14404 lines
531 KiB
EmacsLisp
14404 lines
531 KiB
EmacsLisp
;;; org.el --- Outline-based notes management and organize
|
|
;; Carstens outline-mode for keeping track of everything.
|
|
;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
|
|
;;
|
|
;; Author: Carsten Dominik <dominik at science dot uva dot nl>
|
|
;; Keywords: outlines, hypermedia, calendar, wp
|
|
;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/
|
|
;; Version: 4.30
|
|
;;
|
|
;; This file is part of GNU Emacs.
|
|
;;
|
|
;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation; either version 2, or (at your option)
|
|
;; any later version.
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
;; Boston, MA 02110-1301, USA.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;
|
|
;;; Commentary:
|
|
;;
|
|
;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing
|
|
;; project planning with a fast and effective plain-text system.
|
|
;;
|
|
;; Org-mode develops organizational tasks around a NOTES file that contains
|
|
;; information about projects as plain text. Org-mode is implemented on top
|
|
;; of outline-mode - ideal to keep the content of large files well structured.
|
|
;; It supports ToDo items, deadlines and time stamps, which can be extracted
|
|
;; to create a daily/weekly agenda that also integrates the diary of the Emacs
|
|
;; calendar. Tables are easily created with a built-in table editor. Plain
|
|
;; text URL-like links connect to websites, emails (VM, RMAIL, WANDERLUST),
|
|
;; Usenet messages (Gnus), BBDB entries, and any files related to the
|
|
;; projects. For printing and sharing of notes, an Org-mode file (or a part
|
|
;; of it) can be exported as a structured ASCII file, or as HTML.
|
|
;;
|
|
;; Installation
|
|
;; ------------
|
|
;; If Org-mode is part of the Emacs distribution or an XEmacs package, you
|
|
;; only need to copy the following lines to your .emacs file. The last two
|
|
;; lines define *global* keys for the commands `org-store-link' and
|
|
;; `org-agenda' - please choose suitable keys yourself.
|
|
;;
|
|
;; (add-to-list 'auto-mode-alist '("\\.org$" . org-mode))
|
|
;; (define-key global-map "\C-cl" 'org-store-link)
|
|
;; (define-key global-map "\C-ca" 'org-agenda)
|
|
;;
|
|
;; Furthermore you need to activate font-lock-mode in org-mode buffers.
|
|
;; either of the following two lins will do the trick:
|
|
;;
|
|
;; (global-font-lock-mode 1) ; for all buffers
|
|
;; (add-hook 'org-mode-hook 'turn-on-font-lock) ; org-mode buffers only
|
|
;;
|
|
;; If you have downloaded Org-mode from the Web, you have to take additional
|
|
;; action: Byte-compile org.el and org-publish.el and put them together with
|
|
;; org-install.el on your load path. Then also add to your .emacs file:
|
|
;;
|
|
;; (require 'org-install)
|
|
;;
|
|
;; This setup will put all files with extension ".org" into Org-mode. As
|
|
;; an alternative, make the first line of a file look like this:
|
|
;;
|
|
;; MY PROJECTS -*- mode: org; -*-
|
|
;;
|
|
;; which will select Org-mode for this buffer no matter what the file's
|
|
;; name is.
|
|
;;
|
|
;; Documentation
|
|
;; -------------
|
|
;; The documentation of Org-mode can be found in the TeXInfo file. The
|
|
;; distribution also contains a PDF version of it. At the homepage of
|
|
;; Org-mode, you can read the same text online as HTML. There is also an
|
|
;; excellent reference card made by Philip Rooke. This card can be found
|
|
;; in the etc/ directory of Emacs 22.
|
|
;;
|
|
;; Changes since version 4.10:
|
|
;; ---------------------------
|
|
;; Version 4.30
|
|
;; - Modified installation: Autoloads have been collected in org-install.el.
|
|
;; - Logging (org-log-done) is now a #+STARTUP option.
|
|
;; - Checkboxes in plain list items, following up on Frank Ruell's idea.
|
|
;; - File links inserted with C-c C-l will use relative paths if the linked
|
|
;; file is in the current directory or a subdirectory of it.
|
|
;; - New variable `org-link-file-path-type' to specify preference for
|
|
;; relative and absolute paths.
|
|
;; - New CSS classes for tags, timestamps, timestamp keywords.
|
|
;; - Bug and typo fixes.
|
|
;;
|
|
;; Version 4.29
|
|
;; - Inlining images in HTML export now depends on wheather the link
|
|
;; contains a description or not.
|
|
;; - TODO items can be scheduled from the global TODO list using C-c C-s.
|
|
;; - TODO items already scheduled can be made to disappear from the global
|
|
;; todo list, see `org-agenda-todo-ignore-scheduled'.
|
|
;; - In Tables, formulas may also be Lisp forms.
|
|
;; - Exporting the visible part of an outline with `C-c C-x v' works now
|
|
;; for all available exporters.
|
|
;; - Bug fixes, lots of them :-(
|
|
;;
|
|
;; Version 4.28
|
|
;; - Bug fixes.
|
|
;;
|
|
;; Version 4.27
|
|
;; - HTML exporter generalized to receive external options.
|
|
;; As part of the process, author, email and date have been moved to the
|
|
;; end of the HTML file.
|
|
;; - Support for customizable file search in file links.
|
|
;; - BibTeX database links as first application of the above.
|
|
;; - New option `org-agenda-todo-list-sublevels' to turn off listing TODO
|
|
;; entries that are sublevels of another TODO entry.
|
|
;;
|
|
;; Version 4.26
|
|
;; - Bug fixes.
|
|
;;
|
|
;; Version 4.25
|
|
;; - Revision of the font-lock faces section, with better tty support.
|
|
;; - TODO keywords in Agenda buffer are fontified.
|
|
;; - Export converts links between .org files to links between .html files.
|
|
;; - Better support for bold/italic/underline emphasis.
|
|
;;
|
|
;; Version 4.24
|
|
;; - Bug fixes.
|
|
;;
|
|
;; Version 4.23
|
|
;; - Bug fixes.
|
|
;;
|
|
;; Version 4.22
|
|
;; - Bug fixes.
|
|
;; - In agenda buffer, mouse-1 no longer follows link.
|
|
;; See `org-agenda-mouse-1-follows-link' and `org-mouse-1-follows-link'.
|
|
;;
|
|
;; Version 4.20
|
|
;; - Links use now the [[link][description]] format by default.
|
|
;; When inserting links, the user is prompted for a description.
|
|
;; - If a link has a description, only the description is displayed
|
|
;; the link part is hidden. Use C-c C-l to edit the link part.
|
|
;; - TAGS are now bold, but in the same color as the headline.
|
|
;; - The width of a table column can be limited by using a field "<N>".
|
|
;; - New structure for the customization tree.
|
|
;; - Bug fixes.
|
|
;;
|
|
;; Version 4.13
|
|
;; - The list of agenda files can be maintainted in an external file.
|
|
;; - Bug fixes.
|
|
;;
|
|
;; Version 4.12
|
|
;; - Templates for remember buffer. Note that the remember setup changes.
|
|
;; To set up templates, see `org-remember-templates'.
|
|
;; - The time in new time stamps can be rounded, see new option
|
|
;; `org-time-stamp-rounding-minutes'.
|
|
;; - Bug fixes (there are *always* more bugs).
|
|
;;
|
|
;;; Code:
|
|
|
|
(eval-when-compile
|
|
(require 'cl)
|
|
(require 'calendar))
|
|
(require 'outline)
|
|
(require 'time-date)
|
|
(require 'easymenu)
|
|
|
|
(defvar calc-embedded-close-formula) ; defined by the calc package
|
|
(defvar calc-embedded-open-formula) ; defined by the calc package
|
|
(defvar font-lock-unfontify-region-function) ; defined by font-lock.el
|
|
|
|
;;; Customization variables
|
|
|
|
(defvar org-version "4.29"
|
|
"The version number of the file org.el.")
|
|
(defun org-version ()
|
|
(interactive)
|
|
(message "Org-mode version %s" org-version))
|
|
|
|
;; The following constant is for compatibility with different versions
|
|
;; of outline.el.
|
|
(defconst org-noutline-p (featurep 'noutline)
|
|
"Are we using the new outline mode?")
|
|
(defconst org-xemacs-p (featurep 'xemacs)) ; not used by org.el itself
|
|
(defconst org-format-transports-properties-p
|
|
(let ((x "a"))
|
|
(add-text-properties 0 1 '(test t) x)
|
|
(get-text-property 0 'test (format "%s" x)))
|
|
"Does format transport text properties?")
|
|
|
|
(defgroup org nil
|
|
"Outline-based notes management and organizer."
|
|
:tag "Org"
|
|
:group 'outlines
|
|
:group 'hypermedia
|
|
:group 'calendar)
|
|
|
|
(defgroup org-startup nil
|
|
"Options concerning startup of Org-mode."
|
|
:tag "Org Startup"
|
|
:group 'org)
|
|
|
|
(defcustom org-startup-folded t
|
|
"Non-nil means, entering Org-mode will switch to OVERVIEW.
|
|
This can also be configured on a per-file basis by adding one of
|
|
the following lines anywhere in the buffer:
|
|
|
|
#+STARTUP: fold
|
|
#+STARTUP: nofold
|
|
#+STARTUP: content"
|
|
:group 'org-startup
|
|
:type '(choice
|
|
(const :tag "nofold: show all" nil)
|
|
(const :tag "fold: overview" t)
|
|
(const :tag "content: all headlines" content)))
|
|
|
|
(defcustom org-startup-truncated t
|
|
"Non-nil means, entering Org-mode will set `truncate-lines'.
|
|
This is useful since some lines containing links can be very long and
|
|
uninteresting. Also tables look terrible when wrapped."
|
|
:group 'org-startup
|
|
:type 'boolean)
|
|
|
|
(defcustom org-startup-align-all-tables nil
|
|
"Non-nil means, align all tables when visiting a file.
|
|
This is useful when the column width in tables is forced with <N> cookies
|
|
in table fields. Such tables will look correct only after the first re-align.
|
|
This can also be configured on a per-file basis by adding one of
|
|
the following lines anywhere in the buffer:
|
|
#+STARTUP: align
|
|
#+STARTUP: noalign"
|
|
:group 'org-startup
|
|
:type 'boolean)
|
|
|
|
(defcustom org-startup-with-deadline-check nil
|
|
"Non-nil means, entering Org-mode will run the deadline check.
|
|
This means, if you start editing an org file, you will get an
|
|
immediate reminder of any due deadlines.
|
|
This can also be configured on a per-file basis by adding one of
|
|
the following lines anywhere in the buffer:
|
|
#+STARTUP: dlcheck
|
|
#+STARTUP: nodlcheck"
|
|
:group 'org-startup
|
|
:type 'boolean)
|
|
|
|
(defcustom org-insert-mode-line-in-empty-file nil
|
|
"Non-nil means insert the first line setting Org-mode in empty files.
|
|
When the function `org-mode' is called interactively in an empty file, this
|
|
normally means that the file name does not automatically trigger Org-mode.
|
|
To ensure that the file will always be in Org-mode in the future, a
|
|
line enforcing Org-mode will be inserted into the buffer, if this option
|
|
has been set."
|
|
:group 'org-startup
|
|
:type 'boolean)
|
|
|
|
(defcustom org-CUA-compatible nil
|
|
"Non-nil means use alternative key bindings for S-<cursor movement>.
|
|
Org-mode used S-<cursor movement> for changing timestamps and priorities.
|
|
S-<cursor movement> is also used for example by `CUA-mode' to select text.
|
|
If you want to use Org-mode together with `CUA-mode', Org-mode needs to use
|
|
alternative bindings. Setting this variable to t will replace the following
|
|
keys both in Org-mode and in the Org-agenda buffer.
|
|
|
|
S-RET -> C-S-RET
|
|
S-up -> M-p
|
|
S-down -> M-n
|
|
S-left -> M--
|
|
S-right -> M-+
|
|
|
|
If you do not like the alternative keys, take a look at the variable
|
|
`org-disputed-keys'.
|
|
|
|
This option is only relevant at load-time of Org-mode. Changing it requires
|
|
a restart of Emacs to become effective."
|
|
:group 'org-startup
|
|
:type 'boolean)
|
|
|
|
(defvar org-disputed-keys
|
|
'((S-up [(shift up)] [(meta ?p)])
|
|
(S-down [(shift down)] [(meta ?n)])
|
|
(S-left [(shift left)] [(meta ?-)])
|
|
(S-right [(shift right)] [(meta ?+)])
|
|
(S-return [(shift return)] [(control shift return)]))
|
|
"Keys for which Org-mode and other modes compete.
|
|
This is an alist, cars are symbols for lookup, 1st element is the default key,
|
|
second element will be used when `org-CUA-compatible' is t.")
|
|
|
|
(defun org-key (key)
|
|
"Select a key according to `org-CUA-compatible'."
|
|
(nth (if org-CUA-compatible 2 1)
|
|
(or (assq key org-disputed-keys)
|
|
(error "Invalid Key %s in `org-key'" key))))
|
|
|
|
(defcustom org-ellipsis nil
|
|
"The ellipsis to use in the Org-mode outline.
|
|
When nil, just use the standard three dots. When a string, use that instead,
|
|
and just in Org-mode (which will then use its own display table).
|
|
Changing this requires executing `M-x org-mode' in a buffer to become
|
|
effective."
|
|
:group 'org-startup
|
|
:type '(choice (const :tag "Default" nil)
|
|
(string :tag "String" :value "...#")))
|
|
|
|
(defvar org-display-table nil
|
|
"The display table for org-mode, in case `org-ellipsis' is non-nil.")
|
|
|
|
(defgroup org-keywords nil
|
|
"Keywords in Org-mode."
|
|
:tag "Org Keywords"
|
|
:group 'org)
|
|
|
|
(defcustom org-deadline-string "DEADLINE:"
|
|
"String to mark deadline entries.
|
|
A deadline is this string, followed by a time stamp. Should be a word,
|
|
terminated by a colon. You can insert a schedule keyword and
|
|
a timestamp with \\[org-deadline].
|
|
Changes become only effective after restarting Emacs."
|
|
:group 'org-keywords
|
|
:type 'string)
|
|
|
|
(defcustom org-scheduled-string "SCHEDULED:"
|
|
"String to mark scheduled TODO entries.
|
|
A schedule is this string, followed by a time stamp. Should be a word,
|
|
terminated by a colon. You can insert a schedule keyword and
|
|
a timestamp with \\[org-schedule].
|
|
Changes become only effective after restarting Emacs."
|
|
:group 'org-keywords
|
|
:type 'string)
|
|
|
|
(defcustom org-closed-string "CLOSED:"
|
|
"String used as the prefix for timestamps logging closing a TODO entry."
|
|
:group 'org-keywords
|
|
:type 'string)
|
|
|
|
(defcustom org-comment-string "COMMENT"
|
|
"Entries starting with this keyword will never be exported.
|
|
An entry can be toggled between COMMENT and normal with
|
|
\\[org-toggle-comment].
|
|
Changes become only effective after restarting Emacs."
|
|
:group 'org-keywords
|
|
:type 'string)
|
|
|
|
(defcustom org-quote-string "QUOTE"
|
|
"Entries starting with this keyword will be exported in fixed-width font.
|
|
Quoting applies only to the text in the entry following the headline, and does
|
|
not extend beyond the next headline, even if that is lower level.
|
|
An entry can be toggled between QUOTE and normal with
|
|
\\[org-toggle-fixed-width-section]."
|
|
:group 'org-keywords
|
|
:type 'string)
|
|
|
|
(defgroup org-structure nil
|
|
"Options concerning the general structure of Org-mode files."
|
|
:tag "Org Structure"
|
|
:group 'org)
|
|
|
|
(defgroup org-cycle nil
|
|
"Options concerning visibility cycling in Org-mode."
|
|
:tag "Org Cycle"
|
|
:group 'org-structure)
|
|
|
|
(defcustom org-cycle-global-at-bob t
|
|
"Cycle globally if cursor is at beginning of buffer and not at a headline.
|
|
This makes it possible to do global cycling without having to use S-TAB or
|
|
C-u TAB. For this special case to work, the first line of the buffer
|
|
must not be a headline - it may be empty ot some other text. When used in
|
|
this way, `org-cycle-hook' is disables temporarily, to make sure the
|
|
cursor stays at the beginning of the buffer.
|
|
When this option is nil, don't do anything special at the beginning
|
|
of the buffer."
|
|
:group 'org-cycle
|
|
:type 'boolean)
|
|
|
|
(defcustom org-cycle-emulate-tab t
|
|
"Where should `org-cycle' emulate TAB.
|
|
nil Never
|
|
white Only in completely white lines
|
|
t Everywhere except in headlines"
|
|
:group 'org-cycle
|
|
:type '(choice (const :tag "Never" nil)
|
|
(const :tag "Only in completely white lines" white)
|
|
(const :tag "Everywhere except in headlines" t)
|
|
))
|
|
|
|
(defcustom org-cycle-hook '(org-optimize-window-after-visibility-change)
|
|
"Hook that is run after `org-cycle' has changed the buffer visibility.
|
|
The function(s) in this hook must accept a single argument which indicates
|
|
the new state that was set by the most recent `org-cycle' command. The
|
|
argument is a symbol. After a global state change, it can have the values
|
|
`overview', `content', or `all'. After a local state change, it can have
|
|
the values `folded', `children', or `subtree'."
|
|
:group 'org-cycle
|
|
:type 'hook)
|
|
|
|
(defgroup org-edit-structure nil
|
|
"Options concerning structure editing in Org-mode."
|
|
:tag "Org Edit Structure"
|
|
:group 'org-structure)
|
|
|
|
(defcustom org-odd-levels-only nil
|
|
"Non-nil means, skip even levels and only use odd levels for the outline.
|
|
This has the effect that two stars are being added/taken away in
|
|
promotion/demotion commands. It also influences how levels are
|
|
handled by the exporters.
|
|
Changing it requires restart of `font-lock-mode' to become effective
|
|
for fontification also in regions already fontified.
|
|
You may also set this on a per-file basis by adding one of the following
|
|
lines to the buffer:
|
|
|
|
#+STARTUP: odd
|
|
#+STARTUP: oddeven"
|
|
:group 'org-edit-structure
|
|
:group 'org-font-lock
|
|
:type 'boolean)
|
|
|
|
(defcustom org-adapt-indentation t
|
|
"Non-nil means, adapt indentation when promoting and demoting.
|
|
When this is set and the *entire* text in an entry is indented, the
|
|
indentation is increased by one space in a demotion command, and
|
|
decreased by one in a promotion command. If any line in the entry
|
|
body starts at column 0, indentation is not changed at all."
|
|
:group 'org-edit-structure
|
|
:type 'boolean)
|
|
|
|
(defcustom org-insert-heading-hook nil
|
|
"Hook being run after inserting a new heading."
|
|
:group 'org-edit-structure
|
|
:type 'boolean)
|
|
|
|
(defcustom org-enable-fixed-width-editor t
|
|
"Non-nil means, lines starting with \":\" are treated as fixed-width.
|
|
This currently only means, they are never auto-wrapped.
|
|
When nil, such lines will be treated like ordinary lines.
|
|
See also the QUOTE keyword."
|
|
:group 'org-edit-structure
|
|
:type 'boolean)
|
|
|
|
(defgroup org-sparse-trees nil
|
|
"Options concerning sparse trees in Org-mode."
|
|
:tag "Org Sparse Trees"
|
|
:group 'org-structure)
|
|
|
|
(defcustom org-highlight-sparse-tree-matches t
|
|
"Non-nil means, highlight all matches that define a sparse tree.
|
|
The highlights will automatically disappear the next time the buffer is
|
|
changed by an edit command."
|
|
:group 'org-sparse-trees
|
|
:type 'boolean)
|
|
|
|
(defcustom org-show-hierarchy-above t
|
|
"Non-nil means, show full hierarchy when showing a spot in the tree.
|
|
Turning this off makes sparse trees more compact, but also less clear."
|
|
:group 'org-sparse-trees
|
|
:type 'boolean)
|
|
|
|
(defcustom org-show-following-heading t
|
|
"Non-nil means, show heading following match in `org-occur'.
|
|
When doing an `org-occur' it is useful to show the headline which
|
|
follows the match, even if they do not match the regexp. This makes it
|
|
easier to edit directly inside the sparse tree. However, if you use
|
|
`org-occur' mainly as an overview, the following headlines are
|
|
unnecessary clutter."
|
|
:group 'org-sparse-trees
|
|
:type 'boolean)
|
|
|
|
(defcustom org-occur-hook '(org-first-headline-recenter)
|
|
"Hook that is run after `org-occur' has constructed a sparse tree.
|
|
This can be used to recenter the window to show as much of the structure
|
|
as possible."
|
|
:group 'org-sparse-trees
|
|
:type 'hook)
|
|
|
|
(defgroup org-plain-lists nil
|
|
"Options concerning plain lists in Org-mode."
|
|
:tag "Org Plain lists"
|
|
:group 'org-structure)
|
|
|
|
(defcustom org-cycle-include-plain-lists nil
|
|
"Non-nil means, include plain lists into visibility cycling.
|
|
This means that during cycling, plain list items will *temporarily* be
|
|
interpreted as outline headlines with a level given by 1000+i where i is the
|
|
indentation of the bullet. In all other operations, plain list items are
|
|
not seen as headlines. For example, you cannot assign a TODO keyword to
|
|
such an item."
|
|
:group 'org-plain-lists
|
|
:type 'boolean)
|
|
|
|
|
|
(defcustom org-plain-list-ordered-item-terminator t
|
|
"The character that makes a line with leading number an ordered list item.
|
|
Valid values are ?. and ?\). To get both terminators, use t. While
|
|
?. may look nicer, it creates the danger that a line with leading
|
|
number may be incorrectly interpreted as an item. ?\) therefore is
|
|
the safe choice."
|
|
:group 'org-plain-lists
|
|
:type '(choice (const :tag "dot like in \"2.\"" ?.)
|
|
(const :tag "paren like in \"2)\"" ?\))
|
|
(const :tab "both" t)))
|
|
|
|
(defcustom org-auto-renumber-ordered-lists t
|
|
"Non-nil means, automatically renumber ordered plain lists.
|
|
Renumbering happens when the sequence have been changed with
|
|
\\[org-shiftmetaup] or \\[org-shiftmetadown]. After other editing commands,
|
|
use \\[org-ctrl-c-ctrl-c] to trigger renumbering."
|
|
:group 'org-plain-lists
|
|
:type 'boolean)
|
|
|
|
(defgroup org-archive nil
|
|
"Options concerning archiving in Org-mode."
|
|
:tag "Org Archive"
|
|
:group 'org-structure)
|
|
|
|
(defcustom org-archive-location "%s_archive::"
|
|
"The location where subtrees should be archived.
|
|
This string consists of two parts, separated by a double-colon.
|
|
|
|
The first part is a file name - when omitted, archiving happens in the same
|
|
file. %s will be replaced by the current file name (without directory part).
|
|
Archiving to a different file is useful to keep archived entries from
|
|
contributing to the Org-mode Agenda.
|
|
|
|
The part after the double colon is a headline. The archived entries will be
|
|
filed under that headline. When omitted, the subtrees are simply filed away
|
|
at the end of the file, as top-level entries.
|
|
|
|
Here are a few examples:
|
|
\"%s_archive::\"
|
|
If the current file is Projects.org, archive in file
|
|
Projects.org_archive, as top-level trees. This is the default.
|
|
|
|
\"::* Archived Tasks\"
|
|
Archive in the current file, under the top-level headline
|
|
\"* Archived Tasks\".
|
|
|
|
\"~/org/archive.org::\"
|
|
Archive in file ~/org/archive.org (absolute path), as top-level trees.
|
|
|
|
\"basement::** Finished Tasks\"
|
|
Archive in file ./basement (relative path), as level 3 trees
|
|
below the level 2 heading \"** Finished Tasks\".
|
|
|
|
You may set this option on a per-file basis by adding to the buffer a
|
|
line like
|
|
|
|
#+ARCHIVE: basement::** Finished Tasks"
|
|
:group 'org-archive
|
|
:type 'string)
|
|
|
|
(defcustom org-archive-mark-done t
|
|
"Non-nil means, mark archived entries as DONE."
|
|
:group 'org-archive
|
|
:type 'boolean)
|
|
|
|
(defcustom org-archive-stamp-time t
|
|
"Non-nil means, add a time stamp to archived entries.
|
|
The time stamp will be added directly after the TODO state keyword in the
|
|
first line, so it is probably best to use this in combinations with
|
|
`org-archive-mark-done'."
|
|
:group 'org-archive
|
|
:type 'boolean)
|
|
|
|
(defgroup org-table nil
|
|
"Options concerning tables in Org-mode."
|
|
:tag "Org Table"
|
|
:group 'org)
|
|
|
|
(defcustom org-enable-table-editor 'optimized
|
|
"Non-nil means, lines starting with \"|\" are handled by the table editor.
|
|
When nil, such lines will be treated like ordinary lines.
|
|
|
|
When equal to the symbol `optimized', the table editor will be optimized to
|
|
do the following:
|
|
- Use automatic overwrite mode in front of whitespace in table fields.
|
|
This make the structure of the table stay in tact as long as the edited
|
|
field does not exceed the column width.
|
|
- Minimize the number of realigns. Normally, the table is aligned each time
|
|
TAB or RET are pressed to move to another field. With optimization this
|
|
happens only if changes to a field might have changed the column width.
|
|
Optimization requires replacing the functions `self-insert-command',
|
|
`delete-char', and `backward-delete-char' in Org-mode buffers, with a
|
|
slight (in fact: unnoticeable) speed impact for normal typing. Org-mode is
|
|
very good at guessing when a re-align will be necessary, but you can always
|
|
force one with \\[org-ctrl-c-ctrl-c].
|
|
|
|
If you would like to use the optimized version in Org-mode, but the
|
|
un-optimized version in OrgTbl-mode, see the variable `orgtbl-optimized'.
|
|
|
|
This variable can be used to turn on and off the table editor during a session,
|
|
but in order to toggle optimization, a restart is required.
|
|
|
|
See also the variable `org-table-auto-blank-field'."
|
|
:group 'org-table
|
|
:type '(choice
|
|
(const :tag "off" nil)
|
|
(const :tag "on" t)
|
|
(const :tag "on, optimized" optimized)))
|
|
|
|
(defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized)
|
|
"Non-nil means, use the optimized table editor version for `orgtbl-mode'.
|
|
In the optimized version, the table editor takes over all simple keys that
|
|
normally just insert a character. In tables, the characters are inserted
|
|
in a way to minimize disturbing the table structure (i.e. in overwrite mode
|
|
for empty fields). Outside tables, the correct binding of the keys is
|
|
restored.
|
|
|
|
The default for this option is t if the optimized version is also used in
|
|
Org-mode. See the variable `org-enable-table-editor' for details. Changing
|
|
this variable requires a restart of Emacs to become effective."
|
|
:group 'org-table
|
|
:type 'boolean)
|
|
|
|
(defgroup org-table-settings nil
|
|
"Settings for tables in Org-mode."
|
|
:tag "Org Table Settings"
|
|
:group 'org-table)
|
|
|
|
(defcustom org-table-default-size "5x2"
|
|
"The default size for newly created tables, Columns x Rows."
|
|
:group 'org-table-settings
|
|
:type 'string)
|
|
|
|
(defcustom org-table-number-regexp "^[<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*$"
|
|
"Regular expression for recognizing numbers in table columns.
|
|
If a table column contains mostly numbers, it will be aligned to the
|
|
right. If not, it will be aligned to the left.
|
|
|
|
The default value of this option is a regular expression which allows
|
|
anything which looks remotely like a number as used in scientific
|
|
context. For example, all of the following will be considered a
|
|
number:
|
|
12 12.2 2.4e-08 2x10^12 4.034+-0.02 2.7(10) >3.5
|
|
|
|
Other options offered by the customize interface are more restrictive."
|
|
:group 'org-table-settings
|
|
:type '(choice
|
|
(const :tag "Positive Integers"
|
|
"^[0-9]+$")
|
|
(const :tag "Integers"
|
|
"^[-+]?[0-9]+$")
|
|
(const :tag "Floating Point Numbers"
|
|
"^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.[0-9]*\\)$")
|
|
(const :tag "Floating Point Number or Integer"
|
|
"^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.?[0-9]*\\)$")
|
|
(const :tag "Exponential, Floating point, Integer"
|
|
"^[-+]?[0-9.]+\\([eEdD][-+0-9]+\\)?$")
|
|
(const :tag "Very General Number-Like"
|
|
"^[<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*$")
|
|
(string :tag "Regexp:")))
|
|
|
|
(defcustom org-table-number-fraction 0.5
|
|
"Fraction of numbers in a column required to make the column align right.
|
|
In a column all non-white fields are considered. If at least this
|
|
fraction of fields is matched by `org-table-number-fraction',
|
|
alignment to the right border applies."
|
|
:group 'org-table-settings
|
|
:type 'number)
|
|
|
|
(defgroup org-table-editing nil
|
|
"Bahavior of tables during editing in Org-mode."
|
|
:tag "Org Table Editing"
|
|
:group 'org-table)
|
|
|
|
(defcustom org-table-automatic-realign t
|
|
"Non-nil means, automatically re-align table when pressing TAB or RETURN.
|
|
When nil, aligning is only done with \\[org-table-align], or after column
|
|
removal/insertion."
|
|
:group 'org-table-editing
|
|
:type 'boolean)
|
|
|
|
(defcustom org-table-limit-column-width t ;kw
|
|
"Non-nil means, allow to limit the width of table columns with <N> fields."
|
|
:group 'org-table-editing
|
|
:type 'boolean)
|
|
|
|
(defcustom org-table-auto-blank-field t
|
|
"Non-nil means, automatically blank table field when starting to type into it.
|
|
This only happens when typing immediately after a field motion
|
|
command (TAB, S-TAB or RET).
|
|
Only relevant when `org-enable-table-editor' is equal to `optimized'."
|
|
:group 'org-table-editing
|
|
:type 'boolean)
|
|
|
|
(defcustom org-table-tab-jumps-over-hlines t
|
|
"Non-nil means, tab in the last column of a table with jump over a hline.
|
|
If a horizontal separator line is following the current line,
|
|
`org-table-next-field' can either create a new row before that line, or jump
|
|
over the line. When this option is nil, a new line will be created before
|
|
this line."
|
|
:group 'org-table-editing
|
|
:type 'boolean)
|
|
|
|
(defcustom org-table-tab-recognizes-table.el t
|
|
"Non-nil means, TAB will automatically notice a table.el table.
|
|
When it sees such a table, it moves point into it and - if necessary -
|
|
calls `table-recognize-table'."
|
|
:group 'org-table-editing
|
|
:type 'boolean)
|
|
|
|
(defgroup org-table-calculation nil
|
|
"Options concerning tables in Org-mode."
|
|
:tag "Org Table Calculation"
|
|
:group 'org-table)
|
|
|
|
(defcustom org-table-copy-increment t
|
|
"Non-nil means, increment when copying current field with \\[org-table-copy-down]."
|
|
:group 'org-table-calculation
|
|
:type 'boolean)
|
|
|
|
(defcustom org-calc-default-modes
|
|
'(calc-internal-prec 12
|
|
calc-float-format (float 5)
|
|
calc-angle-mode deg
|
|
calc-prefer-frac nil
|
|
calc-symbolic-mode nil
|
|
calc-date-format (YYYY "-" MM "-" DD " " Www (" " HH ":" mm))
|
|
calc-display-working-message t
|
|
)
|
|
"List with Calc mode settings for use in calc-eval for table formulas.
|
|
The list must contain alternating symbols (Calc modes variables and values).
|
|
Don't remove any of the default settings, just change the values. Org-mode
|
|
relies on the variables to be present in the list."
|
|
:group 'org-table-calculation
|
|
:type 'plist)
|
|
|
|
(defcustom org-table-formula-evaluate-inline t
|
|
"Non-nil means, TAB and RET evaluate a formula in current table field.
|
|
If the current field starts with an equal sign, it is assumed to be a formula
|
|
which should be evaluated as described in the manual and in the documentation
|
|
string of the command `org-table-eval-formula'. This feature requires the
|
|
Emacs calc package.
|
|
When this variable is nil, formula calculation is only available through
|
|
the command \\[org-table-eval-formula]."
|
|
:group 'org-table-calculation
|
|
:type 'boolean)
|
|
|
|
|
|
(defcustom org-table-formula-use-constants t
|
|
"Non-nil means, interpret constants in formulas in tables.
|
|
A constant looks like `$c' or `$Grav' and will be replaced before evaluation
|
|
by the value given in `org-table-formula-constants', or by a value obtained
|
|
from the `constants.el' package."
|
|
:group 'org-table-calculation
|
|
:type 'boolean)
|
|
|
|
(defcustom org-table-formula-constants nil
|
|
"Alist with constant names and values, for use in table formulas.
|
|
The car of each element is a name of a constant, without the `$' before it.
|
|
The cdr is the value as a string. For example, if you'd like to use the
|
|
speed of light in a formula, you would configure
|
|
|
|
(setq org-table-formula-constants '((\"c\" . \"299792458.\")))
|
|
|
|
and then use it in an equation like `$1*$c'."
|
|
:group 'org-table-calculation
|
|
:type '(repeat
|
|
(cons (string :tag "name")
|
|
(string :tag "value"))))
|
|
|
|
(defcustom org-table-formula-numbers-only nil
|
|
"Non-nil means, calculate only with numbers in table formulas.
|
|
Then all input fields will be converted to a number, and the result
|
|
must also be a number. When nil, calc's full potential is available
|
|
in table calculations, including symbolics etc."
|
|
:group 'org-table-calculation
|
|
:type 'boolean)
|
|
|
|
(defcustom org-table-allow-automatic-line-recalculation t
|
|
"Non-nil means, lines marked with |#| or |*| will be recomputed automatically.
|
|
Automatically means, when TAB or RET or C-c C-c are pressed in the line."
|
|
:group 'org-table-calculation
|
|
:type 'boolean)
|
|
|
|
(defgroup org-link nil
|
|
"Options concerning links in Org-mode."
|
|
:tag "Org Link"
|
|
:group 'org)
|
|
|
|
(defcustom org-descriptive-links t
|
|
"Non-nil means, hide link part and only show description of bracket links.
|
|
Bracket links are like [[link][descritpion]]. This variable sets the initial
|
|
state in new org-mode buffers. The setting can then be toggled on a
|
|
per-buffer basis from the Org->Hyperlinks menu."
|
|
:group 'org-link
|
|
:type 'boolean)
|
|
|
|
(defcustom org-link-style 'bracket
|
|
"The style of links to be inserted with \\[org-insert-link].
|
|
Possible values are:
|
|
bracket [[link][description]]. This is recommended
|
|
plain Description \\n link. The old way, no longer recommended."
|
|
:group 'org-link
|
|
:type '(choice
|
|
(const :tag "Bracket (recommended)" bracket)
|
|
(const :tag "Plain (no longer recommended)" plain)))
|
|
|
|
(defcustom org-link-format "%s"
|
|
"Default format for external, URL-like linkes in the buffer.
|
|
This is a format string for printf, %s will be replaced by the link text.
|
|
The recommended value is just \"%s\", since links will be protected by
|
|
enclosing them in double brackets. If you prefer plain links (see variable
|
|
`org-link-style'), \"<%s>\" is useful. Some people also recommend an
|
|
additional URL: prefix, so the format would be \"<URL:%s>\"."
|
|
:group 'org-link
|
|
:type '(choice
|
|
(const :tag "\"%s\" (e.g. http://www.there.com)" "%s")
|
|
(const :tag "\"<%s>\" (e.g. <http://www.there.com>)" "<%s>")
|
|
(const :tag "\"<URL:%s>\" (e.g. <URL:http://www.there.com>)" "<URL:%s>")
|
|
(string :tag "Other" :value "<%s>")))
|
|
|
|
(defcustom org-link-file-path-type 'adaptive
|
|
"How the path name in file links should be stored.
|
|
Valid values are:
|
|
|
|
relative relative to the current directory, i.e. the directory of the file
|
|
into which the link is being inserted.
|
|
absolute absolute path, if possible with ~ for home directory.
|
|
noabbrev absolute path, no abbreviation of home directory.
|
|
adaptive Use relative path for files in the current directory and sub-
|
|
directories of it. For other files, use an absolute path."
|
|
:group 'org-link
|
|
:type '(choice
|
|
(const relative)
|
|
(const absolute)
|
|
(const noabbrev)
|
|
(const adaptive)))
|
|
|
|
(defcustom org-activate-links '(bracket angle plain radio tag date)
|
|
"Types of links that should be activated in Org-mode files.
|
|
This is a list of symbols, each leading to the activation of a certain link
|
|
type. In principle, it does not hurt to turn on most link types - there may
|
|
be a small gain when turning off unused link types. The types are:
|
|
|
|
bracket The recommended [[link][description]] or [[link]] links with hiding.
|
|
angular Links in angular brackes that may contain whitespace like
|
|
<bbdb:Carsten Dominik>.
|
|
plain Plain links in normal text, no whitespace, like http://google.com.
|
|
radio Text that is matched by a radio target, see manual for details.
|
|
tag Tag settings in a headline (link to tag search).
|
|
date Time stamps (link to calendar).
|
|
camel CamelCase words defining text searches.
|
|
|
|
Changing this variable requires a restart of Emacs to become effective."
|
|
:group 'org-link
|
|
:type '(set (const :tag "Double bracket links (new style)" bracket)
|
|
(const :tag "Angular bracket links (old style)" angular)
|
|
(const :tag "plain text links" plain)
|
|
(const :tag "Radio target matches" radio)
|
|
(const :tag "Tags" tag)
|
|
(const :tag "Timestamps" date)
|
|
(const :tag "CamelCase words" camel)))
|
|
|
|
(defgroup org-link-store nil
|
|
"Options concerning storing links in Org-mode"
|
|
:tag "Org Store Link"
|
|
:group 'org-link)
|
|
|
|
(defcustom org-context-in-file-links t
|
|
"Non-nil means, file links from `org-store-link' contain context.
|
|
A search string will be added to the file name with :: as separator and
|
|
used to find the context when the link is activated by the command
|
|
`org-open-at-point'.
|
|
Using a prefix arg to the command \\[org-store-link] (`org-store-link')
|
|
negates this setting for the duration of the command."
|
|
:group 'org-link-store
|
|
:type 'boolean)
|
|
|
|
(defcustom org-file-link-context-use-camel-case nil
|
|
"Non-nil means, use CamelCase to store a search context in a file link.
|
|
When nil, the search string simply consists of the words of the string.
|
|
CamelCase is deprecated, and support for it may be dropped in the future."
|
|
:group 'org-link-store
|
|
:type 'boolean)
|
|
|
|
(defcustom org-keep-stored-link-after-insertion nil
|
|
"Non-nil means, keep link in list for entire session.
|
|
|
|
The command `org-store-link' adds a link pointing to the current
|
|
location to an internal list. These links accumulate during a session.
|
|
The command `org-insert-link' can be used to insert links into any
|
|
Org-mode file (offering completion for all stored links). When this
|
|
option is nil, every link which has been inserted once using \\[org-insert-link]
|
|
will be removed from the list, to make completing the unused links
|
|
more efficient."
|
|
:group 'org-link-store
|
|
:type 'boolean)
|
|
|
|
(defcustom org-usenet-links-prefer-google nil
|
|
"Non-nil means, `org-store-link' will create web links to Google groups.
|
|
When nil, Gnus will be used for such links.
|
|
Using a prefix arg to the command \\[org-store-link] (`org-store-link')
|
|
negates this setting for the duration of the command."
|
|
:group 'org-link-store
|
|
:type 'boolean)
|
|
|
|
(defgroup org-link-follow nil
|
|
"Options concerning following links in Org-mode"
|
|
:tag "Org Follow Link"
|
|
:group 'org-link)
|
|
|
|
(defcustom org-tab-follows-link nil
|
|
"Non-nil means, on links TAB will follow the link.
|
|
Needs to be set before org.el is loaded."
|
|
:group 'org-link-follow
|
|
:type 'boolean)
|
|
|
|
(defcustom org-return-follows-link nil
|
|
"Non-nil means, on links RET will follow the link.
|
|
Needs to be set before org.el is loaded."
|
|
:group 'org-link-follow
|
|
:type 'boolean)
|
|
|
|
(defcustom org-mouse-1-follows-link t
|
|
"Non-nil means, mouse-1 on a link will follow the link.
|
|
A longer mouse click will still set point. Does not wortk on XEmacs.
|
|
Needs to be set before org.el is loaded."
|
|
:group 'org-link-follow
|
|
:type 'boolean)
|
|
|
|
(defcustom org-mark-ring-length 4
|
|
"Number of different positions to be recorded in the ring
|
|
Changing this requires a restart of Emacs to work correctly."
|
|
:group 'org-link-follow
|
|
:type 'interger)
|
|
|
|
(defcustom org-link-frame-setup
|
|
'((vm . vm-visit-folder-other-frame)
|
|
(gnus . gnus-other-frame)
|
|
(file . find-file-other-window))
|
|
"Setup the frame configuration for following links.
|
|
When following a link with Emacs, it may often be useful to display
|
|
this link in another window or frame. This variable can be used to
|
|
set this up for the different types of links.
|
|
For VM, use any of
|
|
`vm-visit-folder'
|
|
`vm-visit-folder-other-frame'
|
|
For Gnus, use any of
|
|
`gnus'
|
|
`gnus-other-frame'
|
|
For FILE, use any of
|
|
`find-file'
|
|
`find-file-other-window'
|
|
`find-file-other-frame'
|
|
For the calendar, use the variable `calendar-setup'.
|
|
For BBDB, it is currently only possible to display the matches in
|
|
another window."
|
|
:group 'org-link-follow
|
|
:type '(list
|
|
(cons (const vm)
|
|
(choice
|
|
(const vm-visit-folder)
|
|
(const vm-visit-folder-other-window)
|
|
(const vm-visit-folder-other-frame)))
|
|
(cons (const gnus)
|
|
(choice
|
|
(const gnus)
|
|
(const gnus-other-frame)))
|
|
(cons (const file)
|
|
(choice
|
|
(const find-file)
|
|
(const find-file-other-window)
|
|
(const find-file-other-frame)))))
|
|
|
|
(defcustom org-open-non-existing-files nil
|
|
"Non-nil means, `org-open-file' will open non-existing file.
|
|
When nil, an error will be generated."
|
|
:group 'org-link-follow
|
|
:type 'boolean)
|
|
|
|
(defcustom org-confirm-shell-links 'yes-or-no-p
|
|
"Non-nil means, ask for confirmation before executing shell links.
|
|
Shell links can be dangerous, just thing about a link
|
|
|
|
[[shell:rm -rf ~/*][Google Search]]
|
|
|
|
This link would show up in your Org-mode document as \"Google Search\"
|
|
but really it would remove your entire home directory. Dangerous indeed.
|
|
Therefore I *definitely* advise agains setting this varaiable to nil.
|
|
Just change it to `y-or-n-p' of you want to confirm with a single key press
|
|
rather than having to type \"yes\"."
|
|
:group 'org-link-follow
|
|
:type '(choice
|
|
(const :tag "with yes-or-no (safer)" yes-or-no-p)
|
|
(const :tag "with y-or-n (faster)" y-or-n-p)
|
|
(const :tag "no confirmation (dangerous)" nil)))
|
|
|
|
(defconst org-file-apps-defaults-gnu
|
|
'((t . mailcap))
|
|
"Default file applications on a UNIX or GNU/Linux system.
|
|
See `org-file-apps'.")
|
|
|
|
(defconst org-file-apps-defaults-macosx
|
|
'((t . "open %s")
|
|
("ps" . "gv %s")
|
|
("ps.gz" . "gv %s")
|
|
("eps" . "gv %s")
|
|
("eps.gz" . "gv %s")
|
|
("dvi" . "xdvi %s")
|
|
("fig" . "xfig %s"))
|
|
"Default file applications on a MacOS X system.
|
|
The system \"open\" is known as a default, but we use X11 applications
|
|
for some files for which the OS does not have a good default.
|
|
See `org-file-apps'.")
|
|
|
|
(defconst org-file-apps-defaults-windowsnt
|
|
(list (cons t
|
|
(list (if (featurep 'xemacs)
|
|
'mswindows-shell-execute
|
|
'w32-shell-execute)
|
|
"open" 'file)))
|
|
"Default file applications on a Windows NT system.
|
|
The system \"open\" is used for most files.
|
|
See `org-file-apps'.")
|
|
|
|
(defcustom org-file-apps
|
|
'(
|
|
("txt" . emacs)
|
|
("tex" . emacs)
|
|
("ltx" . emacs)
|
|
("org" . emacs)
|
|
("el" . emacs)
|
|
("bib" . emacs)
|
|
)
|
|
"External applications for opening `file:path' items in a document.
|
|
Org-mode uses system defaults for different file types, but
|
|
you can use this variable to set the application for a given file
|
|
extension. The entries in this list are cons cells where the car identifies
|
|
files and the cdr the corresponding command. Possible values for the
|
|
file identifier are
|
|
\"ext\" A string identifying an extension
|
|
`directory' Matches a directory
|
|
t Default for all remaining files
|
|
|
|
Possible values for the command are:
|
|
`emacs' The file will be visited by the current Emacs process.
|
|
`default' Use the default application for this file type.
|
|
string A command to be executed by a shell; %s will be replaced
|
|
by the path to the file.
|
|
sexp A Lisp form which will be evaluated. The file path will
|
|
be available in the Lisp variable `file'.
|
|
For more examples, see the system specific constants
|
|
`org-file-apps-defaults-macosx'
|
|
`org-file-apps-defaults-windowsnt'
|
|
`org-file-apps-defaults-gnu'."
|
|
:group 'org-link-follow
|
|
:type '(repeat
|
|
(cons (choice :value ""
|
|
(string :tag "Extension")
|
|
(const :tag "Default for unrecognized files" t)
|
|
(const :tag "Links to a directory" directory))
|
|
(choice :value ""
|
|
(const :tag "Visit with Emacs" emacs)
|
|
(const :tag "Use system default" default)
|
|
(string :tag "Command")
|
|
(sexp :tag "Lisp form")))))
|
|
|
|
(defcustom org-mhe-search-all-folders nil
|
|
"Non-nil means, that the search for the mh-message will be extended to
|
|
all folders if the message cannot be found in the folder given in the link.
|
|
Searching all folders is very effective with one of the search engines
|
|
supported by MH-E, but will be slow with pick."
|
|
:group 'org-link-follow
|
|
:type 'boolean)
|
|
|
|
(defgroup org-remember nil
|
|
"Options concerning interaction with remember.el."
|
|
:tag "Org Remember"
|
|
:group 'org)
|
|
|
|
(defcustom org-directory "~/org"
|
|
"Directory with org files.
|
|
This directory will be used as default to prompt for org files.
|
|
Used by the hooks for remember.el."
|
|
:group 'org-remember
|
|
:type 'directory)
|
|
|
|
(defcustom org-default-notes-file "~/.notes"
|
|
"Default target for storing notes.
|
|
Used by the hooks for remember.el. This can be a string, or nil to mean
|
|
the value of `remember-data-file'."
|
|
:group 'org-remember
|
|
:type '(choice
|
|
(const :tag "Default from remember-data-file" nil)
|
|
file))
|
|
|
|
(defcustom org-remember-templates nil
|
|
"Templates for the creation of remember buffers.
|
|
When nil, just let remember make the buffer.
|
|
When not nil, this is a list of 3-element lists. In each entry, the first
|
|
element is a character, a unique key to select this template.
|
|
The second element is the template. The third element is optional and can
|
|
specify a destination file for remember items created with this template.
|
|
The default file is given by `org-default-notes-file'.
|
|
|
|
The template specifies the structure of the remember buffer. It should have
|
|
a first line starting with a star, to act as the org-mode headline.
|
|
Furthermore, the following %-escapes will be replaced with content:
|
|
%t time stamp, date only
|
|
%T time stamp with date and time
|
|
%u inactive time stamp, date only
|
|
%U inactive time stamp with date and time
|
|
%n user name
|
|
%a annotation, normally the link created with org-store-link
|
|
%i initial content, the region when remember is called with C-u.
|
|
If %i is indented, the entire inserted text will be indented as well.
|
|
%? This will be removed, and the cursor placed at this position."
|
|
:group 'org-remember
|
|
:type '(repeat :tag "enabled"
|
|
(list :value (?a "\n" nil)
|
|
(character :tag "Selection Key")
|
|
(string :tag "Template")
|
|
(file :tag "Destination file (optional)"))))
|
|
|
|
(defcustom org-reverse-note-order nil
|
|
"Non-nil means, store new notes at the beginning of a file or entry.
|
|
When nil, new notes will be filed to the end of a file or entry."
|
|
:group 'org-remember
|
|
:type '(choice
|
|
(const :tag "Reverse always" t)
|
|
(const :tag "Reverse never" nil)
|
|
(repeat :tag "By file name regexp"
|
|
(cons regexp boolean))))
|
|
|
|
(defgroup org-todo nil
|
|
"Options concerning TODO items in Org-mode."
|
|
:tag "Org TODO"
|
|
:group 'org)
|
|
|
|
(defcustom org-todo-keywords '("TODO" "DONE")
|
|
"List of TODO entry keywords.
|
|
\\<org-mode-map>By default, this is '(\"TODO\" \"DONE\"). The last entry in the list is
|
|
considered to mean that the entry is \"done\". All the other mean that
|
|
action is required, and will make the entry show up in todo lists, diaries
|
|
etc.
|
|
The command \\[org-todo] cycles an entry through these states, and an
|
|
additional state where no keyword is present. For details about this
|
|
cycling, see also the variable `org-todo-interpretation'
|
|
Changes become only effective after restarting Emacs."
|
|
:group 'org-todo
|
|
:group 'org-keywords
|
|
:type '(repeat (string :tag "Keyword")))
|
|
|
|
(defcustom org-todo-interpretation 'sequence
|
|
"Controls how TODO keywords are interpreted.
|
|
This variable is only relevant if `org-todo-keywords' contains more than two
|
|
states. \\<org-mode-map>Possible values are `sequence' and `type'.
|
|
|
|
When `sequence', \\[org-todo] will always switch to the next state in the
|
|
`org-todo-keywords' list. When `type', \\[org-todo] only cycles from state
|
|
to state when executed several times in direct succession. Otherwise, it
|
|
switches directly to DONE from any state.
|
|
See the manual for more information."
|
|
:group 'org-todo
|
|
:group 'org-keywords
|
|
:type '(choice (const sequence)
|
|
(const type)))
|
|
|
|
(defcustom org-after-todo-state-change-hook nil
|
|
"Hook which is run after the state of a TODO item was changed.
|
|
The new state (a string with a TODO keyword, or nil) is available in the
|
|
Lisp variable `state'."
|
|
:group 'org-todo
|
|
:type 'hook)
|
|
|
|
(defcustom org-log-done nil
|
|
"When set, insert a (non-active) time stamp when TODO entry is marked DONE.
|
|
When the state of an entry is changed from nothing to TODO, remove a previous
|
|
closing date.
|
|
This can also be configured on a per-file basis by adding one of
|
|
the following lines anywhere in the buffer:
|
|
|
|
#+STARTUP: logging
|
|
#+STARTUP: nologging"
|
|
:group 'org-todo
|
|
:type 'boolean)
|
|
|
|
(defgroup org-priorities nil
|
|
"Priorities in Org-mode."
|
|
:tag "Org Priorities"
|
|
:group 'org-todo)
|
|
|
|
(defcustom org-default-priority ?B
|
|
"The default priority of TODO items.
|
|
This is the priority an item get if no explicit priority is given."
|
|
:group 'org-priorities
|
|
:type 'character)
|
|
|
|
(defcustom org-lowest-priority ?C
|
|
"The lowest priority of TODO items. A character like ?A, ?B etc."
|
|
:group 'org-priorities
|
|
:type 'character)
|
|
|
|
(defgroup org-time nil
|
|
"Options concerning time stamps and deadlines in Org-mode."
|
|
:tag "Org Time"
|
|
:group 'org)
|
|
|
|
(defcustom org-insert-labeled-timestamps-at-point nil
|
|
"Non-nil means, SCHEDULED and DEADLINE timestamps are inserted at point.
|
|
When nil, these labeled time stamps are forces into the second line of an
|
|
entry, just after the headline. When scheduling from the global TODO list,
|
|
the time stamp will always be forced into the second line."
|
|
:group 'org-time
|
|
:type 'boolean)
|
|
|
|
(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>")
|
|
"Formats for `format-time-string' which are used for time stamps.
|
|
It is not recommended to change this constant.")
|
|
|
|
(defcustom org-time-stamp-rounding-minutes 0
|
|
"Number of minutes to round time stamps to upon insertion.
|
|
When zero, insert the time unmodified. Useful rounding numbers
|
|
should be factors of 60, so for example 5, 10, 15.
|
|
When this is not zero, you can still force an exact time-stamp by using
|
|
a double prefix argument to a time-stamp command like `C-c .' or `C-c !'."
|
|
:group 'org-time
|
|
:type 'integer)
|
|
|
|
(defcustom org-deadline-warning-days 30
|
|
"No. of days before expiration during which a deadline becomes active.
|
|
This variable governs the display in the org file."
|
|
:group 'org-time
|
|
:type 'number)
|
|
|
|
(defcustom org-popup-calendar-for-date-prompt t
|
|
"Non-nil means, pop up a calendar when prompting for a date.
|
|
In the calendar, the date can be selected with mouse-1. However, the
|
|
minibuffer will also be active, and you can simply enter the date as well.
|
|
When nil, only the minibuffer will be available."
|
|
:group 'org-time
|
|
:type 'boolean)
|
|
|
|
(defcustom org-calendar-follow-timestamp-change t
|
|
"Non-nil means, make the calendar window follow timestamp changes.
|
|
When a timestamp is modified and the calendar window is visible, it will be
|
|
moved to the new date."
|
|
:group 'org-time
|
|
:type 'boolean)
|
|
|
|
(defgroup org-tags nil
|
|
"Options concerning tags in Org-mode."
|
|
:tag "Org Tags"
|
|
:group 'org)
|
|
|
|
(defcustom org-tags-column 48
|
|
"The column to which tags should be indented in a headline.
|
|
If this number is positive, it specifies the column. If it is negative,
|
|
it means that the tags should be flushright to that column. For example,
|
|
-79 works well for a normal 80 character screen."
|
|
:group 'org-tags
|
|
:type 'integer)
|
|
|
|
(defcustom org-auto-align-tags t
|
|
"Non-nil means, realign tags after pro/demotion of TODO state change.
|
|
These operations change the length of a headline and therefore shift
|
|
the tags around. With this options turned on, after each such operation
|
|
the tags are again aligned to `org-tags-column'."
|
|
:group 'org-tags
|
|
:type 'boolean)
|
|
|
|
(defcustom org-use-tag-inheritance t
|
|
"Non-nil means, tags in levels apply also for sublevels.
|
|
When nil, only the tags directly given in a specific line apply there.
|
|
If you turn off this option, you very likely want to turn on the
|
|
companion option `org-tags-match-list-sublevels'."
|
|
:group 'org-tags
|
|
:type 'boolean)
|
|
|
|
(defcustom org-tags-match-list-sublevels nil
|
|
"Non-nil means list also sublevels of headlines matching tag search.
|
|
Because of tag inheritance (see variable `org-use-tag-inheritance'),
|
|
the sublevels of a headline matching a tag search often also match
|
|
the same search. Listing all of them can create very long lists.
|
|
Setting this variable to nil causes subtrees of a match to be skipped.
|
|
This option is off by default, because inheritance in on. If you turn
|
|
inheritance off, you very likely want to turn this option on.
|
|
|
|
As a special case, if the tag search is restricted to TODO items, the
|
|
value of this variable is ignored and sublevels are always checked, to
|
|
make sure all corresponding TODO items find their way into the list."
|
|
:group 'org-tags
|
|
:type 'boolean)
|
|
|
|
(defvar org-tags-history nil
|
|
"History of minibuffer reads for tags.")
|
|
(defvar org-last-tags-completion-table nil
|
|
"The last used completion table for tags.")
|
|
|
|
(defgroup org-agenda nil
|
|
"Options concerning agenda display Org-mode."
|
|
:tag "Org Agenda"
|
|
:group 'org)
|
|
|
|
(defvar org-category nil
|
|
"Variable used by org files to set a category for agenda display.
|
|
Such files should use a file variable to set it, for example
|
|
|
|
-*- mode: org; org-category: \"ELisp\"
|
|
|
|
or contain a special line
|
|
|
|
#+CATEGORY: ELisp
|
|
|
|
If the file does not specify a category, then file's base name
|
|
is used instead.")
|
|
(make-variable-buffer-local 'org-category)
|
|
|
|
(defcustom org-agenda-files nil
|
|
"The files to be used for agenda display.
|
|
Entries may be added to this list with \\[org-agenda-file-to-front] and removed with
|
|
\\[org-remove-file]. You can also use customize to edit the list.
|
|
|
|
If the value of the variable is not a list but a single file name, then
|
|
the list of agenda files is actually stored and maintained in that file, one
|
|
agenda file per line."
|
|
:group 'org-agenda
|
|
:type '(choice
|
|
(repeat :tag "List of files" file)
|
|
(file :tag "Store list in a file\n" :value "~/.agenda_files")))
|
|
|
|
(defcustom org-agenda-custom-commands '(("w" todo "WAITING"))
|
|
"Custom commands for the agenda.
|
|
These commands will be offered on the splash screen displayed by the
|
|
agenda dispatcher \\[org-agenda]. Each entry is a list of 3 items:
|
|
|
|
key The key (a single char as a string) to be associated with the command.
|
|
type The command type, any of the following symbols:
|
|
todo Entries with a specific TODO keyword, in all agenda files.
|
|
tags Tags match in all agenda files.
|
|
tags-todo Tags match in all agenda files, TODO entries only.
|
|
todo-tree Sparse tree of specific TODO keyword in *current* file.
|
|
tags-tree Sparse tree with all tags matches in *current* file.
|
|
occur-tree Occur sparse tree for current file.
|
|
match What to search for:
|
|
- a single keyword for TODO keyword searches
|
|
- a tags match expression for tags searches
|
|
- a regular expression for occur searches"
|
|
:group 'org-agenda
|
|
:type '(repeat
|
|
(list (string :tag "Key")
|
|
(choice :tag "Type"
|
|
(const :tag "Tags search in all agenda files" tags)
|
|
(const :tag "Tags search of TODO entries, all agenda files" tags-todo)
|
|
(const :tag "TODO keyword search in all agenda files" todo)
|
|
(const :tag "Tags sparse tree in current buffer" tags-tree)
|
|
(const :tag "TODO keyword tree in current buffer" todo-tree)
|
|
(const :tag "Occur tree in current buffer" occur-tree))
|
|
(string :tag "Match"))))
|
|
|
|
;; Fixme: Need a way to toggle this variable, maybe a mode in the
|
|
;; agenda buffer?
|
|
(defcustom org-agenda-todo-list-sublevels t
|
|
"Non-nil means, check also the sublevels of a TODO entry for TODO entries.
|
|
When nil, the sublevels of a TODO entry are not checked, resulting in
|
|
potentially much shorter TODO lists."
|
|
:group 'org-agenda
|
|
:group 'org-todo
|
|
:type 'boolean)
|
|
|
|
(defcustom org-agenda-todo-ignore-scheduled nil
|
|
"Non-nil means, don't show scheduled entries in the global todo list.
|
|
The idea behind this is that by scheduling it, you have already taken care
|
|
of this item."
|
|
:group 'org-agenda
|
|
:group 'org-todo
|
|
:type 'boolean)
|
|
|
|
(defcustom org-agenda-include-all-todo nil
|
|
"Non-nil means, the agenda will always contain all TODO entries.
|
|
When nil, date-less entries will only be shown if `org-agenda' is called
|
|
with a prefix argument.
|
|
When non-nil, the TODO entries will be listed at the top of the agenda, before
|
|
the entries for specific days."
|
|
:group 'org-agenda
|
|
:type 'boolean)
|
|
|
|
(defcustom org-agenda-include-diary nil
|
|
"If non-nil, include in the agenda entries from the Emacs Calendar's diary."
|
|
:group 'org-agenda
|
|
:type 'boolean)
|
|
|
|
(defcustom org-calendar-to-agenda-key [?c]
|
|
"The key to be installed in `calendar-mode-map' for switching to the agenda.
|
|
The command `org-calendar-goto-agenda' will be bound to this key. The
|
|
default is the character `c' because then `c' can be used to switch back and
|
|
forth between agenda and calendar."
|
|
:group 'org-agenda
|
|
:type 'sexp)
|
|
|
|
(defgroup org-agenda-setup nil
|
|
"Options concerning setting up the Agenda window in Org Mode."
|
|
:tag "Org Agenda Window Setup"
|
|
:group 'org-agenda)
|
|
|
|
(defcustom org-agenda-mouse-1-follows-link nil
|
|
"Non-nil means, mouse-1 on a link will follow the link in the agenda.
|
|
A longer mouse click will still set point. Does not wortk on XEmacs.
|
|
Needs to be set before org.el is loaded."
|
|
:group 'org-agenda-setup
|
|
:type 'boolean)
|
|
|
|
(defcustom org-agenda-start-with-follow-mode nil
|
|
"The initial value of follwo-mode in a newly created agenda window."
|
|
:group 'org-agenda-setup
|
|
:type 'boolean)
|
|
|
|
(defcustom org-select-timeline-window t
|
|
"Non-nil means, after creating a timeline, move cursor into Timeline window.
|
|
When nil, cursor will remain in the current window."
|
|
:group 'org-agenda-setup
|
|
:type 'boolean)
|
|
|
|
(defcustom org-select-agenda-window t
|
|
"Non-nil means, after creating an agenda, move cursor into Agenda window.
|
|
When nil, cursor will remain in the current window."
|
|
:group 'org-agenda-setup
|
|
:type 'boolean)
|
|
|
|
(defcustom org-fit-agenda-window t
|
|
"Non-nil means, change window size of agenda to fit content."
|
|
:group 'org-agenda-setup
|
|
:type 'boolean)
|
|
|
|
(defgroup org-agenda-display nil
|
|
"Options concerning what to display initially in Agenda."
|
|
:tag "Org Agenda Display"
|
|
:group 'org-agenda)
|
|
|
|
(defcustom org-agenda-show-all-dates t
|
|
"Non-nil means, `org-agenda' shows every day in the selected range.
|
|
When nil, only the days which actually have entries are shown."
|
|
:group 'org-agenda-display
|
|
:type 'boolean)
|
|
|
|
(defcustom org-agenda-start-on-weekday 1
|
|
"Non-nil means, start the overview always on the specified weekday.
|
|
0 denotes Sunday, 1 denotes Monday etc.
|
|
When nil, always start on the current day."
|
|
:group 'org-agenda-display
|
|
:type '(choice (const :tag "Today" nil)
|
|
(number :tag "Weekday No.")))
|
|
|
|
(defcustom org-agenda-ndays 7
|
|
"Number of days to include in overview display.
|
|
Should be 1 or 7."
|
|
:group 'org-agenda-display
|
|
:type 'number)
|
|
|
|
(defcustom org-agenda-use-time-grid t
|
|
"Non-nil means, show a time grid in the agenda schedule.
|
|
A time grid is a set of lines for specific times (like every two hours between
|
|
8:00 and 20:00). The items scheduled for a day at specific times are
|
|
sorted in between these lines.
|
|
For details about when the grid will be shown, and what it will look like, see
|
|
the variable `org-agenda-time-grid'."
|
|
:group 'org-agenda-display
|
|
:type 'boolean)
|
|
|
|
(defcustom org-agenda-time-grid
|
|
'((daily today require-timed)
|
|
"----------------"
|
|
(800 1000 1200 1400 1600 1800 2000))
|
|
|
|
"The settings for time grid for agenda display.
|
|
This is a list of three items. The first item is again a list. It contains
|
|
symbols specifying conditions when the grid should be displayed:
|
|
|
|
daily if the agenda shows a single day
|
|
weekly if the agenda shows an entire week
|
|
today show grid on current date, independent of daily/weekly display
|
|
require-timed show grid only if at least on item has a time specification
|
|
|
|
The second item is a string which will be places behing the grid time.
|
|
|
|
The third item is a list of integers, indicating the times that should have
|
|
a grid line."
|
|
:group 'org-agenda-display
|
|
:type
|
|
'(list
|
|
(set :greedy t :tag "Grid Display Options"
|
|
(const :tag "Show grid in single day agenda display" daily)
|
|
(const :tag "Show grid in weekly agenda display" weekly)
|
|
(const :tag "Always show grid for today" today)
|
|
(const :tag "Show grid only if any timed entries are present"
|
|
require-timed)
|
|
(const :tag "Skip grid times already present in an entry"
|
|
remove-match))
|
|
(string :tag "Grid String")
|
|
(repeat :tag "Grid Times" (integer :tag "Time"))))
|
|
|
|
(defcustom org-agenda-sorting-strategy '(time-up category-keep priority-down)
|
|
"Sorting structure for the agenda items of a single day.
|
|
This is a list of symbols which will be used in sequence to determine
|
|
if an entry should be listed before another entry. The following
|
|
symbols are recognized:
|
|
|
|
time-up Put entries with time-of-day indications first, early first
|
|
time-down Put entries with time-of-day indications first, late first
|
|
category-keep Keep the default order of categories, corresponding to the
|
|
sequence in `org-agenda-files'.
|
|
category-up Sort alphabetically by category, A-Z.
|
|
category-down Sort alphabetically by category, Z-A.
|
|
priority-up Sort numerically by priority, high priority last.
|
|
priority-down Sort numerically by priority, high priority first.
|
|
|
|
The different possibilities will be tried in sequence, and testing stops
|
|
if one comparison returns a \"not-equal\". For example, the default
|
|
'(time-up category-keep priority-down)
|
|
means: Pull out all entries having a specified time of day and sort them,
|
|
in order to make a time schedule for the current day the first thing in the
|
|
agenda listing for the day. Of the entries without a time indication, keep
|
|
the grouped in categories, don't sort the categories, but keep them in
|
|
the sequence given in `org-agenda-files'. Within each category sort by
|
|
priority.
|
|
|
|
Leaving out `category-keep' would mean that items will be sorted across
|
|
categories by priority."
|
|
:group 'org-agenda-display
|
|
:type '(repeat
|
|
(choice
|
|
(const time-up)
|
|
(const time-down)
|
|
(const category-keep)
|
|
(const category-up)
|
|
(const category-down)
|
|
(const priority-up)
|
|
(const priority-down))))
|
|
|
|
(defcustom org-sort-agenda-notime-is-late t
|
|
"Non-nil means, items without time are considered late.
|
|
This is only relevant for sorting. When t, items which have no explicit
|
|
time like 15:30 will be considered as 24:01, i.e. later than any items which
|
|
do have a time. When nil, the default time is before 0:00. You can use this
|
|
option to decide if the schedule for today should come before or after timeless
|
|
agenda entries."
|
|
:group 'org-agenda-display
|
|
:type 'boolean)
|
|
|
|
|
|
(defgroup org-agenda-prefix nil
|
|
"Options concerning the entry prefix in the Org-mode agenda display."
|
|
:tag "Org Agenda Prefix"
|
|
:group 'org-agenda)
|
|
|
|
(defcustom org-agenda-prefix-format " %-12:c%?-12t% s"
|
|
"Format specification for the prefix of items in the agenda buffer.
|
|
This format works similar to a printf format, with the following meaning:
|
|
|
|
%c the category of the item, \"Diary\" for entries from the diary, or
|
|
as given by the CATEGORY keyword or derived from the file name.
|
|
%T the first tag of the item.
|
|
%t the time-of-day specification if one applies to the entry, in the
|
|
format HH:MM
|
|
%s Scheduling/Deadline information, a short string
|
|
|
|
All specifiers work basically like the standard `%s' of printf, but may
|
|
contain two additional characters: A question mark just after the `%' and
|
|
a whitespace/punctuation character just before the final letter.
|
|
|
|
If the first character after `%' is a question mark, the entire field
|
|
will only be included if the corresponding value applies to the
|
|
current entry. This is useful for fields which should have fixed
|
|
width when present, but zero width when absent. For example,
|
|
\"%?-12t\" will result in a 12 character time field if a time of the
|
|
day is specified, but will completely disappear in entries which do
|
|
not contain a time.
|
|
|
|
If there is punctuation or whitespace character just before the final
|
|
format letter, this character will be appended to the field value if
|
|
the value is not empty. For example, the format \"%-12:c\" leads to
|
|
\"Diary: \" if the category is \"Diary\". If the category were be
|
|
empty, no additional colon would be interted.
|
|
|
|
The default value of this option is \" %-12:c%?-12t% s\", meaning:
|
|
- Indent the line with two space characters
|
|
- Give the category in a 12 chars wide field, padded with whitespace on
|
|
the right (because of `-'). Append a colon if there is a category
|
|
(because of `:').
|
|
- If there is a time-of-day, put it into a 12 chars wide field. If no
|
|
time, don't put in an empty field, just skip it (because of '?').
|
|
- Finally, put the scheduling information and append a whitespace.
|
|
|
|
As another example, if you don't want the time-of-day of entries in
|
|
the prefix, you could use:
|
|
|
|
(setq org-agenda-prefix-format \" %-11:c% s\")
|
|
|
|
See also the variables `org-agenda-remove-times-when-in-prefix' and
|
|
`org-agenda-remove-tags-when-in-prefix'."
|
|
:type 'string
|
|
:group 'org-agenda-prefix)
|
|
|
|
(defcustom org-timeline-prefix-format " % s"
|
|
"Like `org-agenda-prefix-format', but for the timeline of a single file."
|
|
:type 'string
|
|
:group 'org-agenda-prefix)
|
|
|
|
(defvar org-prefix-format-compiled nil
|
|
"The compiled version of the most recently used prefix format.
|
|
Depending on which command was used last, this may be the compiled version
|
|
of `org-agenda-prefix-format' or `org-timeline-prefix-format'.")
|
|
|
|
;; FIXME: There seem to be situations where this does no work.
|
|
(defcustom org-agenda-remove-times-when-in-prefix t
|
|
"Non-nil means, remove duplicate time specifications in agenda items.
|
|
When the format `org-agenda-prefix-format' contains a `%t' specifier, a
|
|
time-of-day specification in a headline or diary entry is extracted and
|
|
placed into the prefix. If this option is non-nil, the original specification
|
|
\(a timestamp or -range, or just a plain time(range) specification like
|
|
11:30-4pm) will be removed for agenda display. This makes the agenda less
|
|
cluttered.
|
|
The option can be t or nil. It may also be the symbol `beg', indicating
|
|
that the time should only be removed what it is located at the beginning of
|
|
the headline/diary entry."
|
|
:group 'org-agenda-prefix
|
|
:type '(choice
|
|
(const :tag "Always" t)
|
|
(const :tag "Never" nil)
|
|
(const :tag "When at beginning of entry" beg)))
|
|
|
|
(defcustom org-agenda-remove-tags-when-in-prefix nil
|
|
"Non-nil means, remove the tags from the headline copy in the agenda.
|
|
When this is the symbol `prefix', only remove tags when
|
|
`org-agenda-prefix-format' contains a `%T' specifier."
|
|
:group 'org-agenda-prefix
|
|
:type '(choice
|
|
(const :tag "Always" t)
|
|
(const :tag "Never" nil)
|
|
(const :tag "When prefix format contains %T" prefix)))
|
|
|
|
(defgroup org-export nil
|
|
"Options for exporting org-listings."
|
|
:tag "Org Export"
|
|
:group 'org)
|
|
|
|
(defgroup org-export-general nil
|
|
"General options for exporting Org-mode files."
|
|
:tag "Org Export General"
|
|
:group 'org-export)
|
|
|
|
(defcustom org-export-publishing-directory "."
|
|
"Path to the location where exported files should be located.
|
|
This path may be relative to the directory where the Org-mode file lives.
|
|
The default is to put them into the same directory as the Org-mode file."
|
|
:group 'org-export-general
|
|
:type 'directory)
|
|
|
|
(defcustom org-export-language-setup
|
|
'(("en" "Author" "Date" "Table of Contents")
|
|
("da" "Ophavsmand" "Dato" "Indhold")
|
|
("de" "Autor" "Datum" "Inhaltsverzeichnis")
|
|
("es" "Autor" "Fecha" "\xccndice")
|
|
("fr" "Auteur" "Date" "Table des Mati\xe8res")
|
|
("it" "Autore" "Data" "Indice")
|
|
("nl" "Auteur" "Datum" "Inhoudsopgave")
|
|
("nn" "Forfattar" "Dato" "Innhold") ;; nn = Norsk (nynorsk)
|
|
("sv" "F\xf6rfattarens" "Datum" "Inneh\xe5ll"))
|
|
"Terms used in export text, translated to different languages.
|
|
Use the variable `org-export-default-language' to set the language,
|
|
or use the +OPTION lines for a per-file setting."
|
|
:group 'org-export-general
|
|
:type '(repeat
|
|
(list
|
|
(string :tag "HTML language tag")
|
|
(string :tag "Author")
|
|
(string :tag "Date")
|
|
(string :tag "Table of Contents"))))
|
|
|
|
(defcustom org-export-default-language "en"
|
|
"The default language of HTML export, as a string.
|
|
This should have an association in `org-export-language-setup'."
|
|
:group 'org-export-general
|
|
:type 'string)
|
|
|
|
(defcustom org-export-headline-levels 3
|
|
"The last level which is still exported as a headline.
|
|
Inferior levels will produce itemize lists when exported.
|
|
Note that a numeric prefix argument to an exporter function overrides
|
|
this setting.
|
|
|
|
This option can also be set with the +OPTIONS line, e.g. \"H:2\"."
|
|
:group 'org-export-general
|
|
:type 'number)
|
|
|
|
(defcustom org-export-with-section-numbers t
|
|
"Non-nil means, add section numbers to headlines when exporting.
|
|
|
|
This option can also be set with the +OPTIONS line, e.g. \"num:t\"."
|
|
:group 'org-export-general
|
|
:type 'boolean)
|
|
|
|
(defcustom org-export-with-toc t
|
|
"Non-nil means, create a table of contents in exported files.
|
|
The TOC contains headlines with levels up to`org-export-headline-levels'.
|
|
|
|
Headlines which contain any TODO items will be marked with \"(*)\" in
|
|
ASCII export, and with red color in HTML output.
|
|
|
|
In HTML output, the TOC will be clickable.
|
|
|
|
This option can also be set with the +OPTIONS line, e.g. \"toc:nil\"."
|
|
:group 'org-export-general
|
|
:type 'boolean)
|
|
|
|
(defcustom org-export-mark-todo-in-toc nil
|
|
"Non-nil means, mark TOC lines that contain any open TODO items."
|
|
:group 'org-export-general
|
|
:type 'boolean)
|
|
|
|
(defcustom org-export-preserve-breaks nil
|
|
"Non-nil means, preserve all line breaks when exporting.
|
|
Normally, in HTML output paragraphs will be reformatted. In ASCII
|
|
export, line breaks will always be preserved, regardless of this variable.
|
|
|
|
This option can also be set with the +OPTIONS line, e.g. \"\\n:t\"."
|
|
:group 'org-export-general
|
|
:type 'boolean)
|
|
|
|
(defcustom org-export-with-timestamps t
|
|
"Nil means, do not export time stamps and associated keywords."
|
|
:group 'org-export
|
|
:type 'boolean)
|
|
|
|
(defcustom org-export-with-tags t
|
|
"Nil means, do not export tags, just remove them from headlines."
|
|
:group 'org-export-general
|
|
:type 'boolean)
|
|
|
|
(defcustom org-export-with-timestamps t
|
|
"Nil means, do not export timestamps and associated keywords."
|
|
:group 'org-export-general
|
|
:type 'boolean)
|
|
|
|
(defgroup org-export-translation nil
|
|
"Options for translating special ascii sequences for the export backends."
|
|
:tag "Org Export Translation"
|
|
:group 'org-export)
|
|
|
|
(defcustom org-export-with-emphasize t
|
|
"Non-nil means, interpret *word*, /word/, and _word_ as emphasized text.
|
|
If the export target supports emphasizing text, the word will be
|
|
typeset in bold, italic, or underlined, respectively. Works only for
|
|
single words, but you can say: I *really* *mean* *this*.
|
|
Not all export backends support this.
|
|
|
|
This option can also be set with the +OPTIONS line, e.g. \"*:nil\"."
|
|
:group 'org-export-translation
|
|
:type 'boolean)
|
|
|
|
(defcustom org-export-with-sub-superscripts t
|
|
"Non-nil means, interpret \"_\" and \"^\" for export.
|
|
When this option is turned on, you can use TeX-like syntax for sub- and
|
|
superscripts. Several characters after \"_\" or \"^\" will be
|
|
considered as a single item - so grouping with {} is normally not
|
|
needed. For example, the following things will be parsed as single
|
|
sub- or superscripts.
|
|
|
|
10^24 or 10^tau several digits will be considered 1 item.
|
|
10^-12 or 10^-tau a leading sign with digits or a word
|
|
x^2-y^3 will be read as x^2 - y^3, because items are
|
|
terminated by almost any nonword/nondigit char.
|
|
x_{i^2} or x^(2-i) braces or parenthesis do grouping.
|
|
|
|
Still, ambiguity is possible - so when in doubt use {} to enclose the
|
|
sub/superscript.
|
|
Not all export backends support this, but HTML does.
|
|
|
|
This option can also be set with the +OPTIONS line, e.g. \"^:nil\"."
|
|
:group 'org-export-translation
|
|
:type 'boolean)
|
|
|
|
(defcustom org-export-with-TeX-macros t
|
|
"Non-nil means, interpret simple TeX-like macros when exporting.
|
|
For example, HTML export converts \\alpha to α and \\AA to Å.
|
|
No only real TeX macros will work here, but the standard HTML entities
|
|
for math can be used as macro names as well. For a list of supported
|
|
names in HTML export, see the constant `org-html-entities'.
|
|
Not all export backends support this.
|
|
|
|
This option can also be set with the +OPTIONS line, e.g. \"TeX:nil\"."
|
|
:group 'org-export-translation
|
|
:type 'boolean)
|
|
|
|
(defcustom org-export-with-fixed-width t
|
|
"Non-nil means, lines starting with \":\" will be in fixed width font.
|
|
This can be used to have pre-formatted text, fragments of code etc. For
|
|
example:
|
|
: ;; Some Lisp examples
|
|
: (while (defc cnt)
|
|
: (ding))
|
|
will be looking just like this in also HTML. See also the QUOTE keyword.
|
|
Not all export backends support this.
|
|
|
|
This option can also be set with the +OPTIONS line, e.g. \"::nil\"."
|
|
:group 'org-export-translation
|
|
:type 'boolean)
|
|
|
|
(defcustom org-match-sexp-depth 3
|
|
"Number of stacked braces for sub/superscript matching.
|
|
This has to be set before loading org.el to be effective."
|
|
:group 'org-export-translation
|
|
:type 'integer)
|
|
|
|
(defgroup org-export-tables nil
|
|
"Options for exporting tables in Org-mode."
|
|
:tag "Org Export Tables"
|
|
:group 'org-export)
|
|
|
|
(defcustom org-export-with-tables t
|
|
"If non-nil, lines starting with \"|\" define a table.
|
|
For example:
|
|
|
|
| Name | Address | Birthday |
|
|
|-------------+----------+-----------|
|
|
| Arthur Dent | England | 29.2.2100 |
|
|
|
|
Not all export backends support this.
|
|
|
|
This option can also be set with the +OPTIONS line, e.g. \"|:nil\"."
|
|
:group 'org-export-tables
|
|
:type 'boolean)
|
|
|
|
(defcustom org-export-highlight-first-table-line t
|
|
"Non-nil means, highlight the first table line.
|
|
In HTML export, this means use <th> instead of <td>.
|
|
In tables created with table.el, this applies to the first table line.
|
|
In Org-mode tables, all lines before the first horizontal separator
|
|
line will be formatted with <th> tags."
|
|
:group 'org-export-tables
|
|
:type 'boolean)
|
|
|
|
(defcustom org-export-table-remove-special-lines t
|
|
"Remove special lines and marking characters in calculating tables.
|
|
This removes the special marking character column from tables that are set
|
|
up for spreadsheet calculations. It also removes the entire lines
|
|
marked with `!', `_', or `^'. The lines with `$' are kept, because
|
|
the values of constants may be useful to have."
|
|
:group 'org-export-tables
|
|
:type 'boolean)
|
|
|
|
(defcustom org-export-prefer-native-exporter-for-tables nil
|
|
"Non-nil means, always export tables created with table.el natively.
|
|
Natively means, use the HTML code generator in table.el.
|
|
When nil, Org-mode's own HTML generator is used when possible (i.e. if
|
|
the table does not use row- or column-spanning). This has the
|
|
advantage, that the automatic HTML conversions for math symbols and
|
|
sub/superscripts can be applied. Org-mode's HTML generator is also
|
|
much faster."
|
|
:group 'org-export-tables
|
|
:type 'boolean)
|
|
|
|
(defgroup org-export-ascii nil
|
|
"Options specific for ASCII export of Org-mode files."
|
|
:tag "Org Export ASCII"
|
|
:group 'org-export)
|
|
|
|
(defcustom org-export-ascii-show-new-buffer t
|
|
"Non-nil means, popup buffer containing the exported ASCII text.
|
|
Otherwise the buffer will just be saved to a file and stay hidden."
|
|
:group 'org-export-ascii
|
|
:type 'boolean)
|
|
|
|
(defgroup org-export-xml nil
|
|
"Options specific for XML export of Org-mode files."
|
|
:tag "Org Export XML"
|
|
:group 'org-export)
|
|
|
|
;; FIXME: I am told XOXO is not XML, it is semantic-only HTML.
|
|
|
|
(defcustom org-export-xml-type 'xoxo ;kw, if we have only one.
|
|
"The kind of XML to be produced by the XML exporter.
|
|
Allowed values are:
|
|
xoxo The XOXO exporter."
|
|
:group 'org-export-xml
|
|
:type '(choice
|
|
(const :tag "XOXO" xoxo)))
|
|
|
|
(defgroup org-export-html nil
|
|
"Options specific for HTML export of Org-mode files."
|
|
:tag "Org Export HTML"
|
|
:group 'org-export)
|
|
|
|
(defcustom org-export-html-style
|
|
"<style type=\"text/css\">
|
|
html {
|
|
font-family: Times, serif;
|
|
font-size: 12pt;
|
|
}
|
|
.title { text-align: center; }
|
|
.todo { color: red; }
|
|
.done { color: green; }
|
|
.timestamp { color: grey }
|
|
.timestamp-kwd { color: CadetBlue }
|
|
.tag { background-color:lightblue; font-weight:normal }
|
|
.target { background-color: lavender; }
|
|
pre {
|
|
border: 1pt solid #AEBDCC;
|
|
background-color: #F3F5F7;
|
|
padding: 5pt;
|
|
font-family: courier, monospace;
|
|
}
|
|
table { border-collapse: collapse; }
|
|
td, th {
|
|
vertical-align: top;
|
|
border: 1pt solid #ADB9CC;
|
|
}
|
|
</style>"
|
|
"The default style specification for exported HTML files.
|
|
Since there are different ways of setting style information, this variable
|
|
needs to contain the full HTML structure to provide a style, including the
|
|
surrounding HTML tags. The style specifications should include definitions
|
|
for new classes todo, done, title, and deadline. For example, legal values
|
|
would be:
|
|
|
|
<style type=\"text/css\">
|
|
p { font-weight: normal; color: gray; }
|
|
h1 { color: black; }
|
|
.title { text-align: center; }
|
|
.todo, .deadline { color: red; }
|
|
.done { color: green; }
|
|
</style>
|
|
|
|
or, if you want to keep the style in a file,
|
|
|
|
<link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\">
|
|
|
|
As the value of this option simply gets inserted into the HTML <head> header,
|
|
you can \"misuse\" it to add arbitrary text to the header."
|
|
:group 'org-export-html
|
|
:type 'string)
|
|
|
|
(defcustom org-export-html-link-org-files-as-html t
|
|
"Non-nil means, make file links to `file.org' point to `file.html'.
|
|
When org-mode is exporting an org-mode file to HTML, links to
|
|
non-html files are directly put into a href tag in HTML.
|
|
However, links to other Org-mode files (recognized by the
|
|
extension `.org.) should become links to the corresponding html
|
|
file, assuming that the linked org-mode file will also be
|
|
converted to HTML.
|
|
When nil, the links still point to the plain `.org' file."
|
|
:group 'org-export-html
|
|
:type 'boolean)
|
|
|
|
(defcustom org-export-html-inline-images 'maybe
|
|
"Non-nil means, inline images into exported HTML pages.
|
|
This is done using an <img> tag. When nil, an anchor with href is used to
|
|
link to the image. If this option is `maybe', then images in links with
|
|
an empty description will be inlined, while images with a description will
|
|
be linked only."
|
|
:group 'org-export-html
|
|
:type '(choice (const :tag "Never" nil)
|
|
(const :tag "Always" t)
|
|
(const :tag "When there is no description" maybe)))
|
|
|
|
(defcustom org-export-html-expand t
|
|
"Non-nil means, for HTML export, treat @<...> as HTML tag.
|
|
When nil, these tags will be exported as plain text and therefore
|
|
not be interpreted by a browser.
|
|
|
|
This option can also be set with the +OPTIONS line, e.g. \"@:nil\"."
|
|
:group 'org-export-html
|
|
:type 'boolean)
|
|
|
|
(defcustom org-export-html-table-tag
|
|
"<table border=1 cellspacing=0 cellpadding=6>"
|
|
"The HTML tag used to start a table.
|
|
This must be a <table> tag, but you may change the options like
|
|
borders and spacing."
|
|
:group 'org-export-html
|
|
:type 'string)
|
|
|
|
(defcustom org-export-html-with-timestamp nil
|
|
"If non-nil, write `org-export-html-html-helper-timestamp'
|
|
into the exported HTML text. Otherwise, the buffer will just be saved
|
|
to a file."
|
|
:group 'org-export-html
|
|
:type 'boolean)
|
|
|
|
(defcustom org-export-html-html-helper-timestamp
|
|
"<br><br><hr><p><!-- hhmts start --> <!-- hhmts end -->\n"
|
|
"The HTML tag used as timestamp delimiter for HTML-helper-mode."
|
|
:group 'org-export-html
|
|
:type 'string)
|
|
|
|
(defcustom org-export-html-show-new-buffer nil
|
|
"Non-nil means, popup buffer containing the exported html text.
|
|
Otherwise, the buffer will just be saved to a file and stay hidden."
|
|
:group 'org-export-html
|
|
:type 'boolean)
|
|
|
|
(defgroup org-export-icalendar nil
|
|
"Options specific for iCalendar export of Org-mode files."
|
|
:tag "Org Export iCalendar"
|
|
:group 'org-export)
|
|
|
|
(defcustom org-combined-agenda-icalendar-file "~/org.ics"
|
|
"The file name for the iCalendar file covering all agenda files.
|
|
This file is created with the command \\[org-export-icalendar-all-agenda-files]."
|
|
:group 'org-export-icalendar
|
|
:type 'file)
|
|
|
|
(defcustom org-icalendar-include-todo nil
|
|
"Non-nil means, export to iCalendar files should also cover TODO items."
|
|
:group 'org-export-icalendar
|
|
:type 'boolean)
|
|
|
|
(defcustom org-icalendar-combined-name "OrgMode"
|
|
"Calendar name for the combined iCalendar representing all agenda files."
|
|
:group 'org-export-icalendar
|
|
:type 'string)
|
|
|
|
(defgroup org-font-lock nil
|
|
"Font-lock settings for highlighting in Org-mode."
|
|
:tag "Org Font Lock"
|
|
:group 'org)
|
|
|
|
(defcustom org-level-color-stars-only nil
|
|
"Non-nil means fontify only the stars in each headline.
|
|
When nil, the entire headline is fontified.
|
|
Changing it requires restart of `font-lock-mode' to become effective
|
|
also in regions already fontified."
|
|
:group 'org-font-lock
|
|
:type 'boolean)
|
|
|
|
(defcustom org-hide-leading-stars nil
|
|
"Non-nil means, hide the first N-1 stars in a headline.
|
|
This works by using the face `org-hide' for these stars. This
|
|
face is white for a light background, and black for a dark
|
|
background. You may have to customize the face `org-hide' to
|
|
make this work.
|
|
Changing it requires restart of `font-lock-mode' to become effective
|
|
also in regions already fontified.
|
|
You may also set this on a per-file basis by adding one of the following
|
|
lines to the buffer:
|
|
|
|
#+STARTUP: hidestars
|
|
#+STARTUP: showstars"
|
|
:group 'org-font-lock
|
|
:type 'boolean)
|
|
|
|
(defcustom org-fontify-done-headline nil
|
|
"Non-nil means, change the face of a headline if it is marked DONE.
|
|
Normally, only the TODO/DONE keyword indicates the state of a headline.
|
|
When this is non-nil, the headline after the keyword is set to the
|
|
`org-headline-done' as an additional indication."
|
|
:group 'org-font-lock
|
|
:type 'boolean)
|
|
|
|
(defcustom org-fontify-emphasized-text t
|
|
"Non-nil means fontify *bold*, /italic/ and _underlined_ text.
|
|
Changing this variable requires a restart of Emacs to take effect."
|
|
:group 'org-font-lock
|
|
:type 'boolean)
|
|
|
|
(defgroup org-faces nil
|
|
"Faces in Org-mode."
|
|
:tag "Org Faces"
|
|
:group 'org-font-lock)
|
|
|
|
(defun org-compatible-face (specs)
|
|
"Make a compatible face specification.
|
|
XEmacs and Emacs 21 do not know about the `min-colors' attribute.
|
|
For them we convert a (min-colors 8) entry to a `tty' entry and move it
|
|
to the top of the list. The `min-colors' attribute will be removed from
|
|
any other entries, and any resulting duplicates will be removed entirely."
|
|
(if (or (featurep 'xemacs) (< emacs-major-version 22))
|
|
(let (r e a)
|
|
(while (setq e (pop specs))
|
|
(cond
|
|
((memq (car e) '(t default)) (push e r))
|
|
((setq a (member '(min-colors 8) (car e)))
|
|
(nconc r (list (cons (cons '(type tty) (delq (car a) (car e)))
|
|
(cdr e)))))
|
|
((setq a (assq 'min-colors (car e)))
|
|
(setq e (cons (delq a (car e)) (cdr e)))
|
|
(or (assoc (car e) r) (push e r)))
|
|
(t (or (assoc (car e) r) (push e r)))))
|
|
(nreverse r))
|
|
specs))
|
|
|
|
(defface org-hide
|
|
'((((background light)) (:foreground "white"))
|
|
(((background dark)) (:foreground "black")))
|
|
"Face used to hide leading stars in headlines.
|
|
The forground color of this face should be equal to the background
|
|
color of the frame."
|
|
:group 'org-faces)
|
|
|
|
(defface org-level-1 ;; font-lock-function-name-face
|
|
(org-compatible-face
|
|
'((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
|
|
(((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
|
|
(((class color) (min-colors 16) (background light)) (:foreground "Blue"))
|
|
(((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
|
|
(((class color) (min-colors 8)) (:foreground "blue" :bold t))
|
|
(t (:bold t))))
|
|
"Face used for level 1 headlines."
|
|
:group 'org-faces)
|
|
|
|
(defface org-level-2 ;; font-lock-variable-name-face
|
|
(org-compatible-face
|
|
'((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
|
|
(((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
|
|
(((class color) (min-colors 8) (background light)) (:foreground "yellow"))
|
|
(((class color) (min-colors 8) (background dark)) (:foreground "yellow" :bold t))
|
|
(t (:bold t))))
|
|
"Face used for level 2 headlines."
|
|
:group 'org-faces)
|
|
|
|
(defface org-level-3 ;; font-lock-keyword-face
|
|
(org-compatible-face
|
|
'((((class color) (min-colors 88) (background light)) (:foreground "Purple"))
|
|
(((class color) (min-colors 88) (background dark)) (:foreground "Cyan1"))
|
|
(((class color) (min-colors 16) (background light)) (:foreground "Purple"))
|
|
(((class color) (min-colors 16) (background dark)) (:foreground "Cyan"))
|
|
(((class color) (min-colors 8) (background light)) (:foreground "purple" :bold t))
|
|
(((class color) (min-colors 8) (background dark)) (:foreground "cyan" :bold t))
|
|
(t (:bold t))))
|
|
"Face used for level 3 headlines."
|
|
:group 'org-faces)
|
|
|
|
(defface org-level-4 ;; font-lock-comment-face
|
|
(org-compatible-face
|
|
'((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
|
|
(((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
|
|
(((class color) (min-colors 16) (background light)) (:foreground "red"))
|
|
(((class color) (min-colors 16) (background dark)) (:foreground "red1"))
|
|
(((class color) (min-colors 8) (background light)) (:foreground "red" :bold t))
|
|
(((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
|
|
(t (:bold t))))
|
|
"Face used for level 4 headlines."
|
|
:group 'org-faces)
|
|
|
|
(defface org-level-5 ;; font-lock-type-face
|
|
(org-compatible-face
|
|
'((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen"))
|
|
(((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen"))
|
|
(((class color) (min-colors 8)) (:foreground "green"))))
|
|
"Face used for level 5 headlines."
|
|
:group 'org-faces)
|
|
|
|
(defface org-level-6 ;; font-lock-constant-face
|
|
(org-compatible-face
|
|
'((((class color) (min-colors 16) (background light)) (:foreground "CadetBlue"))
|
|
(((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine"))
|
|
(((class color) (min-colors 8)) (:foreground "magenta"))))
|
|
"Face used for level 6 headlines."
|
|
:group 'org-faces)
|
|
|
|
(defface org-level-7 ;; font-lock-builtin-face
|
|
(org-compatible-face
|
|
'((((class color) (min-colors 16) (background light)) (:foreground "Orchid"))
|
|
(((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue"))
|
|
(((class color) (min-colors 8)) (:foreground "blue")))) ;; FIXME: for dark bg?
|
|
"Face used for level 7 headlines."
|
|
:group 'org-faces)
|
|
|
|
(defface org-level-8 ;; font-lock-string-face
|
|
(org-compatible-face
|
|
'((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
|
|
(((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
|
|
(((class color) (min-colors 8)) (:foreground "green"))))
|
|
"Face used for level 8 headlines."
|
|
:group 'org-faces)
|
|
|
|
(defface org-special-keyword ;; font-lock-string-face
|
|
(org-compatible-face
|
|
'((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
|
|
(((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
|
|
(t (:italic t))))
|
|
"Face used for special keywords."
|
|
:group 'org-faces)
|
|
|
|
(defface org-warning ;; font-lock-warning-face
|
|
(org-compatible-face
|
|
'((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t))
|
|
(((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t))
|
|
(((class color) (min-colors 8) (background light)) (:foreground "red" :bold t))
|
|
(((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
|
|
(t (:bold t))))
|
|
"Face for deadlines and TODO keywords."
|
|
:group 'org-faces)
|
|
|
|
(defface org-headline-done ;; font-lock-string-face
|
|
(org-compatible-face
|
|
'((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
|
|
(((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
|
|
(((class color) (min-colors 8) (background light)) (:bold nil))))
|
|
"Face used to indicate that a headline is DONE.
|
|
This face is only used if `org-fontify-done-headline' is set."
|
|
:group 'org-faces)
|
|
|
|
(defface org-link
|
|
'((((class color) (background light)) (:foreground "Purple" :underline t))
|
|
(((class color) (background dark)) (:foreground "Cyan" :underline t))
|
|
(t (:underline t)))
|
|
"Face for links."
|
|
:group 'org-faces)
|
|
|
|
(defface org-date
|
|
'((((class color) (background light)) (:foreground "Purple" :underline t))
|
|
(((class color) (background dark)) (:foreground "Cyan" :underline t))
|
|
(t (:underline t)))
|
|
"Face for links."
|
|
:group 'org-faces)
|
|
|
|
(defface org-tag
|
|
'((t (:bold t)))
|
|
"Face for tags."
|
|
:group 'org-faces)
|
|
|
|
(defface org-todo ;; font-lock-warning-face
|
|
(org-compatible-face
|
|
'((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t))
|
|
(((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t))
|
|
(((class color) (min-colors 8) (background light)) (:foreground "red" :bold t))
|
|
(((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
|
|
(t (:inverse-video t :bold t))))
|
|
"Face for TODO keywords."
|
|
:group 'org-faces)
|
|
|
|
(defface org-done ;; font-lock-type-face
|
|
(org-compatible-face
|
|
'((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen"))
|
|
(((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen"))
|
|
(((class color) (min-colors 8)) (:foreground "green"))
|
|
(t (:bold t))))
|
|
"Face used for DONE."
|
|
:group 'org-faces)
|
|
|
|
(defface org-table ;; font-lock-function-name-face
|
|
(org-compatible-face
|
|
'((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
|
|
(((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
|
|
(((class color) (min-colors 16) (background light)) (:foreground "Blue"))
|
|
(((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
|
|
(((class color) (min-colors 8) (background light)) (:foreground "blue"))
|
|
(((class color) (min-colors 8) (background dark)))))
|
|
"Face used for tables."
|
|
:group 'org-faces)
|
|
|
|
(defface org-formula
|
|
(org-compatible-face
|
|
'((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
|
|
(((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
|
|
(((class color) (min-colors 8) (background light)) (:foreground "red"))
|
|
(((class color) (min-colors 8) (background dark)) (:foreground "red"))
|
|
(t (:bold t :italic t))))
|
|
"Face for formulas."
|
|
:group 'org-faces)
|
|
|
|
(defface org-scheduled-today
|
|
(org-compatible-face
|
|
'((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen"))
|
|
(((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen"))
|
|
(((class color) (min-colors 8)) (:foreground "green"))
|
|
(t (:bold t :italic t))))
|
|
"Face for items scheduled for a certain day."
|
|
:group 'org-faces)
|
|
|
|
(defface org-scheduled-previously
|
|
(org-compatible-face
|
|
'((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
|
|
(((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
|
|
(((class color) (min-colors 8) (background light)) (:foreground "red"))
|
|
(((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
|
|
(t (:bold t))))
|
|
"Face for items scheduled previously, and not yet done."
|
|
:group 'org-faces)
|
|
|
|
(defface org-time-grid ;; font-lock-variable-name-face
|
|
(org-compatible-face
|
|
'((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
|
|
(((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
|
|
(((class color) (min-colors 8)) (:foreground "yellow" :weight light)))) ; FIXME: turn off???
|
|
"Face used for time grids."
|
|
:group 'org-faces)
|
|
|
|
(defconst org-level-faces
|
|
'(org-level-1 org-level-2 org-level-3 org-level-4
|
|
org-level-5 org-level-6 org-level-7 org-level-8
|
|
))
|
|
(defconst org-n-levels (length org-level-faces))
|
|
|
|
(defconst org-bold-re
|
|
(if (featurep 'xemacs)
|
|
"\\([ ]\\|^\\)\\(\\*\\(\\w[a-zA-Z0-9-_ ]*?\\w\\)\\*\\)\\([ ,.]\\|$\\)"
|
|
"\\([ ]\\|^\\)\\(\\*\\(\\w[[:word:] -_]*?\\w\\)\\*\\)\\([ ,.]\\|$\\)")
|
|
"Regular expression for bold emphasis.")
|
|
(defconst org-italic-re
|
|
(if (featurep 'xemacs)
|
|
"\\([ ]\\|^\\)\\(/\\(\\w[a-zA-Z0-9-_ ]*?\\w\\)/\\)\\([ ,.]\\|$\\)"
|
|
"\\([ ]\\|^\\)\\(/\\(\\w[[:word:] -_]*?\\w\\)/\\)\\([ ,.]\\|$\\)")
|
|
"Regular expression for italic emphasis.")
|
|
(defconst org-underline-re
|
|
(if (featurep 'xemacs)
|
|
"\\([ ]\\|^\\)\\(_\\(\\w[a-zA-Z0-9-_ ]*?\\w\\)_\\)\\([ ,.]\\|$\\)"
|
|
"\\([ ]\\|^\\)\\(_\\(\\w[[:word:] -_]*?\\w\\)_\\)\\([ ,.]\\|$\\)")
|
|
"Regular expression for underline emphasis.")
|
|
|
|
;; Variables for pre-computed regular expressions, all buffer local
|
|
(defvar org-done-string nil
|
|
"The last string in `org-todo-keywords', indicating an item is DONE.")
|
|
(make-variable-buffer-local 'org-done-string)
|
|
(defvar org-todo-regexp nil
|
|
"Matches any of the TODO state keywords.")
|
|
(make-variable-buffer-local 'org-todo-regexp)
|
|
(defvar org-not-done-regexp nil
|
|
"Matches any of the TODO state keywords except the last one.")
|
|
(make-variable-buffer-local 'org-not-done-regexp)
|
|
(defvar org-todo-line-regexp nil
|
|
"Matches a headline and puts TODO state into group 2 if present.")
|
|
(make-variable-buffer-local 'org-todo-line-regexp)
|
|
(defvar org-nl-done-regexp nil
|
|
"Matches newline followed by a headline with the DONE keyword.")
|
|
(make-variable-buffer-local 'org-nl-done-regexp)
|
|
(defvar org-looking-at-done-regexp nil
|
|
"Matches the DONE keyword a point.")
|
|
(make-variable-buffer-local 'org-looking-at-done-regexp)
|
|
(defvar org-todo-kwd-priority-p nil
|
|
"Do TODO items have priorities?")
|
|
(make-variable-buffer-local 'org-todo-kwd-priority-p)
|
|
(defvar org-todo-kwd-max-priority nil
|
|
"Maximum priority of TODO items.")
|
|
(make-variable-buffer-local 'org-todo-kwd-max-priority)
|
|
(defvar org-ds-keyword-length 12
|
|
"Maximum length of the Deadline and SCHEDULED keywords.")
|
|
(make-variable-buffer-local 'org-ds-keyword-length)
|
|
(defvar org-deadline-regexp nil
|
|
"Matches the DEADLINE keyword.")
|
|
(make-variable-buffer-local 'org-deadline-regexp)
|
|
(defvar org-deadline-time-regexp nil
|
|
"Matches the DEADLINE keyword together with a time stamp.")
|
|
(make-variable-buffer-local 'org-deadline-time-regexp)
|
|
(defvar org-deadline-line-regexp nil
|
|
"Matches the DEADLINE keyword and the rest of the line.")
|
|
(make-variable-buffer-local 'org-deadline-line-regexp)
|
|
(defvar org-scheduled-regexp nil
|
|
"Matches the SCHEDULED keyword.")
|
|
(make-variable-buffer-local 'org-scheduled-regexp)
|
|
(defvar org-scheduled-time-regexp nil
|
|
"Matches the SCHEDULED keyword together with a time stamp.")
|
|
(make-variable-buffer-local 'org-scheduled-time-regexp)
|
|
(defvar org-closed-time-regexp nil
|
|
"Matches the CLOSED keyword together with a time stamp.")
|
|
(make-variable-buffer-local 'org-closed-time-regexp)
|
|
|
|
(defvar org-keyword-time-regexp nil
|
|
"Matches any of the 3 keywords, together with the time stamp.")
|
|
(make-variable-buffer-local 'org-keyword-time-regexp)
|
|
(defvar org-maybe-keyword-time-regexp nil
|
|
"Matches a timestamp, possibly preceeded by a keyword.")
|
|
(make-variable-buffer-local 'org-keyword-time-regexp)
|
|
|
|
(defun org-set-regexps-and-options ()
|
|
"Precompute regular expressions for current buffer."
|
|
(when (eq major-mode 'org-mode)
|
|
(let ((re (org-make-options-regexp
|
|
'("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO"
|
|
"STARTUP" "ARCHIVE")))
|
|
(splitre "[ \t]+")
|
|
kwds int key value cat arch)
|
|
(save-excursion
|
|
(save-restriction
|
|
(widen)
|
|
(goto-char (point-min))
|
|
(while (re-search-forward re nil t)
|
|
(setq key (match-string 1) value (match-string 2))
|
|
(cond
|
|
((equal key "CATEGORY")
|
|
(if (string-match "[ \t]+$" value)
|
|
(setq value (replace-match "" t t value)))
|
|
(setq cat (intern value)))
|
|
((equal key "SEQ_TODO")
|
|
(setq int 'sequence
|
|
kwds (append kwds (org-split-string value splitre))))
|
|
((equal key "PRI_TODO")
|
|
(setq int 'priority
|
|
kwds (append kwds (org-split-string value splitre))))
|
|
((equal key "TYP_TODO")
|
|
(setq int 'type
|
|
kwds (append kwds (org-split-string value splitre))))
|
|
((equal key "STARTUP")
|
|
(let ((opts (org-split-string value splitre))
|
|
(set '(("fold" org-startup-folded t)
|
|
("overview" org-startup-folded t)
|
|
("nofold" org-startup-folded nil)
|
|
("showall" org-startup-folded nil)
|
|
("content" org-startup-folded content)
|
|
("hidestars" org-hide-leading-stars t)
|
|
("showstars" org-hide-leading-stars nil)
|
|
("odd" org-odd-levels-only t)
|
|
("oddeven" org-odd-levels-only nil)
|
|
("align" org-startup-align-all-tables t)
|
|
("noalign" org-startup-align-all-tables nil)
|
|
("logging" org-log-done t)
|
|
("nologging" org-log-done nil)
|
|
("dlcheck" org-startup-with-deadline-check t)
|
|
("nodlcheck" org-startup-with-deadline-check nil)))
|
|
l var val)
|
|
(while (setq l (assoc (pop opts) set))
|
|
(setq var (nth 1 l) val (nth 2 l))
|
|
(set (make-local-variable var) val))))
|
|
((equal key "ARCHIVE")
|
|
(string-match " *$" value)
|
|
(setq arch (replace-match "" t t value))
|
|
(remove-text-properties 0 (length arch)
|
|
'(face t fontified t) arch)))
|
|
)))
|
|
(and cat (set (make-local-variable 'org-category) cat))
|
|
(and kwds (set (make-local-variable 'org-todo-keywords) kwds))
|
|
(and arch (set (make-local-variable 'org-archive-location) arch))
|
|
(and int (set (make-local-variable 'org-todo-interpretation) int)))
|
|
;; Compute the regular expressions and other local variables
|
|
(setq org-todo-kwd-priority-p (equal org-todo-interpretation 'priority)
|
|
org-todo-kwd-max-priority (1- (length org-todo-keywords))
|
|
org-ds-keyword-length (+ 2 (max (length org-deadline-string)
|
|
(length org-scheduled-string)))
|
|
org-done-string
|
|
(nth (1- (length org-todo-keywords)) org-todo-keywords)
|
|
org-todo-regexp
|
|
(concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords
|
|
"\\|") "\\)\\>")
|
|
org-not-done-regexp
|
|
(concat "\\<\\("
|
|
(mapconcat 'regexp-quote
|
|
(nreverse (cdr (reverse org-todo-keywords)))
|
|
"\\|")
|
|
"\\)\\>")
|
|
org-todo-line-regexp
|
|
(concat "^\\(\\*+\\)[ \t]*\\("
|
|
(mapconcat 'regexp-quote org-todo-keywords "\\|")
|
|
"\\)? *\\(.*\\)")
|
|
org-nl-done-regexp
|
|
(concat "[\r\n]\\*+[ \t]+" org-done-string "\\>")
|
|
org-looking-at-done-regexp (concat "^" org-done-string "\\>")
|
|
org-deadline-regexp (concat "\\<" org-deadline-string)
|
|
org-deadline-time-regexp
|
|
(concat "\\<" org-deadline-string " *<\\([^>]+\\)>")
|
|
org-deadline-line-regexp
|
|
(concat "\\<\\(" org-deadline-string "\\).*")
|
|
org-scheduled-regexp
|
|
(concat "\\<" org-scheduled-string)
|
|
org-scheduled-time-regexp
|
|
(concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")
|
|
org-closed-time-regexp
|
|
(concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]")
|
|
org-keyword-time-regexp
|
|
(concat "\\<\\(" org-scheduled-string
|
|
"\\|" org-deadline-string
|
|
"\\|" org-closed-string "\\)"
|
|
" *[[<]\\([^]>]+\\)[]>]") ;; FIXME: is this correct?
|
|
org-maybe-keyword-time-regexp
|
|
(concat "\\(\\<\\(" org-scheduled-string
|
|
"\\|" org-deadline-string
|
|
"\\|" org-closed-string "\\)\\)?"
|
|
" *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^]\r\n>]*?[]>]\\)")) ;; FIXME: is this correct?
|
|
|
|
(org-set-font-lock-defaults)))
|
|
|
|
;; Tell the compiler about dynamically scoped variables,
|
|
;; and variables from other packages
|
|
(defvar zmacs-regions) ; XEmacs regions
|
|
(defvar original-date) ; dynamically scoped in calendar
|
|
(defvar org-old-auto-fill-inhibit-regexp) ; local variable used by `orgtbl-mode'
|
|
(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized
|
|
(defvar org-html-entities) ; defined later in this file
|
|
(defvar org-goto-start-pos) ; dynamically scoped parameter
|
|
(defvar org-time-was-given) ; dynamically scoped parameter
|
|
(defvar org-ts-what) ; dynamically scoped parameter
|
|
(defvar mark-active) ; Emacs only, not available in XEmacs.
|
|
(defvar timecnt) ; dynamically scoped parameter
|
|
(defvar levels-open) ; dynamically scoped parameter
|
|
(defvar entry) ; dynamically scoped parameter
|
|
(defvar date) ; dynamically scoped parameter
|
|
(defvar description) ; dynamically scoped parameter
|
|
(defvar ans1) ; dynamically scoped parameter
|
|
(defvar ans2) ; dynamically scoped parameter
|
|
(defvar starting-day) ; local variable
|
|
(defvar include-all-loc) ; local variable
|
|
(defvar vm-message-pointer) ; from vm
|
|
(defvar vm-folder-directory) ; from vm
|
|
(defvar wl-summary-buffer-elmo-folder) ; from wanderlust
|
|
(defvar wl-summary-buffer-folder-name) ; from wanderlust
|
|
(defvar gnus-group-name) ; from gnus
|
|
(defvar gnus-article-current) ; from gnus
|
|
(defvar w3m-current-url) ; from w3m
|
|
(defvar mh-progs) ; from MH-E
|
|
(defvar mh-current-folder) ; from MH-E
|
|
(defvar mh-show-folder-buffer) ; from MH-E
|
|
(defvar mh-index-folder) ; from MH-E
|
|
(defvar mh-searcher) ; from MH-E
|
|
(defvar org-selected-point) ; dynamically scoped parameter
|
|
(defvar calendar-mode-map) ; from calendar.el
|
|
(defvar last-arg) ; local variable
|
|
(defvar remember-save-after-remembering) ; from remember.el
|
|
(defvar remember-data-file) ; from remember.el
|
|
(defvar annotation) ; from remember.el, dynamically scoped in `remember-mode'
|
|
(defvar initial) ; from remember.el, dynamically scoped in `remember-mode'
|
|
(defvar orgtbl-mode) ; defined later in this file
|
|
;;; Define the mode
|
|
|
|
(defvar org-mode-map
|
|
(if (and (not (keymapp outline-mode-map)) (featurep 'allout))
|
|
(error "Conflict with outdated version of allout.el. Load org.el before allout.el, or ugrade to newer allout, for example by switching to Emacs 22.")
|
|
(copy-keymap outline-mode-map))
|
|
"Keymap for Org-mode.")
|
|
|
|
(defvar org-struct-menu) ; defined later in this file
|
|
(defvar org-org-menu) ; defined later in this file
|
|
(defvar org-tbl-menu) ; defined later in this file
|
|
|
|
;; We use a before-change function to check if a table might need
|
|
;; an update.
|
|
(defvar org-table-may-need-update t
|
|
"Indicates that a table might need an update.
|
|
This variable is set by `org-before-change-function'.
|
|
`org-table-align' sets it back to nil.")
|
|
(defvar org-mode-hook nil)
|
|
(defvar org-inhibit-startup nil) ; Dynamically-scoped param.
|
|
(defvar org-agenda-keep-modes nil) ; Dynamically-scoped param.
|
|
|
|
|
|
;;;###autoload
|
|
(define-derived-mode org-mode outline-mode "Org"
|
|
"Outline-based notes management and organizer, alias
|
|
\"Carsten's outline-mode for keeping track of everything.\"
|
|
|
|
Org-mode develops organizational tasks around a NOTES file which
|
|
contains information about projects as plain text. Org-mode is
|
|
implemented on top of outline-mode, which is ideal to keep the content
|
|
of large files well structured. It supports ToDo items, deadlines and
|
|
time stamps, which magically appear in the diary listing of the Emacs
|
|
calendar. Tables are easily created with a built-in table editor.
|
|
Plain text URL-like links connect to websites, emails (VM), Usenet
|
|
messages (Gnus), BBDB entries, and any files related to the project.
|
|
For printing and sharing of notes, an Org-mode file (or a part of it)
|
|
can be exported as a structured ASCII or HTML file.
|
|
|
|
The following commands are available:
|
|
|
|
\\{org-mode-map}"
|
|
|
|
;; Get rid of Outline menus, they are not needed
|
|
;; Need to do this here because define-derived-mode sets up
|
|
;; the keymap so late.
|
|
(if (featurep 'xemacs)
|
|
(if org-noutline-p
|
|
(progn
|
|
(easy-menu-remove outline-mode-menu-heading)
|
|
(easy-menu-remove outline-mode-menu-show)
|
|
(easy-menu-remove outline-mode-menu-hide))
|
|
(delete-menu-item '("Headings"))
|
|
(delete-menu-item '("Show"))
|
|
(delete-menu-item '("Hide"))
|
|
(set-menubar-dirty-flag))
|
|
(define-key org-mode-map [menu-bar headings] 'undefined)
|
|
(define-key org-mode-map [menu-bar hide] 'undefined)
|
|
(define-key org-mode-map [menu-bar show] 'undefined))
|
|
|
|
(easy-menu-add org-org-menu)
|
|
(easy-menu-add org-tbl-menu)
|
|
(org-install-agenda-files-menu)
|
|
(if org-descriptive-links (org-add-to-invisibility-spec '(org-link)))
|
|
(org-add-to-invisibility-spec '(org-cwidth))
|
|
(when (featurep 'xemacs)
|
|
(set (make-local-variable 'line-move-ignore-invisible) t))
|
|
(setq outline-regexp "\\*+")
|
|
;;(setq outline-regexp "\\(?:\\*+\\|[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\) \\)")
|
|
(setq outline-level 'org-outline-level)
|
|
(when (and org-ellipsis (stringp org-ellipsis))
|
|
(unless org-display-table
|
|
(setq org-display-table (make-display-table)))
|
|
(set-display-table-slot org-display-table
|
|
4 (string-to-vector org-ellipsis))
|
|
(setq buffer-display-table org-display-table))
|
|
(org-set-regexps-and-options)
|
|
(if org-startup-truncated (setq truncate-lines t))
|
|
(set (make-local-variable 'font-lock-unfontify-region-function)
|
|
'org-unfontify-region)
|
|
;; Activate before-change-function
|
|
(set (make-local-variable 'org-table-may-need-update) t)
|
|
(org-add-hook 'before-change-functions 'org-before-change-function nil
|
|
'local)
|
|
;; Paragraphs and auto-filling
|
|
(org-set-autofill-regexps)
|
|
(org-update-radio-target-regexp)
|
|
;; Settings for Calc embedded mode
|
|
(set (make-local-variable 'calc-embedded-open-formula) "|\\|\n")
|
|
(set (make-local-variable 'calc-embedded-close-formula) "|\\|\n")
|
|
(if (and org-insert-mode-line-in-empty-file
|
|
(interactive-p)
|
|
(= (point-min) (point-max)))
|
|
(insert " -*- mode: org -*-\n\n"))
|
|
|
|
(unless org-inhibit-startup
|
|
(if org-startup-align-all-tables
|
|
(org-table-map-tables 'org-table-align))
|
|
(if org-startup-with-deadline-check
|
|
(call-interactively 'org-check-deadlines)
|
|
(cond
|
|
((eq org-startup-folded t)
|
|
(org-cycle '(4)))
|
|
((eq org-startup-folded 'content)
|
|
(let ((this-command 'org-cycle) (last-command 'org-cycle))
|
|
(org-cycle '(4)) (org-cycle '(4))))))))
|
|
|
|
(defsubst org-current-line (&optional pos)
|
|
(+ (if (bolp) 1 0) (count-lines (point-min) (or pos (point)))))
|
|
|
|
(defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t
|
|
mouse-map t)
|
|
"Properties to remove when a string without properties is wanted.")
|
|
|
|
(defsubst org-match-string-no-properties (num &optional string)
|
|
(if (featurep 'xemacs)
|
|
(let ((s (match-string num string)))
|
|
(remove-text-properties 0 (length s) org-rm-props s)
|
|
s)
|
|
(match-string-no-properties num string)))
|
|
|
|
(defsubst org-no-properties (s)
|
|
(remove-text-properties 0 (length s) org-rm-props s)
|
|
s)
|
|
|
|
(defun org-current-time ()
|
|
"Current time, possibly rounded to `org-time-stamp-rounding-minutes'."
|
|
(if (> org-time-stamp-rounding-minutes 0)
|
|
(let ((r org-time-stamp-rounding-minutes)
|
|
(time (decode-time)))
|
|
(apply 'encode-time
|
|
(append (list 0 (* r (floor (+ .5 (/ (float (nth 1 time)) r)))))
|
|
(nthcdr 2 time))))
|
|
(current-time)))
|
|
|
|
(defun org-add-props (string plist &rest props)
|
|
"Add text properties to entire string, from beginning to end.
|
|
PLIST may be a list of properties, PROPS are individual properties and values
|
|
that will be added to PLIST. Returns the string that was modified."
|
|
(add-text-properties
|
|
0 (length string) (if props (append plist props) plist) string)
|
|
string)
|
|
(put 'org-add-props 'lisp-indent-function 2)
|
|
|
|
|
|
;;; Font-Lock stuff
|
|
|
|
(defvar org-mouse-map (make-sparse-keymap))
|
|
(define-key org-mouse-map
|
|
(if (featurep 'xemacs) [button2] [mouse-2]) 'org-open-at-mouse)
|
|
(define-key org-mouse-map
|
|
(if (featurep 'xemacs) [button3] [mouse-3]) 'org-find-file-at-mouse)
|
|
(when org-mouse-1-follows-link
|
|
(define-key org-mouse-map [follow-link] 'mouse-face))
|
|
(when org-tab-follows-link
|
|
(define-key org-mouse-map [(tab)] 'org-open-at-point)
|
|
(define-key org-mouse-map "\C-i" 'org-open-at-point))
|
|
(when org-return-follows-link
|
|
(define-key org-mouse-map [(return)] 'org-open-at-point)
|
|
(define-key org-mouse-map "\C-m" 'org-open-at-point))
|
|
|
|
(require 'font-lock)
|
|
|
|
(defconst org-non-link-chars "]\t\n\r<>")
|
|
(defconst org-link-types '("https?" "ftp" "mailto" "file" "news" "bbdb" "vm"
|
|
"wl" "mhe" "rmail" "gnus" "shell"))
|
|
(defconst org-link-re-with-space
|
|
(concat
|
|
"<?\\(" (mapconcat 'identity org-link-types "\\|") "\\):"
|
|
"\\([^" org-non-link-chars " ]"
|
|
"[^" org-non-link-chars "]*"
|
|
"[^" org-non-link-chars " ]\\)>?")
|
|
"Matches a link with spaces, optional angular brackets around it.")
|
|
|
|
(defconst org-link-re-with-space2
|
|
(concat
|
|
"<?\\(" (mapconcat 'identity org-link-types "\\|") "\\):"
|
|
"\\([^" org-non-link-chars " ]"
|
|
"[^]\t\n\r]*"
|
|
"[^" org-non-link-chars " ]\\)>?")
|
|
"Matches a link with spaces, optional angular brackets around it.")
|
|
|
|
(defconst org-angle-link-re
|
|
(concat
|
|
"<\\(" (mapconcat 'identity org-link-types "\\|") "\\):"
|
|
"\\([^" org-non-link-chars " ]"
|
|
"[^" org-non-link-chars "]*"
|
|
"\\)>")
|
|
"Matches link with angular brackets, spaces are allowed.")
|
|
(defconst org-plain-link-re
|
|
(concat
|
|
"\\(" (mapconcat 'identity org-link-types "\\|") "\\):"
|
|
"\\([^]\t\n\r<>,;() ]+\\)")
|
|
"Matches plain link, without spaces.")
|
|
|
|
(defconst org-bracket-link-regexp
|
|
"\\[\\[\\([^]]+\\)\\]\\(\\[\\([^]]+\\)\\]\\)?\\]"
|
|
"Matches a link in double brackets.")
|
|
|
|
(defconst org-bracket-link-analytic-regexp
|
|
(concat
|
|
"\\[\\["
|
|
"\\(\\(" (mapconcat 'identity org-link-types "\\|") "\\):\\)?"
|
|
"\\([^]]+\\)"
|
|
"\\]"
|
|
"\\(\\[" "\\([^]]+\\)" "\\]\\)?"
|
|
"\\]"))
|
|
; 1: http:
|
|
; 2: http
|
|
; 3: path
|
|
; 4: [desc]
|
|
; 5: desc
|
|
|
|
|
|
(defconst org-ts-lengths
|
|
(cons (length (format-time-string (car org-time-stamp-formats)))
|
|
(length (format-time-string (cdr org-time-stamp-formats))))
|
|
"This holds the lengths of the two different time formats.")
|
|
(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^\r\n>]*?\\)>"
|
|
"Regular expression for fast time stamp matching.")
|
|
(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^\r\n>]*?\\)[]>]"
|
|
"Regular expression for fast time stamp matching.")
|
|
(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\([^0-9>\r\n]*\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
|
|
"Regular expression matching time strings for analysis.")
|
|
(defconst org-ts-regexp2 (concat "<" org-ts-regexp1 ">")
|
|
"Regular expression matching time stamps, with groups.")
|
|
(defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp)
|
|
"Regular expression matching a time stamp range.")
|
|
(defconst org-tsr-regexp (concat org-ts-regexp "\\(--?-?"
|
|
org-ts-regexp "\\)?")
|
|
"Regular expression matching a time stamp or time stamp range.")
|
|
|
|
(defun org-activate-plain-links (limit)
|
|
"Run through the buffer and add overlays to links."
|
|
(if (re-search-forward org-plain-link-re limit t)
|
|
(progn
|
|
(add-text-properties (match-beginning 0) (match-end 0)
|
|
(list 'mouse-face 'highlight
|
|
'keymap org-mouse-map
|
|
))
|
|
t)))
|
|
|
|
(defun org-activate-angle-links (limit)
|
|
"Run through the buffer and add overlays to links."
|
|
(if (re-search-forward org-angle-link-re limit t)
|
|
(progn
|
|
(add-text-properties (match-beginning 0) (match-end 0)
|
|
(list 'mouse-face 'highlight
|
|
'keymap org-mouse-map
|
|
))
|
|
t)))
|
|
|
|
(defun org-activate-bracket-links (limit)
|
|
"Run through the buffer and add overlays to bracketed links."
|
|
(if (re-search-forward org-bracket-link-regexp limit t)
|
|
(let* ((help (concat "LINK: "
|
|
(org-match-string-no-properties 1)))
|
|
;; FIXME: above we should remove the escapes.
|
|
(ip (list 'invisible 'org-link 'intangible t 'rear-nonsticky t
|
|
'keymap org-mouse-map 'mouse-face 'highlight
|
|
'help-echo help))
|
|
(vp (list 'rear-nonsticky t
|
|
'keymap org-mouse-map 'mouse-face 'highlight
|
|
'help-echo help)))
|
|
;; We need to remove the invisible property here. Table narrowing
|
|
;; may have made some of this invisible.
|
|
(remove-text-properties (match-beginning 0) (match-end 0)
|
|
'(invisible nil))
|
|
(if (match-end 3)
|
|
(progn
|
|
(add-text-properties (match-beginning 0) (match-beginning 3) ip)
|
|
(add-text-properties (match-beginning 3) (match-end 3) vp)
|
|
(add-text-properties (match-end 3) (match-end 0) ip))
|
|
(add-text-properties (match-beginning 0) (match-beginning 1) ip)
|
|
(add-text-properties (match-beginning 1) (match-end 1) vp)
|
|
(add-text-properties (match-end 1) (match-end 0) ip))
|
|
t)))
|
|
|
|
(defun org-activate-dates (limit)
|
|
"Run through the buffer and add overlays to dates."
|
|
(if (re-search-forward org-tsr-regexp limit t)
|
|
(progn
|
|
(add-text-properties (match-beginning 0) (match-end 0)
|
|
(list 'mouse-face 'highlight
|
|
'keymap org-mouse-map))
|
|
t)))
|
|
|
|
(defvar org-target-link-regexp nil
|
|
"Regular expression matching radio targets in plain text.")
|
|
(defvar org-target-regexp "<<\\([^<>\n\r]+\\)>>"
|
|
"Regular expression matching a link target.")
|
|
(defvar org-radio-target-regexp "<<<\\([^<>\n\r]+\\)>>>"
|
|
"Regular expression matching a link target.")
|
|
|
|
(defun org-activate-target-links (limit)
|
|
"Run through the buffer and add overlays to target matches."
|
|
(when org-target-link-regexp
|
|
(let ((case-fold-search t))
|
|
(if (re-search-forward org-target-link-regexp limit t)
|
|
(progn
|
|
(add-text-properties (match-beginning 0) (match-end 0)
|
|
(list 'mouse-face 'highlight
|
|
'keymap org-mouse-map
|
|
'help-echo "Radio target link"
|
|
'org-linked-text t))
|
|
t)))))
|
|
|
|
(defun org-update-radio-target-regexp ()
|
|
"Find all radio targets in this file and update the regular expression."
|
|
(interactive)
|
|
(when (memq 'radio org-activate-links)
|
|
(setq org-target-link-regexp
|
|
(org-make-target-link-regexp (org-all-targets 'radio)))
|
|
(org-restart-font-lock)))
|
|
|
|
(defun org-hide-wide-columns (limit)
|
|
(let (s e)
|
|
(setq s (text-property-any (point) (or limit (point-max))
|
|
'org-cwidth t))
|
|
(when s
|
|
(setq e (next-single-property-change s 'org-cwidth))
|
|
(add-text-properties s e '(invisible org-cwidth intangible t))
|
|
(goto-char e)
|
|
t)))
|
|
|
|
(defun org-restart-font-lock ()
|
|
"Restart font-lock-mode, to force refontification."
|
|
(when (and (boundp 'font-lock-mode) font-lock-mode)
|
|
(font-lock-mode -1)
|
|
(font-lock-mode 1)))
|
|
|
|
(defun org-all-targets (&optional radio)
|
|
"Return a list of all targets in this file.
|
|
With optional argument RADIO, only find radio targets."
|
|
(let ((re (if radio org-radio-target-regexp org-target-regexp))
|
|
rtn)
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(while (re-search-forward re nil t)
|
|
(add-to-list 'rtn (downcase (org-match-string-no-properties 1))))
|
|
rtn)))
|
|
|
|
(defun org-make-target-link-regexp (targets)
|
|
"Make regular expression matching all strings in TARGETS.
|
|
The regular expression finds the targets also if there is a line break
|
|
between words."
|
|
(and targets
|
|
(concat
|
|
"\\<\\("
|
|
(mapconcat
|
|
(lambda (x)
|
|
(while (string-match " +" x)
|
|
(setq x (replace-match "\\s-+" t t x)))
|
|
x)
|
|
targets
|
|
"\\|")
|
|
"\\)\\>")))
|
|
|
|
(defvar org-camel-regexp "\\*?\\<[A-Z]+[a-z]+[A-Z][a-zA-Z]*\\>"
|
|
"Matches CamelCase words, possibly with a star before it.")
|
|
|
|
(defun org-activate-camels (limit)
|
|
"Run through the buffer and add overlays to dates."
|
|
(if (re-search-forward org-camel-regexp limit t)
|
|
(progn
|
|
(add-text-properties (match-beginning 0) (match-end 0)
|
|
(list 'mouse-face 'highlight
|
|
'keymap org-mouse-map))
|
|
t)))
|
|
|
|
(defun org-activate-tags (limit)
|
|
(if (re-search-forward "[ \t]\\(:[A-Za-z_@0-9:]+:\\)[ \r\n]" limit t)
|
|
(progn
|
|
(add-text-properties (match-beginning 1) (match-end 1)
|
|
(list 'mouse-face 'highlight
|
|
'keymap org-mouse-map))
|
|
t)))
|
|
|
|
(defun org-font-lock-level ()
|
|
(save-excursion
|
|
(org-back-to-heading t)
|
|
(- (match-end 0) (match-beginning 0))))
|
|
|
|
(defun org-outline-level ()
|
|
(save-excursion
|
|
(looking-at outline-regexp)
|
|
(if (match-beginning 1)
|
|
(+ (org-get-string-indentation (match-string 1)) 1000)
|
|
(- (match-end 0) (match-beginning 0)))))
|
|
|
|
(defvar org-font-lock-keywords nil)
|
|
|
|
(defun org-set-font-lock-defaults ()
|
|
(let* ((em org-fontify-emphasized-text)
|
|
(lk org-activate-links)
|
|
(org-font-lock-extra-keywords
|
|
;; Headlines
|
|
(list
|
|
'("^\\(\\**\\)\\(\\*\\)\\(.*\\)" (1 (org-get-level-face 1))
|
|
(2 (org-get-level-face 2)) (3 (org-get-level-face 3)))
|
|
'("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
|
|
(1 'org-table))
|
|
;; Links
|
|
(if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t)))
|
|
(if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t)))
|
|
(if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t)))
|
|
(if (memq 'radio lk) '(org-activate-target-links (0 'org-link t)))
|
|
(if (memq 'date lk) '(org-activate-dates (0 'org-date t)))
|
|
(if (memq 'camel lk) '(org-activate-camels (0 'org-link t)))
|
|
(if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend)))
|
|
(if org-table-limit-column-width
|
|
'(org-hide-wide-columns (0 nil append)))
|
|
;; TODO lines
|
|
(list (concat "^\\*+[ \t]*" org-not-done-regexp)
|
|
'(1 'org-todo t))
|
|
;; Priorities
|
|
(list (concat "\\[#[A-Z]\\]") '(0 'org-special-keyword t))
|
|
;; Special keywords
|
|
(list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t))
|
|
(list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t))
|
|
(list (concat "\\<" org-closed-string) '(0 'org-special-keyword t))
|
|
;; Emphasis
|
|
(if em (list org-bold-re 2 ''bold 'prepend))
|
|
(if em (list org-italic-re 2 ''italic 'prepend))
|
|
(if em (list org-underline-re 2 ''underline 'prepend))
|
|
;; Checkboxes, similar to Frank Ruell's org-checklet.el
|
|
'("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[_\\]\\)"
|
|
2 'bold prepend)
|
|
'("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[X\\]\\)"
|
|
2 'bold prepend)
|
|
;; COMMENT
|
|
(list (concat "^\\*+[ \t]*\\<\\(" org-comment-string
|
|
"\\|" org-quote-string "\\)\\>")
|
|
'(1 'org-special-keyword t))
|
|
'("^#.*" (0 'font-lock-comment-face t))
|
|
;; DONE
|
|
(if org-fontify-done-headline
|
|
(list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\(.*\\)\\>")
|
|
'(1 'org-done t) '(2 'org-headline-done t))
|
|
(list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>")
|
|
'(1 'org-done t)))
|
|
;; Table stuff
|
|
'("^[ \t]*\\(:.*\\)" (1 'org-table t))
|
|
'("| *\\(:?=[^|\n]*\\)" (1 'org-formula t))
|
|
'("^[ \t]*| *\\([#!$*_^]\\) *|" (1 'org-formula t))
|
|
(if org-format-transports-properties-p
|
|
'("| *\\(<[0-9]+>\\) *" (1 'org-formula t)))
|
|
)))
|
|
(setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords))
|
|
;; Now set the full font-lock-keywords
|
|
(set (make-local-variable 'org-font-lock-keywords)
|
|
org-font-lock-extra-keywords)
|
|
(set (make-local-variable 'font-lock-defaults)
|
|
'(org-font-lock-keywords t nil nil backward-paragraph))
|
|
(kill-local-variable 'font-lock-keywords) nil))
|
|
|
|
(defvar org-m nil)
|
|
(defvar org-l nil)
|
|
(defvar org-f nil)
|
|
(defun org-get-level-face (n)
|
|
"Get the right face for match N in font-lock matching of healdines."
|
|
(setq org-l (- (match-end 2) (match-beginning 1)))
|
|
(if org-odd-levels-only (setq org-l (1+ (/ org-l 2))))
|
|
; (setq org-f (nth (1- (% org-l org-n-levels)) org-level-faces))
|
|
(setq org-f (nth (% (1- org-l) org-n-levels) org-level-faces))
|
|
(cond
|
|
((eq n 1) (if org-hide-leading-stars 'org-hide org-f))
|
|
((eq n 2) org-f)
|
|
(t (if org-level-color-stars-only nil org-f))))
|
|
|
|
(defun org-unfontify-region (beg end &optional maybe_loudly)
|
|
"Remove fontification and activation overlays from links."
|
|
(font-lock-default-unfontify-region beg end)
|
|
(let* ((buffer-undo-list t)
|
|
(inhibit-read-only t) (inhibit-point-motion-hooks t)
|
|
(inhibit-modification-hooks t)
|
|
deactivate-mark buffer-file-name buffer-file-truename)
|
|
(remove-text-properties beg end
|
|
'(mouse-face nil keymap nil org-linked-text nil
|
|
invisible nil intangible nil))))
|
|
;;; Visibility cycling
|
|
|
|
(defvar org-cycle-global-status nil)
|
|
(make-variable-buffer-local 'org-cycle-global-status)
|
|
(defvar org-cycle-subtree-status nil)
|
|
(make-variable-buffer-local 'org-cycle-subtree-status)
|
|
|
|
;;;###autoload
|
|
(defun org-cycle (&optional arg)
|
|
"Visibility cycling for Org-mode.
|
|
|
|
- When this function is called with a prefix argument, rotate the entire
|
|
buffer through 3 states (global cycling)
|
|
1. OVERVIEW: Show only top-level headlines.
|
|
2. CONTENTS: Show all headlines of all levels, but no body text.
|
|
3. SHOW ALL: Show everything.
|
|
|
|
- When point is at the beginning of a headline, rotate the subtree started
|
|
by this line through 3 different states (local cycling)
|
|
1. FOLDED: Only the main headline is shown.
|
|
2. CHILDREN: The main headline and the direct children are shown.
|
|
From this state, you can move to one of the children
|
|
and zoom in further.
|
|
3. SUBTREE: Show the entire subtree, including body text.
|
|
|
|
- When there is a numeric prefix, go up to a heading with level ARG, do
|
|
a `show-subtree' and return to the previous cursor position. If ARG
|
|
is negative, go up that many levels.
|
|
|
|
- When point is not at the beginning of a headline, execute
|
|
`indent-relative', like TAB normally does. See the option
|
|
`org-cycle-emulate-tab' for details.
|
|
|
|
- Special case: if point is the the beginning of the buffer and there is
|
|
no headline in line 1, this function will act as if called with prefix arg."
|
|
(interactive "P")
|
|
|
|
(let* ((outline-regexp
|
|
(if org-cycle-include-plain-lists
|
|
"\\*+\\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) "
|
|
outline-regexp))
|
|
(bob-special (and org-cycle-global-at-bob (bobp)
|
|
(not (looking-at outline-regexp))))
|
|
(org-cycle-hook (if bob-special nil org-cycle-hook)))
|
|
|
|
(if (or bob-special (equal arg '(4)))
|
|
;; special case: use global cycling
|
|
(setq arg t))
|
|
|
|
(cond
|
|
|
|
((org-at-table-p 'any)
|
|
;; Enter the table or move to the next field in the table
|
|
(or (org-table-recognize-table.el)
|
|
(progn
|
|
(if arg (org-table-edit-field t)
|
|
(org-table-justify-field-maybe)
|
|
(org-table-next-field)))))
|
|
|
|
((eq arg t) ;; Global cycling
|
|
|
|
(cond
|
|
((and (eq last-command this-command)
|
|
(eq org-cycle-global-status 'overview))
|
|
;; We just created the overview - now do table of contents
|
|
;; This can be slow in very large buffers, so indicate action
|
|
(message "CONTENTS...")
|
|
(org-content)
|
|
(message "CONTENTS...done")
|
|
(setq org-cycle-global-status 'contents)
|
|
(run-hook-with-args 'org-cycle-hook 'contents))
|
|
|
|
((and (eq last-command this-command)
|
|
(eq org-cycle-global-status 'contents))
|
|
;; We just showed the table of contents - now show everything
|
|
(show-all)
|
|
(message "SHOW ALL")
|
|
(setq org-cycle-global-status 'all)
|
|
(run-hook-with-args 'org-cycle-hook 'all))
|
|
|
|
(t
|
|
;; Default action: go to overview
|
|
(org-overview)
|
|
(message "OVERVIEW")
|
|
(setq org-cycle-global-status 'overview)
|
|
(run-hook-with-args 'org-cycle-hook 'overview))))
|
|
|
|
((integerp arg)
|
|
;; Show-subtree, ARG levels up from here.
|
|
(save-excursion
|
|
(org-back-to-heading)
|
|
(outline-up-heading (if (< arg 0) (- arg)
|
|
(- (funcall outline-level) arg)))
|
|
(org-show-subtree)))
|
|
|
|
((save-excursion (beginning-of-line 1) (looking-at outline-regexp))
|
|
;; At a heading: rotate between three different views
|
|
(org-back-to-heading)
|
|
(let ((goal-column 0) eoh eol eos)
|
|
;; First, some boundaries
|
|
(save-excursion
|
|
(org-back-to-heading)
|
|
(save-excursion
|
|
(beginning-of-line 2)
|
|
(while (and (not (eobp)) ;; this is like `next-line'
|
|
(get-char-property (1- (point)) 'invisible))
|
|
(beginning-of-line 2)) (setq eol (point)))
|
|
(outline-end-of-heading) (setq eoh (point))
|
|
(org-end-of-subtree t) (setq eos (point))
|
|
(outline-next-heading))
|
|
;; Find out what to do next and set `this-command'
|
|
(cond
|
|
((= eos eoh)
|
|
;; Nothing is hidden behind this heading
|
|
(message "EMPTY ENTRY")
|
|
(setq org-cycle-subtree-status nil))
|
|
((>= eol eos)
|
|
;; Entire subtree is hidden in one line: open it
|
|
(org-show-entry)
|
|
(show-children)
|
|
(message "CHILDREN")
|
|
(setq org-cycle-subtree-status 'children)
|
|
(run-hook-with-args 'org-cycle-hook 'children))
|
|
((and (eq last-command this-command)
|
|
(eq org-cycle-subtree-status 'children))
|
|
;; We just showed the children, now show everything.
|
|
(org-show-subtree)
|
|
(message "SUBTREE")
|
|
(setq org-cycle-subtree-status 'subtree)
|
|
(run-hook-with-args 'org-cycle-hook 'subtree))
|
|
(t
|
|
;; Default action: hide the subtree.
|
|
(hide-subtree)
|
|
(message "FOLDED")
|
|
(setq org-cycle-subtree-status 'folded)
|
|
(run-hook-with-args 'org-cycle-hook 'folded)))))
|
|
|
|
;; TAB emulation
|
|
(buffer-read-only (org-back-to-heading))
|
|
((if (and (eq org-cycle-emulate-tab 'white)
|
|
(save-excursion (beginning-of-line 1) (looking-at "[ \t]+$")))
|
|
t
|
|
(eq org-cycle-emulate-tab t))
|
|
(if (and (looking-at "[ \n\r\t]")
|
|
(string-match "^[ \t]*$" (buffer-substring
|
|
(point-at-bol) (point))))
|
|
(progn
|
|
(beginning-of-line 1)
|
|
(and (looking-at "[ \t]+") (replace-match ""))))
|
|
(indent-relative))
|
|
|
|
(t (save-excursion
|
|
(org-back-to-heading)
|
|
(org-cycle))))))
|
|
|
|
;;;###autoload
|
|
(defun org-global-cycle ()
|
|
"Cycle the global visibility. For details see `org-cycle'."
|
|
(interactive)
|
|
(org-cycle '(4)))
|
|
|
|
(defun org-overview ()
|
|
"Switch to overview mode, shoing only top-level headlines.
|
|
Really, this shows all headlines with level equal or greater than the level
|
|
of the first headline in the buffer. This is important, because if the
|
|
first headline is not level one, then (hide-sublevels 1) gives confusing
|
|
results."
|
|
(interactive)
|
|
(hide-sublevels (save-excursion
|
|
(goto-char (point-min))
|
|
(if (re-search-forward (concat "^" outline-regexp) nil t)
|
|
(progn
|
|
(goto-char (match-beginning 0))
|
|
(funcall outline-level))
|
|
1))))
|
|
|
|
;; FIXME: allow an argument to give a limiting level for this.
|
|
(defun org-content ()
|
|
"Show all headlines in the buffer, like a table of contents"
|
|
(interactive)
|
|
(save-excursion
|
|
;; Visit all headings and show their offspring
|
|
(goto-char (point-max))
|
|
(catch 'exit
|
|
(while (and (progn (condition-case nil
|
|
(outline-previous-visible-heading 1)
|
|
(error (goto-char (point-min))))
|
|
t)
|
|
(looking-at outline-regexp))
|
|
(show-branches)
|
|
(if (bobp) (throw 'exit nil))))))
|
|
|
|
|
|
(defun org-optimize-window-after-visibility-change (state)
|
|
"Adjust the window after a change in outline visibility.
|
|
This function is the default value of the hook `org-cycle-hook'."
|
|
(when (get-buffer-window (current-buffer))
|
|
(cond
|
|
((eq state 'overview) (org-first-headline-recenter 1))
|
|
((eq state 'content) nil)
|
|
((eq state 'all) nil)
|
|
((eq state 'folded) nil)
|
|
((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1)))
|
|
((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1))))))
|
|
|
|
(defun org-subtree-end-visible-p ()
|
|
"Is the end of the current subtree visible?"
|
|
(pos-visible-in-window-p
|
|
(save-excursion (org-end-of-subtree t) (point))))
|
|
|
|
(defun org-first-headline-recenter (&optional N)
|
|
"Move cursor to the first headline and recenter the headline.
|
|
Optional argument N means, put the headline into the Nth line of the window."
|
|
(goto-char (point-min))
|
|
(when (re-search-forward (concat "^" outline-regexp) nil t)
|
|
(beginning-of-line)
|
|
(recenter (prefix-numeric-value N))))
|
|
|
|
(defvar org-goto-window-configuration nil)
|
|
(defvar org-goto-marker nil)
|
|
(defvar org-goto-map (make-sparse-keymap))
|
|
(let ((cmds '(isearch-forward isearch-backward)) cmd)
|
|
(while (setq cmd (pop cmds))
|
|
(substitute-key-definition cmd cmd org-goto-map global-map)))
|
|
(define-key org-goto-map "\C-m" 'org-goto-ret)
|
|
(define-key org-goto-map [(left)] 'org-goto-left)
|
|
(define-key org-goto-map [(right)] 'org-goto-right)
|
|
(define-key org-goto-map [(?q)] 'org-goto-quit)
|
|
(define-key org-goto-map [(control ?g)] 'org-goto-quit)
|
|
(define-key org-goto-map "\C-i" 'org-cycle)
|
|
(define-key org-goto-map [(tab)] 'org-cycle)
|
|
(define-key org-goto-map [(down)] 'outline-next-visible-heading)
|
|
(define-key org-goto-map [(up)] 'outline-previous-visible-heading)
|
|
(define-key org-goto-map "n" 'outline-next-visible-heading)
|
|
(define-key org-goto-map "p" 'outline-previous-visible-heading)
|
|
(define-key org-goto-map "f" 'outline-forward-same-level)
|
|
(define-key org-goto-map "b" 'outline-backward-same-level)
|
|
(define-key org-goto-map "u" 'outline-up-heading)
|
|
(define-key org-goto-map "\C-c\C-n" 'outline-next-visible-heading)
|
|
(define-key org-goto-map "\C-c\C-p" 'outline-previous-visible-heading)
|
|
(define-key org-goto-map "\C-c\C-f" 'outline-forward-same-level)
|
|
(define-key org-goto-map "\C-c\C-b" 'outline-backward-same-level)
|
|
(define-key org-goto-map "\C-c\C-u" 'outline-up-heading)
|
|
(let ((l '(1 2 3 4 5 6 7 8 9 0)))
|
|
(while l (define-key org-goto-map (int-to-string (pop l)) 'digit-argument)))
|
|
|
|
(defconst org-goto-help
|
|
"Select a location to jump to, press RET
|
|
\[Up]/[Down]=next/prev headline TAB=cycle visibility RET=select [Q]uit")
|
|
|
|
(defun org-goto ()
|
|
"Go to a different location of the document, keeping current visibility.
|
|
|
|
When you want to go to a different location in a document, the fastest way
|
|
is often to fold the entire buffer and then dive into the tree. This
|
|
method has the disadvantage, that the previous location will be folded,
|
|
which may not be what you want.
|
|
|
|
This command works around this by showing a copy of the current buffer in
|
|
overview mode. You can dive into the tree in that copy, to find the
|
|
location you want to reach. When pressing RET, the command returns to the
|
|
original buffer in which the visibility is still unchanged. It then jumps
|
|
to the new location, making it and the headline hierarchy above it visible."
|
|
(interactive)
|
|
(let* ((org-goto-start-pos (point))
|
|
(selected-point
|
|
(org-get-location (current-buffer) org-goto-help)))
|
|
(if selected-point
|
|
(progn
|
|
(org-mark-ring-push org-goto-start-pos)
|
|
(goto-char selected-point)
|
|
(if (or (org-invisible-p) (org-invisible-p2))
|
|
(org-show-hierarchy-above)))
|
|
(error "Quit"))))
|
|
|
|
(defun org-get-location (buf help)
|
|
"Let the user select a location in the Org-mode buffer BUF.
|
|
This function uses a recursive edit. It returns the selected position
|
|
or nil."
|
|
(let (org-selected-point)
|
|
(save-excursion
|
|
(save-window-excursion
|
|
(delete-other-windows)
|
|
(switch-to-buffer (get-buffer-create "*org-goto*"))
|
|
(with-output-to-temp-buffer "*Help*"
|
|
(princ help))
|
|
(shrink-window-if-larger-than-buffer (get-buffer-window "*Help*"))
|
|
(setq buffer-read-only nil)
|
|
(erase-buffer)
|
|
(insert-buffer-substring buf)
|
|
(let ((org-startup-truncated t)
|
|
(org-startup-folded t)
|
|
(org-startup-align-all-tables nil)
|
|
(org-startup-with-deadline-check nil))
|
|
(org-mode))
|
|
(setq buffer-read-only t)
|
|
(if (boundp 'org-goto-start-pos)
|
|
(goto-char org-goto-start-pos)
|
|
(goto-char (point-min)))
|
|
(org-beginning-of-line)
|
|
(message "Select location and press RET")
|
|
;; now we make sure that during selection, ony very few keys work
|
|
;; and that it is impossible to switch to another window.
|
|
(let ((gm (current-global-map))
|
|
(overriding-local-map org-goto-map))
|
|
(unwind-protect
|
|
(progn
|
|
(use-global-map org-goto-map)
|
|
(recursive-edit))
|
|
(use-global-map gm)))))
|
|
(kill-buffer "*org-goto*")
|
|
org-selected-point))
|
|
|
|
;; FIXME: It may not be a good idea to temper with the prefix argument...
|
|
(defun org-goto-ret (&optional arg)
|
|
"Finish `org-goto' by going to the new location."
|
|
(interactive "P")
|
|
(setq org-selected-point (point)
|
|
current-prefix-arg arg)
|
|
(throw 'exit nil))
|
|
|
|
(defun org-goto-left ()
|
|
"Finish `org-goto' by going to the new location."
|
|
(interactive)
|
|
(if (org-on-heading-p)
|
|
(progn
|
|
(beginning-of-line 1)
|
|
(setq org-selected-point (point)
|
|
current-prefix-arg (- (match-end 0) (match-beginning 0)))
|
|
(throw 'exit nil))
|
|
(error "Not on a heading")))
|
|
|
|
(defun org-goto-right ()
|
|
"Finish `org-goto' by going to the new location."
|
|
(interactive)
|
|
(if (org-on-heading-p)
|
|
(progn
|
|
(outline-end-of-subtree)
|
|
(or (eobp) (forward-char 1))
|
|
(setq org-selected-point (point)
|
|
current-prefix-arg (- (match-end 0) (match-beginning 0)))
|
|
(throw 'exit nil))
|
|
(error "Not on a heading")))
|
|
|
|
(defun org-goto-quit ()
|
|
"Finish `org-goto' without cursor motion."
|
|
(interactive)
|
|
(setq org-selected-point nil)
|
|
(throw 'exit nil))
|
|
|
|
;;; Promotion, Demotion, Inserting new headlines
|
|
|
|
(defvar org-ignore-region nil
|
|
"To temporarily disable the active region.")
|
|
|
|
(defun org-insert-heading (&optional force-heading)
|
|
"Insert a new heading or item with same depth at point.
|
|
If point is in a plain list and FORCE-HEADING is nil, create a new list item.
|
|
If point is at the beginning of a headline, insert a sibling before the
|
|
current headline. If point is in the middle of a headline, split the headline
|
|
at that position and make the rest of the headline part of the sibling below
|
|
the current headline."
|
|
(interactive "P")
|
|
(if (= (buffer-size) 0)
|
|
(insert "\n* ")
|
|
(when (or force-heading (not (org-insert-item)))
|
|
(let* ((head (save-excursion
|
|
(condition-case nil
|
|
(progn
|
|
(org-back-to-heading)
|
|
(match-string 0))
|
|
(error "*"))))
|
|
pos)
|
|
(cond
|
|
((and (org-on-heading-p) (bolp)
|
|
(save-excursion (backward-char 1) (not (org-invisible-p))))
|
|
(open-line 1))
|
|
((bolp) nil)
|
|
(t (newline)))
|
|
(insert head) (just-one-space)
|
|
(setq pos (point))
|
|
(end-of-line 1)
|
|
(unless (= (point) pos) (just-one-space) (backward-delete-char 1))
|
|
(run-hooks 'org-insert-heading-hook)))))
|
|
|
|
(defun org-insert-item ()
|
|
"Insert a new item at the current level.
|
|
Return t when things worked, nil when we are not in an item."
|
|
(when (save-excursion
|
|
(condition-case nil
|
|
(progn
|
|
(org-beginning-of-item)
|
|
(org-at-item-p)
|
|
t)
|
|
(error nil)))
|
|
(debug)
|
|
(let* ((bul (match-string 0))
|
|
(end (match-end 0))
|
|
(eow (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")
|
|
(match-end 0)))
|
|
(eowcol (save-excursion (goto-char eow) (current-column)))
|
|
(checkboxp (save-excursion (goto-char end)
|
|
(looking-at "[ \t]*\\[[_X]\\]")))
|
|
pos)
|
|
(cond
|
|
((and (org-at-item-p) (<= (point) eow))
|
|
;; before the bullet
|
|
(beginning-of-line 1)
|
|
(open-line 1))
|
|
((<= (point) eow)
|
|
(beginning-of-line 1))
|
|
(t (newline)))
|
|
(insert bul (if checkboxp "[_]" ""))
|
|
(just-one-space)
|
|
(setq pos (point))
|
|
(end-of-line 1)
|
|
(unless (= (point) pos) (just-one-space) (backward-delete-char 1)))
|
|
(org-maybe-renumber-ordered-list)
|
|
t))
|
|
|
|
(defun org-insert-todo-heading (arg)
|
|
"Insert a new heading with the same level and TODO state as current heading.
|
|
If the heading has no TODO state, or if the state is DONE, use the first
|
|
state (TODO by default). Also with prefix arg, force first state."
|
|
(interactive "P")
|
|
(org-insert-heading)
|
|
(save-excursion
|
|
(org-back-to-heading)
|
|
(if org-noutline-p
|
|
(outline-previous-heading)
|
|
(outline-previous-visible-heading t))
|
|
(looking-at org-todo-line-regexp))
|
|
(if (or arg
|
|
(not (match-beginning 2))
|
|
(equal (match-string 2) org-done-string))
|
|
(insert (car org-todo-keywords) " ")
|
|
(insert (match-string 2) " ")))
|
|
|
|
(defun org-promote-subtree ()
|
|
"Promote the entire subtree.
|
|
See also `org-promote'."
|
|
(interactive)
|
|
(save-excursion
|
|
(org-map-tree 'org-promote)))
|
|
|
|
(defun org-demote-subtree ()
|
|
"Demote the entire subtree. See `org-demote'.
|
|
See also `org-promote'."
|
|
(interactive)
|
|
(save-excursion
|
|
(org-map-tree 'org-demote)))
|
|
|
|
(defun org-do-promote ()
|
|
"Promote the current heading higher up the tree.
|
|
If the region is active in `transient-mark-mode', promote all headings
|
|
in the region."
|
|
(interactive)
|
|
(save-excursion
|
|
(if (org-region-active-p)
|
|
(org-map-region 'org-promote (region-beginning) (region-end))
|
|
(org-promote)))
|
|
(org-fix-position-after-promote))
|
|
|
|
(defun org-do-demote ()
|
|
"Demote the current heading lower down the tree.
|
|
If the region is active in `transient-mark-mode', demote all headings
|
|
in the region."
|
|
(interactive)
|
|
(save-excursion
|
|
(if (org-region-active-p)
|
|
(org-map-region 'org-demote (region-beginning) (region-end))
|
|
(org-demote)))
|
|
(org-fix-position-after-promote))
|
|
|
|
(defun org-fix-position-after-promote ()
|
|
"Make sure that after pro/demotion cursor position is right."
|
|
(and (equal (char-after) ?\ )
|
|
(equal (char-before) ?*)
|
|
(forward-char 1)))
|
|
|
|
(defun org-get-legal-level (level change)
|
|
"Rectify a level change under the influence of `org-odd-levels-only'
|
|
LEVEL is a current level, CHANGE is by how much the level should be
|
|
modified. Even if CHANGE is nil, LEVEL may be returned modified because
|
|
even level numbers will become the next higher odd number."
|
|
(if org-odd-levels-only
|
|
(cond ((not change) (1+ (* 2 (/ level 2))))
|
|
((> change 0) (1+ (* 2 (/ (+ level (* 2 change)) 2))))
|
|
((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2))))))
|
|
(max 1 (+ level change))))
|
|
|
|
(defun org-promote ()
|
|
"Promote the current heading higher up the tree.
|
|
If the region is active in `transient-mark-mode', promote all headings
|
|
in the region."
|
|
(org-back-to-heading t)
|
|
(let* ((level (save-match-data (funcall outline-level)))
|
|
(up-head (make-string (org-get-legal-level level -1) ?*))
|
|
(diff (abs (- level (length up-head)))))
|
|
(if (= level 1) (error "Cannot promote to level 0. UNDO to recover"))
|
|
(replace-match up-head nil t)
|
|
;; Fixup tag positioning
|
|
(and org-auto-align-tags (org-set-tags nil t))
|
|
(if org-adapt-indentation
|
|
(org-fixup-indentation (if (> diff 1) "^ " "^ ") ""
|
|
(if (> diff 1) "^ ? ?\\S-" "^ ?\\S-")))))
|
|
|
|
(defun org-demote ()
|
|
"Demote the current heading lower down the tree.
|
|
If the region is active in `transient-mark-mode', demote all headings
|
|
in the region."
|
|
(org-back-to-heading t)
|
|
(let* ((level (save-match-data (funcall outline-level)))
|
|
(down-head (make-string (org-get-legal-level level 1) ?*))
|
|
(diff (abs (- level (length down-head)))))
|
|
(replace-match down-head nil t)
|
|
;; Fixup tag positioning
|
|
(and org-auto-align-tags (org-set-tags nil t))
|
|
(if org-adapt-indentation
|
|
(org-fixup-indentation "^ " (if (> diff 1) " " " ") "^\\S-"))))
|
|
|
|
(defun org-map-tree (fun)
|
|
"Call FUN for every heading underneath the current one."
|
|
(org-back-to-heading)
|
|
(let ((level (funcall outline-level)))
|
|
(save-excursion
|
|
(funcall fun)
|
|
(while (and (progn
|
|
(outline-next-heading)
|
|
(> (funcall outline-level) level))
|
|
(not (eobp)))
|
|
(funcall fun)))))
|
|
|
|
(defun org-map-region (fun beg end)
|
|
"Call FUN for every heading between BEG and END."
|
|
(let ((org-ignore-region t))
|
|
(save-excursion
|
|
(setq end (copy-marker end))
|
|
(goto-char beg)
|
|
(if (and (re-search-forward (concat "^" outline-regexp) nil t)
|
|
(< (point) end))
|
|
(funcall fun))
|
|
(while (and (progn
|
|
(outline-next-heading)
|
|
(< (point) end))
|
|
(not (eobp)))
|
|
(funcall fun)))))
|
|
|
|
(defun org-fixup-indentation (from to prohibit)
|
|
"Change the indentation in the current entry by re-replacing FROM with TO.
|
|
However, if the regexp PROHIBIT matches at all, don't do anything.
|
|
This is being used to change indentation along with the length of the
|
|
heading marker. But if there are any lines which are not indented, nothing
|
|
is changed at all."
|
|
(save-excursion
|
|
(let ((end (save-excursion (outline-next-heading)
|
|
(point-marker))))
|
|
(unless (save-excursion (re-search-forward prohibit end t))
|
|
(while (re-search-forward from end t)
|
|
(replace-match to)
|
|
(beginning-of-line 2)))
|
|
(move-marker end nil))))
|
|
|
|
;;; Vertical tree motion, cutting and pasting of subtrees
|
|
|
|
(defun org-move-subtree-up (&optional arg)
|
|
"Move the current subtree up past ARG headlines of the same level."
|
|
(interactive "p")
|
|
(org-move-subtree-down (- (prefix-numeric-value arg))))
|
|
|
|
(defun org-move-subtree-down (&optional arg)
|
|
"Move the current subtree down past ARG headlines of the same level."
|
|
(interactive "p")
|
|
(setq arg (prefix-numeric-value arg))
|
|
(let ((movfunc (if (> arg 0) 'outline-get-next-sibling
|
|
'outline-get-last-sibling))
|
|
(ins-point (make-marker))
|
|
(cnt (abs arg))
|
|
beg end txt folded)
|
|
;; Select the tree
|
|
(org-back-to-heading)
|
|
(setq beg (point))
|
|
(save-match-data
|
|
(save-excursion (outline-end-of-heading)
|
|
(setq folded (org-invisible-p)))
|
|
(outline-end-of-subtree))
|
|
(outline-next-heading)
|
|
(setq end (point))
|
|
;; Find insertion point, with error handling
|
|
(goto-char beg)
|
|
(while (> cnt 0)
|
|
(or (and (funcall movfunc) (looking-at outline-regexp))
|
|
(progn (goto-char beg)
|
|
(error "Cannot move past superior level or buffer limit")))
|
|
(setq cnt (1- cnt)))
|
|
(if (> arg 0)
|
|
;; Moving forward - still need to move over subtree
|
|
(progn (outline-end-of-subtree)
|
|
(outline-next-heading)
|
|
(if (not (or (looking-at (concat "^" outline-regexp))
|
|
(bolp)))
|
|
(newline))))
|
|
(move-marker ins-point (point))
|
|
(setq txt (buffer-substring beg end))
|
|
(delete-region beg end)
|
|
(insert txt)
|
|
(goto-char ins-point)
|
|
(if folded (hide-subtree))
|
|
(move-marker ins-point nil)))
|
|
|
|
(defvar org-subtree-clip ""
|
|
"Clipboard for cut and paste of subtrees.
|
|
This is actually only a copy of the kill, because we use the normal kill
|
|
ring. We need it to check if the kill was created by `org-copy-subtree'.")
|
|
|
|
(defvar org-subtree-clip-folded nil
|
|
"Was the last copied subtree folded?
|
|
This is used to fold the tree back after pasting.")
|
|
|
|
(defun org-cut-subtree ()
|
|
"Cut the current subtree into the clipboard.
|
|
This is a short-hand for marking the subtree and then cutting it."
|
|
(interactive)
|
|
(org-copy-subtree 'cut))
|
|
|
|
(defun org-copy-subtree (&optional cut)
|
|
"Cut the current subtree into the clipboard.
|
|
This is a short-hand for marking the subtree and then copying it.
|
|
If CUT is non nil, actually cut the subtree."
|
|
(interactive)
|
|
(let (beg end folded)
|
|
(org-back-to-heading)
|
|
(setq beg (point))
|
|
(save-match-data
|
|
(save-excursion (outline-end-of-heading)
|
|
(setq folded (org-invisible-p)))
|
|
(outline-end-of-subtree))
|
|
(if (equal (char-after) ?\n) (forward-char 1))
|
|
(setq end (point))
|
|
(goto-char beg)
|
|
(when (> end beg)
|
|
(setq org-subtree-clip-folded folded)
|
|
(if cut (kill-region beg end) (copy-region-as-kill beg end))
|
|
(setq org-subtree-clip (current-kill 0))
|
|
(message "%s: Subtree with %d characters"
|
|
(if cut "Cut" "Copied")
|
|
(length org-subtree-clip)))))
|
|
|
|
(defun org-paste-subtree (&optional level tree)
|
|
"Paste the clipboard as a subtree, with modification of headline level.
|
|
The entire subtree is promoted or demoted in order to match a new headline
|
|
level. By default, the new level is derived from the visible headings
|
|
before and after the insertion point, and taken to be the inferior headline
|
|
level of the two. So if the previous visible heading is level 3 and the
|
|
next is level 4 (or vice versa), level 4 will be used for insertion.
|
|
This makes sure that the subtree remains an independent subtree and does
|
|
not swallow low level entries.
|
|
|
|
You can also force a different level, either by using a numeric prefix
|
|
argument, or by inserting the heading marker by hand. For example, if the
|
|
cursor is after \"*****\", then the tree will be shifted to level 5.
|
|
|
|
If you want to insert the tree as is, just use \\[yank].
|
|
|
|
If optional TREE is given, use this text instead of the kill ring."
|
|
(interactive "P")
|
|
(unless (org-kill-is-subtree-p tree)
|
|
(error
|
|
(substitute-command-keys
|
|
"The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway")))
|
|
(let* ((txt (or tree (current-kill 0)))
|
|
(^re (concat "^\\(" outline-regexp "\\)"))
|
|
(re (concat "\\(" outline-regexp "\\)"))
|
|
(^re_ (concat "\\(" outline-regexp "\\)[ \t]*"))
|
|
|
|
(old-level (if (string-match ^re txt)
|
|
(- (match-end 0) (match-beginning 0))
|
|
-1))
|
|
(force-level (cond (level (prefix-numeric-value level))
|
|
((string-match
|
|
^re_ (buffer-substring (point-at-bol) (point)))
|
|
(- (match-end 0) (match-beginning 0)))
|
|
(t nil)))
|
|
(previous-level (save-excursion
|
|
(condition-case nil
|
|
(progn
|
|
(outline-previous-visible-heading 1)
|
|
(if (looking-at re)
|
|
(- (match-end 0) (match-beginning 0))
|
|
1))
|
|
(error 1))))
|
|
(next-level (save-excursion
|
|
(condition-case nil
|
|
(progn
|
|
(outline-next-visible-heading 1)
|
|
(if (looking-at re)
|
|
(- (match-end 0) (match-beginning 0))
|
|
1))
|
|
(error 1))))
|
|
(new-level (or force-level (max previous-level next-level)))
|
|
(shift (if (or (= old-level -1)
|
|
(= new-level -1)
|
|
(= old-level new-level))
|
|
0
|
|
(- new-level old-level)))
|
|
(shift1 shift)
|
|
(delta (if (> shift 0) -1 1))
|
|
(func (if (> shift 0) 'org-demote 'org-promote))
|
|
(org-odd-levels-only nil)
|
|
beg end)
|
|
;; Remove the forces level indicator
|
|
(if force-level
|
|
(delete-region (point-at-bol) (point)))
|
|
;; Make sure we start at the beginning of an empty line
|
|
(if (not (bolp)) (insert "\n"))
|
|
(if (not (looking-at "[ \t]*$"))
|
|
(progn (insert "\n") (backward-char 1)))
|
|
;; Paste
|
|
(setq beg (point))
|
|
(insert txt)
|
|
(setq end (point))
|
|
(goto-char beg)
|
|
;; Shift if necessary
|
|
(if (= shift 0)
|
|
(message "Pasted at level %d, without shift" new-level)
|
|
(save-restriction
|
|
(narrow-to-region beg end)
|
|
(while (not (= shift 0))
|
|
(org-map-region func (point-min) (point-max))
|
|
(setq shift (+ delta shift)))
|
|
(goto-char (point-min))
|
|
(message "Pasted at level %d, with shift by %d levels"
|
|
new-level shift1)))
|
|
(if (and (eq org-subtree-clip (current-kill 0))
|
|
org-subtree-clip-folded)
|
|
;; The tree was folded before it was killed/copied
|
|
(hide-subtree))))
|
|
|
|
(defun org-kill-is-subtree-p (&optional txt)
|
|
"Check if the current kill is an outline subtree, or a set of trees.
|
|
Returns nil if kill does not start with a headline, or if the first
|
|
headline level is not the largest headline level in the tree.
|
|
So this will actually accept several entries of equal levels as well,
|
|
which is OK for `org-paste-subtree'.
|
|
If optional TXT is given, check this string instead of the current kill."
|
|
(let* ((kill (or txt (current-kill 0) ""))
|
|
(start-level (and (string-match (concat "\\`" outline-regexp) kill)
|
|
(- (match-end 0) (match-beginning 0))))
|
|
(re (concat "^" outline-regexp))
|
|
(start 1))
|
|
(if (not start-level)
|
|
nil ;; does not even start with a heading
|
|
(catch 'exit
|
|
(while (setq start (string-match re kill (1+ start)))
|
|
(if (< (- (match-end 0) (match-beginning 0)) start-level)
|
|
(throw 'exit nil)))
|
|
t))))
|
|
|
|
;;; Plain list items
|
|
|
|
(defun org-at-item-p ()
|
|
"Is point in a line starting a hand-formatted item?"
|
|
(let ((llt org-plain-list-ordered-item-terminator))
|
|
(save-excursion
|
|
(goto-char (point-at-bol))
|
|
(looking-at
|
|
(cond
|
|
((eq llt t) "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
|
|
((= llt ?.) "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
|
|
((= llt ?\)) "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
|
|
(t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))))))
|
|
|
|
(defun org-at-item-checkbox-p ()
|
|
"Is point at a line starting a plain-list item with a checklet?"
|
|
(and (org-at-item-p)
|
|
(save-excursion
|
|
(goto-char (match-end 0))
|
|
(skip-chars-forward " \t")
|
|
(looking-at "\\[[_X]\\]"))))
|
|
|
|
(defun org-toggle-checkbox ()
|
|
"Toggle the checkbox in the current line."
|
|
(save-excursion
|
|
(if (org-at-item-checklet-p)
|
|
(replace-match (if (equal (match-string 0) "[_]") "[X]" "[_]") t t))))
|
|
|
|
(defun org-get-indentation ()
|
|
"Get the indentation of the current line, interpreting tabs."
|
|
(save-excursion
|
|
(beginning-of-line 1)
|
|
(skip-chars-forward " \t")
|
|
(current-column)))
|
|
|
|
(defun org-beginning-of-item ()
|
|
"Go to the beginning of the current hand-formatted item.
|
|
If the cursor is not in an item, throw an error."
|
|
(let ((pos (point))
|
|
(limit (save-excursion (org-back-to-heading)
|
|
(beginning-of-line 2) (point)))
|
|
ind ind1)
|
|
(if (org-at-item-p)
|
|
(beginning-of-line 1)
|
|
(beginning-of-line 1)
|
|
(skip-chars-forward " \t")
|
|
(setq ind (current-column))
|
|
(if (catch 'exit
|
|
(while t
|
|
(beginning-of-line 0)
|
|
(if (< (point) limit) (throw 'exit nil))
|
|
(unless (looking-at " \t]*$")
|
|
(skip-chars-forward " \t")
|
|
(setq ind1 (current-column))
|
|
(if (< ind1 ind)
|
|
(throw 'exit (org-at-item-p))))))
|
|
nil
|
|
(goto-char pos)
|
|
(error "Not in an item")))))
|
|
|
|
(defun org-end-of-item ()
|
|
"Go to the end of the current hand-formatted item.
|
|
If the cursor is not in an item, throw an error."
|
|
(let ((pos (point))
|
|
(limit (save-excursion (outline-next-heading) (point)))
|
|
(ind (save-excursion
|
|
(org-beginning-of-item)
|
|
(skip-chars-forward " \t")
|
|
(current-column)))
|
|
ind1)
|
|
(if (catch 'exit
|
|
(while t
|
|
(beginning-of-line 2)
|
|
(if (>= (point) limit) (throw 'exit t))
|
|
(unless (looking-at "[ \t]*$")
|
|
(skip-chars-forward " \t")
|
|
(setq ind1 (current-column))
|
|
(if (<= ind1 ind) (throw 'exit t)))))
|
|
(beginning-of-line 1)
|
|
(goto-char pos)
|
|
(error "Not in an item"))))
|
|
|
|
(defun org-move-item-down (arg)
|
|
"Move the plain list item at point down, i.e. swap with following item.
|
|
Subitems (items with larger indentation) are considered part of the item,
|
|
so this really moves item trees."
|
|
(interactive "p")
|
|
(let (beg end ind ind1 (pos (point)) txt)
|
|
(org-beginning-of-item)
|
|
(setq beg (point))
|
|
(setq ind (org-get-indentation))
|
|
(org-end-of-item)
|
|
(setq end (point))
|
|
(setq ind1 (org-get-indentation))
|
|
(if (and (org-at-item-p) (= ind ind1))
|
|
(progn
|
|
(org-end-of-item)
|
|
(setq txt (buffer-substring beg end))
|
|
(save-excursion
|
|
(delete-region beg end))
|
|
(setq pos (point))
|
|
(insert txt)
|
|
(goto-char pos)
|
|
(org-maybe-renumber-ordered-list))
|
|
(goto-char pos)
|
|
(error "Cannot move this item further down"))))
|
|
|
|
(defun org-move-item-up (arg)
|
|
"Move the plain list item at point up, i.e. swap with previous item.
|
|
Subitems (items with larger indentation) are considered part of the item,
|
|
so this really moves item trees."
|
|
(interactive "p")
|
|
(let (beg end ind ind1 (pos (point)) txt)
|
|
(org-beginning-of-item)
|
|
(setq beg (point))
|
|
(setq ind (org-get-indentation))
|
|
(org-end-of-item)
|
|
(setq end (point))
|
|
(goto-char beg)
|
|
(catch 'exit
|
|
(while t
|
|
(beginning-of-line 0)
|
|
(if (looking-at "[ \t]*$")
|
|
nil
|
|
(if (<= (setq ind1 (org-get-indentation)) ind)
|
|
(throw 'exit t)))))
|
|
(condition-case nil
|
|
(org-beginning-of-item)
|
|
(error (goto-char beg)
|
|
(error "Cannot move this item further up")))
|
|
(setq ind1 (org-get-indentation))
|
|
(if (and (org-at-item-p) (= ind ind1))
|
|
(progn
|
|
(setq txt (buffer-substring beg end))
|
|
(save-excursion
|
|
(delete-region beg end))
|
|
(setq pos (point))
|
|
(insert txt)
|
|
(goto-char pos)
|
|
(org-maybe-renumber-ordered-list))
|
|
(goto-char pos)
|
|
(error "Cannot move this item further up"))))
|
|
|
|
(defun org-maybe-renumber-ordered-list ()
|
|
"Renumber the ordered list at point if setup allows it.
|
|
This tests the user option `org-auto-renumber-ordered-lists' before
|
|
doing the renumbering."
|
|
(and org-auto-renumber-ordered-lists
|
|
(org-at-item-p)
|
|
(match-beginning 3)
|
|
(org-renumber-ordered-list 1)))
|
|
|
|
(defun org-get-string-indentation (s)
|
|
"What indentation has S due to SPACE and TAB at the beginning of the string?"
|
|
(let ((n -1) (i 0) (w tab-width) c)
|
|
(catch 'exit
|
|
(while (< (setq n (1+ n)) (length s))
|
|
(setq c (aref s n))
|
|
(cond ((= c ?\ ) (setq i (1+ i)))
|
|
((= c ?\t) (setq i (* (/ (+ w i) w) w)))
|
|
(t (throw 'exit t)))))
|
|
i))
|
|
|
|
(defun org-renumber-ordered-list (arg)
|
|
"Renumber an ordered plain list.
|
|
Cursor needs to be in the first line of an item, the line that starts
|
|
with something like \"1.\" or \"2)\"."
|
|
(interactive "p")
|
|
(unless (and (org-at-item-p)
|
|
(match-beginning 3))
|
|
(error "This is not an ordered list"))
|
|
(let ((line (org-current-line))
|
|
(col (current-column))
|
|
(ind (org-get-string-indentation
|
|
(buffer-substring (point-at-bol) (match-beginning 3))))
|
|
;; (term (substring (match-string 3) -1))
|
|
ind1 (n (1- arg)))
|
|
;; find where this list begins
|
|
(catch 'exit
|
|
(while t
|
|
(catch 'next
|
|
(beginning-of-line 0)
|
|
(if (looking-at "[ \t]*$") (throw 'next t))
|
|
(skip-chars-forward " \t") (setq ind1 (current-column))
|
|
(if (or (< ind1 ind)
|
|
(and (= ind1 ind)
|
|
(not (org-at-item-p))))
|
|
(throw 'exit t)))))
|
|
;; Walk forward and replace these numbers
|
|
(catch 'exit
|
|
(while t
|
|
(catch 'next
|
|
(beginning-of-line 2)
|
|
(if (eobp) (throw 'exit nil))
|
|
(if (looking-at "[ \t]*$") (throw 'next nil))
|
|
(skip-chars-forward " \t") (setq ind1 (current-column))
|
|
(if (> ind1 ind) (throw 'next t))
|
|
(if (< ind1 ind) (throw 'exit t))
|
|
(if (not (org-at-item-p)) (throw 'exit nil))
|
|
(if (not (match-beginning 3))
|
|
(error "unordered bullet in ordered list. Press \\[undo] to recover"))
|
|
(delete-region (match-beginning 3) (1- (match-end 3)))
|
|
(goto-char (match-beginning 3))
|
|
(insert (format "%d" (setq n (1+ n)))))))
|
|
(goto-line line)
|
|
(move-to-column col)))
|
|
|
|
(defvar org-last-indent-begin-marker (make-marker))
|
|
(defvar org-last-indent-end-marker (make-marker))
|
|
|
|
(defun org-outdent-item (arg)
|
|
"Outdent a local list item."
|
|
(interactive "p")
|
|
(org-indent-item (- arg)))
|
|
|
|
(defun org-indent-item (arg)
|
|
"Indent a local list item."
|
|
(interactive "p")
|
|
(unless (org-at-item-p)
|
|
(error "Not on an item"))
|
|
(let (beg end ind ind1)
|
|
(if (memq last-command '(org-shiftmetaright org-shiftmetaleft))
|
|
(setq beg org-last-indent-begin-marker
|
|
end org-last-indent-end-marker)
|
|
(org-beginning-of-item)
|
|
(setq beg (move-marker org-last-indent-begin-marker (point)))
|
|
(org-end-of-item)
|
|
(setq end (move-marker org-last-indent-end-marker (point))))
|
|
(goto-char beg)
|
|
(skip-chars-forward " \t") (setq ind (current-column))
|
|
(if (< (+ arg ind) 0) (error "Cannot outdent beyond margin"))
|
|
(while (< (point) end)
|
|
(beginning-of-line 1)
|
|
(skip-chars-forward " \t") (setq ind1 (current-column))
|
|
(delete-region (point-at-bol) (point))
|
|
(indent-to-column (+ ind1 arg))
|
|
(beginning-of-line 2))
|
|
(goto-char beg)))
|
|
|
|
;;; Archiving
|
|
|
|
(defun org-archive-subtree ()
|
|
"Move the current subtree to the archive.
|
|
The archive can be a certain top-level heading in the current file, or in
|
|
a different file. The tree will be moved to that location, the subtree
|
|
heading be marked DONE, and the current time will be added."
|
|
(interactive)
|
|
;; Save all relevant TODO keyword-relatex variables
|
|
(let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler
|
|
(tr-org-todo-keywords org-todo-keywords)
|
|
(tr-org-todo-interpretation org-todo-interpretation)
|
|
(tr-org-done-string org-done-string)
|
|
(tr-org-todo-regexp org-todo-regexp)
|
|
(tr-org-todo-line-regexp org-todo-line-regexp)
|
|
(this-buffer (current-buffer))
|
|
file heading buffer level newfile-p)
|
|
(if (string-match "\\(.*\\)::\\(.*\\)" org-archive-location)
|
|
(progn
|
|
(setq file (format (match-string 1 org-archive-location)
|
|
(file-name-nondirectory buffer-file-name))
|
|
heading (match-string 2 org-archive-location)))
|
|
(error "Invalid `org-archive-location'"))
|
|
(if (> (length file) 0)
|
|
(setq newfile-p (not (file-exists-p file))
|
|
buffer (find-file-noselect file))
|
|
(setq buffer (current-buffer)))
|
|
(unless buffer
|
|
(error "Cannot access file \"%s\"" file))
|
|
(if (and (> (length heading) 0)
|
|
(string-match "^\\*+" heading))
|
|
(setq level (match-end 0))
|
|
(setq heading nil level 0))
|
|
(save-excursion
|
|
;; We first only copy, in case something goes wrong
|
|
;; we need to protect this-command, to avoid kill-region sets it,
|
|
;; which would lead to duplication of subtrees
|
|
(let (this-command) (org-copy-subtree))
|
|
(set-buffer buffer)
|
|
;; Enforce org-mode for the archive buffer
|
|
(if (not (eq major-mode 'org-mode))
|
|
;; Force the mode for future visits.
|
|
(let ((org-insert-mode-line-in-empty-file t))
|
|
(call-interactively 'org-mode)))
|
|
(when newfile-p
|
|
(goto-char (point-max))
|
|
(insert (format "\nArchived entries from file %s\n\n"
|
|
(buffer-file-name this-buffer))))
|
|
;; Force the TODO keywords of the original buffer
|
|
(let ((org-todo-line-regexp tr-org-todo-line-regexp)
|
|
(org-todo-keywords tr-org-todo-keywords)
|
|
(org-todo-interpretation tr-org-todo-interpretation)
|
|
(org-done-string tr-org-done-string)
|
|
(org-todo-regexp tr-org-todo-regexp)
|
|
(org-todo-line-regexp tr-org-todo-line-regexp))
|
|
(goto-char (point-min))
|
|
(if heading
|
|
(progn
|
|
(if (re-search-forward
|
|
(concat "\\(^\\|\r\\)"
|
|
(regexp-quote heading) "[ \t]*\\($\\|\r\\)")
|
|
nil t)
|
|
(goto-char (match-end 0))
|
|
;; Heading not found, just insert it at the end
|
|
(goto-char (point-max))
|
|
(or (bolp) (insert "\n"))
|
|
(insert "\n" heading "\n")
|
|
(end-of-line 0))
|
|
;; Make the heading visible, and the following as well
|
|
(let ((org-show-following-heading t)) (org-show-hierarchy-above))
|
|
(if (re-search-forward
|
|
(concat "^" (regexp-quote (make-string level ?*)) "[ \t]")
|
|
nil t)
|
|
(progn (goto-char (match-beginning 0)) (insert "\n")
|
|
(beginning-of-line 0))
|
|
(goto-char (point-max)) (insert "\n")))
|
|
(goto-char (point-max)) (insert "\n"))
|
|
;; Paste
|
|
(org-paste-subtree (1+ level))
|
|
;; Mark the entry as done, i.e. set to last work in org-todo-keywords
|
|
(if org-archive-mark-done
|
|
(org-todo (length org-todo-keywords)))
|
|
;; Move cursor to right after the TODO keyword
|
|
(when org-archive-stamp-time
|
|
(beginning-of-line 1)
|
|
(looking-at org-todo-line-regexp)
|
|
(goto-char (or (match-end 2) (match-beginning 3)))
|
|
(insert "(" (format-time-string (cdr org-time-stamp-formats)
|
|
(org-current-time))
|
|
")"))
|
|
;; Save the buffer, if it is not the same buffer.
|
|
(if (not (eq this-buffer buffer)) (save-buffer))))
|
|
;; Here we are back in the original buffer. Everything seems to have
|
|
;; worked. So now cut the tree and finish up.
|
|
(let (this-command) (org-cut-subtree))
|
|
(if (and (not (eobp)) (looking-at "[ \t]*$")) (kill-line))
|
|
(message "Subtree archived %s"
|
|
(if (eq this-buffer buffer)
|
|
(concat "under heading: " heading)
|
|
(concat "in file: " (abbreviate-file-name file))))))
|
|
|
|
;;; Completion
|
|
|
|
(defun org-complete (&optional arg)
|
|
"Perform completion on word at point.
|
|
At the beginning of a headline, this completes TODO keywords as given in
|
|
`org-todo-keywords'.
|
|
If the current word is preceded by a backslash, completes the TeX symbols
|
|
that are supported for HTML support.
|
|
If the current word is preceded by \"#+\", completes special words for
|
|
setting file options.
|
|
At all other locations, this simply calls `ispell-complete-word'."
|
|
(interactive "P")
|
|
(catch 'exit
|
|
(let* ((end (point))
|
|
(beg1 (save-excursion
|
|
(if (equal (char-before (point)) ?\ ) (backward-char 1))
|
|
(skip-chars-backward "a-zA-Z_@0-9")
|
|
(point)))
|
|
(beg (save-excursion
|
|
(if (equal (char-before (point)) ?\ ) (backward-char 1))
|
|
(skip-chars-backward "a-zA-Z0-9_:$")
|
|
(point)))
|
|
(camel (equal (char-before beg) ?*))
|
|
(tag (equal (char-before beg1) ?:))
|
|
(texp (equal (char-before beg) ?\\))
|
|
(opt (equal (buffer-substring (max (point-at-bol) (- beg 2))
|
|
beg)
|
|
"#+"))
|
|
(completion-ignore-case opt)
|
|
(type nil)
|
|
(tbl nil)
|
|
(table (cond
|
|
(opt
|
|
(setq type :opt)
|
|
(mapcar (lambda (x)
|
|
(string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x)
|
|
(cons (match-string 2 x) (match-string 1 x)))
|
|
(org-split-string (org-get-current-options) "\n")))
|
|
(texp
|
|
(setq type :tex)
|
|
org-html-entities)
|
|
((string-match "\\`\\*+[ \t]*\\'"
|
|
(buffer-substring (point-at-bol) beg))
|
|
(setq type :todo)
|
|
(mapcar 'list org-todo-keywords))
|
|
(camel
|
|
(setq type :camel)
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(while (re-search-forward org-todo-line-regexp nil t)
|
|
(push (list
|
|
(if org-file-link-context-use-camel-case
|
|
(org-make-org-heading-camel (match-string 3) t)
|
|
(org-make-org-heading-search-string
|
|
(match-string 3) t)))
|
|
tbl)))
|
|
tbl)
|
|
(tag (setq type :tag beg beg1)
|
|
(org-get-buffer-tags))
|
|
(t (progn (ispell-complete-word arg) (throw 'exit nil)))))
|
|
(pattern (buffer-substring-no-properties beg end))
|
|
(completion (try-completion pattern table)))
|
|
(cond ((eq completion t)
|
|
(if (equal type :opt)
|
|
(insert (substring (cdr (assoc (upcase pattern) table))
|
|
(length pattern)))))
|
|
((null completion)
|
|
(message "Can't find completion for \"%s\"" pattern)
|
|
(ding))
|
|
((not (string= pattern completion))
|
|
(delete-region beg end)
|
|
(if (string-match " +$" completion)
|
|
(setq completion (replace-match "" t t completion)))
|
|
(insert completion)
|
|
(if (get-buffer-window "*Completions*")
|
|
(delete-window (get-buffer-window "*Completions*")))
|
|
(if (assoc completion table)
|
|
(if (eq type :todo) (insert " ")
|
|
(if (eq type :tag) (insert ":"))))
|
|
(if (and (equal type :opt) (assoc completion table))
|
|
(message "%s" (substitute-command-keys
|
|
"Press \\[org-complete] again to insert example settings"))))
|
|
(t
|
|
(message "Making completion list...")
|
|
(let ((list (sort (all-completions pattern table) 'string<)))
|
|
(with-output-to-temp-buffer "*Completions*"
|
|
(condition-case nil
|
|
;; Protection needed for XEmacs and emacs 21
|
|
(display-completion-list list pattern)
|
|
(error (display-completion-list list)))))
|
|
(message "Making completion list...%s" "done"))))))
|
|
|
|
;;; Comments, TODO and DEADLINE
|
|
|
|
(defun org-toggle-comment ()
|
|
"Change the COMMENT state of an entry."
|
|
(interactive)
|
|
(save-excursion
|
|
(org-back-to-heading)
|
|
(if (looking-at (concat outline-regexp
|
|
"\\( +\\<" org-comment-string "\\>\\)"))
|
|
(replace-match "" t t nil 1)
|
|
(if (looking-at outline-regexp)
|
|
(progn
|
|
(goto-char (match-end 0))
|
|
(insert " " org-comment-string))))))
|
|
|
|
(defvar org-last-todo-state-is-todo nil
|
|
"This is non-nil when the last TODO state change led to a TODO state.
|
|
If the last change removed the TODO tag or switched to DONE, then
|
|
this is nil.")
|
|
|
|
(defun org-todo (&optional arg)
|
|
"Change the TODO state of an item.
|
|
The state of an item is given by a keyword at the start of the heading,
|
|
like
|
|
*** TODO Write paper
|
|
*** DONE Call mom
|
|
|
|
The different keywords are specified in the variable `org-todo-keywords'.
|
|
By default the available states are \"TODO\" and \"DONE\".
|
|
So for this example: when the item starts with TODO, it is changed to DONE.
|
|
When it starts with DONE, the DONE is removed. And when neither TODO nor
|
|
DONE are present, add TODO at the beginning of the heading.
|
|
|
|
With prefix arg, use completion to determine the new state. With numeric
|
|
prefix arg, switch to that state."
|
|
(interactive "P")
|
|
(save-excursion
|
|
(org-back-to-heading)
|
|
(if (looking-at outline-regexp) (goto-char (match-end 0)))
|
|
(or (looking-at (concat " +" org-todo-regexp " *"))
|
|
(looking-at " *"))
|
|
(let* ((this (match-string 1))
|
|
(completion-ignore-case t)
|
|
(member (member this org-todo-keywords))
|
|
(tail (cdr member))
|
|
(state (cond
|
|
((equal arg '(4))
|
|
;; Read a state with completion
|
|
(completing-read "State: " (mapcar (lambda(x) (list x))
|
|
org-todo-keywords)
|
|
nil t))
|
|
((eq arg 'right)
|
|
(if this
|
|
(if tail (car tail) nil)
|
|
(car org-todo-keywords)))
|
|
((eq arg 'left)
|
|
(if (equal member org-todo-keywords)
|
|
nil
|
|
(if this
|
|
(nth (- (length org-todo-keywords) (length tail) 2)
|
|
org-todo-keywords)
|
|
org-done-string)))
|
|
(arg
|
|
;; user requests a specific state
|
|
(nth (1- (prefix-numeric-value arg))
|
|
org-todo-keywords))
|
|
((null member) (car org-todo-keywords))
|
|
((null tail) nil) ;; -> first entry
|
|
((eq org-todo-interpretation 'sequence)
|
|
(car tail))
|
|
((memq org-todo-interpretation '(type priority))
|
|
(if (eq this-command last-command)
|
|
(car tail)
|
|
(if (> (length tail) 0) org-done-string nil)))
|
|
(t nil)))
|
|
(next (if state (concat " " state " ") " ")))
|
|
(replace-match next t t)
|
|
(setq org-last-todo-state-is-todo
|
|
(not (equal state org-done-string)))
|
|
(when org-log-done
|
|
(if (equal state org-done-string)
|
|
(org-add-planning-info 'closed (current-time) 'scheduled)
|
|
(if (not this)
|
|
(org-add-planning-info nil nil 'closed))))
|
|
;; Fixup tag positioning
|
|
(and org-auto-align-tags (org-set-tags nil t))
|
|
(run-hooks 'org-after-todo-state-change-hook)))
|
|
;; Fixup cursor location if close to the keyword
|
|
(if (and (outline-on-heading-p)
|
|
(not (bolp))
|
|
(save-excursion (beginning-of-line 1)
|
|
(looking-at org-todo-line-regexp))
|
|
(< (point) (+ 2 (or (match-end 2) (match-end 1)))))
|
|
(progn
|
|
(goto-char (or (match-end 2) (match-end 1)))
|
|
(just-one-space))))
|
|
|
|
(defun org-log-done (&optional undone)
|
|
"Add a time stamp logging that a TODO entry has been closed.
|
|
When UNDONE is non-nil, remove such a time stamp again."
|
|
(interactive)
|
|
(let (beg end col)
|
|
(save-excursion
|
|
(org-back-to-heading t)
|
|
(setq beg (point))
|
|
(looking-at (concat outline-regexp " *"))
|
|
(goto-char (match-end 0))
|
|
(setq col (current-column))
|
|
(outline-next-heading)
|
|
(setq end (point))
|
|
(goto-char beg)
|
|
(when (re-search-forward (concat
|
|
"[\r\n]\\([ \t]*"
|
|
(regexp-quote org-closed-string)
|
|
" *\\[.*?\\][^\n\r]*[\n\r]?\\)") end t)
|
|
(delete-region (match-beginning 1) (match-end 1)))
|
|
(unless undone
|
|
(org-back-to-heading t)
|
|
(skip-chars-forward "^\n\r")
|
|
(goto-char (min (1+ (point)) (point-max)))
|
|
(when (not (member (char-before) '(?\r ?\n)))
|
|
(insert "\n"))
|
|
(indent-to col)
|
|
(insert org-closed-string " "
|
|
(format-time-string
|
|
(concat "[" (substring (cdr org-time-stamp-formats) 1 -1) "]")
|
|
(org-current-time))
|
|
"\n")))))
|
|
|
|
(defun org-show-todo-tree (arg)
|
|
"Make a compact tree which shows all headlines marked with TODO.
|
|
The tree will show the lines where the regexp matches, and all higher
|
|
headlines above the match.
|
|
With \\[universal-argument] prefix, also show the DONE entries.
|
|
With a numeric prefix N, construct a sparse tree for the Nth element
|
|
of `org-todo-keywords'."
|
|
(interactive "P")
|
|
(let ((case-fold-search nil)
|
|
(kwd-re
|
|
(cond ((null arg) org-not-done-regexp)
|
|
((equal arg '(4)) org-todo-regexp)
|
|
((<= (prefix-numeric-value arg) (length org-todo-keywords))
|
|
(regexp-quote (nth (1- (prefix-numeric-value arg))
|
|
org-todo-keywords)))
|
|
(t (error "Invalid prefix argument: %s" arg)))))
|
|
(message "%d TODO entries found"
|
|
(org-occur (concat "^" outline-regexp " +" kwd-re )))))
|
|
|
|
(defun org-deadline ()
|
|
"Insert the DEADLINE: string to make a deadline.
|
|
A timestamp is also inserted - use \\[org-timestamp-up] and \\[org-timestamp-down]
|
|
to modify it to the correct date."
|
|
(interactive)
|
|
(org-add-planning-info 'deadline nil 'closed))
|
|
|
|
(defun org-schedule ()
|
|
"Insert the SCHEDULED: string to schedule a TODO item.
|
|
A timestamp is also inserted - use \\[org-timestamp-up] and \\[org-timestamp-down]
|
|
to modify it to the correct date."
|
|
(interactive)
|
|
(org-add-planning-info 'scheduled nil 'closed))
|
|
|
|
(defun org-add-planning-info (what &optional time &rest remove)
|
|
"Insert new timestamp with keyword in the line directly after the headline.
|
|
WHAT indicates what kind of time stamp to add. TIME indicated the time to use.
|
|
If non is given, the user is prompted for a date.
|
|
REMOVE indicates what kind of entries to remove. An old WHAT entry will also
|
|
be removed."
|
|
(interactive)
|
|
(when what (setq time (or time (org-read-date nil 'to-time))))
|
|
(when (and org-insert-labeled-timestamps-at-point
|
|
(member what '(scheduled deadline)))
|
|
(insert
|
|
(if (eq what 'scheduled) org-scheduled-string org-deadline-string)
|
|
" "
|
|
(format-time-string (car org-time-stamp-formats) time))
|
|
(setq what nil))
|
|
(save-excursion
|
|
(let (beg end col list elt (buffer-invisibility-spec nil) ts)
|
|
(org-back-to-heading t)
|
|
(setq beg (point))
|
|
(looking-at (concat outline-regexp "\\( *\\)[^\r\n]*"))
|
|
(goto-char (match-end 1))
|
|
(setq col (current-column))
|
|
(goto-char (1+ (match-end 0)))
|
|
(if (and (not (looking-at outline-regexp))
|
|
(looking-at (concat "[^\r\n]*?" org-keyword-time-regexp
|
|
"[^\r\n]*")))
|
|
(narrow-to-region (match-beginning 0) (match-end 0))
|
|
(insert "\n")
|
|
(backward-char 1)
|
|
(narrow-to-region (point) (point))
|
|
(indent-to-column col))
|
|
;; Check if we have to remove something.
|
|
(setq list (cons what remove))
|
|
(while list
|
|
(setq elt (pop list))
|
|
(goto-char (point-min))
|
|
(when (or (and (eq elt 'scheduled)
|
|
(re-search-forward org-scheduled-time-regexp nil t))
|
|
(and (eq elt 'deadline)
|
|
(re-search-forward org-deadline-time-regexp nil t))
|
|
(and (eq elt 'closed)
|
|
(re-search-forward org-closed-time-regexp nil t)))
|
|
(replace-match "")
|
|
(if (looking-at " +") (replace-match ""))))
|
|
(goto-char (point-max))
|
|
(when what
|
|
(insert
|
|
(if (not (equal (char-before) ?\ )) " " "")
|
|
(cond ((eq what 'scheduled) org-scheduled-string)
|
|
((eq what 'deadline) org-deadline-string)
|
|
((eq what 'closed) org-closed-string))
|
|
" ")
|
|
(insert
|
|
(setq ts
|
|
(format-time-string
|
|
(if (eq what 'closed)
|
|
(concat "[" (substring (cdr org-time-stamp-formats) 1 -1) "]")
|
|
(car org-time-stamp-formats))
|
|
time))))
|
|
(goto-char (point-min))
|
|
(widen)
|
|
(if (looking-at "[ \t]+\r?\n")
|
|
(replace-match ""))
|
|
ts)))
|
|
|
|
(defun org-occur (regexp &optional callback)
|
|
"Make a compact tree which shows all matches of REGEXP.
|
|
The tree will show the lines where the regexp matches, and all higher
|
|
headlines above the match. It will also show the heading after the match,
|
|
to make sure editing the matching entry is easy.
|
|
If CALLBACK is non-nil, it is a function which is called to confirm
|
|
that the match should indeed be shown."
|
|
(interactive "sRegexp: ")
|
|
(org-remove-occur-highlights nil nil t)
|
|
(setq regexp (org-check-occur-regexp regexp))
|
|
(let ((cnt 0))
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(org-overview)
|
|
(while (re-search-forward regexp nil t)
|
|
(when (or (not callback)
|
|
(save-match-data (funcall callback)))
|
|
(setq cnt (1+ cnt))
|
|
(org-highlight-new-match (match-beginning 0) (match-end 0))
|
|
(org-show-hierarchy-above))))
|
|
(org-add-hook 'before-change-functions 'org-remove-occur-highlights
|
|
nil 'local)
|
|
(run-hooks 'org-occur-hook)
|
|
(if (interactive-p)
|
|
(message "%d match(es) for regexp %s" cnt regexp))
|
|
cnt))
|
|
|
|
(defun org-show-hierarchy-above ()
|
|
"Make sure point and the headings hierarchy above is visible."
|
|
(catch 'exit
|
|
(if (org-on-heading-p t)
|
|
(org-flag-heading nil) ; only show the heading
|
|
(and (or (org-invisible-p) (org-invisible-p2))
|
|
(org-show-hidden-entry))) ; show entire entry
|
|
(save-excursion
|
|
(and org-show-following-heading
|
|
(outline-next-heading)
|
|
(org-flag-heading nil))) ; show the next heading
|
|
(when org-show-hierarchy-above
|
|
(save-excursion ; show all higher headings
|
|
(while (and (condition-case nil
|
|
(progn (org-up-heading-all 1) t)
|
|
(error nil))
|
|
(not (bobp)))
|
|
(org-flag-heading nil))))))
|
|
|
|
;; Overlay compatibility functions
|
|
(defun org-make-overlay (beg end &optional buffer)
|
|
(if (featurep 'xemacs)
|
|
(make-extent beg end buffer)
|
|
(make-overlay beg end buffer)))
|
|
(defun org-delete-overlay (ovl)
|
|
(if (featurep 'xemacs) (delete-extent ovl) (delete-overlay ovl)))
|
|
(defun org-detatch-overlay (ovl)
|
|
(if (featurep 'xemacs) (detach-extent ovl) (delete-overlay ovl)))
|
|
(defun org-move-overlay (ovl beg end &optional buffer)
|
|
(if (featurep 'xemacs)
|
|
(set-extent-endpoints ovl beg end buffer)
|
|
(move-overlay ovl beg end buffer)))
|
|
(defun org-overlay-put (ovl prop value)
|
|
(if (featurep 'xemacs)
|
|
(set-extent-property ovl prop value)
|
|
(overlay-put ovl prop value)))
|
|
|
|
(defvar org-occur-highlights nil)
|
|
(defun org-highlight-new-match (beg end)
|
|
"Highlight from BEG to END and mark the highlight is an occur headline."
|
|
(let ((ov (org-make-overlay beg end)))
|
|
(org-overlay-put ov 'face 'secondary-selection)
|
|
(push ov org-occur-highlights)))
|
|
|
|
(defun org-remove-occur-highlights (&optional beg end noremove)
|
|
"Remove the occur highlights from the buffer.
|
|
BEG and END are ignored. If NOREMOVE is nil, remove this function
|
|
from the `before-change-functions' in the current buffer."
|
|
(interactive)
|
|
(mapc 'org-delete-overlay org-occur-highlights)
|
|
(setq org-occur-highlights nil)
|
|
(unless noremove
|
|
(remove-hook 'before-change-functions
|
|
'org-remove-occur-highlights 'local)))
|
|
|
|
;;; Priorities
|
|
|
|
(defvar org-priority-regexp ".*?\\(\\[#\\([A-Z]\\)\\] ?\\)"
|
|
"Regular expression matching the priority indicator.")
|
|
|
|
(defvar org-remove-priority-next-time nil)
|
|
|
|
(defun org-priority-up ()
|
|
"Increase the priority of the current item."
|
|
(interactive)
|
|
(org-priority 'up))
|
|
|
|
(defun org-priority-down ()
|
|
"Decrease the priority of the current item."
|
|
(interactive)
|
|
(org-priority 'down))
|
|
|
|
(defun org-priority (&optional action)
|
|
"Change the priority of an item by ARG.
|
|
ACTION can be set, up, or down."
|
|
(interactive)
|
|
(setq action (or action 'set))
|
|
(let (current new news have remove)
|
|
(save-excursion
|
|
(org-back-to-heading)
|
|
(if (looking-at org-priority-regexp)
|
|
(setq current (string-to-char (match-string 2))
|
|
have t)
|
|
(setq current org-default-priority))
|
|
(cond
|
|
((eq action 'set)
|
|
(message "Priority A-%c, SPC to remove: " org-lowest-priority)
|
|
(setq new (read-char-exclusive))
|
|
(cond ((equal new ?\ ) (setq remove t))
|
|
((or (< (upcase new) ?A) (> (upcase new) org-lowest-priority))
|
|
(error "Priority must be between `%c' and `%c'"
|
|
?A org-lowest-priority))))
|
|
((eq action 'up)
|
|
(setq new (1- current)))
|
|
((eq action 'down)
|
|
(setq new (1+ current)))
|
|
(t (error "Invalid action")))
|
|
(setq new (min (max ?A (upcase new)) org-lowest-priority))
|
|
(setq news (format "%c" new))
|
|
(if have
|
|
(if remove
|
|
(replace-match "" t t nil 1)
|
|
(replace-match news t t nil 2))
|
|
(if remove
|
|
(error "No priority cookie found in line")
|
|
(looking-at org-todo-line-regexp)
|
|
(if (match-end 2)
|
|
(progn
|
|
(goto-char (match-end 2))
|
|
(insert " [#" news "]"))
|
|
(goto-char (match-beginning 3))
|
|
(insert "[#" news "] ")))))
|
|
(if remove
|
|
(message "Priority removed")
|
|
(message "Priority of current item set to %s" news))))
|
|
|
|
|
|
(defun org-get-priority (s)
|
|
"Find priority cookie and return priority."
|
|
(save-match-data
|
|
(if (not (string-match org-priority-regexp s))
|
|
(* 1000 (- org-lowest-priority org-default-priority))
|
|
(* 1000 (- org-lowest-priority
|
|
(string-to-char (match-string 2 s)))))))
|
|
|
|
;;; Timestamps
|
|
|
|
(defvar org-last-changed-timestamp nil)
|
|
|
|
(defun org-time-stamp (arg)
|
|
"Prompt for a date/time and insert a time stamp.
|
|
If the user specifies a time like HH:MM, or if this command is called
|
|
with a prefix argument, the time stamp will contain date and time.
|
|
Otherwise, only the date will be included. All parts of a date not
|
|
specified by the user will be filled in from the current date/time.
|
|
So if you press just return without typing anything, the time stamp
|
|
will represent the current date/time. If there is already a timestamp
|
|
at the cursor, it will be modified."
|
|
(interactive "P")
|
|
(let ((fmt (if arg (cdr org-time-stamp-formats)
|
|
(car org-time-stamp-formats)))
|
|
(org-time-was-given nil)
|
|
time)
|
|
(cond
|
|
((and (org-at-timestamp-p)
|
|
(eq last-command 'org-time-stamp)
|
|
(eq this-command 'org-time-stamp))
|
|
(insert "--")
|
|
(setq time (let ((this-command this-command))
|
|
(org-read-date arg 'totime)))
|
|
(if org-time-was-given (setq fmt (cdr org-time-stamp-formats)))
|
|
(insert (format-time-string fmt time)))
|
|
((org-at-timestamp-p)
|
|
(setq time (let ((this-command this-command))
|
|
(org-read-date arg 'totime)))
|
|
(and (org-at-timestamp-p) (replace-match
|
|
(setq org-last-changed-timestamp
|
|
(format-time-string fmt time))
|
|
t t))
|
|
(message "Timestamp updated"))
|
|
(t
|
|
(setq time (let ((this-command this-command))
|
|
(org-read-date arg 'totime)))
|
|
(if org-time-was-given (setq fmt (cdr org-time-stamp-formats)))
|
|
(insert (format-time-string fmt time))))))
|
|
|
|
(defun org-time-stamp-inactive (&optional arg)
|
|
"Insert an inactive time stamp.
|
|
An inactive time stamp is enclosed in square brackets instead of angle
|
|
brackets. It is inactive in the sense that it does not trigger agenda entries,
|
|
does not link to the calendar and cannot be changed with the S-cursor keys.
|
|
So these are more for recording a certain time/date."
|
|
(interactive "P")
|
|
(let ((fmt (if arg (cdr org-time-stamp-formats)
|
|
(car org-time-stamp-formats)))
|
|
(org-time-was-given nil)
|
|
time)
|
|
(setq time (org-read-date arg 'totime))
|
|
(if org-time-was-given (setq fmt (cdr org-time-stamp-formats)))
|
|
(setq fmt (concat "[" (substring fmt 1 -1) "]"))
|
|
(insert (format-time-string fmt time))))
|
|
|
|
(defvar org-date-ovl (org-make-overlay 1 1))
|
|
(org-overlay-put org-date-ovl 'face 'org-warning)
|
|
(org-detatch-overlay org-date-ovl)
|
|
|
|
(defun org-read-date (&optional with-time to-time)
|
|
"Read a date and make things smooth for the user.
|
|
The prompt will suggest to enter an ISO date, but you can also enter anything
|
|
which will at least partially be understood by `parse-time-string'.
|
|
Unrecognized parts of the date will default to the current day, month, year,
|
|
hour and minute. For example,
|
|
3-2-5 --> 2003-02-05
|
|
feb 15 --> currentyear-02-15
|
|
sep 12 9 --> 2009-09-12
|
|
12:45 --> today 12:45
|
|
22 sept 0:34 --> currentyear-09-22 0:34
|
|
12 --> currentyear-currentmonth-12
|
|
Fri --> nearest Friday (today or later)
|
|
etc.
|
|
The function understands only English month and weekday abbreviations,
|
|
but this can be configured with the variables `parse-time-months' and
|
|
`parse-time-weekdays'.
|
|
|
|
While prompting, a calendar is popped up - you can also select the
|
|
date with the mouse (button 1). The calendar shows a period of three
|
|
months. To scroll it to other months, use the keys `>' and `<'.
|
|
If you don't like the calendar, turn it off with
|
|
\(setq org-popup-calendar-for-date-prompt nil)
|
|
|
|
With optional argument TO-TIME, the date will immediately be converted
|
|
to an internal time.
|
|
With an optional argument WITH-TIME, the prompt will suggest to also
|
|
insert a time. Note that when WITH-TIME is not set, you can still
|
|
enter a time, and this function will inform the calling routine about
|
|
this change. The calling routine may then choose to change the format
|
|
used to insert the time stamp into the buffer to include the time."
|
|
(require 'parse-time)
|
|
(let* ((org-time-stamp-rounding-minutes
|
|
(if (equal with-time '(16)) 0 org-time-stamp-rounding-minutes))
|
|
(ct (org-current-time))
|
|
(default-time
|
|
;; Default time is either today, or, when entering a range,
|
|
;; the range start.
|
|
(if (save-excursion
|
|
(re-search-backward
|
|
(concat org-ts-regexp "--\\=") ; FIXME: exactly two minuses?
|
|
(- (point) 20) t))
|
|
(apply
|
|
'encode-time
|
|
(mapcar (lambda(x) (or x 0))
|
|
(parse-time-string (match-string 1))))
|
|
ct))
|
|
(calendar-move-hook nil)
|
|
(view-diary-entries-initially nil)
|
|
(view-calendar-holidays-initially nil)
|
|
(timestr (format-time-string
|
|
(if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") default-time))
|
|
(prompt (format "YYYY-MM-DD [%s]: " timestr))
|
|
ans ans1 ans2
|
|
second minute hour day month year tl wday wday1)
|
|
|
|
(if org-popup-calendar-for-date-prompt
|
|
(save-excursion
|
|
(save-window-excursion
|
|
(calendar)
|
|
(calendar-forward-day (- (time-to-days default-time)
|
|
(calendar-absolute-from-gregorian
|
|
(calendar-current-date))))
|
|
(org-eval-in-calendar nil)
|
|
(let* ((old-map (current-local-map))
|
|
(map (copy-keymap calendar-mode-map))
|
|
(minibuffer-local-map (copy-keymap minibuffer-local-map)))
|
|
(define-key map (kbd "RET") 'org-calendar-select)
|
|
(define-key map (if (featurep 'xemacs) [button1] [mouse-1])
|
|
'org-calendar-select-mouse)
|
|
(define-key map (if (featurep 'xemacs) [button2] [mouse-2])
|
|
'org-calendar-select-mouse)
|
|
(define-key minibuffer-local-map [(meta shift left)]
|
|
(lambda () (interactive)
|
|
(org-eval-in-calendar '(calendar-backward-month 1))))
|
|
(define-key minibuffer-local-map [(meta shift right)]
|
|
(lambda () (interactive)
|
|
(org-eval-in-calendar '(calendar-forward-month 1))))
|
|
(define-key minibuffer-local-map [(shift up)]
|
|
(lambda () (interactive)
|
|
(org-eval-in-calendar '(calendar-backward-week 1))))
|
|
(define-key minibuffer-local-map [(shift down)]
|
|
(lambda () (interactive)
|
|
(org-eval-in-calendar '(calendar-forward-week 1))))
|
|
(define-key minibuffer-local-map [(shift left)]
|
|
(lambda () (interactive)
|
|
(org-eval-in-calendar '(calendar-backward-day 1))))
|
|
(define-key minibuffer-local-map [(shift right)]
|
|
(lambda () (interactive)
|
|
(org-eval-in-calendar '(calendar-forward-day 1))))
|
|
(define-key minibuffer-local-map ">"
|
|
(lambda () (interactive)
|
|
(org-eval-in-calendar '(scroll-calendar-left 1))))
|
|
(define-key minibuffer-local-map "<"
|
|
(lambda () (interactive)
|
|
(org-eval-in-calendar '(scroll-calendar-right 1))))
|
|
(unwind-protect
|
|
(progn
|
|
(use-local-map map)
|
|
(setq ans (read-string prompt "" nil nil))
|
|
(if (not (string-match "\\S-" ans)) (setq ans nil))
|
|
(setq ans (or ans1 ans ans2)))
|
|
(use-local-map old-map)))))
|
|
;; Naked prompt only
|
|
(setq ans (read-string prompt "" nil timestr)))
|
|
(org-detatch-overlay org-date-ovl)
|
|
|
|
(if (string-match
|
|
"^ *\\(\\([0-9]+\\)-\\)?\\([0-1]?[0-9]\\)-\\([0-3]?[0-9]\\)\\([^-0-9]\\|$\\)" ans)
|
|
(progn
|
|
(setq year (if (match-end 2)
|
|
(string-to-number (match-string 2 ans))
|
|
(string-to-number (format-time-string "%Y")))
|
|
month (string-to-number (match-string 3 ans))
|
|
day (string-to-number (match-string 4 ans)))
|
|
(if (< year 100) (setq year (+ 2000 year)))
|
|
(setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day)
|
|
t nil ans))))
|
|
(setq tl (parse-time-string ans)
|
|
year (or (nth 5 tl) (string-to-number (format-time-string "%Y" ct)))
|
|
month (or (nth 4 tl) (string-to-number (format-time-string "%m" ct)))
|
|
day (or (nth 3 tl) (string-to-number (format-time-string "%d" ct)))
|
|
hour (or (nth 2 tl) (string-to-number (format-time-string "%H" ct)))
|
|
minute (or (nth 1 tl) (string-to-number (format-time-string "%M" ct)))
|
|
second (or (nth 0 tl) 0)
|
|
wday (nth 6 tl))
|
|
(when (and wday (not (nth 3 tl)))
|
|
;; Weekday was given, but no day, so pick that day in the week
|
|
;; on or after the derived date.
|
|
(setq wday1 (nth 6 (decode-time (encode-time 0 0 0 day month year))))
|
|
(unless (equal wday wday1)
|
|
(setq day (+ day (% (- wday wday1 -7) 7)))))
|
|
(if (and (boundp 'org-time-was-given)
|
|
(nth 2 tl))
|
|
(setq org-time-was-given t))
|
|
(if (< year 100) (setq year (+ 2000 year)))
|
|
(if to-time
|
|
(encode-time second minute hour day month year)
|
|
(if (or (nth 1 tl) (nth 2 tl))
|
|
(format "%04d-%02d-%02d %02d:%02d" year month day hour minute)
|
|
(format "%04d-%02d-%02d" year month day)))))
|
|
|
|
(defun org-eval-in-calendar (form)
|
|
"Eval FORM in the calendar window and return to current window.
|
|
Also, store the cursor date in variable ans2."
|
|
(let ((sw (selected-window)))
|
|
(select-window (get-buffer-window "*Calendar*"))
|
|
(eval form)
|
|
(when (calendar-cursor-to-date)
|
|
(let* ((date (calendar-cursor-to-date))
|
|
(time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
|
|
(setq ans2 (format-time-string "%Y-%m-%d" time))))
|
|
(org-move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer))
|
|
(select-window sw)))
|
|
|
|
(defun org-calendar-select ()
|
|
"Return to `org-read-date' with the date currently selected.
|
|
This is used by `org-read-date' in a temporary keymap for the calendar buffer."
|
|
(interactive)
|
|
(when (calendar-cursor-to-date)
|
|
(let* ((date (calendar-cursor-to-date))
|
|
(time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
|
|
(setq ans1 (format-time-string "%Y-%m-%d" time)))
|
|
(if (active-minibuffer-window) (exit-minibuffer))))
|
|
|
|
(defun org-calendar-select-mouse (ev)
|
|
"Return to `org-read-date' with the date currently selected.
|
|
This is used by `org-read-date' in a temporary keymap for the calendar buffer."
|
|
(interactive "e")
|
|
(mouse-set-point ev)
|
|
(when (calendar-cursor-to-date)
|
|
(let* ((date (calendar-cursor-to-date))
|
|
(time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
|
|
(setq ans1 (format-time-string "%Y-%m-%d" time)))
|
|
(if (active-minibuffer-window) (exit-minibuffer))))
|
|
|
|
(defun org-check-deadlines (ndays)
|
|
"Check if there are any deadlines due or past due.
|
|
A deadline is considered due if it happens within `org-deadline-warning-days'
|
|
days from today's date. If the deadline appears in an entry marked DONE,
|
|
it is not shown. The prefix arg NDAYS can be used to test that many
|
|
days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are shown."
|
|
(interactive "P")
|
|
(let* ((org-warn-days
|
|
(cond
|
|
((equal ndays '(4)) 100000)
|
|
(ndays (prefix-numeric-value ndays))
|
|
(t org-deadline-warning-days)))
|
|
(case-fold-search nil)
|
|
(regexp (concat "\\<" org-deadline-string " *<\\([^>]+\\)>"))
|
|
(callback
|
|
(lambda ()
|
|
(and (let ((d1 (time-to-days (current-time)))
|
|
(d2 (time-to-days
|
|
(org-time-string-to-time (match-string 1)))))
|
|
(< (- d2 d1) org-warn-days))
|
|
(not (org-entry-is-done-p))))))
|
|
(message "%d deadlines past-due or due within %d days"
|
|
(org-occur regexp callback)
|
|
org-warn-days)))
|
|
|
|
(defun org-evaluate-time-range (&optional to-buffer)
|
|
"Evaluate a time range by computing the difference between start and end.
|
|
Normally the result is just printed in the echo area, but with prefix arg
|
|
TO-BUFFER, the result is inserted just after the date stamp into the buffer.
|
|
If the time range is actually in a table, the result is inserted into the
|
|
next column.
|
|
For time difference computation, a year is assumed to be exactly 365
|
|
days in order to avoid rounding problems."
|
|
(interactive "P")
|
|
(save-excursion
|
|
(unless (org-at-date-range-p)
|
|
(goto-char (point-at-bol))
|
|
(re-search-forward org-tr-regexp (point-at-eol) t))
|
|
(if (not (org-at-date-range-p))
|
|
(error "Not at a time-stamp range, and none found in current line")))
|
|
(let* ((ts1 (match-string 1))
|
|
(ts2 (match-string 2))
|
|
(havetime (or (> (length ts1) 15) (> (length ts2) 15)))
|
|
(match-end (match-end 0))
|
|
(time1 (org-time-string-to-time ts1))
|
|
(time2 (org-time-string-to-time ts2))
|
|
(t1 (time-to-seconds time1))
|
|
(t2 (time-to-seconds time2))
|
|
(diff (abs (- t2 t1)))
|
|
(negative (< (- t2 t1) 0))
|
|
;; (ys (floor (* 365 24 60 60)))
|
|
(ds (* 24 60 60))
|
|
(hs (* 60 60))
|
|
(fy "%dy %dd %02d:%02d")
|
|
(fy1 "%dy %dd")
|
|
(fd "%dd %02d:%02d")
|
|
(fd1 "%dd")
|
|
(fh "%02d:%02d")
|
|
y d h m align)
|
|
(if havetime
|
|
(setq ; y (floor (/ diff ys)) diff (mod diff ys)
|
|
y 0
|
|
d (floor (/ diff ds)) diff (mod diff ds)
|
|
h (floor (/ diff hs)) diff (mod diff hs)
|
|
m (floor (/ diff 60)))
|
|
(setq ; y (floor (/ diff ys)) diff (mod diff ys)
|
|
y 0
|
|
d (floor (+ (/ diff ds) 0.5))
|
|
h 0 m 0))
|
|
(if (not to-buffer)
|
|
(message (org-make-tdiff-string y d h m))
|
|
(when (org-at-table-p)
|
|
(goto-char match-end)
|
|
(setq align t)
|
|
(and (looking-at " *|") (goto-char (match-end 0))))
|
|
(if (looking-at
|
|
"\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]")
|
|
(replace-match ""))
|
|
(if negative (insert " -"))
|
|
(if (> y 0) (insert " " (format (if havetime fy fy1) y d h m))
|
|
(if (> d 0) (insert " " (format (if havetime fd fd1) d h m))
|
|
(insert " " (format fh h m))))
|
|
(if align (org-table-align))
|
|
(message "Time difference inserted"))))
|
|
|
|
(defun org-make-tdiff-string (y d h m)
|
|
(let ((fmt "")
|
|
(l nil))
|
|
(if (> y 0) (setq fmt (concat fmt "%d year" (if (> y 1) "s" "") " ")
|
|
l (push y l)))
|
|
(if (> d 0) (setq fmt (concat fmt "%d day" (if (> d 1) "s" "") " ")
|
|
l (push d l)))
|
|
(if (> h 0) (setq fmt (concat fmt "%d hour" (if (> h 1) "s" "") " ")
|
|
l (push h l)))
|
|
(if (> m 0) (setq fmt (concat fmt "%d minute" (if (> m 1) "s" "") " ")
|
|
l (push m l)))
|
|
(apply 'format fmt (nreverse l))))
|
|
|
|
(defun org-time-string-to-time (s)
|
|
(apply 'encode-time (org-parse-time-string s)))
|
|
|
|
(defun org-parse-time-string (s &optional nodefault)
|
|
"Parse the standard Org-mode time string.
|
|
This should be a lot faster than the normal `parse-time-string'.
|
|
If time is not given, defaults to 0:00. However, with optional NODEFAULT,
|
|
hour and minute fields will be nil if not given."
|
|
(if (string-match org-ts-regexp1 s)
|
|
(list 0
|
|
(if (or (match-beginning 8) (not nodefault))
|
|
(string-to-number (or (match-string 8 s) "0")))
|
|
(if (or (match-beginning 7) (not nodefault))
|
|
(string-to-number (or (match-string 7 s) "0")))
|
|
(string-to-number (match-string 4 s))
|
|
(string-to-number (match-string 3 s))
|
|
(string-to-number (match-string 2 s))
|
|
nil nil nil)
|
|
(make-list 9 0)))
|
|
|
|
(defun org-timestamp-up (&optional arg)
|
|
"Increase the date item at the cursor by one.
|
|
If the cursor is on the year, change the year. If it is on the month or
|
|
the day, change that.
|
|
With prefix ARG, change by that many units."
|
|
(interactive "p")
|
|
(org-timestamp-change (prefix-numeric-value arg)))
|
|
|
|
(defun org-timestamp-down (&optional arg)
|
|
"Decrease the date item at the cursor by one.
|
|
If the cursor is on the year, change the year. If it is on the month or
|
|
the day, change that.
|
|
With prefix ARG, change by that many units."
|
|
(interactive "p")
|
|
(org-timestamp-change (- (prefix-numeric-value arg))))
|
|
|
|
(defun org-timestamp-up-day (&optional arg)
|
|
"Increase the date in the time stamp by one day.
|
|
With prefix ARG, change that many days."
|
|
(interactive "p")
|
|
(if (and (not (org-at-timestamp-p))
|
|
(org-on-heading-p))
|
|
(org-todo 'up)
|
|
(org-timestamp-change (prefix-numeric-value arg) 'day)))
|
|
|
|
(defun org-timestamp-down-day (&optional arg)
|
|
"Decrease the date in the time stamp by one day.
|
|
With prefix ARG, change that many days."
|
|
(interactive "p")
|
|
(if (and (not (org-at-timestamp-p))
|
|
(org-on-heading-p))
|
|
(org-todo 'down)
|
|
(org-timestamp-change (- (prefix-numeric-value arg)) 'day)))
|
|
|
|
(defsubst org-pos-in-match-range (pos n)
|
|
(and (match-beginning n)
|
|
(<= (match-beginning n) pos)
|
|
(>= (match-end n) pos)))
|
|
|
|
(defun org-at-timestamp-p ()
|
|
"Determine if the cursor is in or at a timestamp."
|
|
(interactive)
|
|
(let* ((tsr org-ts-regexp2)
|
|
(pos (point))
|
|
(ans (or (looking-at tsr)
|
|
(save-excursion
|
|
(skip-chars-backward "^<\n\r\t")
|
|
(if (> (point) 1) (backward-char 1))
|
|
(and (looking-at tsr)
|
|
(> (- (match-end 0) pos) -1))))))
|
|
(and (boundp 'org-ts-what)
|
|
(setq org-ts-what
|
|
(cond
|
|
((org-pos-in-match-range pos 2) 'year)
|
|
((org-pos-in-match-range pos 3) 'month)
|
|
((org-pos-in-match-range pos 7) 'hour)
|
|
((org-pos-in-match-range pos 8) 'minute)
|
|
((or (org-pos-in-match-range pos 4)
|
|
(org-pos-in-match-range pos 5)) 'day)
|
|
(t 'day))))
|
|
ans))
|
|
|
|
(defun org-timestamp-change (n &optional what)
|
|
"Change the date in the time stamp at point.
|
|
The date will be changed by N times WHAT. WHAT can be `day', `month',
|
|
`year', `minute', `second'. If WHAT is not given, the cursor position
|
|
in the timestamp determines what will be changed."
|
|
(let ((fmt (car org-time-stamp-formats))
|
|
org-ts-what
|
|
(pos (point))
|
|
ts time time0)
|
|
(if (not (org-at-timestamp-p))
|
|
(error "Not at a timestamp"))
|
|
(setq org-ts-what (or what org-ts-what))
|
|
(setq fmt (if (<= (abs (- (cdr org-ts-lengths)
|
|
(- (match-end 0) (match-beginning 0))))
|
|
1)
|
|
(cdr org-time-stamp-formats)
|
|
(car org-time-stamp-formats)))
|
|
(setq ts (match-string 0))
|
|
(replace-match "")
|
|
(setq time0 (org-parse-time-string ts))
|
|
(setq time
|
|
(apply 'encode-time
|
|
(append
|
|
(list (or (car time0) 0))
|
|
(list (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0)))
|
|
(list (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0)))
|
|
(list (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0)))
|
|
(list (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0)))
|
|
(list (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0)))
|
|
(nthcdr 6 time0))))
|
|
(if (eq what 'calendar)
|
|
(let ((cal-date
|
|
(save-excursion
|
|
(save-match-data
|
|
(set-buffer "*Calendar*")
|
|
(calendar-cursor-to-date)))))
|
|
(setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month
|
|
(setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day
|
|
(setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year
|
|
(setcar time0 (or (car time0) 0))
|
|
(setcar (nthcdr 1 time0) (or (nth 1 time0) 0))
|
|
(setcar (nthcdr 2 time0) (or (nth 1 time0) 0))
|
|
(setq time (apply 'encode-time time0))))
|
|
(insert (setq org-last-changed-timestamp (format-time-string fmt time)))
|
|
(goto-char pos)
|
|
;; Try to recenter the calendar window, if any
|
|
(if (and org-calendar-follow-timestamp-change
|
|
(get-buffer-window "*Calendar*" t)
|
|
(memq org-ts-what '(day month year)))
|
|
(org-recenter-calendar (time-to-days time)))))
|
|
|
|
(defun org-recenter-calendar (date)
|
|
"If the calendar is visible, recenter it to DATE."
|
|
(let* ((win (selected-window))
|
|
(cwin (get-buffer-window "*Calendar*" t))
|
|
(calendar-move-hook nil))
|
|
(when cwin
|
|
(select-window cwin)
|
|
(calendar-goto-date (if (listp date) date
|
|
(calendar-gregorian-from-absolute date)))
|
|
(select-window win))))
|
|
|
|
(defun org-goto-calendar (&optional arg)
|
|
"Go to the Emacs calendar at the current date.
|
|
If there is a time stamp in the current line, go to that date.
|
|
A prefix ARG can be used to force the current date."
|
|
(interactive "P")
|
|
(let ((tsr org-ts-regexp) diff
|
|
(calendar-move-hook nil)
|
|
(view-calendar-holidays-initially nil)
|
|
(view-diary-entries-initially nil))
|
|
(if (or (org-at-timestamp-p)
|
|
(save-excursion
|
|
(beginning-of-line 1)
|
|
(looking-at (concat ".*" tsr))))
|
|
(let ((d1 (time-to-days (current-time)))
|
|
(d2 (time-to-days
|
|
(org-time-string-to-time (match-string 1)))))
|
|
(setq diff (- d2 d1))))
|
|
(calendar)
|
|
(calendar-goto-today)
|
|
(if (and diff (not arg)) (calendar-forward-day diff))))
|
|
|
|
(defun org-date-from-calendar ()
|
|
"Insert time stamp corresponding to cursor date in *Calendar* buffer.
|
|
If there is already a time stamp at the cursor position, update it."
|
|
(interactive)
|
|
(org-timestamp-change 0 'calendar))
|
|
|
|
;;; Agenda, and Diary Integration
|
|
|
|
;;; Define the mode
|
|
|
|
(defvar org-agenda-mode-map (make-sparse-keymap)
|
|
"Keymap for `org-agenda-mode'.")
|
|
|
|
(defvar org-agenda-menu) ; defined later in this file.
|
|
(defvar org-agenda-follow-mode nil)
|
|
(defvar org-agenda-show-log nil)
|
|
(defvar org-agenda-buffer-name "*Org Agenda*")
|
|
(defvar org-agenda-redo-command nil)
|
|
(defvar org-agenda-mode-hook nil)
|
|
(defvar org-agenda-type nil)
|
|
(defvar org-agenda-force-single-file nil)
|
|
|
|
(defun org-agenda-mode ()
|
|
"Mode for time-sorted view on action items in Org-mode files.
|
|
|
|
The following commands are available:
|
|
|
|
\\{org-agenda-mode-map}"
|
|
(interactive)
|
|
(kill-all-local-variables)
|
|
(setq major-mode 'org-agenda-mode)
|
|
(setq mode-name "Org-Agenda")
|
|
(use-local-map org-agenda-mode-map)
|
|
(easy-menu-add org-agenda-menu)
|
|
(if org-startup-truncated (setq truncate-lines t))
|
|
(org-add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local)
|
|
(org-add-hook 'pre-command-hook 'org-unhighlight nil 'local)
|
|
(unless org-agenda-keep-modes
|
|
(setq org-agenda-follow-mode org-agenda-start-with-follow-mode
|
|
org-agenda-show-log nil))
|
|
(easy-menu-change
|
|
'("Agenda") "Agenda Files"
|
|
(append
|
|
(list
|
|
(vector
|
|
(if (get 'org-agenda-files 'org-restrict)
|
|
"Restricted to single file"
|
|
"Edit File List")
|
|
'(org-edit-agenda-file-list)
|
|
(not (get 'org-agenda-files 'org-restrict)))
|
|
"--")
|
|
(mapcar 'org-file-menu-entry (org-agenda-files))))
|
|
(org-agenda-set-mode-name)
|
|
(apply
|
|
(if (fboundp 'run-mode-hooks) 'run-mode-hooks 'run-hooks)
|
|
(list 'org-agenda-mode-hook)))
|
|
|
|
(define-key org-agenda-mode-map "\C-i" 'org-agenda-goto)
|
|
(define-key org-agenda-mode-map [(tab)] 'org-agenda-goto)
|
|
(define-key org-agenda-mode-map "\C-m" 'org-agenda-switch-to)
|
|
(define-key org-agenda-mode-map " " 'org-agenda-show)
|
|
(define-key org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo)
|
|
(define-key org-agenda-mode-map "o" 'delete-other-windows)
|
|
(define-key org-agenda-mode-map "L" 'org-agenda-recenter)
|
|
(define-key org-agenda-mode-map "t" 'org-agenda-todo)
|
|
(define-key org-agenda-mode-map ":" 'org-agenda-set-tags)
|
|
(define-key org-agenda-mode-map "." 'org-agenda-goto-today)
|
|
(define-key org-agenda-mode-map "d" 'org-agenda-day-view)
|
|
(define-key org-agenda-mode-map "w" 'org-agenda-week-view)
|
|
(define-key org-agenda-mode-map (org-key 'S-right) 'org-agenda-date-later)
|
|
(define-key org-agenda-mode-map (org-key 'S-left) 'org-agenda-date-earlier)
|
|
(define-key org-agenda-mode-map [?\C-c ?\C-x (right)] 'org-agenda-date-later)
|
|
(define-key org-agenda-mode-map [?\C-c ?\C-x (left)] 'org-agenda-date-earlier)
|
|
|
|
(define-key org-agenda-mode-map ">" 'org-agenda-date-prompt)
|
|
(define-key org-agenda-mode-map "\C-c\C-s" 'org-agenda-schedule)
|
|
(define-key org-agenda-mode-map "\C-c\C-d" 'org-agenda-deadline)
|
|
(let ((l '(1 2 3 4 5 6 7 8 9 0)))
|
|
(while l (define-key org-agenda-mode-map
|
|
(int-to-string (pop l)) 'digit-argument)))
|
|
|
|
(define-key org-agenda-mode-map "f" 'org-agenda-follow-mode)
|
|
(define-key org-agenda-mode-map "l" 'org-agenda-log-mode)
|
|
(define-key org-agenda-mode-map "D" 'org-agenda-toggle-diary)
|
|
(define-key org-agenda-mode-map "g" 'org-agenda-toggle-time-grid)
|
|
(define-key org-agenda-mode-map "r" 'org-agenda-redo)
|
|
(define-key org-agenda-mode-map "q" 'org-agenda-quit)
|
|
(define-key org-agenda-mode-map "x" 'org-agenda-exit)
|
|
(define-key org-agenda-mode-map "P" 'org-agenda-show-priority)
|
|
(define-key org-agenda-mode-map "T" 'org-agenda-show-tags)
|
|
(define-key org-agenda-mode-map "n" 'next-line)
|
|
(define-key org-agenda-mode-map "p" 'previous-line)
|
|
(define-key org-agenda-mode-map "\C-n" 'org-agenda-next-date-line)
|
|
(define-key org-agenda-mode-map "\C-p" 'org-agenda-previous-date-line)
|
|
(define-key org-agenda-mode-map "," 'org-agenda-priority)
|
|
(define-key org-agenda-mode-map "\C-c," 'org-agenda-priority)
|
|
(define-key org-agenda-mode-map "i" 'org-agenda-diary-entry)
|
|
(define-key org-agenda-mode-map "c" 'org-agenda-goto-calendar)
|
|
(eval-after-load "calendar"
|
|
'(define-key calendar-mode-map org-calendar-to-agenda-key
|
|
'org-calendar-goto-agenda))
|
|
(define-key org-agenda-mode-map "C" 'org-agenda-convert-date)
|
|
(define-key org-agenda-mode-map "m" 'org-agenda-phases-of-moon)
|
|
(define-key org-agenda-mode-map "M" 'org-agenda-phases-of-moon)
|
|
(define-key org-agenda-mode-map "s" 'org-agenda-sunrise-sunset)
|
|
(define-key org-agenda-mode-map "S" 'org-agenda-sunrise-sunset)
|
|
(define-key org-agenda-mode-map "h" 'org-agenda-holidays)
|
|
(define-key org-agenda-mode-map "H" 'org-agenda-holidays)
|
|
(define-key org-agenda-mode-map "+" 'org-agenda-priority-up)
|
|
(define-key org-agenda-mode-map "-" 'org-agenda-priority-down)
|
|
(define-key org-agenda-mode-map (org-key 'S-up) 'org-agenda-priority-up)
|
|
(define-key org-agenda-mode-map (org-key 'S-down) 'org-agenda-priority-down)
|
|
(define-key org-agenda-mode-map [?\C-c ?\C-x (up)] 'org-agenda-priority-up)
|
|
(define-key org-agenda-mode-map [?\C-c ?\C-x (down)] 'org-agenda-priority-down)
|
|
(define-key org-agenda-mode-map [(right)] 'org-agenda-later)
|
|
(define-key org-agenda-mode-map [(left)] 'org-agenda-earlier)
|
|
(define-key org-agenda-mode-map "\C-c\C-x\C-c" 'org-export-icalendar-combine-agenda-files)
|
|
(defvar org-agenda-keymap (copy-keymap org-agenda-mode-map)
|
|
"Local keymap for agenda entries from Org-mode.")
|
|
|
|
(define-key org-agenda-keymap
|
|
(if (featurep 'xemacs) [(button2)] [(mouse-2)]) 'org-agenda-goto-mouse)
|
|
(define-key org-agenda-keymap
|
|
(if (featurep 'xemacs) [(button3)] [(mouse-3)]) 'org-agenda-show-mouse)
|
|
(when org-agenda-mouse-1-follows-link
|
|
(define-key org-agenda-keymap [follow-link] 'mouse-face))
|
|
(easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu"
|
|
'("Agenda"
|
|
("Agenda Files")
|
|
"--"
|
|
["Show" org-agenda-show t]
|
|
["Go To (other window)" org-agenda-goto t]
|
|
["Go To (one window)" org-agenda-switch-to t]
|
|
["Follow Mode" org-agenda-follow-mode
|
|
:style toggle :selected org-agenda-follow-mode :active t]
|
|
"--"
|
|
["Cycle TODO" org-agenda-todo t]
|
|
("Tags"
|
|
["Show all Tags" org-agenda-show-tags t]
|
|
["Set Tags" org-agenda-set-tags t])
|
|
("Schedule"
|
|
["Schedule" org-agenda-schedule t]
|
|
["Set Deadline" org-agenda-deadline t]
|
|
"--"
|
|
["Reschedule +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)]
|
|
["Reschedule -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)]
|
|
["Reschedule to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)])
|
|
("Priority"
|
|
["Set Priority" org-agenda-priority t]
|
|
["Increase Priority" org-agenda-priority-up t]
|
|
["Decrease Priority" org-agenda-priority-down t]
|
|
["Show Priority" org-agenda-show-priority t])
|
|
"--"
|
|
;; ["New agenda command" org-agenda t]
|
|
["Rebuild buffer" org-agenda-redo t]
|
|
"--"
|
|
["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda 'timeline)]
|
|
["Next Dates" org-agenda-later (org-agenda-check-type nil 'agenda)]
|
|
["Previous Dates" org-agenda-earlier (org-agenda-check-type nil 'agenda)]
|
|
"--"
|
|
["Day View" org-agenda-day-view :active (org-agenda-check-type nil 'agenda)
|
|
:style radio :selected (equal org-agenda-ndays 1)]
|
|
["Week View" org-agenda-week-view :active (org-agenda-check-type nil 'agenda)
|
|
:style radio :selected (equal org-agenda-ndays 7)]
|
|
"--"
|
|
["Show Logbook entries" org-agenda-log-mode
|
|
:style toggle :selected org-agenda-show-log :active (org-agenda-check-type nil 'agenda 'timeline)]
|
|
["Include Diary" org-agenda-toggle-diary
|
|
:style toggle :selected org-agenda-include-diary :active (org-agenda-check-type nil 'agenda)]
|
|
["Use Time Grid" org-agenda-toggle-time-grid
|
|
:style toggle :selected org-agenda-use-time-grid :active (org-agenda-check-type nil 'agenda)]
|
|
"--"
|
|
["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline)]
|
|
("Calendar Commands"
|
|
["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda 'timeline)]
|
|
["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda 'timeline)]
|
|
["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda 'timeline)]
|
|
["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda 'timeline)]
|
|
["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda 'timeline)])
|
|
["Create iCalendar file" org-export-icalendar-combine-agenda-files t]
|
|
"--"
|
|
["Quit" org-agenda-quit t]
|
|
["Exit and Release Buffers" org-agenda-exit t]
|
|
))
|
|
|
|
;;;###autoload
|
|
(defun org-agenda (arg)
|
|
"Dispatch agenda commands to collect entries to the agenda buffer.
|
|
Prompts for a character to select a command. Any prefix arg will be passed
|
|
on to the selected command. The default selections are:
|
|
|
|
a Call `org-agenda' to display the agenda for the current day or week.
|
|
t Call `org-todo-list' to display the global todo list.
|
|
T Call `org-todo-list' to display the global todo list, select only
|
|
entries with a specific TODO keyword (the user gets a prompt).
|
|
m Call `org-tags-view' to display headlines with tags matching
|
|
a condition (the user is prompted for the condition).
|
|
M Like `m', but select only TODO entries, no ordinary headlines.
|
|
|
|
More commands can be added by configuring the variable
|
|
`org-agenda-custom-commands'. In particular, specific tags and TODO keyword
|
|
searches can be pre-defined in this way.
|
|
|
|
If the current buffer is in Org-mode and visiting a file, you can also
|
|
first press `1' to indicate that the agenda should be temporarily (until the
|
|
next use of \\[org-agenda]) restricted to the current file."
|
|
(interactive "P")
|
|
(catch 'exit
|
|
(let ((restrict-ok (and buffer-file-name (eq major-mode 'org-mode)))
|
|
(custom org-agenda-custom-commands)
|
|
c entry key type string)
|
|
(put 'org-agenda-files 'org-restrict nil)
|
|
(save-window-excursion
|
|
(delete-other-windows)
|
|
(switch-to-buffer-other-window " *Agenda Commands*")
|
|
(erase-buffer)
|
|
(insert
|
|
"Press key for an agenda command:
|
|
--------------------------------
|
|
a Agenda for current week or day
|
|
t List of all TODO entries T Entries with special TODO kwd
|
|
m Match a TAGS query M Like m, but only TODO entries
|
|
C Configure your own agenda commands")
|
|
(while (setq entry (pop custom))
|
|
(setq key (car entry) type (nth 1 entry) string (nth 2 entry))
|
|
(insert (format "\n%-4s%-14s: %s"
|
|
key
|
|
(cond
|
|
((eq type 'tags) "Tags query")
|
|
((eq type 'todo) "TODO keyword")
|
|
((eq type 'tags-tree) "Tags tree")
|
|
((eq type 'todo-tree) "TODO kwd tree")
|
|
((eq type 'occur-tree) "Occur tree")
|
|
(t "???"))
|
|
(org-add-props string nil 'face 'org-warning))))
|
|
(goto-char (point-min))
|
|
(if (fboundp 'fit-window-to-buffer) (fit-window-to-buffer))
|
|
(message "Press key for agenda command%s"
|
|
(if restrict-ok ", or [1] to restrict to current file" ""))
|
|
(setq c (read-char-exclusive))
|
|
(message "")
|
|
(when (equal c ?1)
|
|
(if restrict-ok
|
|
(put 'org-agenda-files 'org-restrict (list buffer-file-name))
|
|
(error "Cannot restrict agenda to current buffer"))
|
|
(message "Press key for agenda command%s"
|
|
(if restrict-ok " (restricted to current file)" ""))
|
|
(setq c (read-char-exclusive))
|
|
(message "")))
|
|
(require 'calendar) ; FIXME: can we avoid this for some commands?
|
|
;; For example the todo list should not need it (but does...)
|
|
(cond
|
|
((equal c ?C) (customize-variable 'org-agenda-custom-commands))
|
|
((equal c ?a) (call-interactively 'org-agenda-list))
|
|
((equal c ?t) (call-interactively 'org-todo-list))
|
|
((equal c ?T)
|
|
(setq current-prefix-arg (or arg '(4)))
|
|
(call-interactively 'org-todo-list))
|
|
((equal c ?m) (call-interactively 'org-tags-view))
|
|
((equal c ?M)
|
|
(setq current-prefix-arg (or arg '(4)))
|
|
(call-interactively 'org-tags-view))
|
|
((setq entry (assoc (char-to-string c) org-agenda-custom-commands))
|
|
(setq type (nth 1 entry) string (nth 2 entry))
|
|
(cond
|
|
((eq type 'tags)
|
|
(org-tags-view current-prefix-arg string))
|
|
((eq type 'tags-todo)
|
|
(org-tags-view '(4) string))
|
|
((eq type 'todo)
|
|
(org-todo-list string))
|
|
((eq type 'tags-tree)
|
|
(org-check-for-org-mode)
|
|
(org-tags-sparse-tree current-prefix-arg string))
|
|
((eq type 'todo-tree)
|
|
(org-check-for-org-mode)
|
|
(org-occur (concat "^" outline-regexp "[ \t]*"
|
|
(regexp-quote string) "\\>")))
|
|
((eq type 'occur-tree)
|
|
(org-check-for-org-mode)
|
|
(org-occur string))
|
|
(t (error "Invalid custom agenda command type %s" type))))
|
|
(t (error "Invalid key"))))))
|
|
|
|
(defun org-check-for-org-mode ()
|
|
"Make sure current buffer is in org-mode. Error if not."
|
|
(or (eq major-mode 'org-mode)
|
|
(error "Cannot execute org-mode agenda command on buffer in %s."
|
|
major-mode)))
|
|
|
|
(defun org-fit-agenda-window ()
|
|
"Fit the window to the buffer size."
|
|
(and org-fit-agenda-window
|
|
(fboundp 'fit-window-to-buffer)
|
|
(fit-window-to-buffer nil (/ (* (frame-height) 3) 4)
|
|
(/ (frame-height) 2))))
|
|
|
|
(defun org-agenda-files (&optional unrestricted)
|
|
"Get the list of agenda files.
|
|
Optional UNRESTRICTED means return the full list even if a restriction
|
|
is currently in place."
|
|
(cond
|
|
((and (not unrestricted) (get 'org-agenda-files 'org-restrict)))
|
|
((stringp org-agenda-files) (org-read-agenda-file-list))
|
|
((listp org-agenda-files) org-agenda-files)
|
|
(t (error "Invalid value of `org-agenda-files'"))))
|
|
|
|
(defvar org-window-configuration)
|
|
|
|
(defun org-edit-agenda-file-list ()
|
|
"Edit the list of agenda files.
|
|
Depending on setup, this either uses customize to edit the variable
|
|
`org-agenda-files', or it visits the file that is holding the list. In the
|
|
latter case, the buffer is set up in a way that saving it automatically kills
|
|
the buffer and restores the previous window configuration."
|
|
(interactive)
|
|
(if (stringp org-agenda-files)
|
|
(let ((cw (current-window-configuration)))
|
|
(find-file org-agenda-files)
|
|
(set (make-local-variable 'org-window-configuration) cw)
|
|
(org-add-hook 'after-save-hook
|
|
(lambda ()
|
|
(set-window-configuration
|
|
(prog1 org-window-configuration
|
|
(kill-buffer (current-buffer))))
|
|
(org-install-agenda-files-menu)
|
|
(message "New agenda file list installed"))
|
|
nil 'local)
|
|
(message (substitute-command-keys
|
|
"Edit list and finish with \\[save-buffer]")))
|
|
(customize-variable 'org-agenda-files)))
|
|
|
|
(defun org-store-new-agenda-file-list (list)
|
|
"Set new value for the agenda file list and save it correcly."
|
|
(if (stringp org-agenda-files)
|
|
(let ((f org-agenda-files) b)
|
|
(while (setq b (find-buffer-visiting f)) (kill-buffer b))
|
|
(with-temp-file f
|
|
(insert (mapconcat 'identity list "\n") "\n")))
|
|
(let ((org-mode-hook nil) (default-major-mode 'fundamental-mode))
|
|
(setq org-agenda-files list)
|
|
(customize-save-variable 'org-agenda-files org-agenda-files))))
|
|
|
|
(defun org-read-agenda-file-list ()
|
|
"Read the list of agenda files from a file."
|
|
(when (stringp org-agenda-files)
|
|
(with-temp-buffer
|
|
(insert-file-contents org-agenda-files)
|
|
(org-split-string (buffer-string) "[ \t\r\n]*?[\r\n][ \t\r\n]*"))))
|
|
|
|
(defvar org-agenda-markers nil
|
|
"List of all currently active markers created by `org-agenda'.")
|
|
(defvar org-agenda-last-marker-time (time-to-seconds (current-time))
|
|
"Creation time of the last agenda marker.")
|
|
|
|
(defun org-agenda-new-marker (&optional pos)
|
|
"Return a new agenda marker.
|
|
Org-mode keeps a list of these markers and resets them when they are
|
|
no longer in use."
|
|
(let ((m (copy-marker (or pos (point)))))
|
|
(setq org-agenda-last-marker-time (time-to-seconds (current-time)))
|
|
(push m org-agenda-markers)
|
|
m))
|
|
|
|
(defun org-agenda-maybe-reset-markers (&optional force)
|
|
"Reset markers created by `org-agenda'. But only if they are old enough."
|
|
(if (or force
|
|
(> (- (time-to-seconds (current-time))
|
|
org-agenda-last-marker-time)
|
|
5))
|
|
(while org-agenda-markers
|
|
(move-marker (pop org-agenda-markers) nil))))
|
|
|
|
(defvar org-agenda-new-buffers nil
|
|
"Buffers created to visit agenda files.")
|
|
|
|
(defun org-get-agenda-file-buffer (file)
|
|
"Get a buffer visiting FILE. If the buffer needs to be created, add
|
|
it to the list of buffers which might be released later."
|
|
(let ((buf (find-buffer-visiting file)))
|
|
(if buf
|
|
buf ; just return it
|
|
;; Make a new buffer and remember it
|
|
(setq buf (find-file-noselect file))
|
|
(if buf (push buf org-agenda-new-buffers))
|
|
buf)))
|
|
|
|
(defun org-release-buffers (blist)
|
|
"Release all buffers in list, asking the user for confirmation when needed.
|
|
When a buffer is unmodified, it is just killed. When modified, it is saved
|
|
\(if the user agrees) and then killed."
|
|
(let (buf file)
|
|
(while (setq buf (pop blist))
|
|
(setq file (buffer-file-name buf))
|
|
(when (and (buffer-modified-p buf)
|
|
file
|
|
(y-or-n-p (format "Save file %s? " file)))
|
|
(with-current-buffer buf (save-buffer)))
|
|
(kill-buffer buf))))
|
|
|
|
(defvar org-respect-restriction nil) ; Dynamically-scoped param.
|
|
|
|
(defun org-timeline (&optional include-all keep-modes)
|
|
"Show a time-sorted view of the entries in the current org file.
|
|
Only entries with a time stamp of today or later will be listed. With
|
|
\\[universal-argument] prefix, all unfinished TODO items will also be shown,
|
|
under the current date.
|
|
If the buffer contains an active region, only check the region for
|
|
dates."
|
|
(interactive "P")
|
|
(require 'calendar)
|
|
(org-agenda-maybe-reset-markers 'force)
|
|
(org-compile-prefix-format org-timeline-prefix-format)
|
|
(let* ((dopast t)
|
|
(dotodo include-all)
|
|
(doclosed org-agenda-show-log)
|
|
(org-agenda-keep-modes keep-modes)
|
|
(entry buffer-file-name)
|
|
(org-agenda-files (list buffer-file-name))
|
|
(date (calendar-current-date))
|
|
(win (selected-window))
|
|
(pos1 (point))
|
|
(beg (if (org-region-active-p) (region-beginning) (point-min)))
|
|
(end (if (org-region-active-p) (region-end) (point-max)))
|
|
(day-numbers (org-get-all-dates beg end 'no-ranges
|
|
t doclosed)) ; always include today
|
|
(today (time-to-days (current-time)))
|
|
(org-respect-restriction t)
|
|
(past t)
|
|
args
|
|
s e rtn d)
|
|
(setq org-agenda-redo-command
|
|
(list 'progn
|
|
(list 'switch-to-buffer-other-window (current-buffer))
|
|
(list 'org-timeline (list 'quote include-all) t)))
|
|
(if (not dopast)
|
|
;; Remove past dates from the list of dates.
|
|
(setq day-numbers (delq nil (mapcar (lambda(x)
|
|
(if (>= x today) x nil))
|
|
day-numbers))))
|
|
(switch-to-buffer-other-window
|
|
(get-buffer-create org-agenda-buffer-name))
|
|
(setq buffer-read-only nil)
|
|
(erase-buffer)
|
|
(org-agenda-mode) (setq buffer-read-only nil)
|
|
(set (make-local-variable 'org-agenda-type) 'timeline)
|
|
(if doclosed (push :closed args))
|
|
(push :timestamp args)
|
|
(if dotodo (push :todo args))
|
|
(while (setq d (pop day-numbers))
|
|
(if (and (>= d today)
|
|
dopast
|
|
past)
|
|
(progn
|
|
(setq past nil)
|
|
(insert (make-string 79 ?-) "\n")))
|
|
(setq date (calendar-gregorian-from-absolute d))
|
|
(setq s (point))
|
|
(setq rtn (apply 'org-agenda-get-day-entries
|
|
entry date args))
|
|
(if (or rtn (equal d today))
|
|
(progn
|
|
(insert (calendar-day-name date) " "
|
|
(number-to-string (extract-calendar-day date)) " "
|
|
(calendar-month-name (extract-calendar-month date)) " "
|
|
(number-to-string (extract-calendar-year date)) "\n")
|
|
(put-text-property s (1- (point)) 'face
|
|
'org-level-3)
|
|
(if (equal d today)
|
|
(put-text-property s (1- (point)) 'org-today t))
|
|
(insert (org-finalize-agenda-entries rtn) "\n")
|
|
(put-text-property s (1- (point)) 'day d))))
|
|
(goto-char (point-min))
|
|
(setq buffer-read-only t)
|
|
(goto-char (or (text-property-any (point-min) (point-max) 'org-today t)
|
|
(point-min)))
|
|
(when (not org-select-timeline-window)
|
|
(select-window win)
|
|
(goto-char pos1))))
|
|
|
|
;;;###autoload
|
|
(defun org-agenda-list (&optional include-all start-day ndays keep-modes)
|
|
"Produce a weekly view from all files in variable `org-agenda-files'.
|
|
The view will be for the current week, but from the overview buffer you
|
|
will be able to go to other weeks.
|
|
With one \\[universal-argument] prefix argument INCLUDE-ALL, all unfinished TODO items will
|
|
also be shown, under the current date.
|
|
With two \\[universal-argument] prefix argument INCLUDE-ALL, all TODO entries marked DONE
|
|
on the days are also shown. See the variable `org-log-done' for how
|
|
to turn on logging.
|
|
START-DAY defaults to TODAY, or to the most recent match for the weekday
|
|
given in `org-agenda-start-on-weekday'.
|
|
NDAYS defaults to `org-agenda-ndays'."
|
|
(interactive "P")
|
|
(org-agenda-maybe-reset-markers 'force)
|
|
(org-compile-prefix-format org-agenda-prefix-format)
|
|
(require 'calendar)
|
|
(let* ((org-agenda-start-on-weekday
|
|
(if (or (equal ndays 1)
|
|
(and (null ndays) (equal 1 org-agenda-ndays)))
|
|
nil org-agenda-start-on-weekday))
|
|
(org-agenda-keep-modes keep-modes)
|
|
(thefiles (org-agenda-files))
|
|
(files thefiles)
|
|
(win (selected-window))
|
|
(today (time-to-days (current-time)))
|
|
(sd (or start-day today))
|
|
(start (if (or (null org-agenda-start-on-weekday)
|
|
(< org-agenda-ndays 7))
|
|
sd
|
|
(let* ((nt (calendar-day-of-week
|
|
(calendar-gregorian-from-absolute sd)))
|
|
(n1 org-agenda-start-on-weekday)
|
|
(d (- nt n1)))
|
|
(- sd (+ (if (< d 0) 7 0) d)))))
|
|
(day-numbers (list start))
|
|
(inhibit-redisplay t)
|
|
s e rtn rtnall file date d start-pos end-pos todayp nd)
|
|
(setq org-agenda-redo-command
|
|
(list 'org-agenda-list (list 'quote include-all) start-day ndays t))
|
|
;; Make the list of days
|
|
(setq ndays (or ndays org-agenda-ndays)
|
|
nd ndays)
|
|
(while (> ndays 1)
|
|
(push (1+ (car day-numbers)) day-numbers)
|
|
(setq ndays (1- ndays)))
|
|
(setq day-numbers (nreverse day-numbers))
|
|
(if (not (equal (current-buffer) (get-buffer org-agenda-buffer-name)))
|
|
(progn
|
|
(delete-other-windows)
|
|
(switch-to-buffer-other-window
|
|
(get-buffer-create org-agenda-buffer-name))))
|
|
(setq buffer-read-only nil)
|
|
(erase-buffer)
|
|
(org-agenda-mode) (setq buffer-read-only nil)
|
|
(set (make-local-variable 'org-agenda-type) 'agenda)
|
|
(set (make-local-variable 'starting-day) (car day-numbers))
|
|
(set (make-local-variable 'include-all-loc) include-all)
|
|
(when (and (or include-all org-agenda-include-all-todo)
|
|
(member today day-numbers))
|
|
(setq files thefiles
|
|
rtnall nil)
|
|
(while (setq file (pop files))
|
|
(catch 'nextfile
|
|
(org-check-agenda-file file)
|
|
(setq date (calendar-gregorian-from-absolute today)
|
|
rtn (org-agenda-get-day-entries
|
|
file date :todo))
|
|
(setq rtnall (append rtnall rtn))))
|
|
(when rtnall
|
|
(insert "ALL CURRENTLY OPEN TODO ITEMS:\n")
|
|
(add-text-properties (point-min) (1- (point))
|
|
(list 'face 'org-level-3))
|
|
(insert (org-finalize-agenda-entries rtnall) "\n")))
|
|
(while (setq d (pop day-numbers))
|
|
(setq date (calendar-gregorian-from-absolute d)
|
|
s (point))
|
|
(if (or (setq todayp (= d today))
|
|
(and (not start-pos) (= d sd)))
|
|
(setq start-pos (point))
|
|
(if (and start-pos (not end-pos))
|
|
(setq end-pos (point))))
|
|
(setq files thefiles
|
|
rtnall nil)
|
|
(while (setq file (pop files))
|
|
(catch 'nextfile
|
|
(org-check-agenda-file file)
|
|
(if org-agenda-show-log
|
|
(setq rtn (org-agenda-get-day-entries
|
|
file date
|
|
:deadline :scheduled :timestamp :closed))
|
|
(setq rtn (org-agenda-get-day-entries
|
|
file date
|
|
:deadline :scheduled :timestamp)))
|
|
(setq rtnall (append rtnall rtn))))
|
|
(if org-agenda-include-diary
|
|
(progn
|
|
(require 'diary-lib)
|
|
(setq rtn (org-get-entries-from-diary date))
|
|
(setq rtnall (append rtnall rtn))))
|
|
(if (or rtnall org-agenda-show-all-dates)
|
|
(progn
|
|
(insert (format "%-9s %2d %s %4d\n"
|
|
(calendar-day-name date)
|
|
(extract-calendar-day date)
|
|
(calendar-month-name (extract-calendar-month date))
|
|
(extract-calendar-year date)))
|
|
(put-text-property s (1- (point)) 'face
|
|
'org-level-3)
|
|
(if rtnall (insert
|
|
(org-finalize-agenda-entries
|
|
(org-agenda-add-time-grid-maybe
|
|
rtnall nd todayp))
|
|
"\n"))
|
|
(put-text-property s (1- (point)) 'day d))))
|
|
(goto-char (point-min))
|
|
(setq buffer-read-only t)
|
|
(org-fit-agenda-window)
|
|
(unless (and (pos-visible-in-window-p (point-min))
|
|
(pos-visible-in-window-p (point-max)))
|
|
(goto-char (1- (point-max)))
|
|
(recenter -1)
|
|
(if (not (pos-visible-in-window-p (or start-pos 1)))
|
|
(progn
|
|
(goto-char (or start-pos 1))
|
|
(recenter 1))))
|
|
(goto-char (or start-pos 1))
|
|
(if (not org-select-agenda-window) (select-window win))
|
|
(message "")))
|
|
|
|
(defvar org-select-this-todo-keyword nil)
|
|
|
|
;;;###autoload
|
|
(defun org-todo-list (arg &optional keep-modes)
|
|
"Show all TODO entries from all agenda file in a single list.
|
|
The prefix arg can be used to select a specific TODO keyword and limit
|
|
the list to these. When using \\[universal-argument], you will be prompted
|
|
for a keyword. A numeric prefix directly selects the Nth keyword in
|
|
`org-todo-keywords'."
|
|
(interactive "P")
|
|
(org-agenda-maybe-reset-markers 'force)
|
|
(org-compile-prefix-format org-agenda-prefix-format)
|
|
(let* ((org-agenda-keep-modes keep-modes)
|
|
(today (time-to-days (current-time)))
|
|
(date (calendar-gregorian-from-absolute today))
|
|
(win (selected-window))
|
|
(kwds org-todo-keywords)
|
|
(completion-ignore-case t)
|
|
(org-select-this-todo-keyword
|
|
(if (stringp arg) arg
|
|
(and arg (integerp arg) (> arg 0)
|
|
(nth (1- arg) org-todo-keywords))))
|
|
rtn rtnall files file pos)
|
|
(when (equal arg '(4))
|
|
(setq org-select-this-todo-keyword
|
|
(completing-read "Keyword: " (mapcar 'list org-todo-keywords)
|
|
nil t)))
|
|
(and (equal 0 arg) (setq org-select-this-todo-keyword nil))
|
|
(if (not (equal (current-buffer) (get-buffer org-agenda-buffer-name)))
|
|
(progn
|
|
(delete-other-windows)
|
|
(switch-to-buffer-other-window
|
|
(get-buffer-create org-agenda-buffer-name))))
|
|
(setq buffer-read-only nil)
|
|
(erase-buffer)
|
|
(org-agenda-mode) (setq buffer-read-only nil)
|
|
(set (make-local-variable 'org-agenda-type) 'todo)
|
|
(set (make-local-variable 'last-arg) arg)
|
|
(set (make-local-variable 'org-todo-keywords) kwds)
|
|
(set (make-local-variable 'org-agenda-redo-command)
|
|
'(org-todo-list (or current-prefix-arg last-arg) t))
|
|
(setq files (org-agenda-files)
|
|
rtnall nil)
|
|
(while (setq file (pop files))
|
|
(catch 'nextfile
|
|
(org-check-agenda-file file)
|
|
(setq rtn (org-agenda-get-day-entries file date :todo))
|
|
(setq rtnall (append rtnall rtn))))
|
|
(insert "Global list of TODO items of type: ")
|
|
(add-text-properties (point-min) (1- (point))
|
|
(list 'face 'org-level-3))
|
|
(setq pos (point))
|
|
(insert (or org-select-this-todo-keyword "ALL") "\n")
|
|
(add-text-properties pos (1- (point)) (list 'face 'org-warning))
|
|
(setq pos (point))
|
|
(insert
|
|
"Available with `N r': (0)ALL "
|
|
(let ((n 0))
|
|
(mapconcat (lambda (x)
|
|
(format "(%d)%s" (setq n (1+ n)) x))
|
|
org-todo-keywords " "))
|
|
"\n")
|
|
(add-text-properties pos (1- (point)) (list 'face 'org-level-3))
|
|
(when rtnall
|
|
(insert (org-finalize-agenda-entries rtnall) "\n"))
|
|
(goto-char (point-min))
|
|
(setq buffer-read-only t)
|
|
(org-fit-agenda-window)
|
|
(if (not org-select-agenda-window) (select-window win))))
|
|
|
|
(defun org-check-agenda-file (file)
|
|
"Make sure FILE exists. If not, ask user what to do."
|
|
(when (not (file-exists-p file))
|
|
(message "non-existent file %s. [R]emove from list or [A]bort?"
|
|
(abbreviate-file-name file))
|
|
(let ((r (downcase (read-char-exclusive))))
|
|
(cond
|
|
((equal r ?r)
|
|
(org-remove-file file)
|
|
(throw 'nextfile t))
|
|
(t (error "Abort"))))))
|
|
|
|
(defun org-agenda-check-type (error &rest types)
|
|
"Check if agenda buffer is of allowed type.
|
|
If ERROR is non-nil, throw an error, otherwise just return nil."
|
|
(if (memq org-agenda-type types)
|
|
t
|
|
(if error
|
|
(error "Not allowed in %s-type agenda buffers" org-agenda-type)
|
|
nil)))
|
|
|
|
(defun org-agenda-quit ()
|
|
"Exit agenda by removing the window or the buffer."
|
|
(interactive)
|
|
(let ((buf (current-buffer)))
|
|
(if (not (one-window-p)) (delete-window))
|
|
(kill-buffer buf)
|
|
(org-agenda-maybe-reset-markers 'force)))
|
|
|
|
(defun org-agenda-exit ()
|
|
"Exit agenda by removing the window or the buffer.
|
|
Also kill all Org-mode buffers which have been loaded by `org-agenda'.
|
|
Org-mode buffers visited directly by the user will not be touched."
|
|
(interactive)
|
|
(org-release-buffers org-agenda-new-buffers)
|
|
(setq org-agenda-new-buffers nil)
|
|
(org-agenda-quit))
|
|
|
|
(defun org-agenda-redo ()
|
|
"Rebuild Agenda.
|
|
When this is the global TODO list, a prefix argument will be interpreted."
|
|
(interactive)
|
|
(message "Rebuilding agenda buffer...")
|
|
(eval org-agenda-redo-command)
|
|
(message "Rebuilding agenda buffer...done"))
|
|
|
|
(defun org-agenda-goto-today ()
|
|
"Go to today."
|
|
(interactive)
|
|
(org-agenda-check-type t 'timeline 'agenda)
|
|
(if (boundp 'starting-day)
|
|
(let ((cmd (car org-agenda-redo-command))
|
|
(iall (nth 1 org-agenda-redo-command))
|
|
(nday (nth 3 org-agenda-redo-command))
|
|
(keep (nth 4 org-agenda-redo-command)))
|
|
(eval (list cmd iall nil nday keep)))
|
|
(goto-char (or (text-property-any (point-min) (point-max) 'org-today t)
|
|
(point-min)))))
|
|
|
|
(defun org-agenda-later (arg)
|
|
"Go forward in time by `org-agenda-ndays' days.
|
|
With prefix ARG, go forward that many times `org-agenda-ndays'."
|
|
(interactive "p")
|
|
(org-agenda-check-type t 'agenda)
|
|
(org-agenda-list (if (boundp 'include-all-loc) include-all-loc nil)
|
|
(+ starting-day (* arg org-agenda-ndays)) nil t))
|
|
|
|
(defun org-agenda-earlier (arg)
|
|
"Go back in time by `org-agenda-ndays' days.
|
|
With prefix ARG, go back that many times `org-agenda-ndays'."
|
|
(interactive "p")
|
|
(org-agenda-check-type t 'agenda)
|
|
(org-agenda-list (if (boundp 'include-all-loc) include-all-loc nil)
|
|
(- starting-day (* arg org-agenda-ndays)) nil t))
|
|
|
|
(defun org-agenda-week-view ()
|
|
"Switch to weekly view for agenda."
|
|
(interactive)
|
|
(org-agenda-check-type t 'agenda)
|
|
(setq org-agenda-ndays 7)
|
|
(org-agenda-list include-all-loc
|
|
(or (get-text-property (point) 'day)
|
|
starting-day)
|
|
nil t)
|
|
(org-agenda-set-mode-name)
|
|
(message "Switched to week view"))
|
|
|
|
(defun org-agenda-day-view ()
|
|
"Switch to daily view for agenda."
|
|
(interactive)
|
|
(org-agenda-check-type t 'agenda)
|
|
(setq org-agenda-ndays 1)
|
|
(org-agenda-list include-all-loc
|
|
(or (get-text-property (point) 'day)
|
|
starting-day)
|
|
nil t)
|
|
(org-agenda-set-mode-name)
|
|
(message "Switched to day view"))
|
|
|
|
(defun org-agenda-next-date-line (&optional arg)
|
|
"Jump to the next line indicating a date in agenda buffer."
|
|
(interactive "p")
|
|
(org-agenda-check-type t 'agenda 'timeline)
|
|
(beginning-of-line 1)
|
|
(if (looking-at "^\\S-") (forward-char 1))
|
|
(if (not (re-search-forward "^\\S-" nil t arg))
|
|
(progn
|
|
(backward-char 1)
|
|
(error "No next date after this line in this buffer")))
|
|
(goto-char (match-beginning 0)))
|
|
|
|
(defun org-agenda-previous-date-line (&optional arg)
|
|
"Jump to the previous line indicating a date in agenda buffer."
|
|
(interactive "p")
|
|
(org-agenda-check-type t 'agenda 'timeline)
|
|
(beginning-of-line 1)
|
|
(if (not (re-search-backward "^\\S-" nil t arg))
|
|
(error "No previous date before this line in this buffer")))
|
|
|
|
;; Initialize the highlight
|
|
(defvar org-hl (org-make-overlay 1 1))
|
|
(org-overlay-put org-hl 'face 'highlight)
|
|
|
|
(defun org-highlight (begin end &optional buffer)
|
|
"Highlight a region with overlay."
|
|
(funcall (if (featurep 'xemacs) 'set-extent-endpoints 'move-overlay)
|
|
org-hl begin end (or buffer (current-buffer))))
|
|
|
|
(defun org-unhighlight ()
|
|
"Detach overlay INDEX."
|
|
(funcall (if (featurep 'xemacs) 'detach-extent 'delete-overlay) org-hl))
|
|
|
|
|
|
(defun org-agenda-follow-mode ()
|
|
"Toggle follow mode in an agenda buffer."
|
|
(interactive)
|
|
(setq org-agenda-follow-mode (not org-agenda-follow-mode))
|
|
(org-agenda-set-mode-name)
|
|
(message "Follow mode is %s"
|
|
(if org-agenda-follow-mode "on" "off")))
|
|
|
|
(defun org-agenda-log-mode ()
|
|
"Toggle log mode in an agenda buffer."
|
|
(interactive)
|
|
(org-agenda-check-type t 'agenda 'timeline)
|
|
(setq org-agenda-show-log (not org-agenda-show-log))
|
|
(org-agenda-set-mode-name)
|
|
(org-agenda-redo)
|
|
(message "Log mode is %s"
|
|
(if org-agenda-show-log "on" "off")))
|
|
|
|
(defun org-agenda-toggle-diary ()
|
|
"Toggle diary inclusion in an agenda buffer."
|
|
(interactive)
|
|
(org-agenda-check-type t 'agenda)
|
|
(setq org-agenda-include-diary (not org-agenda-include-diary))
|
|
(org-agenda-redo)
|
|
(org-agenda-set-mode-name)
|
|
(message "Diary inclusion turned %s"
|
|
(if org-agenda-include-diary "on" "off")))
|
|
|
|
(defun org-agenda-toggle-time-grid ()
|
|
"Toggle time grid in an agenda buffer."
|
|
(interactive)
|
|
(org-agenda-check-type t 'agenda)
|
|
(setq org-agenda-use-time-grid (not org-agenda-use-time-grid))
|
|
(org-agenda-redo)
|
|
(org-agenda-set-mode-name)
|
|
(message "Time-grid turned %s"
|
|
(if org-agenda-use-time-grid "on" "off")))
|
|
|
|
(defun org-agenda-set-mode-name ()
|
|
"Set the mode name to indicate all the small mode settings."
|
|
(setq mode-name
|
|
(concat "Org-Agenda"
|
|
(if (equal org-agenda-ndays 1) " Day" "")
|
|
(if (equal org-agenda-ndays 7) " Week" "")
|
|
(if org-agenda-follow-mode " Follow" "")
|
|
(if org-agenda-include-diary " Diary" "")
|
|
(if org-agenda-use-time-grid " Grid" "")
|
|
(if org-agenda-show-log " Log" "")))
|
|
(force-mode-line-update))
|
|
|
|
(defun org-agenda-post-command-hook ()
|
|
(and (eolp) (not (bolp)) (backward-char 1))
|
|
(if (and org-agenda-follow-mode
|
|
(get-text-property (point) 'org-marker))
|
|
(org-agenda-show)))
|
|
|
|
(defvar org-disable-agenda-to-diary nil) ;Dynamically-scoped param.
|
|
|
|
(defun org-get-entries-from-diary (date)
|
|
"Get the (Emacs Calendar) diary entries for DATE."
|
|
(let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*")
|
|
(diary-display-hook '(fancy-diary-display))
|
|
(list-diary-entries-hook
|
|
(cons 'org-diary-default-entry list-diary-entries-hook))
|
|
(diary-file-name-prefix-function nil) ; turn this feature off
|
|
(diary-modify-entry-list-string-function 'org-modify-diary-entry-string)
|
|
entries
|
|
(org-disable-agenda-to-diary t))
|
|
(save-excursion
|
|
(save-window-excursion
|
|
(list-diary-entries date 1))) ;; Keep this name for now, compatibility
|
|
(if (not (get-buffer fancy-diary-buffer))
|
|
(setq entries nil)
|
|
(with-current-buffer fancy-diary-buffer
|
|
(setq buffer-read-only nil)
|
|
(if (= (point-max) 1)
|
|
;; No entries
|
|
(setq entries nil)
|
|
;; Omit the date and other unnecessary stuff
|
|
(org-agenda-cleanup-fancy-diary)
|
|
;; Add prefix to each line and extend the text properties
|
|
(if (= (point-max) 1)
|
|
(setq entries nil)
|
|
(setq entries (buffer-substring (point-min) (- (point-max) 1)))))
|
|
(set-buffer-modified-p nil)
|
|
(kill-buffer fancy-diary-buffer)))
|
|
(when entries
|
|
(setq entries (org-split-string entries "\n"))
|
|
(setq entries
|
|
(mapcar
|
|
(lambda (x)
|
|
(setq x (org-format-agenda-item "" x "Diary" nil 'time))
|
|
;; Extend the text properties to the beginning of the line
|
|
(org-add-props x (text-properties-at (1- (length x)) x)))
|
|
entries)))))
|
|
|
|
(defun org-agenda-cleanup-fancy-diary ()
|
|
"Remove unwanted stuff in buffer created by `fancy-diary-display'.
|
|
This gets rid of the date, the underline under the date, and
|
|
the dummy entry installed by `org-mode' to ensure non-empty diary for each
|
|
date. It also removes lines that contain only whitespace."
|
|
(goto-char (point-min))
|
|
(if (looking-at ".*?:[ \t]*")
|
|
(progn
|
|
(replace-match "")
|
|
(re-search-forward "\n=+$" nil t)
|
|
(replace-match "")
|
|
(while (re-search-backward "^ +\n?" nil t) (replace-match "")))
|
|
(re-search-forward "\n=+$" nil t)
|
|
(delete-region (point-min) (min (point-max) (1+ (match-end 0)))))
|
|
(goto-char (point-min))
|
|
(while (re-search-forward "^ +\n" nil t)
|
|
(replace-match ""))
|
|
(goto-char (point-min))
|
|
(if (re-search-forward "^Org-mode dummy\n?" nil t)
|
|
(replace-match "")))
|
|
|
|
;; Make sure entries from the diary have the right text properties.
|
|
(eval-after-load "diary-lib"
|
|
'(if (boundp 'diary-modify-entry-list-string-function)
|
|
;; We can rely on the hook, nothing to do
|
|
nil
|
|
;; Hook not avaiable, must use advice to make this work
|
|
(defadvice add-to-diary-list (before org-mark-diary-entry activate)
|
|
"Make the position visible."
|
|
(if (and org-disable-agenda-to-diary ;; called from org-agenda
|
|
(stringp string)
|
|
buffer-file-name)
|
|
(setq string (org-modify-diary-entry-string string))))))
|
|
|
|
(defun org-modify-diary-entry-string (string)
|
|
"Add text properties to string, allowing org-mode to act on it."
|
|
(org-add-props string nil
|
|
'mouse-face 'highlight
|
|
'keymap org-agenda-keymap
|
|
'help-echo (format "mouse-2 or RET jump to diary file %s"
|
|
(abbreviate-file-name buffer-file-name))
|
|
'org-agenda-diary-link t
|
|
'org-marker (org-agenda-new-marker (point-at-bol))))
|
|
|
|
(defun org-diary-default-entry ()
|
|
"Add a dummy entry to the diary.
|
|
Needed to avoid empty dates which mess up holiday display."
|
|
;; Catch the error if dealing with the new add-to-diary-alist
|
|
(when org-disable-agenda-to-diary
|
|
(condition-case nil
|
|
(add-to-diary-list original-date "Org-mode dummy" "")
|
|
(error
|
|
(add-to-diary-list original-date "Org-mode dummy" "" nil)))))
|
|
|
|
(defun org-cycle-agenda-files ()
|
|
"Cycle through the files in `org-agenda-files'.
|
|
If the current buffer visits an agenda file, find the next one in the list.
|
|
If the current buffer does not, find the first agenda file."
|
|
(interactive)
|
|
(let* ((fs (org-agenda-files t))
|
|
(files (append fs (list (car fs))))
|
|
(tcf (if buffer-file-name (file-truename buffer-file-name)))
|
|
file)
|
|
(unless files (error "No agenda files"))
|
|
(catch 'exit
|
|
(while (setq file (pop files))
|
|
(if (equal (file-truename file) tcf)
|
|
(when (car files)
|
|
(find-file (car files))
|
|
(throw 'exit t))))
|
|
(find-file (car fs)))))
|
|
|
|
(defun org-agenda-file-to-end ()
|
|
"Move/add the current file to the end of the agenda file list.
|
|
If the file is not present in the list, it is appended to the list. If it is
|
|
present, it is moved there."
|
|
(interactive)
|
|
(org-agenda-file-to-front 'to-end))
|
|
|
|
(defun org-agenda-file-to-front (&optional to-end)
|
|
"Move/add the current file to the top of the agenda file list.
|
|
If the file is not present in the list, it is added to the front. If it is
|
|
present, it is moved there. With optional argument TO-END, add/move to the
|
|
end of the list."
|
|
(interactive "P")
|
|
(let ((file-alist (mapcar (lambda (x)
|
|
(cons (file-truename x) x))
|
|
(org-agenda-files t)))
|
|
(ctf (file-truename buffer-file-name))
|
|
x had)
|
|
(setq x (assoc ctf file-alist) had x)
|
|
|
|
(if (not x) (setq x (cons ctf (abbreviate-file-name buffer-file-name))))
|
|
(if to-end
|
|
(setq file-alist (append (delq x file-alist) (list x)))
|
|
(setq file-alist (cons x (delq x file-alist))))
|
|
(org-store-new-agenda-file-list (mapcar 'cdr file-alist))
|
|
(org-install-agenda-files-menu)
|
|
(message "File %s to %s of agenda file list"
|
|
(if had "moved" "added") (if to-end "end" "front"))))
|
|
|
|
(defun org-remove-file (&optional file)
|
|
"Remove current file from the list of files in variable `org-agenda-files'.
|
|
These are the files which are being checked for agenda entries.
|
|
Optional argument FILE means, use this file instead of the current."
|
|
(interactive)
|
|
(let* ((file (or file buffer-file-name))
|
|
(true-file (file-truename file))
|
|
(afile (abbreviate-file-name file))
|
|
(files (delq nil (mapcar
|
|
(lambda (x)
|
|
(if (equal true-file
|
|
(file-truename x))
|
|
nil x))
|
|
(org-agenda-files t)))))
|
|
(if (not (= (length files) (length (org-agenda-files t))))
|
|
(progn
|
|
(org-store-new-agenda-file-list files)
|
|
(org-install-agenda-files-menu)
|
|
(message "Removed file: %s" afile))
|
|
(message "File was not in list: %s" afile))))
|
|
|
|
(defun org-file-menu-entry (file)
|
|
(vector file (list 'find-file file) t))
|
|
|
|
(defun org-get-all-dates (beg end &optional no-ranges force-today inactive)
|
|
"Return a list of all relevant day numbers from BEG to END buffer positions.
|
|
If NO-RANGES is non-nil, include only the start and end dates of a range,
|
|
not every single day in the range. If FORCE-TODAY is non-nil, make
|
|
sure that TODAY is included in the list. If INACTIVE is non-nil, also
|
|
inactive time stamps (those in square brackets) are included."
|
|
(let ((re (if inactive org-ts-regexp-both org-ts-regexp))
|
|
dates date day day1 day2 ts1 ts2)
|
|
(if force-today
|
|
(setq dates (list (time-to-days (current-time)))))
|
|
(save-excursion
|
|
(goto-char beg)
|
|
(while (re-search-forward re end t)
|
|
(setq day (time-to-days (org-time-string-to-time
|
|
(substring (match-string 1) 0 10))))
|
|
(or (memq day dates) (push day dates)))
|
|
(unless no-ranges
|
|
(goto-char beg)
|
|
(while (re-search-forward org-tr-regexp end t)
|
|
(setq ts1 (substring (match-string 1) 0 10)
|
|
ts2 (substring (match-string 2) 0 10)
|
|
day1 (time-to-days (org-time-string-to-time ts1))
|
|
day2 (time-to-days (org-time-string-to-time ts2)))
|
|
(while (< (setq day1 (1+ day1)) day2)
|
|
(or (memq day1 dates) (push day1 dates)))))
|
|
(sort dates '<))))
|
|
|
|
;;;###autoload
|
|
(defun org-diary (&rest args)
|
|
"Return diary information from org-files.
|
|
This function can be used in a \"sexp\" diary entry in the Emacs calendar.
|
|
It accesses org files and extracts information from those files to be
|
|
listed in the diary. The function accepts arguments specifying what
|
|
items should be listed. The following arguments are allowed:
|
|
|
|
:timestamp List the headlines of items containing a date stamp or
|
|
date range matching the selected date. Deadlines will
|
|
also be listed, on the expiration day.
|
|
|
|
:deadline List any deadlines past due, or due within
|
|
`org-deadline-warning-days'. The listing occurs only
|
|
in the diary for *today*, not at any other date. If
|
|
an entry is marked DONE, it is no longer listed.
|
|
|
|
:scheduled List all items which are scheduled for the given date.
|
|
The diary for *today* also contains items which were
|
|
scheduled earlier and are not yet marked DONE.
|
|
|
|
:todo List all TODO items from the org-file. This may be a
|
|
long list - so this is not turned on by default.
|
|
Like deadlines, these entries only show up in the
|
|
diary for *today*, not at any other date.
|
|
|
|
The call in the diary file should look like this:
|
|
|
|
&%%(org-diary) ~/path/to/some/orgfile.org
|
|
|
|
Use a separate line for each org file to check. Or, if you omit the file name,
|
|
all files listed in `org-agenda-files' will be checked automatically:
|
|
|
|
&%%(org-diary)
|
|
|
|
If you don't give any arguments (as in the example above), the default
|
|
arguments (:deadline :scheduled :timestamp) are used. So the example above may
|
|
also be written as
|
|
|
|
&%%(org-diary :deadline :timestamp :scheduled)
|
|
|
|
The function expects the lisp variables `entry' and `date' to be provided
|
|
by the caller, because this is how the calendar works. Don't use this
|
|
function from a program - use `org-agenda-get-day-entries' instead."
|
|
(org-agenda-maybe-reset-markers)
|
|
(org-compile-prefix-format org-agenda-prefix-format)
|
|
(setq args (or args '(:deadline :scheduled :timestamp)))
|
|
(let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry))
|
|
(list entry)
|
|
(org-agenda-files t)))
|
|
file rtn results)
|
|
;; If this is called during org-agenda, don't return any entries to
|
|
;; the calendar. Org Agenda will list these entries itself.
|
|
(if org-disable-agenda-to-diary (setq files nil))
|
|
(while (setq file (pop files))
|
|
(setq rtn (apply 'org-agenda-get-day-entries file date args))
|
|
(setq results (append results rtn)))
|
|
(if results
|
|
(concat (org-finalize-agenda-entries results) "\n"))))
|
|
(defvar org-category-table nil)
|
|
(defun org-get-category-table ()
|
|
"Get the table of categories and positions in current buffer."
|
|
(let (tbl)
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(while (re-search-forward "\\(^\\|\r\\)#\\+CATEGORY:[ \t]*\\(.*\\)" nil t)
|
|
(push (cons (point) (org-trim (match-string 2))) tbl)))
|
|
tbl))
|
|
(defun org-get-category (&optional pos)
|
|
"Get the category applying to position POS."
|
|
(if (not org-category-table)
|
|
(cond
|
|
((null org-category)
|
|
(setq org-category
|
|
(if buffer-file-name
|
|
(file-name-sans-extension
|
|
(file-name-nondirectory buffer-file-name))
|
|
"???")))
|
|
((symbolp org-category) (symbol-name org-category))
|
|
(t org-category))
|
|
(let ((tbl org-category-table)
|
|
(pos (or pos (point))))
|
|
(while (and tbl (> (caar tbl) pos))
|
|
(pop tbl))
|
|
(or (cdar tbl) (cdr (nth (1- (length org-category-table))
|
|
org-category-table))))))
|
|
|
|
(defun org-agenda-get-day-entries (file date &rest args)
|
|
"Does the work for `org-diary' and `org-agenda'.
|
|
FILE is the path to a file to be checked for entries. DATE is date like
|
|
the one returned by `calendar-current-date'. ARGS are symbols indicating
|
|
which kind of entries should be extracted. For details about these, see
|
|
the documentation of `org-diary'."
|
|
(setq args (or args '(:deadline :scheduled :timestamp)))
|
|
(let* ((org-startup-with-deadline-check nil)
|
|
(org-startup-folded nil)
|
|
(org-startup-align-all-tables nil)
|
|
(buffer (if (file-exists-p file)
|
|
(org-get-agenda-file-buffer file)
|
|
(error "No such file %s" file)))
|
|
arg results rtn)
|
|
(if (not buffer)
|
|
;; If file does not exist, make sure an error message ends up in diary
|
|
(list (format "ORG-AGENDA-ERROR: No such org-file %s" file))
|
|
(with-current-buffer buffer
|
|
(unless (eq major-mode 'org-mode)
|
|
(error "Agenda file %s is not in `org-mode'" file))
|
|
(setq org-category-table (org-get-category-table))
|
|
(let ((case-fold-search nil))
|
|
(save-excursion
|
|
(save-restriction
|
|
(if org-respect-restriction
|
|
(if (org-region-active-p)
|
|
;; Respect a region to restrict search
|
|
(narrow-to-region (region-beginning) (region-end)))
|
|
;; If we work for the calendar or many files,
|
|
;; get rid of any restriction
|
|
(widen))
|
|
;; The way we repeatedly append to `results' makes it O(n^2) :-(
|
|
(while (setq arg (pop args))
|
|
(cond
|
|
((and (eq arg :todo)
|
|
(equal date (calendar-current-date)))
|
|
(setq rtn (org-agenda-get-todos))
|
|
(setq results (append results rtn)))
|
|
((eq arg :timestamp)
|
|
(setq rtn (org-agenda-get-blocks))
|
|
(setq results (append results rtn))
|
|
(setq rtn (org-agenda-get-timestamps))
|
|
(setq results (append results rtn)))
|
|
((eq arg :scheduled)
|
|
(setq rtn (org-agenda-get-scheduled))
|
|
(setq results (append results rtn)))
|
|
((eq arg :closed)
|
|
(setq rtn (org-agenda-get-closed))
|
|
(setq results (append results rtn)))
|
|
((and (eq arg :deadline)
|
|
(equal date (calendar-current-date)))
|
|
(setq rtn (org-agenda-get-deadlines))
|
|
(setq results (append results rtn))))))))
|
|
results))))
|
|
|
|
(defun org-entry-is-done-p ()
|
|
"Is the current entry marked DONE?"
|
|
(save-excursion
|
|
(and (re-search-backward "[\r\n]\\*" nil t)
|
|
(looking-at org-nl-done-regexp))))
|
|
|
|
(defun org-at-date-range-p ()
|
|
"Is the cursor inside a date range?"
|
|
(interactive)
|
|
(save-excursion
|
|
(catch 'exit
|
|
(let ((pos (point)))
|
|
(skip-chars-backward "^<\r\n")
|
|
(skip-chars-backward "<")
|
|
(and (looking-at org-tr-regexp)
|
|
(>= (match-end 0) pos)
|
|
(throw 'exit t))
|
|
(skip-chars-backward "^<\r\n")
|
|
(skip-chars-backward "<")
|
|
(and (looking-at org-tr-regexp)
|
|
(>= (match-end 0) pos)
|
|
(throw 'exit t)))
|
|
nil)))
|
|
|
|
(defun org-agenda-get-todos ()
|
|
"Return the TODO information for agenda display."
|
|
(let* ((props (list 'face nil
|
|
'done-face 'org-done
|
|
'org-not-done-regexp org-not-done-regexp
|
|
'mouse-face 'highlight
|
|
'keymap org-agenda-keymap
|
|
'help-echo
|
|
(format "mouse-2 or RET jump to org file %s"
|
|
(abbreviate-file-name buffer-file-name))))
|
|
(regexp (concat "[\n\r]\\*+ *\\("
|
|
(if org-select-this-todo-keyword
|
|
(concat "\\<\\(" org-select-this-todo-keyword
|
|
"\\)\\>")
|
|
org-not-done-regexp)
|
|
"[^\n\r]*\\)"))
|
|
(sched-re (concat ".*\n.*?" org-scheduled-time-regexp))
|
|
marker priority category tags
|
|
ee txt)
|
|
(goto-char (point-min))
|
|
(while (re-search-forward regexp nil t)
|
|
(when (not (and org-agenda-todo-ignore-scheduled
|
|
(save-match-data (looking-at sched-re))))
|
|
(goto-char (match-beginning 1))
|
|
(setq marker (org-agenda-new-marker (1+ (match-beginning 0)))
|
|
category (org-get-category)
|
|
tags (org-get-tags-at (point))
|
|
txt (org-format-agenda-item "" (match-string 1) category tags)
|
|
priority
|
|
(+ (org-get-priority txt)
|
|
(if org-todo-kwd-priority-p
|
|
(- org-todo-kwd-max-priority -2
|
|
(length
|
|
(member (match-string 2) org-todo-keywords)))
|
|
1)))
|
|
(org-add-props txt props
|
|
'org-marker marker 'org-hd-marker marker
|
|
'priority priority 'category category)
|
|
(push txt ee)
|
|
(if org-agenda-todo-list-sublevels ; FIXME???? Change needed?
|
|
(goto-char (match-end 1))
|
|
(org-end-of-subtree 'invisible))))
|
|
(nreverse ee)))
|
|
|
|
(defconst org-agenda-no-heading-message
|
|
"No heading for this item in buffer or region.")
|
|
|
|
(defun org-agenda-get-timestamps ()
|
|
"Return the date stamp information for agenda display."
|
|
(let* ((props (list 'face nil
|
|
'org-not-done-regexp org-not-done-regexp
|
|
'mouse-face 'highlight
|
|
'keymap org-agenda-keymap
|
|
'help-echo
|
|
(format "mouse-2 or RET jump to org file %s"
|
|
(abbreviate-file-name buffer-file-name))))
|
|
(regexp (regexp-quote
|
|
(substring
|
|
(format-time-string
|
|
(car org-time-stamp-formats)
|
|
(apply 'encode-time ; DATE bound by calendar
|
|
(list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
|
|
0 11)))
|
|
marker hdmarker deadlinep scheduledp donep tmp priority category
|
|
ee txt timestr tags)
|
|
(goto-char (point-min))
|
|
(while (re-search-forward regexp nil t)
|
|
(if (not (save-match-data (org-at-date-range-p)))
|
|
(progn
|
|
(setq marker (org-agenda-new-marker (match-beginning 0))
|
|
category (org-get-category (match-beginning 0))
|
|
tmp (buffer-substring (max (point-min)
|
|
(- (match-beginning 0)
|
|
org-ds-keyword-length))
|
|
(match-beginning 0))
|
|
timestr (buffer-substring (match-beginning 0) (point-at-eol))
|
|
deadlinep (string-match org-deadline-regexp tmp)
|
|
scheduledp (string-match org-scheduled-regexp tmp)
|
|
donep (org-entry-is-done-p))
|
|
(if (string-match ">" timestr)
|
|
;; substring should only run to end of time stamp
|
|
(setq timestr (substring timestr 0 (match-end 0))))
|
|
(save-excursion
|
|
(if (re-search-backward "\\(^\\|\r\\)\\*+" nil t)
|
|
(progn
|
|
(goto-char (match-end 1))
|
|
(setq hdmarker (org-agenda-new-marker)
|
|
tags (org-get-tags-at))
|
|
(looking-at "\\*+[ \t]*\\([^\r\n]+\\)")
|
|
(setq txt (org-format-agenda-item
|
|
(format "%s%s"
|
|
(if deadlinep "Deadline: " "")
|
|
(if scheduledp "Scheduled: " ""))
|
|
(match-string 1) category tags timestr)))
|
|
(setq txt org-agenda-no-heading-message))
|
|
(setq priority (org-get-priority txt))
|
|
(org-add-props txt props
|
|
'org-marker marker 'org-hd-marker hdmarker)
|
|
(if deadlinep
|
|
(org-add-props txt nil
|
|
'face (if donep 'org-done 'org-warning)
|
|
'undone-face 'org-warning 'done-face 'org-done
|
|
'category category 'priority (+ 100 priority))
|
|
(if scheduledp
|
|
(org-add-props txt nil
|
|
'face 'org-scheduled-today
|
|
'undone-face 'org-scheduled-today 'done-face 'org-done
|
|
'category category 'priority (+ 99 priority))
|
|
(org-add-props txt nil 'priority priority 'category category)))
|
|
(push txt ee))
|
|
(outline-next-heading))))
|
|
(nreverse ee)))
|
|
|
|
(defun org-agenda-get-closed ()
|
|
"Return the logged TODO entries for agenda display."
|
|
(let* ((props (list 'mouse-face 'highlight
|
|
'org-not-done-regexp org-not-done-regexp
|
|
'keymap org-agenda-keymap
|
|
'help-echo
|
|
(format "mouse-2 or RET jump to org file %s"
|
|
(abbreviate-file-name buffer-file-name))))
|
|
(regexp (concat
|
|
"\\<" org-closed-string " *\\["
|
|
(regexp-quote
|
|
(substring
|
|
(format-time-string
|
|
(car org-time-stamp-formats)
|
|
(apply 'encode-time ; DATE bound by calendar
|
|
(list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
|
|
1 11))))
|
|
marker hdmarker priority category tags
|
|
ee txt timestr)
|
|
(goto-char (point-min))
|
|
(while (re-search-forward regexp nil t)
|
|
(if (not (save-match-data (org-at-date-range-p)))
|
|
(progn
|
|
(setq marker (org-agenda-new-marker (match-beginning 0))
|
|
category (org-get-category (match-beginning 0))
|
|
timestr (buffer-substring (match-beginning 0) (point-at-eol))
|
|
;; donep (org-entry-is-done-p)
|
|
)
|
|
(if (string-match "\\]" timestr)
|
|
;; substring should only run to end of time stamp
|
|
(setq timestr (substring timestr 0 (match-end 0))))
|
|
(save-excursion
|
|
(if (re-search-backward "\\(^\\|\r\\)\\*+" nil t)
|
|
(progn
|
|
(goto-char (match-end 1))
|
|
(setq hdmarker (org-agenda-new-marker)
|
|
tags (org-get-tags-at))
|
|
(looking-at "\\*+[ \t]*\\([^\r\n]+\\)")
|
|
(setq txt (org-format-agenda-item
|
|
"Closed: "
|
|
(match-string 1) category tags timestr)))
|
|
(setq txt org-agenda-no-heading-message))
|
|
(setq priority 100000)
|
|
(org-add-props txt props
|
|
'org-marker marker 'org-hd-marker hdmarker 'face 'org-done
|
|
'priority priority 'category category
|
|
'undone-face 'org-warning 'done-face 'org-done)
|
|
(push txt ee))
|
|
(outline-next-heading))))
|
|
(nreverse ee)))
|
|
|
|
(defun org-agenda-get-deadlines ()
|
|
"Return the deadline information for agenda display."
|
|
(let* ((wdays org-deadline-warning-days)
|
|
(props (list 'mouse-face 'highlight
|
|
'org-not-done-regexp org-not-done-regexp
|
|
'keymap org-agenda-keymap
|
|
'help-echo
|
|
(format "mouse-2 or RET jump to org file %s"
|
|
(abbreviate-file-name buffer-file-name))))
|
|
(regexp org-deadline-time-regexp)
|
|
(todayp (equal date (calendar-current-date))) ; DATE bound by calendar
|
|
(d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar
|
|
d2 diff pos pos1 category tags
|
|
ee txt head)
|
|
(goto-char (point-min))
|
|
(while (re-search-forward regexp nil t)
|
|
(setq pos (1- (match-beginning 1))
|
|
d2 (time-to-days
|
|
(org-time-string-to-time (match-string 1)))
|
|
diff (- d2 d1))
|
|
;; When to show a deadline in the calendar:
|
|
;; If the expiration is within wdays warning time.
|
|
;; Past-due deadlines are only shown on the current date
|
|
(if (and (< diff wdays) todayp (not (= diff 0)))
|
|
(save-excursion
|
|
(setq category (org-get-category))
|
|
(if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t)
|
|
(progn
|
|
(goto-char (match-end 0))
|
|
(setq pos1 (match-end 1))
|
|
(setq tags (org-get-tags-at pos1))
|
|
(setq head (buffer-substring-no-properties
|
|
(point)
|
|
(progn (skip-chars-forward "^\r\n")
|
|
(point))))
|
|
(if (string-match org-looking-at-done-regexp head)
|
|
(setq txt nil)
|
|
(setq txt (org-format-agenda-item
|
|
(format "In %3d d.: " diff) head category tags))))
|
|
(setq txt org-agenda-no-heading-message))
|
|
(when txt
|
|
(org-add-props txt props
|
|
'org-marker (org-agenda-new-marker pos)
|
|
'org-hd-marker (org-agenda-new-marker pos1)
|
|
'priority (+ (- 10 diff) (org-get-priority txt))
|
|
'category category
|
|
'face (cond ((<= diff 0) 'org-warning)
|
|
((<= diff 5) 'org-scheduled-previously)
|
|
(t nil))
|
|
'undone-face (cond
|
|
((<= diff 0) 'org-warning)
|
|
((<= diff 5) 'org-scheduled-previously)
|
|
(t nil))
|
|
'done-face 'org-done)
|
|
(push txt ee)))))
|
|
ee))
|
|
|
|
(defun org-agenda-get-scheduled ()
|
|
"Return the scheduled information for agenda display."
|
|
(let* ((props (list 'face 'org-scheduled-previously
|
|
'org-not-done-regexp org-not-done-regexp
|
|
'undone-face 'org-scheduled-previously
|
|
'done-face 'org-done
|
|
'mouse-face 'highlight
|
|
'keymap org-agenda-keymap
|
|
'help-echo
|
|
(format "mouse-2 or RET jump to org file %s"
|
|
(abbreviate-file-name buffer-file-name))))
|
|
(regexp org-scheduled-time-regexp)
|
|
(todayp (equal date (calendar-current-date))) ; DATE bound by calendar
|
|
(d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar
|
|
d2 diff pos pos1 category tags
|
|
ee txt head)
|
|
(goto-char (point-min))
|
|
(while (re-search-forward regexp nil t)
|
|
(setq pos (1- (match-beginning 1))
|
|
d2 (time-to-days
|
|
(org-time-string-to-time (match-string 1)))
|
|
diff (- d2 d1))
|
|
;; When to show a scheduled item in the calendar:
|
|
;; If it is on or past the date.
|
|
(if (and (< diff 0) todayp)
|
|
(save-excursion
|
|
(setq category (org-get-category))
|
|
(if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t)
|
|
(progn
|
|
(goto-char (match-end 0))
|
|
(setq pos1 (match-end 1))
|
|
(setq tags (org-get-tags-at))
|
|
(setq head (buffer-substring-no-properties
|
|
(point)
|
|
(progn (skip-chars-forward "^\r\n") (point))))
|
|
(if (string-match org-looking-at-done-regexp head)
|
|
(setq txt nil)
|
|
(setq txt (org-format-agenda-item
|
|
(format "Sched.%2dx: " (- 1 diff)) head
|
|
category tags))))
|
|
(setq txt org-agenda-no-heading-message))
|
|
(when txt
|
|
(org-add-props txt props
|
|
'org-marker (org-agenda-new-marker pos)
|
|
'org-hd-marker (org-agenda-new-marker pos1)
|
|
'priority (+ (- 5 diff) (org-get-priority txt))
|
|
'category category)
|
|
(push txt ee)))))
|
|
ee))
|
|
|
|
(defun org-agenda-get-blocks ()
|
|
"Return the date-range information for agenda display."
|
|
(let* ((props (list 'face nil
|
|
'org-not-done-regexp org-not-done-regexp
|
|
'mouse-face 'highlight
|
|
'keymap org-agenda-keymap
|
|
'help-echo
|
|
(format "mouse-2 or RET jump to org file %s"
|
|
(abbreviate-file-name buffer-file-name))))
|
|
(regexp org-tr-regexp)
|
|
(d0 (calendar-absolute-from-gregorian date))
|
|
marker hdmarker ee txt d1 d2 s1 s2 timestr category tags)
|
|
(goto-char (point-min))
|
|
(while (re-search-forward regexp nil t)
|
|
(setq timestr (match-string 0)
|
|
s1 (match-string 1)
|
|
s2 (match-string 2)
|
|
d1 (time-to-days (org-time-string-to-time s1))
|
|
d2 (time-to-days (org-time-string-to-time s2)))
|
|
(if (and (> (- d0 d1) -1) (> (- d2 d0) -1))
|
|
;; Only allow days between the limits, because the normal
|
|
;; date stamps will catch the limits.
|
|
(save-excursion
|
|
(setq marker (org-agenda-new-marker (point)))
|
|
(setq category (org-get-category))
|
|
(if (re-search-backward "\\(^\\|\r\\)\\*+" nil t)
|
|
(progn
|
|
(setq hdmarker (org-agenda-new-marker (match-end 1)))
|
|
(goto-char (match-end 1))
|
|
(setq tags (org-get-tags-at))
|
|
(looking-at "\\*+[ \t]*\\([^\r\n]+\\)")
|
|
(setq txt (org-format-agenda-item
|
|
(format (if (= d1 d2) "" "(%d/%d): ")
|
|
(1+ (- d0 d1)) (1+ (- d2 d1)))
|
|
(match-string 1) category tags
|
|
(if (= d0 d1) timestr))))
|
|
(setq txt org-agenda-no-heading-message))
|
|
(org-add-props txt props
|
|
'org-marker marker 'org-hd-marker hdmarker
|
|
'priority (org-get-priority txt) 'category category)
|
|
(push txt ee)))
|
|
(outline-next-heading))
|
|
;; Sort the entries by expiration date.
|
|
(nreverse ee)))
|
|
|
|
(defconst org-plain-time-of-day-regexp
|
|
(concat
|
|
"\\(\\<[012]?[0-9]"
|
|
"\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)"
|
|
"\\(--?"
|
|
"\\(\\<[012]?[0-9]"
|
|
"\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)"
|
|
"\\)?")
|
|
"Regular expression to match a plain time or time range.
|
|
Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following
|
|
groups carry important information:
|
|
0 the full match
|
|
1 the first time, range or not
|
|
8 the second time, if it is a range.")
|
|
|
|
(defconst org-stamp-time-of-day-regexp
|
|
(concat
|
|
"<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} +[a-zA-Z]+ +\\)"
|
|
"\\([012][0-9]:[0-5][0-9]\\)>"
|
|
"\\(--?"
|
|
"<\\1\\([012][0-9]:[0-5][0-9]\\)>\\)?")
|
|
"Regular expression to match a timestamp time or time range.
|
|
After a match, the following groups carry important information:
|
|
0 the full match
|
|
1 date plus weekday, for backreferencing to make sure both times on same day
|
|
2 the first time, range or not
|
|
4 the second time, if it is a range.")
|
|
|
|
(defvar org-prefix-has-time nil
|
|
"A flag, set by `org-compile-prefix-format'.
|
|
The flag is set if the currently compiled format contains a `%t'.")
|
|
(defvar org-prefix-has-tag nil
|
|
"A flag, set by `org-compile-prefix-format'.
|
|
The flag is set if the currently compiled format contains a `%T'.")
|
|
|
|
(defun org-format-agenda-item (extra txt &optional category tags dotime noprefix)
|
|
"Format TXT to be inserted into the agenda buffer.
|
|
In particular, it adds the prefix and corresponding text properties. EXTRA
|
|
must be a string and replaces the `%s' specifier in the prefix format.
|
|
CATEGORY (string, symbol or nil) may be used to overrule the default
|
|
category taken from local variable or file name. It will replace the `%c'
|
|
specifier in the format. DOTIME, when non-nil, indicates that a
|
|
time-of-day should be extracted from TXT for sorting of this entry, and for
|
|
the `%t' specifier in the format. When DOTIME is a string, this string is
|
|
searched for a time before TXT is. NOPREFIX is a flag and indicates that
|
|
only the correctly processes TXT should be returned - this is used by
|
|
`org-agenda-change-all-lines'. TAG can be the tag of the headline."
|
|
(save-match-data
|
|
;; Diary entries sometimes have extra whitespace at the beginning
|
|
(if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt)))
|
|
(let* ((category (or category
|
|
org-category
|
|
(if buffer-file-name
|
|
(file-name-sans-extension
|
|
(file-name-nondirectory buffer-file-name))
|
|
"")))
|
|
(tag (if tags (nth (1- (length tags)) tags) ""))
|
|
time ;; needed for the eval of the prefix format
|
|
(ts (if dotime (concat (if (stringp dotime) dotime "") txt)))
|
|
(time-of-day (and dotime (org-get-time-of-day ts)))
|
|
stamp plain s0 s1 s2 rtn)
|
|
(when (and dotime time-of-day org-prefix-has-time)
|
|
;; Extract starting and ending time and move them to prefix
|
|
(when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts))
|
|
(setq plain (string-match org-plain-time-of-day-regexp ts)))
|
|
(setq s0 (match-string 0 ts)
|
|
s1 (match-string (if plain 1 2) ts)
|
|
s2 (match-string (if plain 8 4) ts))
|
|
|
|
;; If the times are in TXT (not in DOTIMES), and the prefix will list
|
|
;; them, we might want to remove them there to avoid duplication.
|
|
;; The user can turn this off with a variable.
|
|
(if (and org-agenda-remove-times-when-in-prefix (or stamp plain)
|
|
(string-match (concat (regexp-quote s0) " *") txt)
|
|
(if (eq org-agenda-remove-times-when-in-prefix 'beg)
|
|
(= (match-beginning 0) 0)
|
|
t))
|
|
(setq txt (replace-match "" nil nil txt))))
|
|
;; Normalize the time(s) to 24 hour
|
|
(if s1 (setq s1 (org-get-time-of-day s1 'string)))
|
|
(if s2 (setq s2 (org-get-time-of-day s2 'string))))
|
|
|
|
(when (and (or (eq org-agenda-remove-tags-when-in-prefix t)
|
|
(and org-agenda-remove-tags-when-in-prefix
|
|
org-prefix-has-tag))
|
|
(string-match ":[a-zA-Z_@0-9:]+:[ \t]*$" txt))
|
|
(setq txt (replace-match "" t t txt)))
|
|
|
|
;; Create the final string
|
|
(if noprefix
|
|
(setq rtn txt)
|
|
;; Prepare the variables needed in the eval of the compiled format
|
|
(setq time (cond (s2 (concat s1 "-" s2))
|
|
(s1 (concat s1 "......"))
|
|
(t ""))
|
|
extra (or extra "")
|
|
category (if (symbolp category) (symbol-name category) category))
|
|
;; Evaluate the compiled format
|
|
(setq rtn (concat (eval org-prefix-format-compiled) txt)))
|
|
|
|
;; And finally add the text properties
|
|
(org-add-props rtn nil
|
|
'category (downcase category) 'tags tags
|
|
'prefix-length (- (length rtn) (length txt))
|
|
'time-of-day time-of-day
|
|
'dotime dotime))))
|
|
|
|
(defun org-agenda-add-time-grid-maybe (list ndays todayp)
|
|
(catch 'exit
|
|
(cond ((not org-agenda-use-time-grid) (throw 'exit list))
|
|
((and todayp (member 'today (car org-agenda-time-grid))))
|
|
((and (= ndays 1) (member 'daily (car org-agenda-time-grid))))
|
|
((member 'weekly (car org-agenda-time-grid)))
|
|
(t (throw 'exit list)))
|
|
(let* ((have (delq nil (mapcar
|
|
(lambda (x) (get-text-property 1 'time-of-day x))
|
|
list)))
|
|
(string (nth 1 org-agenda-time-grid))
|
|
(gridtimes (nth 2 org-agenda-time-grid))
|
|
(req (car org-agenda-time-grid))
|
|
(remove (member 'remove-match req))
|
|
new time)
|
|
(if (and (member 'require-timed req) (not have))
|
|
;; don't show empty grid
|
|
(throw 'exit list))
|
|
(while (setq time (pop gridtimes))
|
|
(unless (and remove (member time have))
|
|
(setq time (int-to-string time))
|
|
(push (org-format-agenda-item
|
|
nil string "" nil
|
|
(concat (substring time 0 -2) ":" (substring time -2)))
|
|
new)
|
|
(put-text-property
|
|
1 (length (car new)) 'face 'org-time-grid (car new))))
|
|
(if (member 'time-up org-agenda-sorting-strategy)
|
|
(append new list)
|
|
(append list new)))))
|
|
|
|
(defun org-compile-prefix-format (format)
|
|
"Compile the prefix format into a Lisp form that can be evaluated.
|
|
The resulting form is returned and stored in the variable
|
|
`org-prefix-format-compiled'."
|
|
(setq org-prefix-has-time nil org-prefix-has-tag nil)
|
|
(let ((start 0) varform vars var (s format)e c f opt)
|
|
(while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cts]\\)"
|
|
s start)
|
|
(setq var (cdr (assoc (match-string 4 s)
|
|
'(("c" . category) ("t" . time) ("s" . extra)
|
|
("T" . tag))))
|
|
c (or (match-string 3 s) "")
|
|
opt (match-beginning 1)
|
|
start (1+ (match-beginning 0)))
|
|
(if (equal var 'time) (setq org-prefix-has-time t))
|
|
(if (equal var 'tag) (setq org-prefix-has-tag t))
|
|
(setq f (concat "%" (match-string 2 s) "s"))
|
|
(if opt
|
|
(setq varform
|
|
`(if (equal "" ,var)
|
|
""
|
|
(format ,f (if (equal "" ,var) "" (concat ,var ,c)))))
|
|
(setq varform `(format ,f (if (equal ,var "") "" (concat ,var ,c)))))
|
|
(setq s (replace-match "%s" t nil s))
|
|
(push varform vars))
|
|
(setq vars (nreverse vars))
|
|
(setq org-prefix-format-compiled `(format ,s ,@vars))))
|
|
|
|
(defun org-get-time-of-day (s &optional string)
|
|
"Check string S for a time of day.
|
|
If found, return it as a military time number between 0 and 2400.
|
|
If not found, return nil.
|
|
The optional STRING argument forces conversion into a 5 character wide string
|
|
HH:MM."
|
|
(save-match-data
|
|
(when
|
|
(or
|
|
(string-match
|
|
"\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
|
|
(string-match
|
|
"\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s))
|
|
(let* ((t0 (+ (* 100
|
|
(+ (string-to-number (match-string 1 s))
|
|
(if (and (match-beginning 4)
|
|
(equal (downcase (match-string 4 s)) "pm"))
|
|
12 0)))
|
|
(if (match-beginning 3)
|
|
(string-to-number (match-string 3 s))
|
|
0)))
|
|
(t1 (concat " "
|
|
(if (< t0 100) "0" "") (if (< t0 10) "0" "")
|
|
(int-to-string t0))))
|
|
(if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0)))))
|
|
|
|
(defun org-finalize-agenda-entries (list)
|
|
"Sort and concatenate the agenda items."
|
|
(setq list (mapcar 'org-agenda-highlight-todo list))
|
|
(mapconcat 'identity (sort list 'org-entries-lessp) "\n"))
|
|
|
|
(defun org-agenda-highlight-todo (x)
|
|
(let (re)
|
|
(if (eq x 'line)
|
|
(save-excursion
|
|
(beginning-of-line 1)
|
|
(setq re (get-text-property (point) 'org-not-done-regexp))
|
|
(goto-char (+ (point) (get-text-property (point) 'prefix-length)))
|
|
(and (looking-at (concat "[ \t]*" re))
|
|
(add-text-properties (match-beginning 0) (match-end 0)
|
|
'(face org-todo))))
|
|
(setq re (get-text-property 0 'org-not-done-regexp x))
|
|
(and re (string-match re x)
|
|
(add-text-properties (match-beginning 0) (match-end 0)
|
|
'(face org-todo) x))
|
|
x)))
|
|
|
|
(defsubst org-cmp-priority (a b)
|
|
"Compare the priorities of string A and B."
|
|
(let ((pa (or (get-text-property 1 'priority a) 0))
|
|
(pb (or (get-text-property 1 'priority b) 0)))
|
|
(cond ((> pa pb) +1)
|
|
((< pa pb) -1)
|
|
(t nil))))
|
|
|
|
(defsubst org-cmp-category (a b)
|
|
"Compare the string values of categories of strings A and B."
|
|
(let ((ca (or (get-text-property 1 'category a) ""))
|
|
(cb (or (get-text-property 1 'category b) "")))
|
|
(cond ((string-lessp ca cb) -1)
|
|
((string-lessp cb ca) +1)
|
|
(t nil))))
|
|
|
|
(defsubst org-cmp-time (a b)
|
|
"Compare the time-of-day values of strings A and B."
|
|
(let* ((def (if org-sort-agenda-notime-is-late 2401 -1))
|
|
(ta (or (get-text-property 1 'time-of-day a) def))
|
|
(tb (or (get-text-property 1 'time-of-day b) def)))
|
|
(cond ((< ta tb) -1)
|
|
((< tb ta) +1)
|
|
(t nil))))
|
|
|
|
(defun org-entries-lessp (a b)
|
|
"Predicate for sorting agenda entries."
|
|
;; The following variables will be used when the form is evaluated.
|
|
(let* ((time-up (org-cmp-time a b))
|
|
(time-down (if time-up (- time-up) nil))
|
|
(priority-up (org-cmp-priority a b))
|
|
(priority-down (if priority-up (- priority-up) nil))
|
|
(category-up (org-cmp-category a b))
|
|
(category-down (if category-up (- category-up) nil))
|
|
(category-keep (if category-up +1 nil)))
|
|
(cdr (assoc
|
|
(eval (cons 'or org-agenda-sorting-strategy))
|
|
'((-1 . t) (1 . nil) (nil . nil))))))
|
|
|
|
(defun org-agenda-show-priority ()
|
|
"Show the priority of the current item.
|
|
This priority is composed of the main priority given with the [#A] cookies,
|
|
and by additional input from the age of a schedules or deadline entry."
|
|
(interactive)
|
|
(let* ((pri (get-text-property (point-at-bol) 'priority)))
|
|
(message "Priority is %d" (if pri pri -1000))))
|
|
|
|
(defun org-agenda-show-tags ()
|
|
"Show the tags applicable to the current item."
|
|
(interactive)
|
|
(let* ((tags (get-text-property (point-at-bol) 'tags)))
|
|
(if tags
|
|
(message "Tags are :%s:" (mapconcat 'identity tags ":"))
|
|
(message "No tags associated with this line"))))
|
|
|
|
(defun org-agenda-goto (&optional highlight)
|
|
"Go to the Org-mode file which contains the item at point."
|
|
(interactive)
|
|
(let* ((marker (or (get-text-property (point) 'org-marker)
|
|
(org-agenda-error)))
|
|
(buffer (marker-buffer marker))
|
|
(pos (marker-position marker)))
|
|
(switch-to-buffer-other-window buffer)
|
|
(widen)
|
|
(goto-char pos)
|
|
(when (eq major-mode 'org-mode)
|
|
(org-show-hidden-entry)
|
|
(save-excursion
|
|
(and (outline-next-heading)
|
|
(org-flag-heading nil)))) ; show the next heading
|
|
(and highlight (org-highlight (point-at-bol) (point-at-eol)))))
|
|
|
|
(defun org-agenda-switch-to ()
|
|
"Go to the Org-mode file which contains the item at point."
|
|
(interactive)
|
|
(let* ((marker (or (get-text-property (point) 'org-marker)
|
|
(org-agenda-error)))
|
|
(buffer (marker-buffer marker))
|
|
(pos (marker-position marker)))
|
|
(switch-to-buffer buffer)
|
|
(delete-other-windows)
|
|
(widen)
|
|
(goto-char pos)
|
|
(when (eq major-mode 'org-mode)
|
|
(org-show-hidden-entry)
|
|
(save-excursion
|
|
(and (outline-next-heading)
|
|
(org-flag-heading nil)))))) ; show the next heading
|
|
|
|
(defun org-agenda-goto-mouse (ev)
|
|
"Go to the Org-mode file which contains the item at the mouse click."
|
|
(interactive "e")
|
|
(mouse-set-point ev)
|
|
(org-agenda-goto))
|
|
|
|
(defun org-agenda-show ()
|
|
"Display the Org-mode file which contains the item at point."
|
|
(interactive)
|
|
(let ((win (selected-window)))
|
|
(org-agenda-goto t)
|
|
(select-window win)))
|
|
|
|
(defun org-agenda-recenter (arg)
|
|
"Display the Org-mode file which contains the item at point and recenter."
|
|
(interactive "P")
|
|
(let ((win (selected-window)))
|
|
(org-agenda-goto t)
|
|
(recenter arg)
|
|
(select-window win)))
|
|
|
|
(defun org-agenda-show-mouse (ev)
|
|
"Display the Org-mode file which contains the item at the mouse click."
|
|
(interactive "e")
|
|
(mouse-set-point ev)
|
|
(org-agenda-show))
|
|
|
|
(defun org-agenda-check-no-diary ()
|
|
"Check if the entry is a diary link and abort if yes."
|
|
(if (get-text-property (point) 'org-agenda-diary-link)
|
|
(org-agenda-error)))
|
|
|
|
(defun org-agenda-error ()
|
|
(error "Command not allowed in this line"))
|
|
|
|
(defvar org-last-heading-marker (make-marker)
|
|
"Marker pointing to the headline that last changed its TODO state
|
|
by a remote command from the agenda.")
|
|
|
|
(defun org-agenda-todo (&optional arg)
|
|
"Cycle TODO state of line at point, also in Org-mode file.
|
|
This changes the line at point, all other lines in the agenda referring to
|
|
the same tree node, and the headline of the tree node in the Org-mode file."
|
|
(interactive "P")
|
|
(org-agenda-check-no-diary)
|
|
(let* ((col (current-column))
|
|
(marker (or (get-text-property (point) 'org-marker)
|
|
(org-agenda-error)))
|
|
(buffer (marker-buffer marker))
|
|
(pos (marker-position marker))
|
|
(hdmarker (get-text-property (point) 'org-hd-marker))
|
|
(buffer-read-only nil)
|
|
newhead)
|
|
(with-current-buffer buffer
|
|
(widen)
|
|
(goto-char pos)
|
|
(org-show-hidden-entry)
|
|
(save-excursion
|
|
(and (outline-next-heading)
|
|
(org-flag-heading nil))) ; show the next heading
|
|
(org-todo arg)
|
|
(and (bolp) (forward-char 1))
|
|
(setq newhead (org-get-heading))
|
|
(save-excursion
|
|
(org-back-to-heading)
|
|
(move-marker org-last-heading-marker (point))))
|
|
(beginning-of-line 1)
|
|
(save-excursion
|
|
(org-agenda-change-all-lines newhead hdmarker 'fixface))
|
|
(move-to-column col)))
|
|
|
|
(defun org-agenda-change-all-lines (newhead hdmarker &optional fixface)
|
|
"Change all lines in the agenda buffer which match HDMARKER.
|
|
The new content of the line will be NEWHEAD (as modified by
|
|
`org-format-agenda-item'). HDMARKER is checked with
|
|
`equal' against all `org-hd-marker' text properties in the file.
|
|
If FIXFACE is non-nil, the face of each item is modified acording to
|
|
the new TODO state."
|
|
(let* (props m pl undone-face done-face finish new dotime cat tags)
|
|
; (setq newhead (org-format-agenda-item "x" newhead "x" nil 'noprefix))
|
|
(save-excursion
|
|
(goto-char (point-max))
|
|
(beginning-of-line 1)
|
|
(while (not finish)
|
|
(setq finish (bobp))
|
|
(when (and (setq m (get-text-property (point) 'org-hd-marker))
|
|
(equal m hdmarker))
|
|
(setq props (text-properties-at (point))
|
|
dotime (get-text-property (point) 'dotime)
|
|
cat (get-text-property (point) 'category)
|
|
tags (get-text-property (point) 'tags)
|
|
new (org-format-agenda-item "x" newhead cat tags dotime 'noprefix)
|
|
pl (get-text-property (point) 'prefix-length)
|
|
undone-face (get-text-property (point) 'undone-face)
|
|
done-face (get-text-property (point) 'done-face))
|
|
(move-to-column pl)
|
|
(if (looking-at ".*")
|
|
(progn
|
|
(replace-match new t t)
|
|
(beginning-of-line 1)
|
|
(add-text-properties (point-at-bol) (point-at-eol) props)
|
|
(when fixface
|
|
(add-text-properties
|
|
(point-at-bol) (point-at-eol)
|
|
(list 'face
|
|
(if org-last-todo-state-is-todo
|
|
undone-face done-face)))
|
|
(org-agenda-highlight-todo 'line))
|
|
(beginning-of-line 1))
|
|
(error "Line update did not work")))
|
|
(beginning-of-line 0)))))
|
|
|
|
(defun org-agenda-priority-up ()
|
|
"Increase the priority of line at point, also in Org-mode file."
|
|
(interactive)
|
|
(org-agenda-priority 'up))
|
|
|
|
(defun org-agenda-priority-down ()
|
|
"Decrease the priority of line at point, also in Org-mode file."
|
|
(interactive)
|
|
(org-agenda-priority 'down))
|
|
|
|
(defun org-agenda-priority (&optional force-direction)
|
|
"Set the priority of line at point, also in Org-mode file.
|
|
This changes the line at point, all other lines in the agenda referring to
|
|
the same tree node, and the headline of the tree node in the Org-mode file."
|
|
(interactive)
|
|
(org-agenda-check-no-diary)
|
|
(let* ((marker (or (get-text-property (point) 'org-marker)
|
|
(org-agenda-error)))
|
|
(buffer (marker-buffer marker))
|
|
(pos (marker-position marker))
|
|
(hdmarker (get-text-property (point) 'org-hd-marker))
|
|
(buffer-read-only nil)
|
|
newhead)
|
|
(with-current-buffer buffer
|
|
(widen)
|
|
(goto-char pos)
|
|
(org-show-hidden-entry)
|
|
(save-excursion
|
|
(and (outline-next-heading)
|
|
(org-flag-heading nil))) ; show the next heading
|
|
(funcall 'org-priority force-direction)
|
|
(end-of-line 1)
|
|
(setq newhead (org-get-heading)))
|
|
(org-agenda-change-all-lines newhead hdmarker)
|
|
(beginning-of-line 1)))
|
|
|
|
(defun org-get-tags-at (&optional pos)
|
|
"Get a list of all headline tags applicable at POS.
|
|
POS defaults to point. If tags are inherited, the list contains
|
|
the targets in the same sequence as the headlines appear, i.e.
|
|
the tags of the current headline come last."
|
|
(interactive)
|
|
(let (tags)
|
|
(save-excursion
|
|
(goto-char (or pos (point)))
|
|
(save-match-data
|
|
(org-back-to-heading t)
|
|
(condition-case nil
|
|
(while t
|
|
(if (looking-at "[^\r\n]+?:\\([a-zA-Z_@0-9:]+\\):[ \t]*\\([\n\r]\\|\\'\\)")
|
|
(setq tags (append (org-split-string (match-string 1) ":") tags)))
|
|
(or org-use-tag-inheritance (error ""))
|
|
(org-up-heading-all 1))
|
|
(error nil))))
|
|
(message "%s" tags)
|
|
tags))
|
|
|
|
(defun org-agenda-set-tags ()
|
|
"Set tags for the current headline."
|
|
(interactive)
|
|
(org-agenda-check-no-diary)
|
|
(org-agenda-show) ;;; FIXME This is a stupid hack and should not be needed
|
|
(let* ((hdmarker (or (get-text-property (point) 'org-hd-marker)
|
|
(org-agenda-error)))
|
|
(buffer (marker-buffer hdmarker))
|
|
(pos (marker-position hdmarker))
|
|
(buffer-read-only nil)
|
|
newhead)
|
|
(with-current-buffer buffer
|
|
(widen)
|
|
(goto-char pos)
|
|
(org-show-hidden-entry)
|
|
(save-excursion
|
|
(and (outline-next-heading)
|
|
(org-flag-heading nil))) ; show the next heading
|
|
(call-interactively 'org-set-tags)
|
|
(end-of-line 1)
|
|
(setq newhead (org-get-heading)))
|
|
(org-agenda-change-all-lines newhead hdmarker)
|
|
(beginning-of-line 1)))
|
|
|
|
(defun org-agenda-date-later (arg &optional what)
|
|
"Change the date of this item to one day later."
|
|
(interactive "p")
|
|
(org-agenda-check-type t 'agenda 'timeline)
|
|
(org-agenda-check-no-diary)
|
|
(let* ((marker (or (get-text-property (point) 'org-marker)
|
|
(org-agenda-error)))
|
|
(buffer (marker-buffer marker))
|
|
(pos (marker-position marker)))
|
|
(with-current-buffer buffer
|
|
(widen)
|
|
(goto-char pos)
|
|
(if (not (org-at-timestamp-p))
|
|
(error "Cannot find time stamp"))
|
|
(org-timestamp-change arg (or what 'day))
|
|
(message "Time stamp changed to %s" org-last-changed-timestamp))))
|
|
|
|
(defun org-agenda-date-earlier (arg &optional what)
|
|
"Change the date of this item to one day earlier."
|
|
(interactive "p")
|
|
(org-agenda-date-later (- arg) what))
|
|
|
|
(defun org-agenda-date-prompt (arg)
|
|
"Change the date of this item. Date is prompted for, with default today.
|
|
The prefix ARG is passed to the `org-time-stamp' command and can therefore
|
|
be used to request time specification in the time stamp."
|
|
(interactive "P")
|
|
(org-agenda-check-type t 'agenda 'timeline)
|
|
(org-agenda-check-no-diary)
|
|
(let* ((marker (or (get-text-property (point) 'org-marker)
|
|
(org-agenda-error)))
|
|
(buffer (marker-buffer marker))
|
|
(pos (marker-position marker)))
|
|
(with-current-buffer buffer
|
|
(widen)
|
|
(goto-char pos)
|
|
(if (not (org-at-timestamp-p))
|
|
(error "Cannot find time stamp"))
|
|
(org-time-stamp arg)
|
|
(message "Time stamp changed to %s" org-last-changed-timestamp))))
|
|
|
|
(defun org-agenda-schedule (arg)
|
|
"Schedule the item at point."
|
|
(interactive "P")
|
|
(org-agenda-check-type t 'agenda 'timeline 'todo 'tags)
|
|
(org-agenda-check-no-diary)
|
|
(let* ((marker (or (get-text-property (point) 'org-marker)
|
|
(org-agenda-error)))
|
|
(buffer (marker-buffer marker))
|
|
(pos (marker-position marker))
|
|
(org-insert-labeled-timestamps-at-point nil)
|
|
ts)
|
|
(with-current-buffer buffer
|
|
(widen)
|
|
(goto-char pos)
|
|
(setq ts (org-schedule))
|
|
(message "Item scheduled for %s" ts))))
|
|
|
|
(defun org-agenda-deadline (arg)
|
|
"Schedule the item at point."
|
|
(interactive "P")
|
|
(org-agenda-check-type t 'agenda 'timeline 'todo 'tags)
|
|
(org-agenda-check-no-diary)
|
|
(let* ((marker (or (get-text-property (point) 'org-marker)
|
|
(org-agenda-error)))
|
|
(buffer (marker-buffer marker))
|
|
(pos (marker-position marker))
|
|
(org-insert-labeled-timestamps-at-point nil)
|
|
ts)
|
|
(with-current-buffer buffer
|
|
(widen)
|
|
(goto-char pos)
|
|
(setq ts (org-deadline))
|
|
(message "Deadline for this item set to %s" ts))))
|
|
|
|
(defun org-get-heading ()
|
|
"Return the heading of the current entry, without the stars."
|
|
(save-excursion
|
|
(and (memq (char-before) '(?\n ?\r)) (skip-chars-forward "^\n\r"))
|
|
(if (and (re-search-backward "[\r\n]\\*" nil t)
|
|
(looking-at "[\r\n]\\*+[ \t]+\\([^\r\n]*\\)"))
|
|
(match-string 1)
|
|
"")))
|
|
|
|
(defun org-agenda-diary-entry ()
|
|
"Make a diary entry, like the `i' command from the calendar.
|
|
All the standard commands work: block, weekly etc."
|
|
(interactive)
|
|
(org-agenda-check-type t 'agenda 'timeline)
|
|
(require 'diary-lib)
|
|
(let* ((char (progn
|
|
(message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic")
|
|
(read-char-exclusive)))
|
|
(cmd (cdr (assoc char
|
|
'((?d . insert-diary-entry)
|
|
(?w . insert-weekly-diary-entry)
|
|
(?m . insert-monthly-diary-entry)
|
|
(?y . insert-yearly-diary-entry)
|
|
(?a . insert-anniversary-diary-entry)
|
|
(?b . insert-block-diary-entry)
|
|
(?c . insert-cyclic-diary-entry)))))
|
|
(oldf (symbol-function 'calendar-cursor-to-date))
|
|
(point (point))
|
|
(mark (or (mark t) (point))))
|
|
(unless cmd
|
|
(error "No command associated with <%c>" char))
|
|
(unless (and (get-text-property point 'day)
|
|
(or (not (equal ?b char))
|
|
(get-text-property mark 'day)))
|
|
(error "Don't know which date to use for diary entry"))
|
|
;; We implement this by hacking the `calendar-cursor-to-date' function
|
|
;; and the `calendar-mark-ring' variable. Saves a lot of code.
|
|
(let ((calendar-mark-ring
|
|
(list (calendar-gregorian-from-absolute
|
|
(or (get-text-property mark 'day)
|
|
(get-text-property point 'day))))))
|
|
(unwind-protect
|
|
(progn
|
|
(fset 'calendar-cursor-to-date
|
|
(lambda (&optional error)
|
|
(calendar-gregorian-from-absolute
|
|
(get-text-property point 'day))))
|
|
(call-interactively cmd))
|
|
(fset 'calendar-cursor-to-date oldf)))))
|
|
|
|
|
|
(defun org-agenda-execute-calendar-command (cmd)
|
|
"Execute a calendar command from the agenda, with the date associated to
|
|
the cursor position."
|
|
(org-agenda-check-type t 'agenda 'timeline)
|
|
(require 'diary-lib)
|
|
(unless (get-text-property (point) 'day)
|
|
(error "Don't know which date to use for calendar command"))
|
|
(let* ((oldf (symbol-function 'calendar-cursor-to-date))
|
|
(point (point))
|
|
(date (calendar-gregorian-from-absolute
|
|
(get-text-property point 'day)))
|
|
(displayed-day (extract-calendar-day date))
|
|
(displayed-month (extract-calendar-month date))
|
|
(displayed-year (extract-calendar-year date)))
|
|
(unwind-protect
|
|
(progn
|
|
(fset 'calendar-cursor-to-date
|
|
(lambda (&optional error)
|
|
(calendar-gregorian-from-absolute
|
|
(get-text-property point 'day))))
|
|
(call-interactively cmd))
|
|
(fset 'calendar-cursor-to-date oldf))))
|
|
|
|
(defun org-agenda-phases-of-moon ()
|
|
"Display the phases of the moon for the 3 months around the cursor date."
|
|
(interactive)
|
|
(org-agenda-execute-calendar-command 'calendar-phases-of-moon))
|
|
|
|
(defun org-agenda-holidays ()
|
|
"Display the holidays for the 3 months around the cursor date."
|
|
(interactive)
|
|
(org-agenda-execute-calendar-command 'list-calendar-holidays))
|
|
|
|
(defun org-agenda-sunrise-sunset (arg)
|
|
"Display sunrise and sunset for the cursor date.
|
|
Latitude and longitude can be specified with the variables
|
|
`calendar-latitude' and `calendar-longitude'. When called with prefix
|
|
argument, latitude and longitude will be prompted for."
|
|
(interactive "P")
|
|
(let ((calendar-longitude (if arg nil calendar-longitude))
|
|
(calendar-latitude (if arg nil calendar-latitude))
|
|
(calendar-location-name
|
|
(if arg "the given coordinates" calendar-location-name)))
|
|
(org-agenda-execute-calendar-command 'calendar-sunrise-sunset)))
|
|
|
|
(defun org-agenda-goto-calendar ()
|
|
"Open the Emacs calendar with the date at the cursor."
|
|
(interactive)
|
|
(org-agenda-check-type t 'agenda 'timeline)
|
|
(let* ((day (or (get-text-property (point) 'day)
|
|
(error "Don't know which date to open in calendar")))
|
|
(date (calendar-gregorian-from-absolute day))
|
|
(calendar-move-hook nil)
|
|
(view-calendar-holidays-initially nil)
|
|
(view-diary-entries-initially nil))
|
|
(calendar)
|
|
(calendar-goto-date date)))
|
|
|
|
(defun org-calendar-goto-agenda ()
|
|
"Compute the Org-mode agenda for the calendar date displayed at the cursor.
|
|
This is a command that has to be installed in `calendar-mode-map'."
|
|
(interactive)
|
|
(org-agenda-list nil (calendar-absolute-from-gregorian
|
|
(calendar-cursor-to-date))
|
|
nil t))
|
|
|
|
(defun org-agenda-convert-date ()
|
|
(interactive)
|
|
(org-agenda-check-type t 'agenda 'timeline)
|
|
(let ((day (get-text-property (point) 'day))
|
|
date s)
|
|
(unless day
|
|
(error "Don't know which date to convert"))
|
|
(setq date (calendar-gregorian-from-absolute day))
|
|
(setq s (concat
|
|
"Gregorian: " (calendar-date-string date) "\n"
|
|
"ISO: " (calendar-iso-date-string date) "\n"
|
|
"Day of Yr: " (calendar-day-of-year-string date) "\n"
|
|
"Julian: " (calendar-julian-date-string date) "\n"
|
|
"Astron. JD: " (calendar-astro-date-string date)
|
|
" (Julian date number at noon UTC)\n"
|
|
"Hebrew: " (calendar-hebrew-date-string date) " (until sunset)\n"
|
|
"Islamic: " (calendar-islamic-date-string date) " (until sunset)\n"
|
|
"French: " (calendar-french-date-string date) "\n"
|
|
"Mayan: " (calendar-mayan-date-string date) "\n"
|
|
"Coptic: " (calendar-coptic-date-string date) "\n"
|
|
"Ethiopic: " (calendar-ethiopic-date-string date) "\n"
|
|
"Persian: " (calendar-persian-date-string date) "\n"
|
|
"Chinese: " (calendar-chinese-date-string date) "\n"))
|
|
(with-output-to-temp-buffer "*Dates*"
|
|
(princ s))
|
|
(if (fboundp 'fit-window-to-buffer)
|
|
(fit-window-to-buffer (get-buffer-window "*Dates*")))))
|
|
|
|
;;; Tags
|
|
|
|
(defun org-scan-tags (action matcher &optional todo-only)
|
|
"Scan headline tags with inheritance and produce output ACTION.
|
|
ACTION can be `sparse-tree' or `agenda'. MATCHER is a Lisp form to be
|
|
evaluated, testing if a given set of tags qualifies a headline for
|
|
inclusion. When TODO-ONLY is non-nil, only lines with a TODO keyword
|
|
are included in the output."
|
|
(let* ((re (concat "[\n\r]" outline-regexp " *\\(\\<\\("
|
|
(mapconcat 'regexp-quote
|
|
(nreverse (cdr (reverse org-todo-keywords)))
|
|
"\\|")
|
|
"\\>\\)\\)? *\\(.*?\\)\\(:[A-Za-z_@0-9:]+:\\)?[ \t]*[\n\r]"))
|
|
(props (list 'face nil
|
|
'done-face 'org-done
|
|
'undone-face nil
|
|
'mouse-face 'highlight
|
|
'keymap org-agenda-keymap
|
|
'help-echo
|
|
(format "mouse-2 or RET jump to org file %s"
|
|
(abbreviate-file-name buffer-file-name))))
|
|
lspos
|
|
tags tags-list tags-alist (llast 0) rtn level category i txt
|
|
todo marker)
|
|
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(when (eq action 'sparse-tree) (org-overview))
|
|
(while (re-search-forward re nil t)
|
|
(setq todo (if (match-end 1) (match-string 2))
|
|
tags (if (match-end 4) (match-string 4)))
|
|
(goto-char (setq lspos (1+ (match-beginning 0))))
|
|
(setq level (funcall outline-level)
|
|
category (org-get-category))
|
|
(setq i llast llast level)
|
|
;; remove tag lists from same and sublevels
|
|
(while (>= i level)
|
|
(when (setq entry (assoc i tags-alist))
|
|
(setq tags-alist (delete entry tags-alist)))
|
|
(setq i (1- i)))
|
|
;; add the nex tags
|
|
(when tags
|
|
(setq tags (mapcar 'downcase (org-split-string tags ":"))
|
|
tags-alist
|
|
(cons (cons level tags) tags-alist)))
|
|
;; compile tags for current headline
|
|
(setq tags-list
|
|
(if org-use-tag-inheritance
|
|
(apply 'append (mapcar 'cdr tags-alist))
|
|
tags))
|
|
(when (and (or (not todo-only) todo)
|
|
(eval matcher))
|
|
;; list this headline
|
|
(if (eq action 'sparse-tree)
|
|
(progn
|
|
(org-show-hierarchy-above))
|
|
(setq txt (org-format-agenda-item
|
|
""
|
|
(concat
|
|
(if org-tags-match-list-sublevels
|
|
(make-string (1- level) ?.) "")
|
|
(org-get-heading))
|
|
category tags-list))
|
|
(goto-char lspos)
|
|
(setq marker (org-agenda-new-marker))
|
|
(org-add-props txt props
|
|
'org-marker marker 'org-hd-marker marker 'category category)
|
|
(push txt rtn))
|
|
;; if we are to skip sublevels, jump to end of subtree
|
|
(point)
|
|
(or org-tags-match-list-sublevels (org-end-of-subtree)))))
|
|
(nreverse rtn)))
|
|
|
|
(defun org-tags-sparse-tree (&optional arg match)
|
|
"Create a sparse tree according to tags search string MATCH.
|
|
MATCH can contain positive and negative selection of tags, like
|
|
\"+WORK+URGENT-WITHBOSS\"."
|
|
(interactive "P")
|
|
(let ((org-show-following-heading nil)
|
|
(org-show-hierarchy-above nil))
|
|
(org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)))))
|
|
|
|
(defun org-make-tags-matcher (match)
|
|
"Create the TAGS matcher form for the tags-selecting string MATCH."
|
|
(unless match
|
|
;; Get a new match request, with completion
|
|
(setq org-last-tags-completion-table
|
|
(or (org-get-buffer-tags)
|
|
org-last-tags-completion-table))
|
|
(setq match (completing-read
|
|
"Tags: " 'org-tags-completion-function nil nil nil
|
|
'org-tags-history)))
|
|
;; parse the string and create a lisp form
|
|
(let ((match0 match) minus tag mm matcher orterms term orlist)
|
|
(setq orterms (org-split-string match "|"))
|
|
(while (setq term (pop orterms))
|
|
(while (string-match "^&?\\([-+:]\\)?\\([A-Za-z_@0-9]+\\)" term)
|
|
(setq minus (and (match-end 1)
|
|
(equal (match-string 1 term) "-"))
|
|
tag (match-string 2 term)
|
|
term (substring term (match-end 0))
|
|
mm (list 'member (downcase tag) 'tags-list)
|
|
mm (if minus (list 'not mm) mm))
|
|
(push mm matcher))
|
|
(push (if (> (length matcher) 1) (cons 'and matcher) (car matcher))
|
|
orlist)
|
|
(setq matcher nil))
|
|
(setq matcher (if (> (length orlist) 1) (cons 'or orlist) (car orlist)))
|
|
;; Return the string and lisp forms of the matcher
|
|
(cons match0 matcher)))
|
|
|
|
;;;###autoload
|
|
(defun org-tags-view (&optional todo-only match keep-modes)
|
|
"Show all headlines for all `org-agenda-files' matching a TAGS criterion.
|
|
The prefix arg TODO-ONLY limits the search to TODO entries."
|
|
(interactive "P")
|
|
(org-agenda-maybe-reset-markers 'force)
|
|
(org-compile-prefix-format org-agenda-prefix-format)
|
|
(let* ((org-agenda-keep-modes keep-modes)
|
|
(org-tags-match-list-sublevels
|
|
(if todo-only t org-tags-match-list-sublevels))
|
|
(win (selected-window))
|
|
(completion-ignore-case t)
|
|
rtn rtnall files file pos matcher
|
|
buffer)
|
|
(setq matcher (org-make-tags-matcher match)
|
|
match (car matcher) matcher (cdr matcher))
|
|
(if (not (equal (current-buffer) (get-buffer org-agenda-buffer-name)))
|
|
(progn
|
|
(delete-other-windows)
|
|
(switch-to-buffer-other-window
|
|
(get-buffer-create org-agenda-buffer-name))))
|
|
(setq buffer-read-only nil)
|
|
(erase-buffer)
|
|
(org-agenda-mode) (setq buffer-read-only nil)
|
|
(set (make-local-variable 'org-agenda-type) 'tags)
|
|
(set (make-local-variable 'org-agenda-redo-command)
|
|
(list 'org-tags-view (list 'quote todo-only)
|
|
(list 'if 'current-prefix-arg nil match) t))
|
|
(setq files (org-agenda-files)
|
|
rtnall nil)
|
|
(while (setq file (pop files))
|
|
(catch 'nextfile
|
|
(org-check-agenda-file file)
|
|
(setq buffer (if (file-exists-p file)
|
|
(org-get-agenda-file-buffer file)
|
|
(error "No such file %s" file)))
|
|
(if (not buffer)
|
|
;; If file does not exist, merror message to agenda
|
|
(setq rtn (list
|
|
(format "ORG-AGENDA-ERROR: No such org-file %s" file))
|
|
rtnall (append rtnall rtn))
|
|
(with-current-buffer buffer
|
|
(unless (eq major-mode 'org-mode)
|
|
(error "Agenda file %s is not in `org-mode'" file))
|
|
(save-excursion
|
|
(save-restriction
|
|
(if org-respect-restriction
|
|
(if (org-region-active-p)
|
|
;; Respect a region to restrict search
|
|
(narrow-to-region (region-beginning) (region-end)))
|
|
;; If we work for the calendar or many files,
|
|
;; get rid of any restriction
|
|
(widen))
|
|
(setq rtn (org-scan-tags 'agenda matcher todo-only))
|
|
(setq rtnall (append rtnall rtn))))))))
|
|
(insert "Headlines with TAGS match: ")
|
|
(add-text-properties (point-min) (1- (point))
|
|
(list 'face 'org-level-3))
|
|
(setq pos (point))
|
|
(insert match "\n")
|
|
(add-text-properties pos (1- (point)) (list 'face 'org-warning))
|
|
(setq pos (point))
|
|
(insert "Press `C-u r' to search again with new search string\n")
|
|
(add-text-properties pos (1- (point)) (list 'face 'org-level-3))
|
|
(when rtnall
|
|
(insert (mapconcat 'identity rtnall "\n")))
|
|
(goto-char (point-min))
|
|
(setq buffer-read-only t)
|
|
(org-fit-agenda-window)
|
|
(if (not org-select-agenda-window) (select-window win))))
|
|
|
|
(defvar org-add-colon-after-tag-completion nil) ;; dynamically skoped param
|
|
(defun org-set-tags (&optional arg just-align)
|
|
"Set the tags for the current headline.
|
|
With prefix ARG, realign all tags in headings in the current buffer."
|
|
(interactive)
|
|
(let* (;(inherit (org-get-inherited-tags))
|
|
(re (concat "^" outline-regexp))
|
|
(col (current-column))
|
|
(current (org-get-tags))
|
|
tags hd empty invis)
|
|
(if arg
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(while (re-search-forward re nil t)
|
|
(org-set-tags nil t))
|
|
(message "All tags realigned to column %d" org-tags-column))
|
|
(if just-align
|
|
(setq tags current)
|
|
(setq org-last-tags-completion-table
|
|
(or (org-get-buffer-tags)
|
|
org-last-tags-completion-table))
|
|
(setq tags
|
|
(let ((org-add-colon-after-tag-completion t))
|
|
(completing-read "Tags: " 'org-tags-completion-function
|
|
nil nil current 'org-tags-history)))
|
|
(while (string-match "[-+&]+" tags)
|
|
(setq tags (replace-match ":" t t tags))))
|
|
;; FIXME: still optimize this by not checking when JUST-ALIGN?
|
|
(unless (setq empty (string-match "\\`[\t ]*\\'" tags))
|
|
(unless (string-match ":$" tags) (setq tags (concat tags ":")))
|
|
(unless (string-match "^:" tags) (setq tags (concat ":" tags))))
|
|
(if (equal current "")
|
|
(progn
|
|
(end-of-line 1)
|
|
(or empty (insert-before-markers " ")))
|
|
(beginning-of-line 1)
|
|
(setq invis (org-invisible-p))
|
|
(looking-at (concat "\\(.*\\)\\(" (regexp-quote current) "\\)[ \t]*"))
|
|
(setq hd (match-string 1))
|
|
(delete-region (match-beginning 0) (match-end 0))
|
|
(insert-before-markers (org-trim hd) (if empty "" " ")))
|
|
(unless (equal tags "")
|
|
(move-to-column (max (current-column)
|
|
(if (> org-tags-column 0)
|
|
org-tags-column
|
|
(- (- org-tags-column) (length tags))))
|
|
t)
|
|
(insert-before-markers tags)
|
|
(if (and (not invis) (org-invisible-p))
|
|
(outline-flag-region (point-at-bol) (point) nil)))
|
|
(move-to-column col))))
|
|
|
|
(defun org-tags-completion-function (string predicate &optional flag)
|
|
(let (s1 s2 rtn (ctable org-last-tags-completion-table))
|
|
(if (string-match "^\\(.*[-+:&|]\\)\\([^-+:&|]*\\)$" string)
|
|
(setq s1 (match-string 1 string)
|
|
s2 (match-string 2 string))
|
|
(setq s1 "" s2 string))
|
|
(cond
|
|
((eq flag nil)
|
|
;; try completion
|
|
(setq rtn (try-completion s2 ctable))
|
|
(if (stringp rtn)
|
|
(concat s1 s2 (substring rtn (length s2))
|
|
(if (and org-add-colon-after-tag-completion
|
|
(assoc rtn ctable))
|
|
":" "")))
|
|
)
|
|
((eq flag t)
|
|
;; all-completions
|
|
(all-completions s2 ctable)
|
|
)
|
|
((eq flag 'lambda)
|
|
;; exact match?
|
|
(assoc s2 ctable)))
|
|
))
|
|
|
|
(defun org-get-tags ()
|
|
"Get the TAGS string in the current headline."
|
|
(unless (org-on-heading-p)
|
|
(error "Not on a heading"))
|
|
(save-excursion
|
|
(beginning-of-line 1)
|
|
(if (looking-at ".*[ \t]\\(:[A-Za-z_@0-9:]+:\\)[ \t]*\\(\r\\|$\\)")
|
|
(org-match-string-no-properties 1)
|
|
"")))
|
|
|
|
(defun org-get-buffer-tags ()
|
|
"Get a table of all tags used in the buffer, for completion."
|
|
(let (tags)
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(while (re-search-forward "[ \t]:\\([A-Za-z_@0-9:]+\\):[ \t\r\n]" nil t)
|
|
(mapc (lambda (x) (add-to-list 'tags x))
|
|
(org-split-string (org-match-string-no-properties 1) ":"))))
|
|
(mapcar 'list tags)))
|
|
|
|
;;; Link Stuff
|
|
|
|
(defvar org-create-file-search-functions nil
|
|
"List of functions to construct the right search string for a file link.
|
|
These functions are called in turn with point at the location to
|
|
which the link should point.
|
|
|
|
A function in the hook should first test if it would like to
|
|
handle this file type, for example by checking the major-mode or
|
|
the file extension. If it decides not to handle this file, it
|
|
should just return nil to give other functions a chance. If it
|
|
does handle the file, it must return the search string to be used
|
|
when following the link. The search string will be part of the
|
|
file link, given after a double colon, and `org-open-at-point'
|
|
will automatically search for it. If special measures must be
|
|
taken to make the search successful, another function should be
|
|
added to the companion hook `org-execute-file-search-functions',
|
|
which see.
|
|
|
|
A function in this hook may also use `setq' to set the variable
|
|
`description' to provide a suggestion for the descriptive text to
|
|
be used for this link when it gets inserted into an Org-mode
|
|
buffer with \\[org-insert-link].")
|
|
|
|
(defvar org-execute-file-search-functions nil
|
|
"List of functions to execute a file search triggered by a link.
|
|
|
|
Functions added to this hook must accept a single argument, the
|
|
search string that was part of the file link, the part after the
|
|
double colon. The function must first check if it would like to
|
|
handle this search, for example by checking the major-mode or the
|
|
file extension. If it decides not to handle this search, it
|
|
should just return nil to give other functions a chance. If it
|
|
does handle the search, it must return a non-nil value to keep
|
|
other functions from trying.
|
|
|
|
Each function can access the current prefix argument through the
|
|
variable `current-prefix-argument'. Note that a single prefix is
|
|
used to force opening a link in Emacs, so it may be good to only
|
|
use a numeric or double prefix to guide the search function.
|
|
|
|
In case this is needed, a function in this hook can also restore
|
|
the window configuration before `org-open-at-point' was called using:
|
|
|
|
(set-window-configuration org-window-config-before-follow-link)")
|
|
|
|
(defun org-find-file-at-mouse (ev)
|
|
"Open file link or URL at mouse."
|
|
(interactive "e")
|
|
(mouse-set-point ev)
|
|
(org-open-at-point 'in-emacs))
|
|
|
|
(defun org-open-at-mouse (ev)
|
|
"Open file link or URL at mouse."
|
|
(interactive "e")
|
|
(mouse-set-point ev)
|
|
(org-open-at-point))
|
|
|
|
(defvar org-window-config-before-follow-link nil
|
|
"The window configuration before following a link.
|
|
This is saved in case the need arises to restore it.")
|
|
|
|
(defun org-open-at-point (&optional in-emacs)
|
|
"Open link at or after point.
|
|
If there is no link at point, this function will search forward up to
|
|
the end of the current subtree.
|
|
Normally, files will be opened by an appropriate application. If the
|
|
optional argument IN-EMACS is non-nil, Emacs will visit the file."
|
|
(interactive "P")
|
|
(setq org-window-config-before-follow-link (current-window-configuration))
|
|
(org-remove-occur-highlights nil nil t)
|
|
(if (org-at-timestamp-p)
|
|
(org-agenda-list nil (time-to-days (org-time-string-to-time
|
|
(substring (match-string 1) 0 10)))
|
|
1)
|
|
(let (type path link line search (pos (point)))
|
|
(catch 'match
|
|
(save-excursion
|
|
(skip-chars-forward "^]\n\r")
|
|
(when (and (re-search-backward "\\[\\[" nil t)
|
|
(looking-at org-bracket-link-regexp)
|
|
(<= (match-beginning 0) pos)
|
|
(>= (match-end 0) pos))
|
|
(setq link (org-link-unescape (org-match-string-no-properties 1)))
|
|
(while (string-match " *\n *" link)
|
|
(setq link (replace-match " " t t link)))
|
|
(if (string-match org-link-re-with-space2 link)
|
|
(setq type (match-string 1 link)
|
|
path (match-string 2 link))
|
|
(setq type "thisfile"
|
|
path link))
|
|
(throw 'match t)))
|
|
|
|
(when (get-text-property (point) 'org-linked-text)
|
|
(setq type "thisfile"
|
|
pos (if (get-text-property (1+ (point)) 'org-linked-text)
|
|
(1+ (point)) (point))
|
|
path (buffer-substring
|
|
(previous-single-property-change pos 'org-linked-text)
|
|
(next-single-property-change pos 'org-linked-text)))
|
|
(throw 'match t))
|
|
|
|
(save-excursion
|
|
(skip-chars-backward (concat "^[]" org-non-link-chars " "))
|
|
(if (equal (char-before) ?<) (backward-char 1))
|
|
(when (or (looking-at org-angle-link-re)
|
|
(looking-at org-plain-link-re)
|
|
(and (or (re-search-forward org-angle-link-re (point-at-eol) t)
|
|
(re-search-forward org-plain-link-re (point-at-eol) t))
|
|
(<= (match-beginning 0) pos)
|
|
(>= (match-end 0) pos)))
|
|
(setq type (match-string 1)
|
|
path (match-string 2))
|
|
(throw 'match t)))
|
|
(save-excursion
|
|
(skip-chars-backward "^ \t\n\r")
|
|
(when (looking-at "\\(:[A-Za-z_@0-9:]+\\):[ \t\r\n]")
|
|
(setq type "tags"
|
|
path (match-string 1))
|
|
(while (string-match ":" path)
|
|
(setq path (replace-match "+" t t path)))
|
|
(throw 'match t)))
|
|
(save-excursion
|
|
(skip-chars-backward "a-zA-Z_")
|
|
(when (and (memq 'camel org-activate-links)
|
|
(looking-at org-camel-regexp))
|
|
(setq type "camel" path (match-string 0))
|
|
(if (equal (char-before) ?*)
|
|
(setq path (concat "*" path))))
|
|
(throw 'match t)))
|
|
(unless path
|
|
(error "No link found"))
|
|
;; Remove any trailing spaces in path
|
|
(if (string-match " +\\'" path)
|
|
(setq path (replace-match "" t t path)))
|
|
|
|
(cond
|
|
|
|
((member type '("http" "https" "ftp" "mailto" "news"))
|
|
(browse-url (concat type ":" path)))
|
|
|
|
((string= type "tags")
|
|
(org-tags-view in-emacs path))
|
|
((or (string= type "camel")
|
|
(string= type "thisfile"))
|
|
(org-mark-ring-push)
|
|
(org-link-search
|
|
path
|
|
(cond ((equal in-emacs '(4)) 'occur)
|
|
((equal in-emacs '(16)) 'org-occur)
|
|
(t nil))))
|
|
|
|
((string= type "file")
|
|
(if (string-match "::?\\([0-9]+\\)\\'" path) ;; second : optional
|
|
;; FIXME: It is unsafe to allow a single colon.
|
|
(setq line (string-to-number (match-string 1 path))
|
|
path (substring path 0 (match-beginning 0)))
|
|
(if (string-match "::\\(.+\\)\\'" path)
|
|
(setq search (match-string 1 path)
|
|
path (substring path 0 (match-beginning 0)))))
|
|
(org-open-file path in-emacs line search))
|
|
|
|
((string= type "news")
|
|
(org-follow-gnus-link path))
|
|
|
|
((string= type "bbdb")
|
|
(org-follow-bbdb-link path))
|
|
|
|
((string= type "gnus")
|
|
(let (group article)
|
|
(if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
|
|
(error "Error in Gnus link"))
|
|
(setq group (match-string 1 path)
|
|
article (match-string 3 path))
|
|
(org-follow-gnus-link group article)))
|
|
|
|
((string= type "vm")
|
|
(let (folder article)
|
|
(if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
|
|
(error "Error in VM link"))
|
|
(setq folder (match-string 1 path)
|
|
article (match-string 3 path))
|
|
;; in-emacs is the prefix arg, will be interpreted as read-only
|
|
(org-follow-vm-link folder article in-emacs)))
|
|
|
|
((string= type "wl")
|
|
(let (folder article)
|
|
(if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
|
|
(error "Error in Wanderlust link"))
|
|
(setq folder (match-string 1 path)
|
|
article (match-string 3 path))
|
|
(org-follow-wl-link folder article)))
|
|
|
|
((string= type "mhe")
|
|
(let (folder article)
|
|
(if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
|
|
(error "Error in MHE link"))
|
|
(setq folder (match-string 1 path)
|
|
article (match-string 3 path))
|
|
(org-follow-mhe-link folder article)))
|
|
|
|
((string= type "rmail")
|
|
(let (folder article)
|
|
(if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
|
|
(error "Error in RMAIL link"))
|
|
(setq folder (match-string 1 path)
|
|
article (match-string 3 path))
|
|
(org-follow-rmail-link folder article)))
|
|
|
|
((string= type "shell")
|
|
(let ((cmd path))
|
|
(while (string-match "@{" cmd)
|
|
(setq cmd (replace-match "<" t t cmd)))
|
|
(while (string-match "@}" cmd)
|
|
(setq cmd (replace-match ">" t t cmd)))
|
|
(if (or (not org-confirm-shell-links)
|
|
(funcall org-confirm-shell-links
|
|
(format "Execute \"%s\" in shell? "
|
|
(org-add-props cmd nil
|
|
'face 'org-warning))))
|
|
(progn
|
|
(message "Executing %s" cmd)
|
|
(shell-command cmd))
|
|
(error "Abort"))))
|
|
|
|
(t
|
|
(browse-url-at-point))))))
|
|
|
|
(defun org-link-search (s &optional type)
|
|
"Search for a link search option.
|
|
When S is a CamelCaseWord, search for a target, or for a sentence containing
|
|
the words. If S is surrounded by forward slashes, it is interpreted as a
|
|
regular expression. In org-mode files, this will create an `org-occur'
|
|
sparse tree. In ordinary files, `occur' will be used to list matches.
|
|
If the current buffer is in `dired-mode', grep will be used to search
|
|
in all files."
|
|
(let ((case-fold-search t)
|
|
(s0 (mapconcat 'identity (org-split-string s "[ \t\r\n]+") " "))
|
|
(pos (point))
|
|
(pre "") (post "")
|
|
words re0 re1 re2 re3 re4 re5 re2a reall camel)
|
|
(cond
|
|
;; First check if there are any special
|
|
((run-hook-with-args-until-success 'org-execute-file-search-functions s))
|
|
;; Now try the builtin stuff
|
|
((save-excursion
|
|
(goto-char (point-min))
|
|
(and
|
|
(re-search-forward
|
|
(concat "<<" (regexp-quote s0) ">>") nil t)
|
|
(setq pos (match-beginning 0))))
|
|
;; There is an exact target for this
|
|
(goto-char pos))
|
|
((string-match "^/\\(.*\\)/$" s)
|
|
;; A regular expression
|
|
(cond
|
|
((eq major-mode 'org-mode)
|
|
(org-occur (match-string 1 s)))
|
|
;;((eq major-mode 'dired-mode)
|
|
;; (grep (concat "grep -n -e '" (match-string 1 s) "' *")))
|
|
(t (org-do-occur (match-string 1 s)))))
|
|
((or (setq camel (string-match (concat "^" org-camel-regexp "$") s))
|
|
t)
|
|
;; A camel or a normal search string
|
|
(when (equal (string-to-char s) ?*)
|
|
;; Anchor on headlines, post may include tags.
|
|
(setq pre "^\\*+[ \t]*\\(?:\\sw+\\)?[ \t]*"
|
|
post "[ \t]*\\(?:[ \t]+:[a-zA-Z_@0-9:+]:[ \t]*\\)?$"
|
|
s (substring s 1)))
|
|
(remove-text-properties
|
|
0 (length s)
|
|
'(face nil mouse-face nil keymap nil fontified nil) s)
|
|
;; Make a series of regular expressions to find a match
|
|
(setq words
|
|
(if camel
|
|
(org-camel-to-words s)
|
|
(org-split-string s "[ \n\r\t]+"))
|
|
re0 (concat "\\(<<" (regexp-quote s0) ">>\\)")
|
|
;; FIXME: The word delimiters in the following are not quite correct.
|
|
; re2 (concat "\\<" (mapconcat 'downcase words "[ \t]+") "\\>")
|
|
; re2a (concat "\\<" (mapconcat 'downcase words "[ \t\r\n]+") "\\>")
|
|
; re4 (concat "\\<" (mapconcat 'downcase words "[^a-zA-Z_\r\n]+") "\\>")
|
|
re2 (concat "[ \t\r\n]\\(" (mapconcat 'downcase words "[ \t]+") "\\)[ \t\r\n]")
|
|
re2a (concat "[ \t\r\n]\\(" (mapconcat 'downcase words "[ \t\r\n]+") "\\)[ \t\r\n]")
|
|
re4 (concat "[^a-zA-Z_]\\(" (mapconcat 'downcase words "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]")
|
|
re1 (concat pre re2 post)
|
|
re3 (concat pre re4 post)
|
|
re5 (concat pre ".*" re4)
|
|
re2 (concat pre re2)
|
|
re2a (concat pre re2a)
|
|
re4 (concat pre re4)
|
|
reall (concat "\\(" re0 "\\)\\|\\(" re1 "\\)\\|\\(" re2
|
|
"\\)\\|\\(" re3 "\\)\\|\\(" re4 "\\)\\|\\("
|
|
re5 "\\)"
|
|
))
|
|
(cond
|
|
((eq type 'org-occur) (org-occur reall))
|
|
((eq type 'occur) (org-do-occur (downcase reall) 'cleanup))
|
|
(t (goto-char (point-min))
|
|
(if (or (org-search-not-link re0 nil t)
|
|
(org-search-not-link re1 nil t)
|
|
(org-search-not-link re2 nil t)
|
|
(org-search-not-link re2a nil t)
|
|
(org-search-not-link re3 nil t)
|
|
(org-search-not-link re4 nil t)
|
|
(org-search-not-link re5 nil t)
|
|
)
|
|
(goto-char (match-beginning 1)) ;; Fixme: does every re have group 1?
|
|
(goto-char pos)
|
|
(error "No match")))))
|
|
(t
|
|
;; Normal string-search
|
|
(goto-char (point-min))
|
|
(if (search-forward s nil t)
|
|
(goto-char (match-beginning 0))
|
|
(error "No match"))))
|
|
(and (eq major-mode 'org-mode) (org-show-hierarchy-above))))
|
|
|
|
(defun org-search-not-link (&rest args)
|
|
"Execute `re-search-forward', but only accept matches that are not a link."
|
|
(catch 'exit
|
|
(let ((pos (point)) p1)
|
|
(while (apply 're-search-forward args)
|
|
(setq p1 (point))
|
|
(if (not (save-match-data
|
|
(and (re-search-backward "\\[\\[" nil t)
|
|
(looking-at org-bracket-link-regexp)
|
|
(<= (match-beginning 0) p1)
|
|
(>= (match-end 0) p1))))
|
|
(progn (goto-char (match-end 0))
|
|
(throw 'exit (point)))
|
|
(goto-char (match-end 0)))))))
|
|
|
|
(defun org-do-occur (regexp &optional cleanup)
|
|
"Call the Emacs command `occur'.
|
|
If CLEANUP is non-nil, remove the printout of the regular expression
|
|
in the *Occur* buffer. This is useful if the regex is long and not useful
|
|
to read."
|
|
(occur regexp)
|
|
(when cleanup
|
|
(let ((cwin (selected-window)) win beg end)
|
|
(when (setq win (get-buffer-window "*Occur*"))
|
|
(select-window win))
|
|
(goto-char (point-min))
|
|
(when (re-search-forward "match[a-z]+" nil t)
|
|
(setq beg (match-end 0))
|
|
(if (re-search-forward "^[ \t]*[0-9]+" nil t)
|
|
(setq end (1- (match-beginning 0)))))
|
|
(and beg end (let ((buffer-read-only)) (delete-region beg end)))
|
|
(goto-char (point-min))
|
|
(select-window cwin))))
|
|
|
|
(defvar org-mark-ring nil
|
|
"Mark ring for positions before jumps in Org-mode.")
|
|
(defvar org-mark-ring-last-goto nil
|
|
"Last position in the mark ring used to go back.")
|
|
;; Fill and close the ring
|
|
(setq org-mark-ring nil org-mark-ring-last-goto nil) ;; in case file is reloaded
|
|
(loop for i from 1 to org-mark-ring-length do
|
|
(push (make-marker) org-mark-ring))
|
|
(setcdr (nthcdr (1- org-mark-ring-length) org-mark-ring)
|
|
org-mark-ring)
|
|
|
|
(defun org-mark-ring-push (&optional pos buffer)
|
|
"Put the current position or POS into the mark ring and rotate it."
|
|
(interactive)
|
|
(setq pos (or pos (point)))
|
|
(setq org-mark-ring (nthcdr (1- org-mark-ring-length) org-mark-ring))
|
|
(move-marker (car org-mark-ring)
|
|
(or pos (point))
|
|
(or buffer (current-buffer)))
|
|
(message
|
|
(substitute-command-keys
|
|
"Position saved to mark ring, go back with \\[org-mark-ring-goto].")))
|
|
|
|
(defun org-mark-ring-goto (&optional n)
|
|
"Jump to the previous position in the mark ring.
|
|
With prefix arg N, jump back that many stored positions. When
|
|
called several times in succession, walk through the entire ring.
|
|
Org-mode commands jumping to a different position in the current file,
|
|
or to another Org-mode file, automatically push the old position
|
|
onto the ring."
|
|
(interactive "p")
|
|
(let (p m)
|
|
(if (eq last-command this-command)
|
|
(setq p (nthcdr n (or org-mark-ring-last-goto org-mark-ring)))
|
|
(setq p org-mark-ring))
|
|
(setq org-mark-ring-last-goto p)
|
|
(setq m (car p))
|
|
(switch-to-buffer (marker-buffer m))
|
|
(goto-char m)
|
|
(if (or (org-invisible-p) (org-invisible-p2)) (org-show-hierarchy-above))))
|
|
|
|
(defun org-camel-to-words (s)
|
|
"Split \"CamelCaseWords\" to (\"Camel\" \"Case\" \"Words\")."
|
|
(let ((case-fold-search nil)
|
|
words)
|
|
(while (string-match "[a-z][A-Z]" s)
|
|
(push (substring s 0 (1+ (match-beginning 0))) words)
|
|
(setq s (substring s (1+ (match-beginning 0)))))
|
|
(nreverse (cons s words))))
|
|
|
|
(defun org-remove-angle-brackets (s)
|
|
(if (equal (substring s 0 1) "<") (setq s (substring s 1)))
|
|
(if (equal (substring s -1) ">") (setq s (substring s 0 -1)))
|
|
s)
|
|
(defun org-add-angle-brackets (s)
|
|
(if (equal (substring s 0 1) "<") nil (setq s (concat "<" s)))
|
|
(if (equal (substring s -1) ">") nil (setq s (concat s ">")))
|
|
s)
|
|
|
|
(defun org-follow-bbdb-link (name)
|
|
"Follow a BBDB link to NAME."
|
|
(require 'bbdb)
|
|
(let ((inhibit-redisplay t)
|
|
(bbdb-electric-p nil))
|
|
(catch 'exit
|
|
;; Exact match on name
|
|
(bbdb-name (concat "\\`" name "\\'") nil)
|
|
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
|
|
;; Exact match on name
|
|
(bbdb-company (concat "\\`" name "\\'") nil)
|
|
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
|
|
;; Partial match on name
|
|
(bbdb-name name nil)
|
|
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
|
|
;; Partial match on company
|
|
(bbdb-company name nil)
|
|
(if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
|
|
;; General match including network address and notes
|
|
(bbdb name nil)
|
|
(when (= 0 (buffer-size (get-buffer "*BBDB*")))
|
|
(delete-window (get-buffer-window "*BBDB*"))
|
|
(error "No matching BBDB record")))))
|
|
|
|
(defun org-follow-gnus-link (&optional group article)
|
|
"Follow a Gnus link to GROUP and ARTICLE."
|
|
(require 'gnus)
|
|
(funcall (cdr (assq 'gnus org-link-frame-setup)))
|
|
(if group (gnus-fetch-group group))
|
|
(if article
|
|
(or (gnus-summary-goto-article article nil 'force)
|
|
(if (fboundp 'gnus-summary-insert-cached-articles)
|
|
(progn
|
|
(gnus-summary-insert-cached-articles)
|
|
(gnus-summary-goto-article article nil 'force))
|
|
(message "Message could not be found.")))))
|
|
|
|
(defun org-follow-vm-link (&optional folder article readonly)
|
|
"Follow a VM link to FOLDER and ARTICLE."
|
|
(require 'vm)
|
|
(setq article (org-add-angle-brackets article))
|
|
(if (string-match "^//\\([a-zA-Z]+@\\)?\\([^:]+\\):\\(.*\\)" folder)
|
|
;; ange-ftp or efs or tramp access
|
|
(let ((user (or (match-string 1 folder) (user-login-name)))
|
|
(host (match-string 2 folder))
|
|
(file (match-string 3 folder)))
|
|
(cond
|
|
((featurep 'tramp)
|
|
;; use tramp to access the file
|
|
(if (featurep 'xemacs)
|
|
(setq folder (format "[%s@%s]%s" user host file))
|
|
(setq folder (format "/%s@%s:%s" user host file))))
|
|
(t
|
|
;; use ange-ftp or efs
|
|
(require (if (featurep 'xemacs) 'efs 'ange-ftp))
|
|
(setq folder (format "/%s@%s:%s" user host file))))))
|
|
(when folder
|
|
(funcall (cdr (assq 'vm org-link-frame-setup)) folder readonly)
|
|
(sit-for 0.1)
|
|
(when article
|
|
(vm-select-folder-buffer)
|
|
(widen)
|
|
(let ((case-fold-search t))
|
|
(goto-char (point-min))
|
|
(if (not (re-search-forward
|
|
(concat "^" "message-id: *" (regexp-quote article))))
|
|
(error "Could not find the specified message in this folder"))
|
|
(vm-isearch-update)
|
|
(vm-isearch-narrow)
|
|
(vm-beginning-of-message)
|
|
(vm-summarize)))))
|
|
|
|
(defun org-follow-wl-link (folder article)
|
|
"Follow a Wanderlust link to FOLDER and ARTICLE."
|
|
(setq article (org-add-angle-brackets article))
|
|
(wl-summary-goto-folder-subr folder 'no-sync t nil t)
|
|
(if article (wl-summary-jump-to-msg-by-message-id article ">"))
|
|
(wl-summary-redisplay))
|
|
|
|
(defun org-follow-rmail-link (folder article)
|
|
"Follow an RMAIL link to FOLDER and ARTICLE."
|
|
(setq article (org-add-angle-brackets article))
|
|
(let (message-number)
|
|
(save-excursion
|
|
(save-window-excursion
|
|
(rmail (if (string= folder "RMAIL") rmail-file-name folder))
|
|
(setq message-number
|
|
(save-restriction
|
|
(widen)
|
|
(goto-char (point-max))
|
|
(if (re-search-backward
|
|
(concat "^Message-ID:\\s-+" (regexp-quote
|
|
(or article "")))
|
|
nil t)
|
|
(rmail-what-message))))))
|
|
(if message-number
|
|
(progn
|
|
(rmail (if (string= folder "RMAIL") rmail-file-name folder))
|
|
(rmail-show-message message-number)
|
|
message-number)
|
|
(error "Message not found"))))
|
|
|
|
;; mh-e integration based on planner-mode
|
|
(defun org-mhe-get-message-real-folder ()
|
|
"Return the name of the current message real folder, so if you use
|
|
sequences, it will now work."
|
|
(save-excursion
|
|
(let* ((folder
|
|
(if (equal major-mode 'mh-folder-mode)
|
|
mh-current-folder
|
|
;; Refer to the show buffer
|
|
mh-show-folder-buffer))
|
|
(end-index
|
|
(if (boundp 'mh-index-folder)
|
|
(min (length mh-index-folder) (length folder))))
|
|
)
|
|
;; a simple test on mh-index-data does not work, because
|
|
;; mh-index-data is always nil in a show buffer.
|
|
(if (and (boundp 'mh-index-folder)
|
|
(string= mh-index-folder (substring folder 0 end-index)))
|
|
(if (equal major-mode 'mh-show-mode)
|
|
(save-window-excursion
|
|
(when (buffer-live-p (get-buffer folder))
|
|
(progn
|
|
(pop-to-buffer folder)
|
|
(org-mhe-get-message-folder-from-index)
|
|
)
|
|
))
|
|
(org-mhe-get-message-folder-from-index)
|
|
)
|
|
folder
|
|
)
|
|
)))
|
|
|
|
(defun org-mhe-get-message-folder-from-index ()
|
|
"Returns the name of the message folder in a index folder buffer."
|
|
(save-excursion
|
|
(mh-index-previous-folder)
|
|
(re-search-forward "^\\(+.*\\)$" nil t)
|
|
(message (match-string 1))))
|
|
|
|
(defun org-mhe-get-message-folder ()
|
|
"Return the name of the current message folder. Be careful if you
|
|
use sequences."
|
|
(save-excursion
|
|
(if (equal major-mode 'mh-folder-mode)
|
|
mh-current-folder
|
|
;; Refer to the show buffer
|
|
mh-show-folder-buffer)))
|
|
|
|
(defun org-mhe-get-message-num ()
|
|
"Return the number of the current message. Be careful if you
|
|
use sequences."
|
|
(save-excursion
|
|
(if (equal major-mode 'mh-folder-mode)
|
|
(mh-get-msg-num nil)
|
|
;; Refer to the show buffer
|
|
(mh-show-buffer-message-number))))
|
|
|
|
(defun org-mhe-get-header (header)
|
|
"Return a header of the message in folder mode. This will create a
|
|
show buffer for the corresponding message. If you have a more clever
|
|
idea..."
|
|
(let* ((folder (org-mhe-get-message-folder))
|
|
(num (org-mhe-get-message-num))
|
|
(buffer (get-buffer-create (concat "show-" folder)))
|
|
(header-field))
|
|
(with-current-buffer buffer
|
|
(mh-display-msg num folder)
|
|
(if (equal major-mode 'mh-folder-mode)
|
|
(mh-header-display)
|
|
(mh-show-header-display))
|
|
(set-buffer buffer)
|
|
(setq header-field (mh-get-header-field header))
|
|
(if (equal major-mode 'mh-folder-mode)
|
|
(mh-show)
|
|
(mh-show-show))
|
|
header-field)))
|
|
|
|
(defun org-follow-mhe-link (folder article)
|
|
"Follow an MHE link to FOLDER and ARTICLE.
|
|
If ARTICLE is nil FOLDER is shown. If the configuration variable
|
|
`org-mhe-search-all-folders' is t and `mh-searcher' is pick,
|
|
ARTICLE is searched in all folders. Indexed searches (swish++,
|
|
namazu, and others supported by MH-E) will always search in all
|
|
folders."
|
|
(require 'mh-e)
|
|
(require 'mh-search)
|
|
(require 'mh-utils)
|
|
(mh-find-path)
|
|
(if (not article)
|
|
(mh-visit-folder (mh-normalize-folder-name folder))
|
|
(setq article (org-add-angle-brackets article))
|
|
(mh-search-choose)
|
|
(if (equal mh-searcher 'pick)
|
|
(progn
|
|
(mh-search folder (list "--message-id" article))
|
|
(when (and org-mhe-search-all-folders
|
|
(not (org-mhe-get-message-real-folder)))
|
|
(kill-this-buffer)
|
|
(mh-search "+" (list "--message-id" article))))
|
|
(mh-search "+" article))
|
|
(if (org-mhe-get-message-real-folder)
|
|
(mh-show-msg 1)
|
|
(kill-this-buffer)
|
|
(error "Message not found"))))
|
|
|
|
;; BibTeX links
|
|
|
|
;; Use the custom search meachnism to construct and use search strings for
|
|
;; file links to BibTeX database entries.
|
|
|
|
(defun org-create-file-search-in-bibtex ()
|
|
"Create the search string and description for a BibTeX database entry."
|
|
(when (eq major-mode 'bibtex-mode)
|
|
;; yes, we want to construct this search string.
|
|
;; Make a good description for this entry, using names, year and the title
|
|
;; Put it into the `description' variable which is dynamically scoped.
|
|
(let ((bibtex-autokey-names 1)
|
|
(bibtex-autokey-names-stretch 1)
|
|
(bibtex-autokey-name-case-convert-function 'identity)
|
|
(bibtex-autokey-name-separator " & ")
|
|
(bibtex-autokey-additional-names " et al.")
|
|
(bibtex-autokey-year-length 4)
|
|
(bibtex-autokey-name-year-separator " ")
|
|
(bibtex-autokey-titlewords 3)
|
|
(bibtex-autokey-titleword-separator " ")
|
|
(bibtex-autokey-titleword-case-convert-function 'identity)
|
|
(bibtex-autokey-titleword-length 'infty)
|
|
(bibtex-autokey-year-title-separator ": "))
|
|
(setq description (bibtex-generate-autokey)))
|
|
;; Now parse the entry, get the key and return it.
|
|
(save-excursion
|
|
(bibtex-beginning-of-entry)
|
|
(cdr (assoc "=key=" (bibtex-parse-entry))))))
|
|
|
|
(defun org-execute-file-search-in-bibtex (s)
|
|
"Find the link search string S as a key for a database entry."
|
|
(when (eq major-mode 'bibtex-mode)
|
|
;; Yes, we want to do the search in this file.
|
|
;; We construct a regexp that searches for "@entrytype{" followed by the key
|
|
(goto-char (point-min))
|
|
(and (re-search-forward (concat "@[a-zA-Z]+[ \t\n]*{[ \t\n]*"
|
|
(regexp-quote s) "[ \t\n]*,") nil t)
|
|
(goto-char (match-beginning 0)))
|
|
(if (and (match-beginning 0) (equal current-prefix-arg '(16)))
|
|
;; Use double prefix to indicate that any web link should be browsed
|
|
(let ((b (current-buffer)) (p (point)))
|
|
;; Restore the window configuration because we just use the web link
|
|
(set-window-configuration org-window-config-before-follow-link)
|
|
(save-excursion (set-buffer b) (goto-char p)
|
|
(bibtex-url)))
|
|
(recenter 0)) ; Move entry start to beginning of window
|
|
;; return t to indicate that the search is done.
|
|
t))
|
|
|
|
;; Finally add the functions to the right hooks.
|
|
(add-hook 'org-create-file-search-functions 'org-create-file-search-in-bibtex)
|
|
(add-hook 'org-execute-file-search-functions 'org-execute-file-search-in-bibtex)
|
|
|
|
;; end of Bibtex link setup
|
|
|
|
(defun org-upgrade-old-links (&optional query-description)
|
|
"Transfer old <...> style links to new [[...]] style links.
|
|
With arg query-description, ask at each match for a description text to use
|
|
for this link."
|
|
(interactive (list (y-or-n-p "Would you like to be queried for a description at each link?")))
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(let ((re (concat "\\([^[]\\)<\\("
|
|
"\\(" (mapconcat 'identity org-link-types "\\|")
|
|
"\\):"
|
|
"[^" org-non-link-chars "]+\\)>"))
|
|
l1 l2 (cnt 0))
|
|
(while (re-search-forward re nil t)
|
|
(setq cnt (1+ cnt)
|
|
l1 (org-match-string-no-properties 2)
|
|
l2 (save-match-data (org-link-escape l1)))
|
|
(when query-description (setq l1 (read-string "Desc: " l1)))
|
|
(if (equal l1 l2)
|
|
(replace-match (concat (match-string 1) "[[" l1 "]]") t t)
|
|
(replace-match (concat (match-string 1) "[[" l2 "][" l1 "]]") t t)))
|
|
(message "%d matches have beed treated" cnt))))
|
|
|
|
(defun org-open-file (path &optional in-emacs line search)
|
|
"Open the file at PATH.
|
|
First, this expands any special file name abbreviations. Then the
|
|
configuration variable `org-file-apps' is checked if it contains an
|
|
entry for this file type, and if yes, the corresponding command is launched.
|
|
If no application is found, Emacs simply visits the file.
|
|
With optional argument IN-EMACS, Emacs will visit the file.
|
|
Optional LINE specifies a line to go to, optional SEARCH a string to
|
|
search for. If LINE or SEARCH is given, the file will always be
|
|
opened in Emacs.
|
|
If the file does not exist, an error is thrown."
|
|
(setq in-emacs (or in-emacs line search))
|
|
(let* ((file (if (equal path "")
|
|
buffer-file-name
|
|
(convert-standard-filename (org-expand-file-name path))))
|
|
(dirp (file-directory-p file))
|
|
(dfile (downcase file))
|
|
(old-buffer (current-buffer))
|
|
(old-pos (point))
|
|
(old-mode major-mode)
|
|
ext cmd apps)
|
|
(if (and (not (file-exists-p file))
|
|
(not org-open-non-existing-files))
|
|
(error "No such file: %s" file))
|
|
(if (string-match "^.*\\.\\([a-zA-Z0-9]+\\.gz\\)$" dfile)
|
|
(setq ext (match-string 1 dfile))
|
|
(if (string-match "^.*\\.\\([a-zA-Z0-9]+\\)$" dfile)
|
|
(setq ext (match-string 1 dfile))))
|
|
(setq apps (append org-file-apps (org-default-apps)))
|
|
(if in-emacs
|
|
(setq cmd 'emacs)
|
|
(setq cmd (or (and dirp (cdr (assoc 'directory apps)))
|
|
(cdr (assoc ext apps))
|
|
(cdr (assoc t apps)))))
|
|
(when (eq cmd 'mailcap)
|
|
(require 'mailcap)
|
|
(mailcap-parse-mailcaps)
|
|
(let* ((mime-type (mailcap-extension-to-mime (or ext "")))
|
|
(command (mailcap-mime-info mime-type)))
|
|
(if (stringp command)
|
|
(setq cmd command)
|
|
(setq cmd 'emacs))))
|
|
(cond
|
|
((and (stringp cmd) (not (string-match "^\\s-*$" cmd)))
|
|
;; Normalize use of quote, this can vary.
|
|
(if (string-match "['\"]%s['\"]" cmd)
|
|
(setq cmd (replace-match "'%s'" t t cmd)))
|
|
(setq cmd (format cmd file))
|
|
(save-window-excursion
|
|
(shell-command (concat cmd " &"))))
|
|
((or (stringp cmd)
|
|
(eq cmd 'emacs))
|
|
(unless (equal (file-truename file) (file-truename (or buffer-file-name "")))
|
|
(funcall (cdr (assq 'file org-link-frame-setup)) file))
|
|
(if line (goto-line line)
|
|
(if search (org-link-search search))))
|
|
((consp cmd)
|
|
(eval cmd))
|
|
(t (funcall (cdr (assq 'file org-link-frame-setup)) file)))
|
|
(and (eq major-mode 'org-mode) (eq old-mode 'org-mode)
|
|
(or (not (equal old-buffer (current-buffer)))
|
|
(not (equal old-pos (point))))
|
|
(org-mark-ring-push old-pos old-buffer))))
|
|
|
|
(defun org-default-apps ()
|
|
"Return the default applications for this operating system."
|
|
(cond
|
|
((eq system-type 'darwin)
|
|
org-file-apps-defaults-macosx)
|
|
((eq system-type 'windows-nt)
|
|
org-file-apps-defaults-windowsnt)
|
|
(t org-file-apps-defaults-gnu)))
|
|
|
|
(defun org-expand-file-name (path)
|
|
"Replace special path abbreviations and expand the file name."
|
|
(expand-file-name path))
|
|
|
|
|
|
(defvar org-insert-link-history nil
|
|
"Minibuffer history for links inserted with `org-insert-link'.")
|
|
|
|
(defvar org-stored-links nil
|
|
"Contains the links stored with `org-store-link'.")
|
|
|
|
;;;###autoload
|
|
(defun org-store-link (arg)
|
|
"\\<org-mode-map>Store an org-link to the current location.
|
|
This link can later be inserted into an org-buffer with
|
|
\\[org-insert-link].
|
|
For some link types, a prefix arg is interpreted:
|
|
For links to usenet articles, arg negates `org-usenet-links-prefer-google'.
|
|
For file links, arg negates `org-context-in-file-links'."
|
|
(interactive "P")
|
|
(let (link cpltxt desc description search txt (pos (point)))
|
|
(cond
|
|
|
|
((eq major-mode 'bbdb-mode)
|
|
(setq cpltxt (concat
|
|
"bbdb:"
|
|
(or (bbdb-record-name (bbdb-current-record))
|
|
(bbdb-record-company (bbdb-current-record))))
|
|
link (org-make-link cpltxt)))
|
|
|
|
((eq major-mode 'calendar-mode)
|
|
(let ((cd (calendar-cursor-to-date)))
|
|
(setq link
|
|
(format-time-string
|
|
(car org-time-stamp-formats)
|
|
(apply 'encode-time
|
|
(list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd)
|
|
nil nil nil))))))
|
|
|
|
((or (eq major-mode 'vm-summary-mode)
|
|
(eq major-mode 'vm-presentation-mode))
|
|
(and (eq major-mode 'vm-presentation-mode) (vm-summarize))
|
|
(vm-follow-summary-cursor)
|
|
(save-excursion
|
|
(vm-select-folder-buffer)
|
|
(let* ((message (car vm-message-pointer))
|
|
(folder buffer-file-name)
|
|
(subject (vm-su-subject message))
|
|
(author (vm-su-full-name message))
|
|
(message-id (vm-su-message-id message)))
|
|
(setq message-id (org-remove-angle-brackets message-id))
|
|
(setq folder (abbreviate-file-name folder))
|
|
(if (string-match (concat "^" (regexp-quote vm-folder-directory))
|
|
folder)
|
|
(setq folder (replace-match "" t t folder)))
|
|
(setq cpltxt (concat author " on: " subject))
|
|
(setq link (org-make-link "vm:" folder "#" message-id)))))
|
|
|
|
((eq major-mode 'wl-summary-mode)
|
|
(let* ((msgnum (wl-summary-message-number))
|
|
(message-id (elmo-message-field wl-summary-buffer-elmo-folder
|
|
msgnum 'message-id))
|
|
(wl-message-entity (elmo-msgdb-overview-get-entity
|
|
msgnum (wl-summary-buffer-msgdb)))
|
|
(author (wl-summary-line-from)) ; FIXME: correct?
|
|
(subject "???")) ; FIXME:
|
|
(setq message-id (org-remove-angle-brackets message-id))
|
|
(setq cpltxt (concat author " on: " subject))
|
|
(setq link (org-make-link "wl:" wl-summary-buffer-folder-name
|
|
"#" message-id))))
|
|
|
|
((or (equal major-mode 'mh-folder-mode)
|
|
(equal major-mode 'mh-show-mode))
|
|
(let ((from-header (org-mhe-get-header "From:"))
|
|
(to-header (org-mhe-get-header "To:"))
|
|
(subject (org-mhe-get-header "Subject:")))
|
|
(setq cpltxt (concat from-header " on: " subject))
|
|
(setq link (org-make-link "mhe:" (org-mhe-get-message-real-folder) "#"
|
|
(org-remove-angle-brackets
|
|
(org-mhe-get-header "Message-Id:"))))))
|
|
|
|
((eq major-mode 'rmail-mode)
|
|
(save-excursion
|
|
(save-restriction
|
|
(rmail-narrow-to-non-pruned-header)
|
|
(let ((folder buffer-file-name)
|
|
(message-id (mail-fetch-field "message-id"))
|
|
(author (mail-fetch-field "from"))
|
|
(subject (mail-fetch-field "subject")))
|
|
(setq message-id (org-remove-angle-brackets message-id))
|
|
(setq cpltxt (concat author " on: " subject))
|
|
(setq link (org-make-link "rmail:" folder "#" message-id))))))
|
|
|
|
((eq major-mode 'gnus-group-mode)
|
|
(let ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus
|
|
(gnus-group-group-name)) ; version
|
|
((fboundp 'gnus-group-name)
|
|
(gnus-group-name))
|
|
(t "???"))))
|
|
(setq cpltxt (concat
|
|
(if (org-xor arg org-usenet-links-prefer-google)
|
|
"http://groups.google.com/groups?group="
|
|
"gnus:")
|
|
group)
|
|
link (org-make-link cpltxt))))
|
|
|
|
((memq major-mode '(gnus-summary-mode gnus-article-mode))
|
|
(and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary))
|
|
(gnus-summary-beginning-of-article)
|
|
(let* ((group (car gnus-article-current))
|
|
(article (cdr gnus-article-current))
|
|
(header (gnus-summary-article-header article))
|
|
(author (mail-header-from header))
|
|
(message-id (mail-header-id header))
|
|
(date (mail-header-date header))
|
|
(subject (gnus-summary-subject-string)))
|
|
(setq cpltxt (concat author " on: " subject))
|
|
(if (org-xor arg org-usenet-links-prefer-google)
|
|
(setq link
|
|
(concat
|
|
cpltxt "\n "
|
|
(format "http://groups.google.com/groups?as_umsgid=%s"
|
|
(org-fixup-message-id-for-http message-id))))
|
|
(setq link (org-make-link "gnus:" group
|
|
"#" (number-to-string article))))))
|
|
|
|
((eq major-mode 'w3-mode)
|
|
(setq cpltxt (url-view-url t)
|
|
link (org-make-link cpltxt)))
|
|
((eq major-mode 'w3m-mode)
|
|
(setq cpltxt w3m-current-url
|
|
link (org-make-link cpltxt)))
|
|
|
|
((setq search (run-hook-with-args-until-success
|
|
'org-create-file-search-functions))
|
|
(setq link (concat "file:" (abbreviate-file-name buffer-file-name)
|
|
"::" search))
|
|
(setq cpltxt (or description link))) ;; FIXME: is this the best way?
|
|
|
|
((eq major-mode 'org-mode)
|
|
;; Just link to current headline
|
|
(setq cpltxt (concat "file:"
|
|
(abbreviate-file-name buffer-file-name)))
|
|
;; Add a context search string
|
|
(when (org-xor org-context-in-file-links arg)
|
|
;; Check if we are on a target
|
|
(if (save-excursion
|
|
(skip-chars-forward "^>\n\r")
|
|
(and (re-search-backward "<<" nil t)
|
|
(looking-at "<<\\(.*?\\)>>")
|
|
(<= (match-beginning 0) pos)
|
|
(>= (match-end 0) pos)))
|
|
(setq cpltxt (concat cpltxt "::" (match-string 1)))
|
|
(setq txt (cond
|
|
((org-on-heading-p) nil)
|
|
((org-region-active-p)
|
|
(buffer-substring (region-beginning) (region-end)))
|
|
(t (buffer-substring (point-at-bol) (point-at-eol)))))
|
|
(when (string-match "\\S-" txt)
|
|
(setq cpltxt
|
|
(concat cpltxt "::"
|
|
(if org-file-link-context-use-camel-case
|
|
(org-make-org-heading-camel txt)
|
|
(org-make-org-heading-search-string txt)))
|
|
desc "NONE"))))
|
|
(if (string-match "::\\'" cpltxt)
|
|
(setq cpltxt (substring cpltxt 0 -2)))
|
|
(setq link (org-make-link cpltxt)))
|
|
|
|
(buffer-file-name
|
|
;; Just link to this file here.
|
|
(setq cpltxt (concat "file:"
|
|
(abbreviate-file-name buffer-file-name)))
|
|
;; Add a context string
|
|
(when (org-xor org-context-in-file-links arg)
|
|
(setq txt (if (org-region-active-p)
|
|
(buffer-substring (region-beginning) (region-end))
|
|
(buffer-substring (point-at-bol) (point-at-eol))))
|
|
;; Only use search option if there is some text.
|
|
(when (string-match "\\S-" txt)
|
|
(setq cpltxt
|
|
(concat cpltxt "::"
|
|
(if org-file-link-context-use-camel-case
|
|
(org-make-org-heading-camel txt)
|
|
(org-make-org-heading-search-string txt)))
|
|
desc "NONE")))
|
|
(setq link (org-make-link cpltxt)))
|
|
|
|
((interactive-p)
|
|
(error "Cannot link to a buffer which is not visiting a file"))
|
|
|
|
(t (setq link nil)))
|
|
|
|
(if (consp link) (setq cpltxt (car link) link (cdr link)))
|
|
(setq link (or link cpltxt)
|
|
desc (or desc cpltxt))
|
|
(if (equal desc "NONE") (setq desc nil))
|
|
|
|
(if (and (interactive-p) link)
|
|
(progn
|
|
(setq org-stored-links
|
|
(cons (list cpltxt link desc) org-stored-links))
|
|
(message "Stored: %s" (or cpltxt link)))
|
|
(org-make-link-string link desc))))
|
|
|
|
(defun org-make-org-heading-search-string (&optional string heading)
|
|
"Make search string for STRING or current headline."
|
|
(interactive)
|
|
(let ((s (or string (org-get-heading))))
|
|
(unless (and string (not heading))
|
|
;; We are using a headline, clean up garbage in there.
|
|
(if (string-match org-todo-regexp s)
|
|
(setq s (replace-match "" t t s)))
|
|
(if (string-match ":[a-zA-Z_@0-9:]+:[ \t]*$" s)
|
|
(setq s (replace-match "" t t s)))
|
|
(setq s (org-trim s))
|
|
(if (string-match (concat "^\\(" org-quote-string "\\|"
|
|
org-comment-string "\\)") s)
|
|
(setq s (replace-match "" t t s)))
|
|
(while (string-match org-ts-regexp s)
|
|
(setq s (replace-match "" t t s))))
|
|
(while (string-match "[^a-zA-Z_0-9 \t]+" s)
|
|
(setq s (replace-match " " t t s)))
|
|
(or string (setq s (concat "*" s))) ; Add * for headlines
|
|
(mapconcat 'identity (org-split-string s "[ \t]+") " ")))
|
|
|
|
(defun org-make-org-heading-camel (&optional string heading)
|
|
"Make a CamelCase string for STRING or the current headline."
|
|
(interactive)
|
|
(let ((s (or string (org-get-heading))))
|
|
(unless (and string (not heading))
|
|
;; We are using a headline, clean up garbage in there.
|
|
(if (string-match org-todo-regexp s)
|
|
(setq s (replace-match "" t t s)))
|
|
(if (string-match ":[a-zA-Z_@0-9:]+:[ \t]*$" s)
|
|
(setq s (replace-match "" t t s)))
|
|
(setq s (org-trim s))
|
|
(if (string-match (concat "^\\(" org-quote-string "\\|"
|
|
org-comment-string "\\)") s)
|
|
(setq s (replace-match "" t t s)))
|
|
(while (string-match org-ts-regexp s)
|
|
(setq s (replace-match "" t t s))))
|
|
(while (string-match "[^a-zA-Z_ \t]+" s)
|
|
(setq s (replace-match " " t t s)))
|
|
(or string (setq s (concat "*" s))) ; Add * for headlines
|
|
(mapconcat 'capitalize (org-split-string s "[ \t]+") "")))
|
|
|
|
(defun org-make-link (&rest strings)
|
|
"Concatenate STRINGS, format resulting string with `org-link-format'."
|
|
(format org-link-format (apply 'concat strings)))
|
|
|
|
(defun org-make-link-string (link &optional description)
|
|
"Make a link with brackets, consisting of LINK and DESCRIPTION."
|
|
(if (eq org-link-style 'plain)
|
|
(if (equal description link)
|
|
link
|
|
(concat description "\n" link))
|
|
(when (stringp description)
|
|
;; Remove brackets from the description, they are fatal.
|
|
(while (string-match "\\[\\|\\]" description)
|
|
(setq description (replace-match "" t t description))))
|
|
(when (equal (org-link-escape link) description)
|
|
;; No description needed, it is identical
|
|
(setq description nil))
|
|
(when (and (not description)
|
|
(not (equal link (org-link-escape link))))
|
|
(setq description link))
|
|
(concat "[[" (org-link-escape link) "]"
|
|
(if description (concat "[" description "]") "")
|
|
"]")))
|
|
|
|
(defconst org-link-escape-chars '(("[" . "%5B") ("]" . "%5D") (" " . "%20"))
|
|
"Association list of escapes for some characters problematic in links.")
|
|
|
|
(defun org-link-escape (text)
|
|
"Escape charaters in TEXT that are problematic for links."
|
|
(when text
|
|
(let ((re (mapconcat (lambda (x) (regexp-quote (car x)))
|
|
org-link-escape-chars "\\|")))
|
|
(while (string-match re text)
|
|
(setq text
|
|
(replace-match
|
|
(cdr (assoc (match-string 0 text) org-link-escape-chars))
|
|
t t text)))
|
|
text)))
|
|
|
|
(defun org-link-unescape (text)
|
|
"Reverse the action of `org-link-escape'."
|
|
(when text
|
|
(let ((re (mapconcat (lambda (x) (regexp-quote (cdr x)))
|
|
org-link-escape-chars "\\|")))
|
|
(while (string-match re text)
|
|
(setq text
|
|
(replace-match
|
|
(car (rassoc (match-string 0 text) org-link-escape-chars))
|
|
t t text)))
|
|
text)))
|
|
|
|
(defun org-xor (a b)
|
|
"Exclusive or."
|
|
(if a (not b) b))
|
|
|
|
(defun org-get-header (header)
|
|
"Find a header field in the current buffer."
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(let ((case-fold-search t) s)
|
|
(cond
|
|
((eq header 'from)
|
|
(if (re-search-forward "^From:\\s-+\\(.*\\)" nil t)
|
|
(setq s (match-string 1)))
|
|
(while (string-match "\"" s)
|
|
(setq s (replace-match "" t t s)))
|
|
(if (string-match "[<(].*" s)
|
|
(setq s (replace-match "" t t s))))
|
|
((eq header 'message-id)
|
|
(if (re-search-forward "^message-id:\\s-+\\(.*\\)" nil t)
|
|
(setq s (match-string 1))))
|
|
((eq header 'subject)
|
|
(if (re-search-forward "^subject:\\s-+\\(.*\\)" nil t)
|
|
(setq s (match-string 1)))))
|
|
(if (string-match "\\`[ \t\]+" s) (setq s (replace-match "" t t s)))
|
|
(if (string-match "[ \t\]+\\'" s) (setq s (replace-match "" t t s)))
|
|
s)))
|
|
|
|
|
|
(defun org-fixup-message-id-for-http (s)
|
|
"Replace special characters in a message id, so it can be used in an http query."
|
|
(while (string-match "<" s)
|
|
(setq s (replace-match "%3C" t t s)))
|
|
(while (string-match ">" s)
|
|
(setq s (replace-match "%3E" t t s)))
|
|
(while (string-match "@" s)
|
|
(setq s (replace-match "%40" t t s)))
|
|
s)
|
|
|
|
(defun org-insert-link (&optional complete-file)
|
|
"Insert a link. At the prompt, enter the link.
|
|
|
|
Completion can be used to select a link previously stored with
|
|
`org-store-link'. When the empty string is entered (i.e. if you just
|
|
press RET at the prompt), the link defaults to the most recently
|
|
stored link. As SPC triggers completion in the minibuffer, you need to
|
|
use M-SPC or C-q SPC to force the insertion of a space character.
|
|
|
|
You will also be prompted for a description, and if one is given, it will
|
|
be displayed in the buffer instead of the link.
|
|
|
|
If there is already a link at point, this command will allow you to edit link
|
|
and description parts.
|
|
|
|
With a \\[universal-argument] prefix, prompts for a file to link to. The file name can be
|
|
selected using completion. The path to the file will be relative to
|
|
the current directory if the file is in the current directory or a
|
|
subdirectory. Otherwise, the link will be the absolute path as
|
|
completed in the minibuffer (i.e. normally ~/path/to/file).
|
|
|
|
With two \\[universal-argument] prefixes, enforce an absolute path even if the file
|
|
is in the current directory or below."
|
|
(interactive "P")
|
|
(let (link desc entry remove file (pos (point)))
|
|
(cond
|
|
((save-excursion
|
|
(skip-chars-forward "^]\n\r")
|
|
(and (re-search-backward "\\[\\[" nil t)
|
|
(looking-at org-bracket-link-regexp)
|
|
(<= (match-beginning 0) pos)
|
|
(>= (match-end 0) pos)))
|
|
;; We do have a link at point, and we are going to edit it.
|
|
(setq remove (list (match-beginning 0) (match-end 0)))
|
|
(setq desc (if (match-end 3) (org-match-string-no-properties 3)))
|
|
(setq link (read-string "Link: "
|
|
(org-link-unescape
|
|
(org-match-string-no-properties 1)))))
|
|
(complete-file
|
|
;; Completing read for file names.
|
|
(setq file (read-file-name "File: "))
|
|
(let ((pwd (file-name-as-directory (expand-file-name ".")))
|
|
(pwd1 (file-name-as-directory (abbreviate-file-name
|
|
(expand-file-name ".")))))
|
|
(cond
|
|
((equal complete-file '(16))
|
|
(setq link (org-make-link
|
|
"file:"
|
|
(abbreviate-file-name (expand-file-name file)))))
|
|
((string-match (concat "^" (regexp-quote pwd1) "\\(.+\\)") file)
|
|
(setq link (org-make-link "file:" (match-string 1 file))))
|
|
((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)")
|
|
(expand-file-name file))
|
|
(setq link (org-make-link
|
|
"file:" (match-string 1 (expand-file-name file)))))
|
|
(t (setq link (org-make-link "file:" file))))))
|
|
(t
|
|
;; Read link, with completion for stored links.
|
|
(setq link (org-completing-read
|
|
"Link: " org-stored-links nil nil nil
|
|
org-insert-link-history
|
|
(or (car (car org-stored-links)))))
|
|
(setq entry (assoc link org-stored-links))
|
|
(if (not org-keep-stored-link-after-insertion)
|
|
(setq org-stored-links (delq (assoc link org-stored-links)
|
|
org-stored-links)))
|
|
(setq link (if entry (nth 1 entry) link)
|
|
desc (or desc (nth 2 entry)))))
|
|
|
|
(if (string-match org-plain-link-re link)
|
|
;; URL-like link, normalize the use of angular brackets.
|
|
(setq link (org-make-link (org-remove-angle-brackets link))))
|
|
|
|
;; Check if we are linking to the current file with a search option
|
|
;; If yes, simplify the link by using only the search option.
|
|
(when (string-match "\\<file:\\(.+?\\)::\\([^>]+\\)" link)
|
|
(let* ((path (match-string 1 link))
|
|
(case-fold-search nil)
|
|
(search (match-string 2 link)))
|
|
(save-match-data
|
|
(if (equal (file-truename buffer-file-name) (file-truename path))
|
|
;; We are linking to this same file, with a search option
|
|
(setq link search)))))
|
|
|
|
;; Check if we can/should use a relative path. If yes, simplify the link
|
|
(when (string-match "\\<file:\\(.*\\)" link)
|
|
(let* ((path (match-string 1 link))
|
|
(case-fold-search nil))
|
|
(cond
|
|
((eq org-link-file-path-type 'absolute)
|
|
(setq path (abbreviate-file-name (expand-file-name path))))
|
|
((eq org-link-file-path-type 'noabbrev)
|
|
(setq path (expand-file-name path)))
|
|
((eq org-link-file-path-type 'relative)
|
|
(setq path (file-relative-name path)))
|
|
(t
|
|
(save-match-data
|
|
(if (string-match (concat "^" (regexp-quote
|
|
(file-name-as-directory
|
|
(expand-file-name "."))))
|
|
(expand-file-name path))
|
|
;; We are linking a file with relative path name.
|
|
(setq path (substring (expand-file-name path)
|
|
(match-end 0)))))))
|
|
(setq link (concat "file:" path))))
|
|
|
|
(setq desc (read-string "Description: " desc))
|
|
(unless (string-match "\\S-" desc) (setq desc nil))
|
|
(if remove (apply 'delete-region remove))
|
|
(insert (org-make-link-string link desc))))
|
|
|
|
(defun org-completing-read (&rest args)
|
|
(let ((minibuffer-local-completion-map
|
|
(copy-keymap minibuffer-local-completion-map)))
|
|
(define-key minibuffer-local-completion-map " " 'self-insert-command)
|
|
(apply 'completing-read args)))
|
|
|
|
;;; Hooks for remember.el
|
|
|
|
(defvar org-finish-function nil)
|
|
|
|
;;;###autoload
|
|
(defun org-remember-annotation ()
|
|
"Return a link to the current location as an annotation for remember.el.
|
|
If you are using Org-mode files as target for data storage with
|
|
remember.el, then the annotations should include a link compatible with the
|
|
conventions in Org-mode. This function returns such a link."
|
|
(org-store-link nil))
|
|
|
|
(defconst org-remember-help
|
|
"Select a destination location for the note.
|
|
UP/DOWN=headline TAB=cycle visibility [Q]uit RET/<left>/<right>=Store
|
|
RET at beg-of-buf -> Append to file as level 2 headline
|
|
RET on headline -> Store as sublevel entry to current headline
|
|
<left>/<right> -> before/after current headline, same headings level")
|
|
|
|
;;;###autoload
|
|
(defun org-remember-apply-template ()
|
|
"Initialize *remember* buffer with template, invoke `org-mode'.
|
|
This function should be placed into `remember-mode-hook' and in fact requires
|
|
to be run from that hook to fucntion properly."
|
|
(if org-remember-templates
|
|
|
|
(let* ((entry (if (= (length org-remember-templates) 1)
|
|
(cdar org-remember-templates)
|
|
(message "Select template: %s"
|
|
(mapconcat
|
|
(lambda (x) (char-to-string (car x)))
|
|
org-remember-templates " "))
|
|
(cdr (assoc (read-char-exclusive) org-remember-templates))))
|
|
(tpl (car entry))
|
|
(file (if (consp (cdr entry)) (nth 1 entry)))
|
|
(v-t (format-time-string (car org-time-stamp-formats) (org-current-time)))
|
|
(v-T (format-time-string (cdr org-time-stamp-formats) (org-current-time)))
|
|
(v-u (concat "[" (substring v-t 1 -1) "]"))
|
|
(v-U (concat "[" (substring v-T 1 -1) "]"))
|
|
(v-a annotation) ; defined in `remember-mode'
|
|
(v-i initial) ; defined in `remember-mode'
|
|
(v-n user-full-name)
|
|
)
|
|
(unless tpl (setq tpl "") (message "No template") (ding))
|
|
(insert tpl) (goto-char (point-min))
|
|
(while (re-search-forward "%\\([tTuTai]\\)" nil t)
|
|
(when (and initial (equal (match-string 0) "%i"))
|
|
(save-match-data
|
|
(let* ((lead (buffer-substring
|
|
(point-at-bol) (match-beginning 0))))
|
|
(setq v-i (mapconcat 'identity
|
|
(org-split-string initial "\n")
|
|
(concat "\n" lead))))))
|
|
(replace-match
|
|
(or (eval (intern (concat "v-" (match-string 1)))) "")
|
|
t t))
|
|
(let ((org-startup-folded nil)
|
|
(org-startup-with-deadline-check nil))
|
|
(org-mode))
|
|
(if (and file (string-match "\\S-" file) (not (file-directory-p file)))
|
|
(set (make-local-variable 'org-default-notes-file) file))
|
|
(goto-char (point-min))
|
|
(if (re-search-forward "%\\?" nil t) (replace-match "")))
|
|
(let ((org-startup-folded nil)
|
|
(org-startup-with-deadline-check nil))
|
|
(org-mode)))
|
|
(set (make-local-variable 'org-finish-function) 'remember-buffer))
|
|
|
|
;;;###autoload
|
|
(defun org-remember-handler ()
|
|
"Store stuff from remember.el into an org file.
|
|
First prompts for an org file. If the user just presses return, the value
|
|
of `org-default-notes-file' is used.
|
|
Then the command offers the headings tree of the selected file in order to
|
|
file the text at a specific location.
|
|
You can either immediately press RET to get the note appended to the
|
|
file, or you can use vertical cursor motion and visibility cycling (TAB) to
|
|
find a better place. Then press RET or <left> or <right> in insert the note.
|
|
|
|
Key Cursor position Note gets inserted
|
|
-----------------------------------------------------------------------------
|
|
RET buffer-start as level 2 heading at end of file
|
|
RET on headline as sublevel of the heading at cursor
|
|
RET no heading at cursor position, level taken from context.
|
|
Or use prefix arg to specify level manually.
|
|
<left> on headline as same level, before current heading
|
|
<right> on headline as same level, after current heading
|
|
|
|
So the fastest way to store the note is to press RET RET to append it to
|
|
the default file. This way your current train of thought is not
|
|
interrupted, in accordance with the principles of remember.el. But with
|
|
little extra effort, you can push it directly to the correct location.
|
|
|
|
Before being stored away, the function ensures that the text has a
|
|
headline, i.e. a first line that starts with a \"*\". If not, a headline
|
|
is constructed from the current date and some additional data.
|
|
|
|
If the variable `org-adapt-indentation' is non-nil, the entire text is
|
|
also indented so that it starts in the same column as the headline
|
|
\(i.e. after the stars).
|
|
|
|
See also the variable `org-reverse-note-order'."
|
|
(catch 'quit
|
|
(let* ((txt (buffer-substring (point-min) (point-max)))
|
|
(fastp current-prefix-arg)
|
|
(file (if fastp org-default-notes-file (org-get-org-file)))
|
|
(visiting (find-buffer-visiting file))
|
|
(org-startup-with-deadline-check nil)
|
|
(org-startup-folded nil)
|
|
(org-startup-align-all-tables nil)
|
|
spos level indent reversed)
|
|
;; Modify text so that it becomes a nice subtree which can be inserted
|
|
;; into an org tree.
|
|
(let* ((lines (split-string txt "\n"))
|
|
first)
|
|
;; remove empty lines at the beginning
|
|
(while (and lines (string-match "^[ \t]*\n" (car lines)))
|
|
(setq lines (cdr lines)))
|
|
(setq first (car lines) lines (cdr lines))
|
|
(if (string-match "^\\*+" first)
|
|
;; Is already a headline
|
|
(setq indent nil)
|
|
;; We need to add a headline: Use time and first buffer line
|
|
(setq lines (cons first lines)
|
|
first (concat "* " (current-time-string)
|
|
" (" (remember-buffer-desc) ")")
|
|
indent " "))
|
|
(if (and org-adapt-indentation indent)
|
|
(setq lines (mapcar (lambda (x) (concat indent x)) lines)))
|
|
(setq txt (concat first "\n"
|
|
(mapconcat 'identity lines "\n"))))
|
|
;; Find the file
|
|
(if (not visiting)
|
|
(find-file-noselect file))
|
|
(with-current-buffer (get-file-buffer file)
|
|
(save-excursion (and (goto-char (point-min))
|
|
(not (re-search-forward "^\\* " nil t))
|
|
(insert "\n* Notes\n")))
|
|
(setq reversed (org-notes-order-reversed-p))
|
|
(save-excursion
|
|
(save-restriction
|
|
(widen)
|
|
;; Ask the User for a location
|
|
(setq spos (if fastp 1 (org-get-location
|
|
(current-buffer)
|
|
org-remember-help)))
|
|
(if (not spos) (throw 'quit nil)) ; return nil to show we did
|
|
; not handle this note
|
|
(goto-char spos)
|
|
(cond ((bobp)
|
|
;; Put it at the start or end, as level 2
|
|
(save-restriction
|
|
(widen)
|
|
(goto-char (if reversed (point-min) (point-max)))
|
|
(if (not (bolp)) (newline))
|
|
(org-paste-subtree 2 txt)))
|
|
((and (org-on-heading-p nil) (not current-prefix-arg))
|
|
;; Put it below this entry, at the beg/end of the subtree
|
|
(org-back-to-heading)
|
|
(setq level (funcall outline-level))
|
|
(if reversed
|
|
(outline-end-of-heading)
|
|
(outline-end-of-subtree))
|
|
(if (not (bolp)) (newline))
|
|
(beginning-of-line 1)
|
|
(org-paste-subtree (1+ level) txt))
|
|
(t
|
|
;; Put it right there, with automatic level determined by
|
|
;; org-paste-subtree or from prefix arg
|
|
(org-paste-subtree current-prefix-arg txt)))
|
|
(when remember-save-after-remembering
|
|
(save-buffer)
|
|
(if (not visiting) (kill-buffer (current-buffer)))))))))
|
|
t) ;; return t to indicate that we took care of this note.
|
|
|
|
(defun org-get-org-file ()
|
|
"Read a filename, with default directory `org-directory'."
|
|
(let ((default (or org-default-notes-file remember-data-file)))
|
|
(read-file-name (format "File name [%s]: " default)
|
|
(file-name-as-directory org-directory)
|
|
default)))
|
|
|
|
(defun org-notes-order-reversed-p ()
|
|
"Check if the current file should receive notes in reversed order."
|
|
(cond
|
|
((not org-reverse-note-order) nil)
|
|
((eq t org-reverse-note-order) t)
|
|
((not (listp org-reverse-note-order)) nil)
|
|
(t (catch 'exit
|
|
(let ((all org-reverse-note-order)
|
|
entry)
|
|
(while (setq entry (pop all))
|
|
(if (string-match (car entry) buffer-file-name)
|
|
(throw 'exit (cdr entry))))
|
|
nil)))))
|
|
|
|
;;; Tables
|
|
|
|
;; Watch out: Here we are talking about two different kind of tables.
|
|
;; Most of the code is for the tables created with the Org-mode table editor.
|
|
;; Sometimes, we talk about tables created and edited with the table.el
|
|
;; Emacs package. We call the former org-type tables, and the latter
|
|
;; table.el-type tables.
|
|
|
|
|
|
(defun org-before-change-function (beg end)
|
|
"Every change indicates that a table might need an update."
|
|
(setq org-table-may-need-update t))
|
|
|
|
(defconst org-table-line-regexp "^[ \t]*|"
|
|
"Detects an org-type table line.")
|
|
(defconst org-table-dataline-regexp "^[ \t]*|[^-]"
|
|
"Detects an org-type table line.")
|
|
(defconst org-table-auto-recalculate-regexp "^[ \t]*| *# *\\(|\\|$\\)"
|
|
"Detects a table line marked for automatic recalculation.")
|
|
(defconst org-table-recalculate-regexp "^[ \t]*| *[#*] *\\(|\\|$\\)"
|
|
"Detects a table line marked for automatic recalculation.")
|
|
(defconst org-table-calculate-mark-regexp "^[ \t]*| *[!$^_#*] *\\(|\\|$\\)"
|
|
"Detects a table line marked for automatic recalculation.")
|
|
(defconst org-table-hline-regexp "^[ \t]*|-"
|
|
"Detects an org-type table hline.")
|
|
(defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]"
|
|
"Detects a table-type table hline.")
|
|
(defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)"
|
|
"Detects an org-type or table-type table.")
|
|
(defconst org-table-border-regexp "^[ \t]*[^| \t]"
|
|
"Searching from within a table (any type) this finds the first line
|
|
outside the table.")
|
|
(defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]"
|
|
"Searching from within a table (any type) this finds the first line
|
|
outside the table.")
|
|
|
|
(defun org-table-create-with-table.el ()
|
|
"Use the table.el package to insert a new table.
|
|
If there is already a table at point, convert between Org-mode tables
|
|
and table.el tables."
|
|
(interactive)
|
|
(require 'table)
|
|
(cond
|
|
((org-at-table.el-p)
|
|
(if (y-or-n-p "Convert table to Org-mode table? ")
|
|
(org-table-convert)))
|
|
((org-at-table-p)
|
|
(if (y-or-n-p "Convert table to table.el table? ")
|
|
(org-table-convert)))
|
|
(t (call-interactively 'table-insert))))
|
|
|
|
(defun org-table-create-or-convert-from-region (arg)
|
|
"Convert region to table, or create an empty table.
|
|
If there is an active region, convert it to a table. If there is no such
|
|
region, create an empty table."
|
|
(interactive "P")
|
|
(if (org-region-active-p)
|
|
(org-table-convert-region (region-beginning) (region-end) arg)
|
|
(org-table-create arg)))
|
|
|
|
(defun org-table-create (&optional size)
|
|
"Query for a size and insert a table skeleton.
|
|
SIZE is a string Columns x Rows like for example \"3x2\"."
|
|
(interactive "P")
|
|
(unless size
|
|
(setq size (read-string
|
|
(concat "Table size Columns x Rows [e.g. "
|
|
org-table-default-size "]: ")
|
|
"" nil org-table-default-size)))
|
|
|
|
(let* ((pos (point))
|
|
(indent (make-string (current-column) ?\ ))
|
|
(split (org-split-string size " *x *"))
|
|
(rows (string-to-number (nth 1 split)))
|
|
(columns (string-to-number (car split)))
|
|
(line (concat (apply 'concat indent "|" (make-list columns " |"))
|
|
"\n")))
|
|
(if (string-match "^[ \t]*$" (buffer-substring-no-properties
|
|
(point-at-bol) (point)))
|
|
(beginning-of-line 1)
|
|
(newline))
|
|
;; (mapcar (lambda (x) (insert line)) (make-list rows t))
|
|
(dotimes (i rows) (insert line))
|
|
(goto-char pos)
|
|
(if (> rows 1)
|
|
;; Insert a hline after the first row.
|
|
(progn
|
|
(end-of-line 1)
|
|
(insert "\n|-")
|
|
(goto-char pos)))
|
|
(org-table-align)))
|
|
|
|
(defun org-table-convert-region (beg0 end0 &optional nspace)
|
|
"Convert region to a table.
|
|
The region goes from BEG0 to END0, but these borders will be moved
|
|
slightly, to make sure a beginning of line in the first line is included.
|
|
When NSPACE is non-nil, it indicates the minimum number of spaces that
|
|
separate columns (default: just one space)."
|
|
(interactive "rP")
|
|
(let* ((beg (min beg0 end0))
|
|
(end (max beg0 end0))
|
|
(tabsep t)
|
|
re)
|
|
(goto-char beg)
|
|
(beginning-of-line 1)
|
|
(setq beg (move-marker (make-marker) (point)))
|
|
(goto-char end)
|
|
(if (bolp) (backward-char 1) (end-of-line 1))
|
|
(setq end (move-marker (make-marker) (point)))
|
|
;; Lets see if this is tab-separated material. If every nonempty line
|
|
;; contains a tab, we will assume that it is tab-separated material
|
|
(if nspace
|
|
(setq tabsep nil)
|
|
(goto-char beg)
|
|
(and (re-search-forward "^[^\n\t]+$" end t) (setq tabsep nil)))
|
|
(if nspace (setq tabsep nil))
|
|
(if tabsep
|
|
(setq re "^\\|\t")
|
|
(setq re (format "^ *\\| *\t *\\| \\{%d,\\}"
|
|
(max 1 (prefix-numeric-value nspace)))))
|
|
(goto-char beg)
|
|
(while (re-search-forward re end t)
|
|
(replace-match "|" t t))
|
|
(goto-char beg)
|
|
(insert " ")
|
|
(org-table-align)))
|
|
|
|
(defun org-table-import (file arg)
|
|
"Import FILE as a table.
|
|
The file is assumed to be tab-separated. Such files can be produced by most
|
|
spreadsheet and database applications. If no tabs (at least one per line)
|
|
are found, lines will be split on whitespace into fields."
|
|
(interactive "f\nP")
|
|
(or (bolp) (newline))
|
|
(let ((beg (point))
|
|
(pm (point-max)))
|
|
(insert-file-contents file)
|
|
(org-table-convert-region beg (+ (point) (- (point-max) pm)) arg)))
|
|
|
|
(defun org-table-export ()
|
|
"Export table as a tab-separated file.
|
|
Such a file can be imported into a spreadsheet program like Excel."
|
|
(interactive)
|
|
(let* ((beg (org-table-begin))
|
|
(end (org-table-end))
|
|
(table (buffer-substring beg end))
|
|
(file (read-file-name "Export table to: "))
|
|
buf)
|
|
(unless (or (not (file-exists-p file))
|
|
(y-or-n-p (format "Overwrite file %s? " file)))
|
|
(error "Abort"))
|
|
(with-current-buffer (find-file-noselect file)
|
|
(setq buf (current-buffer))
|
|
(erase-buffer)
|
|
(fundamental-mode)
|
|
(insert table)
|
|
(goto-char (point-min))
|
|
(while (re-search-forward "^[ \t]*|[ \t]*" nil t)
|
|
(replace-match "" t t)
|
|
(end-of-line 1))
|
|
(goto-char (point-min))
|
|
(while (re-search-forward "[ \t]*|[ \t]*$" nil t)
|
|
(replace-match "" t t)
|
|
(goto-char (min (1+ (point)) (point-max))))
|
|
(goto-char (point-min))
|
|
(while (re-search-forward "^-[-+]*$" nil t)
|
|
(replace-match "")
|
|
(if (looking-at "\n")
|
|
(delete-char 1)))
|
|
(goto-char (point-min))
|
|
(while (re-search-forward "[ \t]*|[ \t]*" nil t)
|
|
(replace-match "\t" t t))
|
|
(save-buffer))
|
|
(kill-buffer buf)))
|
|
|
|
(defvar org-table-aligned-begin-marker (make-marker)
|
|
"Marker at the beginning of the table last aligned.
|
|
Used to check if cursor still is in that table, to minimize realignment.")
|
|
(defvar org-table-aligned-end-marker (make-marker)
|
|
"Marker at the end of the table last aligned.
|
|
Used to check if cursor still is in that table, to minimize realignment.")
|
|
(defvar org-table-last-alignment nil
|
|
"List of flags for flushright alignment, from the last re-alignment.
|
|
This is being used to correctly align a single field after TAB or RET.")
|
|
(defvar org-table-last-column-widths nil
|
|
"List of max width of fields in each column.
|
|
This is being used to correctly align a single field after TAB or RET.")
|
|
|
|
(defvar org-last-recalc-line nil)
|
|
(defconst org-narrow-column-arrow "=>"
|
|
"Used as display property in narrowed table columns.")
|
|
|
|
(defun org-table-align ()
|
|
"Align the table at point by aligning all vertical bars."
|
|
(interactive)
|
|
(let* (
|
|
;; Limits of table
|
|
(beg (org-table-begin))
|
|
(end (org-table-end))
|
|
;; Current cursor position
|
|
(linepos (+ (if (bolp) 1 0) (count-lines (point-min) (point))))
|
|
(colpos (org-table-current-column))
|
|
(winstart (window-start))
|
|
text lines (new "") lengths l typenums ty fields maxfields i
|
|
column
|
|
(indent "") cnt frac
|
|
rfmt hfmt
|
|
(spaces '(1 . 1))
|
|
(sp1 (car spaces))
|
|
(sp2 (cdr spaces))
|
|
(rfmt1 (concat
|
|
(make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|"))
|
|
(hfmt1 (concat
|
|
(make-string sp2 ?-) "%s" (make-string sp1 ?-) "+"))
|
|
emptystrings xx links narrow fmax fmin f1 len c e)
|
|
(untabify beg end)
|
|
(remove-text-properties beg end '(org-cwidth t display t))
|
|
;; Check if we have links
|
|
(goto-char beg)
|
|
(setq links (re-search-forward org-bracket-link-regexp end t))
|
|
;; Make sure the link properties are right FIXME: Can this be optimized????
|
|
(when links (goto-char beg) (while (org-activate-bracket-links end)))
|
|
;; Check if we are narrowing any columns
|
|
(goto-char beg)
|
|
(setq narrow (and org-format-transports-properties-p
|
|
(re-search-forward "<[0-9]+>" end t)))
|
|
;; Get the rows
|
|
(setq lines (org-split-string
|
|
(buffer-substring beg end) "\n"))
|
|
;; Store the indentation of the first line
|
|
(if (string-match "^ *" (car lines))
|
|
(setq indent (make-string (- (match-end 0) (match-beginning 0)) ?\ )))
|
|
;; Mark the hlines by setting the corresponding element to nil
|
|
;; At the same time, we remove trailing space.
|
|
(setq lines (mapcar (lambda (l)
|
|
(if (string-match "^ *|-" l)
|
|
nil
|
|
(if (string-match "[ \t]+$" l)
|
|
(substring l 0 (match-beginning 0))
|
|
l)))
|
|
lines))
|
|
;; Get the data fields by splitting the lines.
|
|
(setq fields (mapcar
|
|
(lambda (l)
|
|
(org-split-string l " *| *"))
|
|
(delq nil (copy-sequence lines))))
|
|
;; How many fields in the longest line?
|
|
(condition-case nil
|
|
(setq maxfields (apply 'max (mapcar 'length fields)))
|
|
(error
|
|
(kill-region beg end)
|
|
(org-table-create org-table-default-size)
|
|
(error "Empty table - created default table")))
|
|
;; A list of empty string to fill any short rows on output
|
|
(setq emptystrings (make-list maxfields ""))
|
|
;; Check for special formatting.
|
|
(setq i -1)
|
|
(while (< (setq i (1+ i)) maxfields) ;; Loop over all columns
|
|
(setq column (mapcar (lambda (x) (or (nth i x) "")) fields))
|
|
;; Check if there is an explicit width specified
|
|
(when (and org-table-limit-column-width narrow)
|
|
(setq c column fmax nil)
|
|
(while c
|
|
(setq e (pop c))
|
|
(if (and (stringp e) (string-match "^<\\([0-9]+\\)>$" e))
|
|
(setq fmax (string-to-number (match-string 1 e)) c nil)))
|
|
;; Find fields that are wider than fmax, and shorten them
|
|
(when fmax
|
|
(loop for xx in column do
|
|
(when (and (stringp xx)
|
|
(> (org-string-width xx) fmax))
|
|
(org-add-props xx nil
|
|
'help-echo
|
|
(concat "Clipped table field, use C-c ` to edit. Full value is:\n" (org-no-properties (copy-sequence xx))))
|
|
(setq f1 (min fmax (or (string-match org-bracket-link-regexp xx) fmax)))
|
|
(unless (> f1 1)
|
|
(error "Cannot narrow field starting with wide link \"%s\""
|
|
(match-string 0 xx)))
|
|
(add-text-properties f1 (length xx) (list 'org-cwidth t) xx)
|
|
(add-text-properties (- f1 2) f1
|
|
(list 'display org-narrow-column-arrow)
|
|
xx)))))
|
|
;; Get the maximum width for each column
|
|
(push (apply 'max 1 (mapcar 'org-string-width column)) lengths)
|
|
;; Get the fraction of numbers, to decide about alignment of the column
|
|
(setq cnt 0 frac 0.0)
|
|
(loop for x in column do
|
|
(if (equal x "")
|
|
nil
|
|
(setq frac ( / (+ (* frac cnt)
|
|
(if (string-match org-table-number-regexp x) 1 0))
|
|
(setq cnt (1+ cnt))))))
|
|
(push (>= frac org-table-number-fraction) typenums))
|
|
(setq lengths (nreverse lengths) typenums (nreverse typenums))
|
|
|
|
;; Store the alignment of this table, for later editing of single fields
|
|
(setq org-table-last-alignment typenums
|
|
org-table-last-column-widths lengths)
|
|
|
|
;; With invisible characters, `format' does not get the field width right
|
|
;; So we need to make these fields wide by hand.
|
|
(when links
|
|
(loop for i from 0 upto (1- maxfields) do
|
|
(setq len (nth i lengths))
|
|
(loop for j from 0 upto (1- (length fields)) do
|
|
(setq c (nthcdr i (car (nthcdr j fields))))
|
|
(if (and (stringp (car c))
|
|
(string-match org-bracket-link-regexp (car c))
|
|
(< (org-string-width (car c)) len))
|
|
(setcar c (concat (car c) (make-string (- len (org-string-width (car c))) ?\ )))))))
|
|
|
|
;; Compute the formats needed for output of the table
|
|
(setq rfmt (concat indent "|") hfmt (concat indent "|"))
|
|
(while (setq l (pop lengths))
|
|
(setq ty (if (pop typenums) "" "-")) ; number types flushright
|
|
(setq rfmt (concat rfmt (format rfmt1 ty l))
|
|
hfmt (concat hfmt (format hfmt1 (make-string l ?-)))))
|
|
(setq rfmt (concat rfmt "\n")
|
|
hfmt (concat (substring hfmt 0 -1) "|\n"))
|
|
|
|
(setq new (mapconcat
|
|
(lambda (l)
|
|
(if l (apply 'format rfmt
|
|
(append (pop fields) emptystrings))
|
|
hfmt))
|
|
lines ""))
|
|
;; Replace the old one
|
|
(delete-region beg end)
|
|
(move-marker end nil)
|
|
(move-marker org-table-aligned-begin-marker (point))
|
|
(insert new)
|
|
(move-marker org-table-aligned-end-marker (point))
|
|
(when (and orgtbl-mode (not (eq major-mode 'org-mode)))
|
|
(goto-char org-table-aligned-begin-marker)
|
|
(while (org-hide-wide-columns org-table-aligned-end-marker)))
|
|
;; Try to move to the old location (approximately)
|
|
(goto-line linepos)
|
|
(set-window-start (selected-window) winstart 'noforce)
|
|
(org-table-goto-column colpos)
|
|
(setq org-table-may-need-update nil)
|
|
))
|
|
|
|
(defun org-string-width (s)
|
|
"Compute width of string, ignoring invisible characters.
|
|
This ignores character with invisibility property `org-link', and also
|
|
characters with property `org-cwidth', because these will become invisible
|
|
upon the next fontification round."
|
|
(let (b)
|
|
(when (or (eq t buffer-invisibility-spec)
|
|
(assq 'org-link buffer-invisibility-spec))
|
|
(while (setq b (text-property-any 0 (length s)
|
|
'invisible 'org-link s))
|
|
(setq s (concat (substring s 0 b)
|
|
(substring s (or (next-single-property-change
|
|
b 'invisible s) (length s)))))))
|
|
(while (setq b (text-property-any 0 (length s) 'org-cwidth t s))
|
|
(setq s (concat (substring s 0 b)
|
|
(substring s (or (next-single-property-change
|
|
b 'org-cwidth s) (length s))))))
|
|
(string-width s)))
|
|
|
|
(defun org-table-begin (&optional table-type)
|
|
"Find the beginning of the table and return its position.
|
|
With argument TABLE-TYPE, go to the beginning of a table.el-type table."
|
|
(save-excursion
|
|
(if (not (re-search-backward
|
|
(if table-type org-table-any-border-regexp
|
|
org-table-border-regexp)
|
|
nil t))
|
|
(progn (goto-char (point-min)) (point))
|
|
(goto-char (match-beginning 0))
|
|
(beginning-of-line 2)
|
|
(point))))
|
|
|
|
(defun org-table-end (&optional table-type)
|
|
"Find the end of the table and return its position.
|
|
With argument TABLE-TYPE, go to the end of a table.el-type table."
|
|
(save-excursion
|
|
(if (not (re-search-forward
|
|
(if table-type org-table-any-border-regexp
|
|
org-table-border-regexp)
|
|
nil t))
|
|
(goto-char (point-max))
|
|
(goto-char (match-beginning 0)))
|
|
(point-marker)))
|
|
|
|
(defun org-table-justify-field-maybe (&optional new)
|
|
"Justify the current field, text to left, number to right.
|
|
Optional argument NEW may specify text to replace the current field content."
|
|
(cond
|
|
((and (not new) org-table-may-need-update)) ; Realignment will happen anyway
|
|
((org-at-table-hline-p))
|
|
((and (not new)
|
|
(or (not (equal (marker-buffer org-table-aligned-begin-marker)
|
|
(current-buffer)))
|
|
(< (point) org-table-aligned-begin-marker)
|
|
(>= (point) org-table-aligned-end-marker)))
|
|
;; This is not the same table, force a full re-align
|
|
(setq org-table-may-need-update t))
|
|
(t ;; realign the current field, based on previous full realign
|
|
(let* ((pos (point)) s
|
|
(col (org-table-current-column))
|
|
(num (if (> col 0) (nth (1- col) org-table-last-alignment)))
|
|
l f n o e)
|
|
(when (> col 0)
|
|
(skip-chars-backward "^|\n")
|
|
(if (looking-at " *\\([^|\n]*?\\) *\\(|\\|$\\)")
|
|
(progn
|
|
(setq s (match-string 1)
|
|
o (match-string 0)
|
|
l (max 1 (- (match-end 0) (match-beginning 0) 3))
|
|
e (not (= (match-beginning 2) (match-end 2))))
|
|
(setq f (format (if num " %%%ds %s" " %%-%ds %s")
|
|
l (if e "|" (setq org-table-may-need-update t) ""))
|
|
n (format f s))
|
|
(if new
|
|
(if (<= (length new) l) ;; FIXME: length -> str-width?
|
|
(setq n (format f new t t)) ;; FIXME: t t?
|
|
(setq n (concat new "|") org-table-may-need-update t)))
|
|
(or (equal n o)
|
|
(let (org-table-may-need-update)
|
|
(replace-match n))))
|
|
(setq org-table-may-need-update t))
|
|
(goto-char pos))))))
|
|
|
|
(defun org-table-next-field ()
|
|
"Go to the next field in the current table, creating new lines as needed.
|
|
Before doing so, re-align the table if necessary."
|
|
(interactive)
|
|
(org-table-maybe-eval-formula)
|
|
(org-table-maybe-recalculate-line)
|
|
(if (and org-table-automatic-realign
|
|
org-table-may-need-update)
|
|
(org-table-align))
|
|
(let ((end (org-table-end)))
|
|
(if (org-at-table-hline-p)
|
|
(end-of-line 1))
|
|
(condition-case nil
|
|
(progn
|
|
(re-search-forward "|" end)
|
|
(if (looking-at "[ \t]*$")
|
|
(re-search-forward "|" end))
|
|
(if (and (looking-at "-")
|
|
org-table-tab-jumps-over-hlines
|
|
(re-search-forward "^[ \t]*|\\([^-]\\)" end t))
|
|
(goto-char (match-beginning 1)))
|
|
(if (looking-at "-")
|
|
(progn
|
|
(beginning-of-line 0)
|
|
(org-table-insert-row 'below))
|
|
(if (looking-at " ") (forward-char 1))))
|
|
(error
|
|
(org-table-insert-row 'below)))))
|
|
|
|
(defun org-table-previous-field ()
|
|
"Go to the previous field in the table.
|
|
Before doing so, re-align the table if necessary."
|
|
(interactive)
|
|
(org-table-justify-field-maybe)
|
|
(org-table-maybe-recalculate-line)
|
|
(if (and org-table-automatic-realign
|
|
org-table-may-need-update)
|
|
(org-table-align))
|
|
(if (org-at-table-hline-p)
|
|
(end-of-line 1))
|
|
(re-search-backward "|" (org-table-begin))
|
|
(re-search-backward "|" (org-table-begin))
|
|
(while (looking-at "|\\(-\\|[ \t]*$\\)")
|
|
(re-search-backward "|" (org-table-begin)))
|
|
(if (looking-at "| ?")
|
|
(goto-char (match-end 0))))
|
|
|
|
(defun org-table-next-row ()
|
|
"Go to the next row (same column) in the current table.
|
|
Before doing so, re-align the table if necessary."
|
|
(interactive)
|
|
(org-table-maybe-eval-formula)
|
|
(org-table-maybe-recalculate-line)
|
|
(if (or (looking-at "[ \t]*$")
|
|
(save-excursion (skip-chars-backward " \t") (bolp)))
|
|
(newline)
|
|
(if (and org-table-automatic-realign
|
|
org-table-may-need-update)
|
|
(org-table-align))
|
|
(let ((col (org-table-current-column)))
|
|
(beginning-of-line 2)
|
|
(if (or (not (org-at-table-p))
|
|
(org-at-table-hline-p))
|
|
(progn
|
|
(beginning-of-line 0)
|
|
(org-table-insert-row 'below)))
|
|
(org-table-goto-column col)
|
|
(skip-chars-backward "^|\n\r")
|
|
(if (looking-at " ") (forward-char 1)))))
|
|
|
|
(defun org-table-copy-down (n)
|
|
"Copy a field down in the current column.
|
|
If the field at the cursor is empty, copy into it the content of the nearest
|
|
non-empty field above. With argument N, use the Nth non-empty field.
|
|
If the current field is not empty, it is copied down to the next row, and
|
|
the cursor is moved with it. Therefore, repeating this command causes the
|
|
column to be filled row-by-row.
|
|
If the variable `org-table-copy-increment' is non-nil and the field is an
|
|
integer, it will be incremented while copying."
|
|
(interactive "p")
|
|
(let* ((colpos (org-table-current-column))
|
|
(field (org-table-get-field))
|
|
(non-empty (string-match "[^ \t]" field))
|
|
(beg (org-table-begin))
|
|
txt)
|
|
(org-table-check-inside-data-field)
|
|
(if non-empty
|
|
(progn
|
|
(setq txt (org-trim field))
|
|
(org-table-next-row)
|
|
(org-table-blank-field))
|
|
(save-excursion
|
|
(setq txt
|
|
(catch 'exit
|
|
(while (progn (beginning-of-line 1)
|
|
(re-search-backward org-table-dataline-regexp
|
|
beg t))
|
|
(org-table-goto-column colpos t)
|
|
(if (and (looking-at
|
|
"|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
|
|
(= (setq n (1- n)) 0))
|
|
(throw 'exit (match-string 1))))))))
|
|
(if txt
|
|
(progn
|
|
(if (and org-table-copy-increment
|
|
(string-match "^[0-9]+$" txt))
|
|
(setq txt (format "%d" (+ (string-to-number txt) 1))))
|
|
(insert txt)
|
|
(org-table-maybe-recalculate-line)
|
|
(org-table-align))
|
|
(error "No non-empty field found"))))
|
|
|
|
(defun org-table-check-inside-data-field ()
|
|
"Is point inside a table data field?
|
|
I.e. not on a hline or before the first or after the last column?
|
|
This actually throws an error, so it aborts the current command."
|
|
(if (or (not (org-at-table-p))
|
|
(= (org-table-current-column) 0)
|
|
(org-at-table-hline-p)
|
|
(looking-at "[ \t]*$"))
|
|
(error "Not in table data field")))
|
|
|
|
(defvar org-table-clip nil
|
|
"Clipboard for table regions.")
|
|
|
|
(defun org-table-blank-field ()
|
|
"Blank the current table field or active region."
|
|
(interactive)
|
|
(org-table-check-inside-data-field)
|
|
(if (and (interactive-p) (org-region-active-p))
|
|
(let (org-table-clip)
|
|
(org-table-cut-region (region-beginning) (region-end)))
|
|
(skip-chars-backward "^|")
|
|
(backward-char 1)
|
|
(if (looking-at "|[^|\n]+")
|
|
(let* ((pos (match-beginning 0))
|
|
(match (match-string 0))
|
|
(len (org-string-width match)))
|
|
(replace-match (concat "|" (make-string (1- len) ?\ )))
|
|
(goto-char (+ 2 pos))
|
|
(substring match 1)))))
|
|
|
|
(defun org-table-get-field (&optional n replace)
|
|
"Return the value of the field in column N of current row.
|
|
N defaults to current field.
|
|
If REPLACE is a string, replace field with this value. The return value
|
|
is always the old value."
|
|
(and n (org-table-goto-column n))
|
|
(skip-chars-backward "^|\n")
|
|
(backward-char 1)
|
|
(if (looking-at "|[^|\r\n]*")
|
|
(let* ((pos (match-beginning 0))
|
|
(val (buffer-substring (1+ pos) (match-end 0))))
|
|
(if replace
|
|
(replace-match (concat "|" replace)))
|
|
(goto-char (min (point-at-eol) (+ 2 pos)))
|
|
val)
|
|
(forward-char 1) ""))
|
|
|
|
(defun org-table-current-column ()
|
|
"Find out which column we are in.
|
|
When called interactively, column is also displayed in echo area."
|
|
(interactive)
|
|
(if (interactive-p) (org-table-check-inside-data-field))
|
|
(save-excursion
|
|
(let ((cnt 0) (pos (point)))
|
|
(beginning-of-line 1)
|
|
(while (search-forward "|" pos t)
|
|
(setq cnt (1+ cnt)))
|
|
(if (interactive-p) (message "This is table column %d" cnt))
|
|
cnt)))
|
|
|
|
(defun org-table-goto-column (n &optional on-delim force)
|
|
"Move the cursor to the Nth column in the current table line.
|
|
With optional argument ON-DELIM, stop with point before the left delimiter
|
|
of the field.
|
|
If there are less than N fields, just go to after the last delimiter.
|
|
However, when FORCE is non-nil, create new columns if necessary."
|
|
(interactive "p")
|
|
(let ((pos (point-at-eol)))
|
|
(beginning-of-line 1)
|
|
(when (> n 0)
|
|
(while (and (> (setq n (1- n)) -1)
|
|
(or (search-forward "|" pos t)
|
|
(and force
|
|
(progn (end-of-line 1)
|
|
(skip-chars-backward "^|")
|
|
(insert " | "))))))
|
|
; (backward-char 2) t)))))
|
|
(when (and force (not (looking-at ".*|")))
|
|
(save-excursion (end-of-line 1) (insert " | ")))
|
|
(if on-delim
|
|
(backward-char 1)
|
|
(if (looking-at " ") (forward-char 1))))))
|
|
|
|
(defun org-at-table-p (&optional table-type)
|
|
"Return t if the cursor is inside an org-type table.
|
|
If TABLE-TYPE is non-nil, also check for table.el-type tables."
|
|
(if org-enable-table-editor
|
|
(save-excursion
|
|
(beginning-of-line 1)
|
|
(looking-at (if table-type org-table-any-line-regexp
|
|
org-table-line-regexp)))
|
|
nil))
|
|
|
|
(defun org-at-table.el-p ()
|
|
"Return t if and only if we are at a table.el table."
|
|
(and (org-at-table-p 'any)
|
|
(save-excursion
|
|
(goto-char (org-table-begin 'any))
|
|
(looking-at org-table1-hline-regexp))))
|
|
|
|
(defun org-table-recognize-table.el ()
|
|
"If there is a table.el table nearby, recognize it and move into it."
|
|
(if org-table-tab-recognizes-table.el
|
|
(if (org-at-table.el-p)
|
|
(progn
|
|
(beginning-of-line 1)
|
|
(if (looking-at org-table-dataline-regexp)
|
|
nil
|
|
(if (looking-at org-table1-hline-regexp)
|
|
(progn
|
|
(beginning-of-line 2)
|
|
(if (looking-at org-table-any-border-regexp)
|
|
(beginning-of-line -1)))))
|
|
(if (re-search-forward "|" (org-table-end t) t)
|
|
(progn
|
|
(require 'table)
|
|
(if (table--at-cell-p (point))
|
|
t
|
|
(message "recognizing table.el table...")
|
|
(table-recognize-table)
|
|
(message "recognizing table.el table...done")))
|
|
(error "This should not happen..."))
|
|
t)
|
|
nil)
|
|
nil))
|
|
|
|
(defun org-at-table-hline-p ()
|
|
"Return t if the cursor is inside a hline in a table."
|
|
(if org-enable-table-editor
|
|
(save-excursion
|
|
(beginning-of-line 1)
|
|
(looking-at org-table-hline-regexp))
|
|
nil))
|
|
|
|
(defun org-table-insert-column ()
|
|
"Insert a new column into the table."
|
|
(interactive)
|
|
(if (not (org-at-table-p))
|
|
(error "Not at a table"))
|
|
(org-table-find-dataline)
|
|
(let* ((col (max 1 (org-table-current-column)))
|
|
(beg (org-table-begin))
|
|
(end (org-table-end))
|
|
;; Current cursor position
|
|
(linepos (+ (if (bolp) 1 0) (count-lines (point-min) (point))))
|
|
(colpos col))
|
|
(goto-char beg)
|
|
(while (< (point) end)
|
|
(if (org-at-table-hline-p)
|
|
nil
|
|
(org-table-goto-column col t)
|
|
(insert "| "))
|
|
(beginning-of-line 2))
|
|
(move-marker end nil)
|
|
(goto-line linepos)
|
|
(org-table-goto-column colpos)
|
|
(org-table-align)
|
|
(org-table-modify-formulas 'insert col)))
|
|
|
|
(defun org-table-find-dataline ()
|
|
"Find a dataline in the current table, which is needed for column commands."
|
|
(if (and (org-at-table-p)
|
|
(not (org-at-table-hline-p)))
|
|
t
|
|
(let ((col (current-column))
|
|
(end (org-table-end)))
|
|
(move-to-column col)
|
|
(while (and (< (point) end)
|
|
(or (not (= (current-column) col))
|
|
(org-at-table-hline-p)))
|
|
(beginning-of-line 2)
|
|
(move-to-column col))
|
|
(if (and (org-at-table-p)
|
|
(not (org-at-table-hline-p)))
|
|
t
|
|
(error
|
|
"Please position cursor in a data line for column operations")))))
|
|
|
|
(defun org-table-delete-column ()
|
|
"Delete a column from the table."
|
|
(interactive)
|
|
(if (not (org-at-table-p))
|
|
(error "Not at a table"))
|
|
(org-table-find-dataline)
|
|
(org-table-check-inside-data-field)
|
|
(let* ((col (org-table-current-column))
|
|
(beg (org-table-begin))
|
|
(end (org-table-end))
|
|
;; Current cursor position
|
|
(linepos (+ (if (bolp) 1 0) (count-lines (point-min) (point))))
|
|
(colpos col))
|
|
(goto-char beg)
|
|
(while (< (point) end)
|
|
(if (org-at-table-hline-p)
|
|
nil
|
|
(org-table-goto-column col t)
|
|
(and (looking-at "|[^|\n]+|")
|
|
(replace-match "|")))
|
|
(beginning-of-line 2))
|
|
(move-marker end nil)
|
|
(goto-line linepos)
|
|
(org-table-goto-column colpos)
|
|
(org-table-align)
|
|
(org-table-modify-formulas 'remove col)))
|
|
|
|
(defun org-table-move-column-right ()
|
|
"Move column to the right."
|
|
(interactive)
|
|
(org-table-move-column nil))
|
|
(defun org-table-move-column-left ()
|
|
"Move column to the left."
|
|
(interactive)
|
|
(org-table-move-column 'left))
|
|
|
|
(defun org-table-move-column (&optional left)
|
|
"Move the current column to the right. With arg LEFT, move to the left."
|
|
(interactive "P")
|
|
(if (not (org-at-table-p))
|
|
(error "Not at a table"))
|
|
(org-table-find-dataline)
|
|
(org-table-check-inside-data-field)
|
|
(let* ((col (org-table-current-column))
|
|
(col1 (if left (1- col) col))
|
|
(beg (org-table-begin))
|
|
(end (org-table-end))
|
|
;; Current cursor position
|
|
(linepos (+ (if (bolp) 1 0) (count-lines (point-min) (point))))
|
|
(colpos (if left (1- col) (1+ col))))
|
|
(if (and left (= col 1))
|
|
(error "Cannot move column further left"))
|
|
(if (and (not left) (looking-at "[^|\n]*|[^|\n]*$"))
|
|
(error "Cannot move column further right"))
|
|
(goto-char beg)
|
|
(while (< (point) end)
|
|
(if (org-at-table-hline-p)
|
|
nil
|
|
(org-table-goto-column col1 t)
|
|
(and (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|")
|
|
(replace-match "|\\2|\\1|")))
|
|
(beginning-of-line 2))
|
|
(move-marker end nil)
|
|
(goto-line linepos)
|
|
(org-table-goto-column colpos)
|
|
(org-table-align)
|
|
(org-table-modify-formulas 'swap col (if left (1- col) (1+ col)))))
|
|
|
|
(defun org-table-move-row-down ()
|
|
"Move table row down."
|
|
(interactive)
|
|
(org-table-move-row nil))
|
|
(defun org-table-move-row-up ()
|
|
"Move table row up."
|
|
(interactive)
|
|
(org-table-move-row 'up))
|
|
|
|
(defun org-table-move-row (&optional up)
|
|
"Move the current table line down. With arg UP, move it up."
|
|
(interactive "P")
|
|
(let ((col (current-column))
|
|
(pos (point))
|
|
(tonew (if up 0 2))
|
|
txt)
|
|
(beginning-of-line tonew)
|
|
(if (not (org-at-table-p))
|
|
(progn
|
|
(goto-char pos)
|
|
(error "Cannot move row further")))
|
|
(goto-char pos)
|
|
(beginning-of-line 1)
|
|
(setq pos (point))
|
|
(setq txt (buffer-substring (point) (1+ (point-at-eol))))
|
|
(delete-region (point) (1+ (point-at-eol)))
|
|
(beginning-of-line tonew)
|
|
(insert txt)
|
|
(beginning-of-line 0)
|
|
(move-to-column col)))
|
|
|
|
(defun org-table-insert-row (&optional arg)
|
|
"Insert a new row above the current line into the table.
|
|
With prefix ARG, insert below the current line."
|
|
(interactive "P")
|
|
(if (not (org-at-table-p))
|
|
(error "Not at a table"))
|
|
(let* ((line (buffer-substring (point-at-bol) (point-at-eol)))
|
|
(new (org-table-clean-line line)))
|
|
;; Fix the first field if necessary
|
|
(if (string-match "^[ \t]*| *[#$] *|" line)
|
|
(setq new (replace-match (match-string 0 line) t t new)))
|
|
(beginning-of-line (if arg 2 1))
|
|
(let (org-table-may-need-update) (insert-before-markers new "\n"))
|
|
(beginning-of-line 0)
|
|
(re-search-forward "| ?" (point-at-eol) t)
|
|
(and org-table-may-need-update (org-table-align))))
|
|
|
|
(defun org-table-insert-hline (&optional arg)
|
|
"Insert a horizontal-line below the current line into the table.
|
|
With prefix ARG, insert above the current line."
|
|
(interactive "P")
|
|
(if (not (org-at-table-p))
|
|
(error "Not at a table"))
|
|
(let ((line (org-table-clean-line
|
|
(buffer-substring (point-at-bol) (point-at-eol))))
|
|
(col (current-column)))
|
|
(while (string-match "|\\( +\\)|" line)
|
|
(setq line (replace-match
|
|
(concat "+" (make-string (- (match-end 1) (match-beginning 1))
|
|
?-) "|") t t line)))
|
|
(and (string-match "\\+" line) (setq line (replace-match "|" t t line)))
|
|
(beginning-of-line (if arg 1 2))
|
|
(insert line "\n")
|
|
(beginning-of-line (if arg 1 -1))
|
|
(move-to-column col)))
|
|
|
|
(defun org-table-clean-line (s)
|
|
"Convert a table line S into a string with only \"|\" and space.
|
|
In particular, this does handle wide and invisible characters."
|
|
(if (string-match "^[ \t]*|-" s)
|
|
;; It's a hline, just map the characters
|
|
(setq s (mapconcat (lambda (x) (if (member x '(?| ?+)) "|" " ")) s ""))
|
|
(while (string-match "|\\([ \t]*?[^ \t\r\n|][^\r\n|]*\\)|" s)
|
|
(setq s (replace-match
|
|
(concat "|" (make-string (org-string-width (match-string 1 s))
|
|
?\ ) "|")
|
|
t t s)))
|
|
s))
|
|
|
|
(defun org-table-kill-row ()
|
|
"Delete the current row or horizontal line from the table."
|
|
(interactive)
|
|
(if (not (org-at-table-p))
|
|
(error "Not at a table"))
|
|
(let ((col (current-column)))
|
|
(kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))
|
|
(if (not (org-at-table-p)) (beginning-of-line 0))
|
|
(move-to-column col)))
|
|
|
|
(defun org-table-sort-lines (beg end numericp)
|
|
"Sort table lines in region.
|
|
Point and mark define the first and last line to include. Both point and
|
|
mark should be in the column that is used for sorting. For example, to
|
|
sort according to column 3, put the mark in the first line to sort, in
|
|
table column 3. Put point into the last line to be included in the sorting,
|
|
also in table column 3. The command will prompt for the sorting method
|
|
\(n for numerical, a for alphanumeric)."
|
|
(interactive "r\nsSorting method: [n]=numeric [a]=alpha: ")
|
|
(setq numericp (string-match "[nN]" numericp))
|
|
(org-table-align) ;; Just to be safe
|
|
(let* (bcol ecol cmp column lns)
|
|
(goto-char beg)
|
|
(org-table-check-inside-data-field)
|
|
(setq column (org-table-current-column)
|
|
beg (move-marker (make-marker) (point-at-bol)))
|
|
(goto-char end)
|
|
(org-table-check-inside-data-field)
|
|
(setq end (move-marker (make-marker) (1+ (point-at-eol))))
|
|
(untabify beg end)
|
|
(goto-char beg)
|
|
(org-table-goto-column column)
|
|
(skip-chars-backward "^|")
|
|
(setq bcol (current-column))
|
|
(org-table-goto-column (1+ column))
|
|
(skip-chars-backward "^|")
|
|
(setq ecol (1- (current-column)))
|
|
(setq cmp (if numericp
|
|
(lambda (a b) (< (car a) (car b)))
|
|
(lambda (a b) (string< (car a) (car b)))))
|
|
(setq lns (mapcar (lambda(x) (cons (org-trim (substring x bcol ecol)) x))
|
|
(org-split-string (buffer-substring beg end) "\n")))
|
|
(if numericp
|
|
(setq lns (mapcar (lambda(x)
|
|
(cons (string-to-number (car x)) (cdr x)))
|
|
lns)))
|
|
(delete-region beg end)
|
|
(move-marker beg nil)
|
|
(move-marker end nil)
|
|
(insert (mapconcat 'cdr (setq lns (sort lns cmp)) "\n") "\n")
|
|
(message "%d lines sorted %s based on column %d"
|
|
(length lns)
|
|
(if numericp "numerically" "alphabetically") column)))
|
|
|
|
(defun org-table-cut-region (beg end)
|
|
"Copy region in table to the clipboard and blank all relevant fields."
|
|
(interactive "r")
|
|
(org-table-copy-region beg end 'cut))
|
|
|
|
(defun org-table-copy-region (beg end &optional cut)
|
|
"Copy rectangular region in table to clipboard.
|
|
A special clipboard is used which can only be accessed
|
|
with `org-table-paste-rectangle'."
|
|
(interactive "rP")
|
|
(let* (l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2
|
|
region cols
|
|
(rpl (if cut " " nil)))
|
|
(goto-char beg)
|
|
(org-table-check-inside-data-field)
|
|
(setq l01 (count-lines (point-min) (point))
|
|
c01 (org-table-current-column))
|
|
(goto-char end)
|
|
(org-table-check-inside-data-field)
|
|
(setq l02 (count-lines (point-min) (point))
|
|
c02 (org-table-current-column))
|
|
(setq l1 (min l01 l02) l2 (max l01 l02)
|
|
c1 (min c01 c02) c2 (max c01 c02))
|
|
(catch 'exit
|
|
(while t
|
|
(catch 'nextline
|
|
(if (> l1 l2) (throw 'exit t))
|
|
(goto-line l1)
|
|
(if (org-at-table-hline-p) (throw 'nextline (setq l1 (1+ l1))))
|
|
(setq cols nil ic1 c1 ic2 c2)
|
|
(while (< ic1 (1+ ic2))
|
|
(push (org-table-get-field ic1 rpl) cols)
|
|
(setq ic1 (1+ ic1)))
|
|
(push (nreverse cols) region)
|
|
(setq l1 (1+ l1)))))
|
|
(setq org-table-clip (nreverse region))
|
|
(if cut (org-table-align))
|
|
org-table-clip))
|
|
|
|
(defun org-table-paste-rectangle ()
|
|
"Paste a rectangular region into a table.
|
|
The upper right corner ends up in the current field. All involved fields
|
|
will be overwritten. If the rectangle does not fit into the present table,
|
|
the table is enlarged as needed. The process ignores horizontal separator
|
|
lines."
|
|
(interactive)
|
|
(unless (and org-table-clip (listp org-table-clip))
|
|
(error "First cut/copy a region to paste!"))
|
|
(org-table-check-inside-data-field)
|
|
(let* ((clip org-table-clip)
|
|
(line (count-lines (point-min) (point)))
|
|
(col (org-table-current-column))
|
|
(org-enable-table-editor t)
|
|
(org-table-automatic-realign nil)
|
|
c cols field)
|
|
(while (setq cols (pop clip))
|
|
(while (org-at-table-hline-p) (beginning-of-line 2))
|
|
(if (not (org-at-table-p))
|
|
(progn (end-of-line 0) (org-table-next-field)))
|
|
(setq c col)
|
|
(while (setq field (pop cols))
|
|
(org-table-goto-column c nil 'force)
|
|
(org-table-get-field nil field)
|
|
(setq c (1+ c)))
|
|
(beginning-of-line 2))
|
|
(goto-line line)
|
|
(org-table-goto-column col)
|
|
(org-table-align)))
|
|
|
|
(defun org-table-convert ()
|
|
"Convert from `org-mode' table to table.el and back.
|
|
Obviously, this only works within limits. When an Org-mode table is
|
|
converted to table.el, all horizontal separator lines get lost, because
|
|
table.el uses these as cell boundaries and has no notion of horizontal lines.
|
|
A table.el table can be converted to an Org-mode table only if it does not
|
|
do row or column spanning. Multiline cells will become multiple cells.
|
|
Beware, Org-mode does not test if the table can be successfully converted - it
|
|
blindly applies a recipe that works for simple tables."
|
|
(interactive)
|
|
(require 'table)
|
|
(if (org-at-table.el-p)
|
|
;; convert to Org-mode table
|
|
(let ((beg (move-marker (make-marker) (org-table-begin t)))
|
|
(end (move-marker (make-marker) (org-table-end t))))
|
|
(table-unrecognize-region beg end)
|
|
(goto-char beg)
|
|
(while (re-search-forward "^\\([ \t]*\\)\\+-.*\n" end t)
|
|
(replace-match ""))
|
|
(goto-char beg))
|
|
(if (org-at-table-p)
|
|
;; convert to table.el table
|
|
(let ((beg (move-marker (make-marker) (org-table-begin)))
|
|
(end (move-marker (make-marker) (org-table-end))))
|
|
;; first, get rid of all horizontal lines
|
|
(goto-char beg)
|
|
(while (re-search-forward "^\\([ \t]*\\)|-.*\n" end t)
|
|
(replace-match ""))
|
|
;; insert a hline before first
|
|
(goto-char beg)
|
|
(org-table-insert-hline 'above)
|
|
(beginning-of-line -1)
|
|
;; insert a hline after each line
|
|
(while (progn (beginning-of-line 3) (< (point) end))
|
|
(org-table-insert-hline))
|
|
(goto-char beg)
|
|
(setq end (move-marker end (org-table-end)))
|
|
;; replace "+" at beginning and ending of hlines
|
|
(while (re-search-forward "^\\([ \t]*\\)|-" end t)
|
|
(replace-match "\\1+-"))
|
|
(goto-char beg)
|
|
(while (re-search-forward "-|[ \t]*$" end t)
|
|
(replace-match "-+"))
|
|
(goto-char beg)))))
|
|
|
|
(defun org-table-wrap-region (arg)
|
|
"Wrap several fields in a column like a paragraph.
|
|
This is useful if you'd like to spread the contents of a field over several
|
|
lines, in order to keep the table compact.
|
|
|
|
If there is an active region, and both point and mark are in the same column,
|
|
the text in the column is wrapped to minimum width for the given number of
|
|
lines. Generally, this makes the table more compact. A prefix ARG may be
|
|
used to change the number of desired lines. For example, `C-2 \\[org-table-wrap]'
|
|
formats the selected text to two lines. If the region was longer than two
|
|
lines, the remaining lines remain empty. A negative prefix argument reduces
|
|
the current number of lines by that amount. The wrapped text is pasted back
|
|
into the table. If you formatted it to more lines than it was before, fields
|
|
further down in the table get overwritten - so you might need to make space in
|
|
the table first.
|
|
|
|
If there is no region, the current field is split at the cursor position and
|
|
the text fragment to the right of the cursor is prepended to the field one
|
|
line down.
|
|
|
|
If there is no region, but you specify a prefix ARG, the current field gets
|
|
blank, and the content is appended to the field above."
|
|
(interactive "P")
|
|
(org-table-check-inside-data-field)
|
|
(if (org-region-active-p)
|
|
;; There is a region: fill as a paragraph
|
|
(let ((beg (region-beginning))
|
|
nlines)
|
|
(org-table-cut-region (region-beginning) (region-end))
|
|
(if (> (length (car org-table-clip)) 1)
|
|
(error "Region must be limited to single column"))
|
|
(setq nlines (if arg
|
|
(if (< arg 1)
|
|
(+ (length org-table-clip) arg)
|
|
arg)
|
|
(length org-table-clip)))
|
|
(setq org-table-clip
|
|
(mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ")
|
|
nil nlines)))
|
|
(goto-char beg)
|
|
(org-table-paste-rectangle))
|
|
;; No region, split the current field at point
|
|
(if arg
|
|
;; combine with field above
|
|
(let ((s (org-table-blank-field))
|
|
(col (org-table-current-column)))
|
|
(beginning-of-line 0)
|
|
(while (org-at-table-hline-p) (beginning-of-line 0))
|
|
(org-table-goto-column col)
|
|
(skip-chars-forward "^|")
|
|
(skip-chars-backward " ")
|
|
(insert " " (org-trim s))
|
|
(org-table-align))
|
|
;; split field
|
|
(when (looking-at "\\([^|]+\\)+|")
|
|
(let ((s (match-string 1)))
|
|
(replace-match " |")
|
|
(goto-char (match-beginning 0))
|
|
(org-table-next-row)
|
|
(insert (org-trim s) " ")
|
|
(org-table-align))))))
|
|
|
|
(defvar org-field-marker nil)
|
|
|
|
(defun org-table-edit-field (arg)
|
|
"Edit table field in a different window.
|
|
This is mainly useful for fields that contain hidden parts.
|
|
When called with a \\[universal-argument] prefix, just make the full field visible so that
|
|
it can be edited in place."
|
|
(interactive "P")
|
|
(if arg
|
|
(let ((b (save-excursion (skip-chars-backward "^|") (point)))
|
|
(e (save-excursion (skip-chars-forward "^|\r\n") (point))))
|
|
(remove-text-properties b e '(org-cwidth t invisible t
|
|
display t intangible t))
|
|
(if (and (boundp 'font-lock-mode) font-lock-mode)
|
|
(font-lock-fontify-block)))
|
|
(let ((pos (move-marker (make-marker) (point)))
|
|
(field (org-table-get-field))
|
|
(cw (current-window-configuration))
|
|
p)
|
|
(switch-to-buffer-other-window "*Org tmp*")
|
|
(erase-buffer)
|
|
(insert "#\n# Edit field and finish with C-c C-c\n#\n")
|
|
(org-mode)
|
|
(goto-char (setq p (point-max)))
|
|
(insert (org-trim field))
|
|
(remove-text-properties p (point-max)
|
|
'(invisible t org-cwidth t display t
|
|
intangible t))
|
|
(goto-char p)
|
|
(set (make-local-variable 'org-finish-function)
|
|
'org-table-finish-edit-field)
|
|
(set (make-local-variable 'org-window-configuration) cw)
|
|
(set (make-local-variable 'org-field-marker) pos)
|
|
(message "Edit and finish with C-c C-c"))))
|
|
|
|
(defun org-table-finish-edit-field ()
|
|
"Finish editing a table data field.
|
|
Remove all newline characters, insert the result into the table, realign
|
|
the table and kill the editing buffer."
|
|
(let ((pos org-field-marker)
|
|
(cw org-window-configuration)
|
|
(cb (current-buffer))
|
|
text)
|
|
(goto-char (point-min))
|
|
(while (re-search-forward "^#.*\n?" nil t) (replace-match ""))
|
|
(while (re-search-forward "\\([ \t]*\n[ \t]*\\)+" nil t)
|
|
(replace-match " "))
|
|
(setq text (org-trim (buffer-string)))
|
|
(set-window-configuration cw)
|
|
(kill-buffer cb)
|
|
(select-window (get-buffer-window (marker-buffer pos)))
|
|
(goto-char pos)
|
|
(move-marker pos nil)
|
|
(org-table-check-inside-data-field)
|
|
(org-table-get-field nil text)
|
|
(org-table-align)
|
|
(message "New field value inserted")))
|
|
|
|
(defun org-trim (s)
|
|
"Remove whitespace at beginning and end of string."
|
|
(if (string-match "^[ \t]+" s) (setq s (replace-match "" t t s)))
|
|
(if (string-match "[ \t]+$" s) (setq s (replace-match "" t t s)))
|
|
s)
|
|
|
|
(defun org-wrap (string &optional width lines)
|
|
"Wrap string to either a number of lines, or a width in characters.
|
|
If WIDTH is non-nil, the string is wrapped to that width, however many lines
|
|
that costs. If there is a word longer than WIDTH, the text is actually
|
|
wrapped to the length of that word.
|
|
IF WIDTH is nil and LINES is non-nil, the string is forced into at most that
|
|
many lines, whatever width that takes.
|
|
The return value is a list of lines, without newlines at the end."
|
|
(let* ((words (org-split-string string "[ \t\n]+"))
|
|
(maxword (apply 'max (mapcar 'org-string-width words)))
|
|
w ll)
|
|
(cond (width
|
|
(org-do-wrap words (max maxword width)))
|
|
(lines
|
|
(setq w maxword)
|
|
(setq ll (org-do-wrap words maxword))
|
|
(if (<= (length ll) lines)
|
|
ll
|
|
(setq ll words)
|
|
(while (> (length ll) lines)
|
|
(setq w (1+ w))
|
|
(setq ll (org-do-wrap words w)))
|
|
ll))
|
|
(t (error "Cannot wrap this")))))
|
|
|
|
|
|
(defun org-do-wrap (words width)
|
|
"Create lines of maximum width WIDTH (in characters) from word list WORDS."
|
|
(let (lines line)
|
|
(while words
|
|
(setq line (pop words))
|
|
(while (and words (< (+ (length line) (length (car words))) width))
|
|
(setq line (concat line " " (pop words))))
|
|
(setq lines (push line lines)))
|
|
(nreverse lines)))
|
|
|
|
(defun org-split-string (string &optional separators)
|
|
"Splits STRING into substrings at SEPARATORS.
|
|
No empty strings are returned if there are matches at the beginning
|
|
and end of string."
|
|
(let ((rexp (or separators "[ \f\t\n\r\v]+"))
|
|
(start 0)
|
|
notfirst
|
|
(list nil))
|
|
(while (and (string-match rexp string
|
|
(if (and notfirst
|
|
(= start (match-beginning 0))
|
|
(< start (length string)))
|
|
(1+ start) start))
|
|
(< (match-beginning 0) (length string)))
|
|
(setq notfirst t)
|
|
(or (eq (match-beginning 0) 0)
|
|
(and (eq (match-beginning 0) (match-end 0))
|
|
(eq (match-beginning 0) start))
|
|
(setq list
|
|
(cons (substring string start (match-beginning 0))
|
|
list)))
|
|
(setq start (match-end 0)))
|
|
(or (eq start (length string))
|
|
(setq list
|
|
(cons (substring string start)
|
|
list)))
|
|
(nreverse list)))
|
|
|
|
(defun org-table-map-tables (function)
|
|
"Apply FUNCTION to the start of all tables in the buffer."
|
|
(save-excursion
|
|
(save-restriction
|
|
(widen)
|
|
(goto-char (point-min))
|
|
(while (re-search-forward org-table-any-line-regexp nil t)
|
|
(message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size)))
|
|
(beginning-of-line 1)
|
|
(if (looking-at org-table-line-regexp)
|
|
(save-excursion (funcall function)))
|
|
(re-search-forward org-table-any-border-regexp nil 1))))
|
|
(message "Mapping tables: done"))
|
|
|
|
(defun org-table-sum (&optional beg end nlast)
|
|
"Sum numbers in region of current table column.
|
|
The result will be displayed in the echo area, and will be available
|
|
as kill to be inserted with \\[yank].
|
|
|
|
If there is an active region, it is interpreted as a rectangle and all
|
|
numbers in that rectangle will be summed. If there is no active
|
|
region and point is located in a table column, sum all numbers in that
|
|
column.
|
|
|
|
If at least one number looks like a time HH:MM or HH:MM:SS, all other
|
|
numbers are assumed to be times as well (in decimal hours) and the
|
|
numbers are added as such.
|
|
|
|
If NLAST is a number, only the NLAST fields will actually be summed."
|
|
(interactive)
|
|
(save-excursion
|
|
(let (col (timecnt 0) diff h m s org-table-clip)
|
|
(cond
|
|
((and beg end)) ; beg and end given explicitly
|
|
((org-region-active-p)
|
|
(setq beg (region-beginning) end (region-end)))
|
|
(t
|
|
(setq col (org-table-current-column))
|
|
(goto-char (org-table-begin))
|
|
(unless (re-search-forward "^[ \t]*|[^-]" nil t)
|
|
(error "No table data"))
|
|
(org-table-goto-column col)
|
|
;not needed? (skip-chars-backward "^|")
|
|
(setq beg (point))
|
|
(goto-char (org-table-end))
|
|
(unless (re-search-backward "^[ \t]*|[^-]" nil t)
|
|
(error "No table data"))
|
|
(org-table-goto-column col)
|
|
;not needed? (skip-chars-forward "^|")
|
|
(setq end (point))))
|
|
(let* ((items (apply 'append (org-table-copy-region beg end)))
|
|
(items1 (cond ((not nlast) items)
|
|
((>= nlast (length items)) items)
|
|
(t (setq items (reverse items))
|
|
(setcdr (nthcdr (1- nlast) items) nil)
|
|
(nreverse items))))
|
|
(numbers (delq nil (mapcar 'org-table-get-number-for-summing
|
|
items1)))
|
|
(res (apply '+ numbers))
|
|
(sres (if (= timecnt 0)
|
|
(format "%g" res)
|
|
(setq diff (* 3600 res)
|
|
h (floor (/ diff 3600)) diff (mod diff 3600)
|
|
m (floor (/ diff 60)) diff (mod diff 60)
|
|
s diff)
|
|
(format "%d:%02d:%02d" h m s))))
|
|
(kill-new sres)
|
|
(if (interactive-p)
|
|
(message "%s"
|
|
(substitute-command-keys
|
|
(format "Sum of %d items: %-20s (\\[yank] will insert result into buffer)"
|
|
(length numbers) sres))))
|
|
sres))))
|
|
|
|
(defun org-table-get-number-for-summing (s)
|
|
(let (n)
|
|
(if (string-match "^ *|? *" s)
|
|
(setq s (replace-match "" nil nil s)))
|
|
(if (string-match " *|? *$" s)
|
|
(setq s (replace-match "" nil nil s)))
|
|
(setq n (string-to-number s))
|
|
(cond
|
|
((and (string-match "0" s)
|
|
(string-match "\\`[-+ \t0.edED]+\\'" s)) 0)
|
|
((string-match "\\`[ \t]+\\'" s) nil)
|
|
((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?\\'" s)
|
|
(let ((h (string-to-number (or (match-string 1 s) "0")))
|
|
(m (string-to-number (or (match-string 2 s) "0")))
|
|
(s (string-to-number (or (match-string 4 s) "0"))))
|
|
(if (boundp 'timecnt) (setq timecnt (1+ timecnt)))
|
|
(* 1.0 (+ h (/ m 60.0) (/ s 3600.0)))))
|
|
((equal n 0) nil)
|
|
(t n))))
|
|
|
|
(defun org-table-get-vertical-vector (desc &optional tbeg col)
|
|
"Get a calc vector from a column, accorting to descriptor DESC.
|
|
Optional arguments TBEG and COL can give the beginning of the table and
|
|
the current column, to avoid unnecessary parsing."
|
|
(save-excursion
|
|
(or tbeg (setq tbeg (org-table-begin)))
|
|
(or col (setq col (org-table-current-column)))
|
|
(let (beg end nn n n1 n2 l (thisline (org-current-line)) hline-list)
|
|
(cond
|
|
((string-match "\\(I+\\)\\(-\\(I+\\)\\)?" desc)
|
|
(setq n1 (- (match-end 1) (match-beginning 1)))
|
|
(if (match-beginning 3)
|
|
(setq n2 (- (match-end 2) (match-beginning 3))))
|
|
(setq n (if n2 (max n1 n2) n1))
|
|
(setq n1 (if n2 (min n1 n2)))
|
|
(setq nn n)
|
|
(while (and (> nn 0)
|
|
(re-search-backward org-table-hline-regexp tbeg t))
|
|
(push (org-current-line) hline-list)
|
|
(setq nn (1- nn)))
|
|
(setq hline-list (nreverse hline-list))
|
|
(goto-line (nth (1- n) hline-list))
|
|
(when (re-search-forward org-table-dataline-regexp)
|
|
(org-table-goto-column col)
|
|
(setq beg (point)))
|
|
(goto-line (if n1 (nth (1- n1) hline-list) thisline))
|
|
(when (re-search-backward org-table-dataline-regexp)
|
|
(org-table-goto-column col)
|
|
(setq end (point)))
|
|
(setq l (apply 'append (org-table-copy-region beg end)))
|
|
(concat "[" (mapconcat (lambda (x) (setq x (org-trim x))
|
|
(if (equal x "") "0" x))
|
|
l ",") "]"))
|
|
((string-match "\\([0-9]+\\)-\\([0-9]+\\)" desc)
|
|
(setq n1 (string-to-number (match-string 1 desc))
|
|
n2 (string-to-number (match-string 2 desc)))
|
|
(beginning-of-line 1)
|
|
(save-excursion
|
|
(when (re-search-backward org-table-dataline-regexp tbeg t n1)
|
|
(org-table-goto-column col)
|
|
(setq beg (point))))
|
|
(when (re-search-backward org-table-dataline-regexp tbeg t n2)
|
|
(org-table-goto-column col)
|
|
(setq end (point)))
|
|
(setq l (apply 'append (org-table-copy-region beg end)))
|
|
(concat "[" (mapconcat
|
|
(lambda (x) (setq x (org-trim x))
|
|
(if (equal x "") "0" x))
|
|
l ",") "]"))
|
|
((string-match "\\([0-9]+\\)" desc)
|
|
(beginning-of-line 1)
|
|
(when (re-search-backward org-table-dataline-regexp tbeg t
|
|
(string-to-number (match-string 0 desc)))
|
|
(org-table-goto-column col)
|
|
(org-trim (org-table-get-field))))))))
|
|
|
|
(defvar org-table-formula-history nil)
|
|
|
|
(defvar org-table-column-names nil
|
|
"Alist with column names, derived from the `!' line.")
|
|
(defvar org-table-column-name-regexp nil
|
|
"Regular expression matching the current column names.")
|
|
(defvar org-table-local-parameters nil
|
|
"Alist with parameter names, derived from the `$' line.")
|
|
(defvar org-table-named-field-locations nil
|
|
"Alist with locations of named fields.")
|
|
|
|
(defun org-table-get-formula (&optional equation named)
|
|
"Read a formula from the minibuffer, offer stored formula as default."
|
|
(let* ((name (car (rassoc (list (org-current-line)
|
|
(org-table-current-column))
|
|
org-table-named-field-locations)))
|
|
(scol (if named
|
|
(if name name
|
|
(error "Not in a named field"))
|
|
(int-to-string (org-table-current-column))))
|
|
(dummy (and name (not named)
|
|
(not (y-or-n-p "Replace named-field formula with column equation? " ))
|
|
(error "Abort")))
|
|
(org-table-may-need-update nil)
|
|
(stored-list (org-table-get-stored-formulas))
|
|
(stored (cdr (assoc scol stored-list)))
|
|
(eq (cond
|
|
((and stored equation (string-match "^ *=? *$" equation))
|
|
stored)
|
|
((stringp equation)
|
|
equation)
|
|
(t (read-string
|
|
(format "%s formula $%s=" (if named "Field" "Column") scol)
|
|
(or stored "") 'org-table-formula-history
|
|
;stored
|
|
))))
|
|
mustsave)
|
|
(when (not (string-match "\\S-" eq))
|
|
;; remove formula
|
|
(setq stored-list (delq (assoc scol stored-list) stored-list))
|
|
(org-table-store-formulas stored-list)
|
|
(error "Formula removed"))
|
|
(if (string-match "^ *=?" eq) (setq eq (replace-match "" t t eq)))
|
|
(if (string-match " *$" eq) (setq eq (replace-match "" t t eq)))
|
|
(if (and name (not named))
|
|
;; We set the column equation, delete the named one.
|
|
(setq stored-list (delq (assoc name stored-list) stored-list)
|
|
mustsave t))
|
|
(if stored
|
|
(setcdr (assoc scol stored-list) eq)
|
|
(setq stored-list (cons (cons scol eq) stored-list)))
|
|
(if (or mustsave (not (equal stored eq)))
|
|
(org-table-store-formulas stored-list))
|
|
eq))
|
|
|
|
(defun org-table-store-formulas (alist)
|
|
"Store the list of formulas below the current table."
|
|
(setq alist (sort alist (lambda (a b) (string< (car a) (car b)))))
|
|
(save-excursion
|
|
(goto-char (org-table-end))
|
|
(if (looking-at "\\([ \t]*\n\\)*#\\+TBLFM:.*\n?")
|
|
(delete-region (point) (match-end 0)))
|
|
(insert "#+TBLFM: "
|
|
(mapconcat (lambda (x)
|
|
(concat "$" (car x) "=" (cdr x)))
|
|
alist "::")
|
|
"\n")))
|
|
|
|
(defun org-table-get-stored-formulas ()
|
|
"Return an alist with the stored formulas directly after current table."
|
|
(interactive)
|
|
(let (scol eq eq-alist strings string seen)
|
|
(save-excursion
|
|
(goto-char (org-table-end))
|
|
(when (looking-at "\\([ \t]*\n\\)*#\\+TBLFM: *\\(.*\\)")
|
|
(setq strings (org-split-string (match-string 2) " *:: *"))
|
|
(while (setq string (pop strings))
|
|
(when (string-match "\\$\\([a-zA-Z0-9]+\\) *= *\\(.*[^ \t]\\)" string)
|
|
(setq scol (match-string 1 string)
|
|
eq (match-string 2 string)
|
|
eq-alist (cons (cons scol eq) eq-alist))
|
|
(if (member scol seen)
|
|
(error "Double definition `$%s=' in TBLFM line, please fix by hand" scol)
|
|
(push scol seen))))))
|
|
(nreverse eq-alist)))
|
|
|
|
(defun org-table-modify-formulas (action &rest columns)
|
|
"Modify the formulas stored below the current table.
|
|
ACTION can be `remove', `insert', `swap'. For `swap', two column numbers are
|
|
expected, for the other actions only a single column number is needed."
|
|
(let ((list (org-table-get-stored-formulas))
|
|
(nmax (length (org-split-string
|
|
(buffer-substring (point-at-bol) (point-at-eol))
|
|
"|")))
|
|
col col1 col2 scol si sc1 sc2)
|
|
(cond
|
|
((null list)) ; No action needed if there are no stored formulas
|
|
((eq action 'remove)
|
|
(setq col (car columns)
|
|
scol (int-to-string col))
|
|
(org-table-replace-in-formulas list scol "INVALID")
|
|
(if (assoc scol list) (setq list (delq (assoc scol list) list)))
|
|
(loop for i from (1+ col) upto nmax by 1 do
|
|
(setq si (int-to-string i))
|
|
(org-table-replace-in-formulas list si (int-to-string (1- i)))
|
|
(if (assoc si list) (setcar (assoc si list)
|
|
(int-to-string (1- i))))))
|
|
((eq action 'insert)
|
|
(setq col (car columns))
|
|
(loop for i from nmax downto col by 1 do
|
|
(setq si (int-to-string i))
|
|
(org-table-replace-in-formulas list si (int-to-string (1+ i)))
|
|
(if (assoc si list) (setcar (assoc si list)
|
|
(int-to-string (1+ i))))))
|
|
((eq action 'swap)
|
|
(setq col1 (car columns) col2 (nth 1 columns)
|
|
sc1 (int-to-string col1) sc2 (int-to-string col2))
|
|
;; Hopefully, ZqZtZ will never be a name in a table
|
|
(org-table-replace-in-formulas list sc1 "ZqZtZ")
|
|
(org-table-replace-in-formulas list sc2 sc1)
|
|
(org-table-replace-in-formulas list "ZqZtZ" sc2)
|
|
(if (assoc sc1 list) (setcar (assoc sc1 list) "ZqZtZ"))
|
|
(if (assoc sc2 list) (setcar (assoc sc2 list) sc1))
|
|
(if (assoc "ZqZtZ" list) (setcar (assoc "ZqZtZ" list) sc2)))
|
|
(t (error "Invalid action in `org-table-modify-formulas'")))
|
|
(if list (org-table-store-formulas list))))
|
|
|
|
(defun org-table-replace-in-formulas (list s1 s2)
|
|
(let (elt re s)
|
|
(setq s1 (concat "$" (if (integerp s1) (int-to-string s1) s1))
|
|
s2 (concat "$" (if (integerp s2) (int-to-string s2) s2))
|
|
re (concat (regexp-quote s1) "\\>"))
|
|
(while (setq elt (pop list))
|
|
(setq s (cdr elt))
|
|
(while (string-match re s)
|
|
(setq s (replace-match s2 t t s)))
|
|
(setcdr elt s))))
|
|
|
|
(defun org-table-get-specials ()
|
|
"Get the column names and local parameters for this table."
|
|
(save-excursion
|
|
(let ((beg (org-table-begin)) (end (org-table-end))
|
|
names name fields fields1 field cnt c v line col)
|
|
(setq org-table-column-names nil
|
|
org-table-local-parameters nil
|
|
org-table-named-field-locations nil)
|
|
(goto-char beg)
|
|
(when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t)
|
|
(setq names (org-split-string (match-string 1) " *| *")
|
|
cnt 1)
|
|
(while (setq name (pop names))
|
|
(setq cnt (1+ cnt))
|
|
(if (string-match "^[a-zA-Z][a-zA-Z0-9]*$" name)
|
|
(push (cons name (int-to-string cnt)) org-table-column-names))))
|
|
(setq org-table-column-names (nreverse org-table-column-names))
|
|
(setq org-table-column-name-regexp
|
|
(concat "\\$\\(" (mapconcat 'car org-table-column-names "\\|") "\\)\\>"))
|
|
(goto-char beg)
|
|
(while (re-search-forward "^[ \t]*| *\\$ *\\(|.*\\)" end t)
|
|
(setq fields (org-split-string (match-string 1) " *| *"))
|
|
(while (setq field (pop fields))
|
|
(if (string-match "^\\([a-zA-Z][a-zA-Z0-9]*\\|%\\) *= *\\(.*\\)" field)
|
|
(push (cons (match-string 1 field) (match-string 2 field))
|
|
org-table-local-parameters))))
|
|
(goto-char beg)
|
|
(while (re-search-forward "^[ \t]*| *\\([_^]\\) *\\(|.*\\)" end t)
|
|
(setq c (match-string 1)
|
|
fields (org-split-string (match-string 2) " *| *"))
|
|
(save-excursion
|
|
(beginning-of-line (if (equal c "_") 2 0))
|
|
(setq line (org-current-line) col 1)
|
|
(and (looking-at "^[ \t]*|[^|]*\\(|.*\\)")
|
|
(setq fields1 (org-split-string (match-string 1) " *| *"))))
|
|
(while (and fields1 (setq field (pop fields)))
|
|
(setq v (pop fields1) col (1+ col))
|
|
(when (and (stringp field) (stringp v)
|
|
(string-match "^[a-zA-Z][a-zA-Z0-9]*$" field))
|
|
(push (cons field v) org-table-local-parameters)
|
|
(push (list field line col) org-table-named-field-locations)))))))
|
|
|
|
(defun org-this-word ()
|
|
;; Get the current word
|
|
(save-excursion
|
|
(let ((beg (progn (skip-chars-backward "^ \t\n") (point)))
|
|
(end (progn (skip-chars-forward "^ \t\n") (point))))
|
|
(buffer-substring-no-properties beg end))))
|
|
|
|
(defun org-table-maybe-eval-formula ()
|
|
"Check if the current field starts with \"=\" or \":=\".
|
|
If yes, store the formula and apply it."
|
|
;; We already know we are in a table. Get field will only return a formula
|
|
;; when appropriate. It might return a separator line, but no problem.
|
|
(when org-table-formula-evaluate-inline
|
|
(let* ((field (org-trim (or (org-table-get-field) "")))
|
|
named eq)
|
|
(when (string-match "^:?=\\(.*\\)" field)
|
|
(setq named (equal (string-to-char field) ?:)
|
|
eq (match-string 1 field))
|
|
(if (fboundp 'calc-eval)
|
|
(org-table-eval-formula (if named '(4) nil) eq))))))
|
|
|
|
(defvar org-recalc-commands nil
|
|
"List of commands triggering the recalculation of a line.
|
|
Will be filled automatically during use.")
|
|
|
|
(defvar org-recalc-marks
|
|
'((" " . "Unmarked: no special line, no automatic recalculation")
|
|
("#" . "Automatically recalculate this line upon TAB, RET, and C-c C-c in the line")
|
|
("*" . "Recalculate only when entire table is recalculated with `C-u C-c *'")
|
|
("!" . "Column name definition line. Reference in formula as $name.")
|
|
("$" . "Parameter definition line name=value. Reference in formula as $name.")
|
|
("_" . "Names for values in row below this one.")
|
|
("^" . "Names for values in row above this one.")))
|
|
|
|
(defun org-table-rotate-recalc-marks (&optional newchar)
|
|
"Rotate the recalculation mark in the first column.
|
|
If in any row, the first field is not consistent with a mark,
|
|
insert a new column for the markers.
|
|
When there is an active region, change all the lines in the region,
|
|
after prompting for the marking character.
|
|
After each change, a message will be displayed indicating the meaning
|
|
of the new mark."
|
|
(interactive)
|
|
(unless (org-at-table-p) (error "Not at a table"))
|
|
(let* ((marks (append (mapcar 'car org-recalc-marks) '(" ")))
|
|
(beg (org-table-begin))
|
|
(end (org-table-end))
|
|
(l (org-current-line))
|
|
(l1 (if (org-region-active-p) (org-current-line (region-beginning))))
|
|
(l2 (if (org-region-active-p) (org-current-line (region-end))))
|
|
(have-col
|
|
(save-excursion
|
|
(goto-char beg)
|
|
(not (re-search-forward "^[ \t]*|[^-|][^|]*[^#!$*_^| \t][^|]*|" end t))))
|
|
(col (org-table-current-column))
|
|
(forcenew (car (assoc newchar org-recalc-marks)))
|
|
epos new)
|
|
(when l1
|
|
(message "Change region to what mark? Type # * ! $ or SPC: ")
|
|
(setq newchar (char-to-string (read-char-exclusive))
|
|
forcenew (car (assoc newchar org-recalc-marks))))
|
|
(if (and newchar (not forcenew))
|
|
(error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'"
|
|
newchar))
|
|
(if l1 (goto-line l1))
|
|
(save-excursion
|
|
(beginning-of-line 1)
|
|
(unless (looking-at org-table-dataline-regexp)
|
|
(error "Not at a table data line")))
|
|
(unless have-col
|
|
(org-table-goto-column 1)
|
|
(org-table-insert-column)
|
|
(org-table-goto-column (1+ col)))
|
|
(setq epos (point-at-eol))
|
|
(save-excursion
|
|
(beginning-of-line 1)
|
|
(org-table-get-field
|
|
1 (if (looking-at "^[ \t]*| *\\([#!$*^_ ]\\) *|")
|
|
(concat " "
|
|
(setq new (or forcenew
|
|
(cadr (member (match-string 1) marks))))
|
|
" ")
|
|
" # ")))
|
|
(if (and l1 l2)
|
|
(progn
|
|
(goto-line l1)
|
|
(while (progn (beginning-of-line 2) (not (= (org-current-line) l2)))
|
|
(and (looking-at org-table-dataline-regexp)
|
|
(org-table-get-field 1 (concat " " new " "))))
|
|
(goto-line l1)))
|
|
(if (not (= epos (point-at-eol))) (org-table-align))
|
|
(goto-line l)
|
|
(and (interactive-p) (message (cdr (assoc new org-recalc-marks))))))
|
|
|
|
(defun org-table-maybe-recalculate-line ()
|
|
"Recompute the current line if marked for it, and if we haven't just done it."
|
|
(interactive)
|
|
(and org-table-allow-automatic-line-recalculation
|
|
(not (and (memq last-command org-recalc-commands)
|
|
(equal org-last-recalc-line (org-current-line))))
|
|
(save-excursion (beginning-of-line 1)
|
|
(looking-at org-table-auto-recalculate-regexp))
|
|
(fboundp 'calc-eval)
|
|
(org-table-recalculate) t))
|
|
|
|
(defvar org-table-formula-debug nil
|
|
"Non-nil means, debug table formulas.
|
|
When nil, simply write \"#ERROR\" in corrupted fields.")
|
|
|
|
(defvar modes)
|
|
(defsubst org-set-calc-mode (var &optional value)
|
|
(if (stringp var)
|
|
(setq var (assoc var '(("D" calc-angle-mode deg)
|
|
("R" calc-angle-mode rad)
|
|
("F" calc-prefer-frac t)
|
|
("S" calc-symbolic-mode t)))
|
|
value (nth 2 var) var (nth 1 var)))
|
|
(if (memq var modes)
|
|
(setcar (cdr (memq var modes)) value)
|
|
(cons var (cons value modes)))
|
|
modes)
|
|
|
|
(defun org-table-eval-formula (&optional arg equation
|
|
suppress-align suppress-const
|
|
suppress-store)
|
|
"Replace the table field value at the cursor by the result of a calculation.
|
|
|
|
This function makes use of Dave Gillespie's Calc package, in my view the
|
|
most exciting program ever written for GNU Emacs. So you need to have Calc
|
|
installed in order to use this function.
|
|
|
|
In a table, this command replaces the value in the current field with the
|
|
result of a formula. It also installs the formula as the \"current\" column
|
|
formula, by storing it in a special line below the table. When called
|
|
with a `C-u' prefix, the current field must ba a named field, and the
|
|
formula is installed as valid in only this specific field.
|
|
|
|
When called, the command first prompts for a formula, which is read in
|
|
the minibuffer. Previously entered formulas are available through the
|
|
history list, and the last used formula is offered as a default.
|
|
These stored formulas are adapted correctly when moving, inserting, or
|
|
deleting columns with the corresponding commands.
|
|
|
|
The formula can be any algebraic expression understood by the Calc package.
|
|
For details, see the Org-mode manual.
|
|
|
|
This function can also be called from Lisp programs and offers
|
|
additional arguments: EQUATION can be the formula to apply. If this
|
|
argument is given, the user will not be prompted. SUPPRESS-ALIGN is
|
|
used to speed-up recursive calls by by-passing unnecessary aligns.
|
|
SUPPRESS-CONST suppresses the interpretation of constants in the
|
|
formula, assuming that this has been done already outside the function.
|
|
SUPPRESS-STORE means the formula should not be stored, either because
|
|
it is already stored, or because it is a modified equation that should
|
|
not overwrite the stored one."
|
|
(interactive "P")
|
|
(require 'calc)
|
|
(org-table-check-inside-data-field)
|
|
(org-table-get-specials)
|
|
(let* (fields
|
|
(ndown (if (integerp arg) arg 1))
|
|
(org-table-automatic-realign nil)
|
|
(case-fold-search nil)
|
|
(down (> ndown 1))
|
|
(formula (if (and equation suppress-store)
|
|
equation
|
|
(org-table-get-formula equation (equal arg '(4)))))
|
|
(n0 (org-table-current-column))
|
|
(modes (copy-sequence org-calc-default-modes))
|
|
n form fmt x ev orig c lispp)
|
|
;; Parse the format string. Since we have a lot of modes, this is
|
|
;; a lot of work. However, I think calc still uses most of the time.
|
|
(if (string-match ";" formula)
|
|
(let ((tmp (org-split-string formula ";")))
|
|
(setq formula (car tmp)
|
|
fmt (concat (cdr (assoc "%" org-table-local-parameters))
|
|
(nth 1 tmp)))
|
|
(while (string-match "[pnfse]\\(-?[0-9]+\\)" fmt)
|
|
(setq c (string-to-char (match-string 1 fmt))
|
|
n (string-to-number (or (match-string 1 fmt) "")))
|
|
(if (= c ?p) (setq modes (org-set-calc-mode 'calc-internal-prec n))
|
|
(setq modes (org-set-calc-mode
|
|
'calc-float-format
|
|
(list (cdr (assoc c '((?n . float) (?f . fix)
|
|
(?s . sci) (?e . eng))))
|
|
n))))
|
|
(setq fmt (replace-match "" t t fmt)))
|
|
(while (string-match "[DRFS]" fmt)
|
|
(setq modes (org-set-calc-mode (match-string 0 fmt)))
|
|
(setq fmt (replace-match "" t t fmt)))
|
|
(unless (string-match "\\S-" fmt)
|
|
(setq fmt nil))))
|
|
(if (and (not suppress-const) org-table-formula-use-constants)
|
|
(setq formula (org-table-formula-substitute-names formula)))
|
|
(setq orig (or (get-text-property 1 :orig-formula formula) "?"))
|
|
(while (> ndown 0)
|
|
(setq fields (org-split-string
|
|
(buffer-substring
|
|
(point-at-bol) (point-at-eol)) " *| *"))
|
|
(if org-table-formula-numbers-only
|
|
(setq fields (mapcar
|
|
(lambda (x) (number-to-string (string-to-number x)))
|
|
fields)))
|
|
(setq ndown (1- ndown))
|
|
(setq form (copy-sequence formula)
|
|
lispp (equal (substring form 0 2) "'("))
|
|
;; Insert the references to fields in same row
|
|
(while (string-match "\\$\\([0-9]+\\)?" form)
|
|
(setq n (if (match-beginning 1)
|
|
(string-to-number (match-string 1 form))
|
|
n0)
|
|
x (nth (1- n) fields))
|
|
(unless x (error "Invalid field specifier \"%s\""
|
|
(match-string 0 form)))
|
|
(if (equal x "") (setq x "0"))
|
|
(setq form (replace-match
|
|
(if lispp x (concat "(" x ")"))
|
|
t t form)))
|
|
;; Insert ranges in current column
|
|
(while (string-match "\\&[-I0-9]+" form)
|
|
(setq form (replace-match
|
|
(save-match-data
|
|
(org-table-get-vertical-vector (match-string 0 form)
|
|
nil n0))
|
|
t t form)))
|
|
;; (setq ev (calc-eval (cons form modes)
|
|
;; FIXME (if org-table-formula-numbers-only 'num)))
|
|
|
|
(if lispp
|
|
(setq ev (eval (eval (read form)))
|
|
ev (if (numberp ev) (number-to-string ev) ev))
|
|
(setq ev (calc-eval (cons form modes)
|
|
(if org-table-formula-numbers-only 'num))))
|
|
|
|
(when org-table-formula-debug
|
|
(with-output-to-temp-buffer "*Help*"
|
|
(princ (format "Substitution history of formula
|
|
Orig: %s
|
|
$xyz-> %s
|
|
$1-> %s\n" orig formula form))
|
|
(if (listp ev)
|
|
(princ (format " %s^\nError: %s"
|
|
(make-string (car ev) ?\-) (nth 1 ev)))
|
|
(princ (format "Result: %s\nFormat: %s\nFinal: %s"
|
|
ev (or fmt "NONE")
|
|
(if fmt (format fmt (string-to-number ev)) ev)))))
|
|
(shrink-window-if-larger-than-buffer (get-buffer-window "*Help*"))
|
|
(unless (and (interactive-p) (not ndown))
|
|
(unless (let (inhibit-redisplay)
|
|
(y-or-n-p "Debugging Formula. Continue to next? "))
|
|
(org-table-align)
|
|
(error "Abort"))
|
|
(delete-window (get-buffer-window "*Help*"))
|
|
(message "")))
|
|
(if (listp ev) (setq fmt nil ev "#ERROR"))
|
|
(org-table-justify-field-maybe
|
|
(if fmt (format fmt (string-to-number ev)) ev))
|
|
(if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]"))
|
|
(call-interactively 'org-return)
|
|
(setq ndown 0)))
|
|
(and down (org-table-maybe-recalculate-line))
|
|
(or suppress-align (and org-table-may-need-update
|
|
(org-table-align)))))
|
|
|
|
(defun org-table-recalculate (&optional all noalign)
|
|
"Recalculate the current table line by applying all stored formulas.
|
|
With prefix arg ALL, do this for all lines in the table."
|
|
(interactive "P")
|
|
(or (memq this-command org-recalc-commands)
|
|
(setq org-recalc-commands (cons this-command org-recalc-commands)))
|
|
(unless (org-at-table-p) (error "Not at a table"))
|
|
(org-table-get-specials)
|
|
(let* ((eqlist (sort (org-table-get-stored-formulas)
|
|
(lambda (a b) (string< (car a) (car b)))))
|
|
(inhibit-redisplay t)
|
|
(line-re org-table-dataline-regexp)
|
|
(thisline (+ (if (bolp) 1 0) (count-lines (point-min) (point))))
|
|
(thiscol (org-table-current-column))
|
|
beg end entry eqlnum eqlname eql (cnt 0) eq a name)
|
|
;; Insert constants in all formulas
|
|
(setq eqlist
|
|
(mapcar (lambda (x)
|
|
(setcdr x (org-table-formula-substitute-names (cdr x)))
|
|
x)
|
|
eqlist))
|
|
;; Split the equation list
|
|
(while (setq eq (pop eqlist))
|
|
(if (<= (string-to-char (car eq)) ?9)
|
|
(push eq eqlnum)
|
|
(push eq eqlname)))
|
|
(setq eqlnum (nreverse eqlnum) eqlname (nreverse eqlname))
|
|
(if all
|
|
(progn
|
|
(setq end (move-marker (make-marker) (1+ (org-table-end))))
|
|
(goto-char (setq beg (org-table-begin)))
|
|
(if (re-search-forward org-table-calculate-mark-regexp end t)
|
|
;; This is a table with marked lines, only compute selected lines
|
|
(setq line-re org-table-recalculate-regexp)
|
|
;; Move forward to the first non-header line
|
|
(if (and (re-search-forward org-table-dataline-regexp end t)
|
|
(re-search-forward org-table-hline-regexp end t)
|
|
(re-search-forward org-table-dataline-regexp end t))
|
|
(setq beg (match-beginning 0))
|
|
nil))) ;; just leave beg where it is
|
|
(setq beg (point-at-bol)
|
|
end (move-marker (make-marker) (1+ (point-at-eol)))))
|
|
(goto-char beg)
|
|
(and all (message "Re-applying formulas to full table..."))
|
|
(while (re-search-forward line-re end t)
|
|
(unless (string-match "^ *[_^!$] *$" (org-table-get-field 1))
|
|
;; Unprotected line, recalculate
|
|
(and all (message "Re-applying formulas to full table...(line %d)"
|
|
(setq cnt (1+ cnt))))
|
|
(setq org-last-recalc-line (org-current-line))
|
|
(setq eql eqlnum)
|
|
(while (setq entry (pop eql))
|
|
(goto-line org-last-recalc-line)
|
|
(org-table-goto-column (string-to-number (car entry)) nil 'force)
|
|
(org-table-eval-formula nil (cdr entry) 'noalign 'nocst 'nostore))))
|
|
(goto-line thisline)
|
|
(org-table-goto-column thiscol)
|
|
(or noalign (and org-table-may-need-update (org-table-align))
|
|
(and all (message "Re-applying formulas to %d lines...done" cnt)))
|
|
;; Now do the names fields
|
|
(while (setq eq (pop eqlname))
|
|
(setq name (car eq)
|
|
a (assoc name org-table-named-field-locations))
|
|
(when a
|
|
(message "Re-applying formula to named field: %s" name)
|
|
(goto-line (nth 1 a))
|
|
(org-table-goto-column (nth 2 a))
|
|
(org-table-eval-formula nil (cdr eq) 'noalign 'nocst 'nostore)))
|
|
;; back to initial position
|
|
(goto-line thisline)
|
|
(org-table-goto-column thiscol)
|
|
(or noalign (and org-table-may-need-update (org-table-align))
|
|
(and all (message "Re-applying formulas...done")))))
|
|
|
|
(defun org-table-formula-substitute-names (f)
|
|
"Replace $const with values in string F."
|
|
(let ((start 0) a n1 n2 nn1 nn2 s (f1 f))
|
|
;; First, check for column names
|
|
(while (setq start (string-match org-table-column-name-regexp f start))
|
|
(setq start (1+ start))
|
|
(setq a (assoc (match-string 1 f) org-table-column-names))
|
|
(setq f (replace-match (concat "$" (cdr a)) t t f)))
|
|
;; Expand ranges to vectors
|
|
(while (string-match "\\$\\([0-9]+\\)\\.\\.\\.?\\$\\([0-9]+\\)" f)
|
|
(setq n1 (string-to-number (match-string 1 f))
|
|
n2 (string-to-number (match-string 2 f))
|
|
nn1 (1+ (min n1 n2)) nn2 (max n1 n2)
|
|
s (concat "[($" (number-to-string (1- nn1)) ")"))
|
|
(loop for i from nn1 upto nn2 do
|
|
(setq s (concat s ",($" (int-to-string i) ")")))
|
|
(setq s (concat s "]"))
|
|
(if (< n2 n1) (setq s (concat "rev(" s ")")))
|
|
(setq f (replace-match s t t f)))
|
|
;; Parameters and constants
|
|
(setq start 0)
|
|
(while (setq start (string-match "\\$\\([a-zA-Z][a-zA-Z0-9]*\\)" f start))
|
|
(setq start (1+ start))
|
|
(if (setq a (save-match-data
|
|
(org-table-get-constant (match-string 1 f))))
|
|
(setq f (replace-match (concat "(" a ")") t t f))))
|
|
(if org-table-formula-debug
|
|
(put-text-property 0 (length f) :orig-formula f1 f))
|
|
f))
|
|
|
|
(defun org-table-get-constant (const)
|
|
"Find the value for a parameter or constant in a formula.
|
|
Parameters get priority."
|
|
(or (cdr (assoc const org-table-local-parameters))
|
|
(cdr (assoc const org-table-formula-constants))
|
|
(and (fboundp 'constants-get) (constants-get const))
|
|
"#UNDEFINED_NAME"))
|
|
|
|
(defvar org-edit-formulas-map (make-sparse-keymap))
|
|
(define-key org-edit-formulas-map "\C-c\C-c" 'org-finish-edit-formulas)
|
|
(define-key org-edit-formulas-map "\C-c\C-q" 'org-abort-edit-formulas)
|
|
(define-key org-edit-formulas-map "\C-c?" 'org-show-variable)
|
|
|
|
(defvar org-pos)
|
|
|
|
(defun org-table-edit-formulas ()
|
|
"Edit the formulas of the current table in a separate buffer."
|
|
(interactive)
|
|
(unless (org-at-table-p)
|
|
(error "Not at a table"))
|
|
(org-table-get-specials)
|
|
(let ((eql (org-table-get-stored-formulas))
|
|
(pos (move-marker (make-marker) (point)))
|
|
(wc (current-window-configuration))
|
|
entry loc s)
|
|
(switch-to-buffer-other-window "*Edit Formulas*")
|
|
(erase-buffer)
|
|
(fundamental-mode)
|
|
(set (make-local-variable 'org-pos) pos)
|
|
(set (make-local-variable 'org-window-configuration) wc)
|
|
(use-local-map org-edit-formulas-map)
|
|
(setq s "# Edit formulas and finish with `C-c C-c'.
|
|
# Use `C-u C-c C-c' to also appy them immediately to the entire table.
|
|
# Use `C-c ?' to get information about $name at point.
|
|
# To cancel editing, press `C-c C-q'.\n")
|
|
(put-text-property 0 (length s) 'face 'font-lock-comment-face s)
|
|
(insert s)
|
|
(while (setq entry (pop eql))
|
|
(when (setq loc (assoc (car entry) org-table-named-field-locations))
|
|
(setq s (format "# Named formula, referring to column %d in line %d\n"
|
|
(nth 2 loc) (nth 1 loc)))
|
|
(put-text-property 0 (length s) 'face 'font-lock-comment-face s)
|
|
(insert s))
|
|
(setq s (concat "$" (car entry) "=" (cdr entry) "\n"))
|
|
(remove-text-properties 0 (length s) '(face nil) s)
|
|
(insert s))
|
|
(goto-char (point-min))
|
|
(message "Edit formulas and finish with `C-c C-c'.")))
|
|
|
|
(defun org-show-variable ()
|
|
"Show the location/value of the $ expression at point."
|
|
(interactive)
|
|
(let (var (pos org-pos) (win (selected-window)) e)
|
|
(save-excursion
|
|
(or (looking-at "\\$") (skip-chars-backward "$a-zA-Z0-9"))
|
|
(if (looking-at "\\$\\([a-zA-Z0-9]+\\)")
|
|
(setq var (match-string 1))
|
|
(error "No variable at point")))
|
|
(cond
|
|
((setq e (assoc var org-table-named-field-locations))
|
|
(switch-to-buffer-other-window (marker-buffer pos))
|
|
(goto-line (nth 1 e))
|
|
(org-table-goto-column (nth 2 e))
|
|
(select-window win)
|
|
(message "Named field, column %d of line %d" (nth 2 e) (nth 1 e)))
|
|
((setq e (assoc var org-table-column-names))
|
|
(switch-to-buffer-other-window (marker-buffer pos))
|
|
(goto-char pos)
|
|
(goto-char (org-table-begin))
|
|
(if (re-search-forward (concat "^[ \t]*| *! *.*?| *\\(" var "\\) *|")
|
|
(org-table-end) t)
|
|
(progn
|
|
(goto-char (match-beginning 1))
|
|
(message "Named column (column %s)" (cdr e)))
|
|
(error "Column name not found"))
|
|
(select-window win))
|
|
((string-match "^[0-9]$" var)
|
|
;; column number
|
|
(switch-to-buffer-other-window (marker-buffer pos))
|
|
(goto-char pos)
|
|
(goto-char (org-table-begin))
|
|
(recenter 1)
|
|
(if (re-search-forward org-table-dataline-regexp
|
|
(org-table-end) t)
|
|
(progn
|
|
(goto-char (match-beginning 0))
|
|
(org-table-goto-column (string-to-number var))
|
|
(message "Column %s" var))
|
|
(error "Column name not found"))
|
|
(select-window win))
|
|
((setq e (assoc var org-table-local-parameters))
|
|
(switch-to-buffer-other-window (marker-buffer pos))
|
|
(goto-char pos)
|
|
(goto-char (org-table-begin))
|
|
(if (re-search-forward (concat "^[ \t]*| *\\$ *.*?| *\\(" var "=\\)") nil t)
|
|
(progn
|
|
(goto-char (match-beginning 1))
|
|
(message "Local parameter."))
|
|
(error "Parameter not found"))
|
|
(select-window win))
|
|
(t
|
|
(cond
|
|
((setq e (assoc var org-table-formula-constants))
|
|
(message "Constant: $%s=%s in `org-table-formula-constants'." var (cdr e)))
|
|
((setq e (and (fboundp 'constants-get) (constants-get var)))
|
|
(message "Constant: $%s=%s, retrieved from `constants.el'." var e))
|
|
(t (error "Undefined name $%s" var)))))))
|
|
|
|
(defun org-finish-edit-formulas (&optional arg)
|
|
"Parse the buffer for formula definitions and install them.
|
|
With prefix ARG, apply the new formulas to the table."
|
|
(interactive "P")
|
|
(let ((pos org-pos) eql)
|
|
(goto-char (point-min))
|
|
(while (re-search-forward "^\\$\\([a-zA-Z0-9]+\\) *= *\\(.*?\\) *$" nil t)
|
|
(push (cons (match-string 1) (match-string 2)) eql))
|
|
(set-window-configuration org-window-configuration)
|
|
(select-window (get-buffer-window (marker-buffer pos)))
|
|
(goto-char pos)
|
|
(unless (org-at-table-p)
|
|
(error "Lost table position - cannot install formulae"))
|
|
(org-table-store-formulas eql)
|
|
(move-marker pos nil)
|
|
(kill-buffer "*Edit Formulas*")
|
|
(if arg
|
|
(org-table-recalculate 'all)
|
|
(message "New formulas installed - press C-u C-c C-c to apply."))))
|
|
|
|
(defun org-abort-edit-formulas ()
|
|
"Abort editing formulas, without installing the changes."
|
|
(interactive)
|
|
(let ((pos org-pos))
|
|
(set-window-configuration org-window-configuration)
|
|
(select-window (get-buffer-window (marker-buffer pos)))
|
|
(goto-char pos)
|
|
(message "Formula editing aborted without installing changes")))
|
|
|
|
;;; The orgtbl minor mode
|
|
|
|
;; Define a minor mode which can be used in other modes in order to
|
|
;; integrate the org-mode table editor.
|
|
|
|
;; This is really a hack, because the org-mode table editor uses several
|
|
;; keys which normally belong to the major mode, for example the TAB and
|
|
;; RET keys. Here is how it works: The minor mode defines all the keys
|
|
;; necessary to operate the table editor, but wraps the commands into a
|
|
;; function which tests if the cursor is currently inside a table. If that
|
|
;; is the case, the table editor command is executed. However, when any of
|
|
;; those keys is used outside a table, the function uses `key-binding' to
|
|
;; look up if the key has an associated command in another currently active
|
|
;; keymap (minor modes, major mode, global), and executes that command.
|
|
;; There might be problems if any of the keys used by the table editor is
|
|
;; otherwise used as a prefix key.
|
|
|
|
;; Another challenge is that the key binding for TAB can be tab or \C-i,
|
|
;; likewise the binding for RET can be return or \C-m. Orgtbl-mode
|
|
;; addresses this by checking explicitly for both bindings.
|
|
|
|
;; The optimized version (see variable `orgtbl-optimized') takes over
|
|
;; all keys which are bound to `self-insert-command' in the *global map*.
|
|
;; Some modes bind other commands to simple characters, for example
|
|
;; AUCTeX binds the double quote to `Tex-insert-quote'. With orgtbl-mode
|
|
;; active, this binding is ignored inside tables and replaced with a
|
|
;; modified self-insert.
|
|
|
|
(defvar orgtbl-mode nil
|
|
"Variable controlling `orgtbl-mode', a minor mode enabling the `org-mode'
|
|
table editor in arbitrary modes.")
|
|
(make-variable-buffer-local 'orgtbl-mode)
|
|
|
|
(defvar orgtbl-mode-map (make-keymap)
|
|
"Keymap for `orgtbl-mode'.")
|
|
|
|
;;;###autoload
|
|
(defun turn-on-orgtbl ()
|
|
"Unconditionally turn on `orgtbl-mode'."
|
|
(orgtbl-mode 1))
|
|
|
|
;;;###autoload
|
|
(defun orgtbl-mode (&optional arg)
|
|
"The `org-mode' table editor as a minor mode for use in other modes."
|
|
(interactive)
|
|
(if (eq major-mode 'org-mode)
|
|
;; Exit without error, in case some hook functions calls this
|
|
;; by accident in org-mode.
|
|
(message "Orgtbl-mode is not useful in org-mode, command ignored")
|
|
(setq orgtbl-mode
|
|
(if arg (> (prefix-numeric-value arg) 0) (not orgtbl-mode)))
|
|
(if orgtbl-mode
|
|
(progn
|
|
(and (orgtbl-setup) (defun orgtbl-setup () nil))
|
|
;; Make sure we are first in minor-mode-map-alist
|
|
(let ((c (assq 'orgtbl-mode minor-mode-map-alist)))
|
|
(and c (setq minor-mode-map-alist
|
|
(cons c (delq c minor-mode-map-alist)))))
|
|
(set (make-local-variable (quote org-table-may-need-update)) t)
|
|
(org-add-hook 'before-change-functions 'org-before-change-function
|
|
nil 'local)
|
|
(set (make-local-variable 'org-old-auto-fill-inhibit-regexp)
|
|
auto-fill-inhibit-regexp)
|
|
(set (make-local-variable 'auto-fill-inhibit-regexp)
|
|
(if auto-fill-inhibit-regexp
|
|
(concat "\\([ \t]*|\\|" auto-fill-inhibit-regexp)
|
|
"[ \t]*|"))
|
|
(org-add-to-invisibility-spec '(org-cwidth))
|
|
(easy-menu-add orgtbl-mode-menu)
|
|
(run-hooks 'orgtbl-mode-hook))
|
|
(setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp)
|
|
(org-cleanup-narrow-column-properties)
|
|
(org-remove-from-invisibility-spec '(org-cwidth))
|
|
(remove-hook 'before-change-functions 'org-before-change-function t)
|
|
(easy-menu-remove orgtbl-mode-menu)
|
|
(force-mode-line-update 'all))))
|
|
|
|
(defun org-cleanup-narrow-column-properties ()
|
|
"Remove all properties related to narrow-column invisibility."
|
|
(let ((s 1))
|
|
(while (setq s (text-property-any s (point-max)
|
|
'display org-narrow-column-arrow))
|
|
(remove-text-properties s (1+ s) '(display t)))
|
|
(setq s 1)
|
|
(while (setq s (text-property-any s (point-max) 'org-cwidth 1))
|
|
(remove-text-properties s (1+ s) '(org-cwidth t)))
|
|
(setq s 1)
|
|
(while (setq s (text-property-any s (point-max) 'invisible 'org-cwidth))
|
|
(remove-text-properties s (1+ s) '(invisible t)))))
|
|
|
|
;; Install it as a minor mode.
|
|
(put 'orgtbl-mode :included t)
|
|
(put 'orgtbl-mode :menu-tag "Org Table Mode")
|
|
(add-minor-mode 'orgtbl-mode " OrgTbl" orgtbl-mode-map)
|
|
|
|
(defun orgtbl-make-binding (fun n &rest keys)
|
|
"Create a function for binding in the table minor mode.
|
|
FUN is the command to call inside a table. N is used to create a unique
|
|
command name. KEYS are keys that should be checked in for a command
|
|
to execute outside of tables."
|
|
(eval
|
|
(list 'defun
|
|
(intern (concat "orgtbl-hijacker-command-" (int-to-string n)))
|
|
'(arg)
|
|
(concat "In tables, run `" (symbol-name fun) "'.\n"
|
|
"Outside of tables, run the binding of `"
|
|
(mapconcat (lambda (x) (format "%s" x)) keys "' or `")
|
|
"'.")
|
|
'(interactive "p")
|
|
(list 'if
|
|
'(org-at-table-p)
|
|
(list 'call-interactively (list 'quote fun))
|
|
(list 'let '(orgtbl-mode)
|
|
(list 'call-interactively
|
|
(append '(or)
|
|
(mapcar (lambda (k)
|
|
(list 'key-binding k))
|
|
keys)
|
|
'('orgtbl-error))))))))
|
|
|
|
(defun orgtbl-error ()
|
|
"Error when there is no default binding for a table key."
|
|
(interactive)
|
|
(error "This key is has no function outside tables"))
|
|
|
|
(defun orgtbl-setup ()
|
|
"Setup orgtbl keymaps."
|
|
(let ((nfunc 0)
|
|
(bindings
|
|
(list
|
|
'([(meta shift left)] org-table-delete-column)
|
|
'([(meta left)] org-table-move-column-left)
|
|
'([(meta right)] org-table-move-column-right)
|
|
'([(meta shift right)] org-table-insert-column)
|
|
'([(meta shift up)] org-table-kill-row)
|
|
'([(meta shift down)] org-table-insert-row)
|
|
'([(meta up)] org-table-move-row-up)
|
|
'([(meta down)] org-table-move-row-down)
|
|
'("\C-c\C-w" org-table-cut-region)
|
|
'("\C-c\M-w" org-table-copy-region)
|
|
'("\C-c\C-y" org-table-paste-rectangle)
|
|
'("\C-c-" org-table-insert-hline)
|
|
; '([(shift tab)] org-table-previous-field)
|
|
'("\C-m" org-table-next-row)
|
|
(list (org-key 'S-return) 'org-table-copy-down)
|
|
'([(meta return)] org-table-wrap-region)
|
|
'("\C-c\C-q" org-table-wrap-region)
|
|
'("\C-c?" org-table-current-column)
|
|
'("\C-c " org-table-blank-field)
|
|
'("\C-c+" org-table-sum)
|
|
'("\C-c=" org-table-eval-formula)
|
|
'("\C-c'" org-table-edit-formulas)
|
|
'("\C-c`" org-table-edit-field)
|
|
'("\C-c*" org-table-recalculate)
|
|
'("\C-c|" org-table-create-or-convert-from-region)
|
|
'("\C-c^" org-table-sort-lines)
|
|
'([(control ?#)] org-table-rotate-recalc-marks)))
|
|
elt key fun cmd)
|
|
(while (setq elt (pop bindings))
|
|
(setq nfunc (1+ nfunc))
|
|
(setq key (car elt)
|
|
fun (nth 1 elt)
|
|
cmd (orgtbl-make-binding fun nfunc key))
|
|
(define-key orgtbl-mode-map key cmd))
|
|
;; Special treatment needed for TAB and RET
|
|
(define-key orgtbl-mode-map [(return)]
|
|
(orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m"))
|
|
(define-key orgtbl-mode-map "\C-m"
|
|
(orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)]))
|
|
(define-key orgtbl-mode-map [(tab)]
|
|
(orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i"))
|
|
(define-key orgtbl-mode-map "\C-i"
|
|
(orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)])))
|
|
(define-key orgtbl-mode-map "\C-i"
|
|
(orgtbl-make-binding 'orgtbl-tab 104 [(shift tab)]))
|
|
(define-key orgtbl-mode-map "\C-c\C-c"
|
|
(orgtbl-make-binding 'org-ctrl-c-ctrl-c 105 "\C-c\C-c"))
|
|
(when orgtbl-optimized
|
|
;; If the user wants maximum table support, we need to hijack
|
|
;; some standard editing functions
|
|
(org-remap orgtbl-mode-map
|
|
'self-insert-command 'orgtbl-self-insert-command
|
|
'delete-char 'org-delete-char
|
|
'delete-backward-char 'org-delete-backward-char)
|
|
(define-key orgtbl-mode-map "|" 'org-force-self-insert))
|
|
(easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu"
|
|
'("OrgTbl"
|
|
["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"]
|
|
["Next Field" org-cycle :active (org-at-table-p) :keys "TAB"]
|
|
["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"]
|
|
["Next Row" org-return :active (org-at-table-p) :keys "RET"]
|
|
"--"
|
|
["Blank Field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"]
|
|
["Edit Field" org-table-edit-field :active (org-at-table-p) :keys "C-c ` "]
|
|
["Copy Field from Above"
|
|
org-table-copy-down :active (org-at-table-p) :keys "S-RET"]
|
|
"--"
|
|
("Column"
|
|
["Move Column Left" org-metaleft :active (org-at-table-p) :keys "M-<left>"]
|
|
["Move Column Right" org-metaright :active (org-at-table-p) :keys "M-<right>"]
|
|
["Delete Column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-<left>"]
|
|
["Insert Column" org-shiftmetaright :active (org-at-table-p) :keys "M-S-<right>"]
|
|
"--"
|
|
["Enable Narrowing" (setq org-table-limit-column-width (not org-table-limit-column-width)) :active (org-at-table-p) :selected org-table-limit-column-width :style toggle])
|
|
("Row"
|
|
["Move Row Up" org-metaup :active (org-at-table-p) :keys "M-<up>"]
|
|
["Move Row Down" org-metadown :active (org-at-table-p) :keys "M-<down>"]
|
|
["Delete Row" org-shiftmetaup :active (org-at-table-p) :keys "M-S-<up>"]
|
|
["Insert Row" org-shiftmetadown :active (org-at-table-p) :keys "M-S-<down>"]
|
|
["Sort lines in region" org-table-sort-lines (org-at-table-p) :keys "C-c ^"]
|
|
"--"
|
|
["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"])
|
|
("Rectangle"
|
|
["Copy Rectangle" org-copy-special :active (org-at-table-p)]
|
|
["Cut Rectangle" org-cut-special :active (org-at-table-p)]
|
|
["Paste Rectangle" org-paste-special :active (org-at-table-p)]
|
|
["Fill Rectangle" org-table-wrap-region :active (org-at-table-p)])
|
|
"--"
|
|
["Set Column Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="]
|
|
["Set Named Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
|
|
["Edit Formulas" org-table-edit-formulas :active (org-at-table-p) :keys "C-c '"]
|
|
["Recalculate line" org-table-recalculate :active (org-at-table-p) :keys "C-c *"]
|
|
["Recalculate all" (org-table-recalculate '(4)) :active (org-at-table-p) :keys "C-u C-c *"]
|
|
["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"]
|
|
["Sum Column/Rectangle" org-table-sum
|
|
:active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"]
|
|
["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"]
|
|
["Debug Formulas"
|
|
(setq org-table-formula-debug (not org-table-formula-debug))
|
|
:style toggle :selected org-table-formula-debug]
|
|
))
|
|
t)
|
|
|
|
(defun orgtbl-tab (arg)
|
|
"Justification and field motion for `orgtbl-mode'."
|
|
(interactive "P")
|
|
(if arg (org-table-edit-field t)
|
|
(org-table-justify-field-maybe)
|
|
(org-table-next-field)))
|
|
|
|
(defun orgtbl-ret ()
|
|
"Justification and field motion for `orgtbl-mode'."
|
|
(interactive)
|
|
(org-table-justify-field-maybe)
|
|
(org-table-next-row))
|
|
|
|
(defun orgtbl-self-insert-command (N)
|
|
"Like `self-insert-command', use overwrite-mode for whitespace in tables.
|
|
If the cursor is in a table looking at whitespace, the whitespace is
|
|
overwritten, and the table is not marked as requiring realignment."
|
|
(interactive "p")
|
|
(if (and (org-at-table-p)
|
|
(or
|
|
(and org-table-auto-blank-field
|
|
(member last-command
|
|
'(orgtbl-hijacker-command-100
|
|
orgtbl-hijacker-command-101
|
|
orgtbl-hijacker-command-102
|
|
orgtbl-hijacker-command-103
|
|
orgtbl-hijacker-command-104
|
|
orgtbl-hijacker-command-105))
|
|
(org-table-blank-field))
|
|
t)
|
|
(eq N 1)
|
|
(looking-at "[^|\n]* +|"))
|
|
(let (org-table-may-need-update)
|
|
(goto-char (1- (match-end 0)))
|
|
(delete-backward-char 1)
|
|
(goto-char (match-beginning 0))
|
|
(self-insert-command N))
|
|
(setq org-table-may-need-update t)
|
|
(let (orgtbl-mode)
|
|
(call-interactively (key-binding (vector last-input-event))))))
|
|
|
|
(defun org-force-self-insert (N)
|
|
"Needed to enforce self-insert under remapping."
|
|
(interactive "p")
|
|
(self-insert-command N))
|
|
|
|
;;; Exporting
|
|
|
|
(defconst org-level-max 20)
|
|
|
|
(defvar org-export-html-preamble nil
|
|
"Preamble, to be inserted just after <body>. Set by publishing functions.")
|
|
(defvar org-export-html-postamble nil
|
|
"Preamble, to be inserted just before </body>. Set by publishing functions.")
|
|
(defvar org-export-html-auto-preamble t
|
|
"Should default preamble be inserted? Set by publishing functions.")
|
|
(defvar org-export-html-auto-postamble t
|
|
"Should default postamble be inserted? Set by publishing functions.")
|
|
|
|
(defconst org-export-plist-vars
|
|
'((:language . org-export-default-language)
|
|
(:headline-levels . org-export-headline-levels)
|
|
(:section-numbers . org-export-with-section-numbers)
|
|
(:table-of-contents . org-export-with-toc)
|
|
(:emphasize . org-export-with-emphasize)
|
|
(:sub-superscript . org-export-with-sub-superscripts)
|
|
(:TeX-macros . org-export-with-TeX-macros)
|
|
(:fixed-width . org-export-with-fixed-width)
|
|
(:timestamps . org-export-with-timestamps)
|
|
(:tables . org-export-with-tables)
|
|
(:table-auto-headline . org-export-highlight-first-table-line)
|
|
(:style . org-export-html-style)
|
|
(:convert-org-links . org-export-html-link-org-files-as-html)
|
|
(:inline-images . org-export-html-inline-images)
|
|
(:expand-quoted-html . org-export-html-expand)
|
|
(:timestamp . org-export-html-with-timestamp)
|
|
(:publishing-directory . org-export-publishing-directory)
|
|
(:preamble . org-export-html-preamble)
|
|
(:postamble . org-export-html-postamble)
|
|
(:auto-preamble . org-export-html-auto-preamble)
|
|
(:auto-postamble . org-export-html-auto-postamble)
|
|
(:author . user-full-name)
|
|
(:email . user-mail-address)))
|
|
|
|
(defun org-default-export-plist ()
|
|
"Return the property list with default settings for the export variables."
|
|
(let ((l org-export-plist-vars) rtn e)
|
|
(while (setq e (pop l))
|
|
(setq rtn (cons (car e) (cons (symbol-value (cdr e)) rtn))))
|
|
rtn))
|
|
|
|
(defun org-infile-export-plist ()
|
|
"Return the property list with file-local settings for export."
|
|
(save-excursion
|
|
(goto-char 0)
|
|
(let ((re (org-make-options-regexp
|
|
'("TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE")))
|
|
(text nil)
|
|
p key val text options)
|
|
(while (re-search-forward re nil t)
|
|
(setq key (org-match-string-no-properties 1)
|
|
val (org-match-string-no-properties 2))
|
|
(cond
|
|
((string-equal key "TITLE") (setq p (plist-put p :title val)))
|
|
((string-equal key "AUTHOR")(setq p (plist-put p :author val)))
|
|
((string-equal key "EMAIL") (setq p (plist-put p :email val)))
|
|
((string-equal key "LANGUAGE") (setq p (plist-put p :language val)))
|
|
((string-equal key "TEXT")
|
|
(setq text (if text (concat text "\n" val) val)))
|
|
((string-equal key "OPTIONS") (setq options val))))
|
|
(setq p (plist-put p :text text))
|
|
(when options
|
|
(let ((op '(("H" . :headline-levels)
|
|
("num" . :section-numbers)
|
|
("toc" . :table-of-contents)
|
|
("\\n" . :preserve-breaks)
|
|
("@" . :expand-quoted-html)
|
|
(":" . :fixed-width)
|
|
("|" . :tables)
|
|
("^" . :sub-superscript)
|
|
("*" . :emphasize)
|
|
("TeX" . :TeX-macros)))
|
|
o)
|
|
(while (setq o (pop op))
|
|
(if (string-match (concat (regexp-quote (car o))
|
|
":\\([^ \t\n\r;,.]*\\)")
|
|
options)
|
|
(setq p (plist-put p (cdr o)
|
|
(car (read-from-string
|
|
(match-string 1 options)))))))))
|
|
p)))
|
|
|
|
(defun org-combine-plists (&rest plists)
|
|
"Create a single property list from all plists in PLISTS.
|
|
The process starts by copying the last list, and then setting properties
|
|
from the other lists. Settings in the first list are the most significant
|
|
ones and overrule settings in the other lists."
|
|
(let ((rtn (copy-sequence (pop plists)))
|
|
p v ls)
|
|
(while plists
|
|
(setq ls (pop plists))
|
|
(while ls
|
|
(setq p (pop ls) v (pop ls))
|
|
(setq rtn (plist-put rtn p v))))
|
|
rtn))
|
|
|
|
(defun org-export-find-first-heading-line (list)
|
|
"Remove all lines from LIST which are before the first headline."
|
|
(let ((orig-list list)
|
|
(re (concat "^" outline-regexp)))
|
|
(while (and list
|
|
(not (string-match re (car list))))
|
|
(pop list))
|
|
(or list orig-list)))
|
|
|
|
(defun org-skip-comments (lines)
|
|
"Skip lines starting with \"#\" and subtrees starting with COMMENT."
|
|
(let ((re1 (concat "^\\(\\*+\\)[ \t]+" org-comment-string))
|
|
(re2 "^\\(\\*+\\)[ \t\n\r]")
|
|
rtn line level)
|
|
(while (setq line (pop lines))
|
|
(cond
|
|
((and (string-match re1 line)
|
|
(setq level (- (match-end 1) (match-beginning 1))))
|
|
;; Beginning of a COMMENT subtree. Skip it.
|
|
(while (and (setq line (pop lines))
|
|
(or (not (string-match re2 line))
|
|
(> (- (match-end 1) (match-beginning 1)) level))))
|
|
(setq lines (cons line lines)))
|
|
((string-match "^#" line)
|
|
;; an ordinary comment line
|
|
)
|
|
((and org-export-table-remove-special-lines
|
|
(string-match "^[ \t]*| *[!_^] *|" line))
|
|
;; a special table line that should be removed
|
|
)
|
|
(t (setq rtn (cons line rtn)))))
|
|
(nreverse rtn)))
|
|
|
|
;; ASCII
|
|
|
|
(defconst org-ascii-underline '(?\$ ?\# ?^ ?\~ ?\= ?\-)
|
|
"Characters for underlining headings in ASCII export.")
|
|
|
|
(defconst org-html-entities
|
|
'(("nbsp")
|
|
("iexcl")
|
|
("cent")
|
|
("pound")
|
|
("curren")
|
|
("yen")
|
|
("brvbar")
|
|
("sect")
|
|
("uml")
|
|
("copy")
|
|
("ordf")
|
|
("laquo")
|
|
("not")
|
|
("shy")
|
|
("reg")
|
|
("macr")
|
|
("deg")
|
|
("plusmn")
|
|
("sup2")
|
|
("sup3")
|
|
("acute")
|
|
("micro")
|
|
("para")
|
|
("middot")
|
|
("odot"."o")
|
|
("star"."*")
|
|
("cedil")
|
|
("sup1")
|
|
("ordm")
|
|
("raquo")
|
|
("frac14")
|
|
("frac12")
|
|
("frac34")
|
|
("iquest")
|
|
("Agrave")
|
|
("Aacute")
|
|
("Acirc")
|
|
("Atilde")
|
|
("Auml")
|
|
("Aring") ("AA"."Å")
|
|
("AElig")
|
|
("Ccedil")
|
|
("Egrave")
|
|
("Eacute")
|
|
("Ecirc")
|
|
("Euml")
|
|
("Igrave")
|
|
("Iacute")
|
|
("Icirc")
|
|
("Iuml")
|
|
("ETH")
|
|
("Ntilde")
|
|
("Ograve")
|
|
("Oacute")
|
|
("Ocirc")
|
|
("Otilde")
|
|
("Ouml")
|
|
("times")
|
|
("Oslash")
|
|
("Ugrave")
|
|
("Uacute")
|
|
("Ucirc")
|
|
("Uuml")
|
|
("Yacute")
|
|
("THORN")
|
|
("szlig")
|
|
("agrave")
|
|
("aacute")
|
|
("acirc")
|
|
("atilde")
|
|
("auml")
|
|
("aring")
|
|
("aelig")
|
|
("ccedil")
|
|
("egrave")
|
|
("eacute")
|
|
("ecirc")
|
|
("euml")
|
|
("igrave")
|
|
("iacute")
|
|
("icirc")
|
|
("iuml")
|
|
("eth")
|
|
("ntilde")
|
|
("ograve")
|
|
("oacute")
|
|
("ocirc")
|
|
("otilde")
|
|
("ouml")
|
|
("divide")
|
|
("oslash")
|
|
("ugrave")
|
|
("uacute")
|
|
("ucirc")
|
|
("uuml")
|
|
("yacute")
|
|
("thorn")
|
|
("yuml")
|
|
("fnof")
|
|
("Alpha")
|
|
("Beta")
|
|
("Gamma")
|
|
("Delta")
|
|
("Epsilon")
|
|
("Zeta")
|
|
("Eta")
|
|
("Theta")
|
|
("Iota")
|
|
("Kappa")
|
|
("Lambda")
|
|
("Mu")
|
|
("Nu")
|
|
("Xi")
|
|
("Omicron")
|
|
("Pi")
|
|
("Rho")
|
|
("Sigma")
|
|
("Tau")
|
|
("Upsilon")
|
|
("Phi")
|
|
("Chi")
|
|
("Psi")
|
|
("Omega")
|
|
("alpha")
|
|
("beta")
|
|
("gamma")
|
|
("delta")
|
|
("epsilon")
|
|
("varepsilon"."ε")
|
|
("zeta")
|
|
("eta")
|
|
("theta")
|
|
("iota")
|
|
("kappa")
|
|
("lambda")
|
|
("mu")
|
|
("nu")
|
|
("xi")
|
|
("omicron")
|
|
("pi")
|
|
("rho")
|
|
("sigmaf") ("varsigma"."ς")
|
|
("sigma")
|
|
("tau")
|
|
("upsilon")
|
|
("phi")
|
|
("chi")
|
|
("psi")
|
|
("omega")
|
|
("thetasym") ("vartheta"."ϑ")
|
|
("upsih")
|
|
("piv")
|
|
("bull") ("bullet"."•")
|
|
("hellip") ("dots"."…")
|
|
("prime")
|
|
("Prime")
|
|
("oline")
|
|
("frasl")
|
|
("weierp")
|
|
("image")
|
|
("real")
|
|
("trade")
|
|
("alefsym")
|
|
("larr") ("leftarrow"."←") ("gets"."←")
|
|
("uarr") ("uparrow"."↑")
|
|
("rarr") ("to"."→") ("rightarrow"."→")
|
|
("darr")("downarrow"."↓")
|
|
("harr") ("leftrightarrow"."↔")
|
|
("crarr") ("hookleftarrow"."↵") ; has round hook, not quite CR
|
|
("lArr") ("Leftarrow"."⇐")
|
|
("uArr") ("Uparrow"."⇑")
|
|
("rArr") ("Rightarrow"."⇒")
|
|
("dArr") ("Downarrow"."⇓")
|
|
("hArr") ("Leftrightarrow"."⇔")
|
|
("forall")
|
|
("part") ("partial"."∂")
|
|
("exist") ("exists"."∃")
|
|
("empty") ("emptyset"."∅")
|
|
("nabla")
|
|
("isin") ("in"."∈")
|
|
("notin")
|
|
("ni")
|
|
("prod")
|
|
("sum")
|
|
("minus")
|
|
("lowast") ("ast"."∗")
|
|
("radic")
|
|
("prop") ("proptp"."∝")
|
|
("infin") ("infty"."∞")
|
|
("ang") ("angle"."∠")
|
|
("and") ("vee"."∧")
|
|
("or") ("wedge"."∨")
|
|
("cap")
|
|
("cup")
|
|
("int")
|
|
("there4")
|
|
("sim")
|
|
("cong") ("simeq"."≅")
|
|
("asymp")("approx"."≈")
|
|
("ne") ("neq"."≠")
|
|
("equiv")
|
|
("le")
|
|
("ge")
|
|
("sub") ("subset"."⊂")
|
|
("sup") ("supset"."⊃")
|
|
("nsub")
|
|
("sube")
|
|
("supe")
|
|
("oplus")
|
|
("otimes")
|
|
("perp")
|
|
("sdot") ("cdot"."⋅")
|
|
("lceil")
|
|
("rceil")
|
|
("lfloor")
|
|
("rfloor")
|
|
("lang")
|
|
("rang")
|
|
("loz") ("Diamond"."◊")
|
|
("spades") ("spadesuit"."♠")
|
|
("clubs") ("clubsuit"."♣")
|
|
("hearts") ("diamondsuit"."♥")
|
|
("diams") ("diamondsuit"."♦")
|
|
("quot")
|
|
("amp")
|
|
("lt")
|
|
("gt")
|
|
("OElig")
|
|
("oelig")
|
|
("Scaron")
|
|
("scaron")
|
|
("Yuml")
|
|
("circ")
|
|
("tilde")
|
|
("ensp")
|
|
("emsp")
|
|
("thinsp")
|
|
("zwnj")
|
|
("zwj")
|
|
("lrm")
|
|
("rlm")
|
|
("ndash")
|
|
("mdash")
|
|
("lsquo")
|
|
("rsquo")
|
|
("sbquo")
|
|
("ldquo")
|
|
("rdquo")
|
|
("bdquo")
|
|
("dagger")
|
|
("Dagger")
|
|
("permil")
|
|
("lsaquo")
|
|
("rsaquo")
|
|
("euro")
|
|
|
|
("arccos"."arccos")
|
|
("arcsin"."arcsin")
|
|
("arctan"."arctan")
|
|
("arg"."arg")
|
|
("cos"."cos")
|
|
("cosh"."cosh")
|
|
("cot"."cot")
|
|
("coth"."coth")
|
|
("csc"."csc")
|
|
("deg"."deg")
|
|
("det"."det")
|
|
("dim"."dim")
|
|
("exp"."exp")
|
|
("gcd"."gcd")
|
|
("hom"."hom")
|
|
("inf"."inf")
|
|
("ker"."ker")
|
|
("lg"."lg")
|
|
("lim"."lim")
|
|
("liminf"."liminf")
|
|
("limsup"."limsup")
|
|
("ln"."ln")
|
|
("log"."log")
|
|
("max"."max")
|
|
("min"."min")
|
|
("Pr"."Pr")
|
|
("sec"."sec")
|
|
("sin"."sin")
|
|
("sinh"."sinh")
|
|
("sup"."sup")
|
|
("tan"."tan")
|
|
("tanh"."tanh")
|
|
)
|
|
"Entities for TeX->HTML translation.
|
|
Entries can be like (\"ent\"), in which case \"\\ent\" will be translated to
|
|
\"&ent;\". An entry can also be a dotted pair like (\"ent\".\"&other;\").
|
|
In that case, \"\\ent\" will be translated to \"&other;\".
|
|
The list contains HTML entities for Latin-1, Greek and other symbols.
|
|
It is supplemented by a number of commonly used TeX macros with appropriate
|
|
translations. There is currently no way for users to extend this.")
|
|
|
|
(defun org-cleaned-string-for-export (string)
|
|
"Cleanup a buffer substring so that links can be created safely."
|
|
(interactive)
|
|
(let* ((cb (current-buffer))
|
|
(re-radio (and org-target-link-regexp
|
|
(concat "\\([^<]\\)\\(" org-target-link-regexp "\\)")))
|
|
(re-plain-link (concat "\\([^[<]\\)" org-plain-link-re))
|
|
(re-angle-link (concat "\\([^[]\\)" org-angle-link-re))
|
|
rtn)
|
|
(save-excursion
|
|
(set-buffer (get-buffer-create " org-mode-tmp"))
|
|
(erase-buffer)
|
|
(insert string)
|
|
(org-mode)
|
|
;; Find targets in comments and move them out of comments,
|
|
;; but mark them as targets that should be invisible
|
|
(goto-char (point-min))
|
|
(while (re-search-forward "^#.*?\\(<<<?[^>\r\n]+>>>?\\).*" nil t)
|
|
(replace-match "\\1(INVISIBLE)"))
|
|
;; Find matches for radio targets and turn them into internal links
|
|
(goto-char (point-min))
|
|
(when re-radio
|
|
(while (re-search-forward re-radio nil t)
|
|
(replace-match "\\1[[\\2]]")))
|
|
;; Find all links that contain a newline and put them into a single line
|
|
(goto-char (point-min))
|
|
(while (re-search-forward "\\(\\(\\[\\|\\]\\)\\[[^]]*?\\)[ \t]*\n[ \t]*\\([^]]*\\]\\(\\[\\|\\]\\)\\)" nil t)
|
|
(replace-match "\\1 \\3")
|
|
(goto-char (match-beginning 0)))
|
|
;; Normalize links: Convert angle and plain links into bracket links
|
|
(goto-char (point-min))
|
|
(while (re-search-forward re-plain-link nil t)
|
|
(replace-match
|
|
(concat
|
|
(match-string 1) "[[" (match-string 2) ":" (match-string 3) "]]")
|
|
t t))
|
|
(goto-char (point-min))
|
|
(while (re-search-forward re-angle-link nil t)
|
|
(replace-match
|
|
(concat
|
|
(match-string 1) "[[" (match-string 2) ":" (match-string 3) "]]")
|
|
t t))
|
|
|
|
;; Remove comments
|
|
(goto-char (point-min))
|
|
(while (re-search-forward "^#.*\n?" nil t)
|
|
(replace-match ""))
|
|
(setq rtn (buffer-string)))
|
|
(kill-buffer " org-mode-tmp")
|
|
rtn))
|
|
|
|
(defun org-solidify-link-text (s &optional alist)
|
|
"Take link text and make a safe target out of it."
|
|
(save-match-data
|
|
(let* ((rtn
|
|
(mapconcat
|
|
'identity
|
|
(org-split-string s "[ \t\r\n]+") "--"))
|
|
(a (assoc rtn alist)))
|
|
(or (cdr a) rtn))))
|
|
|
|
(defun org-convert-to-odd-levels ()
|
|
"Convert an org-mode file with all levels allowed to one with odd levels.
|
|
This will leave level 1 alone, convert level 2 to level 3, level 3 to
|
|
level 5 etc."
|
|
(interactive)
|
|
(when (yes-or-no-p "Are you sure you want to globally change levels to odd? ")
|
|
(let ((org-odd-levels-only nil) n)
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(while (re-search-forward "^\\*\\*+" nil t)
|
|
(setq n (1- (length (match-string 0))))
|
|
(while (>= (setq n (1- n)) 0)
|
|
(org-demote))
|
|
(end-of-line 1))))))
|
|
|
|
|
|
(defun org-convert-to-oddeven-levels ()
|
|
"Convert an org-mode file with only odd levels to one with odd and even levels.
|
|
This promotes level 3 to level 2, level 5 to level 3 etc. If the file contains a
|
|
section with an even level, conversion would destroy the structure of the file. An error
|
|
is signaled in this case."
|
|
(interactive)
|
|
(goto-char (point-min))
|
|
;; First check if there are no even levels
|
|
(when (re-search-forward "^\\(\\*\\*\\)+[^*]" nil t)
|
|
(org-show-hierarchy-above)
|
|
(error "Not all levels are odd in this file. Conversion not possible."))
|
|
(when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ")
|
|
(let ((org-odd-levels-only nil) n)
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(while (re-search-forward "^\\*\\*+" nil t)
|
|
(setq n (/ (length (match-string 0)) 2))
|
|
(while (>= (setq n (1- n)) 0)
|
|
(org-promote))
|
|
(end-of-line 1))))))
|
|
|
|
(defun org-tr-level (n)
|
|
"Make N odd if required."
|
|
(if org-odd-levels-only (1+ (/ n 2)) n))
|
|
|
|
(defvar org-last-level nil) ; dynamically scoped variable
|
|
|
|
(defun org-export-as-ascii (arg)
|
|
"Export the outline as a pretty ASCII file.
|
|
If there is an active region, export only the region.
|
|
The prefix ARG specifies how many levels of the outline should become
|
|
underlined headlines. The default is 3."
|
|
(interactive "P")
|
|
(setq-default org-todo-line-regexp org-todo-line-regexp)
|
|
(let* ((opt-plist (org-combine-plists (org-default-export-plist)
|
|
(org-infile-export-plist)))
|
|
(region
|
|
(buffer-substring
|
|
(if (org-region-active-p) (region-beginning) (point-min))
|
|
(if (org-region-active-p) (region-end) (point-max))))
|
|
(lines (org-export-find-first-heading-line
|
|
(org-skip-comments
|
|
(org-split-string
|
|
(org-cleaned-string-for-export region)
|
|
"[\r\n]"))))
|
|
(org-startup-with-deadline-check nil)
|
|
(level 0) line txt
|
|
(umax nil)
|
|
(case-fold-search nil)
|
|
(filename (concat (file-name-as-directory
|
|
(plist-get opt-plist :publishing-directory))
|
|
(file-name-sans-extension
|
|
(file-name-nondirectory buffer-file-name))
|
|
".txt"))
|
|
(buffer (find-file-noselect filename))
|
|
(levels-open (make-vector org-level-max nil))
|
|
(odd org-odd-levels-only)
|
|
(date (format-time-string "%Y/%m/%d" (current-time)))
|
|
(time (format-time-string "%X" (org-current-time)))
|
|
(author (plist-get opt-plist :author))
|
|
(title (or (plist-get opt-plist :title)
|
|
(file-name-sans-extension
|
|
(file-name-nondirectory buffer-file-name))))
|
|
(options nil)
|
|
(email (plist-get opt-plist :email))
|
|
(language (plist-get opt-plist :language))
|
|
(text nil)
|
|
(todo nil)
|
|
(lang-words nil))
|
|
|
|
(setq org-last-level 1)
|
|
(org-init-section-numbers)
|
|
|
|
(find-file-noselect filename)
|
|
|
|
(setq lang-words (or (assoc language org-export-language-setup)
|
|
(assoc "en" org-export-language-setup)))
|
|
(if org-export-ascii-show-new-buffer
|
|
(switch-to-buffer-other-window buffer)
|
|
(set-buffer buffer))
|
|
(erase-buffer)
|
|
(fundamental-mode)
|
|
;; create local variables for all options, to make sure all called
|
|
;; functions get the correct information
|
|
(mapcar (lambda (x)
|
|
(set (make-local-variable (cdr x))
|
|
(plist-get opt-plist (car x))))
|
|
org-export-plist-vars)
|
|
(set (make-local-variable 'org-odd-levels-only) odd)
|
|
(setq umax (if arg (prefix-numeric-value arg)
|
|
org-export-headline-levels))
|
|
|
|
;; File header
|
|
(if title (org-insert-centered title ?=))
|
|
(insert "\n")
|
|
(if (or author email)
|
|
(insert (concat (nth 1 lang-words) ": " (or author "")
|
|
(if email (concat " <" email ">") "")
|
|
"\n")))
|
|
(if (and date time)
|
|
(insert (concat (nth 2 lang-words) ": " date " " time "\n")))
|
|
(if text (insert (concat (org-html-expand-for-ascii text) "\n\n")))
|
|
|
|
(insert "\n\n")
|
|
|
|
(if org-export-with-toc
|
|
(progn
|
|
(insert (nth 3 lang-words) "\n"
|
|
(make-string (length (nth 3 lang-words)) ?=) "\n")
|
|
(mapcar '(lambda (line)
|
|
(if (string-match org-todo-line-regexp
|
|
line)
|
|
;; This is a headline
|
|
(progn
|
|
(setq level (- (match-end 1) (match-beginning 1))
|
|
level (org-tr-level level)
|
|
txt (match-string 3 line)
|
|
todo
|
|
(or (and org-export-mark-todo-in-toc
|
|
(match-beginning 2)
|
|
(not (equal (match-string 2 line)
|
|
org-done-string)))
|
|
; TODO, not DONE
|
|
(and org-export-mark-todo-in-toc
|
|
(= level umax)
|
|
(org-search-todo-below
|
|
line lines level))))
|
|
(setq txt (org-html-expand-for-ascii txt))
|
|
|
|
(if org-export-with-section-numbers
|
|
(setq txt (concat (org-section-number level)
|
|
" " txt)))
|
|
(if (<= level umax)
|
|
(progn
|
|
(insert
|
|
(make-string (* (1- level) 4) ?\ )
|
|
(format (if todo "%s (*)\n" "%s\n") txt))
|
|
(setq org-last-level level))
|
|
))))
|
|
lines)))
|
|
|
|
(org-init-section-numbers)
|
|
(while (setq line (pop lines))
|
|
;; Remove the quoted HTML tags.
|
|
(setq line (org-html-expand-for-ascii line))
|
|
;; Remove targets
|
|
(while (string-match "<<<?[^<>]*>>>?[ \t]*\n?" line)
|
|
(setq line (replace-match "" t t line)))
|
|
;; Replace internal links
|
|
(while (string-match org-bracket-link-regexp line)
|
|
(setq line (replace-match
|
|
(if (match-end 3) "[\\3]" "[\\1]")
|
|
t nil line)))
|
|
(cond
|
|
((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line)
|
|
;; a Headline
|
|
(setq level (org-tr-level (- (match-end 1) (match-beginning 1)))
|
|
txt (match-string 2 line))
|
|
(org-ascii-level-start level txt umax))
|
|
(t (insert line "\n"))))
|
|
(normal-mode)
|
|
(save-buffer)
|
|
;; remove display and invisible chars
|
|
(let (beg end s)
|
|
(goto-char (point-min))
|
|
(while (setq beg (next-single-property-change (point) 'display))
|
|
(setq end (next-single-property-change beg 'display))
|
|
(delete-region beg end)
|
|
(goto-char beg)
|
|
(insert "=>"))
|
|
(goto-char (point-min))
|
|
(while (setq beg (next-single-property-change (point) 'org-cwidth))
|
|
(setq end (next-single-property-change beg 'org-cwidth))
|
|
(delete-region beg end)
|
|
(goto-char beg)))
|
|
(goto-char (point-min))))
|
|
|
|
(defun org-search-todo-below (line lines level)
|
|
"Search the subtree below LINE for any TODO entries."
|
|
(let ((rest (cdr (memq line lines)))
|
|
(re org-todo-line-regexp)
|
|
line lv todo)
|
|
(catch 'exit
|
|
(while (setq line (pop rest))
|
|
(if (string-match re line)
|
|
(progn
|
|
(setq lv (- (match-end 1) (match-beginning 1))
|
|
todo (and (match-beginning 2)
|
|
(not (equal (match-string 2 line)
|
|
org-done-string))))
|
|
; TODO, not DONE
|
|
(if (<= lv level) (throw 'exit nil))
|
|
(if todo (throw 'exit t))))))))
|
|
|
|
;; FIXME: Try to handle <b> and <i> as faces via text properties.
|
|
;; We could also implement *bold*,/italic/ and _underline_ for ASCII export
|
|
(defun org-html-expand-for-ascii (line)
|
|
"Handle quoted HTML for ASCII export."
|
|
(if org-export-html-expand
|
|
(while (string-match "@<[^<>\n]*>" line)
|
|
;; We just remove the tags for now.
|
|
(setq line (replace-match "" nil nil line))))
|
|
line)
|
|
|
|
(defun org-insert-centered (s &optional underline)
|
|
"Insert the string S centered and underline it with character UNDERLINE."
|
|
(let ((ind (max (/ (- 80 (string-width s)) 2) 0)))
|
|
(insert (make-string ind ?\ ) s "\n")
|
|
(if underline
|
|
(insert (make-string ind ?\ )
|
|
(make-string (string-width s) underline)
|
|
"\n"))))
|
|
|
|
(defun org-ascii-level-start (level title umax)
|
|
"Insert a new level in ASCII export."
|
|
(let (char)
|
|
(if (> level umax)
|
|
(insert (make-string (* 2 (- level umax 1)) ?\ ) "* " title "\n")
|
|
(if (or (not (equal (char-before) ?\n))
|
|
(not (equal (char-before (1- (point))) ?\n)))
|
|
(insert "\n"))
|
|
(setq char (nth (- umax level) (reverse org-ascii-underline)))
|
|
(if org-export-with-section-numbers
|
|
(setq title (concat (org-section-number level) " " title)))
|
|
(insert title "\n" (make-string (string-width title) char) "\n"))))
|
|
|
|
(defun org-export-visible (type arg)
|
|
"Create a copy of the visible part of the current buffer, and export it.
|
|
The copy is created in a temporary buffer and removed after use.
|
|
TYPE is the final key (as a string) of the `C-c C-x' key sequence that will
|
|
run the export command - in interactive use, the command prompts for this
|
|
key. As a special case, if the you type SPC at the prompt, the temporary
|
|
org-mode file will not be removed but presented to you so that you can
|
|
continue to use it. The prefix arg ARG is passed through to the exporting
|
|
command."
|
|
(interactive
|
|
(list (progn
|
|
(message "Export visible: [a]SCII [h]tml [b]rowse HTML [x]OXO [ ]keep buffer")
|
|
(char-to-string (read-char-exclusive)))
|
|
current-prefix-arg))
|
|
(if (not (member type '("a" "\C-a" "b" "\C-b" "h" "x" " ")))
|
|
(error "Invalid export key"))
|
|
(let* ((binding (key-binding (concat "\C-c\C-x" type)))
|
|
(keepp (equal type " "))
|
|
(file buffer-file-name)
|
|
(buffer (get-buffer-create "*Org Export Visible*"))
|
|
s e)
|
|
(with-current-buffer buffer (erase-buffer))
|
|
(save-excursion
|
|
(setq s (goto-char (point-min)))
|
|
(while (not (= (point) (point-max)))
|
|
(goto-char (org-find-invisible))
|
|
(append-to-buffer buffer s (point))
|
|
(setq s (goto-char (org-find-visible))))
|
|
(goto-char (point-min))
|
|
(unless keepp
|
|
;; Copy all comment lines to the end, to make sure #+ settings are
|
|
;; still available for the second export step. Kind of a hack, but
|
|
;; does do the trick.
|
|
(if (looking-at "#[^\r\n]*")
|
|
(append-to-buffer buffer (match-beginning 0) (1+ (match-end 0))))
|
|
(while (re-search-forward "[\n\r]#[^\n\r]*" nil t)
|
|
(append-to-buffer buffer (1+ (match-beginning 0))
|
|
(min (point-max) (1+ (match-end 0))))))
|
|
(set-buffer buffer)
|
|
(let ((buffer-file-name file)
|
|
(org-inhibit-startup t))
|
|
(org-mode)
|
|
(show-all)
|
|
(unless keepp (funcall binding arg))))
|
|
(if (not keepp)
|
|
(kill-buffer buffer)
|
|
(switch-to-buffer-other-window buffer)
|
|
(goto-char (point-min)))))
|
|
|
|
(defun org-find-visible ()
|
|
(if (featurep 'noutline)
|
|
(let ((s (point)))
|
|
(while (and (not (= (point-max) (setq s (next-overlay-change s))))
|
|
(get-char-property s 'invisible)))
|
|
s)
|
|
(skip-chars-forward "^\n")
|
|
(point)))
|
|
(defun org-find-invisible ()
|
|
(if (featurep 'noutline)
|
|
(let ((s (point)))
|
|
(while (and (not (= (point-max) (setq s (next-overlay-change s))))
|
|
(not (get-char-property s 'invisible))))
|
|
s)
|
|
(skip-chars-forward "^\r")
|
|
(point)))
|
|
|
|
;; HTML
|
|
|
|
(defun org-get-current-options ()
|
|
"Return a string with current options as keyword options.
|
|
Does include HTML export options as well as TODO and CATEGORY stuff."
|
|
(format
|
|
"#+TITLE: %s
|
|
#+AUTHOR: %s
|
|
#+EMAIL: %s
|
|
#+LANGUAGE: %s
|
|
#+TEXT: Some descriptive text to be emitted. Several lines OK.
|
|
#+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s *:%s TeX:%s
|
|
#+CATEGORY: %s
|
|
#+SEQ_TODO: %s
|
|
#+TYP_TODO: %s
|
|
#+STARTUP: %s %s %s %s %s %s
|
|
#+ARCHIVE: %s
|
|
"
|
|
(buffer-name) (user-full-name) user-mail-address org-export-default-language
|
|
org-export-headline-levels
|
|
org-export-with-section-numbers
|
|
org-export-with-toc
|
|
org-export-preserve-breaks
|
|
org-export-html-expand
|
|
org-export-with-fixed-width
|
|
org-export-with-tables
|
|
org-export-with-sub-superscripts
|
|
org-export-with-emphasize
|
|
org-export-with-TeX-macros
|
|
(file-name-nondirectory buffer-file-name)
|
|
(if (equal org-todo-interpretation 'sequence)
|
|
(mapconcat 'identity org-todo-keywords " ")
|
|
"TODO FEEDBACK VERIFY DONE")
|
|
(if (equal org-todo-interpretation 'type)
|
|
(mapconcat 'identity org-todo-keywords " ")
|
|
"Me Jason Marie DONE")
|
|
(cdr (assoc org-startup-folded
|
|
'((nil . "showall") (t . "overview") (content . "content"))))
|
|
(if org-startup-with-deadline-check "dlcheck" "nodlcheck")
|
|
(if org-odd-levels-only "odd" "oddeven")
|
|
(if org-hide-leading-stars "hidestars" "showstars")
|
|
(if org-startup-align-all-tables "align" "noalign")
|
|
(if org-log-done "logging" "nologging")
|
|
org-archive-location
|
|
))
|
|
|
|
(defun org-insert-export-options-template ()
|
|
"Insert into the buffer a template with information for exporting."
|
|
(interactive)
|
|
(if (not (bolp)) (newline))
|
|
(let ((s (org-get-current-options)))
|
|
(and (string-match "#\\+CATEGORY" s)
|
|
(setq s (substring s 0 (match-beginning 0))))
|
|
(insert s)))
|
|
|
|
(defun org-toggle-fixed-width-section (arg)
|
|
"Toggle the fixed-width export.
|
|
If there is no active region, the QUOTE keyword at the current headline is
|
|
inserted or removed. When present, it causes the text between this headline
|
|
and the next to be exported as fixed-width text, and unmodified.
|
|
If there is an active region, this command adds or removes a colon as the
|
|
first character of this line. If the first character of a line is a colon,
|
|
this line is also exported in fixed-width font."
|
|
(interactive "P")
|
|
(let* ((cc 0)
|
|
(regionp (org-region-active-p))
|
|
(beg (if regionp (region-beginning) (point)))
|
|
(end (if regionp (region-end)))
|
|
(nlines (or arg (if (and beg end) (count-lines beg end) 1)))
|
|
(re "[ \t]*\\(:\\)")
|
|
off)
|
|
(if regionp
|
|
(save-excursion
|
|
(goto-char beg)
|
|
(setq cc (current-column))
|
|
(beginning-of-line 1)
|
|
(setq off (looking-at re))
|
|
(while (> nlines 0)
|
|
(setq nlines (1- nlines))
|
|
(beginning-of-line 1)
|
|
(cond
|
|
(arg
|
|
(move-to-column cc t)
|
|
(insert ":\n")
|
|
(forward-line -1))
|
|
((and off (looking-at re))
|
|
(replace-match "" t t nil 1))
|
|
((not off) (move-to-column cc t) (insert ":")))
|
|
(forward-line 1)))
|
|
(save-excursion
|
|
(org-back-to-heading)
|
|
(if (looking-at (concat outline-regexp
|
|
"\\( +\\<" org-quote-string "\\>\\)"))
|
|
(replace-match "" t t nil 1)
|
|
(if (looking-at outline-regexp)
|
|
(progn
|
|
(goto-char (match-end 0))
|
|
(insert " " org-quote-string))))))))
|
|
|
|
(defun org-export-as-html-and-open (arg)
|
|
"Export the outline as HTML and immediately open it with a browser.
|
|
If there is an active region, export only the region.
|
|
The prefix ARG specifies how many levels of the outline should become
|
|
headlines. The default is 3. Lower levels will become bulleted lists."
|
|
(interactive "P")
|
|
(org-export-as-html arg 'hidden)
|
|
(org-open-file buffer-file-name))
|
|
|
|
(defun org-export-as-html-batch ()
|
|
"Call `org-export-as-html', may be used in batch processing as
|
|
emacs --batch
|
|
--load=$HOME/lib/emacs/org.el
|
|
--eval \"(setq org-export-headline-levels 2)\"
|
|
--visit=MyFile --funcall org-export-as-html-batch"
|
|
(org-export-as-html org-export-headline-levels 'hidden))
|
|
|
|
(defun org-export-as-html (arg &optional hidden ext-plist)
|
|
"Export the outline as a pretty HTML file.
|
|
If there is an active region, export only the region.
|
|
The prefix ARG specifies how many levels of the outline should become
|
|
headlines. The default is 3. Lower levels will become bulleted lists.
|
|
When HIDDEN is non-nil, don't display the HTML buffer.
|
|
EXT-PLIST is a property list with external parameters overriding
|
|
org-mode's default settings, but still inferior to file-local settings."
|
|
(interactive "P")
|
|
(setq-default org-todo-line-regexp org-todo-line-regexp)
|
|
(setq-default org-deadline-line-regexp org-deadline-line-regexp)
|
|
(setq-default org-done-string org-done-string)
|
|
(let* ((opt-plist (org-combine-plists (org-default-export-plist)
|
|
ext-plist
|
|
(org-infile-export-plist)))
|
|
|
|
(style (plist-get opt-plist :style))
|
|
(odd org-odd-levels-only)
|
|
(region-p (org-region-active-p))
|
|
(region
|
|
(buffer-substring
|
|
(if region-p (region-beginning) (point-min))
|
|
(if region-p (region-end) (point-max))))
|
|
(all_lines
|
|
(org-skip-comments (org-split-string
|
|
(org-cleaned-string-for-export region)
|
|
"[\r\n]")))
|
|
(lines (org-export-find-first-heading-line all_lines))
|
|
(level 0) (line "") (origline "") txt todo
|
|
(umax nil)
|
|
(filename (concat (file-name-as-directory
|
|
(plist-get opt-plist :publishing-directory))
|
|
(file-name-sans-extension
|
|
(file-name-nondirectory buffer-file-name))
|
|
".html"))
|
|
(buffer (find-file-noselect filename))
|
|
(levels-open (make-vector org-level-max nil))
|
|
(date (format-time-string "%Y/%m/%d" (current-time)))
|
|
(time (format-time-string "%X" (org-current-time)))
|
|
(author (plist-get opt-plist :author))
|
|
(title (or (plist-get opt-plist :title)
|
|
(file-name-sans-extension
|
|
(file-name-nondirectory buffer-file-name))))
|
|
(quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
|
|
(quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)"))
|
|
(inquote nil)
|
|
(infixed nil)
|
|
(in-local-list nil)
|
|
(local-list-num nil)
|
|
(local-list-indent nil)
|
|
(llt org-plain-list-ordered-item-terminator)
|
|
(email (plist-get opt-plist :email))
|
|
(language (plist-get opt-plist :language))
|
|
(text (plist-get opt-plist :text))
|
|
(lang-words nil)
|
|
(target-alist nil) tg
|
|
(head-count 0) cnt
|
|
(start 0)
|
|
;; FIXME: The following returns always nil under XEmacs
|
|
(coding-system (and (fboundp 'coding-system-get)
|
|
(boundp 'buffer-file-coding-system)
|
|
buffer-file-coding-system))
|
|
(coding-system-for-write (or coding-system coding-system-for-write))
|
|
(save-buffer-coding-system (or coding-system save-buffer-coding-system))
|
|
(charset (and coding-system
|
|
(coding-system-get coding-system 'mime-charset)))
|
|
table-open type
|
|
table-buffer table-orig-buffer
|
|
ind start-is-num starter
|
|
rpl path desc descp desc1 desc2 link
|
|
)
|
|
(message "Exporting...")
|
|
|
|
(setq org-last-level 1)
|
|
(org-init-section-numbers)
|
|
|
|
;; Get the language-dependent settings
|
|
(setq lang-words (or (assoc language org-export-language-setup)
|
|
(assoc "en" org-export-language-setup)))
|
|
|
|
;; Switch to the output buffer
|
|
(if (or hidden (not org-export-html-show-new-buffer))
|
|
(set-buffer buffer)
|
|
(switch-to-buffer-other-window buffer))
|
|
(erase-buffer)
|
|
(fundamental-mode)
|
|
(let ((case-fold-search nil)
|
|
(org-odd-levels-only odd))
|
|
;; create local variables for all options, to make sure all called
|
|
;; functions get the correct information
|
|
(mapcar (lambda (x)
|
|
(set (make-local-variable (cdr x))
|
|
(plist-get opt-plist (car x))))
|
|
org-export-plist-vars)
|
|
(setq umax (if arg (prefix-numeric-value arg)
|
|
org-export-headline-levels))
|
|
|
|
;; File header
|
|
(insert (format
|
|
"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\"
|
|
\"http://www.w3.org/TR/REC-html40/loose.dtd\">
|
|
<html lang=\"%s\"><head>
|
|
<title>%s</title>
|
|
<meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\">
|
|
<meta name=generator content=\"Org-mode\">
|
|
<meta name=generated content=\"%s %s\">
|
|
<meta name=author content=\"%s\">
|
|
%s
|
|
</head><body>
|
|
"
|
|
language (org-html-expand title) (or charset "iso-8859-1")
|
|
date time author style))
|
|
|
|
|
|
(insert (or (plist-get opt-plist :preamble) ""))
|
|
|
|
(when (plist-get opt-plist :auto-preamble)
|
|
(if title (insert (concat "<H1 class=\"title\">"
|
|
(org-html-expand title) "</H1>\n")))
|
|
; (if author (insert (concat (nth 1 lang-words) ": " author "\n")))
|
|
; (if email (insert (concat "<a href=\"mailto:" email "\"><"
|
|
; email "></a>\n")))
|
|
; (if (or author email) (insert "<br>\n"))
|
|
; (if (and date time) (insert (concat (nth 2 lang-words) ": "
|
|
; date " " time "<br>\n")))
|
|
(if text (insert (concat "<p>\n" (org-html-expand text)))))
|
|
|
|
(if org-export-with-toc
|
|
(progn
|
|
(insert (format "<H2>%s</H2>\n" (nth 3 lang-words)))
|
|
(insert "<ul>\n")
|
|
(setq lines
|
|
(mapcar '(lambda (line)
|
|
(if (string-match org-todo-line-regexp line)
|
|
;; This is a headline
|
|
(progn
|
|
(setq level (- (match-end 1) (match-beginning 1))
|
|
level (org-tr-level level)
|
|
txt (save-match-data
|
|
(org-html-expand
|
|
(match-string 3 line)))
|
|
todo
|
|
(or (and org-export-mark-todo-in-toc
|
|
(match-beginning 2)
|
|
(not (equal (match-string 2 line)
|
|
org-done-string)))
|
|
; TODO, not DONE
|
|
(and org-export-mark-todo-in-toc
|
|
(= level umax)
|
|
(org-search-todo-below
|
|
line lines level))))
|
|
(if org-export-with-section-numbers
|
|
(setq txt (concat (org-section-number level)
|
|
" " txt)))
|
|
(if (<= level umax)
|
|
(progn
|
|
(setq head-count (+ head-count 1))
|
|
(if (> level org-last-level)
|
|
(progn
|
|
(setq cnt (- level org-last-level))
|
|
(while (>= (setq cnt (1- cnt)) 0)
|
|
(insert "<ul>"))
|
|
(insert "\n")))
|
|
(if (< level org-last-level)
|
|
(progn
|
|
(setq cnt (- org-last-level level))
|
|
(while (>= (setq cnt (1- cnt)) 0)
|
|
(insert "</ul>"))
|
|
(insert "\n")))
|
|
;; Check for targets
|
|
(while (string-match org-target-regexp line)
|
|
(setq tg (match-string 1 line)
|
|
line (replace-match
|
|
(concat "@<span class=\"target\">" tg "@</span> ")
|
|
t t line))
|
|
(push (cons (org-solidify-link-text tg)
|
|
(format "sec-%d" head-count))
|
|
target-alist))
|
|
(while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt)
|
|
(setq txt (replace-match "" t t txt)))
|
|
(insert
|
|
(format
|
|
(if todo
|
|
"<li><a href=\"#sec-%d\"><span class=\"todo\">%s</span></a>\n"
|
|
"<li><a href=\"#sec-%d\">%s</a>\n")
|
|
head-count txt))
|
|
|
|
(setq org-last-level level))
|
|
)))
|
|
line)
|
|
lines))
|
|
(while (> org-last-level 0)
|
|
(setq org-last-level (1- org-last-level))
|
|
(insert "</ul>\n"))
|
|
))
|
|
(setq head-count 0)
|
|
(org-init-section-numbers)
|
|
|
|
(while (setq line (pop lines) origline line)
|
|
(catch 'nextline
|
|
|
|
;; end of quote section?
|
|
(when (and inquote (string-match "^\\*+" line))
|
|
(insert "</pre>\n")
|
|
(setq inquote nil))
|
|
;; inside a quote section?
|
|
(when inquote
|
|
(insert (org-html-protect line) "\n")
|
|
(throw 'nextline nil))
|
|
|
|
;; verbatim lines
|
|
(when (and org-export-with-fixed-width
|
|
(string-match "^[ \t]*:\\(.*\\)" line))
|
|
(when (not infixed)
|
|
(setq infixed t)
|
|
(insert "<pre>\n"))
|
|
(insert (org-html-protect (match-string 1 line)) "\n")
|
|
(when (and lines
|
|
(not (string-match "^[ \t]*\\(:.*\\)"
|
|
(car lines))))
|
|
(setq infixed nil)
|
|
(insert "</pre>\n"))
|
|
(throw 'nextline nil))
|
|
|
|
|
|
;; make targets to anchors
|
|
(while (string-match "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line)
|
|
(cond
|
|
((match-end 2)
|
|
(setq line (replace-match
|
|
(concat "@<a name=\""
|
|
(org-solidify-link-text (match-string 1 line))
|
|
"\">\\nbsp@</a>")
|
|
t t line)))
|
|
((and org-export-with-toc (equal (string-to-char line) ?*))
|
|
(setq line (replace-match
|
|
(concat "@<span class=\"target\">" (match-string 1 line) "@</span> ")
|
|
; (concat "@<i>" (match-string 1 line) "@</i> ")
|
|
t t line)))
|
|
(t
|
|
(setq line (replace-match
|
|
(concat "@<a name=\""
|
|
(org-solidify-link-text (match-string 1 line))
|
|
"\" class=\"target\">" (match-string 1 line) "@</a> ")
|
|
t t line)))))
|
|
|
|
(setq line (org-html-handle-time-stamps line))
|
|
|
|
;; replace "&" by "&", "<" and ">" by "<" and ">"
|
|
;; handle @<..> HTML tags (replace "@>..<" by "<..>")
|
|
(setq line (org-html-expand line))
|
|
|
|
;; Format the links
|
|
(setq start 0)
|
|
(while (string-match org-bracket-link-analytic-regexp line start)
|
|
(setq start (match-beginning 0))
|
|
(setq type (if (match-end 2) (match-string 2 line) "internal"))
|
|
(setq path (match-string 3 line))
|
|
(setq desc1 (if (match-end 5) (match-string 5 line))
|
|
desc2 (if (match-end 2) (concat type ":" path) path)
|
|
descp (and desc1 (not (equal desc1 desc2)))
|
|
desc (or desc1 desc2))
|
|
;; FIXME: do we need to unescape here somewhere?
|
|
(cond
|
|
((equal type "internal")
|
|
(setq rpl
|
|
(concat
|
|
"<a href=\"#"
|
|
(org-solidify-link-text path target-alist)
|
|
"\">" desc "</a>")))
|
|
((member type '("http" "https" "ftp" "mailto" "news"))
|
|
;; standard URL
|
|
(setq link (concat type ":" path))
|
|
(setq rpl (concat "<a href=\"" link "\">" desc "</a>")))
|
|
((string= type "file")
|
|
;; FILE link
|
|
(let* ((filename path)
|
|
(abs-p (file-name-absolute-p filename))
|
|
thefile file-is-image-p search)
|
|
(save-match-data
|
|
(if (string-match "::\\(.*\\)" filename)
|
|
(setq search (match-string 1 filename)
|
|
filename (replace-match "" nil nil filename)))
|
|
(setq file-is-image-p
|
|
(string-match (org-image-file-name-regexp) filename))
|
|
(setq thefile (if abs-p (expand-file-name filename) filename))
|
|
(when (and org-export-html-link-org-files-as-html
|
|
(string-match "\\.org$" thefile))
|
|
(setq thefile (concat (substring thefile 0
|
|
(match-beginning 0))
|
|
".html"))
|
|
(if (and search
|
|
;; make sure this is can be used as target search
|
|
(not (string-match "^[0-9]*$" search))
|
|
(not (string-match "^\\*" search))
|
|
(not (string-match "^/.*/$" search)))
|
|
(setq thefile (concat thefile "#"
|
|
(org-solidify-link-text
|
|
(org-link-unescape search)))))
|
|
(when (string-match "^file:" desc)
|
|
(setq desc (replace-match "" t t desc))
|
|
(if (string-match "\\.org$" desc)
|
|
(setq desc (replace-match "" t t desc))))))
|
|
(setq rpl (if (and file-is-image-p
|
|
(or (eq t org-export-html-inline-images)
|
|
(and org-export-html-inline-images
|
|
(not descp))))
|
|
(concat "<img src=\"" thefile "\"/>")
|
|
(concat "<a href=\"" thefile "\">" desc "</a>")))))
|
|
((member type '("bbdb" "vm" "wl" "mhe" "rmail" "gnus" "shell"))
|
|
(setq rpl (concat "<i><" type ":"
|
|
(save-match-data (org-link-unescape path))
|
|
"></i>"))))
|
|
(setq line (replace-match rpl t t line)
|
|
start (+ start (length rpl))))
|
|
;; TODO items
|
|
(if (and (string-match org-todo-line-regexp line)
|
|
(match-beginning 2))
|
|
(if (equal (match-string 2 line) org-done-string)
|
|
(setq line (replace-match
|
|
"<span class=\"done\">\\2</span>"
|
|
nil nil line 2))
|
|
(setq line (replace-match "<span class=\"todo\">\\2</span>"
|
|
nil nil line 2))))
|
|
|
|
(cond
|
|
((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line)
|
|
;; This is a headline
|
|
(setq level (org-tr-level (- (match-end 1) (match-beginning 1)))
|
|
txt (match-string 2 line))
|
|
(if (string-match quote-re0 txt)
|
|
(setq txt (replace-match "" t t txt)))
|
|
(if (<= level umax) (setq head-count (+ head-count 1)))
|
|
(when in-local-list
|
|
;; Close any local lists before inserting a new header line
|
|
(while local-list-num
|
|
(insert (if (car local-list-num) "</ol>\n" "</ul>"))
|
|
(pop local-list-num))
|
|
(setq local-list-indent nil
|
|
in-local-list nil))
|
|
(org-html-level-start level txt umax
|
|
(and org-export-with-toc (<= level umax))
|
|
head-count)
|
|
;; QUOTES
|
|
(when (string-match quote-re line)
|
|
(insert "<pre>")
|
|
(setq inquote t)))
|
|
|
|
((and org-export-with-tables
|
|
(string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
|
|
(if (not table-open)
|
|
;; New table starts
|
|
(setq table-open t table-buffer nil table-orig-buffer nil))
|
|
;; Accumulate lines
|
|
(setq table-buffer (cons line table-buffer)
|
|
table-orig-buffer (cons origline table-orig-buffer))
|
|
(when (or (not lines)
|
|
(not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
|
|
(car lines))))
|
|
(setq table-open nil
|
|
table-buffer (nreverse table-buffer)
|
|
table-orig-buffer (nreverse table-orig-buffer))
|
|
(insert (org-format-table-html table-buffer table-orig-buffer))))
|
|
(t
|
|
;; Normal lines
|
|
(when (and (string-match
|
|
(cond
|
|
((eq llt t) "^\\([ \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+[.)]\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
|
|
((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+\\.\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
|
|
((= llt ?\)) "^\\( \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+)\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
|
|
(t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))
|
|
line))
|
|
(setq ind (org-get-string-indentation line)
|
|
start-is-num (match-beginning 4)
|
|
starter (if (match-beginning 2)
|
|
(substring (match-string 2 line) 0 -1))
|
|
line (substring line (match-beginning 5)))
|
|
(unless (string-match "[^ \t]" line)
|
|
;; empty line. Pretend indentation is large.
|
|
(setq ind (1+ (or (car local-list-indent) 1))))
|
|
(while (and in-local-list
|
|
(or (and (= ind (car local-list-indent))
|
|
(not starter))
|
|
(< ind (car local-list-indent))))
|
|
(insert (if (car local-list-num) "</ol>\n" "</ul>"))
|
|
(pop local-list-num) (pop local-list-indent)
|
|
(setq in-local-list local-list-indent))
|
|
(cond
|
|
((and starter
|
|
(or (not in-local-list)
|
|
(> ind (car local-list-indent))))
|
|
;; Start new (level of ) list
|
|
(insert (if start-is-num "<ol>\n<li>\n" "<ul>\n<li>\n"))
|
|
(push start-is-num local-list-num)
|
|
(push ind local-list-indent)
|
|
(setq in-local-list t))
|
|
(starter
|
|
;; continue current list
|
|
(insert "<li>\n"))))
|
|
;; Empty lines start a new paragraph. If hand-formatted lists
|
|
;; are not fully interpreted, lines starting with "-", "+", "*"
|
|
;; also start a new paragraph.
|
|
(if (string-match "^ [-+*]-\\|^[ \t]*$" line) (insert "<p>"))
|
|
(insert line (if org-export-preserve-breaks "<br>\n" "\n"))))
|
|
))
|
|
|
|
;; Properly close all local lists and other lists
|
|
(when inquote (insert "</pre>\n"))
|
|
(when in-local-list
|
|
;; Close any local lists before inserting a new header line
|
|
(while local-list-num
|
|
(insert (if (car local-list-num) "</ol>\n" "</ul>"))
|
|
(pop local-list-num))
|
|
(setq local-list-indent nil
|
|
in-local-list nil))
|
|
(org-html-level-start 1 nil umax
|
|
(and org-export-with-toc (<= level umax))
|
|
head-count)
|
|
|
|
(when (plist-get opt-plist :auto-postamble)
|
|
(if author (insert (concat (nth 1 lang-words) ": " author "\n")))
|
|
(if email (insert (concat "<a href=\"mailto:" email "\"><"
|
|
email "></a>\n")))
|
|
(if (or author email) (insert "<br>\n"))
|
|
(if (and date time) (insert (concat (nth 2 lang-words) ": "
|
|
date " " time "<br>\n"))))
|
|
|
|
(if org-export-html-with-timestamp
|
|
(insert org-export-html-html-helper-timestamp))
|
|
(insert (or (plist-get opt-plist :postamble) ""))
|
|
(insert "</body>\n</html>\n")
|
|
(normal-mode)
|
|
(save-buffer)
|
|
(goto-char (point-min)))))
|
|
|
|
(defun org-format-table-html (lines olines)
|
|
"Find out which HTML converter to use and return the HTML code."
|
|
(if (string-match "^[ \t]*|" (car lines))
|
|
;; A normal org table
|
|
(org-format-org-table-html lines)
|
|
;; Table made by table.el - test for spanning
|
|
(let* ((hlines (delq nil (mapcar
|
|
(lambda (x)
|
|
(if (string-match "^[ \t]*\\+-" x) x
|
|
nil))
|
|
lines)))
|
|
(first (car hlines))
|
|
(ll (and (string-match "\\S-+" first)
|
|
(match-string 0 first)))
|
|
(re (concat "^[ \t]*" (regexp-quote ll)))
|
|
(spanning (delq nil (mapcar (lambda (x) (not (string-match re x)))
|
|
hlines))))
|
|
(if (and (not spanning)
|
|
(not org-export-prefer-native-exporter-for-tables))
|
|
;; We can use my own converter with HTML conversions
|
|
(org-format-table-table-html lines)
|
|
;; Need to use the code generator in table.el, with the original text.
|
|
(org-format-table-table-html-using-table-generate-source olines)))))
|
|
|
|
(defun org-format-org-table-html (lines)
|
|
"Format a table into HTML."
|
|
(if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
|
|
(setq lines (nreverse lines))
|
|
(if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
|
|
(setq lines (nreverse lines))
|
|
(when org-export-table-remove-special-lines
|
|
;; Check if the table has a marking column. If yes remove the
|
|
;; column and the special lines
|
|
(let* ((special
|
|
(not
|
|
(memq nil
|
|
(mapcar
|
|
(lambda (x)
|
|
(or (string-match "^[ \t]*|-" x)
|
|
(string-match "^[ \t]*| *\\([#!$*_^ ]\\) *|" x)))
|
|
lines)))))
|
|
(if special
|
|
(setq lines
|
|
(delq nil
|
|
(mapcar
|
|
(lambda (x)
|
|
(if (string-match "^[ \t]*| *[!_^] *|" x)
|
|
nil ; ignore this line
|
|
(and (or (string-match "^[ \t]*|-+\\+" x)
|
|
(string-match "^[ \t]*|[^|]*|" x))
|
|
(replace-match "|" t t x))))
|
|
lines))))))
|
|
|
|
(let ((head (and org-export-highlight-first-table-line
|
|
(delq nil (mapcar
|
|
(lambda (x) (string-match "^[ \t]*|-" x))
|
|
(cdr lines)))))
|
|
line fields html)
|
|
(setq html (concat org-export-html-table-tag "\n"))
|
|
(while (setq line (pop lines))
|
|
(catch 'next-line
|
|
(if (string-match "^[ \t]*|-" line)
|
|
(progn
|
|
(setq head nil) ;; head ends here, first time around
|
|
;; ignore this line
|
|
(throw 'next-line t)))
|
|
;; Break the line into fields
|
|
(setq fields (org-split-string line "[ \t]*|[ \t]*"))
|
|
(setq html (concat
|
|
html
|
|
"<tr>"
|
|
(mapconcat (lambda (x)
|
|
(if head
|
|
(concat "<th>" x "</th>")
|
|
(concat "<td>" x "</td>")))
|
|
fields "")
|
|
"</tr>\n"))))
|
|
(setq html (concat html "</table>\n"))
|
|
html))
|
|
|
|
(defun org-fake-empty-table-line (line)
|
|
"Replace everything except \"|\" with spaces."
|
|
(let ((i (length line))
|
|
(newstr (copy-sequence line)))
|
|
(while (> i 0)
|
|
(setq i (1- i))
|
|
(if (not (eq (aref newstr i) ?|))
|
|
(aset newstr i ?\ )))
|
|
newstr))
|
|
|
|
(defun org-format-table-table-html (lines)
|
|
"Format a table generated by table.el into HTML.
|
|
This conversion does *not* use `table-generate-source' from table.el.
|
|
This has the advantage that Org-mode's HTML conversions can be used.
|
|
But it has the disadvantage, that no cell- or row-spanning is allowed."
|
|
(let (line field-buffer
|
|
(head org-export-highlight-first-table-line)
|
|
fields html empty)
|
|
(setq html (concat org-export-html-table-tag "\n"))
|
|
(while (setq line (pop lines))
|
|
(setq empty " ")
|
|
(catch 'next-line
|
|
(if (string-match "^[ \t]*\\+-" line)
|
|
(progn
|
|
(if field-buffer
|
|
(progn
|
|
(setq html (concat
|
|
html
|
|
"<tr>"
|
|
(mapconcat
|
|
(lambda (x)
|
|
(if (equal x "") (setq x empty))
|
|
(if head
|
|
(concat "<th>" x "</th>\n")
|
|
(concat "<td>" x "</td>\n")))
|
|
field-buffer "\n")
|
|
"</tr>\n"))
|
|
(setq head nil)
|
|
(setq field-buffer nil)))
|
|
;; Ignore this line
|
|
(throw 'next-line t)))
|
|
;; Break the line into fields and store the fields
|
|
(setq fields (org-split-string line "[ \t]*|[ \t]*"))
|
|
(if field-buffer
|
|
(setq field-buffer (mapcar
|
|
(lambda (x)
|
|
(concat x "<br>" (pop fields)))
|
|
field-buffer))
|
|
(setq field-buffer fields))))
|
|
(setq html (concat html "</table>\n"))
|
|
html))
|
|
|
|
(defun org-format-table-table-html-using-table-generate-source (lines)
|
|
"Format a table into html, using `table-generate-source' from table.el.
|
|
This has the advantage that cell- or row-spanning is allowed.
|
|
But it has the disadvantage, that Org-mode's HTML conversions cannot be used."
|
|
(require 'table)
|
|
(with-current-buffer (get-buffer-create " org-tmp1 ")
|
|
(erase-buffer)
|
|
(insert (mapconcat 'identity lines "\n"))
|
|
(goto-char (point-min))
|
|
(if (not (re-search-forward "|[^+]" nil t))
|
|
(error "Error processing table"))
|
|
(table-recognize-table)
|
|
(with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer))
|
|
(table-generate-source 'html " org-tmp2 ")
|
|
(set-buffer " org-tmp2 ")
|
|
(buffer-substring (point-min) (point-max))))
|
|
|
|
(defun org-html-handle-time-stamps (s)
|
|
"Format time stamps in string S, or remove them."
|
|
(let (r b)
|
|
(while (string-match org-maybe-keyword-time-regexp s)
|
|
(or b (setq b (substring s 0 (match-beginning 0))))
|
|
(if (not org-export-with-timestamps)
|
|
(setq r (concat r (substring s 0 (match-beginning 0)))
|
|
s (substring s (match-end 0)))
|
|
(setq r (concat
|
|
r (substring s 0 (match-beginning 0))
|
|
(if (match-end 1)
|
|
(format "@<span class=\"timestamp-kwd\">%s @</span>"
|
|
(match-string 1 s)))
|
|
(format "@<span class=\"timestamp\">%s@</span>"
|
|
(match-string 3 s)))
|
|
s (substring s (match-end 0)))))
|
|
;; Line break of line started and ended with time stamp stuff
|
|
(if (not r)
|
|
s
|
|
(setq r (concat r s))
|
|
(unless (string-match "\\S-" (concat b s))
|
|
(setq r (concat r "@<br>")))
|
|
r)))
|
|
|
|
(defun org-html-protect (s)
|
|
;; convert & to &, < to < and > to >
|
|
(let ((start 0))
|
|
(while (string-match "&" s start)
|
|
(setq s (replace-match "&" t t s)
|
|
start (1+ (match-beginning 0))))
|
|
(while (string-match "<" s)
|
|
(setq s (replace-match "<" t t s)))
|
|
(while (string-match ">" s)
|
|
(setq s (replace-match ">" t t s))))
|
|
s)
|
|
|
|
(defun org-html-expand (string)
|
|
"Prepare STRING for HTML export. Applies all active conversions.
|
|
If there are links in the string, don't modify these."
|
|
(let* (m s l res)
|
|
(while (setq m (string-match org-bracket-link-regexp string))
|
|
(setq s (substring string 0 m)
|
|
l (match-string 0 string)
|
|
string (substring string (match-end 0)))
|
|
(push (org-html-do-expand s) res)
|
|
(push l res))
|
|
(push (org-html-do-expand string) res)
|
|
(apply 'concat (nreverse res))))
|
|
|
|
(defun org-html-do-expand (s)
|
|
"Apply all active conversions to translate special ASCII to HTML."
|
|
(setq s (org-html-protect s))
|
|
(if org-export-html-expand
|
|
(while (string-match "@<\\([^&]*\\)>" s)
|
|
(setq s (replace-match "<\\1>" nil nil s))))
|
|
(if org-export-with-emphasize
|
|
(setq s (org-export-html-convert-emphasize s)))
|
|
(if org-export-with-sub-superscripts
|
|
(setq s (org-export-html-convert-sub-super s)))
|
|
(if org-export-with-TeX-macros
|
|
(let ((start 0) wd ass)
|
|
(while (setq start (string-match "\\\\\\([a-zA-Z]+\\)" s start))
|
|
(setq wd (match-string 1 s))
|
|
(if (setq ass (assoc wd org-html-entities))
|
|
(setq s (replace-match (or (cdr ass)
|
|
(concat "&" (car ass) ";"))
|
|
t t s))
|
|
(setq start (+ start (length wd)))))))
|
|
s)
|
|
|
|
(defun org-create-multibrace-regexp (left right n)
|
|
"Create a regular expression which will match a balanced sexp.
|
|
Opening delimiter is LEFT, and closing delimiter is RIGHT, both given
|
|
as single character strings.
|
|
The regexp returned will match the entire expression including the
|
|
delimiters. It will also define a single group which contains the
|
|
match except for the outermost delimiters. The maximum depth of
|
|
stacked delimiters is N. Escaping delimiters is not possible."
|
|
(let* ((nothing (concat "[^" "\\" left "\\" right "]*?"))
|
|
(or "\\|")
|
|
(re nothing)
|
|
(next (concat "\\(?:" nothing left nothing right "\\)+" nothing)))
|
|
(while (> n 1)
|
|
(setq n (1- n)
|
|
re (concat re or next)
|
|
next (concat "\\(?:" nothing left next right "\\)+" nothing)))
|
|
(concat left "\\(" re "\\)" right)))
|
|
|
|
(defvar org-match-substring-regexp
|
|
(concat
|
|
"\\([^\\]\\)\\([_^]\\)\\("
|
|
"\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)"
|
|
"\\|"
|
|
"\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)"
|
|
"\\|"
|
|
"\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)")
|
|
"The regular expression matching a sub- or superscript.")
|
|
|
|
(defun org-export-html-convert-sub-super (string)
|
|
"Convert sub- and superscripts in STRING to HTML."
|
|
(let (key c)
|
|
(while (string-match org-match-substring-regexp string)
|
|
(setq key (if (string= (match-string 2 string) "_") "sub" "sup"))
|
|
(setq c (or (match-string 8 string)
|
|
(match-string 6 string)
|
|
(match-string 5 string)))
|
|
(setq string (replace-match
|
|
(concat (match-string 1 string)
|
|
"<" key ">" c "</" key ">")
|
|
t t string)))
|
|
(while (string-match "\\\\\\([_^]\\)" string)
|
|
(setq string (replace-match (match-string 1 string) t t string))))
|
|
string)
|
|
|
|
(defun org-export-html-convert-emphasize (string)
|
|
(while (string-match org-italic-re string)
|
|
(setq string (replace-match "\\1<i>\\3</i>\\4" t nil string)))
|
|
(while (string-match org-bold-re string)
|
|
(setq string (replace-match "\\1<b>\\3</b>\\4" t nil string)))
|
|
(while (string-match org-underline-re string)
|
|
(setq string (replace-match "\\1<u>\\3</u>\\4" t nil string)))
|
|
string)
|
|
|
|
(defun org-html-level-start (level title umax with-toc head-count)
|
|
"Insert a new level in HTML export.
|
|
When TITLE is nil, just close all open levels."
|
|
(let ((l (1+ (max level umax))))
|
|
(while (<= l org-level-max)
|
|
(if (aref levels-open (1- l))
|
|
(progn
|
|
(org-html-level-close l)
|
|
(aset levels-open (1- l) nil)))
|
|
(setq l (1+ l)))
|
|
(when title
|
|
;; If title is nil, this means this function is called to close
|
|
;; all levels, so the rest is done only if title is given
|
|
(if (> level umax)
|
|
(progn
|
|
(if (aref levels-open (1- level))
|
|
(insert "<li>" title "<p>\n")
|
|
(aset levels-open (1- level) t)
|
|
(insert "<ul><li>" title "<p>\n")))
|
|
(if org-export-with-section-numbers
|
|
(setq title (concat (org-section-number level) " " title)))
|
|
(setq level (+ level 1))
|
|
;; FIXME: here we need to handle the tags, somehow.
|
|
(when (string-match "\\(:[a-zA-Z0-9_@:]+:\\)[ \t]*$" title)
|
|
(setq title (replace-match
|
|
(if org-export-with-tags
|
|
(save-match-data
|
|
(concat
|
|
" <span class=\"tag\">"
|
|
(mapconcat 'identity (org-split-string
|
|
(match-string 1 title) ":")
|
|
" ")
|
|
"</span>"))
|
|
"")
|
|
t t title)))
|
|
(if with-toc
|
|
(insert (format "\n<H%d><a name=\"sec-%d\">%s</a></H%d>\n"
|
|
level head-count title level))
|
|
(insert (format "\n<H%d>%s</H%d>\n" level title level)))))))
|
|
|
|
(defun org-html-level-close (&rest args)
|
|
"Terminate one level in HTML export."
|
|
(insert "</ul>"))
|
|
|
|
;; Variable holding the vector with section numbers
|
|
(defvar org-section-numbers (make-vector org-level-max 0))
|
|
|
|
(defun org-init-section-numbers ()
|
|
"Initialize the vector for the section numbers."
|
|
(let* ((level -1)
|
|
(numbers (nreverse (org-split-string "" "\\.")))
|
|
(depth (1- (length org-section-numbers)))
|
|
(i depth) number-string)
|
|
(while (>= i 0)
|
|
(if (> i level)
|
|
(aset org-section-numbers i 0)
|
|
(setq number-string (or (car numbers) "0"))
|
|
(if (string-match "\\`[A-Z]\\'" number-string)
|
|
(aset org-section-numbers i
|
|
(- (string-to-char number-string) ?A -1))
|
|
(aset org-section-numbers i (string-to-number number-string)))
|
|
(pop numbers))
|
|
(setq i (1- i)))))
|
|
|
|
(defun org-section-number (&optional level)
|
|
"Return a string with the current section number.
|
|
When LEVEL is non-nil, increase section numbers on that level."
|
|
(let* ((depth (1- (length org-section-numbers))) idx n (string ""))
|
|
(when level
|
|
(when (> level -1)
|
|
(aset org-section-numbers
|
|
level (1+ (aref org-section-numbers level))))
|
|
(setq idx (1+ level))
|
|
(while (<= idx depth)
|
|
(if (not (= idx 1))
|
|
(aset org-section-numbers idx 0))
|
|
(setq idx (1+ idx))))
|
|
(setq idx 0)
|
|
(while (<= idx depth)
|
|
(setq n (aref org-section-numbers idx))
|
|
(setq string (concat string (if (not (string= string "")) "." "")
|
|
(int-to-string n)))
|
|
(setq idx (1+ idx)))
|
|
(save-match-data
|
|
(if (string-match "\\`\\([@0]\\.\\)+" string)
|
|
(setq string (replace-match "" nil nil string)))
|
|
(if (string-match "\\(\\.0\\)+\\'" string)
|
|
(setq string (replace-match "" nil nil string))))
|
|
string))
|
|
|
|
|
|
(defun org-export-icalendar-this-file ()
|
|
"Export current file as an iCalendar file.
|
|
The iCalendar file will be located in the same directory as the Org-mode
|
|
file, but with extension `.ics'."
|
|
(interactive)
|
|
(org-export-icalendar nil buffer-file-name))
|
|
|
|
(defun org-export-as-xml (arg)
|
|
"Export current buffer as XOXO XML buffer."
|
|
(interactive "P")
|
|
(cond ((eq org-export-xml-type 'xoxo)
|
|
(org-export-as-xoxo (current-buffer)))))
|
|
|
|
(defun org-export-as-xoxo-insert-into (buffer &rest output)
|
|
(with-current-buffer buffer
|
|
(apply 'insert output)))
|
|
|
|
(defun org-export-as-xoxo (&optional buffer)
|
|
"Export the org buffer as XOXO.
|
|
The XOXO buffer is named *xoxo-<source buffer name>*"
|
|
(interactive (list (current-buffer)))
|
|
;; A quickie abstraction
|
|
|
|
;; Output everything as XOXO
|
|
(with-current-buffer (get-buffer buffer)
|
|
(goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed.
|
|
(let* ((opt-plist (org-combine-plists (org-default-export-plist)
|
|
(org-infile-export-plist)))
|
|
(filename (concat (file-name-as-directory
|
|
(plist-get opt-plist :publishing-directory))
|
|
(file-name-sans-extension
|
|
(file-name-nondirectory buffer-file-name))
|
|
".html"))
|
|
(out (find-file-noselect filename))
|
|
(last-level 1)
|
|
(hanging-li nil))
|
|
;; Check the output buffer is empty.
|
|
(with-current-buffer out (erase-buffer))
|
|
;; Kick off the output
|
|
(org-export-as-xoxo-insert-into out "<ol class='xoxo'>\n")
|
|
(while (re-search-forward "^\\(\\*+\\) \\(.+\\)" (point-max) 't)
|
|
(let* ((hd (match-string-no-properties 1))
|
|
(level (length hd))
|
|
(text (concat
|
|
(match-string-no-properties 2)
|
|
(save-excursion
|
|
(goto-char (match-end 0))
|
|
(let ((str ""))
|
|
(catch 'loop
|
|
(while 't
|
|
(forward-line)
|
|
(if (looking-at "^[ \t]\\(.*\\)")
|
|
(setq str (concat str (match-string-no-properties 1)))
|
|
(throw 'loop str)))))))))
|
|
|
|
;; Handle level rendering
|
|
(cond
|
|
((> level last-level)
|
|
(org-export-as-xoxo-insert-into out "\n<ol>\n"))
|
|
|
|
((< level last-level)
|
|
(dotimes (- (- last-level level) 1)
|
|
(if hanging-li
|
|
(org-export-as-xoxo-insert-into out "</li>\n"))
|
|
(org-export-as-xoxo-insert-into out "</ol>\n"))
|
|
(when hanging-li
|
|
(org-export-as-xoxo-insert-into out "</li>\n")
|
|
(setq hanging-li nil)))
|
|
|
|
((equal level last-level)
|
|
(if hanging-li
|
|
(org-export-as-xoxo-insert-into out "</li>\n")))
|
|
)
|
|
|
|
(setq last-level level)
|
|
|
|
;; And output the new li
|
|
(setq hanging-li 't)
|
|
(if (equal ?+ (elt text 0))
|
|
(org-export-as-xoxo-insert-into out "<li class='" (substring text 1) "'>")
|
|
(org-export-as-xoxo-insert-into out "<li>" text))))
|
|
|
|
;; Finally finish off the ol
|
|
(dotimes (- last-level 1)
|
|
(if hanging-li
|
|
(org-export-as-xoxo-insert-into out "</li>\n"))
|
|
(org-export-as-xoxo-insert-into out "</ol>\n"))
|
|
|
|
;; Finish the buffer off and clean it up.
|
|
(switch-to-buffer-other-window out)
|
|
(indent-region (point-min) (point-max) nil)
|
|
(save-buffer)
|
|
(goto-char (point-min))
|
|
)))
|
|
|
|
;;;###autoload
|
|
(defun org-export-icalendar-all-agenda-files ()
|
|
"Export all files in `org-agenda-files' to iCalendar .ics files.
|
|
Each iCalendar file will be located in the same directory as the Org-mode
|
|
file, but with extension `.ics'."
|
|
(interactive)
|
|
(apply 'org-export-icalendar nil (org-agenda-files t)))
|
|
|
|
;;;###autoload
|
|
(defun org-export-icalendar-combine-agenda-files ()
|
|
"Export all files in `org-agenda-files' to a single combined iCalendar file.
|
|
The file is stored under the name `org-combined-agenda-icalendar-file'."
|
|
(interactive)
|
|
(apply 'org-export-icalendar t (org-agenda-files t)))
|
|
|
|
(defun org-export-icalendar (combine &rest files)
|
|
"Create iCalendar files for all elements of FILES.
|
|
If COMBINE is non-nil, combine all calendar entries into a single large
|
|
file and store it under the name `org-combined-agenda-icalendar-file'."
|
|
(save-excursion
|
|
(let* (file ical-file ical-buffer category started org-agenda-new-buffers)
|
|
(when combine
|
|
(setq ical-file org-combined-agenda-icalendar-file
|
|
ical-buffer (org-get-agenda-file-buffer ical-file))
|
|
(set-buffer ical-buffer) (erase-buffer))
|
|
(while (setq file (pop files))
|
|
(catch 'nextfile
|
|
(org-check-agenda-file file)
|
|
(unless combine
|
|
(setq ical-file (concat (file-name-sans-extension file) ".ics"))
|
|
(setq ical-buffer (org-get-agenda-file-buffer ical-file))
|
|
(set-buffer ical-buffer) (erase-buffer))
|
|
(set-buffer (org-get-agenda-file-buffer file))
|
|
(setq category (or org-category
|
|
(file-name-sans-extension
|
|
(file-name-nondirectory buffer-file-name))))
|
|
(if (symbolp category) (setq category (symbol-name category)))
|
|
(let ((standard-output ical-buffer))
|
|
(if combine
|
|
(and (not started) (setq started t)
|
|
(org-start-icalendar-file org-icalendar-combined-name))
|
|
(org-start-icalendar-file category))
|
|
(org-print-icalendar-entries combine category)
|
|
(when (or (and combine (not files)) (not combine))
|
|
(org-finish-icalendar-file)
|
|
(set-buffer ical-buffer)
|
|
(save-buffer)
|
|
(run-hooks 'org-after-save-iCalendar-file-hook)))))
|
|
(org-release-buffers org-agenda-new-buffers))))
|
|
|
|
(defvar org-after-save-iCalendar-file-hook nil
|
|
"Hook run after an iCalendar file has been saved.
|
|
The iCalendar buffer is still current when this hook is run.
|
|
A good way to use this is to tell a desktop calenndar application to re-read
|
|
the iCalendar file.")
|
|
|
|
(defun org-print-icalendar-entries (&optional combine category)
|
|
"Print iCalendar entries for the current Org-mode file to `standard-output'.
|
|
When COMBINE is non nil, add the category to each line."
|
|
(let ((re2 (concat "--?-?\\(" org-ts-regexp "\\)"))
|
|
(dts (org-ical-ts-to-string
|
|
(format-time-string (cdr org-time-stamp-formats) (current-time))
|
|
"DTSTART"))
|
|
hd ts ts2 state (inc t) pos scheduledp deadlinep tmp pri)
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(while (re-search-forward org-ts-regexp nil t)
|
|
(setq pos (match-beginning 0)
|
|
ts (match-string 0)
|
|
inc t
|
|
hd (org-get-heading))
|
|
(if (looking-at re2)
|
|
(progn
|
|
(goto-char (match-end 0))
|
|
(setq ts2 (match-string 1) inc nil))
|
|
(setq ts2 ts
|
|
tmp (buffer-substring (max (point-min)
|
|
(- pos org-ds-keyword-length))
|
|
pos)
|
|
deadlinep (string-match org-deadline-regexp tmp)
|
|
scheduledp (string-match org-scheduled-regexp tmp)
|
|
;; donep (org-entry-is-done-p)
|
|
))
|
|
(if (or (string-match org-tr-regexp hd)
|
|
(string-match org-ts-regexp hd))
|
|
(setq hd (replace-match "" t t hd)))
|
|
(if combine
|
|
(setq hd (concat hd " (category " category ")")))
|
|
(if deadlinep (setq hd (concat "DL: " hd " This is a deadline")))
|
|
(if scheduledp (setq hd (concat "S: " hd " Scheduled for this date")))
|
|
(princ (format "BEGIN:VEVENT
|
|
%s
|
|
%s
|
|
SUMMARY:%s
|
|
END:VEVENT\n"
|
|
(org-ical-ts-to-string ts "DTSTART")
|
|
(org-ical-ts-to-string ts2 "DTEND" inc)
|
|
hd)))
|
|
(when org-icalendar-include-todo
|
|
(goto-char (point-min))
|
|
(while (re-search-forward org-todo-line-regexp nil t)
|
|
(setq state (match-string 1))
|
|
(unless (equal state org-done-string)
|
|
(setq hd (match-string 3))
|
|
(if (string-match org-priority-regexp hd)
|
|
(setq pri (string-to-char (match-string 2 hd))
|
|
hd (concat (substring hd 0 (match-beginning 1))
|
|
(substring hd (- (match-end 1)))))
|
|
(setq pri org-default-priority))
|
|
(setq pri (floor (1+ (* 8. (/ (float (- org-lowest-priority pri))
|
|
(- org-lowest-priority ?A))))))
|
|
|
|
(princ (format "BEGIN:VTODO
|
|
%s
|
|
SUMMARY:%s
|
|
SEQUENCE:1
|
|
PRIORITY:%d
|
|
END:VTODO\n"
|
|
dts hd pri))))))))
|
|
|
|
(defun org-start-icalendar-file (name)
|
|
"Start an iCalendar file by inserting the header."
|
|
(let ((user user-full-name)
|
|
(name (or name "unknown"))
|
|
(timezone (cadr (current-time-zone))))
|
|
(princ
|
|
(format "BEGIN:VCALENDAR
|
|
VERSION:2.0
|
|
X-WR-CALNAME:%s
|
|
PRODID:-//%s//Emacs with Org-mode//EN
|
|
X-WR-TIMEZONE:%s
|
|
CALSCALE:GREGORIAN\n" name user timezone))))
|
|
|
|
(defun org-finish-icalendar-file ()
|
|
"Finish an iCalendar file by inserting the END statement."
|
|
(princ "END:VCALENDAR\n"))
|
|
|
|
(defun org-ical-ts-to-string (s keyword &optional inc)
|
|
"Take a time string S and convert it to iCalendar format.
|
|
KEYWORD is added in front, to make a complete line like DTSTART....
|
|
When INC is non-nil, increase the hour by two (if time string contains
|
|
a time), or the day by one (if it does not contain a time)."
|
|
(let ((t1 (org-parse-time-string s 'nodefault))
|
|
t2 fmt have-time time)
|
|
(if (and (car t1) (nth 1 t1) (nth 2 t1))
|
|
(setq t2 t1 have-time t)
|
|
(setq t2 (org-parse-time-string s)))
|
|
(let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2))
|
|
(d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2)))
|
|
(when inc
|
|
(if have-time (setq h (+ 2 h)) (setq d (1+ d))))
|
|
(setq time (encode-time s mi h d m y)))
|
|
(setq fmt (if have-time ":%Y%m%dT%H%M%S" ";VALUE=DATE:%Y%m%d"))
|
|
(concat keyword (format-time-string fmt time))))
|
|
|
|
|
|
;;; Key bindings
|
|
|
|
;; - Bindings in Org-mode map are currently
|
|
;; 0123456789abcdefghijklmnopqrstuvwxyz!?@#$%^&-+*/=()_{}[]:;"|,.<>~`'\t the alphabet
|
|
;; abcd fgh j lmnopqrstuvwxyz!? #$ ^ -+*/= [] ; |,.<>~ '\t necessary bindings
|
|
;; e (?) useful from outline-mode
|
|
;; i k @ expendable from outline-mode
|
|
;; 0123456789 % & ()_{} " ` free
|
|
|
|
;; Make `C-c C-x' a prefix key
|
|
(define-key org-mode-map "\C-c\C-x" (make-sparse-keymap))
|
|
(define-key org-mode-map "\C-c\C-e" (make-sparse-keymap))
|
|
|
|
;; TAB key with modifiers
|
|
(define-key org-mode-map "\C-i" 'org-cycle)
|
|
(define-key org-mode-map [(tab)] 'org-cycle)
|
|
(define-key org-mode-map [(meta tab)] 'org-complete)
|
|
(define-key org-mode-map "\M-\C-i" 'org-complete) ; for tty emacs
|
|
;; The following line is necessary under Suse GNU/Linux
|
|
(unless (featurep 'xemacs)
|
|
(define-key org-mode-map [S-iso-lefttab] 'org-shifttab))
|
|
(define-key org-mode-map [(shift tab)] 'org-shifttab)
|
|
|
|
(define-key org-mode-map (org-key 'S-return) 'org-table-copy-down)
|
|
(define-key org-mode-map "\C-c\C-xc" 'org-table-copy-down) ; tty
|
|
(define-key org-mode-map [(meta shift return)] 'org-insert-todo-heading)
|
|
(define-key org-mode-map "\C-c\C-xM" 'org-insert-todo-heading) ; tty
|
|
(define-key org-mode-map [(meta return)] 'org-meta-return)
|
|
(define-key org-mode-map "\C-c\C-xm" 'org-meta-return) ; tty emacs
|
|
(define-key org-mode-map [?\e (return)] 'org-meta-return) ; tty emacs
|
|
|
|
;; Cursor keys with modifiers
|
|
(define-key org-mode-map [(meta left)] 'org-metaleft)
|
|
(define-key org-mode-map [?\e (left)] 'org-metaleft) ; for tty emacs
|
|
(define-key org-mode-map "\C-c\C-xl" 'org-metaleft) ; for tty emacs
|
|
(define-key org-mode-map [(meta right)] 'org-metaright)
|
|
(define-key org-mode-map [?\e (right)] 'org-metaright) ; for tty emacs
|
|
(define-key org-mode-map "\C-c\C-xr" 'org-metaright) ; for tty emacs
|
|
(define-key org-mode-map [(meta up)] 'org-metaup)
|
|
(define-key org-mode-map [?\e (up)] 'org-metaup) ; for tty emacs
|
|
(define-key org-mode-map "\C-c\C-xu" 'org-metaup) ; for tty emacs
|
|
(define-key org-mode-map [(meta down)] 'org-metadown)
|
|
(define-key org-mode-map [?\e (down)] 'org-metadown) ; for tty emacs
|
|
(define-key org-mode-map "\C-c\C-xd" 'org-metadown) ; for tty emacs
|
|
|
|
(define-key org-mode-map [(meta shift left)] 'org-shiftmetaleft)
|
|
(define-key org-mode-map "\C-c\C-xL" 'org-shiftmetaleft) ; tty
|
|
(define-key org-mode-map [(meta shift right)] 'org-shiftmetaright)
|
|
(define-key org-mode-map "\C-c\C-xR" 'org-shiftmetaright) ; tty
|
|
(define-key org-mode-map [(meta shift up)] 'org-shiftmetaup)
|
|
(define-key org-mode-map "\C-c\C-xU" 'org-shiftmetaup) ; tty
|
|
(define-key org-mode-map [(meta shift down)] 'org-shiftmetadown)
|
|
(define-key org-mode-map "\C-c\C-xD" 'org-shiftmetadown) ; tty
|
|
(define-key org-mode-map (org-key 'S-up) 'org-shiftup)
|
|
(define-key org-mode-map [?\C-c ?\C-x (up)] 'org-shiftup)
|
|
(define-key org-mode-map (org-key 'S-down) 'org-shiftdown)
|
|
(define-key org-mode-map [?\C-c ?\C-x (down)] 'org-shiftdown)
|
|
(define-key org-mode-map (org-key 'S-left) 'org-shiftleft)
|
|
(define-key org-mode-map [?\C-c ?\C-x (left)] 'org-shiftleft)
|
|
(define-key org-mode-map (org-key 'S-right) 'org-shiftright)
|
|
(define-key org-mode-map [?\C-c ?\C-x (right)] 'org-shiftright)
|
|
|
|
;; All the other keys
|
|
|
|
(define-key org-mode-map "\C-c\C-a" 'show-all) ; in case allout messed up.
|
|
(define-key org-mode-map "\C-c$" 'org-archive-subtree)
|
|
(define-key org-mode-map "\C-c\C-j" 'org-goto)
|
|
(define-key org-mode-map "\C-c\C-t" 'org-todo)
|
|
(define-key org-mode-map "\C-c\C-s" 'org-schedule)
|
|
(define-key org-mode-map "\C-c\C-d" 'org-deadline)
|
|
(define-key org-mode-map "\C-c;" 'org-toggle-comment)
|
|
(define-key org-mode-map "\C-c\C-v" 'org-show-todo-tree)
|
|
(define-key org-mode-map "\C-c\C-w" 'org-check-deadlines)
|
|
(define-key org-mode-map "\C-c/" 'org-occur) ; Minor-mode reserved
|
|
(define-key org-mode-map "\C-c\\" 'org-tags-sparse-tree) ; Minor-mode res.
|
|
(define-key org-mode-map "\C-c\C-m" 'org-insert-heading)
|
|
(define-key org-mode-map "\M-\C-m" 'org-insert-heading)
|
|
(define-key org-mode-map "\C-c\C-l" 'org-insert-link)
|
|
(define-key org-mode-map "\C-c\C-o" 'org-open-at-point)
|
|
(define-key org-mode-map "\C-c%" 'org-mark-ring-push)
|
|
(define-key org-mode-map "\C-c&" 'org-mark-ring-goto)
|
|
(define-key org-mode-map "\C-c\C-z" 'org-time-stamp) ; Alternative binding
|
|
(define-key org-mode-map "\C-c." 'org-time-stamp) ; Minor-mode reserved
|
|
(define-key org-mode-map "\C-c!" 'org-time-stamp-inactive) ; Minor-mode r.
|
|
(define-key org-mode-map "\C-c," 'org-priority) ; Minor-mode reserved
|
|
(define-key org-mode-map "\C-c\C-y" 'org-evaluate-time-range)
|
|
(define-key org-mode-map "\C-c>" 'org-goto-calendar)
|
|
(define-key org-mode-map "\C-c<" 'org-date-from-calendar)
|
|
(define-key org-mode-map [(control ?,)] 'org-cycle-agenda-files)
|
|
(define-key org-mode-map "\C-c[" 'org-agenda-file-to-front)
|
|
(define-key org-mode-map "\C-c]" 'org-remove-file)
|
|
(define-key org-mode-map "\C-c\C-r" 'org-timeline)
|
|
(define-key org-mode-map "\C-c-" 'org-table-insert-hline)
|
|
(define-key org-mode-map "\C-c^" 'org-table-sort-lines)
|
|
(define-key org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c)
|
|
(define-key org-mode-map "\C-m" 'org-return)
|
|
(define-key org-mode-map "\C-c?" 'org-table-current-column)
|
|
(define-key org-mode-map "\C-c " 'org-table-blank-field)
|
|
(define-key org-mode-map "\C-c+" 'org-table-sum)
|
|
(define-key org-mode-map "\C-c=" 'org-table-eval-formula)
|
|
(define-key org-mode-map "\C-c'" 'org-table-edit-formulas)
|
|
(define-key org-mode-map "\C-c`" 'org-table-edit-field)
|
|
(define-key org-mode-map "\C-c|" 'org-table-create-or-convert-from-region)
|
|
(define-key org-mode-map "\C-c*" 'org-table-recalculate)
|
|
(define-key org-mode-map [(control ?#)] 'org-table-rotate-recalc-marks)
|
|
(define-key org-mode-map "\C-c~" 'org-table-create-with-table.el)
|
|
(define-key org-mode-map "\C-c\C-q" 'org-table-wrap-region)
|
|
(define-key org-mode-map "\C-c\C-xa" 'org-export-as-ascii)
|
|
(define-key org-mode-map "\C-c\C-x\C-a" 'org-export-as-ascii)
|
|
(define-key org-mode-map "\C-c\C-xv" 'org-export-visible)
|
|
(define-key org-mode-map "\C-c\C-x\C-v" 'org-export-visible)
|
|
;; OPML support is only an option for the future
|
|
;(define-key org-mode-map "\C-c\C-xo" 'org-export-as-opml)
|
|
;(define-key org-mode-map "\C-c\C-x\C-o" 'org-export-as-opml)
|
|
(define-key org-mode-map "\C-c\C-xi" 'org-export-icalendar-this-file)
|
|
(define-key org-mode-map "\C-c\C-x\C-i" 'org-export-icalendar-all-agenda-files)
|
|
(define-key org-mode-map "\C-c\C-xc" 'org-export-icalendar-combine-agenda-files)
|
|
(define-key org-mode-map "\C-c\C-x\C-c" 'org-export-icalendar-combine-agenda-files)
|
|
(define-key org-mode-map "\C-c\C-xt" 'org-insert-export-options-template)
|
|
(define-key org-mode-map "\C-c:" 'org-toggle-fixed-width-section)
|
|
(define-key org-mode-map "\C-c\C-xh" 'org-export-as-html)
|
|
(define-key org-mode-map "\C-c\C-xx" 'org-export-as-xml)
|
|
(define-key org-mode-map "\C-c\C-x\C-x" 'org-export-as-xml)
|
|
(define-key org-mode-map "\C-c\C-xb" 'org-export-as-html-and-open)
|
|
(define-key org-mode-map "\C-c\C-x\C-b" 'org-export-as-html-and-open)
|
|
|
|
(define-key org-mode-map "\C-c\C-x\C-k" 'org-cut-special)
|
|
(define-key org-mode-map "\C-c\C-x\C-w" 'org-cut-special)
|
|
(define-key org-mode-map "\C-c\C-x\M-w" 'org-copy-special)
|
|
(define-key org-mode-map "\C-c\C-x\C-y" 'org-paste-special)
|
|
|
|
(define-key org-mode-map "\C-c\C-ef" 'org-publish-current-file)
|
|
(define-key org-mode-map "\C-c\C-ep" 'org-publish-current-project)
|
|
(define-key org-mode-map "\C-c\C-ec" 'org-publish)
|
|
(define-key org-mode-map "\C-c\C-ea" 'org-publish-all)
|
|
(define-key org-mode-map "\C-c\C-e\C-f" 'org-publish-current-file)
|
|
(define-key org-mode-map "\C-c\C-e\C-p" 'org-publish-current-project)
|
|
(define-key org-mode-map "\C-c\C-e\C-c" 'org-publish)
|
|
(define-key org-mode-map "\C-c\C-e\C-a" 'org-publish-all)
|
|
|
|
(when (featurep 'xemacs)
|
|
(define-key org-mode-map 'button3 'popup-mode-menu))
|
|
|
|
(defsubst org-table-p () (org-at-table-p))
|
|
|
|
(defun org-self-insert-command (N)
|
|
"Like `self-insert-command', use overwrite-mode for whitespace in tables.
|
|
If the cursor is in a table looking at whitespace, the whitespace is
|
|
overwritten, and the table is not marked as requiring realignment."
|
|
(interactive "p")
|
|
(if (and (org-table-p)
|
|
(progn
|
|
;; check if we blank the field, and if that triggers align
|
|
(and org-table-auto-blank-field
|
|
(member last-command
|
|
'(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c))
|
|
(if (or (equal (char-after) ?\ ) (looking-at "[^|\n]* |"))
|
|
;; got extra space, this field does not determine column width
|
|
(let (org-table-may-need-update) (org-table-blank-field))
|
|
;; no extra space, this field may determine column width
|
|
(org-table-blank-field)))
|
|
t)
|
|
(eq N 1)
|
|
(looking-at "[^|\n]* |"))
|
|
(let (org-table-may-need-update)
|
|
(goto-char (1- (match-end 0)))
|
|
(delete-backward-char 1)
|
|
(goto-char (match-beginning 0))
|
|
(self-insert-command N))
|
|
(setq org-table-may-need-update t)
|
|
(self-insert-command N)))
|
|
|
|
(defun org-delete-backward-char (N)
|
|
"Like `delete-backward-char', insert whitespace at field end in tables.
|
|
When deleting backwards, in tables this function will insert whitespace in
|
|
front of the next \"|\" separator, to keep the table aligned. The table will
|
|
still be marked for re-alignment if the field did fill the entire column,
|
|
because, in this case the deletion might narrow the column."
|
|
(interactive "p")
|
|
(if (and (org-table-p)
|
|
(eq N 1)
|
|
(string-match "|" (buffer-substring (point-at-bol) (point)))
|
|
(looking-at ".*?|"))
|
|
(let ((pos (point))
|
|
(noalign (looking-at "[^|\n\r]* |"))
|
|
(c org-table-may-need-update))
|
|
(backward-delete-char N)
|
|
(skip-chars-forward "^|")
|
|
(insert " ")
|
|
(goto-char (1- pos))
|
|
;; noalign: if there were two spaces at the end, this field
|
|
;; does not determine the width of the column.
|
|
(if noalign (setq org-table-may-need-update c)))
|
|
(backward-delete-char N)))
|
|
|
|
(defun org-delete-char (N)
|
|
"Like `delete-char', but insert whitespace at field end in tables.
|
|
When deleting characters, in tables this function will insert whitespace in
|
|
front of the next \"|\" separator, to keep the table aligned. The table will
|
|
still be marked for re-alignment if the field did fill the entire column,
|
|
because, in this case the deletion might narrow the column."
|
|
(interactive "p")
|
|
(if (and (org-table-p)
|
|
(not (bolp))
|
|
(not (= (char-after) ?|))
|
|
(eq N 1))
|
|
(if (looking-at ".*?|")
|
|
(let ((pos (point))
|
|
(noalign (looking-at "[^|\n\r]* |"))
|
|
(c org-table-may-need-update))
|
|
(replace-match (concat
|
|
(substring (match-string 0) 1 -1)
|
|
" |"))
|
|
(goto-char pos)
|
|
;; noalign: if there were two spaces at the end, this field
|
|
;; does not determine the width of the column.
|
|
(if noalign (setq org-table-may-need-update c)))
|
|
(delete-char N))
|
|
(delete-char N)))
|
|
|
|
;; How to do this: Measure non-white length of current string
|
|
;; If equal to column width, we should realign.
|
|
|
|
(defun org-remap (map &rest commands)
|
|
"In MAP, remap the functions given in COMMANDS.
|
|
COMMANDS is a list of alternating OLDDEF NEWDEF command names."
|
|
(let (new old)
|
|
(while commands
|
|
(setq old (pop commands) new (pop commands))
|
|
(if (fboundp 'command-remapping)
|
|
(define-key map (vector 'remap old) new)
|
|
(substitute-key-definition old new map global-map)))))
|
|
|
|
(when (eq org-enable-table-editor 'optimized)
|
|
;; If the user wants maximum table support, we need to hijack
|
|
;; some standard editing functions
|
|
(org-remap org-mode-map
|
|
'self-insert-command 'org-self-insert-command
|
|
'delete-char 'org-delete-char
|
|
'delete-backward-char 'org-delete-backward-char)
|
|
(define-key org-mode-map "|" 'org-force-self-insert))
|
|
|
|
(defun org-shiftcursor-error ()
|
|
"Throw an error because Shift-Cursor command was applied in wrong context."
|
|
(error "This command is active in special context like tables, headlines or timestamps"))
|
|
|
|
(defun org-shifttab ()
|
|
"Global visibility cycling or move to previous table field.
|
|
Calls `org-cycle' with argument t, or `org-table-previous-field', depending
|
|
on context.
|
|
See the individual commands for more information."
|
|
(interactive)
|
|
(cond
|
|
((org-at-table-p) (org-table-previous-field))
|
|
(t (org-global-cycle))))
|
|
|
|
(defun org-shiftmetaleft ()
|
|
"Promote subtree or delete table column.
|
|
Calls `org-promote-subtree' or `org-table-delete-column', depending on context.
|
|
See the individual commands for more information."
|
|
(interactive)
|
|
(cond
|
|
((org-at-table-p) (org-table-delete-column))
|
|
((org-on-heading-p) (org-promote-subtree))
|
|
((org-at-item-p) (call-interactively 'org-outdent-item))
|
|
(t (org-shiftcursor-error))))
|
|
|
|
(defun org-shiftmetaright ()
|
|
"Demote subtree or insert table column.
|
|
Calls `org-demote-subtree' or `org-table-insert-column', depending on context.
|
|
See the individual commands for more information."
|
|
(interactive)
|
|
(cond
|
|
((org-at-table-p) (org-table-insert-column))
|
|
((org-on-heading-p) (org-demote-subtree))
|
|
((org-at-item-p) (call-interactively 'org-indent-item))
|
|
(t (org-shiftcursor-error))))
|
|
|
|
(defun org-shiftmetaup (&optional arg)
|
|
"Move subtree up or kill table row.
|
|
Calls `org-move-subtree-up' or `org-table-kill-row' or
|
|
`org-move-item-up' depending on context. See the individual commands
|
|
for more information."
|
|
(interactive "P")
|
|
(cond
|
|
((org-at-table-p) (org-table-kill-row))
|
|
((org-on-heading-p) (org-move-subtree-up arg))
|
|
((org-at-item-p) (org-move-item-up arg))
|
|
(t (org-shiftcursor-error))))
|
|
(defun org-shiftmetadown (&optional arg)
|
|
"Move subtree down or insert table row.
|
|
Calls `org-move-subtree-down' or `org-table-insert-row' or
|
|
`org-move-item-down', depending on context. See the individual
|
|
commands for more information."
|
|
(interactive "P")
|
|
(cond
|
|
((org-at-table-p) (org-table-insert-row arg))
|
|
((org-on-heading-p) (org-move-subtree-down arg))
|
|
((org-at-item-p) (org-move-item-down arg))
|
|
(t (org-shiftcursor-error))))
|
|
|
|
(defun org-metaleft (&optional arg)
|
|
"Promote heading or move table column to left.
|
|
Calls `org-do-promote' or `org-table-move-column', depending on context.
|
|
With no specific context, calls the Emacs default `backward-word'.
|
|
See the individual commands for more information."
|
|
(interactive "P")
|
|
(cond
|
|
((org-at-table-p) (org-table-move-column 'left))
|
|
((or (org-on-heading-p) (org-region-active-p)) (org-do-promote))
|
|
(t (backward-word (prefix-numeric-value arg)))))
|
|
|
|
(defun org-metaright (&optional arg)
|
|
"Demote subtree or move table column to right.
|
|
Calls `org-do-demote' or `org-table-move-column', depending on context.
|
|
With no specific context, calls the Emacs default `forward-word'.
|
|
See the individual commands for more information."
|
|
(interactive "P")
|
|
(cond
|
|
((org-at-table-p) (org-table-move-column nil))
|
|
((or (org-on-heading-p) (org-region-active-p)) (org-do-demote))
|
|
(t (forward-word (prefix-numeric-value arg)))))
|
|
|
|
(defun org-metaup (&optional arg)
|
|
"Move subtree up or move table row up.
|
|
Calls `org-move-subtree-up' or `org-table-move-row' or
|
|
`org-move-item-up', depending on context. See the individual commands
|
|
for more information."
|
|
(interactive "P")
|
|
(cond
|
|
((org-at-table-p) (org-table-move-row 'up))
|
|
((org-on-heading-p) (org-move-subtree-up arg))
|
|
((org-at-item-p) (org-move-item-up arg))
|
|
(t (org-shiftcursor-error))))
|
|
|
|
(defun org-metadown (&optional arg)
|
|
"Move subtree down or move table row down.
|
|
Calls `org-move-subtree-down' or `org-table-move-row' or
|
|
`org-move-item-down', depending on context. See the individual
|
|
commands for more information."
|
|
(interactive "P")
|
|
(cond
|
|
((org-at-table-p) (org-table-move-row nil))
|
|
((org-on-heading-p) (org-move-subtree-down arg))
|
|
((org-at-item-p) (org-move-item-down arg))
|
|
(t (org-shiftcursor-error))))
|
|
|
|
(defun org-shiftup (&optional arg)
|
|
"Increase item in timestamp or increase priority of current item.
|
|
Calls `org-timestamp-up' or `org-priority-up', depending on context.
|
|
See the individual commands for more information."
|
|
(interactive "P")
|
|
(cond
|
|
((org-at-timestamp-p) (org-timestamp-up arg))
|
|
(t (org-priority-up))))
|
|
|
|
(defun org-shiftdown (&optional arg)
|
|
"Decrease item in timestamp or decrease priority of current item.
|
|
Calls `org-timestamp-down' or `org-priority-down', depending on context.
|
|
See the individual commands for more information."
|
|
(interactive "P")
|
|
(cond
|
|
((org-at-timestamp-p) (org-timestamp-down arg))
|
|
(t (org-priority-down))))
|
|
|
|
(defun org-shiftright ()
|
|
"Next TODO keyword or timestamp one day later, depending on context."
|
|
(interactive)
|
|
(cond
|
|
((org-at-timestamp-p) (org-timestamp-up-day))
|
|
((org-on-heading-p) (org-todo 'right))
|
|
(t (org-shiftcursor-error))))
|
|
|
|
(defun org-shiftleft ()
|
|
"Previous TODO keyword or timestamp one day earlier, depending on context."
|
|
(interactive)
|
|
(cond
|
|
((org-at-timestamp-p) (org-timestamp-down-day))
|
|
((org-on-heading-p) (org-todo 'left))
|
|
(t (org-shiftcursor-error))))
|
|
|
|
(defun org-copy-special ()
|
|
"Copy region in table or copy current subtree.
|
|
Calls `org-table-copy' or `org-copy-subtree', depending on context.
|
|
See the individual commands for more information."
|
|
(interactive)
|
|
(call-interactively
|
|
(if (org-at-table-p) 'org-table-copy-region 'org-copy-subtree)))
|
|
|
|
(defun org-cut-special ()
|
|
"Cut region in table or cut current subtree.
|
|
Calls `org-table-copy' or `org-cut-subtree', depending on context.
|
|
See the individual commands for more information."
|
|
(interactive)
|
|
(call-interactively
|
|
(if (org-at-table-p) 'org-table-cut-region 'org-cut-subtree)))
|
|
|
|
(defun org-paste-special (arg)
|
|
"Paste rectangular region into table, or past subtree relative to level.
|
|
Calls `org-table-paste-rectangle' or `org-paste-subtree', depending on context.
|
|
See the individual commands for more information."
|
|
(interactive "P")
|
|
(if (org-at-table-p)
|
|
(org-table-paste-rectangle)
|
|
(org-paste-subtree arg)))
|
|
|
|
(defun org-ctrl-c-ctrl-c (&optional arg)
|
|
"Set tags in headline, or update according to changed information at point.
|
|
|
|
This command does many different things, depending on context:
|
|
|
|
- If the cursor is in a headline, prompt for tags and insert them
|
|
into the current line, aligned to `org-tags-column'. When called
|
|
with prefix arg, realign all tags in the current buffer.
|
|
|
|
- If the cursor is in one of the special #+KEYWORD lines, this
|
|
triggers scanning the buffer for these lines and updating the
|
|
information.
|
|
|
|
- If the cursor is inside a table, realign the table. This command
|
|
works even if the automatic table editor has been turned off.
|
|
|
|
- If the cursor is on a #+TBLFM line, re-apply the formulas to
|
|
the entire table.
|
|
|
|
- If the cursor is inside a table created by the table.el package,
|
|
activate that table.
|
|
|
|
- If the current buffer is a remember buffer, close note and file it.
|
|
with a prefix argument, file it without further interaction to the default
|
|
location.
|
|
|
|
- If the cursor is on a <<<target>>>, update radio targets and corresponding
|
|
links in this buffer.
|
|
|
|
- If the cursor is on a numbered item in a plain list, renumber the
|
|
ordered list."
|
|
(interactive "P")
|
|
(let ((org-enable-table-editor t))
|
|
(cond
|
|
((and (local-variable-p 'org-finish-function (current-buffer))
|
|
(fboundp org-finish-function))
|
|
(funcall org-finish-function))
|
|
((org-on-target-p) (org-update-radio-target-regexp))
|
|
((org-on-heading-p) (org-set-tags arg))
|
|
((org-at-table.el-p)
|
|
(require 'table)
|
|
(beginning-of-line 1)
|
|
(re-search-forward "|" (save-excursion (end-of-line 2) (point)))
|
|
(table-recognize-table))
|
|
((org-at-table-p)
|
|
(org-table-maybe-eval-formula)
|
|
(if arg
|
|
(org-table-recalculate t)
|
|
(org-table-maybe-recalculate-line))
|
|
(org-table-align))
|
|
((org-at-item-checkbox-p)
|
|
(org-toggle-checkbox))
|
|
((org-at-item-p)
|
|
(org-renumber-ordered-list (prefix-numeric-value arg)))
|
|
((save-excursion (beginning-of-line 1) (looking-at "#\\+\\([A-Z]+\\)"))
|
|
(cond
|
|
((equal (match-string 1) "TBLFM")
|
|
;; Recalculate the table before this line
|
|
(save-excursion
|
|
(beginning-of-line 1)
|
|
(skip-chars-backward " \r\n\t")
|
|
(if (org-at-table-p) (org-table-recalculate t))))
|
|
(t
|
|
(org-mode-restart))))
|
|
(t (error "C-c C-c can do nothing useful at this location.")))))
|
|
|
|
(defun org-mode-restart ()
|
|
"Restart Org-mode, to scan again for special lines.
|
|
Also updates the keyword regular expressions."
|
|
(interactive)
|
|
(let ((org-inhibit-startup t)) (org-mode))
|
|
(message "Org-mode restarted to refresh keyword and special line setup"))
|
|
|
|
(defun org-return ()
|
|
"Goto next table row or insert a newline.
|
|
Calls `org-table-next-row' or `newline', depending on context.
|
|
See the individual commands for more information."
|
|
(interactive)
|
|
(cond
|
|
((org-at-table-p)
|
|
(org-table-justify-field-maybe)
|
|
(org-table-next-row))
|
|
(t (newline))))
|
|
|
|
(defun org-meta-return (&optional arg)
|
|
"Insert a new heading or wrap a region in a table.
|
|
Calls `org-insert-heading' or `org-table-wrap-region', depending on context.
|
|
See the individual commands for more information."
|
|
(interactive "P")
|
|
(cond
|
|
((org-at-table-p)
|
|
(org-table-wrap-region arg))
|
|
(t (org-insert-heading arg))))
|
|
|
|
;;; Menu entries
|
|
|
|
;; Define the Org-mode menus
|
|
(easy-menu-define org-tbl-menu org-mode-map "Tbl menu"
|
|
'("Tbl"
|
|
["Align" org-ctrl-c-ctrl-c (org-at-table-p)]
|
|
["Next Field" org-cycle (org-at-table-p)]
|
|
["Previous Field" org-shifttab (org-at-table-p)]
|
|
["Next Row" org-return (org-at-table-p)]
|
|
"--"
|
|
["Blank Field" org-table-blank-field (org-at-table-p)]
|
|
["Edit Field" org-table-edit-field (org-at-table-p)]
|
|
["Copy Field from Above" org-table-copy-down (org-at-table-p)]
|
|
"--"
|
|
("Column"
|
|
["Move Column Left" org-metaleft (org-at-table-p)]
|
|
["Move Column Right" org-metaright (org-at-table-p)]
|
|
["Delete Column" org-shiftmetaleft (org-at-table-p)]
|
|
["Insert Column" org-shiftmetaright (org-at-table-p)]
|
|
"--"
|
|
["Enable Narrowing" (setq org-table-limit-column-width (not org-table-limit-column-width)) :active (org-at-table-p) :selected org-table-limit-column-width :style toggle])
|
|
("Row"
|
|
["Move Row Up" org-metaup (org-at-table-p)]
|
|
["Move Row Down" org-metadown (org-at-table-p)]
|
|
["Delete Row" org-shiftmetaup (org-at-table-p)]
|
|
["Insert Row" org-shiftmetadown (org-at-table-p)]
|
|
["Sort lines in region" org-table-sort-lines (org-at-table-p)]
|
|
"--"
|
|
["Insert Hline" org-table-insert-hline (org-at-table-p)])
|
|
("Rectangle"
|
|
["Copy Rectangle" org-copy-special (org-at-table-p)]
|
|
["Cut Rectangle" org-cut-special (org-at-table-p)]
|
|
["Paste Rectangle" org-paste-special (org-at-table-p)]
|
|
["Fill Rectangle" org-table-wrap-region (org-at-table-p)])
|
|
"--"
|
|
("Calculate"
|
|
["Set Column Formula" org-table-eval-formula (org-at-table-p)]
|
|
["Set Named Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
|
|
["Edit Formulas" org-table-edit-formulas (org-at-table-p)]
|
|
"--"
|
|
["Recalculate line" org-table-recalculate (org-at-table-p)]
|
|
["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"]
|
|
["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)]
|
|
"--"
|
|
["Sum Column/Rectangle" org-table-sum
|
|
(or (org-at-table-p) (org-region-active-p))]
|
|
["Which Column?" org-table-current-column (org-at-table-p)])
|
|
["Debug Formulas"
|
|
(setq org-table-formula-debug (not org-table-formula-debug))
|
|
:style toggle :selected org-table-formula-debug]
|
|
"--"
|
|
["Create" org-table-create (and (not (org-at-table-p))
|
|
org-enable-table-editor)]
|
|
["Convert Region" org-table-convert-region (not (org-at-table-p 'any))]
|
|
["Import from File" org-table-import (not (org-at-table-p))]
|
|
["Export to File" org-table-export (org-at-table-p)]
|
|
"--"
|
|
["Create/Convert from/to table.el" org-table-create-with-table.el t]))
|
|
|
|
(easy-menu-define org-org-menu org-mode-map "Org menu"
|
|
'("Org"
|
|
["Cycle Visibility" org-cycle (or (bobp) (outline-on-heading-p))]
|
|
["Cycle Global Visibility" org-shifttab (not (org-at-table-p))]
|
|
["Sparse Tree" org-occur t]
|
|
["Show All" show-all t]
|
|
"--"
|
|
["New Heading" org-insert-heading t]
|
|
("Navigate Headings"
|
|
["Up" outline-up-heading t]
|
|
["Next" outline-next-visible-heading t]
|
|
["Previous" outline-previous-visible-heading t]
|
|
["Next Same Level" outline-forward-same-level t]
|
|
["Previous Same Level" outline-backward-same-level t]
|
|
"--"
|
|
["Jump" org-goto t])
|
|
("Edit Structure"
|
|
["Move Subtree Up" org-shiftmetaup (not (org-at-table-p))]
|
|
["Move Subtree Down" org-shiftmetadown (not (org-at-table-p))]
|
|
"--"
|
|
["Copy Subtree" org-copy-special (not (org-at-table-p))]
|
|
["Cut Subtree" org-cut-special (not (org-at-table-p))]
|
|
["Paste Subtree" org-paste-special (not (org-at-table-p))]
|
|
"--"
|
|
["Promote Heading" org-metaleft (not (org-at-table-p))]
|
|
["Promote Subtree" org-shiftmetaleft (not (org-at-table-p))]
|
|
["Demote Heading" org-metaright (not (org-at-table-p))]
|
|
["Demote Subtree" org-shiftmetaright (not (org-at-table-p))]
|
|
"--"
|
|
["Archive Subtree" org-archive-subtree t]
|
|
"--"
|
|
["Convert to odd levels" org-convert-to-odd-levels t]
|
|
["Convert to odd/even levels" org-convert-to-oddeven-levels t])
|
|
"--"
|
|
("TODO Lists"
|
|
["TODO/DONE/-" org-todo t]
|
|
["Show TODO Tree" org-show-todo-tree t]
|
|
["Global TODO list" org-todo-list t]
|
|
"--"
|
|
["Set Priority" org-priority t]
|
|
["Priority Up" org-shiftup t]
|
|
["Priority Down" org-shiftdown t])
|
|
("Dates and Scheduling"
|
|
["Timestamp" org-time-stamp t]
|
|
["Timestamp (inactive)" org-time-stamp-inactive t]
|
|
("Change Date"
|
|
["1 Day Later" org-timestamp-up-day t]
|
|
["1 Day Earlier" org-timestamp-down-day t]
|
|
["1 ... Later" org-shiftup t]
|
|
["1 ... Earlier" org-shiftdown t])
|
|
["Compute Time Range" org-evaluate-time-range t]
|
|
["Schedule Item" org-schedule t]
|
|
["Deadline" org-deadline t]
|
|
"--"
|
|
["Goto Calendar" org-goto-calendar t]
|
|
["Date from Calendar" org-date-from-calendar t])
|
|
"--"
|
|
["Agenda Command" org-agenda t]
|
|
("File List for Agenda")
|
|
("Special views current file"
|
|
["TODO Tree" org-show-todo-tree t]
|
|
["Check Deadlines" org-check-deadlines t]
|
|
["Timeline" org-timeline t]
|
|
["Tags Tree" org-tags-sparse-tree t])
|
|
"--"
|
|
("Hyperlinks"
|
|
["Store Link (Global)" org-store-link t]
|
|
["Insert Link" org-insert-link t]
|
|
["Follow Link" org-open-at-point t]
|
|
"--"
|
|
["Descriptive Links"
|
|
(progn (org-add-to-invisibility-spec '(org-link)) (org-restart-font-lock))
|
|
:style radio :selected (member '(org-link) buffer-invisibility-spec)]
|
|
["Literal Links"
|
|
(progn
|
|
(org-remove-from-invisibility-spec '(org-link)) (org-restart-font-lock))
|
|
:style radio :selected (not (member '(org-link) buffer-invisibility-spec))]
|
|
"--"
|
|
["Upgrade all <link> to [[link][desc]]" org-upgrade-old-links
|
|
(save-excursion (goto-char (point-min))
|
|
(re-search-forward "<[a-z]+:" nil t))])
|
|
"--"
|
|
("Export"
|
|
["ASCII" org-export-as-ascii t]
|
|
["Export visible part..." org-export-visible t]
|
|
["HTML" org-export-as-html t]
|
|
["HTML and Open" org-export-as-html-and-open t]
|
|
["XOXO" org-export-as-xml t]
|
|
"--"
|
|
["iCalendar this file" org-export-icalendar-this-file t]
|
|
["iCalendar all agenda files" org-export-icalendar-all-agenda-files
|
|
:active t :keys "C-c C-x C-i"]
|
|
["iCalendar combined" org-export-icalendar-combine-agenda-files t]
|
|
"--"
|
|
["Option Template" org-insert-export-options-template t]
|
|
["Toggle Fixed Width" org-toggle-fixed-width-section t])
|
|
("Publish"
|
|
["Current File" org-publish-current-file t]
|
|
["Current Project" org-publish-current-project t]
|
|
["Project..." org-publish t]
|
|
["All Projects" org-publish-all t])
|
|
"--"
|
|
("Documentation"
|
|
["Show Version" org-version t]
|
|
["Info Documentation" org-info t])
|
|
("Customize"
|
|
["Browse Org Group" org-customize t]
|
|
"--"
|
|
["Expand This Menu" org-create-customize-menu
|
|
(fboundp 'customize-menu-create)])
|
|
"--"
|
|
["Refresh setup" org-mode-restart t]
|
|
))
|
|
|
|
(defun org-info (&optional node)
|
|
"Read documentation for Org-mode in the info system.
|
|
With optional NODE, go directly to that node."
|
|
(interactive)
|
|
(require 'info)
|
|
(Info-goto-node (format "(org)%s" (or node ""))))
|
|
|
|
(defun org-install-agenda-files-menu ()
|
|
(let ((bl (buffer-list)))
|
|
(save-excursion
|
|
(while bl
|
|
(set-buffer (pop bl))
|
|
(if (eq major-mode 'org-mode) (setq bl nil)))
|
|
(when (eq major-mode 'org-mode)
|
|
(easy-menu-change
|
|
'("Org") "File List for Agenda"
|
|
(append
|
|
(list
|
|
["Edit File List" (org-edit-agenda-file-list) t]
|
|
["Add/Move Current File to Front of List" org-agenda-file-to-front t]
|
|
["Remove Current File from List" org-remove-file t]
|
|
["Cycle through agenda files" org-cycle-agenda-files t]
|
|
"--")
|
|
(mapcar 'org-file-menu-entry (org-agenda-files t))))))))
|
|
|
|
;;; Documentation
|
|
|
|
(defun org-customize ()
|
|
"Call the customize function with org as argument."
|
|
(interactive)
|
|
(customize-browse 'org))
|
|
|
|
(defun org-create-customize-menu ()
|
|
"Create a full customization menu for Org-mode, insert it into the menu."
|
|
(interactive)
|
|
(if (fboundp 'customize-menu-create)
|
|
(progn
|
|
(easy-menu-change
|
|
'("Org") "Customize"
|
|
`(["Browse Org group" org-customize t]
|
|
"--"
|
|
,(customize-menu-create 'org)
|
|
["Set" Custom-set t]
|
|
["Save" Custom-save t]
|
|
["Reset to Current" Custom-reset-current t]
|
|
["Reset to Saved" Custom-reset-saved t]
|
|
["Reset to Standard Settings" Custom-reset-standard t]))
|
|
(message "\"Org\"-menu now contains full customization menu"))
|
|
(error "Cannot expand menu (outdated version of cus-edit.el)")))
|
|
|
|
;;; Miscellaneous stuff
|
|
|
|
(defun org-move-line-down (arg)
|
|
"Move the current line down. With prefix argument, move it past ARG lines."
|
|
(interactive "p")
|
|
(let ((col (current-column))
|
|
beg end pos)
|
|
(beginning-of-line 1) (setq beg (point))
|
|
(beginning-of-line 2) (setq end (point))
|
|
(beginning-of-line (+ 1 arg))
|
|
(setq pos (move-marker (make-marker) (point)))
|
|
(insert (delete-and-extract-region beg end))
|
|
(goto-char pos)
|
|
(move-to-column col)))
|
|
|
|
(defun org-move-line-up (arg)
|
|
"Move the current line up. With prefix argument, move it past ARG lines."
|
|
(interactive "p")
|
|
(let ((col (current-column))
|
|
beg end pos)
|
|
(beginning-of-line 1) (setq beg (point))
|
|
(beginning-of-line 2) (setq end (point))
|
|
(beginning-of-line (- arg))
|
|
(setq pos (move-marker (make-marker) (point)))
|
|
(insert (delete-and-extract-region beg end))
|
|
(goto-char pos)
|
|
(move-to-column col)))
|
|
|
|
;; Paragraph filling stuff.
|
|
;; We want this to be just right, so use the full arsenal.
|
|
;; FIXME: This very likely does not work correctly for XEmacs, because the
|
|
;; filladapt package works slightly differently.
|
|
|
|
(defun org-set-autofill-regexps ()
|
|
(interactive)
|
|
;; In the paragraph separator we include headlines, because filling
|
|
;; text in a line directly attached to a headline would otherwise
|
|
;; fill the headline as well.
|
|
(set (make-local-variable 'paragraph-separate) "\f\\|\\*\\|[ ]*$\\|[ \t]*[:|]")
|
|
;; The paragraph starter includes hand-formatted lists.
|
|
(set (make-local-variable 'paragraph-start)
|
|
"\f\\|[ ]*$\\|\\([*\f]+\\)\\|[ \t]*\\([-+*]\\|[0-9]+[.)][ \t]+\\)\\|[ \t]*[:|]")
|
|
;; Inhibit auto-fill for headers, tables and fixed-width lines.
|
|
;; But only if the user has not turned off tables or fixed-width regions
|
|
(set (make-local-variable 'auto-fill-inhibit-regexp)
|
|
(concat "\\*\\|#"
|
|
(if (or org-enable-table-editor org-enable-fixed-width-editor)
|
|
(concat
|
|
"\\|[ \t]*["
|
|
(if org-enable-table-editor "|" "")
|
|
(if org-enable-fixed-width-editor ":" "")
|
|
"]"))))
|
|
;; We use our own fill-paragraph function, to make sure that tables
|
|
;; and fixed-width regions are not wrapped. That function will pass
|
|
;; through to `fill-paragraph' when appropriate.
|
|
(set (make-local-variable 'fill-paragraph-function) 'org-fill-paragraph)
|
|
;; Adaptive filling: To get full control, first make sure that
|
|
;; `adaptive-fill-regexp' never matches. Then install our own matcher.
|
|
(set (make-local-variable 'adaptive-fill-regexp) "\000")
|
|
(set (make-local-variable 'adaptive-fill-function)
|
|
'org-adaptive-fill-function))
|
|
|
|
(defun org-fill-paragraph (&optional justify)
|
|
"Re-align a table, pass through to fill-paragraph if no table."
|
|
(let ((table-p (org-at-table-p))
|
|
(table.el-p (org-at-table.el-p)))
|
|
(cond ((equal (char-after (point-at-bol)) ?*) t) ; skip headlines
|
|
(table.el-p t) ; skip table.el tables
|
|
(table-p (org-table-align) t) ; align org-mode tables
|
|
(t nil)))) ; call paragraph-fill
|
|
|
|
;; For reference, this is the default value of adaptive-fill-regexp
|
|
;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*"
|
|
|
|
(defun org-adaptive-fill-function ()
|
|
"Return a fill prefix for org-mode files.
|
|
In particular, this makes sure hanging paragraphs for hand-formatted lists
|
|
work correctly."
|
|
(if (looking-at " *\\([-*+] \\|[0-9]+[.)] \\)?")
|
|
(make-string (- (match-end 0) (match-beginning 0)) ?\ )))
|
|
|
|
;; Functions needed for Emacs/XEmacs region compatibility
|
|
|
|
(defun org-add-hook (hook function &optional append local)
|
|
"Add-hook, compatible with both Emacsen."
|
|
(if (and local (featurep 'xemacs))
|
|
(add-local-hook hook function append)
|
|
(add-hook hook function append local)))
|
|
|
|
(defun org-region-active-p ()
|
|
"Is `transient-mark-mode' on and the region active?
|
|
Works on both Emacs and XEmacs."
|
|
(if org-ignore-region
|
|
nil
|
|
(if (featurep 'xemacs)
|
|
(and zmacs-regions (region-active-p))
|
|
(and transient-mark-mode mark-active))))
|
|
|
|
(defun org-add-to-invisibility-spec (arg)
|
|
"Add elements to `buffer-invisibility-spec'.
|
|
See documentation for `buffer-invisibility-spec' for the kind of elements
|
|
that can be added."
|
|
(cond
|
|
((fboundp 'add-to-invisibility-spec)
|
|
(add-to-invisibility-spec arg))
|
|
((or (null buffer-invisibility-spec) (eq buffer-invisibility-spec t))
|
|
(setq buffer-invisibility-spec (list arg)))
|
|
(t
|
|
(setq buffer-invisibility-spec
|
|
(cons arg buffer-invisibility-spec)))))
|
|
|
|
(defun org-remove-from-invisibility-spec (arg)
|
|
"Remove elements from `buffer-invisibility-spec'."
|
|
(if (fboundp 'remove-from-invisibility-spec)
|
|
(remove-from-invisibility-spec arg)
|
|
(if (consp buffer-invisibility-spec)
|
|
(setq buffer-invisibility-spec
|
|
(delete arg buffer-invisibility-spec)))))
|
|
|
|
(defun org-in-invisibility-spec-p (arg)
|
|
"Is ARG a member of `buffer-invisibility-spec'?"
|
|
(if (consp buffer-invisibility-spec)
|
|
(member arg buffer-invisibility-spec)
|
|
nil))
|
|
|
|
(defun org-image-file-name-regexp ()
|
|
"Return regexp matching the file names of images."
|
|
(if (fboundp 'image-file-name-regexp)
|
|
(image-file-name-regexp)
|
|
(let ((image-file-name-extensions
|
|
'("png" "jpeg" "jpg" "gif" "tiff" "tif"
|
|
"xbm" "xpm" "pbm" "pgm" "ppm")))
|
|
(concat "\\."
|
|
(regexp-opt (nconc (mapcar 'upcase
|
|
image-file-name-extensions)
|
|
image-file-name-extensions)
|
|
t)
|
|
"\\'"))))
|
|
|
|
;; Functions needed for compatibility with old outline.el.
|
|
|
|
;; Programming for the old outline.el (that uses selective display
|
|
;; instead of `invisible' text properties) is a nightmare, mostly
|
|
;; because regular expressions can no longer be anchored at
|
|
;; beginning/end of line. Therefore a number of function need special
|
|
;; treatment when the old outline.el is being used.
|
|
|
|
;; The following functions capture almost the entire compatibility code
|
|
;; between the different versions of outline-mode. The only other
|
|
;; places where this is important are the font-lock-keywords, and in
|
|
;; `org-export-visible'. Search for `org-noutline-p' to find them.
|
|
|
|
;; C-a should go to the beginning of a *visible* line, also in the
|
|
;; new outline.el. I guess this should be patched into Emacs?
|
|
(defun org-beginning-of-line ()
|
|
"Go to the beginning of the current line. If that is invisible, continue
|
|
to a visible line beginning. This makes the function of C-a more intuitive."
|
|
(interactive)
|
|
(beginning-of-line 1)
|
|
(if (bobp)
|
|
nil
|
|
(backward-char 1)
|
|
(if (org-invisible-p)
|
|
(while (and (not (bobp)) (org-invisible-p))
|
|
(backward-char 1)
|
|
(beginning-of-line 1))
|
|
(forward-char 1))))
|
|
|
|
(when org-noutline-p
|
|
(define-key org-mode-map "\C-a" 'org-beginning-of-line))
|
|
;; FIXME: should I use substitute-key-definition to reach other bindings
|
|
;; of beginning-of-line?
|
|
|
|
(defun org-invisible-p ()
|
|
"Check if point is at a character currently not visible."
|
|
(if org-noutline-p
|
|
;; Early versions of noutline don't have `outline-invisible-p'.
|
|
(if (fboundp 'outline-invisible-p)
|
|
(outline-invisible-p)
|
|
(get-char-property (point) 'invisible))
|
|
(save-excursion
|
|
(skip-chars-backward "^\r\n")
|
|
(equal (char-before) ?\r))))
|
|
|
|
(defun org-invisible-p2 ()
|
|
"Check if point is at a character currently not visible."
|
|
(save-excursion
|
|
(if org-noutline-p
|
|
(progn
|
|
(if (and (eolp) (not (bobp))) (backward-char 1))
|
|
;; Early versions of noutline don't have `outline-invisible-p'.
|
|
(if (fboundp 'outline-invisible-p)
|
|
(outline-invisible-p)
|
|
(get-char-property (point) 'invisible)))
|
|
(skip-chars-backward "^\r\n")
|
|
(equal (char-before) ?\r))))
|
|
|
|
(defun org-back-to-heading (&optional invisible-ok)
|
|
"Move to previous heading line, or beg of this line if it's a heading.
|
|
Only visible heading lines are considered, unless INVISIBLE-OK is non-nil."
|
|
(if org-noutline-p
|
|
(outline-back-to-heading invisible-ok)
|
|
(if (and (or (bobp) (memq (char-before) '(?\n ?\r)))
|
|
(looking-at outline-regexp))
|
|
t
|
|
(if (re-search-backward (concat (if invisible-ok "\\([\r\n]\\|^\\)" "^")
|
|
outline-regexp)
|
|
nil t)
|
|
(if invisible-ok
|
|
(progn (goto-char (or (match-end 1) (match-beginning 0)))
|
|
(looking-at outline-regexp)))
|
|
(error "Before first heading")))))
|
|
|
|
(defun org-on-heading-p (&optional invisible-ok)
|
|
"Return t if point is on a (visible) heading line.
|
|
If INVISIBLE-OK is non-nil, an invisible heading line is ok too."
|
|
(if org-noutline-p
|
|
(outline-on-heading-p 'invisible-ok)
|
|
(save-excursion
|
|
(skip-chars-backward "^\n\r")
|
|
(and (looking-at outline-regexp)
|
|
(or invisible-ok
|
|
(bobp)
|
|
(equal (char-before) ?\n))))))
|
|
|
|
(defun org-on-target-p ()
|
|
(let ((pos (point)))
|
|
(save-excursion
|
|
(skip-chars-forward "<")
|
|
(and (re-search-backward "<<" nil t)
|
|
(or (looking-at org-radio-target-regexp)
|
|
(looking-at org-target-regexp))
|
|
(<= (match-beginning 0) pos)
|
|
(>= (1+ (match-end 0)) pos)))))
|
|
|
|
(defun org-up-heading-all (arg)
|
|
"Move to the heading line of which the present line is a subheading.
|
|
This function considers both visible and invisible heading lines.
|
|
With argument, move up ARG levels."
|
|
(if org-noutline-p
|
|
(if (fboundp 'outline-up-heading-all)
|
|
(outline-up-heading-all arg) ; emacs 21 version of outline.el
|
|
(outline-up-heading arg t)) ; emacs 22 version of outline.el
|
|
(org-back-to-heading t)
|
|
(looking-at outline-regexp)
|
|
(if (<= (- (match-end 0) (match-beginning 0)) arg)
|
|
(error "Cannot move up %d levels" arg)
|
|
(re-search-backward
|
|
(concat "[\n\r]" (regexp-quote
|
|
(make-string (- (match-end 0) (match-beginning 0) arg)
|
|
?*))
|
|
"[^*]"))
|
|
(forward-char 1))))
|
|
|
|
(defun org-show-hidden-entry ()
|
|
"Show an entry where even the heading is hidden."
|
|
(save-excursion
|
|
(if (not org-noutline-p)
|
|
(progn
|
|
(org-back-to-heading t)
|
|
(org-flag-heading nil)))
|
|
(org-show-entry)))
|
|
|
|
(defun org-check-occur-regexp (regexp)
|
|
"If REGEXP starts with \"^\", modify it to check for \\r as well.
|
|
Of course, only for the old outline mode."
|
|
(if org-noutline-p
|
|
regexp
|
|
(if (string-match "^\\^" regexp)
|
|
(concat "[\n\r]" (substring regexp 1))
|
|
regexp)))
|
|
|
|
(defun org-flag-heading (flag &optional entry)
|
|
"Flag the current heading. FLAG non-nil means make invisible.
|
|
When ENTRY is non-nil, show the entire entry."
|
|
(save-excursion
|
|
(org-back-to-heading t)
|
|
(if (not org-noutline-p)
|
|
;; Make the current headline visible
|
|
(outline-flag-region (max 1 (1- (point))) (point) (if flag ?\r ?\n)))
|
|
;; Check if we should show the entire entry
|
|
(if entry
|
|
(progn
|
|
(org-show-entry)
|
|
(save-excursion ;; FIXME: Is this the fix for points in the -|
|
|
;; middle of text? |
|
|
(and (outline-next-heading) ;; |
|
|
(org-flag-heading nil)))) ; show the next heading _|
|
|
(outline-flag-region (max 1 (1- (point)))
|
|
(save-excursion (outline-end-of-heading) (point))
|
|
(if org-noutline-p
|
|
flag
|
|
(if flag ?\r ?\n))))))
|
|
|
|
(defun org-end-of-subtree (&optional invisible-OK)
|
|
;; This is an exact copy of the original function, but it uses
|
|
;; `org-back-to-heading', to make it work also in invisible
|
|
;; trees. And is uses an invisible-OK argument.
|
|
;; Under Emacs this is not needed, but the old outline.el needs this fix.
|
|
(org-back-to-heading invisible-OK)
|
|
(let ((first t)
|
|
(level (funcall outline-level)))
|
|
(while (and (not (eobp))
|
|
(or first (> (funcall outline-level) level)))
|
|
(setq first nil)
|
|
(outline-next-heading))
|
|
(if (memq (preceding-char) '(?\n ?\^M))
|
|
(progn
|
|
;; Go to end of line before heading
|
|
(forward-char -1)
|
|
(if (memq (preceding-char) '(?\n ?\^M))
|
|
;; leave blank line before heading
|
|
(forward-char -1))))))
|
|
|
|
(defun org-show-subtree ()
|
|
"Show everything after this heading at deeper levels."
|
|
(outline-flag-region
|
|
(point)
|
|
(save-excursion
|
|
(outline-end-of-subtree) (outline-next-heading) (point))
|
|
(if org-noutline-p nil ?\n)))
|
|
|
|
(defun org-show-entry ()
|
|
"Show the body directly following this heading.
|
|
Show the heading too, if it is currently invisible."
|
|
(interactive)
|
|
(save-excursion
|
|
(org-back-to-heading t)
|
|
(outline-flag-region
|
|
(max 1 (1- (point)))
|
|
(save-excursion
|
|
(re-search-forward (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move)
|
|
(or (match-beginning 1) (point-max)))
|
|
(if org-noutline-p nil ?\n))))
|
|
|
|
(defun org-make-options-regexp (kwds)
|
|
"Make a regular expression for keyword lines."
|
|
(concat
|
|
(if org-noutline-p "^" "[\n\r]")
|
|
"#?[ \t]*\\+\\("
|
|
(mapconcat 'regexp-quote kwds "\\|")
|
|
"\\):[ \t]*"
|
|
(if org-noutline-p "\\(.+\\)" "\\([^\n\r]+\\)")))
|
|
|
|
;; Make `bookmark-jump' show the jump location if it was hidden.
|
|
(eval-after-load "bookmark"
|
|
'(if (boundp 'bookmark-after-jump-hook)
|
|
;; We can use the hook
|
|
(add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide)
|
|
;; Hook not available, use advice
|
|
(defadvice bookmark-jump (after org-make-visible activate)
|
|
"Make the position visible."
|
|
(org-bookmark-jump-unhide))))
|
|
|
|
(defun org-bookmark-jump-unhide ()
|
|
"Unhide the current position, to show the bookmark location."
|
|
(and (eq major-mode 'org-mode)
|
|
(or (org-invisible-p)
|
|
(save-excursion (goto-char (max (point-min) (1- (point))))
|
|
(org-invisible-p)))
|
|
(org-show-hierarchy-above)))
|
|
|
|
;;; Finish up
|
|
|
|
(provide 'org)
|
|
|
|
(run-hooks 'org-load-hook)
|
|
|
|
|
|
;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd
|
|
;;; org.el ends here
|
|
|