;;; org.el --- Outline-based notes management and organizer
;; Carstens outline-mode for keeping track of everything.
-;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009
+;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 6.21b
+;; Version: 6.33x
;;
;; This file is part of GNU Emacs.
;;
(require 'org-compat)
(require 'org-faces)
(require 'org-list)
+(require 'org-src)
(require 'org-footnote)
;;;; Customization variables
;;; Version
-(defconst org-version "6.21b"
+(defconst org-version "6.33x"
"The version number of the file org.el.")
(defun org-version (&optional here)
"Show the org-mode version in the echo area.
With prefix arg HERE, insert it at point."
(interactive "P")
- (let ((version (format "Org-mode version %s" org-version)))
- (message version)
- (if here
- (insert version))))
+ (let* ((origin default-directory)
+ (version org-version)
+ (git-version)
+ (dir (concat (file-name-directory (locate-library "org")) "../" )))
+ (when (and (file-exists-p (expand-file-name ".git" dir))
+ (executable-find "git"))
+ (unwind-protect
+ (progn
+ (cd dir)
+ (when (eql 0 (shell-command "git describe --abbrev=4 HEAD"))
+ (with-current-buffer "*Shell Command Output*"
+ (goto-char (point-min))
+ (setq git-version (buffer-substring (point) (point-at-eol))))
+ (subst-char-in-string ?- ?. git-version t)
+ (when (string-match "\\S-"
+ (shell-command-to-string
+ "git diff-index --name-only HEAD --"))
+ (setq git-version (concat git-version ".dirty")))
+ (setq version (concat version " (" git-version ")"))))
+ (cd origin)))
+ (setq version (format "Org-mode version %s" version))
+ (if here (insert version))
+ (message version)))
;;; Compatibility constants
:group 'hypermedia
:group 'calendar)
+(defcustom org-mode-hook nil
+ "Mode hook for Org-mode, run after the mode was turned on."
+ :group 'org
+ :type 'hook)
+
(defcustom org-load-hook nil
"Hook that is run after org.el has been loaded."
:group 'org
the org-mode distribution.
You can also use this system to load external packages (i.e. neither Org
-core modules, not modules from the CONTRIB directory). Just add symbols
+core modules, nor modules from the CONTRIB directory). Just add symbols
to the end of the list. If the package is called org-xyz.el, then you need
to add the symbol `xyz', and the package must have a call to
'(set :greedy t
(const :tag " bbdb: Links to BBDB entries" org-bbdb)
(const :tag " bibtex: Links to BibTeX entries" org-bibtex)
+ (const :tag " crypt: Encryption of subtrees" org-crypt)
(const :tag " gnus: Links to GNUS folders/messages" org-gnus)
(const :tag " id: Global IDs for identifying entries" org-id)
(const :tag " info: Links to Info nodes" org-info)
(const :tag " jsinfo: Set up Sebastian Rose's JavaScript org-info.js" org-jsinfo)
+ (const :tag " habit: Track your consistency with habits" org-habit)
+ (const :tag " inlinetask: Tasks independent of outline hierarchy" org-inlinetask)
(const :tag " irc: Links to IRC/ERC chat sessions" org-irc)
(const :tag " mac-message: Links to messages in Apple Mail" org-mac-message)
(const :tag " mew Links to Mew folders/messages" org-mew)
(const :tag " mhe: Links to MHE folders/messages" org-mhe)
+ (const :tag " protocol: Intercept calls from emacsclient" org-protocol)
(const :tag " rmail: Links to RMAIL folders/messages" org-rmail)
(const :tag " vm: Links to VM folders/messages" org-vm)
(const :tag " wl: Links to Wanderlust folders/messages" org-wl)
- (const :tag " w3m: Special cut/past from w3m to Org." org-w3m)
+ (const :tag " w3m: Special cut/paste from w3m to Org-mode." org-w3m)
(const :tag " mouse: Additional mouse support" org-mouse)
(const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file)
- (const :tag "C annotation-helper: Call Remember directly from Browser" org-annotation-helper)
- (const :tag "C bookmark: Org links to bookmarks" org-bookmark)
- (const :tag "C browser-url: Store link, directly from Browser" org-browser-url)
- (const :tag "C depend: TODO dependencies for Org-mode" org-depend)
- (const :tag "C elisp-symbol: Org links to emacs-lisp symbols" org-elisp-symbol)
+ (const :tag "C bookmark: Org-mode links to bookmarks" org-bookmark)
+ (const :tag "C checklist: Extra functions for checklists in repeated tasks" org-checklist)
+ (const :tag "C choose: Use TODO keywords to mark decisions states" org-choose)
+ (const :tag "C collector: Collect properties into tables" org-collector)
+ (const :tag "C depend: TODO dependencies for Org-mode\n\t\t\t(PARTIALLY OBSOLETE, see built-in dependency support))" org-depend)
+ (const :tag "C elisp-symbol: Org-mode links to emacs-lisp symbols" org-elisp-symbol)
(const :tag "C eval: Include command output as text" org-eval)
(const :tag "C eval-light: Evaluate inbuffer-code on demand" org-eval-light)
- (const :tag "C expiry: Expiry mechanism for Org entries" org-expiry)
- (const :tag "C exp-blocks: Pre-process blocks for export" org-exp-blocks)
- (const :tag "C interactive-query: Interactive modification of tags query" org-interactive-query)
- (const :tag "C mairix: Hook mairix search into Org for different MUAs" org-mairix)
+ (const :tag "C expiry: Expiry mechanism for Org-mode entries" org-expiry)
+ (const :tag "C exp-bibtex: Export citations using BibTeX" org-exp-bibtex)
+ (const :tag "C git-link: Provide org links to specific file version" org-git-link)
+ (const :tag "C interactive-query: Interactive modification of tags query\n\t\t\t(PARTIALLY OBSOLETE, see secondary filtering)" org-interactive-query)
+
+ (const :tag "C invoice: Help manage client invoices in Org-mode" org-invoice)
+
+ (const :tag "C jira: Add a jira:ticket protocol to Org-mode" org-jira)
+ (const :tag "C learn: SuperMemo's incremental learning algorithm" org-learn)
+ (const :tag "C mairix: Hook mairix search into Org-mode for different MUAs" org-mairix)
+ (const :tag "C mac-iCal Imports events from iCal.app to the Emacs diary" org-mac-iCal)
(const :tag "C man: Support for links to manpages in Org-mode" org-man)
(const :tag "C mtags: Support for muse-like tags" org-mtags)
(const :tag "C panel: Simple routines for us with bad memory" org-panel)
- (const :tag "C registry: A registry for Org links" org-registry)
+ (const :tag "C R: Computation using the R language" org-R)
+ (const :tag "C registry: A registry for Org-mode links" org-registry)
(const :tag "C org2rem: Convert org appointments into reminders" org2rem)
(const :tag "C screen: Visit screen sessions through Org-mode links" org-screen)
- (const :tag "C toc: Table of contents for Org-mode buffer" org-toc)
+ (const :tag "C special-blocks: Turn blocks into LaTeX envs and HTML divs" org-special-blocks)
(const :tag "C sqlinsert: Convert Org-mode tables to SQL insertions" orgtbl-sqlinsert)
+ (const :tag "C toc: Table of contents for Org-mode buffer" org-toc)
+ (const :tag "C track: Keep up with Org-mode development" org-track)
(repeat :tag "External packages" :inline t (symbol :tag "Package"))))
(defcustom org-support-shift-select nil
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"
+ #+STARTUP: fold (or `overview', this is equivalent)
+ #+STARTUP: nofold (or `showall', this is equivalent)
+ #+STARTUP: content
+ #+STARTUP: showeverything"
:group 'org-startup
:type '(choice
(const :tag "nofold: show all" nil)
(const :tag "fold: overview" t)
- (const :tag "content: all headlines" content)))
+ (const :tag "content: all headlines" content)
+ (const :tag "show everything, even drawers" showeverything)))
(defcustom org-startup-truncated t
"Non-nil means, entering Org-mode will set `truncate-lines'.
:group 'org-startup
:type 'boolean)
+(defcustom org-startup-indented nil
+ "Non-nil means, turn on `org-indent-mode' on startup.
+This can also be configured on a per-file basis by adding one of
+the following lines anywhere in the buffer:
+
+ #+STARTUP: indent
+ #+STARTUP: noindent"
+ :group 'org-structure
+ :type '(choice
+ (const :tag "Not" nil)
+ (const :tag "Globally (slow on startup in large files)" t)))
+
(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
(defcustom org-replace-disputed-keys nil
"Non-nil means use alternative key bindings for some keys.
Org-mode uses S-<cursor> keys for changing timestamps and priorities.
-These keys are also used by other packages like `CUA-mode' or `windmove.el'.
+These keys are also used by other packages like shift-selection-mode'
+\(built into Emacs 23), `CUA-mode' or `windmove.el'.
If you want to use Org-mode together with one of these other modes,
or more generally if you would like to move some Org-mode commands to
other keys, set this variable and configure the keys with the variable
:type 'string)
(defconst org-repeat-re
- "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*\\([.+]?\\+[0-9]+[dwmy]\\)"
+ "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*?\\([.+]?\\+[0-9]+[dwmy]\\(/[0-9]+[dwmy]\\)?\\)"
"Regular expression for specifying repeated events.
After a match, group 1 contains the repeat expression.")
(const :tag "Each time a new frame" new-frame)
(const :tag "One dedicated frame" dedicated-frame)))
+(defcustom org-use-speed-commands nil
+ "Non-nil means, activate single letter commands at beginning of a headline.
+This may also be a function to test for appropriate locations where speed
+commands should be active."
+ :group 'org-structure
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "At beginning of headline stars" t)
+ (function)))
+
+(defcustom org-speed-commands-user nil
+ "Alist of additional speed commands.
+This list will be checked before `org-speed-commands-default'
+when the variable `org-use-speed-commands' is non-nil
+and when the cursor is at the beginning of a headline.
+The car if each entry is a string with a single letter, which must
+be assigned to `self-insert-command' in the global map.
+The cdr is either a command to be called interactively, a function
+to be called, or a form to be evaluated.
+An entry that is just a list with a single string will be interpreted
+as a descriptive headline that will be added when listing the speed
+copmmands in the Help buffer using the `?' speed command."
+ :group 'org-structure
+ :type '(repeat :value ("k" . ignore)
+ (choice :value ("k" . ignore)
+ (list :tag "Descriptive Headline" (string :tag "Headline"))
+ (cons :tag "Letter and Command"
+ (string :tag "Command letter")
+ (choice
+ (function)
+ (sexp))))))
+
(defgroup org-cycle nil
"Options concerning visibility cycling in Org-mode."
:tag "Org Cycle"
:group 'org-structure)
-(defcustom org-drawers '("PROPERTIES" "CLOCK")
+(defcustom org-cycle-skip-children-state-if-no-children t
+ "Non-nil means, skip CHILDREN state in entries that don't have any."
+ :group 'org-cycle
+ :type 'boolean)
+
+(defcustom org-cycle-max-level nil
+ "Maximum level which should still be subject to visibility cycling.
+Levels higher than this will, for cycling, be treated as text, not a headline.
+When `org-odd-levels-only' is set, a value of N in this variable actually
+means 2N-1 stars as the limiting headline.
+When nil, cycle all levels.
+Note that the limiting level of cycling is also influenced by
+`org-inlinetask-min-level'. When `org-cycle-max-level' is not set but
+`org-inlinetask-min-level' is, cycling will be limited to levels one less
+than its value."
+ :group 'org-cycle
+ :type '(choice
+ (const :tag "No limit" nil)
+ (integer :tag "Maximum level")))
+
+(defcustom org-drawers '("PROPERTIES" "CLOCK" "LOGBOOK")
"Names of drawers. Drawers are not opened by cycling on the headline above.
Drawers only open with a TAB on the drawer line itself. A drawer looks like
this:
#+DRAWERS: HIDDEN STATE PROPERTIES"
:group 'org-structure
+ :group 'org-cycle
:type '(repeat (string :tag "Drawer Name")))
+(defcustom org-hide-block-startup nil
+ "Non-nil means, , entering Org-mode will fold all blocks.
+This can also be set in on a per-file basis with
+
+#+STARTUP: hideblocks
+#+STARTUP: showblocks"
+ :group 'org-startup
+ :group 'org-cycle
+ :type 'boolean)
+
(defcustom org-cycle-global-at-bob nil
"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
+must not be a headline - it may be empty or 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
:group 'org-cycle
:type 'boolean)
+(defcustom org-cycle-level-after-item/entry-creation t
+ "Non-nil means, cycle entry level or item indentation in new empty entries.
+
+When the cursor is at the end of an empty headline, i.e with only stars
+and maybe a TODO keyword, TAB will then switch the entry to become a child,
+and then all possible anchestor states, before returning to the original state.
+This makes data entry extremely fast: M-RET to create a new headline,
+on TAB to make it a child, two or more tabs to make it a (grand-)uncle.
+
+When the cursor is at the end of an empty plain list item, one TAB will
+make it a subitem, two or more tabs will back up to make this an item
+higher up in the item hierarchy."
+ :group 'org-cycle
+ :type 'boolean)
+
(defcustom org-cycle-emulate-tab t
"Where should `org-cycle' emulate TAB.
nil Never
are needed to produce free space between a collapsed subtree and the
following headline.
+If the number is negative, and the number of empty lines is at least -N,
+all empty lines are shown.
+
Special case: when 0, never leave empty lines in collapsed view."
:group 'org-cycle
:type 'integer)
(put 'org-cycle-separator-lines 'safe-local-variable 'integerp)
+(defcustom org-pre-cycle-hook nil
+ "Hook that is run before visibility cycling is happening.
+The function(s) in this hook must accept a single argument which indicates
+the new state that will be set right after running this hook. The
+argument is a symbol. Before a global state change, it can have the values
+`overview', `content', or `all'. Before a local state change, it can have
+the values `folded', `children', or `subtree'."
+ :group 'org-cycle
+ :type 'hook)
+
(defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees
org-cycle-hide-drawers
org-cycle-show-empty-lines
: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."
+ "Non-nil means, adapt indentation to outline node level.
+
+When this variable is set, Org assumes that you write outlines by
+indenting text in each node to align with the headline (after the stars).
+The following issues are influenced by this variable:
+
+- 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 with text at column 0, indentation is not changed at all.
+
+- Property drawers and planning information is inserted indented when
+ this variable s set. When nil, they will not be indented.
+
+- TAB indents a line relative to context. The lines below a headline
+ will be indented when this variable is set.
+
+Note that this is all about true indentation, by adding and removing
+space characters. See also `org-indent.el' which does level-dependent
+indentation in a virtual way, i.e. at display time in Emacs."
:group 'org-edit-structure
:type 'boolean)
(defcustom org-special-ctrl-a/e nil
"Non-nil means `C-a' and `C-e' behave specially in headlines and items.
+
When t, `C-a' will bring back the cursor to the beginning of the
headline text, i.e. after the stars and after a possible TODO keyword.
In an item, this will be the position after the bullet.
When the cursor is already at that position, another `C-a' will bring
it to the beginning of the line.
+
`C-e' will jump to the end of the headline, ignoring the presence of tags
in the headline. A second `C-e' will then jump to the true end of the
-line, after any tags.
+line, after any tags. This also means that, when this variable is
+non-nil, `C-e' also will never jump beyond the end of the heading of a
+folded section, i.e. not after the ellipses.
+
When set to the symbol `reversed', the first `C-a' or `C-e' works normally,
-and only a directly following, identical keypress will bring the cursor
-to the special positions."
+going to the true line boundary first. Only a directly following, identical
+keypress will bring the cursor to the special positions.
+
+This may also be a cons cell where the behavior for `C-a' and `C-e' is
+set separately."
:group 'org-edit-structure
:type '(choice
(const :tag "off" nil)
- (const :tag "after bullet first" t)
- (const :tag "border first" reversed)))
-
+ (const :tag "on: after stars/bullet and before tags first" t)
+ (const :tag "reversed: true line boundary first" reversed)
+ (cons :tag "Set C-a and C-e separately"
+ (choice :tag "Special C-a"
+ (const :tag "off" nil)
+ (const :tag "on: after stars/bullet first" t)
+ (const :tag "reversed: before stars/bullet first" reversed))
+ (choice :tag "Special C-e"
+ (const :tag "off" nil)
+ (const :tag "on: before tags first" t)
+ (const :tag "reversed: after tags first" reversed)))))
(if (fboundp 'defvaralias)
(defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e))
(plain-list-item . auto))
"Should `org-insert-heading' leave a blank line before new heading/item?
The value is an alist, with `heading' and `plain-list-item' as car,
-and a boolean flag as cdr."
+and a boolean flag as cdr. For plain lists, if the variable
+`org-empty-line-terminates-plain-lists' is set, the setting here
+is ignored and no empty line is inserted, to keep the list in tact."
:group 'org-edit-structure
:type '(list
(cons (const heading)
:group 'org-edit-structure
:type 'boolean)
-(defcustom org-edit-src-region-extra nil
- "Additional regexps to identify regions for editing with `org-edit-src-code'.
-For examples see the function `org-edit-src-find-region-and-lang'.
-The regular expression identifying the begin marker should end with a newline,
-and the regexp marking the end line should start with a newline, to make sure
-there are kept outside the narrowed region."
- :group 'org-edit-structure
- :type '(repeat
- (list
- (regexp :tag "begin regexp")
- (regexp :tag "end regexp")
- (choice :tag "language"
- (string :tag "specify")
- (integer :tag "from match group")
- (const :tag "from `lang' element")
- (const :tag "from `style' element")))))
-
-(defcustom org-coderef-label-format "(ref:%s)"
- "The default coderef format.
-This format string will be used to search for coderef labels in literal
-examples (EXAMPLE and SRC blocks). The format can be overwritten
-an individual literal example with the -f option, like
-
-#+BEGIN_SRC pascal +n -r -l \"((%s))\"
-...
-#+END_SRC
-
-If you want to use this for HTML export, make sure that the format does
-not introduce special font-locking, and avoid the HTML special
-characters `<', `>', and `&'. The reason for this restriction is that
-the labels are searched for only after htmlize has done its job."
- :group 'org-edit-structure ; FIXME this is not in the right group
- :type 'string)
-
-(defcustom org-edit-fixed-width-region-mode 'artist-mode
- "The mode that should be used to edit fixed-width regions.
-These are the regions where each line starts with a colon."
- :group 'org-edit-structure
- :type '(choice
- (const artist-mode)
- (const picture-mode)
- (const fundamental-mode)
- (function :tag "Other (specify)")))
(defcustom org-goto-auto-isearch t
"Non-nil means, typing characters in org-goto starts incremental search."
"The maximum level for Imenu access to Org-mode headlines.
This also applied for speedbar access."
:group 'org-imenu-and-speedbar
- :type 'number)
+ :type 'integer)
(defgroup org-table nil
"Options concerning tables in Org-mode."
(const :tag "on" t)
(const :tag "on, optimized" optimized)))
+(defcustom org-self-insert-cluster-for-undo t
+ "Non-nil means cluster self-insert commands for undo when possible.
+If this is set, then, like in the Emacs command loop, 20 consecutive
+characters will be undone together.
+This is configurable, because there is some impact on typing performance."
+ :group 'org-table
+ :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 -
[[linkkey:tag][description]]
+The 'linkkey' must be a word word, starting with a letter, followed
+by letters, numbers, '-' or '_'.
+
If REPLACE is a string, the tag will simply be appended to create the link.
If the string contains \"%s\", the tag will be inserted there. Alternatively,
the placeholder \"%h\" will cause a url-encoded version of the tag to
:group 'org-link-store
:type 'regexp)
-(defcustom org-link-to-org-use-id 'create-if-interactive
+(defcustom org-link-to-org-use-id 'create-if-interactive-and-no-custom-id
"Non-nil means, storing a link to an Org file will use entry IDs.
Note that before this variable is even considered, org-id must be loaded,
-to please customize `org-modules' and turn it on.
+so please customize `org-modules' and turn it on.
The variable can have the following values:
template to an entry not having an ID, create it first by
explicitly creating a link to it, using `C-c C-l' first.
+create-if-interactive-and-no-custom-id
+ Like create-if-interactive, but do not create an ID if there is
+ a CUSTOM_ID property defined in the entry. This is the default.
+
use-existing
Use existing ID, do not create one.
:group 'org-link-store
:type '(choice
(const :tag "Create ID to make link" t)
- (const :tag "Create if string link interactively"
- 'create-if-interactive)
- (const :tag "Only use existing" 'use-existing)
+ (const :tag "Create if storing link interactively"
+ create-if-interactive)
+ (const :tag "Create if storing link interactively and no CUSTOM_ID is present"
+ create-if-interactive-and-no-custom-id)
+ (const :tag "Only use existing" use-existing)
(const :tag "Do not use ID to create link" nil)))
(defcustom org-context-in-file-links t
(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."
+Needs to be set before org.el is loaded.
+This really should not be used, it does not make sense, and the
+implementation is bad."
:group 'org-link-follow
:type 'boolean)
-(defcustom org-return-follows-link t
+(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
(defcustom org-open-non-existing-files nil
"Non-nil means, `org-open-file' will open non-existing files.
-When nil, an error will be generated."
+When nil, an error will be generated.
+This variable applies only to external applications because they
+might choke on non-existing files. If the link is to a file that
+will be opened in Emacs, the variable is ignored."
:group 'org-link-follow
:type 'boolean)
This link would show up in your Org-mode document as \"Google Search\",
but really it would remove your entire home directory.
Therefore we advise against setting this variable to nil.
-Just change it to `y-or-n-p' of you want to confirm with a
+Just change it to `y-or-n-p' if you want to confirm with a
single keystroke rather than having to type \"yes\"."
:group 'org-link-follow
:type '(choice
This link would show up in your Org-mode document as \"Google Search\",
but really it would remove your entire home directory.
Therefore we advise against setting this variable to nil.
-Just change it to `y-or-n-p' of you want to confirm with a
+Just change it to `y-or-n-p' if you want to confirm with a
single keystroke rather than having to type \"yes\"."
:group 'org-link-follow
:type '(choice
(defcustom org-file-apps
'(
(auto-mode . emacs)
+ ("\\.mm\\'" . default)
("\\.x?html?\\'" . default)
("\\.pdf\\'" . default)
)
does define this command, but you can overrule/replace it
here.
string A command to be executed by a shell; %s will be replaced
- by the path to the file.
+ 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'.
+ 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'
(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."
+This is just a default location to look for Org files. There is no need
+at all to put your files into this directory. It is only used in the
+following situations:
+
+1. When a remember template specifies a target file that is not an
+ absolute path. The path will then be interpreted relative to
+ `org-directory'
+2. When a remember note is filed away in an interactive way (when exiting the
+ note buffer with `C-1 C-c C-c'. The user is prompted for an org file,
+ with `org-directory' as the default path."
:group 'org-refile
:group 'org-remember
:type 'directory)
(defcustom org-goto-max-level 5
"Maximum level to be considered when running org-goto with refile interface."
:group 'org-refile
- :type 'number)
+ :type 'integer)
(defcustom org-reverse-note-order nil
"Non-nil means, store new notes at the beginning of a file or entry.
a file name or a list of file names. If you use `org-agenda-files' for
that, all agenda files will be scanned for targets. Nil means, consider
headings in the current buffer.
-- A specification of how to select find candidate refile targets. This
- may be any of
+- A specification of how to find candidate refile targets. This may be
+ any of:
- a cons cell (:tag . \"TAG\") to identify refile targets by a tag.
This tag has to be present in all target headlines, inheritance will
not be considered.
- a cons cell (:regexp . \"REGEXP\") with a regular expression matching
headlines that are refiling targets.
- a cons cell (:level . N). Any headline of level N is considered a target.
+ Note that, when `org-odd-levels-only' is set, level corresponds to
+ order in hierarchy, not to the number of stars.
- a cons cell (:maxlevel . N). Any headline with level <= N is a target.
+ Note that, when `org-odd-levels-only' is set, level corresponds to
+ order in hierarchy, not to the number of stars.
+
+You can set the variable `org-refile-target-verify-function' to a function
+to verify each headline found by the simple critery above.
When this variable is nil, all top-level headlines in the current buffer
are used, equivalent to the value `((nil . (:level . 1))'."
(cons :tag "Level number" (const :value :level) (integer))
(cons :tag "Max Level number" (const :value :maxlevel) (integer))))))
+(defcustom org-refile-target-verify-function nil
+ "Function to verify if the headline at point should be a refile target.
+The function will be called without arguments, with point at the
+beginning of the headline. It should return t and leave point
+where it is if the headline is a valid target for refiling.
+
+If the target should not be selected, the function must return nil.
+In addition to this, it may move point to a place from where the search
+should be continued. For example, the function may decide that the entire
+subtree of the current entry should be excluded and move point to the end
+of the subtree."
+ :group 'org-refile
+ :type 'function)
+
(defcustom org-refile-use-outline-path nil
"Non-nil means, provide refile targets as paths.
So a level 3 headline will be available as level1/level2/level3.
+
When the value is `file', also include the file name (without directory)
-into the path. When `full-file-path', include the full file path."
+into the path. In this case, you can also stop the completion after
+the file name, to get entries inserted as top level in the file.
+
+ When `full-file-path', include the full file path."
:group 'org-refile
:type '(choice
(const :tag "Not" nil)
:group 'org-refile
:type 'boolean)
+(defcustom org-refile-allow-creating-parent-nodes nil
+ "Non-nil means, allow to create new nodes as refile targets.
+New nodes are then created by adding \"/new node name\" to the completion
+of an existing node. When the value of this variable is `confirm',
+new node creation must be confirmed by the user (recommended)
+When nil, the completion must match an existing entry.
+
+Note that, if the new heading is not seen by the criteria
+listed in `org-refile-targets', multiple instances of the same
+heading would be created by trying again to file under the new
+heading."
+ :group 'org-refile
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "Always" t)
+ (const :tag "Prompt for confirmation" confirm)))
+
(defgroup org-todo nil
"Options concerning TODO items in Org-mode."
:tag "Org TODO"
:tag "Org Progress"
:group 'org-time)
+(defvar org-todo-interpretation-widgets
+ '(
+ (:tag "Sequence (cycling hits every state)" sequence)
+ (:tag "Type (cycling directly to DONE)" type))
+ "The available interpretation symbols for customizing
+ `org-todo-keywords'.
+ Interested libraries should add to this list.")
+
(defcustom org-todo-keywords '((sequence "TODO" "DONE"))
"List of TODO entry keyword sequences and their interpretation.
\\<org-mode-map>This is a list of sequences.
(cons
(choice
:tag "Interpretation"
- (const :tag "Sequence (cycling hits every state)" sequence)
- (const :tag "Type (cycling directly to DONE)" type))
+ ;;Quick and dirty way to see
+ ;;`org-todo-interpretations'. This takes the
+ ;;place of item arguments
+ :convert-widget
+ (lambda (widget)
+ (widget-put widget
+ :args (mapcar
+ #'(lambda (x)
+ (widget-convert
+ (cons 'const x)))
+ org-todo-interpretation-widgets))
+ widget))
(repeat
(string :tag "Keyword"))))))
(make-variable-buffer-local 'org-todo-keywords-1)
(defvar org-todo-keywords-for-agenda nil)
(defvar org-done-keywords-for-agenda nil)
+(defvar org-drawers-for-agenda nil)
(defvar org-todo-keyword-alist-for-agenda nil)
(defvar org-tag-alist-for-agenda nil)
(defvar org-agenda-contributing-files nil)
(defcustom org-provide-todo-statistics t
"Non-nil means, update todo statistics after insert and toggle.
-When this is set, todo statistics is updated in the parent of the current
-entry each time a todo state is changed."
+ALL-HEADLINES means update todo statistics by including headlines
+with no TODO keyword as well, counting them as not done.
+A list of TODO keywords means the same, but skip keywords that are
+not in this list.
+
+When this is set, todo statistics is updated in the parent of the
+current entry each time a todo state is changed."
+ :group 'org-todo
+ :type '(choice
+ (const :tag "Yes, only for TODO entries" t)
+ (const :tag "Yes, including all entries" 'all-headlines)
+ (repeat :tag "Yes, for TODOs in this list"
+ (string :tag "TODO keyword"))
+ (other :tag "No TODO statistics" nil)))
+
+(defcustom org-hierarchical-todo-statistics t
+ "Non-nil means, TODO statistics covers just direct children.
+When nil, all entries in the subtree are considered.
+This has only an effect if `org-provide-todo-statistics' is set.
+To set this to nil for only a single subtree, use a COOKIE_DATA
+property and include the word \"recursive\" into the value."
:group 'org-todo
:type 'boolean)
"Non-nil means, undone TODO entries will block switching the parent to DONE.
Also, if a parent has an :ORDERED: property, switching an entry to DONE will
be blocked if any prior sibling is not yet done.
+Finally, if the parent is blocked because of ordered siblings of its own,
+the child will also be blocked.
This variable needs to be set before org.el is loaded, and you need to
restart Emacs after a change to make the change effective. The only way
to change is while Emacs is running is through the customize interface."
(set var val)
(if val
(add-hook 'org-blocker-hook
- 'org-block-todo-from-children-or-siblings)
+ 'org-block-todo-from-children-or-siblings-or-parent)
(remove-hook 'org-blocker-hook
- 'org-block-todo-from-children-or-siblings)))
+ 'org-block-todo-from-children-or-siblings-or-parent)))
:group 'org-todo
:type 'boolean)
:group 'org-todo
:type 'boolean)
+(defcustom org-treat-insert-todo-heading-as-state-change nil
+ "Non-nil means, inserting a TODO heading is treated as state change.
+So when the command \\[org-insert-todo-heading] is used, state change
+logging will apply if appropriate. When nil, the new TODO item will
+be inserted directly, and no logging will take place."
+ :group 'org-todo
+ :type 'boolean)
+
+(defcustom org-treat-S-cursor-todo-selection-as-state-change t
+ "Non-nil means, switching TODO states with S-cursor counts as state change.
+This is the default behavior. However, setting this to nil allows a
+convenient way to select a TODO state and bypass any logging associated
+with that."
+ :group 'org-todo
+ :type 'boolean)
+
(defcustom org-todo-state-tags-triggers nil
"Tag changes that should be triggered by TODO state changes.
This is a list. Each entry is
nil Don't add anything, just change the keyword
time Add a time stamp to the task
-note Prompt a closing note and add it with template `org-log-note-headings'
+note Prompt for a note and add it with template `org-log-note-headings'
This option can also be set with on a per-file-basis with
:type '(choice
(const :tag "No logging" nil)
(const :tag "Record CLOSED timestamp" time)
- (const :tag "Record CLOSED timestamp with closing note." note)))
+ (const :tag "Record CLOSED timestamp with note." note)))
;; Normalize old uses of org-log-done.
(cond
((and (listp org-log-done) (memq 'done org-log-done))
(setq org-log-done 'note)))
+(defcustom org-log-reschedule nil
+ "Information to record when the scheduling date of a tasks is modified.
+
+Possible values are:
+
+nil Don't add anything, just change the date
+time Add a time stamp to the task
+note Prompt for a note and add it with template `org-log-note-headings'
+
+This option can also be set with on a per-file-basis with
+
+ #+STARTUP: nologreschedule
+ #+STARTUP: logreschedule
+ #+STARTUP: lognotereschedule"
+ :group 'org-todo
+ :group 'org-progress
+ :type '(choice
+ (const :tag "No logging" nil)
+ (const :tag "Record timestamp" time)
+ (const :tag "Record timestamp with note." note)))
+
+(defcustom org-log-redeadline nil
+ "Information to record when the deadline date of a tasks is modified.
+
+Possible values are:
+
+nil Don't add anything, just change the date
+time Add a time stamp to the task
+note Prompt for a note and add it with template `org-log-note-headings'
+
+This option can also be set with on a per-file-basis with
+
+ #+STARTUP: nologredeadline
+ #+STARTUP: logredeadline
+ #+STARTUP: lognoteredeadline
+
+You can have local logging settings for a subtree by setting the LOGGING
+property to one or more of these keywords."
+ :group 'org-todo
+ :group 'org-progress
+ :type '(choice
+ (const :tag "No logging" nil)
+ (const :tag "Record timestamp" time)
+ (const :tag "Record timestamp with note." note)))
+
(defcustom org-log-note-clock-out nil
"Non-nil means, record a note when clocking out of an item.
This can also be configured on a per-file basis by adding one of
(defcustom org-log-note-headings
'((done . "CLOSING NOTE %t")
- (state . "State %-12s %t")
+ (state . "State %-12s from %-12S %t")
(note . "Note taken on %t")
+ (reschedule . "Rescheduled from %S on %t")
+ (redeadline . "New deadline from %S on %t")
(clock-out . ""))
"Headings for notes added to entries.
The value is an alist, with the car being a symbol indicating the note
empty string.
%t in the heading will be replaced by a time stamp.
%s will be replaced by the new TODO state, in double quotes.
+%S will be replaced by the old TODO state, in double quotes.
%u will be replaced by the user name.
%U will be replaced by the full user name."
:group 'org-todo
"Heading when changing todo state (todo sequence only)"
state) string)
(cons (const :tag "Heading when just taking a note" note) string)
- (cons (const :tag "Heading when clocking out" clock-out) string)))
+ (cons (const :tag "Heading when clocking out" clock-out) string)
+ (cons (const :tag "Heading when rescheduling" reschedule) string)
+ (cons (const :tag "Heading when changing deadline" redeadline) string)))
(unless (assq 'note org-log-note-headings)
(push '(note . "%t") org-log-note-headings))
+(defcustom org-log-into-drawer nil
+ "Non-nil means, insert state change notes and time stamps into a drawer.
+When nil, state changes notes will be inserted after the headline and
+any scheduling and clock lines, but not inside a drawer.
+
+The value of this variable should be the name of the drawer to use.
+LOGBOOK is proposed at the default drawer for this purpose, you can
+also set this to a string to define the drawer of your choice.
+
+A value of t is also allowed, representing \"LOGBOOK\".
+
+If this variable is set, `org-log-state-notes-insert-after-drawers'
+will be ignored.
+
+You can set the property LOG_INTO_DRAWER to overrule this setting for
+a subtree."
+ :group 'org-todo
+ :group 'org-progress
+ :type '(choice
+ (const :tag "Not into a drawer" nil)
+ (const :tag "LOGBOOK" t)
+ (string :tag "Other")))
+
+(if (fboundp 'defvaralias)
+ (defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer))
+
+(defun org-log-into-drawer ()
+ "Return the value of `org-log-into-drawer', but let properties overrule.
+If the current entry has or inherits a LOG_INTO_DRAWER property, it will be
+used instead of the default value."
+ (let ((p (ignore-errors (org-entry-get nil "LOG_INTO_DRAWER" 'inherit))))
+ (cond
+ ((or (not p) (equal p "nil")) org-log-into-drawer)
+ ((equal p "t") "LOGBOOK")
+ (t p))))
+
(defcustom org-log-state-notes-insert-after-drawers nil
"Non-nil means, insert state change notes after any drawers in entry.
Only the drawers that *immediately* follow the headline and the
deadline/scheduled line are skipped.
When nil, insert notes right after the heading and perhaps the line
-with deadline/scheduling if present."
+with deadline/scheduling if present.
+
+This variable will have no effect if `org-log-into-drawer' is
+set."
:group 'org-todo
:group 'org-progress
:type 'boolean)
(defcustom org-log-repeat 'time
"Non-nil means, record moving through the DONE state when triggering repeat.
-An auto-repeating tasks is immediately switched back to TODO when marked
-done. If you are not logging state changes (by adding \"@\" or \"!\" to
-the TODO keyword definition, or recording a closing note by setting
-`org-log-done', there will be no record of the task moving through DONE.
-This variable forces taking a note anyway. Possible values are:
+An auto-repeating task is immediately switched back to TODO when
+marked DONE. If you are not logging state changes (by adding \"@\"
+or \"!\" to the TODO keyword definition), or set `org-log-done' to
+record a closing note, there will be no record of the task moving
+through DONE. This variable forces taking a note anyway.
nil Don't force a record
time Record a time stamp
:tag "Org Priorities"
:group 'org-todo)
+(defcustom org-enable-priority-commands t
+ "Non-nil means, priority commands are active.
+When nil, these commands will be disabled, so that you never accidentally
+set a priority."
+ :group 'org-priorities
+ :type 'boolean)
+
(defcustom org-highest-priority ?A
"The highest priority of TODO items. A character like ?A, ?B etc.
Must have a smaller ASCII number than `org-lowest-priority'."
"Custom formats for time stamps. See `format-time-string' for the syntax.
These are overlayed over the default ISO format if the variable
`org-display-custom-times' is set. Time like %H:%M should be at the
-end of the second format."
+end of the second format. The custom formats are also honored by export
+commands, if custom time display is turned on at the time of export."
:group 'org-time
:type 'sexp)
:group 'org-time
:type 'string)
+(defcustom org-time-clocksum-use-fractional nil
+ "If non-nil, \\[org-clock-display] uses fractional times.
+org-mode generates a time duration."
+ :group 'org-time
+ :type 'boolean)
+
+(defcustom org-time-clocksum-fractional-format "%.2f"
+ "The format string used when creating CLOCKSUM lines, or when
+org-mode generates a time duration."
+ :group 'org-time
+ :type 'string)
+
(defcustom org-deadline-warning-days 14
"No. of days before expiration during which a deadline becomes active.
This variable governs the display in sparse trees and in the agenda.
When 0 or negative, it means use this number (the absolute value of it)
-even if a deadline has a different individual lead time specified."
+even if a deadline has a different individual lead time specified.
+
+Custom commands can set this variable in the options section."
:group 'org-time
:group 'org-agenda-daily/weekly
- :type 'number)
+ :type 'integer)
(defcustom org-read-date-prefer-future t
"Non-nil means, assume future for incomplete date input from user.
This affects the following situations:
-1. The user gives a day, but no month.
+1. The user gives a month but not a year.
+ For example, if it is april and you enter \"feb 2\", this will be read
+ as feb 2, *next* year. \"May 5\", however, will be this year.
+2. The user gives a day, but no month.
For example, if today is the 15th, and you enter \"3\", Org-mode will
read this as the third of *next* month. However, if you enter \"17\",
it will be considered as *this* month.
-2. The user gives a month but not a year.
- For example, if it is april and you enter \"feb 2\", this will be read
- as feb 2, *next* year. \"May 5\", however, will be this year.
-Currently this does not work for ISO week specifications.
+If you set this variable to the symbol `time', then also the following
+will work:
+
+3. If the user gives a time, but no day. If the time is before now,
+ to will be interpreted as tomorrow.
-When this option is nil, the current month and year will always be used
-as defaults."
+Currently none of this works for ISO week specifications.
+
+When this option is nil, the current day, month and year will always be
+used as defaults."
:group 'org-time
- :type 'boolean)
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "Check month and day" t)
+ (const :tag "Check month, day, and time" time)))
(defcustom org-read-date-display-live t
"Non-nil means, display current interpretation of date prompt live.
(defvaralias 'org-popup-calendar-for-date-prompt
'org-read-date-popup-calendar))
+(defcustom org-read-date-minibuffer-setup-hook nil
+ "Hook to be used to set up keys for the date/time interface.
+Add key definitions to `minibuffer-local-map', which will be a temporary
+copy."
+ :group 'org-time
+ :type 'hook)
+
(defcustom org-extend-today-until 0
"The hour when your day really ends. Must be an integer.
This has influence for the following applications:
remain incomplete. Really, it is only here because past midnight seems to
be the favorite working time of John Wiegley :-)"
:group 'org-time
- :type 'number)
+ :type 'integer)
(defcustom org-edit-timestamp-down-means-later nil
"Non-nil means, S-down will increase the time in a time stamp.
that tag through the fast-tag-selection interface.
See the manual for details."
:group 'org-tags
+ :type '(repeat
+ (choice
+ (cons (string :tag "Tag name")
+ (character :tag "Access char"))
+ (list :tag "Start radio group"
+ (const :startgroup)
+ (option (string :tag "Group description")))
+ (list :tag "End radio group"
+ (const :endgroup)
+ (option (string :tag "Group description")))
+ (const :tag "New line" (:newline)))))
+
+(defcustom org-tag-persistent-alist nil
+ "List of tags that will always appear in all Org-mode files.
+This is in addition to any in buffer settings or customizations
+of `org-tag-alist'.
+When this list is nil, Org-mode will base TAG input on `org-tag-alist'.
+The value of this variable is an alist, the car of each entry must be a
+keyword as a string, the cdr may be a character that is used to select
+that tag through the fast-tag-selection interface.
+See the manual for details.
+To disable these tags on a per-file basis, insert anywhere in the file:
+ #+STARTUP: noptag"
+ :group 'org-tags
:type '(repeat
(choice
(cons (string :tag "Tag name")
(character :tag "Access char"))
(const :tag "Start radio group" (:startgroup))
- (const :tag "End radio group" (:endgroup)))))
+ (const :tag "End radio group" (:endgroup))
+ (const :tag "New line" (:newline)))))
(defvar org-file-tags nil
"List of tags that can be inherited by all entries in the file.
The tags will be inherited if the variable `org-use-tag-inheritance'
says they should be.
-This variable is populated from #+TAG lines.")
+This variable is populated from #+FILETAGS lines.")
(defcustom org-use-fast-tag-selection 'auto
"Non-nil means, use fast tag selection scheme.
(t (error "Invalid setting of `org-use-tag-inheritance'"))))
(defcustom org-tags-match-list-sublevels t
- "Non-nil means list also sublevels of headlines matching tag search.
+ "Non-nil means list also sublevels of headlines matching a search.
+This variable applies to tags/property searches, and also to stuck
+projects because this search is based on a tags match as well.
+
+When set to the symbol `indented', sublevels are indented with
+leading dots.
+
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.
This variable is semi-obsolete and probably should always be true. It
is better to limit inheritance to certain tags using the variables
`org-use-tag-inheritance' and `org-tags-exclude-from-inheritance'."
:group 'org-tags
- :type 'boolean)
+ :type '(choice
+ (const :tag "No, don't list them" nil)
+ (const :tag "Yes, do list them" t)
+ (const :tag "List them, indented with leading dots" indented)))
+
+(defcustom org-tags-sort-function nil
+ "When set, tags are sorted using this function as a comparator"
+ :group 'org-tags
+ :type '(choice
+ (const :tag "No sorting" nil)
+ (const :tag "Alphabetical" string<)
+ (const :tag "Reverse alphabetical" string>)
+ (function :tag "Custom function" nil)))
(defvar org-tags-history nil
"History of minibuffer reads for tags.")
:type '(string :tag "Property"))
(defconst org-global-properties-fixed
- '(("VISIBILITY_ALL" . "folded children content all"))
+ '(("VISIBILITY_ALL" . "folded children content all")
+ ("CLOCK_MODELINE_TOTAL_ALL" . "current today repeat all auto"))
"List of property/value pairs that can be inherited by any entry.
-These are fixed values, for the preset properties.")
+These are fixed values, for the preset properties. The user variable
+that can be used to add to this list is `org-global-properties'.
+
+The entries in this list are cons cells where the car is a property
+name and cdr is a string with the value. If the value represents
+multiple items like an \"_ALL\" property, separate the items by
+spaces.")
(defcustom org-global-properties nil
"List of property/value pairs that can be inherited by any entry.
+
+This list will be combined with the constant `org-global-properties-fixed'.
+
+The entries in this list are cons cells where the car is a property
+name and cdr is a string with the value.
+
You can set buffer-local values for the same purpose in the variable
`org-file-properties' this by adding lines like
:group 'org-agenda
:type 'sexp)
+(defcustom org-calendar-insert-diary-entry-key [?i]
+ "The key to be installed in `calendar-mode-map' for adding diary entries.
+This option is irrelevant until `org-agenda-diary-file' has been configured
+to point to an Org-mode file. When that is the case, the command
+`org-agenda-diary-entry' will be bound to the key given here, by default
+`i'. In the calendar, `i' normally adds entries to `diary-file'. So
+if you want to continue doing this, you need to change this to a different
+key."
+ :group 'org-agenda
+ :type 'sexp)
+
+(defcustom org-agenda-diary-file 'diary-file
+ "File to which to add new entries with the `i' key in agenda and calendar.
+When this is the symbol `diary-file', the functionality in the Emacs
+calendar will be used to add entries to the `diary-file'. But when this
+points to a file, `org-agenda-diary-entry' will be used instead."
+ :group 'org-agenda
+ :type '(choice
+ (const :tag "The standard Emacs diary file" diary-file)
+ (file :tag "Special Org file diary entries")))
+
(eval-after-load "calendar"
'(progn
(org-defkey calendar-mode-map org-calendar-to-agenda-key
'org-calendar-goto-agenda)
(org-defkey calendar-mode-map org-calendar-agenda-action-key
- 'org-agenda-action)))
+ 'org-agenda-action)
+ (add-hook 'calendar-mode-hook
+ (lambda ()
+ (unless (eq org-agenda-diary-file 'diary-file)
+ (define-key calendar-mode-map
+ org-calendar-insert-diary-entry-key
+ 'org-agenda-diary-entry))))))
(defgroup org-latex nil
"Options for embedding LaTeX code into Org-mode."
:type 'plist)
(defcustom org-format-latex-header "\\documentclass{article}
-\\usepackage{fullpage} % do not remove
\\usepackage{amssymb}
\\usepackage[usenames]{color}
\\usepackage{amsmath}
\\usepackage{latexsym}
\\usepackage[mathscr]{eucal}
-\\pagestyle{empty} % do not remove"
- "The document header used for processing LaTeX fragments."
+\\pagestyle{empty} % do not remove
+% The settings below are copied from fullpage.sty
+\\setlength{\\textwidth}{\\paperwidth}
+\\addtolength{\\textwidth}{-3cm}
+\\setlength{\\oddsidemargin}{1.5cm}
+\\addtolength{\\oddsidemargin}{-2.54cm}
+\\setlength{\\evensidemargin}{\\oddsidemargin}
+\\setlength{\\textheight}{\\paperheight}
+\\addtolength{\\textheight}{-\\headheight}
+\\addtolength{\\textheight}{-\\headsep}
+\\addtolength{\\textheight}{-\\footskip}
+\\addtolength{\\textheight}{-3cm}
+\\setlength{\\topmargin}{1.5cm}
+\\addtolength{\\topmargin}{-2.54cm}"
+ "The document header used for processing LaTeX fragments.
+It is imperative that this header make sure that no page number
+appears on the page."
:group 'org-latex
:type 'string)
+;; The following variable is defined here because is it also used
+;; when formatting latex fragments. Originally it was part of the
+;; LaTeX exporter, which is why the name includes "export".
+(defcustom org-export-latex-packages-alist nil
+ "Alist of packages to be inserted in the header.
+Each cell is of the format \( \"option\" . \"package\" \)."
+ :group 'org-export-latex
+ :type '(repeat
+ (list
+ (string :tag "option")
+ (string :tag "package"))))
(defgroup org-font-lock nil
"Font-lock settings for highlighting in Org-mode."
:group 'org-font-lock
:type 'boolean)
+(defcustom org-fontify-whole-heading-line nil
+ "Non-nil means fontify the whole line for headings.
+This is useful when setting a background color for the
+org-level-* faces."
+ :group 'org-font-lock
+ :type 'boolean)
+
(defcustom org-highlight-latex-fragments-and-specials nil
"Non-nil means, fontify what is treated specially by the exporters."
:group 'org-font-lock
"\\([" post "]\\|$\\)")))))
(defcustom org-emphasis-regexp-components
- '(" \t('\"" "- \t.,:?;'\")" " \t\r\n,\"'" "." 1)
+ '(" \t('\"{" "- \t.,:!?;'\")}\\" " \t\r\n,\"'" "." 1)
"Components used to build the regular expression for emphasis.
This is a list with 6 entries. Terminology: In an emphasis string
like \" *strong word* \", we call the initial space PREMATCH, the final
example *bold*, _underlined_ and /italic/. This variable sets the marker
characters, the face to be used by font-lock for highlighting in Org-mode
Emacs buffers, and the HTML tags to be used for this.
+For LaTeX export, see the variable `org-export-latex-emphasis-alist'.
Use customize to modify this, or restart Emacs after changing it."
:group 'org-font-lock
:set 'org-set-emph-re
(string :tag "HTML end tag")
(option (const verbatim)))))
+(defvar org-protecting-blocks
+ '("src" "example" "latex" "ascii" "html" "docbook" "ditaa" "dot" "r" "R")
+ "Blocks that contain text that is quoted, i.e. not processed as Org syntax.
+This is needed for font-lock setup.")
+
;;; Miscellaneous options
(defgroup org-completion nil
"Non-nil means, use ido completion wherever possible.
Note that `ido-mode' must be active for this variable to be relevant.
If you decide to turn this variable on, you might well want to turn off
-`org-outline-path-complete-in-steps'."
+`org-outline-path-complete-in-steps'.
+See also `org-completion-use-iswitchb'."
+ :group 'org-completion
+ :type 'boolean)
+
+(defcustom org-completion-use-iswitchb nil
+ "Non-nil means, use iswitchb completion wherever possible.
+Note that `iswitchb-mode' must be active for this variable to be relevant.
+If you decide to turn this variable on, you might well want to turn off
+`org-outline-path-complete-in-steps'.
+Note that this variable has only an effect if `org-completion-use-ido' is nil."
:group 'org-completion
:type 'boolean)
:group 'org-completion
:type 'function)
-;;; Functions and variables from ther packages
+;;; Functions and variables from their packages
;; Declared here to avoid compiler warnings
;; XEmacs only
(declare-function cdlatex-tab "ext:cdlatex" ())
(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
(defvar font-lock-unfontify-region-function)
-(declare-function iswitchb-mode "iswitchb" (&optional arg))
-(declare-function iswitchb-read-buffer (prompt &optional default require-match start matches-set))
+(declare-function iswitchb-read-buffer "iswitchb"
+ (prompt &optional default require-match start matches-set))
(defvar iswitchb-temp-buflist)
(declare-function org-gnus-follow-link "org-gnus" (&optional group article))
(defvar org-agenda-tags-todo-honor-ignore-options)
(declare-function org-agenda-skip "org-agenda" ())
-(declare-function org-format-agenda-item "org-agenda"
- (extra txt &optional category tags dotime noprefix remove-re))
+(declare-function
+ org-format-agenda-item "org-agenda"
+ (extra txt &optional category tags dotime noprefix remove-re habitp))
(declare-function org-agenda-new-marker "org-agenda" (&optional pos))
(declare-function org-agenda-change-all-lines "org-agenda"
(newhead hdmarker &optional fixface just-this))
(declare-function org-agenda-copy-local-variable "org-agenda" (var))
(declare-function org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
"org-agenda" (&optional end))
-
+(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
+(declare-function org-indent-mode "org-indent" (&optional arg))
(declare-function parse-time-string "parse-time" (string))
-(declare-function remember "remember" (&optional initial))
-(declare-function remember-buffer-desc "remember" ())
-(declare-function remember-finalize "remember" ())
-(defvar remember-save-after-remembering)
+(declare-function org-attach-reveal "org-attach" (&optional if-exists))
(defvar remember-data-file)
-(defvar remember-register)
-(defvar remember-buffer)
-(defvar remember-handler-functions)
-(defvar remember-annotation-functions)
(defvar texmathp-why)
(declare-function speedbar-line-directory "speedbar" (&optional depth))
(declare-function table--at-cell-p "table" (position &optional object at-column))
(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)))
+ (when (looking-at org-table-line-regexp)
+ (save-excursion (funcall function))
+ (or (looking-at org-table-line-regexp)
+ (forward-char 1)))
(re-search-forward org-table-any-border-regexp nil 1))))
(message "Mapping tables: done"))
-;; Declare and autoload functions from org-exp.el
+;; Declare and autoload functions from org-exp.el & Co
(declare-function org-default-export-plist "org-exp")
(declare-function org-infile-export-plist "org-exp")
(declare-function org-get-current-options "org-exp")
(eval-and-compile
(org-autoload "org-exp"
- '(org-export org-export-as-ascii org-export-visible
- org-insert-export-options-template org-export-as-html-and-open
- org-export-as-html-batch org-export-as-html-to-buffer
- org-replace-region-by-html org-export-region-as-html
- org-export-as-html org-export-icalendar-this-file
- org-export-icalendar-all-agenda-files
- org-table-clean-before-export
- org-export-icalendar-combine-agenda-files org-export-as-xoxo)))
+ '(org-export org-export-visible
+ org-insert-export-options-template
+ org-table-clean-before-export))
+ (org-autoload "org-ascii"
+ '(org-export-as-ascii org-export-ascii-preprocess
+ org-export-as-ascii-to-buffer org-replace-region-by-ascii
+ org-export-region-as-ascii))
+ (org-autoload "org-html"
+ '(org-export-as-html-and-open
+ org-export-as-html-batch org-export-as-html-to-buffer
+ org-replace-region-by-html org-export-region-as-html
+ org-export-as-html))
+ (org-autoload "org-icalendar"
+ '(org-export-icalendar-this-file
+ org-export-icalendar-all-agenda-files
+ org-export-icalendar-combine-agenda-files))
+ (org-autoload "org-xoxo" '(org-export-as-xoxo)))
;; Declare and autoload functions from org-agenda.el
(declare-function org-clock-save-markers-for-cut-and-paste "org-clock"
(beg end))
(declare-function org-clock-update-mode-line "org-clock" ())
+(declare-function org-resolve-clocks "org-clock"
+ (&optional also-non-dangling-p prompt last-valid))
(defvar org-clock-start-time)
(defvar org-clock-marker (make-marker)
"Marker recording the last clock-in.")
+(defvar org-clock-hd-marker (make-marker)
+ "Marker recording the last clock-in, but the headline position.")
+(defvar org-clock-heading ""
+ "The heading of the current clock entry.")
+(defun org-clock-is-active ()
+ "Return non-nil if clock is currently running.
+The return value is actually the clock marker."
+ (marker-buffer org-clock-marker))
(eval-and-compile
(org-autoload
org-clock-goto org-clock-sum org-clock-display
org-clock-remove-overlays org-clock-report
org-clocktable-shift org-dblock-write:clocktable
- org-get-clocktable)))
+ org-get-clocktable org-resolve-clocks)))
(defun org-clock-update-time-maybe ()
"If this is a CLOCK line, update it and return t.
(end-of-line 1)
(setq ts (match-string 1)
te (match-string 3))
- (setq s (- (time-to-seconds
+ (setq s (- (org-float-time
(apply 'encode-time (org-parse-time-string te)))
- (time-to-seconds
+ (org-float-time
(apply 'encode-time (org-parse-time-string ts))))
neg (< s 0)
s (abs s)
;; Autoload org-timer.el
-;(declare-function org-timer "org-timer")
-
(eval-and-compile
(org-autoload
"org-timer"
'(org-timer-start org-timer org-timer-item
- org-timer-change-times-in-region)))
+ org-timer-change-times-in-region
+ org-timer-set-timer
+ org-timer-reset-timers
+ org-timer-show-remaining-time)))
+
+;; Autoload org-feed.el
+
+(eval-and-compile
+ (org-autoload
+ "org-feed"
+ '(org-feed-update org-feed-update-all org-feed-goto-inbox)))
+
+
+;; Autoload org-indent.el
+
+;; Define the variable already here, to make sure we have it.
+(defvar org-indent-mode nil
+ "Non-nil if Org-Indent mode is enabled.
+Use the command `org-indent-mode' to change this variable.")
+
+(eval-and-compile
+ (org-autoload
+ "org-indent"
+ '(org-indent-mode)))
+
+;; Autoload org-mobile.el
+(eval-and-compile
+ (org-autoload
+ "org-mobile"
+ '(org-mobile-push org-mobile-pull org-mobile-create-sumo-agenda)))
;; Autoload archiving code
;; The stuff that is needed for cycling and tags has to be defined here.
Archive in file ~/org/archive.org (absolute path), as top-level trees.
\"~/org/archive.org::From %s\"
- Archive in file ~/org/archive.org (absolute path), und headlines
+ Archive in file ~/org/archive.org (absolute path), under headlines
\"From FILENAME\" where file name is the current file name.
\"basement::** Finished Tasks\"
:group 'org-agenda-skip
:type 'boolean)
+(defcustom org-columns-skip-archived-trees t
+ "Non-nil means, ignore archived trees when creating column view."
+ :group 'org-archive
+ :group 'org-properties
+ :type 'boolean)
+
(defcustom org-cycle-open-archived-trees nil
"Non-nil means, `org-cycle' will open archived trees.
An archived tree is a tree marked with the tag ARCHIVE.
(let* ((re (concat ":" org-archive-tag ":")))
(goto-char beg)
(while (re-search-forward re end t)
- (and (org-on-heading-p) (hide-subtree))
+ (and (org-on-heading-p) (org-flag-subtree t))
(org-end-of-subtree t)))))
+(defun org-flag-subtree (flag)
+ (save-excursion
+ (org-back-to-heading t)
+ (outline-end-of-heading)
+ (outline-flag-region (point)
+ (progn (org-end-of-subtree t) (point))
+ flag)))
+
(defalias 'org-advertized-archive-subtree 'org-archive-subtree)
(eval-and-compile
(org-autoload "org-archive"
'(org-add-archive-files org-archive-subtree
- org-archive-to-archive-sibling org-toggle-archive-tag)))
+ org-archive-to-archive-sibling org-toggle-archive-tag
+ org-archive-subtree-default
+ org-archive-subtree-default-with-confirmation)))
;; Autoload Column View Code
;; Autoload ID code
(declare-function org-id-store-link "org-id")
+(declare-function org-id-locations-load "org-id")
+(declare-function org-id-locations-save "org-id")
+(defvar org-id-track-globally)
(org-autoload "org-id"
'(org-id-get-create org-id-new org-id-copy org-id-get
org-id-get-with-outline-path-completion
org-id-get-with-outline-drilling
org-id-goto org-id-find org-id-store-link))
+;; Autoload Plotting Code
+
+(org-autoload "org-plot"
+ '(org-plot/gnuplot))
+
;;; Variables for pre-computed regular expressions, all buffer local
(defvar org-drawer-regexp nil
(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-not-done-heading-regexp nil
+ "Matches a TODO headline that is not done.")
+(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)
group 4: True headline
group 5: Tags")
(make-variable-buffer-local 'org-complex-heading-regexp)
+(defvar org-complex-heading-regexp-format nil)
+(make-variable-buffer-local 'org-complex-heading-regexp-format)
(defvar org-todo-line-tags-regexp nil
"Matches a headline and puts TODO state into group 2 if present.
Also put tags into group 4 if tags are present.")
"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
+1 date plus weekday, for back referencing to make sure both times are on the same day
2 the first time, range or not
4 the second time, if it is a range.")
("overview" org-startup-folded t)
("nofold" org-startup-folded nil)
("showall" org-startup-folded nil)
+ ("showeverything" org-startup-folded showeverything)
("content" org-startup-folded content)
+ ("indent" org-startup-indented t)
+ ("noindent" org-startup-indented nil)
("hidestars" org-hide-leading-stars t)
("showstars" org-hide-leading-stars nil)
("odd" org-odd-levels-only t)
("logrepeat" org-log-repeat state)
("lognoterepeat" org-log-repeat note)
("nologrepeat" org-log-repeat nil)
+ ("logreschedule" org-log-reschedule time)
+ ("lognotereschedule" org-log-reschedule note)
+ ("nologreschedule" org-log-reschedule nil)
+ ("logredeadline" org-log-redeadline time)
+ ("lognoteredeadline" org-log-redeadline note)
+ ("nologredeadline" org-log-redeadline nil)
("fninline" org-footnote-define-inline t)
("nofninline" org-footnote-define-inline nil)
("fnlocal" org-footnote-section nil)
("fnprompt" org-footnote-auto-label nil)
("fnconfirm" org-footnote-auto-label confirm)
("fnplain" org-footnote-auto-label plain)
+ ("fnadjust" org-footnote-auto-adjust t)
+ ("nofnadjust" org-footnote-auto-adjust nil)
("constcgs" constants-unit-system cgs)
- ("constSI" constants-unit-system SI))
+ ("constSI" constants-unit-system SI)
+ ("noptag" org-tag-persistent-alist nil)
+ ("hideblocks" org-hide-block-startup t)
+ ("nohideblocks" org-hide-block-startup nil))
"Variable associated with STARTUP options for org-mode.
Each element is a list of three items: The startup options as written
in the #+STARTUP line, the corresponding variable, and the value to
(org-set-local 'org-file-properties nil)
(org-set-local 'org-file-tags nil)
(let ((re (org-make-options-regexp
- '("CATEGORY" "SEQ_TODO" "TYP_TODO" "TODO" "COLUMNS"
+ '("CATEGORY" "TODO" "COLUMNS"
"STARTUP" "ARCHIVE" "FILETAGS" "TAGS" "LINK" "PRIORITIES"
- "CONSTANTS" "PROPERTY" "DRAWERS" "SETUPFILE")))
+ "CONSTANTS" "PROPERTY" "DRAWERS" "SETUPFILE")
+ "\\(?:[a-zA-Z][0-9a-zA-Z_]*_TODO\\)"))
(splitre "[ \t]+")
kwds kws0 kwsa key log value cat arch tags const links hw dws
tail sep kws1 prio props ftags drawers
(push (cons 'sequence (org-split-string value splitre)) kwds))
((equal key "TYP_TODO")
(push (cons 'type (org-split-string value splitre)) kwds))
+ ((string-match "\\`\\([a-zA-Z][0-9a-zA-Z_]*\\)_TODO\\'" key)
+ ;; general TODO-like setup
+ (push (cons (intern (downcase (match-string 1 key)))
+ (org-split-string value splitre)) kwds))
((equal key "TAGS")
- (setq tags (append tags (org-split-string value splitre))))
+ (setq tags (append tags (if tags '("\\n") nil)
+ (org-split-string value splitre))))
((equal key "COLUMNS")
(org-set-local 'org-columns-default-format value))
((equal key "LINK")
(org-set-local 'org-lowest-priority (nth 1 prio))
(org-set-local 'org-default-priority (nth 2 prio)))
(and props (org-set-local 'org-file-properties (nreverse props)))
- (and ftags (org-set-local 'org-file-tags ftags))
+ (and ftags (org-set-local 'org-file-tags
+ (mapcar 'org-add-prop-inherited ftags)))
(and drawers (org-set-local 'org-drawers drawers))
(and arch (org-set-local 'org-archive-location arch))
(and links (setq org-link-abbrev-alist-local (nreverse links)))
(setq kwds (nreverse kwds))
(let (inter kws kw)
(while (setq kws (pop kwds))
- (setq inter (pop kws) sep (member "|" kws)
- kws0 (delete "|" (copy-sequence kws))
- kwsa nil
- kws1 (mapcar
- (lambda (x)
- ;; 1 2
- (if (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$" x)
- (progn
- (setq kw (match-string 1 x)
- key (and (match-end 2) (match-string 2 x))
- log (org-extract-log-state-settings x))
- (push (cons kw (and key (string-to-char key))) kwsa)
- (and log (push log org-todo-log-states))
- kw)
- (error "Invalid TODO keyword %s" x)))
- kws0)
- kwsa (if kwsa (append '((:startgroup))
- (nreverse kwsa)
- '((:endgroup))))
- hw (car kws1)
- dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1))
- tail (list inter hw (car dws) (org-last dws)))
+ (let ((kws (or
+ (run-hook-with-args-until-success
+ 'org-todo-setup-filter-hook kws)
+ kws)))
+ (setq inter (pop kws) sep (member "|" kws)
+ kws0 (delete "|" (copy-sequence kws))
+ kwsa nil
+ kws1 (mapcar
+ (lambda (x)
+ ;; 1 2
+ (if (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$" x)
+ (progn
+ (setq kw (match-string 1 x)
+ key (and (match-end 2) (match-string 2 x))
+ log (org-extract-log-state-settings x))
+ (push (cons kw (and key (string-to-char key))) kwsa)
+ (and log (push log org-todo-log-states))
+ kw)
+ (error "Invalid TODO keyword %s" x)))
+ kws0)
+ kwsa (if kwsa (append '((:startgroup))
+ (nreverse kwsa)
+ '((:endgroup))))
+ hw (car kws1)
+ dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1))
+ tail (list inter hw (car dws) (org-last dws))))
(add-to-list 'org-todo-heads hw 'append)
(push kws1 org-todo-sets)
(setq org-done-keywords (append org-done-keywords dws nil))
(cond
((equal e "{") (push '(:startgroup) tgs))
((equal e "}") (push '(:endgroup) tgs))
+ ((equal e "\\n") (push '(:newline) tgs))
((string-match (org-re "^\\([[:alnum:]_@]+\\)(\\(.\\))$") e)
(push (cons (match-string 1 e)
(string-to-char (match-string 2 e)))
;; Compute the regular expressions and other local variables
(if (not org-done-keywords)
- (setq org-done-keywords (list (org-last org-todo-keywords-1))))
+ (setq org-done-keywords (and org-todo-keywords-1
+ (list (org-last org-todo-keywords-1)))))
(setq org-ds-keyword-length (+ 2 (max (length org-deadline-string)
(length org-scheduled-string)
(length org-clock-string)
(concat "\\<\\("
(mapconcat 'regexp-quote org-not-done-keywords "\\|")
"\\)\\>")
+ org-not-done-heading-regexp
+ (concat "^\\(\\*+\\)[ \t]+\\("
+ (mapconcat 'regexp-quote org-not-done-keywords "\\|")
+ "\\)\\>")
org-todo-line-regexp
(concat "^\\(\\*+\\)[ \t]+\\(?:\\("
(mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
(mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
"\\)\\>\\)?\\(?:[ \t]*\\(\\[#.\\]\\)\\)?[ \t]*\\(.*?\\)"
"\\(?:[ \t]+\\(:[[:alnum:]_@:]+:\\)\\)?[ \t]*$")
+ org-complex-heading-regexp-format
+ (concat "^\\(\\*+\\)[ \t]+\\(?:\\("
+ (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
+ "\\)\\>\\)?\\(?:[ \t]*\\(\\[#.\\]\\)\\)?[ \t]*\\(%s\\)"
+ "\\(?:[ \t]+\\(:[[:alnum:]_@:]+:\\)\\)?[ \t]*$")
org-nl-done-regexp
(concat "\n\\*+[ \t]+"
"\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|")
(cond
((equal e '(:startgroup)) (push e new))
((equal e '(:endgroup)) (push e new))
+ ((equal e '(:newline)) (push e new))
(t
(setq k (car e) c2 nil)
(if (cdr e)
(defvar org-window-configuration nil
"Used in various places to store a window configuration.")
+(defvar org-selected-window nil
+ "Used in various places to store a window configuration.")
(defvar org-finish-function nil
"Function to be called when `C-c C-c' is used.
This is for getting out of special buffers like remember.")
;; FIXME: Occasionally check by commenting these, to make sure
;; no other functions uses these, forgetting to let-bind them.
(defvar entry)
-(defvar state)
(defvar last-state)
(defvar date)
-(defvar description)
;; Defined somewhere in this file, but used before definition.
(defvar org-html-entities)
(defvar org-struct-menu)
(defvar org-org-menu)
(defvar org-tbl-menu)
-(defvar org-agenda-keymap)
;;;; Define the Org-mode
"Every change indicates that a table might need an update."
(setq org-table-may-need-update t))
(defvar org-mode-map)
-(defvar org-mode-hook nil
- "Mode hook for Org-mode, run after the mode was turned on.")
(defvar org-inhibit-startup nil) ; Dynamically-scoped param.
(defvar org-agenda-keep-modes nil) ; Dynamically-scoped param.
+(defvar org-inhibit-logging nil) ; Dynamically-scoped param.
+(defvar org-inhibit-blocking nil) ; Dynamically-scoped param.
(defvar org-table-buffer-is-an nil)
(defconst org-outline-regexp "\\*+ ")
(org-install-agenda-files-menu)
(if org-descriptive-links (org-add-to-invisibility-spec '(org-link)))
(org-add-to-invisibility-spec '(org-cwidth))
+ (org-add-to-invisibility-spec '(org-hide-block . t))
(when (featurep 'xemacs)
(org-set-local 'line-move-ignore-invisible t))
(org-set-local 'outline-regexp org-outline-regexp)
;; too late :-(
(if org-enforce-todo-dependencies
(add-hook 'org-blocker-hook
- 'org-block-todo-from-children-or-siblings)
+ 'org-block-todo-from-children-or-siblings-or-parent)
(remove-hook 'org-blocker-hook
- 'org-block-todo-from-children-or-siblings))
+ 'org-block-todo-from-children-or-siblings-or-parent))
(if org-enforce-todo-checkbox-dependencies
(add-hook 'org-blocker-hook
'org-block-todo-from-checkboxes)
(let ((bmp (buffer-modified-p)))
(org-table-map-tables 'org-table-align)
(set-buffer-modified-p bmp)))
+ (when org-startup-indented
+ (require 'org-indent)
+ (org-indent-mode 1))
(org-set-startup-visibility)))
+(when (fboundp 'abbrev-table-put)
+ (abbrev-table-put org-mode-abbrev-table
+ :parents (list text-mode-abbrev-table)))
+
(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify)
(defun org-current-time ()
(when org-tab-follows-link
(org-defkey org-mouse-map [(tab)] 'org-open-at-point)
(org-defkey org-mouse-map "\C-i" 'org-open-at-point))
-(when org-return-follows-link
- (org-defkey org-mouse-map [(return)] 'org-open-at-point)
- (org-defkey org-mouse-map "\C-m" 'org-open-at-point))
(require 'font-lock)
(defun org-do-emphasis-faces (limit)
"Run through the buffer and add overlays to links."
- (let (rtn)
+ (let (rtn a)
(while (and (not rtn) (re-search-forward org-emph-re limit t))
(if (not (= (char-after (match-beginning 3))
(char-after (match-beginning 4))))
(progn
(setq rtn t)
+ (setq a (assoc (match-string 3) org-emphasis-alist))
(font-lock-prepend-text-property (match-beginning 2) (match-end 2)
'face
- (nth 1 (assoc (match-string 3)
- org-emphasis-alist)))
+ (nth 1 a))
+ (and (nth 4 a)
+ (org-remove-flyspell-overlays-in
+ (match-beginning 0) (match-end 0)))
(add-text-properties (match-beginning 2) (match-end 2)
'(font-lock-multiline t))
(when org-hide-emphasis-markers
(defconst org-nonsticky-props
'(mouse-face highlight keymap invisible intangible help-echo org-linked-text))
+(defsubst org-rear-nonsticky-at (pos)
+ (add-text-properties (1- pos) pos (list 'rear-nonsticky org-nonsticky-props)))
(defun org-activate-plain-links (limit)
"Run through the buffer and add overlays to links."
(catch 'exit
(let (f)
- (while (re-search-forward org-plain-link-re limit t)
- (setq f (get-text-property (match-beginning 0) 'face))
- (if (or (eq f 'org-tag)
- (and (listp f) (memq 'org-tag f)))
- nil
- (add-text-properties (match-beginning 0) (match-end 0)
- (list 'mouse-face 'highlight
- 'rear-nonsticky org-nonsticky-props
- 'keymap org-mouse-map
- ))
- (throw 'exit t))))))
+ (if (re-search-forward org-plain-link-re limit t)
+ (progn
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
+ (setq f (get-text-property (match-beginning 0) 'face))
+ (if (or (eq f 'org-tag)
+ (and (listp f) (memq 'org-tag f)))
+ nil
+ (add-text-properties (match-beginning 0) (match-end 0)
+ (list 'mouse-face 'highlight
+ 'face 'org-link
+ 'keymap org-mouse-map))
+ (org-rear-nonsticky-at (match-end 0)))
+ t)))))
(defun org-activate-code (limit)
(if (re-search-forward "^[ \t]*\\(: .*\n?\\)" limit t)
(progn
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
(remove-text-properties (match-beginning 0) (match-end 0)
'(display t invisible t intangible t))
t)))
+(defun org-fontify-meta-lines-and-blocks (limit)
+ "Fontify #+ lines and blocks, in the correct ways."
+ (let ((case-fold-search t))
+ (if (re-search-forward
+ "^\\([ \t]*#\\+\\(\\([a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)\\(.*\\)\\)"
+ limit t)
+ (let ((beg (match-beginning 0))
+ (beg1 (line-beginning-position 2))
+ (dc1 (downcase (match-string 2)))
+ (dc3 (downcase (match-string 3)))
+ end end1 quoting block-type)
+ (cond
+ ((member dc1 '("html:" "ascii:" "latex:" "docbook:"))
+ ;; a single line of backend-specific content
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
+ (remove-text-properties (match-beginning 0) (match-end 0)
+ '(display t invisible t intangible t))
+ (add-text-properties (match-beginning 1) (match-end 3)
+ '(font-lock-fontified t face org-meta-line))
+ (add-text-properties (match-beginning 6) (match-end 6)
+ '(font-lock-fontified t face org-block))
+ t)
+ ((and (match-end 4) (equal dc3 "begin"))
+ ;; Truely a block
+ (setq block-type (downcase (match-string 5))
+ quoting (member block-type org-protecting-blocks))
+ (when (re-search-forward
+ (concat "^[ \t]*#\\+end" (match-string 4) "\\>.*")
+ nil t) ;; on purpose, we look further than LIMIT
+ (setq end (match-end 0) end1 (1- (match-beginning 0)))
+ (when quoting
+ (remove-text-properties beg end
+ '(display t invisible t intangible t)))
+ (add-text-properties
+ beg end
+ '(font-lock-fontified t font-lock-multiline t))
+ (add-text-properties beg beg1 '(face org-meta-line))
+ (add-text-properties end1 end '(face org-meta-line))
+ (cond
+ (quoting
+ (add-text-properties beg1 end1 '(face org-block)))
+ ((string= block-type "quote")
+ (add-text-properties beg1 end1 '(face org-quote)))
+ ((string= block-type "verse")
+ (add-text-properties beg1 end1 '(face org-verse))))
+ t))
+ ((not (member (char-after beg) '(?\ ?\t)))
+ ;; just any other in-buffer setting, but not indented
+ (add-text-properties
+ beg (match-end 0)
+ '(font-lock-fontified t face org-meta-line))
+ t)
+ ((or (member dc1 '("begin:" "end:" "caption:" "label:"
+ "orgtbl:" "tblfm:" "tblname:"))
+ (and (match-end 4) (equal dc3 "attr")))
+ (add-text-properties
+ beg (match-end 0)
+ '(font-lock-fontified t face org-meta-line))
+ t)
+ ((member dc3 '(" " ""))
+ (add-text-properties
+ beg (match-end 0)
+ '(font-lock-fontified t face font-lock-comment-face)))
+ (t nil))))))
+
(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
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
(add-text-properties (match-beginning 0) (match-end 0)
(list 'mouse-face 'highlight
- 'rear-nonsticky org-nonsticky-props
- 'keymap org-mouse-map
- ))
+ 'keymap org-mouse-map))
+ (org-rear-nonsticky-at (match-end 0))
t)))
(defun org-activate-footnote-links (limit)
"Run through the buffer and add overlays to links."
- (if (re-search-forward "\\(^\\|[^][]\\)\\(\\[\\([0-9]+\\]\\|fn:[^ \t\r\n:]+?[]:]\\)\\)"
+ (if (re-search-forward "\\(^\\|[^][]\\)\\(\\[\\([0-9]+\\]\\|fn:[^ \t\r\n:]+?[]:]\\)\\)"
limit t)
(progn
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
(add-text-properties (match-beginning 2) (match-end 2)
(list 'mouse-face 'highlight
- 'rear-nonsticky org-nonsticky-props
'keymap org-mouse-map
'help-echo
(if (= (point-at-bol) (match-beginning 2))
"Footnote definition"
"Footnote reference")
))
+ (org-rear-nonsticky-at (match-end 2))
t)))
(defun org-activate-bracket-links (limit)
;; but that requires another match, protecting match data,
;; a lot of overhead for font-lock.
(ip (org-maybe-intangible
- (list 'invisible 'org-link 'rear-nonsticky org-nonsticky-props
+ (list 'invisible 'org-link
'keymap org-mouse-map 'mouse-face 'highlight
'font-lock-multiline t 'help-echo help)))
- (vp (list 'rear-nonsticky org-nonsticky-props
- 'keymap org-mouse-map 'mouse-face 'highlight
- ' font-lock-multiline t 'help-echo help)))
+ (vp (list 'keymap org-mouse-map 'mouse-face 'highlight
+ 'font-lock-multiline t 'help-echo help)))
;; We need to remove the invisible property here. Table narrowing
;; may have made some of this invisible.
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
(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)
+ (org-rear-nonsticky-at (match-beginning 3))
(add-text-properties (match-beginning 3) (match-end 3) vp)
- (add-text-properties (match-end 3) (match-end 0) ip))
+ (org-rear-nonsticky-at (match-end 3))
+ (add-text-properties (match-end 3) (match-end 0) ip)
+ (org-rear-nonsticky-at (match-end 0)))
(add-text-properties (match-beginning 0) (match-beginning 1) ip)
+ (org-rear-nonsticky-at (match-beginning 1))
(add-text-properties (match-beginning 1) (match-end 1) vp)
- (add-text-properties (match-end 1) (match-end 0) ip))
+ (org-rear-nonsticky-at (match-end 1))
+ (add-text-properties (match-end 1) (match-end 0) ip)
+ (org-rear-nonsticky-at (match-end 0)))
t)))
(defun org-activate-dates (limit)
"Run through the buffer and add overlays to dates."
(if (re-search-forward org-tsr-regexp-both limit t)
(progn
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
(add-text-properties (match-beginning 0) (match-end 0)
(list 'mouse-face 'highlight
- 'rear-nonsticky org-nonsticky-props
'keymap org-mouse-map))
+ (org-rear-nonsticky-at (match-end 0))
(when org-display-custom-times
(if (match-end 3)
(org-display-custom-time (match-beginning 3) (match-end 3)))
(let ((case-fold-search t))
(if (re-search-forward org-target-link-regexp limit t)
(progn
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
(add-text-properties (match-beginning 0) (match-end 0)
(list 'mouse-face 'highlight
- 'rear-nonsticky org-nonsticky-props
'keymap org-mouse-map
'help-echo "Radio target link"
'org-linked-text t))
+ (org-rear-nonsticky-at (match-end 0))
t)))))
(defun org-update-radio-target-regexp ()
"Regular expression for highlighting export special stuff.")
(defvar org-match-substring-regexp)
(defvar org-match-substring-with-braces-regexp)
-(defvar org-export-html-special-string-regexps)
+
+;; This should be with the exporter code, but we also use if for font-locking
+(defconst org-export-html-special-string-regexps
+ '(("\\\\-" . "­")
+ ("---\\([^-]\\)" . "—\\1")
+ ("--\\([^-]\\)" . "–\\1")
+ ("\\.\\.\\." . "…"))
+ "Regular expressions for special string conversion.")
+
(defun org-compute-latex-and-specials-regexp ()
"Compute regular expression for stuff treated specially by exporters."
(regexp-opt
(append (mapcar 'car org-html-entities)
(if (boundp 'org-latex-entities)
- org-latex-entities nil))
+ (mapcar (lambda (x)
+ (or (car-safe x) x))
+ org-latex-entities)
+ nil))
'words))) ; FIXME
))
;; (list "\\\\\\(?:[a-zA-Z]+\\)")))
(defun org-activate-tags (limit)
(if (re-search-forward (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \r\n]") limit t)
(progn
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
(add-text-properties (match-beginning 1) (match-end 1)
(list 'mouse-face 'highlight
- 'rear-nonsticky org-nonsticky-props
'keymap org-mouse-map))
+ (org-rear-nonsticky-at (match-end 1))
t)))
(defun org-outline-level ()
+ "Compute the outline level of the heading at point.
+This function assumes that the cursor is at the beginning of a line matched
+by outline-regexp. Otherwise it returns garbage.
+If this is called at a normal headline, the level is the number of stars.
+Use `org-reduced-level' to remove the effect of `org-odd-levels'.
+For plain list items, if they are matched by `outline-regexp', this returns
+1000 plus the line indentation."
(save-excursion
(looking-at outline-regexp)
(if (match-beginning 1)
;; Call the hook
'(org-font-lock-hook)
;; Headlines
- '("^\\(\\**\\)\\(\\* \\)\\(.*\\)" (1 (org-get-level-face 1))
- (2 (org-get-level-face 2)) (3 (org-get-level-face 3)))
+ `(,(if org-fontify-whole-heading-line
+ "^\\(\\**\\)\\(\\* \\)\\(.*\n?\\)"
+ "^\\(\\**\\)\\(\\* \\)\\(.*\\)")
+ (1 (org-get-level-face 1))
+ (2 (org-get-level-face 2))
+ (3 (org-get-level-face 3)))
;; Table lines
'("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
(1 'org-table t))
'("^[ \t]*|\\(?:.*?|\\)? *\\(:?=[^|\n]*\\)" (1 'org-formula t))
'("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t))
'("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t))
+ '("| *\\(<[lr]?[0-9]*>\\)" (1 'org-formula t))
;; Drawers
(list org-drawer-regexp '(0 'org-special-keyword t))
(list "^[ \t]*:END:" '(0 'org-special-keyword t))
(list org-property-re
'(1 'org-special-keyword t)
'(3 'org-property-value t))
- (if org-format-transports-properties-p
- '("| *\\(<[0-9]+>\\) *" (1 'org-formula t)))
;; Links
(if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend)))
(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 'plain lk) '(org-activate-plain-links))
(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)))
'("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t))
'(org-hide-wide-columns (0 nil append))
;; TODO lines
- (list (concat "^\\*+[ \t]+" org-todo-regexp)
+ (list (concat "^\\*+[ \t]+" org-todo-regexp "\\([ \t]\\|$\\)")
'(1 (org-get-todo-face 1) t))
;; DONE
(if org-fontify-done-headline
'(2 'org-headline-done t))
nil)
;; Priorities
- (list (concat "\\[#[A-Z0-9]\\]") '(0 'org-special-keyword t))
+ '(org-font-lock-add-priority-faces)
;; Tags
'(org-font-lock-add-tag-faces)
;; Special keywords
'(org-do-emphasis-faces)))
;; Checkboxes
'("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)"
- 2 'bold prepend)
+ 2 'org-checkbox prepend)
(if org-provide-checkbox-statistics
'("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]"
(0 (org-get-checkbox-statistics-face) t)))
;; Description list items
'("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(.*? ::\\)"
2 'bold prepend)
+ ;; ARCHIVEd headings
(list (concat "^\\*+ \\(.*:" org-archive-tag ":.*\\)")
'(1 'org-archived prepend))
;; Specials
"\\|" org-quote-string "\\)\\>")
'(1 'org-special-keyword t))
'("^#.*" (0 'font-lock-comment-face t))
+ ;; Blocks and meta lines
+ '(org-fontify-meta-lines-and-blocks)
)))
(setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords))
;; Now set the full font-lock-keywords
'(org-font-lock-keywords t nil nil backward-paragraph))
(kill-local-variable 'font-lock-keywords) nil))
+(defun org-fontify-like-in-org-mode (s &optional odd-levels)
+ "Fontify string S like in Org-mode"
+ (with-temp-buffer
+ (insert s)
+ (let ((org-odd-levels-only odd-levels))
+ (org-mode)
+ (font-lock-fontify-buffer)
+ (buffer-string))))
+
(defvar org-m nil)
(defvar org-l nil)
(defvar org-f nil)
'font-lock-fontified t))
(backward-char 1))))
+(defun org-font-lock-add-priority-faces (limit)
+ "Add the special priority faces."
+ (while (re-search-forward "\\[#\\([A-Z0-9]\\)\\]" limit t)
+ (add-text-properties
+ (match-beginning 0) (match-end 0)
+ (list 'face (or (cdr (assoc (char-after (match-beginning 1))
+ org-priority-faces))
+ 'org-special-keyword)
+ 'font-lock-fontified t))))
+
(defun org-get-tag-face (kwd)
"Get the right face for a TODO keyword KWD.
If KWD is a number, get the corresponding match group."
(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 t keymap t org-linked-text t
- invisible t intangible t))))
+ (remove-text-properties
+ beg end
+ (if org-indent-mode
+ ;; also remove line-prefix and wrap-prefix properties
+ '(mouse-face t keymap t org-linked-text t
+ invisible t intangible t
+ line-prefix t wrap-prefix t
+ org-no-flyspell t)
+ '(mouse-face t keymap t org-linked-text t
+ invisible t intangible t
+ org-no-flyspell t)))))
;;;; Visibility cycling, including org-goto and indirect buffer
(make-variable-buffer-local 'org-cycle-subtree-status)
;;;###autoload
+
+(defvar org-inlinetask-min-level)
+
(defun org-cycle (&optional arg)
- "Visibility cycling for Org-mode.
+ "TAB-action and visibility cycling for Org-mode.
+
+This is the command invoked in Org-mode by the TAB key. Its main purpose
+is outline visibility cycling, but it also invokes other actions
+in special contexts.
- 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 called with two C-u C-u prefixes, switch to the startup visibility,
+ When called with two `C-u C-u' prefixes, switch to the startup visibility,
determined by the variable `org-startup-folded', and by any VISIBILITY
properties in the buffer.
- When called with three C-u C-u C-u prefixed, show the entire buffer,
- including drawers.
+ When called with three `C-u C-u C-u' prefixed, show the entire buffer,
+ including any drawers.
+
+- When inside a table, re-align the table and move to the next field.
- When point is at the beginning of a headline, rotate the subtree started
by this line through 3 different states (local cycling)
From this state, you can move to one of the children
and zoom in further.
3. SUBTREE: Show the entire subtree, including body text.
+ If there is no subtree, switch directly from CHILDREN to FOLDED.
- 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
But only if also the variable `org-cycle-global-at-bob' is t."
(interactive "P")
(org-load-modules-maybe)
- (let* ((outline-regexp
- (if (and (org-mode-p) 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
- (delq 'org-optimize-window-after-visibility-change
- (copy-sequence org-cycle-hook))
- org-cycle-hook))
- (pos (point)))
-
- (if (or bob-special (equal arg '(4)))
- ;; special case: use global cycling
- (setq arg t))
+ (unless (or (run-hook-with-args-until-success 'org-tab-first-hook)
+ (and org-cycle-level-after-item/entry-creation
+ (or (org-cycle-level)
+ (org-cycle-item-indentation))))
+ (let* ((limit-level
+ (or org-cycle-max-level
+ (and (boundp 'org-inlinetask-min-level)
+ org-inlinetask-min-level
+ (1- org-inlinetask-min-level))))
+ (nstars (and limit-level
+ (if org-odd-levels-only
+ (and limit-level (1- (* limit-level 2)))
+ limit-level)))
+ (outline-regexp
+ (cond
+ ((not (org-mode-p)) outline-regexp)
+ ((or (eq org-cycle-include-plain-lists 'integrate)
+ (and org-cycle-include-plain-lists (org-at-item-p)))
+ (concat "\\(?:\\*"
+ (if nstars (format "\\{1,%d\\}" nstars) "+")
+ " \\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) \\)"))
+ (t (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ ")))))
+ (bob-special (and org-cycle-global-at-bob (bobp)
+ (not (looking-at outline-regexp))))
+ (org-cycle-hook
+ (if bob-special
+ (delq 'org-optimize-window-after-visibility-change
+ (copy-sequence org-cycle-hook))
+ org-cycle-hook))
+ (pos (point)))
+
+ (if (or bob-special (equal arg '(4)))
+ ;; special case: use global cycling
+ (setq arg t))
- (cond
+ (cond
- ((equal arg '(16))
- (org-set-startup-visibility)
- (message "Startup visibility, plus VISIBILITY properties"))
+ ((equal arg '(16))
+ (org-set-startup-visibility)
+ (message "Startup visibility, plus VISIBILITY properties"))
- ((equal arg '(64))
- (show-all)
- (message "Entire buffer visible, including drawers"))
+ ((equal arg '(64))
+ (show-all)
+ (message "Entire buffer visible, including drawers"))
- ((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)
- (call-interactively 'org-table-next-field)))))
+ ((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)
+ (call-interactively 'org-table-next-field)))))
+
+ ((run-hook-with-args-until-success
+ 'org-tab-after-check-for-table-hook))
+
+ ((eq arg t) ;; Global cycling
+ (org-cycle-internal-global))
+
+ ((and org-drawers org-drawer-regexp
+ (save-excursion
+ (beginning-of-line 1)
+ (looking-at org-drawer-regexp)))
+ ;; Toggle block visibility
+ (org-flag-drawer
+ (not (get-char-property (match-end 0) 'invisible))))
+
+ ((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)))
- ((eq arg t) ;; Global cycling
+ ((and (save-excursion (beginning-of-line 1) (looking-at outline-regexp))
+ (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
- (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))
+ (org-cycle-internal-local))
- (t
- ;; Default action: go to overview
- (org-overview)
- (message "OVERVIEW")
- (setq org-cycle-global-status 'overview)
- (run-hook-with-args 'org-cycle-hook 'overview))))
+ ;; TAB emulation and template completion
+ (buffer-read-only (org-back-to-heading))
- ((and org-drawers org-drawer-regexp
- (save-excursion
- (beginning-of-line 1)
- (looking-at org-drawer-regexp)))
- ;; Toggle block visibility
- (org-flag-drawer
- (not (get-char-property (match-end 0) 'invisible))))
+ ((run-hook-with-args-until-success
+ 'org-tab-after-check-for-cycling-hook))
- ((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)))
+ ((org-try-structure-completion))
- ((and (save-excursion (beginning-of-line 1) (looking-at outline-regexp))
- (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
- ;; 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)
- (unless (eobp)
- (skip-chars-forward " \t\n")
- (beginning-of-line 1) ; in case this is an item
- )
- (setq eos (1- (point))))
- ;; 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)
- (save-excursion
- (goto-char eos)
- (outline-next-heading)
- (if (org-invisible-p) (org-flag-heading nil))))
- ((or (>= eol eos)
- (not (string-match "\\S-" (buffer-substring eol eos))))
- ;; Entire subtree is hidden in one line: open it
- (org-show-entry)
- (show-children)
- (message "CHILDREN")
- (save-excursion
- (goto-char eos)
- (outline-next-heading)
- (if (org-invisible-p) (org-flag-heading nil)))
- (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)))))
+ ((org-try-cdlatex-tab))
- ;; TAB emulation and template completion
- (buffer-read-only (org-back-to-heading))
+ ((run-hook-with-args-until-success
+ 'org-tab-before-tab-emulation-hook))
- ((org-try-structure-completion))
+ ((and (eq org-cycle-emulate-tab 'exc-hl-bol)
+ (or (not (bolp))
+ (not (looking-at outline-regexp))))
+ (call-interactively (global-key-binding "\t")))
- ((org-try-cdlatex-tab))
+ ((if (and (memq org-cycle-emulate-tab '(white whitestart))
+ (save-excursion (beginning-of-line 1) (looking-at "[ \t]*"))
+ (or (and (eq org-cycle-emulate-tab 'white)
+ (= (match-end 0) (point-at-eol)))
+ (and (eq org-cycle-emulate-tab 'whitestart)
+ (>= (match-end 0) pos))))
+ t
+ (eq org-cycle-emulate-tab t))
+ (call-interactively (global-key-binding "\t")))
- ((and (eq org-cycle-emulate-tab 'exc-hl-bol)
- (or (not (bolp))
- (not (looking-at outline-regexp))))
- (call-interactively (global-key-binding "\t")))
+ (t (save-excursion
+ (org-back-to-heading)
+ (org-cycle)))))))
- ((if (and (memq org-cycle-emulate-tab '(white whitestart))
- (save-excursion (beginning-of-line 1) (looking-at "[ \t]*"))
- (or (and (eq org-cycle-emulate-tab 'white)
- (= (match-end 0) (point-at-eol)))
- (and (eq org-cycle-emulate-tab 'whitestart)
- (>= (match-end 0) pos))))
- t
- (eq org-cycle-emulate-tab t))
- (call-interactively (global-key-binding "\t")))
+(defun org-cycle-internal-global ()
+ "Do the global cycling action."
+ (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
+ (run-hook-with-args 'org-pre-cycle-hook 'contents)
+ (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
+ (run-hook-with-args 'org-pre-cycle-hook 'all)
+ (show-all)
+ (message "SHOW ALL")
+ (setq org-cycle-global-status 'all)
+ (run-hook-with-args 'org-cycle-hook 'all))
- (t (save-excursion
- (org-back-to-heading)
- (org-cycle))))))
+ (t
+ ;; Default action: go to overview
+ (run-hook-with-args 'org-pre-cycle-hook 'overview)
+ (org-overview)
+ (message "OVERVIEW")
+ (setq org-cycle-global-status 'overview)
+ (run-hook-with-args 'org-cycle-hook 'overview))))
+
+(defun org-cycle-internal-local ()
+ "Do the local cycling action."
+ (org-back-to-heading)
+ (let ((goal-column 0) eoh eol eos level has-children children-skipped)
+ ;; First, some boundaries
+ (save-excursion
+ (org-back-to-heading)
+ (setq level (funcall outline-level))
+ (save-excursion
+ (beginning-of-line 2)
+ (if (or (featurep 'xemacs) (<= emacs-major-version 21))
+ ; XEmacs does not have `next-single-char-property-change'
+ ; I'm not sure about Emacs 21.
+ (while (and (not (eobp)) ;; this is like `next-line'
+ (get-char-property (1- (point)) 'invisible))
+ (beginning-of-line 2))
+ (while (and (not (eobp)) ;; this is like `next-line'
+ (get-char-property (1- (point)) 'invisible))
+ (goto-char (next-single-char-property-change (point) 'invisible))
+;;;??? (or (bolp) (beginning-of-line 2))))
+ (and (eolp) (beginning-of-line 2))))
+ (setq eol (point)))
+ (outline-end-of-heading) (setq eoh (point))
+ (save-excursion
+ (outline-next-heading)
+ (setq has-children (and (org-at-heading-p t)
+ (> (funcall outline-level) level))))
+ (org-end-of-subtree t)
+ (unless (eobp)
+ (skip-chars-forward " \t\n")
+ (beginning-of-line 1) ; in case this is an item
+ )
+ (setq eos (if (eobp) (point) (1- (point)))))
+ ;; Find out what to do next and set `this-command'
+ (cond
+ ((= eos eoh)
+ ;; Nothing is hidden behind this heading
+ (run-hook-with-args 'org-pre-cycle-hook 'empty)
+ (message "EMPTY ENTRY")
+ (setq org-cycle-subtree-status nil)
+ (save-excursion
+ (goto-char eos)
+ (outline-next-heading)
+ (if (org-invisible-p) (org-flag-heading nil))))
+ ((and (or (>= eol eos)
+ (not (string-match "\\S-" (buffer-substring eol eos))))
+ (or has-children
+ (not (setq children-skipped
+ org-cycle-skip-children-state-if-no-children))))
+ ;; Entire subtree is hidden in one line: children view
+ (run-hook-with-args 'org-pre-cycle-hook 'children)
+ (org-show-entry)
+ (show-children)
+ (message "CHILDREN")
+ (save-excursion
+ (goto-char eos)
+ (outline-next-heading)
+ (if (org-invisible-p) (org-flag-heading nil)))
+ (setq org-cycle-subtree-status 'children)
+ (run-hook-with-args 'org-cycle-hook 'children))
+ ((or children-skipped
+ (and (eq last-command this-command)
+ (eq org-cycle-subtree-status 'children)))
+ ;; We just showed the children, or no children are there,
+ ;; now show everything.
+ (run-hook-with-args 'org-pre-cycle-hook 'subtree)
+ (org-show-subtree)
+ (message (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE"))
+ (setq org-cycle-subtree-status 'subtree)
+ (run-hook-with-args 'org-cycle-hook 'subtree))
+ (t
+ ;; Default action: hide the subtree.
+ (run-hook-with-args 'org-pre-cycle-hook 'folded)
+ (hide-subtree)
+ (message "FOLDED")
+ (setq org-cycle-subtree-status 'folded)
+ (run-hook-with-args 'org-cycle-hook 'folded)))))
;;;###autoload
(defun org-global-cycle (&optional arg)
((eq org-startup-folded 'content)
(let ((this-command 'org-cycle) (last-command 'org-cycle))
(org-cycle '(4)) (org-cycle '(4)))))
- (org-set-visibility-according-to-property 'no-cleanup)
- (org-cycle-hide-archived-subtrees 'all)
- (org-cycle-hide-drawers 'all)
- (org-cycle-show-empty-lines 'all))
+ (unless (eq org-startup-folded 'showeverything)
+ (if org-hide-block-startup (org-hide-block-all))
+ (org-set-visibility-according-to-property 'no-cleanup)
+ (org-cycle-hide-archived-subtrees 'all)
+ (org-cycle-hide-drawers 'all)
+ (org-cycle-show-empty-lines 'all)))
(defun org-set-visibility-according-to-property (&optional no-cleanup)
"Switch subtree visibilities according to :VISIBILITY: property."
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 'overview) (org-beginning-of-line))
((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-compact-display-after-subtree-move ()
- "Show a compacter version of the tree of the entry's parent."
- (save-excursion
- (if (org-up-heading-safe)
- (progn
- (hide-subtree)
- (show-entry)
- (show-children)
- (org-cycle-show-empty-lines 'children)
- (org-cycle-hide-drawers 'children))
- (org-overview))))
+(defun org-remove-empty-overlays-at (pos)
+ "Remove outline overlays that do not contain non-white stuff."
+ (mapc
+ (lambda (o)
+ (and (eq 'outline (org-overlay-get o 'invisible))
+ (not (string-match "\\S-" (buffer-substring (org-overlay-start o)
+ (org-overlay-end o))))
+ (org-delete-overlay o)))
+ (org-overlays-at pos)))
+
+(defun org-clean-visibility-after-subtree-move ()
+ "Fix visibility issues after moving a subtree."
+ ;; First, find a reasonable region to look at:
+ ;; Start two siblings above, end three below
+ (let* ((beg (save-excursion
+ (and (org-get-last-sibling)
+ (org-get-last-sibling))
+ (point)))
+ (end (save-excursion
+ (and (org-get-next-sibling)
+ (org-get-next-sibling)
+ (org-get-next-sibling))
+ (if (org-at-heading-p)
+ (point-at-eol)
+ (point))))
+ (level (looking-at "\\*+"))
+ (re (if level (concat "^" (regexp-quote (match-string 0)) " "))))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (when re
+ ;; Properly fold already folded siblings
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (if (save-excursion (goto-char (point-at-eol)) (org-invisible-p))
+ (hide-entry))))
+ (org-cycle-show-empty-lines 'overview)
+ (org-cycle-hide-drawers 'overview)))))
(defun org-cycle-show-empty-lines (state)
"Show empty lines above all visible headlines.
`org-cycle-hook'. Lisp program can use t for STATE to get the
entire buffer covered. Note that an empty line is only shown if there
are at least `org-cycle-separator-lines' empty lines before the headline."
- (when (> org-cycle-separator-lines 0)
+ (when (not (= org-cycle-separator-lines 0))
(save-excursion
- (let* ((n org-cycle-separator-lines)
+ (let* ((n (abs org-cycle-separator-lines))
(re (cond
((= n 1) "\\(\n[ \t]*\n\\*+\\) ")
((= n 2) "^[ \t]*\\(\n[ \t]*\n\\*+\\) ")
(t (let ((ns (number-to-string (- n 2))))
(concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}"
"[ \t]*\\(\n[ \t]*\n\\*+\\) ")))))
- beg end)
+ beg end b e)
(cond
((memq state '(overview contents t))
(setq beg (point-min) end (point-max)))
(when beg
(goto-char beg)
(while (re-search-forward re end t)
- (if (not (get-char-property (match-end 1) 'invisible))
- (outline-flag-region
- (match-beginning 1) (match-end 1) nil)))))))
+ (unless (get-char-property (match-end 1) 'invisible)
+ (setq e (match-end 1))
+ (if (< org-cycle-separator-lines 0)
+ (setq b (save-excursion
+ (goto-char (match-beginning 0))
+ (org-back-over-empty-lines)
+ (if (save-excursion
+ (goto-char (max (point-min) (1- (point))))
+ (org-on-heading-p))
+ (1- (point))
+ (point))))
+ (setq b (match-beginning 1)))
+ (outline-flag-region b e nil)))))))
;; Never hide empty lines at the end of the file.
(save-excursion
(goto-char (point-max))
(let ((context (if (org-up-heading-safe) 'children 'overview)))
(org-cycle-show-empty-lines context))))
+(defun org-files-list ()
+ "Return `org-agenda-files' list, plus all open org-mode files.
+This is useful for operations that need to scan all of a user's
+open and agenda-wise Org files."
+ (let ((files (mapcar 'expand-file-name (org-agenda-files))))
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (if (and (eq major-mode 'org-mode) (buffer-file-name))
+ (let ((file (expand-file-name (buffer-file-name))))
+ (unless (member file files)
+ (push file files))))))
+ files))
+
+(defsubst org-entry-beginning-position ()
+ "Return the beginning position of the current entry."
+ (save-excursion (outline-back-to-heading t) (point)))
+
+(defsubst org-entry-end-position ()
+ "Return the end position of the current entry."
+ (save-excursion (outline-next-heading) (point)))
+
(defun org-cycle-hide-drawers (state)
"Re-hide all drawers after a visibility state change."
(when (and (org-mode-p)
- (not (memq state '(overview folded))))
+ (not (memq state '(overview folded contents))))
(save-excursion
(let* ((globalp (memq state '(contents all)))
(beg (if globalp (point-min) (point)))
- (end (if globalp (point-max) (org-end-of-subtree t))))
+ (end (if globalp (point-max)
+ (if (eq state 'children)
+ (save-excursion (outline-next-heading) (point))
+ (org-end-of-subtree t)))))
(goto-char beg)
(while (re-search-forward org-drawer-regexp end t)
(org-flag-drawer t))))))
"^[ \t]*:END:"
(save-excursion (outline-next-heading) (point)) t)
(outline-flag-region b (point-at-eol) flag)
- (error ":END: line missing"))))))
+ (error ":END: line missing at position %s" b))))))
(defun org-subtree-end-visible-p ()
"Is the end of the current subtree visible?"
(beginning-of-line)
(recenter (prefix-numeric-value N))))
+;;; Folding of blocks
+
+(defconst org-block-regexp
+
+ "^[ \t]*#\\+begin_\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_\\1[ \t]*$"
+ "Regular expression for hiding blocks.")
+
+(defvar org-hide-block-overlays nil
+ "Overlays hiding blocks.")
+(make-variable-buffer-local 'org-hide-block-overlays)
+
+(defun org-block-map (function &optional start end)
+ "Call func at the head of all source blocks in the current
+buffer. Optional arguments START and END can be used to limit
+the range."
+ (let ((start (or start (point-min)))
+ (end (or end (point-max))))
+ (save-excursion
+ (goto-char start)
+ (while (and (< (point) end) (re-search-forward org-block-regexp end t))
+ (save-excursion
+ (save-match-data
+ (goto-char (match-beginning 0))
+ (funcall function)))))))
+
+(defun org-hide-block-toggle-all ()
+ "Toggle the visibility of all blocks in the current buffer."
+ (org-block-map #'org-hide-block-toggle))
+
+(defun org-hide-block-all ()
+ "Fold all blocks in the current buffer."
+ (interactive)
+ (org-show-block-all)
+ (org-block-map #'org-hide-block-toggle-maybe))
+
+(defun org-show-block-all ()
+ "Unfold all blocks in the current buffer."
+ (mapc 'org-delete-overlay org-hide-block-overlays)
+ (setq org-hide-block-overlays nil))
+
+(defun org-hide-block-toggle-maybe ()
+ "Toggle visibility of block at point."
+ (interactive)
+ (let ((case-fold-search t))
+ (if (save-excursion
+ (beginning-of-line 1)
+ (looking-at org-block-regexp))
+ (progn (org-hide-block-toggle)
+ t) ;; to signal that we took action
+ nil))) ;; to signal that we did not
+
+(defun org-hide-block-toggle (&optional force)
+ "Toggle the visibility of the current block."
+ (interactive)
+ (save-excursion
+ (beginning-of-line)
+ (if (re-search-forward org-block-regexp nil t)
+ (let ((start (- (match-beginning 4) 1)) ;; beginning of body
+ (end (match-end 0)) ;; end of entire body
+ ov)
+ (if (memq t (mapcar (lambda (overlay)
+ (eq (org-overlay-get overlay 'invisible)
+ 'org-hide-block))
+ (org-overlays-at start)))
+ (if (or (not force) (eq force 'off))
+ (mapc (lambda (ov)
+ (when (member ov org-hide-block-overlays)
+ (setq org-hide-block-overlays
+ (delq ov org-hide-block-overlays)))
+ (when (eq (org-overlay-get ov 'invisible)
+ 'org-hide-block)
+ (org-delete-overlay ov)))
+ (org-overlays-at start)))
+ (setq ov (org-make-overlay start end))
+ (org-overlay-put ov 'invisible 'org-hide-block)
+ ;; make the block accessible to isearch
+ (org-overlay-put
+ ov 'isearch-open-invisible
+ (lambda (ov)
+ (when (member ov org-hide-block-overlays)
+ (setq org-hide-block-overlays
+ (delq ov org-hide-block-overlays)))
+ (when (eq (org-overlay-get ov 'invisible)
+ 'org-hide-block)
+ (org-delete-overlay ov))))
+ (push ov org-hide-block-overlays)))
+ (error "Not looking at a source block"))))
+
+;; org-tab-after-check-for-cycling-hook
+(add-hook 'org-tab-first-hook 'org-hide-block-toggle-maybe)
+;; Remove overlays when changing major mode
+(add-hook 'org-mode-hook
+ (lambda () (org-add-hook 'change-major-mode-hook
+ 'org-show-block-all 'append 'local)))
+
;;; Org-goto
(defvar org-goto-window-configuration nil)
(defvar org-goto-start-pos) ; dynamically scoped parameter
-;; FIXME: Docstring doe not mention both interfaces
+;; FIXME: Docstring does not mention both interfaces
(defun org-goto (&optional alternative-interface)
"Look up a different location in the current file, keeping current visibility.
(interactive "P")
(let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level))))
(org-refile-use-outline-path t)
+ (org-refile-target-verify-function nil)
(interface
(if (not alternative-interface)
org-goto-interface
(goto-char org-goto-start-pos)
(and (org-invisible-p) (org-show-context)))
(goto-char (point-min)))
- (org-beginning-of-line)
+ (let (org-special-ctrl-a/e) (org-beginning-of-line))
(message "Select location and press RET")
(use-local-map org-goto-map)
(recursive-edit)
(outline-up-heading 1 t)))
(setq beg (point)
heading (org-get-heading))
- (org-end-of-subtree t) (setq end (point)))
+ (org-end-of-subtree t t) (setq end (point)))
(if (and (buffer-live-p org-last-indirect-buffer)
(not (eq org-indirect-buffer-display 'new-frame))
(not arg))
(switch-to-buffer ibuf))
((eq org-indirect-buffer-display 'other-window)
(pop-to-buffer ibuf))
- (t (error "Invalid value.")))
+ (t (error "Invalid value")))
(if (featurep 'xemacs)
(save-excursion (org-mode) (turn-on-font-lock)))
(narrow-to-region beg end)
(or (beginning-of-line 0) t)
(save-match-data
(looking-at "[ \t]*$")))))
-
+
(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.
;; insert before the current line
(open-line (if blank 2 1)))
((and (bolp)
+ (not org-insert-heading-respect-content)
(or (bobp)
(save-excursion
(backward-char 1) (not (org-invisible-p)))))
(org-match-string-no-properties 4)
(org-match-string-no-properties 5)))))
+(defun org-get-entry ()
+ "Get the entry text, after heading, entire subtree."
+ (save-excursion
+ (org-back-to-heading t)
+ (buffer-substring (point-at-bol 2) (org-end-of-subtree t))))
+
(defun org-insert-heading-after-current ()
"Insert a new heading with same level as current, after current subtree."
(interactive)
(org-back-to-heading)
(outline-previous-heading)
(looking-at org-todo-line-regexp))
- (if (or arg
- (not (match-beginning 2))
- (member (match-string 2) org-done-keywords))
- (insert (car org-todo-keywords-1) " ")
- (insert (match-string 2) " "))
+ (let*
+ ((new-mark-x
+ (if (or arg
+ (not (match-beginning 2))
+ (member (match-string 2) org-done-keywords))
+ (car org-todo-keywords-1)
+ (match-string 2)))
+ (new-mark
+ (or
+ (run-hook-with-args-until-success
+ 'org-todo-get-default-hook new-mark-x nil)
+ new-mark-x)))
+ (beginning-of-line 1)
+ (and (looking-at "\\*+ ") (goto-char (match-end 0))
+ (if org-treat-insert-todo-heading-as-state-change
+ (org-todo new-mark)
+ (insert new-mark " "))))
(when org-provide-todo-statistics
(org-update-parent-todo-statistics))))
;;; Promotion and Demotion
+(defvar org-after-demote-entry-hook nil
+ "Hook run after an entry has been demoted.
+The cursor will be at the beginning of the entry.
+When a subtree is being demoted, the hook will be called for each node.")
+
+(defvar org-after-promote-entry-hook nil
+ "Hook run after an entry has been promoted.
+The cursor will be at the beginning of the entry.
+When a subtree is being promoted, the hook will be called for each node.")
+
(defun org-promote-subtree ()
"Promote the entire subtree.
See also `org-promote'."
((eolp) (insert " "))
((equal (char-after) ?\ ) (forward-char 1))))))
+(defun org-current-level ()
+ "Return the level of the current entry, or nil if before the first headline.
+The level is the number of stars at the beginning of the headline."
+ (save-excursion
+ (condition-case nil
+ (progn
+ (org-back-to-heading t)
+ (funcall outline-level))
+ (error nil))))
+
(defun org-reduced-level (l)
"Compute the effective level of a heading.
This takes into account the setting of `org-odd-levels-only'."
(cond ((or (not change) (= 0 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))))
+ (max 1 (+ level (or change 0)))))
(if (boundp 'define-obsolete-function-alias)
(if (or (featurep 'xemacs) (< emacs-major-version 23))
(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 (- diff)))))
+ (if org-adapt-indentation (org-fixup-indentation (- diff)))
+ (run-hooks 'org-after-promote-entry-hook)))
(defun org-demote ()
"Demote the current heading lower down the tree.
(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 diff))))
+ (if org-adapt-indentation (org-fixup-indentation diff))
+ (run-hooks 'org-after-demote-entry-hook)))
+
+(defvar org-tab-ind-state nil)
+
+(defun org-cycle-level ()
+ (let ((org-adapt-indentation nil))
+ (when (and (looking-at "[ \t]*$")
+ (looking-back
+ (concat "^\\(\\*+\\)[ \t]+\\(" org-todo-regexp "\\)?[ \t]*")))
+ (setq this-command 'org-cycle-level)
+ (if (eq last-command 'org-cycle-level)
+ (condition-case nil
+ (progn (org-do-promote)
+ (if (equal org-tab-ind-state (org-current-level))
+ (org-do-promote)))
+ (error
+ (progn
+ (save-excursion
+ (beginning-of-line 1)
+ (and (looking-at "\\*+")
+ (replace-match
+ (make-string org-tab-ind-state ?*))))
+ (setq this-command 'org-cycle))))
+ (setq org-tab-ind-state (- (match-end 1) (match-beginning 1)))
+ (org-do-demote))
+ t)))
(defun org-map-tree (fun)
"Call FUN for every heading underneath the current one."
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)
+ (let ((outline-regexp org-outline-regexp)
+ (outline-level 'org-outline-level)
+ (org-odd-levels-only nil) n)
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^\\*\\*+ " nil t)
(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
;; First check if there are no even levels
(when (re-search-forward "^\\(\\*\\*\\)+ " nil t)
(org-show-context t)
- (error "Not all levels are odd in this file. Conversion not possible."))
+ (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)
+ (let ((outline-regexp org-outline-regexp)
+ (outline-level 'org-outline-level)
+ (org-odd-levels-only nil) n)
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^\\*\\*+ " nil t)
"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))
+ (let ((movfunc (if (> arg 0) 'org-get-next-sibling
+ 'org-get-last-sibling))
(ins-point (make-marker))
(cnt (abs arg))
beg beg0 end txt folded ne-beg ne-end ne-ins ins-end)
(setq txt (buffer-substring beg end))
(org-save-markers-in-region beg end)
(delete-region beg end)
+ (org-remove-empty-overlays-at beg)
(or (= beg (point-min)) (outline-flag-region (1- beg) beg nil))
(or (bobp) (outline-flag-region (1- (point)) (point) nil))
+ (and (not (bolp)) (looking-at "\n") (forward-char 1))
(let ((bbb (point)))
(insert-before-markers txt)
(org-reinstall-markers-in-region bbb)
(kill-line (- ne-ins ne-beg)) (point)))
(insert (make-string (- ne-ins ne-beg) ?\n)))
(move-marker ins-point nil)
- (org-compact-display-after-subtree-move)
- (org-show-empty-lines-in-parent)
- (unless folded
+ (if folded
+ (hide-subtree)
(org-show-entry)
(show-children)
- (org-cycle-hide-drawers 'children))))
+ (org-cycle-hide-drawers 'children))
+ (org-clean-visibility-after-subtree-move)))
(defvar org-subtree-clip ""
"Clipboard for cut and paste of subtrees.
(save-excursion (outline-end-of-heading)
(setq folded (org-invisible-p)))
(condition-case nil
- (outline-forward-same-level (1- n))
+ (org-forward-same-level (1- n) t)
(error nil))
(org-end-of-subtree t t))
(org-back-over-empty-lines)
move back over whitespace before inserting, and move point to the end of
the inserted text when done."
(interactive "P")
+ (setq tree (or tree (and kill-ring (current-kill 0))))
(unless (org-kill-is-subtree-p tree)
(error "%s"
(substitute-command-keys
"The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway")))
(let* ((visp (not (org-invisible-p)))
- (txt (or tree (and kill-ring (current-kill 0))))
+ (txt tree)
(^re (concat "^\\(" outline-regexp "\\)"))
(re (concat "\\(" outline-regexp "\\)"))
(^re_ (concat "\\(\\*+\\)[ \t]*"))
(save-excursion
(save-match-data
(narrow-to-region
- (progn (org-back-to-heading) (point))
- (progn (org-end-of-subtree t) (point))))))
-
+ (progn (org-back-to-heading t) (point))
+ (progn (org-end-of-subtree t t) (point))))))
+
+(defun org-clone-subtree-with-time-shift (n &optional shift)
+ "Clone the task (subtree) at point N times.
+The clones will be inserted as siblings.
+
+In interactive use, the user will be prompted for the number of clones
+to be produced, and for a time SHIFT, which may be a repeater as used
+in time stamps, for example `+3d'.
+
+When a valid repeater is given and the entry contains any time stamps,
+the clones will become a sequence in time, with time stamps in the
+subtree shifted for each clone produced. If SHIFT is nil or the
+empty string, time stamps will be left alone.
+
+If the original subtree did contain time stamps with a repeater,
+the following will happen:
+- the repeater will be removed in each clone
+- an additional clone will be produced, with the current, unshifted
+ date(s) in the entry.
+- the original entry will be placed *after* all the clones, with
+ repeater intact.
+- the start days in the repeater in the original entry will be shifted
+ to past the last clone.
+I this way you can spell out a number of instances of a repeating task,
+and still retain the repeater to cover future instances of the task."
+ (interactive "nNumber of clones to produce: \nsDate shift per clone (e.g. +1w, empty to copy unchanged): ")
+ (let (beg end template task
+ shift-n shift-what doshift nmin nmax (n-no-remove -1))
+ (if (not (and (integerp n) (> n 0)))
+ (error "Invalid number of replications %s" n))
+ (if (and (setq doshift (and (stringp shift) (string-match "\\S-" shift)))
+ (not (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([dwmy]\\)[ \t]*\\'"
+ shift)))
+ (error "Invalid shift specification %s" shift))
+ (when doshift
+ (setq shift-n (string-to-number (match-string 1 shift))
+ shift-what (cdr (assoc (match-string 2 shift)
+ '(("d" . day) ("w" . week)
+ ("m" . month) ("y" . year))))))
+ (if (eq shift-what 'week) (setq shift-n (* 7 shift-n) shift-what 'day))
+ (setq nmin 1 nmax n)
+ (org-back-to-heading t)
+ (setq beg (point))
+ (org-end-of-subtree t t)
+ (or (bolp) (insert "\n"))
+ (setq end (point))
+ (setq template (buffer-substring beg end))
+ (when (and doshift
+ (string-match "<[^<>\n]+ \\+[0-9]+[dwmy][^<>\n]*>" template))
+ (delete-region beg end)
+ (setq end beg)
+ (setq nmin 0 nmax (1+ nmax) n-no-remove nmax))
+ (goto-char end)
+ (loop for n from nmin to nmax do
+ (if (not doshift)
+ (setq task template)
+ (with-temp-buffer
+ (insert template)
+ (org-mode)
+ (goto-char (point-min))
+ (while (re-search-forward org-ts-regexp-both nil t)
+ (org-timestamp-change (* n shift-n) shift-what))
+ (unless (= n n-no-remove)
+ (goto-char (point-min))
+ (while (re-search-forward org-ts-regexp nil t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (if (looking-at "<[^<>\n]+\\( +\\+[0-9]+[dwmy]\\)")
+ (delete-region (match-beginning 1) (match-end 1))))))
+ (setq task (buffer-string))))
+ (insert task))
+ (goto-char beg)))
;;; Outline Sorting
(defun org-sort (with-case)
"Call `org-sort-entries-or-items' or `org-table-sort-lines'.
-Optional argument WITH-CASE means sort case-sensitively."
+Optional argument WITH-CASE means sort case-sensitively.
+With a double prefix argument, also remove duplicate entries."
(interactive "P")
(if (org-at-table-p)
(org-call-with-arg 'org-table-sort-lines with-case)
(defvar org-priority-regexp) ; defined later in the file
+(defvar org-after-sorting-entries-or-items-hook nil
+ "Hook that is run after a bunch of entries or items have been sorted.
+When children are sorted, the cursor is in the parent line when this
+hook gets called. When a region or a plain list is sorted, the cursor
+will be in the first entry of the sorted region/list.")
+
(defun org-sort-entries-or-items
(&optional with-case sorting-type getkey-func compare-func property)
- "Sort entries on a certain level of an outline tree.
+ "Sort entries on a certain level of an outline tree, or plain list items.
If there is an active region, the entries in the region are sorted.
Else, if the cursor is before the first entry, sort the top-level items.
Else, the children of the entry at point are sorted.
+If the cursor is at the first item in a plain list, the list items will be
+sorted.
+
+Sorting can be alphabetically, numerically, by date/time as given by
+a time stamp, by a property or by priority.
+
+The command prompts for the sorting type unless it has been given to the
+function through the SORTING-TYPE argument, which needs to a character,
+\(?n ?N ?a ?A ?t ?T ?s ?S ?d ?D ?p ?P ?r ?R ?f ?F). Here is the
+precise meaning of each character:
+
+n Numerically, by converting the beginning of the entry/item to a number.
+a Alphabetically, ignoring the TODO keyword and the priority, if any.
+t By date/time, either the first active time stamp in the entry, or, if
+ none exist, by the first inactive one.
+ In items, only the first line will be checked.
+s By the scheduled date/time.
+d By deadline date/time.
+c By creation time, which is assumed to be the first inactive time stamp
+ at the beginning of a line.
+p By priority according to the cookie.
+r By the value of a property.
+
+Capital letters will reverse the sort order.
-Sorting can be alphabetically, numerically, and by date/time as given by
-the first time stamp in the entry. The command prompts for the sorting
-type unless it has been given to the function through the SORTING-TYPE
-argument, which needs to a character, any of (?n ?N ?a ?A ?t ?T ?p ?P ?f ?F).
If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be
called with point at the beginning of the record. It must return either
a string or a number that should serve as the sorting key for that record.
((org-at-item-p)
;; we will sort this plain list
(org-beginning-of-item-list) (setq start (point))
- (org-end-of-item-list) (setq end (point))
+ (org-end-of-item-list)
+ (or (bolp) (insert "\n"))
+ (setq end (point))
(goto-char start)
(setq plain-list-p t
what "plain list"))
(org-back-to-heading)
(setq start (point)
end (progn (org-end-of-subtree t t)
+ (or (bolp) (insert "\n"))
(org-back-over-empty-lines)
(point))
what "children")
;; we will sort the top-level entries in this file
(goto-char (point-min))
(or (org-on-heading-p) (outline-next-heading))
- (setq start (point) end (point-max) what "top-level")
+ (setq start (point))
+ (goto-char (point-max))
+ (beginning-of-line 1)
+ (when (looking-at ".*?\\S-")
+ ;; File ends in a non-white line
+ (end-of-line 1)
+ (insert "\n"))
+ (setq end (point-max))
+ (setq what "top-level")
(goto-char start)
(show-all)))
(unless sorting-type
(message
(if plain-list-p
- "Sort %s: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:"
- "Sort %s: [a]lpha [n]umeric [t]ime [p]riority p[r]operty todo[o]rder [f]unc A/N/T/P/O/F means reversed:")
+ "Sort %s: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:"
+ "Sort %s: [a]lpha [n]umeric [p]riority p[r]operty todo[o]rder [f]unc
+ [t]ime [s]cheduled [d]eadline [c]reated
+ A/N/T/S/D/C/P/O/F means reversed:")
what)
(setq sorting-type (read-char-exclusive))
(and (= (downcase sorting-type) ?f)
(setq getkey-func
- (org-ido-completing-read "Sort using function: "
+ (org-icompleting-read "Sort using function: "
obarray 'fboundp t nil nil))
(setq getkey-func (intern getkey-func)))
(and (= (downcase sorting-type) ?r)
(setq property
- (org-ido-completing-read "Property: "
+ (org-icompleting-read "Property: "
(mapcar 'list (org-buffer-property-keys t))
nil t))))
(narrow-to-region start end)
(let ((dcst (downcase sorting-type))
+ (case-fold-search nil)
(now (current-time)))
(sort-subr
(/= dcst sorting-type)
((= dcst ?a)
(buffer-substring (match-end 0) (point-at-eol)))
((= dcst ?t)
- (if (re-search-forward org-ts-regexp
- (point-at-eol) t)
- (org-time-string-to-time (match-string 0))
- now))
+ (if (or (re-search-forward org-ts-regexp (point-at-eol) t)
+ (re-search-forward org-ts-regexp-both
+ (point-at-eol) t))
+ (org-time-string-to-seconds (match-string 0))
+ (org-float-time now)))
((= dcst ?f)
(if getkey-func
(progn
(funcall case-func (match-string 4))
nil))
((= dcst ?t)
- (if (re-search-forward org-ts-regexp
- (save-excursion
- (forward-line 2)
- (point)) t)
- (org-time-string-to-time (match-string 0))
- now))
+ (let ((end (save-excursion (outline-next-heading) (point))))
+ (if (or (re-search-forward org-ts-regexp end t)
+ (re-search-forward org-ts-regexp-both end t))
+ (org-time-string-to-seconds (match-string 0))
+ (org-float-time now))))
+ ((= dcst ?c)
+ (let ((end (save-excursion (outline-next-heading) (point))))
+ (if (re-search-forward
+ (concat "^[ \t]*\\[" org-ts-regexp1 "\\]")
+ end t)
+ (org-time-string-to-seconds (match-string 0))
+ (org-float-time now))))
+ ((= dcst ?s)
+ (let ((end (save-excursion (outline-next-heading) (point))))
+ (if (re-search-forward org-scheduled-time-regexp end t)
+ (org-time-string-to-seconds (match-string 1))
+ (org-float-time now))))
+ ((= dcst ?d)
+ (let ((end (save-excursion (outline-next-heading) (point))))
+ (if (re-search-forward org-deadline-time-regexp end t)
+ (org-time-string-to-seconds (match-string 1))
+ (org-float-time now))))
((= dcst ?p)
(if (re-search-forward org-priority-regexp (point-at-eol) t)
(string-to-char (match-string 2))
nil
(cond
((= dcst ?a) 'string<)
- ((= dcst ?t) 'time-less-p)
((= dcst ?f) compare-func)
+ ((member dcst '(?p ?t ?s ?d ?c)) '<)
(t nil)))))
+ (run-hooks 'org-after-sorting-entries-or-items-hook)
(message "Sorting entries...done")))
(defun org-do-sort (table what &optional with-case sorting-type)
((= dcst ?t)
(setq extractfun
(lambda (x)
- (if (string-match org-ts-regexp x)
- (time-to-seconds
+ (if (or (string-match org-ts-regexp x)
+ (string-match org-ts-regexp-both x))
+ (org-float-time
(org-time-string-to-time (match-string 0 x)))
0))
comparefun (if (= dcst sorting-type) '< '>)))
table)
(lambda (a b) (funcall comparefun (car a) (car b))))))
-;;; Editing source examples
-
-(defvar org-exit-edit-mode-map (make-sparse-keymap))
-(define-key org-exit-edit-mode-map "\C-c'" 'org-edit-src-exit)
-(defvar org-edit-src-force-single-line nil)
-(defvar org-edit-src-from-org-mode nil)
-(defvar org-edit-src-picture nil)
-
-(define-minor-mode org-exit-edit-mode
- "Minor mode installing a single key binding, \"C-c '\" to exit special edit.")
-
-(defun org-edit-src-code ()
- "Edit the source code example at point.
-An indirect buffer is created, and that buffer is then narrowed to the
-example at point and switched to the correct language mode. When done,
-exit by killing the buffer with \\[org-edit-src-exit]."
- (interactive)
- (let ((line (org-current-line))
- (case-fold-search t)
- (msg (substitute-command-keys
- "Edit, then exit with C-c ' (C-c and single quote)"))
- (info (org-edit-src-find-region-and-lang))
- (org-mode-p (eq major-mode 'org-mode))
- beg end lang lang-f single lfmt)
- (if (not info)
- nil
- (setq beg (nth 0 info)
- end (nth 1 info)
- lang (nth 2 info)
- single (nth 3 info)
- lfmt (nth 4 info)
- lang-f (intern (concat lang "-mode")))
- (unless (functionp lang-f)
- (error "No such language mode: %s" lang-f))
- (goto-line line)
- (if (get-buffer "*Org Edit Src Example*")
- (kill-buffer "*Org Edit Src Example*"))
- (switch-to-buffer (make-indirect-buffer (current-buffer)
- "*Org Edit Src Example*"))
- (narrow-to-region beg end)
- (remove-text-properties beg end '(display nil invisible nil
- intangible nil))
- (let ((org-inhibit-startup t))
- (funcall lang-f))
- (set (make-local-variable 'org-edit-src-force-single-line) single)
- (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p)
- (when lfmt
- (set (make-local-variable 'org-coderef-label-format) lfmt))
- (when org-mode-p
- (goto-char (point-min))
- (while (re-search-forward "^," nil t)
- (replace-match "")))
- (goto-line line)
- (org-exit-edit-mode)
- (org-set-local 'header-line-format msg)
- (message "%s" msg)
- t)))
-
-(defun org-edit-fixed-width-region ()
- "Edit the fixed-width ascii drawing at point.
-This must be a region where each line starts with a colon followed by
-a space character.
-An indirect buffer is created, and that buffer is then narrowed to the
-example at point and switched to artist-mode. When done,
-exit by killing the buffer with \\[org-edit-src-exit]."
- (interactive)
- (let ((line (org-current-line))
- (case-fold-search t)
- (msg (substitute-command-keys
- "Edit, then exit with C-c ' (C-c and single quote)"))
- (org-mode-p (eq major-mode 'org-mode))
- beg end)
- (beginning-of-line 1)
- (if (looking-at "[ \t]*[^:\n \t]")
- nil
- (if (looking-at "[ \t]*\\(\n\\|\\'\\)")
- (setq beg (point) end beg)
- (save-excursion
- (if (re-search-backward "^[ \t]*[^:]" nil 'move)
- (setq beg (point-at-bol 2))
- (setq beg (point))))
- (save-excursion
- (if (re-search-forward "^[ \t]*[^:]" nil 'move)
- (setq end (1- (match-beginning 0)))
- (setq end (point))))
- (goto-line line))
- (if (get-buffer "*Org Edit Picture*")
- (kill-buffer "*Org Edit Picture*"))
- (switch-to-buffer (make-indirect-buffer (current-buffer)
- "*Org Edit Picture*"))
- (narrow-to-region beg end)
- (remove-text-properties beg end '(display nil invisible nil
- intangible nil))
- (when (fboundp 'font-lock-unfontify-region)
- (font-lock-unfontify-region (point-min) (point-max)))
- (cond
- ((eq org-edit-fixed-width-region-mode 'artist-mode)
- (fundamental-mode)
- (artist-mode 1))
- (t (funcall org-edit-fixed-width-region-mode)))
- (set (make-local-variable 'org-edit-src-force-single-line) nil)
- (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p)
- (set (make-local-variable 'org-edit-src-picture) t)
- (goto-char (point-min))
- (while (re-search-forward "^[ \t]*: ?" nil t)
- (replace-match ""))
- (goto-line line)
- (org-exit-edit-mode)
- (org-set-local 'header-line-format msg)
- (message "%s" msg)
- t)))
-
-
-(defun org-edit-src-find-region-and-lang ()
- "Find the region and language for a local edit.
-Return a list with beginning and end of the region, a string representing
-the language, a switch telling of the content should be in a single line."
- (let ((re-list
- (append
- org-edit-src-region-extra
- '(
- ("<src\\>[^<]*>[ \t]*\n?" "\n?[ \t]*</src>" lang)
- ("<literal\\>[^<]*>[ \t]*\n?" "\n?[ \t]*</literal>" style)
- ("<example>[ \t]*\n?" "\n?[ \t]*</example>" "fundamental")
- ("<lisp>[ \t]*\n?" "\n?[ \t]*</lisp>" "emacs-lisp")
- ("<perl>[ \t]*\n?" "\n?[ \t]*</perl>" "perl")
- ("<python>[ \t]*\n?" "\n?[ \t]*</python>" "python")
- ("<ruby>[ \t]*\n?" "\n?[ \t]*</ruby>" "ruby")
- ("^#\\+begin_src\\( \\([^ \t\n]+\\)\\)?.*\n" "\n#\\+end_src" 2)
- ("^#\\+begin_example.*\n" "\n#\\+end_example" "fundamental")
- ("^#\\+html:" "\n" "html" single-line)
- ("^#\\+begin_html.*\n" "\n#\\+end_html" "html")
- ("^#\\+begin_latex.*\n" "\n#\\+end_latex" "latex")
- ("^#\\+latex:" "\n" "latex" single-line)
- ("^#\\+begin_ascii.*\n" "\n#\\+end_ascii" "fundamental")
- ("^#\\+ascii:" "\n" "ascii" single-line)
- )))
- (pos (point))
- re1 re2 single beg end lang lfmt match-re1)
- (catch 'exit
- (while (setq entry (pop re-list))
- (setq re1 (car entry) re2 (nth 1 entry) lang (nth 2 entry)
- single (nth 3 entry))
- (save-excursion
- (if (or (looking-at re1)
- (re-search-backward re1 nil t))
- (progn
- (setq match-re1 (match-string 0))
- (setq beg (match-end 0)
- lang (org-edit-src-get-lang lang)
- lfmt (org-edit-src-get-label-format match-re1))
- (if (and (re-search-forward re2 nil t)
- (>= (match-end 0) pos))
- (throw 'exit (list beg (match-beginning 0)
- lang single lfmt))))
- (if (or (looking-at re2)
- (re-search-forward re2 nil t))
- (progn
- (setq end (match-beginning 0))
- (if (and (re-search-backward re1 nil t)
- (<= (match-beginning 0) pos))
- (progn
- (setq lfmt (org-edit-src-get-label-format
- (match-string 0)))
- (throw 'exit
- (list (match-end 0) end
- (org-edit-src-get-lang lang)
- single lfmt))))))))))))
-
-(defun org-edit-src-get-lang (lang)
- "Extract the src language."
- (let ((m (match-string 0)))
- (cond
- ((stringp lang) lang)
- ((integerp lang) (match-string lang))
- ((and (eq lang 'lang)
- (string-match "\\<lang=\"\\([^ \t\n\"]+\\)\"" m))
- (match-string 1 m))
- ((and (eq lang 'style)
- (string-match "\\<style=\"\\([^ \t\n\"]+\\)\"" m))
- (match-string 1 m))
- (t "fundamental"))))
-
-(defun org-edit-src-get-label-format (s)
- "Extract the label format."
- (save-match-data
- (if (string-match "-l[ \t]+\\\\?\"\\([^\t\r\n\"]+\\)\\\\?\"" s)
- (match-string 1 s))))
-
-(defun org-edit-src-exit ()
- "Exit special edit and protect problematic lines."
- (interactive)
- (unless (buffer-base-buffer (current-buffer))
- (error "This is not an indirect buffer, something is wrong..."))
- (unless (> (point-min) 1)
- (error "This buffer is not narrowed, something is wrong..."))
- (goto-char (point-min))
- (if (looking-at "[ \t\n]*\n") (replace-match ""))
- (if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match ""))
- (when (org-bound-and-true-p org-edit-src-force-single-line)
- (goto-char (point-min))
- (while (re-search-forward "\n" nil t)
- (replace-match " "))
- (goto-char (point-min))
- (if (looking-at "\\s-*") (replace-match " "))
- (if (re-search-forward "\\s-+\\'" nil t)
- (replace-match "")))
- (when (org-bound-and-true-p org-edit-src-from-org-mode)
- (goto-char (point-min))
- (while (re-search-forward (if (org-mode-p) "^\\(.\\)" "^\\([*#]\\)") nil t)
- (replace-match ",\\1"))
- (when font-lock-mode
- (font-lock-unfontify-region (point-min) (point-max)))
- (put-text-property (point-min) (point-max) 'font-lock-fontified t))
- (when (org-bound-and-true-p org-edit-src-picture)
- (untabify (point-min) (point-max))
- (goto-char (point-min))
- (while (re-search-forward "^" nil t)
- (replace-match ": "))
- (when font-lock-mode
- (font-lock-unfontify-region (point-min) (point-max)))
- (put-text-property (point-min) (point-max) 'font-lock-fontified t))
- (kill-buffer (current-buffer))
- (and (org-mode-p) (org-restart-font-lock)))
-
;;; The orgstruct minor mode
"Unconditionally turn on `orgstruct-mode'."
(orgstruct-mode 1))
+(defun orgstruct++-mode (&optional arg)
+ "Toggle `orgstruct-mode', the enhanced version of it.
+In addition to setting orgstruct-mode, this also exports all indentation
+and autofilling variables from org-mode into the buffer. It will also
+recognize item context in multiline items.
+Note that turning off orgstruct-mode will *not* remove the
+indentation/paragraph settings. This can only be done by refreshing the
+major mode, for example with \\[normal-mode]."
+ (interactive "P")
+ (setq arg (prefix-numeric-value (or arg (if orgstruct-mode -1 1))))
+ (if (< arg 1)
+ (orgstruct-mode -1)
+ (orgstruct-mode 1)
+ (let (var val)
+ (mapc
+ (lambda (x)
+ (when (string-match
+ "^\\(paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)"
+ (symbol-name (car x)))
+ (setq var (car x) val (nth 1 x))
+ (org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val))))
+ org-local-vars)
+ (org-set-local 'orgstruct-is-++ t))))
+
+(defvar orgstruct-is-++ nil
+ "Is orgstruct-mode in ++ version in the current-buffer?")
+(make-variable-buffer-local 'orgstruct-is-++)
+
;;;###autoload
(defun turn-on-orgstruct++ ()
- "Unconditionally turn on `orgstruct-mode', and force org-mode indentations.
-In addition to setting orgstruct-mode, this also exports all indentation and
-autofilling variables from org-mode into the buffer. Note that turning
-off orgstruct-mode will *not* remove these additional settings."
- (orgstruct-mode 1)
- (let (var val)
- (mapc
- (lambda (x)
- (when (string-match
- "^\\(paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)"
- (symbol-name (car x)))
- (setq var (car x) val (nth 1 x))
- (org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val))))
- org-local-vars)))
+ "Unconditionally turn on `orgstruct++-mode'."
+ (orgstruct++-mode 1))
(defun orgstruct-error ()
"Error when there is no default binding for a structure key."
'([(meta shift down)] org-shiftmetadown)
'([(meta shift left)] org-shiftmetaleft)
'([(meta shift right)] org-shiftmetaright)
+ '([?\e (up)] org-metaup)
+ '([?\e (down)] org-metadown)
+ '([?\e (left)] org-metaleft)
+ '([?\e (right)] org-metaright)
+ '([?\e (shift up)] org-shiftmetaup)
+ '([?\e (shift down)] org-shiftmetadown)
+ '([?\e (shift left)] org-shiftmetaleft)
+ '([?\e (shift right)] org-shiftmetaright)
'([(shift up)] org-shiftup)
'([(shift down)] org-shiftdown)
'([(shift left)] org-shiftleft)
(orgstruct-make-binding 'org-insert-todo-heading 107
[(meta return)] "\M-\C-m"))
+ (org-defkey orgstruct-mode-map "\e\C-m"
+ (orgstruct-make-binding 'org-insert-heading 108
+ "\e\C-m" [?\e (return)]))
+ (org-defkey orgstruct-mode-map [?\e (return)]
+ (orgstruct-make-binding 'org-insert-heading 109
+ [?\e (return)] "\e\C-m"))
+ (org-defkey orgstruct-mode-map [?\e (shift return)]
+ (orgstruct-make-binding 'org-insert-todo-heading 110
+ [?\e (return)] "\e\C-m"))
+
(unless org-local-vars
(setq org-local-vars (org-get-local-variables)))
"'.")
'(interactive "p")
(list 'if
- '(org-context-p 'headline 'item)
+ `(org-context-p 'headline 'item
+ (and orgstruct-is-++
+ ,(and (memq fun '(org-insert-heading org-insert-todo-heading)) t)
+ 'item-body))
(list 'org-run-like-in-org-mode (list 'quote fun))
(list 'let '(orgstruct-mode)
(list 'call-interactively
;;????????? (looking-at "\\*+"))
(looking-at outline-regexp))
(and (memq 'item contexts)
- (looking-at "[ \t]*\\([-+*] \\|[0-9]+[.)] \\)")))
+ (looking-at "[ \t]*\\([-+*] \\|[0-9]+[.)] \\)"))
+ (and (memq 'item-body contexts)
+ (org-in-item-p)))
(goto-char pos))))
(defun org-get-local-variables ()
;;;###autoload
(defun org-run-like-in-org-mode (cmd)
+ "Run a command, pretending that the current buffer is in Org-mode.
+This will temporarily bind local variables that are typically bound in
+Org-mode to the values they have in Org-mode, and then interactively
+call CMD."
(org-load-modules-maybe)
(unless org-local-vars
(setq org-local-vars (org-get-local-variables)))
(setcdr (assoc type org-link-protocols) (list follow export))
(push (list type follow export) org-link-protocols)))
+(defvar org-agenda-buffer-name)
+
;;;###autoload
(defun org-store-link (arg)
"\\<org-mode-map>Store an org-link to the current location.
(interactive "P")
(org-load-modules-maybe)
(setq org-store-link-plist nil) ; reset
- (let (link cpltxt desc description search txt)
+ (let ((outline-regexp (org-get-limited-outline-regexp))
+ link cpltxt desc description search txt custom-id)
(cond
((run-hook-with-args-until-success 'org-store-link-functions)
(insert link)
(setq link (concat "(" label ")") desc nil)))
+ ((equal (org-bound-and-true-p org-agenda-buffer-name) (buffer-name))
+ ;; We are in the agenda, link to referenced location
+ (let ((m (or (get-text-property (point) 'org-hd-marker)
+ (get-text-property (point) 'org-marker))))
+ (when m
+ (org-with-point-at m
+ (call-interactively 'org-store-link)))))
+
((eq major-mode 'calendar-mode)
(let ((cd (calendar-cursor-to-date)))
(setq link
(org-store-link-props :type "calendar" :date cd)))
((eq major-mode 'w3-mode)
- (setq cpltxt (url-view-url t)
- link (org-make-link cpltxt))
+ (setq cpltxt (if (and (buffer-name)
+ (not (string-match "Untitled" (buffer-name))))
+ (buffer-name)
+ (url-view-url t))
+ link (org-make-link (url-view-url t)))
(org-store-link-props :type "w3" :url (url-view-url t)))
((eq major-mode 'w3m-mode)
link (org-make-link cpltxt)))
((and buffer-file-name (org-mode-p))
+ (setq custom-id (ignore-errors (org-entry-get nil "CUSTOM_ID")))
(cond
((org-in-regexp "<<\\(.*?\\)>>")
(setq cpltxt
(or (eq org-link-to-org-use-id t)
(and (eq org-link-to-org-use-id 'create-if-interactive)
(interactive-p))
+ (and (eq org-link-to-org-use-id 'create-if-interactive-and-no-custom-id)
+ (interactive-p)
+ (not custom-id))
(and org-link-to-org-use-id
(condition-case nil
(org-entry-get nil "ID")
(condition-case nil
(org-make-org-heading-search-string txt)
(error "")))
- desc "NONE")))
+ desc (or (nth 4 (ignore-errors
+ (org-heading-components))) "NONE"))))
(if (string-match "::\\'" cpltxt)
(setq cpltxt (substring cpltxt 0 -2)))
(setq link (org-make-link cpltxt)))))
desc (or desc cpltxt))
(if (equal desc "NONE") (setq desc nil))
- (if (and (interactive-p) link)
+ (if (and (or (interactive-p) executing-kbd-macro) link)
(progn
(setq org-stored-links
(cons (list link desc) org-stored-links))
- (message "Stored: %s" (or desc link)))
+ (message "Stored: %s" (or desc link))
+ (when custom-id
+ (setq link (concat "file:" (abbreviate-file-name (buffer-file-name))
+ "::#" custom-id))
+ (setq org-stored-links
+ (cons (list link desc) org-stored-links))))
(and link (org-make-link-string link desc)))))
(defun org-store-link-props (&rest plist)
"Make a link with brackets, consisting of LINK and DESCRIPTION."
(unless (string-match "\\S-" link)
(error "Empty link"))
+ (when (and description
+ (stringp description)
+ (not (string-match "\\S-" description)))
+ (setq description nil))
(when (stringp description)
;; Remove brackets from the description, they are fatal.
(while (string-match "\\[" description)
"Association list of escapes for some characters problematic in links.
This is the list that is used for internal purposes.")
+(defvar org-url-encoding-use-url-hexify nil)
+
(defconst org-link-escape-chars-browser
'((?\ . "%20")) ; 32 for the SPC char
"Association list of escapes for some characters problematic in links.
(defun org-link-escape (text &optional table)
"Escape characters in TEXT that are problematic for links."
- (setq table (or table org-link-escape-chars))
- (when text
- (let ((re (mapconcat (lambda (x) (regexp-quote
- (char-to-string (car x))))
- table "\\|")))
- (while (string-match re text)
- (setq text
- (replace-match
- (cdr (assoc (string-to-char (match-string 0 text))
- table))
+ (if org-url-encoding-use-url-hexify
+ (url-hexify-string text)
+ (setq table (or table org-link-escape-chars))
+ (when text
+ (let ((re (mapconcat (lambda (x) (regexp-quote
+ (char-to-string (car x))))
+ table "\\|")))
+ (while (string-match re text)
+ (setq text
+ (replace-match
+ (cdr (assoc (string-to-char (match-string 0 text))
+ table))
t t text)))
- text)))
+ text))))
(defun org-link-unescape (text &optional table)
"Reverse the action of `org-link-escape'."
- (setq table (or table org-link-escape-chars))
- (when text
- (let ((re (mapconcat (lambda (x) (regexp-quote (cdr x)))
- table "\\|")))
- (while (string-match re text)
- (setq text
- (replace-match
- (char-to-string (car (rassoc (match-string 0 text) table)))
- t t text)))
- text)))
+ (if org-url-encoding-use-url-hexify
+ (url-unhex-string text)
+ (setq table (or table org-link-escape-chars))
+ (when text
+ (let ((re (mapconcat (lambda (x) (regexp-quote (cdr x)))
+ table "\\|")))
+ (while (string-match re text)
+ (setq text
+ (replace-match
+ (char-to-string (car (rassoc (match-string 0 text) table)))
+ t t text)))
+ text))))
(defun org-xor (a b)
"Exclusive or."
(desc region)
tmphist ; byte-compile incorrectly complains about this
(link link-location)
- entry file)
+ entry file all-prefixes)
(cond
(link-location) ; specified by arg, just use it.
((org-in-regexp org-bracket-link-regexp 1)
(org-remove-angle-brackets (match-string 0)))))
((member complete-file '((4) (16)))
;; 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))))))
+ (setq link (org-file-complete-link complete-file)))
(t
;; Read link, with completion for stored links.
(with-output-to-temp-buffer "*Org Links*"
- (princ "Insert a link. Use TAB to complete valid link prefixes.\n")
+ (princ "Insert a link.
+Use TAB to complete link prefixes, then RET for type-specific completion support\n")
(when org-stored-links
(princ "\nStored links are available with <up>/<down> or M-p/n (most recent with RET):\n\n")
(princ (mapconcat
(let ((cw (selected-window)))
(select-window (get-buffer-window "*Org Links*"))
(setq truncate-lines t)
- (org-fit-window-to-buffer)
- (select-window cw))
+ (unless (pos-visible-in-window-p (point-max))
+ (org-fit-window-to-buffer))
+ (and (window-live-p cw) (select-window cw)))
;; Fake a link history, containing the stored links.
(setq tmphist (append (mapcar 'car org-stored-links)
org-insert-link-history))
+ (setq all-prefixes (append (mapcar 'car org-link-abbrev-alist-local)
+ (mapcar 'car org-link-abbrev-alist)
+ org-link-types))
(unwind-protect
- (setq link
- (let ((org-completion-use-ido nil))
- (org-completing-read
- "Link: "
- (append
- (mapcar (lambda (x) (list (concat (car x) ":")))
- (append org-link-abbrev-alist-local org-link-abbrev-alist))
- (mapcar (lambda (x) (list (concat x ":")))
- org-link-types))
- nil nil nil
- 'tmphist
- (or (car (car org-stored-links))))))
+ (progn
+ (setq link
+ (let ((org-completion-use-ido nil)
+ (org-completion-use-iswitchb nil))
+ (org-completing-read
+ "Link: "
+ (append
+ (mapcar (lambda (x) (list (concat x ":")))
+ all-prefixes)
+ (mapcar 'car org-stored-links))
+ nil nil nil
+ 'tmphist
+ (car (car org-stored-links)))))
+ (if (or (member link all-prefixes)
+ (and (equal ":" (substring link -1))
+ (member (substring link 0 -1) all-prefixes)
+ (setq link (substring link 0 -1))))
+ (setq link (org-link-try-special-completion link))))
(set-window-configuration wcf)
(kill-buffer "*Org Links*"))
(setq entry (assoc link org-stored-links))
(if remove (apply 'delete-region remove))
(insert (org-make-link-string link desc))))
+(defun org-link-try-special-completion (type)
+ "If there is completion support for link type TYPE, offer it."
+ (let ((fun (intern (concat "org-" type "-complete-link"))))
+ (if (functionp fun)
+ (funcall fun)
+ (read-string "Link (no completion support): " (concat type ":")))))
+
+(defun org-file-complete-link (&optional arg)
+ "Create a file link using completion."
+ (let (file link)
+ (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 arg '(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)))))
+ link))
+
(defun org-completing-read (&rest args)
"Completing-read with SPACE being a normal character."
(let ((minibuffer-local-completion-map
(copy-keymap minibuffer-local-completion-map)))
(org-defkey minibuffer-local-completion-map " " 'self-insert-command)
(org-defkey minibuffer-local-completion-map "?" 'self-insert-command)
- (apply 'org-ido-completing-read args)))
-
-(defun org-ido-completing-read (&rest args)
- "Completing-read using `ido-mode' speedups if available"
- (if (and org-completion-use-ido
- (fboundp 'ido-completing-read)
- (boundp 'ido-mode) ido-mode
- (listp (second args)))
- (apply 'ido-completing-read (concat (car args)) (cdr args))
- (apply 'completing-read args)))
+ (apply 'org-icompleting-read args)))
+
+(defun org-completing-read-no-i (&rest args)
+ (let (org-completion-use-ido org-completion-use-iswitchb)
+ (apply 'org-completing-read args)))
+
+(defun org-iswitchb-completing-read (prompt choices &rest args)
+ "Use iswitch as a completing-read replacement to choose from choices.
+PROMPT is a string to prompt with. CHOICES is a list of strings to choose
+from."
+ (let* ((iswitchb-use-virtual-buffers nil)
+ (iswitchb-make-buflist-hook
+ (lambda ()
+ (setq iswitchb-temp-buflist choices))))
+ (iswitchb-read-buffer prompt)))
+
+(defun org-icompleting-read (&rest args)
+ "Completing-read using `ido-mode' or `iswitchb' speedups if available."
+ (org-without-partial-completion
+ (if (and org-completion-use-ido
+ (fboundp 'ido-completing-read)
+ (boundp 'ido-mode) ido-mode
+ (listp (second args)))
+ (let ((ido-enter-matching-directory nil))
+ (apply 'ido-completing-read (concat (car args))
+ (if (consp (car (nth 1 args)))
+ (mapcar (lambda (x) (car x)) (nth 1 args))
+ (nth 1 args))
+ (cddr args)))
+ (if (and org-completion-use-iswitchb
+ (boundp 'iswitchb-mode) iswitchb-mode
+ (listp (second args)))
+ (apply 'org-iswitchb-completing-read (concat (car args))
+ (if (consp (car (nth 1 args)))
+ (mapcar (lambda (x) (car x)) (nth 1 args))
+ (nth 1 args))
+ (cddr args))
+ (apply 'completing-read args)))))
(defun org-extract-attributes (s)
"Extract the attributes cookie from a string and set as text property."
(org-add-props s nil 'org-attr attr))
s))
+(defun org-extract-attributes-from-string (tag)
+ (let (key value attr)
+ (while (string-match "\\([a-zA-Z]+\\)=\"\\([^\"]*\\)\"\\s-?" tag)
+ (setq key (match-string 1 tag) value (match-string 2 tag)
+ tag (replace-match "" t t tag)
+ attr (plist-put attr (intern key) value)))
+ (cons tag attr)))
+
(defun org-attributes-to-string (plist)
"Format a property list into an HTML attribute list."
(let ((s "") key value)
;; Planner has a slash, we do not.
(setq type "elisp" path (substring path 1)))
((string-match "^//\\(.?*\\)/\\(<.*>\\)$" path)
- ;; A typical message link. Planner has the id after the fina slash,
+ ;; A typical message link. Planner has the id after the final slash,
;; we separate it with a hash mark
(setq path (concat (match-string 1 path) "#"
(org-remove-angle-brackets (match-string 2 path)))))
(org-run-like-in-org-mode 'org-open-at-point))
;;;###autoload
-(defun org-open-link-from-string (s &optional arg)
+(defun org-open-link-from-string (s &optional arg reference-buffer)
"Open a link in the string S, as if it was in Org-mode."
(interactive "sLink: \nP")
- (with-temp-buffer
- (let ((org-inhibit-startup t))
- (org-mode)
- (insert s)
- (goto-char (point-min))
- (org-open-at-point arg))))
+ (let ((reference-buffer (or reference-buffer (current-buffer))))
+ (with-temp-buffer
+ (let ((org-inhibit-startup t))
+ (org-mode)
+ (insert s)
+ (goto-char (point-min))
+ (org-open-at-point arg reference-buffer)))))
-(defun org-open-at-point (&optional in-emacs)
+(defun org-open-at-point (&optional in-emacs reference-buffer)
"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.
+the end of the current line.
Normally, files will be opened by an appropriate application. If the
optional argument IN-EMACS is non-nil, Emacs will visit the file.
With a double prefix argument, try to open outside of Emacs, in the
(setq org-window-config-before-follow-link (current-window-configuration))
(org-remove-occur-highlights nil nil t)
(cond
+ ((and (org-on-heading-p)
+ (not (org-in-regexp
+ (concat org-plain-link-re "\\|"
+ org-bracket-link-regexp "\\|"
+ org-angle-link-re "\\|"
+ "[ \t]:[^ \t\n]+:[ \t]*$"))))
+ (or (org-offer-links-in-entry in-emacs)
+ (progn (require 'org-attach) (org-attach-reveal 'if-exists))))
((org-at-timestamp-p t) (org-follow-timestamp-link))
((or (org-footnote-at-reference-p) (org-footnote-at-definition-p))
(org-footnote-action))
- (t
+ (t
(let (type path link line search (pos (point)))
(catch 'match
(save-excursion
(org-in-regexp org-plain-link-re))
(setq type (match-string 1) path (match-string 2))
(throw 'match t)))
- (when (org-in-regexp "\\<\\([^><\n]+\\)\\>")
- (setq type "tree-match"
- path (match-string 1))
- (throw 'match t))
(save-excursion
(when (org-in-regexp (org-re "\\(:[[:alnum:]_@:]+\\):[ \t]*$"))
(setq type "tags"
path (match-string 1))
(while (string-match ":" path)
(setq path (replace-match "+" t t path)))
- (throw 'match t))))
+ (throw 'match t)))
+ (when (org-in-regexp "<\\([^><\n]+\\)>")
+ (setq type "tree-match"
+ path (match-string 1))
+ (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)))
- (if (and org-link-translation-function
- (fboundp org-link-translation-function))
- ;; Check if we need to translate the link
- (let ((tmp (funcall org-link-translation-function type path)))
- (setq type (car tmp) path (cdr tmp))))
- (cond
+ ;; switch back to reference buffer
+ ;; needed when if called in a temporary buffer through
+ ;; org-open-link-from-string
+ (with-current-buffer (or reference-buffer (current-buffer))
- ((assoc type org-link-protocols)
- (funcall (nth 1 (assoc type org-link-protocols)) path))
-
- ((equal type "mailto")
- (let ((cmd (car org-link-mailto-program))
- (args (cdr org-link-mailto-program)) args1
- (address path) (subject "") a)
- (if (string-match "\\(.*\\)::\\(.*\\)" path)
- (setq address (match-string 1 path)
- subject (org-link-escape (match-string 2 path))))
- (while args
- (cond
- ((not (stringp (car args))) (push (pop args) args1))
- (t (setq a (pop args))
- (if (string-match "%a" a)
- (setq a (replace-match address t t a)))
- (if (string-match "%s" a)
- (setq a (replace-match subject t t a)))
- (push a args1))))
- (apply cmd (nreverse args1))))
-
- ((member type '("http" "https" "ftp" "news"))
- (browse-url (concat type ":" (org-link-escape
- path org-link-escape-chars-browser))))
-
- ((member type '("message"))
- (browse-url (concat type ":" path)))
-
- ((string= type "tags")
- (org-tags-view in-emacs path))
- ((string= type "thisfile")
- (if in-emacs
- (switch-to-buffer-other-window
- (org-get-buffer-for-internal-link (current-buffer)))
- (org-mark-ring-push))
- (let ((cmd `(org-link-search
- ,path
- ,(cond ((equal in-emacs '(4)) 'occur)
- ((equal in-emacs '(16)) 'org-occur)
- (t nil))
- ,pos)))
- (condition-case nil (eval cmd)
- (error (progn (widen) (eval cmd))))))
-
- ((string= type "tree-match")
- (org-occur (concat "\\[" (regexp-quote path) "\\]")))
-
- ((string= type "file")
- (if (string-match "::\\([0-9]+\\)\\'" path)
- (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)))))
- (if (string-match "[*?{]" (file-name-nondirectory path))
- (dired path)
- (org-open-file path in-emacs line search)))
-
- ((string= type "news")
- (require 'org-gnus)
- (org-gnus-follow-link path))
-
- ((string= type "shell")
- (let ((cmd path))
- (if (or (not org-confirm-shell-link-function)
- (funcall org-confirm-shell-link-function
- (format "Execute \"%s\" in shell? "
- (org-add-props cmd nil
- 'face 'org-warning))))
- (progn
- (message "Executing %s" cmd)
- (shell-command cmd))
- (error "Abort"))))
-
- ((string= type "elisp")
- (let ((cmd path))
- (if (or (not org-confirm-elisp-link-function)
- (funcall org-confirm-elisp-link-function
- (format "Execute \"%s\" as elisp? "
- (org-add-props cmd nil
- 'face 'org-warning))))
- (message "%s => %s" cmd
- (if (equal (string-to-char cmd) ?\()
- (eval (read cmd))
- (call-interactively (read cmd))))
- (error "Abort"))))
+ ;; Remove any trailing spaces in path
+ (if (string-match " +\\'" path)
+ (setq path (replace-match "" t t path)))
+ (if (and org-link-translation-function
+ (fboundp org-link-translation-function))
+ ;; Check if we need to translate the link
+ (let ((tmp (funcall org-link-translation-function type path)))
+ (setq type (car tmp) path (cdr tmp))))
- (t
- (browse-url-at-point))))))
+ (cond
+
+ ((assoc type org-link-protocols)
+ (funcall (nth 1 (assoc type org-link-protocols)) path))
+
+ ((equal type "mailto")
+ (let ((cmd (car org-link-mailto-program))
+ (args (cdr org-link-mailto-program)) args1
+ (address path) (subject "") a)
+ (if (string-match "\\(.*\\)::\\(.*\\)" path)
+ (setq address (match-string 1 path)
+ subject (org-link-escape (match-string 2 path))))
+ (while args
+ (cond
+ ((not (stringp (car args))) (push (pop args) args1))
+ (t (setq a (pop args))
+ (if (string-match "%a" a)
+ (setq a (replace-match address t t a)))
+ (if (string-match "%s" a)
+ (setq a (replace-match subject t t a)))
+ (push a args1))))
+ (apply cmd (nreverse args1))))
+
+ ((member type '("http" "https" "ftp" "news"))
+ (browse-url (concat type ":" (org-link-escape
+ path org-link-escape-chars-browser))))
+
+ ((member type '("message"))
+ (browse-url (concat type ":" path)))
+
+ ((string= type "tags")
+ (org-tags-view in-emacs path))
+ ((string= type "thisfile")
+ (if in-emacs
+ (switch-to-buffer-other-window
+ (org-get-buffer-for-internal-link (current-buffer)))
+ (org-mark-ring-push))
+ (let ((cmd `(org-link-search
+ ,path
+ ,(cond ((equal in-emacs '(4)) 'occur)
+ ((equal in-emacs '(16)) 'org-occur)
+ (t nil))
+ ,pos)))
+ (condition-case nil (eval cmd)
+ (error (progn (widen) (eval cmd))))))
+
+ ((string= type "tree-match")
+ (org-occur (concat "\\[" (regexp-quote path) "\\]")))
+
+ ((string= type "file")
+ (if (string-match "::\\([0-9]+\\)\\'" path)
+ (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)))))
+ (if (string-match "[*?{]" (file-name-nondirectory path))
+ (dired path)
+ (org-open-file path in-emacs line search)))
+
+ ((string= type "news")
+ (require 'org-gnus)
+ (org-gnus-follow-link path))
+
+ ((string= type "shell")
+ (let ((cmd path))
+ (if (or (not org-confirm-shell-link-function)
+ (funcall org-confirm-shell-link-function
+ (format "Execute \"%s\" in shell? "
+ (org-add-props cmd nil
+ 'face 'org-warning))))
+ (progn
+ (message "Executing %s" cmd)
+ (shell-command cmd))
+ (error "Abort"))))
+
+ ((string= type "elisp")
+ (let ((cmd path))
+ (if (or (not org-confirm-elisp-link-function)
+ (funcall org-confirm-elisp-link-function
+ (format "Execute \"%s\" as elisp? "
+ (org-add-props cmd nil
+ 'face 'org-warning))))
+ (message "%s => %s" cmd
+ (if (equal (string-to-char cmd) ?\()
+ (eval (read cmd))
+ (call-interactively (read cmd))))
+ (error "Abort"))))
+
+ (t
+ (browse-url-at-point)))))))
(move-marker org-open-link-marker nil)
(run-hook-with-args 'org-follow-link-hook))
+(defun org-offer-links-in-entry (&optional nth zero)
+ "Offer links in the current entry and follow the selected link.
+If there is only one link, follow it immediately as well.
+If NTH is an integer, immediately pick the NTH link found.
+If ZERO is a string, check also this string for a link, and if
+there is one, offer it as link number zero."
+ (let ((re (concat "\\(" org-bracket-link-regexp "\\)\\|"
+ "\\(" org-angle-link-re "\\)\\|"
+ "\\(" org-plain-link-re "\\)"))
+ (cnt ?0)
+ (in-emacs (if (integerp nth) nil nth))
+ have-zero end links link c)
+ (when (and (stringp zero) (string-match org-bracket-link-regexp zero))
+ (push (match-string 0 zero) links)
+ (setq cnt (1- cnt) have-zero t))
+ (save-excursion
+ (org-back-to-heading t)
+ (setq end (save-excursion (outline-next-heading) (point)))
+ (while (re-search-forward re end t)
+ (push (match-string 0) links))
+ (setq links (org-uniquify (reverse links))))
+
+ (cond
+ ((null links)
+ (message "No links"))
+ ((equal (length links) 1)
+ (setq link (car links)))
+ ((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth)))
+ (setq link (nth (if have-zero nth (1- nth)) links)))
+ (t ; we have to select a link
+ (save-excursion
+ (save-window-excursion
+ (delete-other-windows)
+ (with-output-to-temp-buffer "*Select Link*"
+ (mapc (lambda (l)
+ (if (not (string-match org-bracket-link-regexp l))
+ (princ (format "[%c] %s\n" (incf cnt)
+ (org-remove-angle-brackets l)))
+ (if (match-end 3)
+ (princ (format "[%c] %s (%s)\n" (incf cnt)
+ (match-string 3 l) (match-string 1 l)))
+ (princ (format "[%c] %s\n" (incf cnt)
+ (match-string 1 l))))))
+ links))
+ (org-fit-window-to-buffer (get-buffer-window "*Select Link*"))
+ (message "Select link to open:")
+ (setq c (read-char-exclusive))
+ (and (get-buffer "*Select Link*") (kill-buffer "*Select Link*"))))
+ (when (equal c ?q) (error "Abort"))
+ (setq nth (- c ?0))
+ (if have-zero (setq nth (1+ nth)))
+ (unless (and (integerp nth) (>= (length links) nth))
+ (error "Invalid link selection"))
+ (setq link (nth (1- nth) links))))
+ (if link
+ (progn (org-open-link-from-string link in-emacs (current-buffer)) t)
+ nil)))
+
;;;; Time estimates
(defun org-get-effort (&optional pom)
;; First check if there are any special
((run-hook-with-args-until-success 'org-execute-file-search-functions s))
;; Now try the builtin stuff
+ ((and (equal (string-to-char s0) ?#)
+ (> (length s0) 1)
+ (save-excursion
+ (goto-char (point-min))
+ (and
+ (re-search-forward
+ (concat "^[ \t]*:CUSTOM_ID:[ \t]+" (regexp-quote (substring s0 1)) "[ \t]*$") nil t)
+ (setq type 'dedicated
+ pos (match-beginning 0))))
+ ;; There is an exact target for this
+ (goto-char pos)
+ (org-back-to-heading t)))
((save-excursion
(goto-char (point-min))
(and
(eq cmd 'emacs))
(funcall (cdr (assq 'file org-link-frame-setup)) file)
(widen)
- (if line (goto-line line)
+ (if line (org-goto-line line)
(if search (org-link-search search))))
((consp cmd)
(let ((file (convert-standard-filename file)))
(defun org-get-refile-targets (&optional default-buffer)
"Produce a table with refile targets."
- (let ((entries (or org-refile-targets '((nil . (:level . 1)))))
- targets txt re files f desc descre fast-path-p level)
+ (let ((case-fold-search nil)
+ ;; otherwise org confuses "TODO" as a kw and "Todo" as a word
+ (entries (or org-refile-targets '((nil . (:level . 1)))))
+ targets txt re files f desc descre fast-path-p level pos0)
(message "Getting targets...")
(with-current-buffer (or default-buffer (current-buffer))
(while (setq entry (pop entries))
"\\}[ \t]")))
(t (error "Bad refiling target description %s" desc)))
(while (setq f (pop files))
- (save-excursion
- (set-buffer (if (bufferp f) f (org-get-agenda-file-buffer f)))
+ (with-current-buffer
+ (if (bufferp f) f (org-get-agenda-file-buffer f))
(if (bufferp f) (setq f (buffer-file-name (buffer-base-buffer f))))
(setq f (expand-file-name f))
+ (if (eq org-refile-use-outline-path 'file)
+ (push (list (file-name-nondirectory f) f nil nil) targets))
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(while (re-search-forward descre nil t)
- (goto-char (point-at-bol))
- (when (looking-at org-complex-heading-regexp)
- (setq level (org-reduced-level (- (match-end 1) (match-beginning 1)))
- txt (org-link-display-format (match-string 4))
- re (concat "^" (regexp-quote
- (buffer-substring (match-beginning 1)
- (match-end 4)))))
- (if (match-end 5) (setq re (concat re "[ \t]+"
- (regexp-quote
- (match-string 5)))))
- (setq re (concat re "[ \t]*$"))
- (when org-refile-use-outline-path
- (setq txt (mapconcat 'org-protect-slash
- (append
- (if (eq org-refile-use-outline-path 'file)
- (list (file-name-nondirectory
- (buffer-file-name (buffer-base-buffer))))
- (if (eq org-refile-use-outline-path 'full-file-path)
- (list (buffer-file-name (buffer-base-buffer)))))
- (org-get-outline-path fast-path-p level txt)
- (list txt))
- "/")))
- (push (list txt f re (point)) targets))
- (goto-char (point-at-eol))))))))
+ (goto-char (setq pos0 (point-at-bol)))
+ (catch 'next
+ (when org-refile-target-verify-function
+ (save-match-data
+ (or (funcall org-refile-target-verify-function)
+ (throw 'next t))))
+ (when (looking-at org-complex-heading-regexp)
+ (setq level (org-reduced-level (- (match-end 1) (match-beginning 1)))
+ txt (org-link-display-format (match-string 4))
+ re (concat "^" (regexp-quote
+ (buffer-substring (match-beginning 1)
+ (match-end 4)))))
+ (if (match-end 5) (setq re (concat re "[ \t]+"
+ (regexp-quote
+ (match-string 5)))))
+ (setq re (concat re "[ \t]*$"))
+ (when org-refile-use-outline-path
+ (setq txt (mapconcat 'org-protect-slash
+ (append
+ (if (eq org-refile-use-outline-path 'file)
+ (list (file-name-nondirectory
+ (buffer-file-name (buffer-base-buffer))))
+ (if (eq org-refile-use-outline-path 'full-file-path)
+ (list (buffer-file-name (buffer-base-buffer)))))
+ (org-get-outline-path fast-path-p level txt)
+ (list txt))
+ "/")))
+ (push (list txt f re (point)) targets)))
+ (when (= (point) pos0)
+ ;; verification function has not moved point
+ (goto-char (point-at-eol))))))))))
(message "Getting targets...done")
- (nreverse targets))))
+ (nreverse targets)))
(defun org-protect-slash (s)
(while (string-match "/" s)
(defvar org-olpa (make-vector 20 nil))
(defun org-get-outline-path (&optional fastp level heading)
- "Return the outline path to the current entry, as a list."
+ "Return the outline path to the current entry, as a list.
+The parameters FASTP, LEVEL, and HEADING are for use be a scanner
+routine which makes outline path derivations for an entire file,
+avoiding backtracing."
(if fastp
(progn
(if (> level 19)
- (error "Outline path failure, more than 19 levels."))
+ (error "Outline path failure, more than 19 levels"))
(loop for i from level upto 19 do
(aset org-olpa i nil))
(prog1
(aset org-olpa level heading)))
(let (rtn)
(save-excursion
- (while (org-up-heading-safe)
- (when (looking-at org-complex-heading-regexp)
- (push (org-match-string-no-properties 4) rtn)))
- rtn))))
+ (save-restriction
+ (widen)
+ (while (org-up-heading-safe)
+ (when (looking-at org-complex-heading-regexp)
+ (push (org-match-string-no-properties 4) rtn)))
+ rtn)))))
+
+(defun org-format-outline-path (path &optional width prefix)
+ "Format the outlie path PATH for display.
+Width is the maximum number of characters that is available.
+Prefix is a prefix to be included in the returned string,
+such as the file name."
+ (setq width (or width 79))
+ (if prefix (setq width (- width (length prefix))))
+ (if (not path)
+ (or prefix "")
+ (let* ((nsteps (length path))
+ (total-width (+ nsteps (apply '+ (mapcar 'length path))))
+ (maxwidth (if (<= total-width width)
+ 10000 ;; everything fits
+ ;; we need to shorten the level headings
+ (/ (- width nsteps) nsteps)))
+ (org-odd-levels-only nil)
+ (n 0)
+ (total (1+ (length prefix))))
+ (setq maxwidth (max maxwidth 10))
+ (concat prefix
+ (mapconcat
+ (lambda (h)
+ (setq n (1+ n))
+ (if (and (= n nsteps) (< maxwidth 10000))
+ (setq maxwidth (- total-width total)))
+ (if (< (length h) maxwidth)
+ (progn (setq total (+ total (length h) 1)) h)
+ (setq h (substring h 0 (- maxwidth 2))
+ total (+ total maxwidth 1))
+ (if (string-match "[ \t]+\\'" h)
+ (setq h (substring h 0 (match-beginning 0))))
+ (setq h (concat h "..")))
+ (org-add-props h nil 'face
+ (nth (% (1- n) org-n-level-faces)
+ org-level-faces))
+ h)
+ path "/")))))
+
+(defun org-display-outline-path (&optional file current)
+ "Display the current outline path in the echo area."
+ (interactive "P")
+ (let ((bfn (buffer-file-name (buffer-base-buffer)))
+ (path (and (org-mode-p) (org-get-outline-path))))
+ (if current (setq path (append path
+ (save-excursion
+ (org-back-to-heading t)
+ (if (looking-at org-complex-heading-regexp)
+ (list (match-string 4)))))))
+ (message "%s"
+ (org-format-outline-path
+ path
+ (1- (frame-width))
+ (and file bfn (concat (file-name-nondirectory bfn) "/"))))))
(defvar org-refile-history nil
"History for refiling operations.")
-(defun org-refile (&optional goto default-buffer)
+(defvar org-after-refile-insert-hook nil
+ "Hook run after `org-refile' has inserted its stuff at the new location.
+Note that this is still *before* the stuff will be removed from
+the *old* location.")
+
+(defun org-refile (&optional goto default-buffer rfloc)
"Move the entry at point to another heading.
The list of target headings is compiled using the information in
`org-refile-targets', which see. This list is created before each use
With prefix arg GOTO, the command will only visit the target location,
not actually move anything.
With a double prefix `C-u C-u', go to the location where the last refiling
-operation has put the subtree."
+operation has put the subtree.
+With a prefix argument of `2', refile to the running clock.
+
+RFLOC can be a refile location obtained in a different way.
+
+See also `org-refile-use-outline-path' and `org-completion-use-ido'"
(interactive "P")
(let* ((cbuf (current-buffer))
(regionp (org-region-active-p))
(region-length (and regionp (- region-end region-start)))
(filename (buffer-file-name (buffer-base-buffer cbuf)))
pos it nbuf file re level reversed)
- (when regionp (goto-char region-start)
- (unless (org-kill-is-subtree-p
- (buffer-substring region-start region-end))
- (error "The region is not a (sequence of) subtree(s)")))
+ (setq last-command nil)
+ (when regionp
+ (goto-char region-start)
+ (or (bolp) (goto-char (point-at-bol)))
+ (setq region-start (point))
+ (unless (org-kill-is-subtree-p
+ (buffer-substring region-start region-end))
+ (error "The region is not a (sequence of) subtree(s)")))
(if (equal goto '(16))
(org-refile-goto-last-stored)
- (when (setq it (org-refile-get-location
- (if goto "Goto: " "Refile to: ") default-buffer))
+ (when (or
+ (and (equal goto 2)
+ org-clock-hd-marker (marker-buffer org-clock-hd-marker)
+ (prog1
+ (setq it (list (or org-clock-heading "running clock")
+ (buffer-file-name
+ (marker-buffer org-clock-hd-marker))
+ ""
+ (marker-position org-clock-hd-marker)))
+ (setq goto nil)))
+ (setq it (or rfloc
+ (save-excursion
+ (org-refile-get-location
+ (if goto "Goto: " "Refile to: ") default-buffer
+ org-refile-allow-creating-parent-nodes)))))
(setq file (nth 1 it)
re (nth 2 it)
pos (nth 3 it))
- (if (and (equal (buffer-file-name) file)
+ (if (and (not goto)
+ pos
+ (equal (buffer-file-name) file)
(if regionp
(and (>= pos region-start)
(<= pos region-end))
(< pos (save-excursion
(org-end-of-subtree t t))))))
(error "Cannot refile to position inside the tree or region"))
-
+
(setq nbuf (or (find-buffer-visiting file)
(find-file-noselect file)))
(if goto
(org-show-context 'org-goto))
(if regionp
(progn
- (kill-new (buffer-substring region-start region-end))
+ (org-kill-new (buffer-substring region-start region-end))
(org-save-markers-in-region region-start region-end))
(org-copy-subtree 1 nil t))
- (save-excursion
- (set-buffer (setq nbuf (or (find-buffer-visiting file)
- (find-file-noselect file))))
+ (with-current-buffer (setq nbuf (or (find-buffer-visiting file)
+ (find-file-noselect file)))
(setq reversed (org-notes-order-reversed-p))
(save-excursion
(save-restriction
(widen)
- (goto-char pos)
- (looking-at outline-regexp)
- (setq level (org-get-valid-level (funcall outline-level) 1))
- (goto-char
- (if reversed
- (or (outline-next-heading) (point-max))
- (or (save-excursion (outline-get-next-sibling))
- (org-end-of-subtree t t)
- (point-max))))
+ (if pos
+ (progn
+ (goto-char pos)
+ (looking-at outline-regexp)
+ (setq level (org-get-valid-level (funcall outline-level) 1))
+ (goto-char
+ (if reversed
+ (or (outline-next-heading) (point-max))
+ (or (save-excursion (org-get-next-sibling))
+ (org-end-of-subtree t t)
+ (point-max)))))
+ (setq level 1)
+ (if (not reversed)
+ (goto-char (point-max))
+ (goto-char (point-min))
+ (or (outline-next-heading) (goto-char (point-max)))))
(if (not (bolp)) (newline))
(bookmark-set "org-refile-last-stored")
- (org-paste-subtree level))))
+ (org-paste-subtree level)
+ (if (fboundp 'deactivate-mark) (deactivate-mark))
+ (run-hooks 'org-after-refile-insert-hook))))
(if regionp
(delete-region (point) (+ (point) region-length))
(org-cut-subtree))
+ (when (featurep 'org-inlinetask)
+ (org-inlinetask-remove-END-maybe))
(setq org-markers-to-move nil)
- (message "Refiled to \"%s\"" (car it)))))))
+ (message "Refiled to \"%s\"" (car it))))))
+ (org-reveal))
(defun org-refile-goto-last-stored ()
"Go to the location where the last refile was stored."
(bookmark-jump "org-refile-last-stored")
(message "This is the location of the last refile"))
-(defun org-refile-get-location (&optional prompt default-buffer)
+(defun org-refile-get-location (&optional prompt default-buffer new-nodes)
"Prompt the user for a refile location, using PROMPT."
(let ((org-refile-targets org-refile-targets)
(org-refile-use-outline-path org-refile-use-outline-path))
(unless org-refile-target-table
(error "No refile targets"))
(let* ((cbuf (current-buffer))
+ (partial-completion-mode nil)
(cfn (buffer-file-name (buffer-base-buffer cbuf)))
(cfunc (if (and org-refile-use-outline-path
org-outline-path-complete-in-steps)
'org-olpath-completing-read
- 'org-ido-completing-read))
+ 'org-icompleting-read))
(extra (if org-refile-use-outline-path "/" ""))
(filename (and cfn (expand-file-name cfn)))
(tbl (mapcar
(lambda (x)
- (if (not (equal filename (nth 1 x)))
+ (if (and (not (member org-refile-use-outline-path
+ '(file full-file-path)))
+ (not (equal filename (nth 1 x))))
(cons (concat (car x) extra " ("
(file-name-nondirectory (nth 1 x)) ")")
(cdr x))
(cons (concat (car x) extra) (cdr x))))
org-refile-target-table))
- (completion-ignore-case t))
- (assoc (funcall cfunc prompt tbl nil t nil 'org-refile-history)
- tbl)))
+ (completion-ignore-case t)
+ pa answ parent-target child parent old-hist)
+ (setq old-hist org-refile-history)
+ (setq answ (funcall cfunc prompt tbl nil (not new-nodes)
+ nil 'org-refile-history))
+ (setq pa (or (assoc answ tbl) (assoc (concat answ "/") tbl)))
+ (if pa
+ (progn
+ (when (or (not org-refile-history)
+ (not (eq old-hist org-refile-history))
+ (not (equal (car pa) (car org-refile-history))))
+ (setq org-refile-history
+ (cons (car pa) (if (assoc (car org-refile-history) tbl)
+ org-refile-history
+ (cdr org-refile-history))))
+ (if (equal (car org-refile-history) (nth 1 org-refile-history))
+ (pop org-refile-history)))
+ pa)
+ (when (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ)
+ (setq parent (match-string 1 answ)
+ child (match-string 2 answ))
+ (setq parent-target (or (assoc parent tbl) (assoc (concat parent "/") tbl)))
+ (when (and parent-target
+ (or (eq new-nodes t)
+ (and (eq new-nodes 'confirm)
+ (y-or-n-p (format "Create new node \"%s\"? " child)))))
+ (org-refile-new-child parent-target child))))))
+
+(defun org-refile-new-child (parent-target child)
+ "Use refile target PARENT-TARGET to add new CHILD below it."
+ (unless parent-target
+ (error "Cannot find parent for new node"))
+ (let ((file (nth 1 parent-target))
+ (pos (nth 3 parent-target))
+ level)
+ (with-current-buffer (or (find-buffer-visiting file)
+ (find-file-noselect file))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (if pos
+ (goto-char pos)
+ (goto-char (point-max))
+ (if (not (bolp)) (newline)))
+ (when (looking-at outline-regexp)
+ (setq level (funcall outline-level))
+ (org-end-of-subtree t t))
+ (org-back-over-empty-lines)
+ (insert "\n" (make-string
+ (if pos (org-get-valid-level level 1) 1) ?*)
+ " " child "\n")
+ (beginning-of-line 0)
+ (list (concat (car parent-target) "/" child) file "" (point)))))))
(defun org-olpath-completing-read (prompt collection &rest args)
"Read an outline path like a file name."
- (let ((thetable collection))
+ (let ((thetable collection)
+ (org-completion-use-ido nil) ; does not work with ido.
+ (org-completion-use-iswitchb nil)) ; or iswitchb
(apply
- 'org-ido-completing-read prompt
+ 'org-icompleting-read prompt
(lambda (string predicate &optional flag)
(let (rtn r f (l (length string)))
(cond
pos))
(defconst org-dblock-start-re
- "^#\\+BEGIN:[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?"
- "Matches the startline of a dynamic block, with parameters.")
+ "^[ \t]*#\\+BEGIN:[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?"
+ "Matches the start line of a dynamic block, with parameters.")
-(defconst org-dblock-end-re "^#\\+END\\([: \t\r\n]\\|$\\)"
+(defconst org-dblock-end-re "^[ \t]*#\\+END\\([: \t\r\n]\\|$\\)"
"Matches the end of a dynamic block.")
(defun org-create-dblock (plist)
"Create a dynamic block section, with parameters taken from PLIST.
PLIST must contain a :name entry which is used as name of the block."
- (unless (bolp) (newline))
- (let ((name (plist-get plist :name)))
+ (when (string-match "\\S-" (buffer-substring (point-at-bol) (point-at-eol)))
+ (end-of-line 1)
+ (newline))
+ (let ((col (current-column))
+ (name (plist-get plist :name)))
(insert "#+BEGIN: " name)
(while plist
(if (eq (car plist) :name)
(setq plist (cddr plist))
(insert " " (prin1-to-string (pop plist)))))
- (insert "\n\n#+END:\n")
+ (insert "\n\n" (make-string col ?\ ) "#+END:\n")
(beginning-of-line -2)))
(defun org-prepare-dblock ()
(name (org-no-properties (match-string 1)))
(params (append (list :name name)
(read (concat "(" (match-string 3) ")")))))
+ (save-excursion
+ (beginning-of-line 1)
+ (skip-chars-forward " \t")
+ (setq params (plist-put params :indentation-column (current-column))))
(unless (re-search-forward org-dblock-end-re nil t)
(error "Dynamic block not terminated"))
(setq params
(line (org-current-line))
(params (org-prepare-dblock))
(name (plist-get params :name))
+ (indent (plist-get params :indentation-column))
(cmd (intern (concat "org-dblock-write:" name))))
(message "Updating dynamic block `%s' at line %d..." name line)
(funcall cmd params)
(message "Updating dynamic block `%s' at line %d...done" name line)
- (goto-char pos))))
+ (goto-char pos)
+ (when (and indent (> indent 0))
+ (setq indent (make-string indent ?\ ))
+ (save-excursion
+ (org-beginning-of-dblock)
+ (forward-line 1)
+ (while (not (looking-at org-dblock-end-re))
+ (insert indent)
+ (beginning-of-line 2))
+ (when (looking-at org-dblock-end-re)
+ (and (looking-at "[ \t]+")
+ (replace-match ""))
+ (insert indent)))))))
(defun org-beginning-of-dblock ()
"Find the beginning of the dynamic block at point.
;;;; Completion
(defconst org-additional-option-like-keywords
- '("BEGIN_HTML" "BEGIN_LaTeX" "END_HTML" "END_LaTeX"
- "ORGTBL" "HTML:" "LaTeX:" "BEGIN:" "END:" "TBLFM"
+ '("BEGIN_HTML" "END_HTML" "HTML:" "ATTR_HTML"
+ "BEGIN_DocBook" "END_DocBook" "DocBook:" "ATTR_DocBook"
+ "BEGIN_LaTeX" "END_LaTeX" "LaTeX:" "LATEX_HEADER:" "LATEX_CLASS:" "ATTR_LaTeX"
+ "BEGIN:" "END:"
+ "ORGTBL" "TBLFM:" "TBLNAME:"
"BEGIN_EXAMPLE" "END_EXAMPLE"
"BEGIN_QUOTE" "END_QUOTE"
"BEGIN_VERSE" "END_VERSE"
+ "BEGIN_CENTER" "END_CENTER"
"BEGIN_SRC" "END_SRC"
- "CAPTION" "LABEL" "ATTR_HTML" "ATTR_LaTeX"))
+ "CATEGORY" "COLUMNS"
+ "CAPTION" "LABEL"
+ "SETUPFILE"
+ "BIND"
+ "MACRO"))
(defcustom org-structure-template-alist
'(
"<quote>\n?\n</quote>")
("v" "#+begin_verse\n?\n#+end_verse"
"<verse>\n?\n/verse>")
+ ("c" "#+begin_center\n?\n#+end_center"
+ "<center>\n?\n/center>")
("l" "#+begin_latex\n?\n#+end_latex"
"<literal style=\"latex\">\n?\n</literal>")
("L" "#+latex: "
(defun org-complete-expand-structure-template (start cell)
"Expand a structure template."
(let* ((musep (org-bound-and-true-p org-mtags-prefer-muse-templates))
- (rpl (nth (if musep 2 1) cell)))
+ (rpl (nth (if musep 2 1) cell))
+ (ind ""))
(delete-region start (point))
(when (string-match "\\`#\\+" rpl)
(cond
((bolp))
((not (string-match "\\S-" (buffer-substring (point-at-bol) (point))))
- (delete-region (point-at-bol) (point)))
+ (setq ind (buffer-substring (point-at-bol) (point))))
(t (newline))))
(setq start (point))
(if (string-match "%file" rpl)
(abbreviate-file-name (read-file-name "Include file: ")))
"\"")
t t rpl)))
+ (setq rpl (mapconcat 'identity (split-string rpl "\n")
+ (concat "\n" ind)))
(insert rpl)
(if (re-search-backward "\\?" start t) (delete-char 1))))
(setq type :opt)
(require 'org-exp)
(append
- (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"))
+ (delq nil
+ (mapcar
+ (lambda (x)
+ (if (string-match
+ "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x)
+ (cons (match-string 2 x)
+ (match-string 1 x))))
+ (org-split-string (org-get-current-options) "\n")))
(mapcar 'list org-additional-option-like-keywords)))
(startup
(setq type :startup)
(push (nth 2 e) rtn)))
rtn)))))
+(defvar org-todo-setup-filter-hook nil
+ "Hook for functions that pre-filter todo specs.
+
+Each function takes a todo spec and returns either `nil' or the spec
+transformed into canonical form." )
+
+(defvar org-todo-get-default-hook nil
+ "Hook for functions that get a default item for todo.
+
+Each function takes arguments (NEW-MARK OLD-MARK) and returns either
+`nil' or a string to be used for the todo mark." )
+
(defvar org-agenda-headline-snapshot-before-repeat)
+
(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,
With C-u prefix arg, use completion to determine the new state.
With numeric prefix arg, switch to that state.
With a double C-u prefix, switch to the next set of TODO keywords (nextset).
-With a tripple C-u prefix, circumvent any state blocking.
+With a triple C-u prefix, circumvent any state blocking.
For calling through lisp, arg is also interpreted in the following way:
'none -> empty state
really is a member of `org-todo-keywords'."
(interactive "P")
(if (equal arg '(16)) (setq arg 'nextset))
- (let ((org-blocker-hook org-blocker-hook))
+ (let ((org-blocker-hook org-blocker-hook)
+ (case-fold-search nil))
(when (equal arg '(64))
(setq arg nil org-blocker-hook nil))
+ (when (and org-blocker-hook
+ (or org-inhibit-blocking
+ (org-entry-get nil "NOBLOCKING")))
+ (setq org-blocker-hook nil))
(save-excursion
(catch 'exit
- (org-back-to-heading)
+ (org-back-to-heading t)
(if (looking-at outline-regexp) (goto-char (1- (match-end 0))))
- (or (looking-at (concat " +" org-todo-regexp " *"))
+ (or (looking-at (concat " +" org-todo-regexp "\\( +\\|$\\)"))
(looking-at " *"))
(let* ((match-data (match-data))
(startpos (point-at-bol))
(or (not org-use-fast-todo-selection)
(not org-todo-key-trigger)))
;; Read a state with completion
- (org-ido-completing-read
+ (org-icompleting-read
"State: " (mapcar (lambda(x) (list x))
org-todo-keywords-1)
nil t))
(or (car (cdr (member head org-todo-heads)))
(car org-todo-heads))))
((car (member arg org-todo-keywords-1)))
+ ((stringp arg)
+ (error "State `%s' not valid in this file" arg))
((nth (1- (prefix-numeric-value arg))
org-todo-keywords-1))))
((null member) (or head (car org-todo-keywords-1)))
((equal this final-done-word) nil) ;; -> make empty
((null tail) nil) ;; -> first entry
- ((eq interpret 'sequence)
- (car tail))
((memq interpret '(type priority))
(if (eq this-command last-command)
(car tail)
(if (> (length tail) 0)
(or done-word (car org-done-keywords))
nil)))
- (t nil)))
+ (t
+ (car tail))))
+ (state (or
+ (run-hook-with-args-until-success
+ 'org-todo-get-default-hook state last-state)
+ state))
(next (if state (concat " " state " ") " "))
(change-plist (list :type 'todo-state-change :from this :to state
:position startpos))
(not (member this org-done-keywords))))
(and logging (org-local-logging logging))
(when (and (or org-todo-log-states org-log-done)
+ (not (eq org-inhibit-logging t))
(not (memq arg '(nextset previousset))))
;; we need to look at recording a time and note
(setq dolog (or (nth 1 (assoc state org-todo-log-states))
(nth 2 (assoc this org-todo-log-states))))
+ (if (and (eq dolog 'note) (eq org-inhibit-logging 'note))
+ (setq dolog 'time))
(when (and state
(member state org-not-done-keywords)
(not (member this org-not-done-keywords)))
;; It is now done, and it was not done before
(org-add-planning-info 'closed (org-current-time))
(if (and (not dolog) (eq 'note org-log-done))
- (org-add-log-setup 'done state 'findpos 'note)))
+ (org-add-log-setup 'done state this 'findpos 'note)))
(when (and state dolog)
;; This is a non-nil state, and we need to log it
- (org-add-log-setup 'state state 'findpos dolog)))
+ (org-add-log-setup 'state state this 'findpos dolog)))
;; Fixup tag positioning
(org-todo-trigger-tag-changes state)
(and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t))
(< (point) (+ 2 (or (match-end 2) (match-end 1)))))
(progn
(goto-char (or (match-end 2) (match-end 1)))
- (just-one-space)))
+ (and (looking-at " ") (just-one-space))))
(when org-trigger-hook
(save-excursion
(run-hook-with-args 'org-trigger-hook change-plist))))))))
-(defun org-block-todo-from-children-or-siblings (change-plist)
+(defun org-block-todo-from-children-or-siblings-or-parent (change-plist)
"Block turning an entry into a TODO, using the hierarchy.
This checks whether the current task should be blocked from state
changes. Such blocking occurs when:
2. A task has a parent with the property :ORDERED:, and there
are siblings prior to the current task with incomplete
- status."
+ status.
+
+ 3. The parent of the task is blocked because it has siblings that should
+ be done first, or is child of a block grandparent TODO entry."
+
(catch 'dont-block
;; If this is not a todo state change, or if this entry is already DONE,
;; do not block
(member (plist-get change-plist :from)
(cons 'done org-done-keywords))
(member (plist-get change-plist :to)
- (cons 'todo org-not-done-keywords)))
+ (cons 'todo org-not-done-keywords))
+ (not (plist-get change-plist :to)))
(throw 'dont-block t))
;; If this task has children, and any are undone, it's blocked
(save-excursion
;; any previous siblings are undone, it's blocked
(save-excursion
(org-back-to-heading t)
- (when (save-excursion
- (ignore-errors
- (outline-up-heading 1)
- (org-entry-get (point) "ORDERED")))
- (let* ((this-level (funcall outline-level))
- (current-level this-level))
- (while (and (not (bobp))
- (= current-level this-level))
- (outline-previous-heading)
- (setq current-level (funcall outline-level))
- (if (= current-level this-level)
- ;; this todo has children, check whether they are all
- ;; completed
- (if (and (not (org-entry-is-done-p))
- (org-entry-is-todo-p))
- (throw 'dont-block nil)))))))
- t)) ; don't block
+ (let* ((pos (point))
+ (parent-pos (and (org-up-heading-safe) (point))))
+ (if (not parent-pos) (throw 'dont-block t)) ; no parent
+ (when (and (org-entry-get (point) "ORDERED")
+ (forward-line 1)
+ (re-search-forward org-not-done-heading-regexp pos t))
+ (throw 'dont-block nil)) ; block, there is an older sibling not done.
+ ;; Search further up the hierarchy, to see if an anchestor is blocked
+ (while t
+ (goto-char parent-pos)
+ (if (not (looking-at org-not-done-heading-regexp))
+ (throw 'dont-block t)) ; do not block, parent is not a TODO
+ (setq pos (point))
+ (setq parent-pos (and (org-up-heading-safe) (point)))
+ (if (not parent-pos) (throw 'dont-block t)) ; no parent
+ (when (and (org-entry-get (point) "ORDERED")
+ (forward-line 1)
+ (re-search-forward org-not-done-heading-regexp pos t))
+ (throw 'dont-block nil))))))) ; block, older sibling not done.
+
+(defcustom org-track-ordered-property-with-tag nil
+ "Should the ORDERED property also be shown as a tag?
+The ORDERED property decides if an entry should require subtasks to be
+completed in sequence. Since a property is not very visible, setting
+this option means that toggling the ORDERED property with the command
+`org-toggle-ordered-property' will also toggle a tag ORDERED. That tag is
+not relevant for the behavior, but it makes things more visible.
+
+Note that toggling the tag with tags commands will not change the property
+and therefore not influence behavior!
+
+This can be t, meaning the tag ORDERED should be used, It can also be a
+string to select a different tag for this task."
+ :group 'org-todo
+ :type '(choice
+ (const :tag "No tracking" nil)
+ (const :tag "Track with ORDERED tag" t)
+ (string :tag "Use other tag")))
(defun org-toggle-ordered-property ()
- "Toggle the ORDERED property of the current entry."
+ "Toggle the ORDERED property of the current entry.
+For better visibility, you can track the value of this property with a tag.
+See variable `org-track-ordered-property-with-tag'."
(interactive)
- (save-excursion
- (org-back-to-heading)
- (if (org-entry-get nil "ORDERED")
- (progn
- (org-delete-property "ORDERED")
- (message "Subtasks can be completed in arbitrary order or parallel"))
- (org-entry-put nil "ORDERED" "t")
- (message "Subtasks must be completed in sequence"))))
-
+ (let* ((t1 org-track-ordered-property-with-tag)
+ (tag (and t1 (if (stringp t1) t1 "ORDERED"))))
+ (save-excursion
+ (org-back-to-heading)
+ (if (org-entry-get nil "ORDERED")
+ (progn
+ (org-delete-property "ORDERED")
+ (and tag (org-toggle-tag tag 'off))
+ (message "Subtasks can be completed in arbitrary order"))
+ (org-entry-put nil "ORDERED" "t")
+ (and tag (org-toggle-tag tag 'on))
+ (message "Subtasks must be completed in sequence")))))
+
+(defvar org-blocked-by-checkboxes) ; dynamically scoped
(defun org-block-todo-from-checkboxes (change-plist)
"Block turning an entry into a TODO, using checkboxes.
This checks whether the current task should be blocked from state
-changes because there are uncheckd boxes in this entry."
+changes because there are unchecked boxes in this entry."
(catch 'dont-block
;; If this is not a todo state change, or if this entry is already DONE,
;; do not block
(member (plist-get change-plist :from)
(cons 'done org-done-keywords))
(member (plist-get change-plist :to)
- (cons 'todo org-not-done-keywords)))
+ (cons 'todo org-not-done-keywords))
+ (not (plist-get change-plist :to)))
(throw 'dont-block t))
;; If this task has checkboxes that are not checked, it's blocked
(save-excursion
(goto-char beg)
(if (re-search-forward "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\[[- ]\\]"
end t)
- (throw 'dont-block nil))))
+ (progn
+ (if (boundp 'org-blocked-by-checkboxes)
+ (setq org-blocked-by-checkboxes t))
+ (throw 'dont-block nil)))))
t)) ; do not block
+(defun org-update-statistics-cookies (all)
+ "Update the statistics cookie, either from TODO or from checkboxes.
+This should be called with the cursor in a line with a statistics cookie."
+ (interactive "P")
+ (if all
+ (progn
+ (org-update-checkbox-count 'all)
+ (org-map-entries 'org-update-parent-todo-statistics))
+ (if (not (org-on-heading-p))
+ (org-update-checkbox-count)
+ (let ((pos (move-marker (make-marker) (point)))
+ end l1 l2)
+ (ignore-errors (org-back-to-heading t))
+ (if (not (org-on-heading-p))
+ (org-update-checkbox-count)
+ (setq l1 (org-outline-level))
+ (setq end (save-excursion
+ (outline-next-heading)
+ (if (org-on-heading-p) (setq l2 (org-outline-level)))
+ (point)))
+ (if (and (save-excursion (re-search-forward
+ "^[ \t]*[-+*] \\[[- X]\\]" end t))
+ (not (save-excursion (re-search-forward
+ ":COOKIE_DATA:.*\\<todo\\>" end t))))
+ (org-update-checkbox-count)
+ (if (and l2 (> l2 l1))
+ (progn
+ (goto-char end)
+ (org-update-parent-todo-statistics))
+ (error "No data for statistics cookie"))))
+ (goto-char pos)
+ (move-marker pos nil)))))
+
+(defvar org-entry-property-inherited-from) ;; defined below
(defun org-update-parent-todo-statistics ()
- "Update any statistics cookie in the parent of the current headline."
+ "Update any statistics cookie in the parent of the current headline.
+When `org-hierarchical-todo-statistics' is nil, statistics will cover
+the entire subtree and this will travel up the hierarchy and update
+statistics everywhere."
(interactive)
- (let ((box-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
- level (cnt-all 0) (cnt-done 0) is-percent kwd cookie-present)
+ (let* ((lim 0) prop
+ (recursive (or (not org-hierarchical-todo-statistics)
+ (string-match
+ "\\<recursive\\>"
+ (or (setq prop (org-entry-get
+ nil "COOKIE_DATA" 'inherit)) ""))))
+ (lim (or (and prop (marker-position
+ org-entry-property-inherited-from))
+ lim))
+ (first t)
+ (box-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
+ level ltoggle l1 new ndel
+ (cnt-all 0) (cnt-done 0) is-percent kwd cookie-present)
(catch 'exit
(save-excursion
- (setq level (org-up-heading-safe))
- (unless level
- (throw 'exit nil))
- (while (re-search-forward box-re (point-at-eol) t)
- (setq cnt-all 0 cnt-done 0 cookie-present t)
- (setq is-percent (match-end 2))
- (save-match-data
- (unless (outline-next-heading) (throw 'exit nil))
- (while (looking-at org-todo-line-regexp)
- (setq kwd (match-string 2))
- (and kwd (setq cnt-all (1+ cnt-all)))
- (and (member kwd org-done-keywords)
- (setq cnt-done (1+ cnt-done)))
- (condition-case nil
- (org-forward-same-level 1)
- (error (end-of-line 1)))))
- (replace-match
- (if is-percent
- (format "[%d%%]" (/ (* 100 cnt-done) (max 1 cnt-all)))
- (format "[%d/%d]" cnt-done cnt-all))))
- (when cookie-present
- (run-hook-with-args 'org-after-todo-statistics-hook
- cnt-done (- cnt-all cnt-done)))))))
+ (beginning-of-line 1)
+ (if (org-at-heading-p)
+ (setq ltoggle (funcall outline-level))
+ (error "This should not happen"))
+ (while (and (setq level (org-up-heading-safe))
+ (or recursive first)
+ (>= (point) lim))
+ (setq first nil cookie-present nil)
+ (unless (and level
+ (not (string-match
+ "\\<checkbox\\>"
+ (downcase
+ (or (org-entry-get
+ nil "COOKIE_DATA")
+ "")))))
+ (throw 'exit nil))
+ (while (re-search-forward box-re (point-at-eol) t)
+ (setq cnt-all 0 cnt-done 0 cookie-present t)
+ (setq is-percent (match-end 2))
+ (save-match-data
+ (unless (outline-next-heading) (throw 'exit nil))
+ (while (and (looking-at org-complex-heading-regexp)
+ (> (setq l1 (length (match-string 1))) level))
+ (setq kwd (and (or recursive (= l1 ltoggle))
+ (match-string 2)))
+ (if (or (eq org-provide-todo-statistics 'all-headlines)
+ (and (listp org-provide-todo-statistics)
+ (or (member kwd org-provide-todo-statistics)
+ (member kwd org-done-keywords))))
+ (setq cnt-all (1+ cnt-all))
+ (if (eq org-provide-todo-statistics t)
+ (and kwd (setq cnt-all (1+ cnt-all)))))
+ (and (member kwd org-done-keywords)
+ (setq cnt-done (1+ cnt-done)))
+ (outline-next-heading)))
+ (setq new
+ (if is-percent
+ (format "[%d%%]" (/ (* 100 cnt-done) (max 1 cnt-all)))
+ (format "[%d/%d]" cnt-done cnt-all))
+ ndel (- (match-end 0) (match-beginning 0)))
+ (goto-char (match-beginning 0))
+ (insert new)
+ (delete-region (point) (+ (point) ndel)))
+ (when cookie-present
+ (run-hook-with-args 'org-after-todo-statistics-hook
+ cnt-done (- cnt-all cnt-done))))))
+ (run-hooks 'org-todo-statistics-hook)))
(defvar org-after-todo-statistics-hook nil
"Hook that is called after a TODO statistics cookie has been updated.
(org-todo (if (= n-not-done 0) \"DONE\" \"TODO\"))))
")
+(defvar org-todo-statistics-hook nil
+ "Hook that is run whenever Org thinks TODO statistics should be updated.
+This hook runs even if there is no statistics cookie present, in which case
+`org-after-todo-statistics-hook' would not run.")
+
(defun org-todo-trigger-tag-changes (state)
"Apply the changes defined in `org-todo-state-tags-triggers'."
(let ((l org-todo-state-tags-triggers)
((equal e '(:endgroup))
(setq ingroup nil cnt 0)
(insert "}\n"))
+ ((equal e '(:newline))
+ (when (not (= cnt 0))
+ (setq cnt 0)
+ (insert "\n")
+ (setq e (car tbl))
+ (while (equal (car tbl) '(:newline))
+ (insert "\n")
+ (setq tbl (cdr tbl)))))
(t
(setq tg (car e) c (cdr e))
(if ingroup (push tg (car groups)))
(throw 'exit t)))
nil)))
-(defun org-get-repeat ()
+(defun org-get-repeat (&optional tagline)
"Check if there is a deadline/schedule with repeater in this entry."
(save-match-data
(save-excursion
(org-back-to-heading t)
- (if (re-search-forward
- org-repeat-re (save-excursion (outline-next-heading) (point)) t)
- (match-string 1)))))
+ (and (re-search-forward (if tagline
+ (concat tagline "\\s-*" org-repeat-re)
+ org-repeat-re)
+ (org-entry-end-position) t)
+ (match-string-no-properties 1)))))
(defvar org-last-changed-timestamp)
(defvar org-last-inserted-timestamp)
(when repeat
(if (eq org-log-repeat t) (setq org-log-repeat 'state))
(org-todo (if (eq interpret 'type) last-state head))
+ (org-entry-put nil "LAST_REPEAT" (format-time-string
+ (org-time-stamp-format t t)))
(when org-log-repeat
(if (or (memq 'org-add-log-note (default-value 'post-command-hook))
(memq 'org-add-log-note post-command-hook))
(setq org-log-note-how 'note))
;; Set up for taking a record
(org-add-log-setup 'state (or done-word (car org-done-keywords))
+ last-state
'findpos org-log-repeat)))
(org-back-to-heading t)
(org-add-planning-info nil nil 'closed)
"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 a \\[universal-argument] prefix, also show the DONE entries.
+With a \\[universal-argument] prefix, prompt for a regexp to match.
With a numeric prefix N, construct a sparse tree for the Nth element
of `org-todo-keywords-1'."
(interactive "P")
(kwd-re
(cond ((null arg) org-not-done-regexp)
((equal arg '(4))
- (let ((kwd (org-ido-completing-read "Keyword (or KWD1|KWD2|...): "
+ (let ((kwd (org-icompleting-read "Keyword (or KWD1|KWD2|...): "
(mapcar 'list org-todo-keywords-1))))
(concat "\\("
(mapconcat 'identity (org-split-string kwd "|") "\\|")
When TIME is set, it should be an internal time specification, and the
scheduling will use the corresponding date."
(interactive "P")
- (if remove
- (progn
- (org-remove-timestamp-with-keyword org-deadline-string)
- (message "Item no longer has a deadline."))
- (if (org-get-repeat)
- (error "Cannot change deadline on task with repeater, please do that by hand")
- (org-add-planning-info 'deadline time 'closed)
- (message "Deadline on %s" org-last-inserted-timestamp))))
+ (let ((old-date (org-entry-get nil "DEADLINE")))
+ (if remove
+ (progn
+ (org-remove-timestamp-with-keyword org-deadline-string)
+ (message "Item no longer has a deadline."))
+ (if (org-get-repeat)
+ (error "Cannot change deadline on task with repeater, please do that by hand")
+ (org-add-planning-info 'deadline time 'closed)
+ (when (and old-date org-log-redeadline
+ (not (equal old-date
+ (substring org-last-inserted-timestamp 1 -1))))
+ (org-add-log-setup 'redeadline nil old-date 'findpos
+ org-log-redeadline))
+ (message "Deadline on %s" org-last-inserted-timestamp)))))
(defun org-schedule (&optional remove time)
"Insert the SCHEDULED: string with a timestamp to schedule a TODO item.
When TIME is set, it should be an internal time specification, and the
scheduling will use the corresponding date."
(interactive "P")
- (if remove
- (progn
- (org-remove-timestamp-with-keyword org-scheduled-string)
- (message "Item is no longer scheduled."))
- (if (org-get-repeat)
- (error "Cannot reschedule task with repeater, please do that by hand")
- (org-add-planning-info 'scheduled time 'closed)
- (message "Scheduled to %s" org-last-inserted-timestamp))))
+ (let ((old-date (org-entry-get nil "SCHEDULED")))
+ (if remove
+ (progn
+ (org-remove-timestamp-with-keyword org-scheduled-string)
+ (message "Item is no longer scheduled."))
+ (if (org-get-repeat)
+ (error "Cannot reschedule task with repeater, please do that by hand")
+ (org-add-planning-info 'scheduled time 'closed)
+ (when (and old-date org-log-reschedule
+ (not (equal old-date
+ (substring org-last-inserted-timestamp 1 -1))))
+ (org-add-log-setup 'reschedule nil old-date 'findpos
+ org-log-reschedule))
+ (message "Scheduled to %s" org-last-inserted-timestamp)))))
+
+(defun org-get-scheduled-time (pom &optional inherit)
+ "Get the scheduled time as a time tuple, of a format suitable
+for calling org-schedule with, or if there is no scheduling,
+returns nil."
+ (let ((time (org-entry-get pom "SCHEDULED" inherit)))
+ (when time
+ (apply 'encode-time (org-parse-time-string time)))))
+
+(defun org-get-deadline-time (pom &optional inherit)
+ "Get the deadine as a time tuple, of a format suitable for
+calling org-deadline with, or if there is no scheduling, returns
+nil."
+ (let ((time (org-entry-get pom "DEADLINE" inherit)))
+ (when time
+ (apply 'encode-time (org-parse-time-string time)))))
(defun org-remove-timestamp-with-keyword (keyword)
"Remove all time stamps with KEYWORD in the current entry."
(save-excursion
(org-back-to-heading t)
(setq beg (point))
- (org-end-of-subtree t t)
+ (outline-next-heading)
(while (re-search-backward re beg t)
(replace-match "")
(if (and (string-match "\\S-" (buffer-substring (point-at-bol) (point)))
(let (org-time-was-given org-end-time-was-given ts
end default-time default-input)
- (when (and (not time) (memq what '(scheduled deadline)))
- ;; Try to get a default date/time from existing timestamp
- (save-excursion
- (org-back-to-heading t)
- (setq end (save-excursion (outline-next-heading) (point)))
- (when (re-search-forward (if (eq what 'scheduled)
- org-scheduled-time-regexp
- org-deadline-time-regexp)
- end t)
- (setq ts (match-string 1)
- default-time
- (apply 'encode-time (org-parse-time-string ts))
- default-input (and ts (org-get-compact-tod ts))))))
- (when what
- ;; If necessary, get the time from the user
- (setq time (or time (org-read-date nil 'to-time nil nil
- default-time default-input))))
-
- (when (and org-insert-labeled-timestamps-at-point
- (member what '(scheduled deadline)))
- (insert
- (if (eq what 'scheduled) org-scheduled-string org-deadline-string) " ")
- (org-insert-time-stamp time org-time-was-given
- nil nil nil (list org-end-time-was-given))
- (setq what nil))
- (save-excursion
- (save-restriction
- (let (col list elt ts buffer-invisibility-spec)
+ (catch 'exit
+ (when (and (not time) (memq what '(scheduled deadline)))
+ ;; Try to get a default date/time from existing timestamp
+ (save-excursion
(org-back-to-heading t)
- (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*"))
- (goto-char (match-end 1))
- (setq col (current-column))
- (goto-char (match-end 0))
- (if (eobp) (insert "\n") (forward-char 1))
- (if (and (not (looking-at outline-regexp))
- (looking-at (concat "[^\r\n]*?" org-keyword-time-regexp
- "[^\r\n]*"))
- (not (equal (match-string 1) org-clock-string)))
- (narrow-to-region (match-beginning 0) (match-end 0))
- (insert-before-markers "\n")
- (backward-char 1)
- (narrow-to-region (point) (point))
- (and org-adapt-indentation (org-indent-to-column col)))
- ;; Check if we have to remove something.
- (setq list (cons what remove))
- (while list
- (setq elt (pop list))
+ (setq end (save-excursion (outline-next-heading) (point)))
+ (when (re-search-forward (if (eq what 'scheduled)
+ org-scheduled-time-regexp
+ org-deadline-time-regexp)
+ end t)
+ (setq ts (match-string 1)
+ default-time
+ (apply 'encode-time (org-parse-time-string ts))
+ default-input (and ts (org-get-compact-tod ts))))))
+ (when what
+ ;; If necessary, get the time from the user
+ (setq time (or time (org-read-date nil 'to-time nil nil
+ default-time default-input))))
+
+ (when (and org-insert-labeled-timestamps-at-point
+ (member what '(scheduled deadline)))
+ (insert
+ (if (eq what 'scheduled) org-scheduled-string org-deadline-string) " ")
+ (org-insert-time-stamp time org-time-was-given
+ nil nil nil (list org-end-time-was-given))
+ (setq what nil))
+ (save-excursion
+ (save-restriction
+ (let (col list elt ts buffer-invisibility-spec)
+ (org-back-to-heading t)
+ (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*"))
+ (goto-char (match-end 1))
+ (setq col (current-column))
+ (goto-char (match-end 0))
+ (if (eobp) (insert "\n") (forward-char 1))
+ (when (and (not what)
+ (not (looking-at
+ (concat "[ \t]*"
+ org-keyword-time-not-clock-regexp))))
+ ;; Nothing to add, nothing to remove...... :-)
+ (throw 'exit nil))
+ (if (and (not (looking-at outline-regexp))
+ (looking-at (concat "[^\r\n]*?" org-keyword-time-regexp
+ "[^\r\n]*"))
+ (not (equal (match-string 1) org-clock-string)))
+ (narrow-to-region (match-beginning 0) (match-end 0))
+ (insert-before-markers "\n")
+ (backward-char 1)
+ (narrow-to-region (point) (point))
+ (and org-adapt-indentation (org-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 ""))
+ (skip-chars-backward " ")
+ (if (looking-at " +") (replace-match ""))))
+ (goto-char (point-max))
+ (and org-adapt-indentation (bolp) (org-indent-to-column col))
+ (when what
+ (insert
+ (if (not (or (bolp) (eq (char-before) ?\ ))) " " "")
+ (cond ((eq what 'scheduled) org-scheduled-string)
+ ((eq what 'deadline) org-deadline-string)
+ ((eq what 'closed) org-closed-string))
+ " ")
+ (setq ts (org-insert-time-stamp
+ time
+ (or org-time-was-given
+ (and (eq what 'closed) org-log-done-with-time))
+ (eq what 'closed)
+ nil nil (list org-end-time-was-given)))
+ (end-of-line 1))
(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 ""))
- (if (looking-at " +") (replace-match ""))))
- (goto-char (point-max))
- (when what
- (insert
- (if (not (or (bolp) (eq (char-before) ?\ ))) " " "")
- (cond ((eq what 'scheduled) org-scheduled-string)
- ((eq what 'deadline) org-deadline-string)
- ((eq what 'closed) org-closed-string))
- " ")
- (setq ts (org-insert-time-stamp
- time
- (or org-time-was-given
- (and (eq what 'closed) org-log-done-with-time))
- (eq what 'closed)
- nil nil (list org-end-time-was-given)))
- (end-of-line 1))
- (goto-char (point-min))
- (widen)
- (if (and (looking-at "[ \t]+\n")
- (equal (char-before) ?\n))
- (delete-region (1- (point)) (point-at-eol)))
- ts)))))
+ (widen)
+ (if (and (looking-at "[ \t]+\n")
+ (equal (char-before) ?\n))
+ (delete-region (1- (point)) (point-at-eol)))
+ ts))))))
(defvar org-log-note-marker (make-marker))
(defvar org-log-note-purpose nil)
(defvar org-log-note-state nil)
+(defvar org-log-note-previous-state nil)
(defvar org-log-note-how nil)
(defvar org-log-note-extra nil)
(defvar org-log-note-window-configuration nil)
"Add a note to the current entry.
This is done in the same way as adding a state change note."
(interactive)
- (org-add-log-setup 'note nil 'findpos nil))
+ (org-add-log-setup 'note nil nil 'findpos nil))
(defvar org-property-end-re)
-(defun org-add-log-setup (&optional purpose state findpos how &optional extra)
+(defun org-add-log-setup (&optional purpose state prev-state
+ findpos how &optional extra)
"Set up the post command hook to take a note.
If this is about to TODO state change, the new state is expected in STATE.
When FINDPOS is non-nil, find the correct position for the note in
the current entry. If not, assume that it can be inserted at point.
HOW is an indicator what kind of note should be created.
EXTRA is additional text that will be inserted into the notes buffer."
- (save-restriction
- (save-excursion
- (when findpos
- (org-back-to-heading t)
- (narrow-to-region (point) (save-excursion
- (outline-next-heading) (point)))
- (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*"
- "\\(\n[^\r\n]*?" org-keyword-time-not-clock-regexp
- "[^\r\n]*\\)?"))
- (goto-char (match-end 0))
- (when (and org-log-state-notes-insert-after-drawers
- (save-excursion
- (forward-line) (looking-at org-drawer-regexp)))
- (progn (forward-line)
- (while (looking-at org-drawer-regexp)
- (goto-char (match-end 0))
- (re-search-forward org-property-end-re (point-max) t)
- (forward-line))
- (forward-line -1)))
- (unless org-log-states-order-reversed
- (and (= (char-after) ?\n) (forward-char 1))
- (org-skip-over-state-notes)
- (skip-chars-backward " \t\n\r")))
- (move-marker org-log-note-marker (point))
- (setq org-log-note-purpose purpose
- org-log-note-state state
- org-log-note-how how
- org-log-note-extra extra)
- (add-hook 'post-command-hook 'org-add-log-note 'append))))
+ (let* ((org-log-into-drawer (org-log-into-drawer))
+ (drawer (cond ((stringp org-log-into-drawer)
+ org-log-into-drawer)
+ (org-log-into-drawer "LOGBOOK")
+ (t nil))))
+ (save-restriction
+ (save-excursion
+ (when findpos
+ (org-back-to-heading t)
+ (narrow-to-region (point) (save-excursion
+ (outline-next-heading) (point)))
+ (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*"
+ "\\(\n[^\r\n]*?" org-keyword-time-not-clock-regexp
+ "[^\r\n]*\\)?"))
+ (goto-char (match-end 0))
+ (cond
+ (drawer
+ (if (re-search-forward (concat "^[ \t]*:" drawer ":[ \t]*$")
+ nil t)
+ (progn
+ (goto-char (match-end 0))
+ (or org-log-states-order-reversed
+ (and (re-search-forward org-property-end-re nil t)
+ (goto-char (1- (match-beginning 0))))))
+ (insert "\n:" drawer ":\n:END:")
+ (beginning-of-line 0)
+ (org-indent-line-function)
+ (beginning-of-line 2)
+ (org-indent-line-function)
+ (end-of-line 0)))
+ ((and org-log-state-notes-insert-after-drawers
+ (save-excursion
+ (forward-line) (looking-at org-drawer-regexp)))
+ (forward-line)
+ (while (looking-at org-drawer-regexp)
+ (goto-char (match-end 0))
+ (re-search-forward org-property-end-re (point-max) t)
+ (forward-line))
+ (forward-line -1)))
+ (unless org-log-states-order-reversed
+ (and (= (char-after) ?\n) (forward-char 1))
+ (org-skip-over-state-notes)
+ (skip-chars-backward " \t\n\r")))
+ (move-marker org-log-note-marker (point))
+ (setq org-log-note-purpose purpose
+ org-log-note-state state
+ org-log-note-previous-state prev-state
+ org-log-note-how how
+ org-log-note-extra extra)
+ (add-hook 'post-command-hook 'org-add-log-note 'append)))))
(defun org-skip-over-state-notes ()
"Skip past the list of State notes in an entry."
((eq org-log-note-purpose 'clock-out) "stopped clock")
((eq org-log-note-purpose 'done) "closed todo item")
((eq org-log-note-purpose 'state)
- (format "state change to \"%s\"" org-log-note-state))
+ (format "state change from \"%s\" to \"%s\""
+ (or org-log-note-previous-state "")
+ (or org-log-note-state "")))
+ ((eq org-log-note-purpose 'reschedule)
+ "rescheduling")
+ ((eq org-log-note-purpose 'redeadline)
+ "changing deadline")
((eq org-log-note-purpose 'note)
"this entry")
(t (error "This should not happen")))))
(current-time)))
(cons "%s" (if org-log-note-state
(concat "\"" org-log-note-state "\"")
- "")))))
+ ""))
+ (cons "%S" (if org-log-note-previous-state
+ (concat "\"" org-log-note-previous-state "\"")
+ "\"\"")))))
(if lines (setq note (concat note " \\\\")))
(push note lines))
- (when (or current-prefix-arg org-note-abort) (setq lines nil))
+ (when (or current-prefix-arg org-note-abort)
+ (when org-log-into-drawer
+ (org-remove-empty-drawer-at
+ (if (stringp org-log-into-drawer) org-log-into-drawer "LOGBOOK")
+ org-log-note-marker))
+ (setq lines nil))
(when lines
- (save-excursion
- (set-buffer (marker-buffer org-log-note-marker))
+ (with-current-buffer (marker-buffer org-log-note-marker)
(save-excursion
(goto-char org-log-note-marker)
(move-marker org-log-note-marker nil)
(end-of-line 1)
(if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n")))
- (indent-relative nil)
(insert "- " (pop lines))
(org-indent-line-function)
(beginning-of-line 1)
(looking-at "[ \t]*")
(setq ind (concat (match-string 0) " "))
(end-of-line 1)
- (while lines (insert "\n" ind (pop lines)))))))
+ (while lines (insert "\n" ind (pop lines)))
+ (message "Note stored")
+ (org-back-to-heading t)
+ (org-cycle-hide-drawers 'children)))))
(set-window-configuration org-log-note-window-configuration)
(with-current-buffer (marker-buffer org-log-note-return-to)
(goto-char org-log-note-return-to))
(move-marker org-log-note-return-to nil)
(and org-log-post-message (message "%s" org-log-post-message)))
+(defun org-remove-empty-drawer-at (drawer pos)
+ "Remove an empty drawer DRAWER at position POS.
+POS may also be a marker."
+ (with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char pos)
+ (if (org-in-regexp
+ (concat "^[ \t]*:" drawer ":[ \t]*\n[ \t]*:END:[ \t]*\n?") 2)
+ (replace-match ""))))))
+
(defun org-sparse-tree (&optional arg)
"Create a sparse tree, prompt for the details.
This command can create sparse trees. You first need to select the type
of match used to create the tree:
t Show entries with a specific TODO keyword.
-T Show entries selected by a tags match.
+m Show entries selected by a tags/property match.
p Enter a property name and its value (both with completion on existing
names/values) and show entries with that property.
-r Show entries matching a regular expression
-d Show deadlines due within `org-deadline-warning-days'."
+/ Show entries matching a regular expression (`r' can be used as well)
+d Show deadlines due within `org-deadline-warning-days'.
+b Show deadlines and scheduled items before a date.
+a Show deadlines and scheduled items after a date."
(interactive "P")
(let (ans kwd value)
- (message "Sparse tree: [/]regexp [t]odo-kwd [T]ag [p]roperty [d]eadlines [b]efore-date")
+ (message "Sparse tree: [/]regexp [t]odo-kwd [m]atch [p]roperty [d]eadlines [b]efore-date [a]fter-date")
(setq ans (read-char-exclusive))
(cond
((equal ans ?d)
(call-interactively 'org-check-deadlines))
((equal ans ?b)
(call-interactively 'org-check-before-date))
+ ((equal ans ?a)
+ (call-interactively 'org-check-after-date))
((equal ans ?t)
(org-show-todo-tree '(4)))
- ((equal ans ?T)
- (call-interactively 'org-tags-sparse-tree))
+ ((member ans '(?T ?m))
+ (call-interactively 'org-match-sparse-tree))
((member ans '(?p ?P))
- (setq kwd (org-ido-completing-read "Property: "
+ (setq kwd (org-icompleting-read "Property: "
(mapcar 'list (org-buffer-property-keys))))
- (setq value (org-ido-completing-read "Value: "
+ (setq value (org-icompleting-read "Value: "
(mapcar 'list (org-property-values kwd))))
(unless (string-match "\\`{.*}\\'" value)
(setq value (concat "\"" value "\"")))
- (org-tags-sparse-tree arg (concat kwd "=" value)))
+ (org-match-sparse-tree arg (concat kwd "=" value)))
((member ans '(?r ?R ?/))
(call-interactively 'org-occur))
(t (error "No such sparse tree command \"%c\"" ans)))))
If CALLBACK is non-nil, it is a function which is called to confirm
that the match should indeed be shown."
(interactive "sRegexp: \nP")
+ (when (equal regexp "")
+ (error "Regexp cannot be empty"))
(unless keep-previous
(org-remove-occur-highlights nil nil t))
(push (cons regexp callback) org-occur-parameters)
"Change the priority of an item by ARG.
ACTION can be `set', `up', `down', or a character."
(interactive)
+ (unless org-enable-priority-commands
+ (error "Priority commands are disabled"))
(setq action (or action 'set))
(let (current new news have remove)
(save-excursion
- (org-back-to-heading)
+ (org-back-to-heading t)
(if (looking-at org-priority-regexp)
(setq current (string-to-char (match-string 2))
have t)
(setq current org-default-priority))
(cond
+ ((eq action 'remove)
+ (setq remove t new ?\ ))
((or (eq action 'set)
(if (featurep 'xemacs) (characterp action) (integerp action)))
(if (not (eq action 'set))
(replace-match news t t nil 2))
(if remove
(error "No priority cookie found in line")
- (looking-at org-todo-line-regexp)
+ (let ((case-fold-search nil))
+ (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 "] ")))))
- (org-preserve-lc (org-set-tags nil 'align))
+ (insert "[#" news "] "))))
+ (org-preserve-lc (org-set-tags nil 'align)))
(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
;;;; Tags
(defvar org-agenda-archives-mode)
+(defvar org-map-continue-from nil
+ "Position from where mapping should continue.
+Can be set by the action argument to `org-scan-tag's and `org-map-entries'.")
+
+(defvar org-scanner-tags nil
+ "The current tag list while the tags scanner is running.")
+(defvar org-trust-scanner-tags nil
+ "Should `org-get-tags-at' use the tags fro the scanner.
+This is for internal dynamical scoping only.
+When this is non-nil, the function `org-get-tags-at' will return the value
+of `org-scanner-tags' instead of building the list by itself. This
+can lead to large speed-ups when the tags scanner is used in a file with
+many entries, and when the list of tags is retrieved, for example to
+obtain a list of properties. Building the tags list for each entry in such
+a file becomes an N^2 operation - but with this variable set, it scales
+as N.")
+
(defun org-scan-tags (action matcher &optional todo-only)
"Scan headline tags with inheritance and produce output ACTION.
qualifies a headline for inclusion. When TODO-ONLY is non-nil,
only lines with a TODO keyword are included in the output."
(require 'org-agenda)
- (let* ((re (concat "[\n\r]" outline-regexp " *\\(\\<\\("
+ (let* ((re (concat "^" outline-regexp " *\\(\\<\\("
(mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
(org-re
"\\>\\)\\)? *\\(.*?\\)\\(:[[:alnum:]_@:]+:\\)?[ \t]*$")))
(props (list 'face 'default
- 'done-face 'org-done
+ 'done-face 'org-agenda-done
'undone-face 'default
'mouse-face 'highlight
'org-not-done-regexp org-not-done-regexp
'org-todo-regexp org-todo-regexp
- 'keymap org-agenda-keymap
'help-echo
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name
(or (buffer-file-name (buffer-base-buffer))
(buffer-name (buffer-base-buffer)))))))
(case-fold-search nil)
+ (org-map-continue-from nil)
lspos tags tags-list
- (tags-alist (list (cons 0 (mapcar 'downcase org-file-tags))))
+ (tags-alist (list (cons 0 org-file-tags)))
(llast 0) rtn rtn1 level category i txt
todo marker entry priority)
(when (not (or (member action '(agenda sparse-tree)) (functionp action)))
(org-remove-occur-highlights))
(while (re-search-forward re nil t)
(catch :skip
- (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 todo (if (match-end 1) (org-match-string-no-properties 2))
+ tags (if (match-end 4) (org-match-string-no-properties 4)))
+ (goto-char (setq lspos (match-beginning 0)))
(setq level (org-reduced-level (funcall outline-level))
category (org-get-category))
(setq i llast llast level)
(setq i (1- i)))
;; add the next tags
(when tags
- (setq tags (mapcar 'downcase (org-split-string tags ":"))
+ (setq tags (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 (reverse tags-alist)))
- tags))
+ tags)
+ org-scanner-tags tags-list)
(when org-use-tag-inheritance
(setcdr (car tags-alist)
(mapcar (lambda (x)
(org-add-prop-inherited x))
(cdar tags-alist))))
(when (and tags org-use-tag-inheritance
- (not (eq t org-use-tag-inheritance)))
+ (or (not (eq t org-use-tag-inheritance))
+ org-tags-exclude-from-inheritance))
;; selective inheritance, remove uninherited ones
(setcdr (car tags-alist)
(org-remove-uniherited-tags (cdar tags-alist))))
(setq txt (org-format-agenda-item
""
(concat
- (if org-tags-match-list-sublevels
+ (if (eq org-tags-match-list-sublevels 'indented)
(make-string (1- level) ?.) "")
(org-get-heading))
- category (org-get-tags-at))
+ category
+ tags-list
+ )
priority (org-get-priority txt))
(goto-char lspos)
(setq marker (org-agenda-new-marker))
(org-add-props txt props
'org-marker marker 'org-hd-marker marker 'org-category category
+ 'todo-state todo
'priority priority 'type "tagsmatch")
(push txt rtn))
((functionp action)
+ (setq org-map-continue-from nil)
(save-excursion
(setq rtn1 (funcall action))
- (push rtn1 rtn))
- (goto-char (point-at-eol)))
+ (push rtn1 rtn)))
(t (error "Invalid action")))
;; if we are to skip sublevels, jump to end of subtree
- (or org-tags-match-list-sublevels (org-end-of-subtree t))))))
+ (unless org-tags-match-list-sublevels
+ (org-end-of-subtree t)
+ (backward-char 1))))
+ ;; Get the correct position from where to continue
+ (if org-map-continue-from
+ (goto-char org-map-continue-from)
+ (and (= (point) lspos) (end-of-line 1)))))
(when (and (eq action 'sparse-tree)
(not org-sparse-tree-open-archived-trees))
(org-hide-archived-subtrees (point-min) (point-max)))
(defvar todo-only) ;; dynamically scoped
-(defun org-tags-sparse-tree (&optional todo-only match)
+(defun org-match-sparse-tree (&optional todo-only match)
"Create a sparse tree according to tags string MATCH.
MATCH can contain positive and negative selection of tags, like
\"+WORK+URGENT-WITHBOSS\".
(org-prepare-agenda-buffers (list (current-buffer)))
(org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only))
+(defalias 'org-tags-sparse-tree 'org-match-sparse-tree)
+
(defvar org-cached-props nil)
(defun org-cached-entry-get (pom property)
(if (or (eq t org-use-property-inheritance)
;; Get a new match request, with completion
(let ((org-last-tags-completion-table
(org-global-tags-completion-table)))
- (setq match (org-completing-read
+ (setq match (org-completing-read-no-i
"Match: " 'org-tags-completion-function nil nil nil
'org-tags-history))))
`(,po (or ,gv "") ,pv)
`(,po (string-to-number (or ,gv ""))
,(string-to-number pv) ))))
- (t `(member ,(downcase tag) tags-list)))
+ (t `(member ,tag tags-list)))
mm (if minus (list 'not mm) mm)
term rest)
(push mm tagsmatcher))
When LOCAL is non-nil, only return tags from the current headline,
ignore inherited ones."
(interactive)
- (let (tags ltags lastpos parent)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (or pos (point)))
- (save-match-data
- (catch 'done
- (condition-case nil
- (progn
- (org-back-to-heading t)
- (while (not (equal lastpos (point)))
- (setq lastpos (point))
- (when (looking-at (org-re "[^\r\n]+?:\\([[:alnum:]_@:]+\\):[ \t]*$"))
- (setq ltags (org-split-string
- (org-match-string-no-properties 1) ":"))
- (when parent
- (setq ltags (mapcar 'org-add-prop-inherited ltags)))
- (setq tags (append
- (if parent
- (org-remove-uniherited-tags ltags)
- ltags)
- tags)))
- (or org-use-tag-inheritance (throw 'done t))
- (if local (throw 'done t))
- (org-up-heading-all 1)
- (setq parent t)))
- (error nil)))))
- (append (org-remove-uniherited-tags org-file-tags) tags))))
+ (if (and org-trust-scanner-tags
+ (or (not pos) (equal pos (point)))
+ (not local))
+ org-scanner-tags
+ (let (tags ltags lastpos parent)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (or pos (point)))
+ (save-match-data
+ (catch 'done
+ (condition-case nil
+ (progn
+ (org-back-to-heading t)
+ (while (not (equal lastpos (point)))
+ (setq lastpos (point))
+ (when (looking-at
+ (org-re "[^\r\n]+?:\\([[:alnum:]_@:]+\\):[ \t]*$"))
+ (setq ltags (org-split-string
+ (org-match-string-no-properties 1) ":"))
+ (when parent
+ (setq ltags (mapcar 'org-add-prop-inherited ltags)))
+ (setq tags (append
+ (if parent
+ (org-remove-uniherited-tags ltags)
+ ltags)
+ tags)))
+ (or org-use-tag-inheritance (throw 'done t))
+ (if local (throw 'done t))
+ (or (org-up-heading-safe) (error nil))
+ (setq parent t)))
+ (error nil)))))
+ (append (org-remove-uniherited-tags org-file-tags) tags)))))
(defun org-add-prop-inherited (s)
(add-text-properties 0 (length s) '(inherited t) s)
(org-back-to-heading t)
(org-set-tags arg just-align))))
+(defun org-set-tags-to (data)
+ "Set the tags of the current entry to DATA, replacing the current tags.
+DATA may be a tags string like :aa:bb:cc:, or a list of tags.
+If DATA is nil or the empty string, any tags will be removed."
+ (interactive "sTags: ")
+ (setq data
+ (cond
+ ((eq data nil) "")
+ ((equal data "") "")
+ ((stringp data)
+ (concat ":" (mapconcat 'identity (org-split-string data ":+") ":")
+ ":"))
+ ((listp data)
+ (concat ":" (mapconcat 'identity data ":") ":"))
+ (t nil)))
+ (when data
+ (save-excursion
+ (org-back-to-heading t)
+ (when (looking-at org-complex-heading-regexp)
+ (if (match-end 5)
+ (progn
+ (goto-char (match-beginning 5))
+ (insert data)
+ (delete-region (point) (point-at-eol))
+ (org-set-tags nil 'align))
+ (goto-char (point-at-eol))
+ (insert " " data)
+ (org-set-tags nil 'align)))
+ (beginning-of-line 1)
+ (if (looking-at ".*?\\([ \t]+\\)$")
+ (delete-region (match-beginning 1) (match-end 1))))))
+
(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."
(setq tags current)
;; Get a new set of tags from the user
(save-excursion
- (setq table (or org-tag-alist (org-get-buffer-tags))
+ (setq table (append org-tag-persistent-alist
+ (or org-tag-alist (org-get-buffer-tags)))
org-last-tags-completion-table table
current-tags (org-split-string current ":")
inherited-tags (nreverse
(let ((org-add-colon-after-tag-completion t))
(org-trim
(org-without-partial-completion
- (org-ido-completing-read "Tags: " 'org-tags-completion-function
+ (org-icompleting-read "Tags: " 'org-tags-completion-function
nil nil current 'org-tags-history)))))))
(while (string-match "[-+&]+" tags)
;; No boolean logic, just a list
(setq tags (replace-match ":" t t tags))))
+ (if org-tags-sort-function
+ (setq tags (mapconcat 'identity
+ (sort (org-split-string tags (org-re "[^[:alnum:]_@]+"))
+ org-tags-sort-function) ":")))
+
(if (string-match "\\`[\t ]*\\'" tags)
- (setq tags "")
+ (setq tags "")
(unless (string-match ":$" tags) (setq tags (concat tags ":")))
(unless (string-match "^:" tags) (setq tags (concat ":" tags))))
(if (org-mode-p)
(org-get-buffer-tags)
(org-global-tags-completion-table))))
- (org-ido-completing-read
+ (org-icompleting-read
"Tag: " 'org-tags-completion-function nil nil nil
'org-tags-history))
(progn
(goto-char beg)
(setq l1 (org-current-line))
(loop for l from l1 to l2 do
- (goto-line l)
+ (org-goto-line l)
(setq m (get-text-property (point) 'org-hd-marker))
(when (or (and (org-mode-p) (org-on-heading-p))
(and agendap m))
(defun org-fast-tag-show-exit (flag)
(save-excursion
- (goto-line 3)
+ (org-goto-line 3)
(if (re-search-forward "[ \t]+Next change exits" (point-at-eol) t)
(replace-match ""))
(when flag
(setq tbl fulltable char ?a cnt 0)
(while (setq e (pop tbl))
(cond
- ((equal e '(:startgroup))
+ ((equal (car e) :startgroup)
(push '() groups) (setq ingroup t)
(when (not (= cnt 0))
(setq cnt 0)
(insert "\n"))
- (insert "{ "))
- ((equal e '(:endgroup))
+ (insert (if (cdr e) (format "%s: " (cdr e)) "") "{ "))
+ ((equal (car e) :endgroup)
(setq ingroup nil cnt 0)
- (insert "}\n"))
+ (insert "}" (if (cdr e) (format " (%s) " (cdr e)) "") "\n"))
+ ((equal e '(:newline))
+ (when (not (= cnt 0))
+ (setq cnt 0)
+ (insert "\n")
+ (setq e (car tbl))
+ (while (equal (car tbl) '(:newline))
+ (insert "\n")
+ (setq tbl (cdr tbl)))))
(t
- (setq tg (car e) c2 nil)
+ (setq tg (copy-sequence (car e)) c2 nil)
(if (cdr e)
(setq c (cdr e))
;; automatically assign a character.
(setq rtn
(catch 'exit
(while t
- (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free%s%s"
- (if groups " [!] no groups" " [!]groups")
+ (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free [!] %sgroups%s"
+ (if (not groups) "no " "")
(if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi")))
(setq c (let ((inhibit-quit t)) (read-char-exclusive)))
(cond
(if exit-after-next (setq exit-after-next 'now)))
((= c ?\t)
(condition-case nil
- (setq tg (org-ido-completing-read
+ (setq tg (org-icompleting-read
"Tag: "
(or buffer-tags
(with-current-buffer buf
(when (equal (char-after (point-at-bol 0)) ?*)
(mapc (lambda (x) (add-to-list 'tags x))
(org-split-string (org-match-string-no-properties 1) ":")))))
+ (mapc (lambda (s) (add-to-list 'tags s)) org-file-tags)
(mapcar 'list tags)))
;;;; The mapping API
The return values of all calls to the function will be collected and
returned as a list.
+The call to FUNC will be wrapped into a save-excursion form, so FUNC
+does not need to preserve point. After evaluation, the cursor will be
+moved to the end of the line (presumably of the headline of the
+processed entry) and search continues from there. Under some
+circumstances, this may not produce the wanted results. For example,
+if you have removed (e.g. archived) the current (sub)tree it could
+mean that the next entry will be skipped entirely. In such cases, you
+can specify the position from where search should continue by making
+FUNC set the variable `org-map-continue-from' to the desired buffer
+position.
+
MATCH is a tags/property/todo match as it is used in the agenda tags view.
Only headlines that are matched by this query will be considered during
the iteration. When MATCH is nil or t, all headlines will be
comment skip trees with the COMMENT keyword
function or Emacs Lisp form:
will be used as value for `org-agenda-skip-function', so whenever
- the the function returns t, FUNC will not be called for that
+ the function returns t, FUNC will not be called for that
entry and search will continue from the point where the
- function leaves it."
+ function leaves it.
+
+If your function needs to retrieve the tags including inherited tags
+at the *current* entry, you can use the value of the variable
+`org-scanner-tags' which will be much faster than getting the value
+with `org-get-tags-at'. If your function gets properties with
+`org-entry-properties' at the *current* entry, bind `org-trust-scanner-tags'
+to t around the call to `org-entry-properties' to get the same speedup.
+Note that if your function moves around to retrieve tags and properties at
+a *different* entry, you cannot use these techniques."
(let* ((org-agenda-archives-mode nil) ; just to make sure
(org-agenda-skip-archived-trees (memq 'archive skip))
(org-agenda-skip-comment-trees (memq 'comment skip))
org-todo-keywords-for-agenda
org-done-keywords-for-agenda
org-todo-keyword-alist-for-agenda
+ org-drawers-for-agenda
org-tag-alist-for-agenda)
(cond
but in some other way.")
(defconst org-default-properties
- '("ARCHIVE" "CATEGORY" "SUMMARY" "DESCRIPTION"
+ '("ARCHIVE" "CATEGORY" "SUMMARY" "DESCRIPTION" "CUSTOM_ID"
"LOCATION" "LOGGING" "COLUMNS" "VISIBILITY"
"TABLE_EXPORT_FORMAT" "TABLE_EXPORT_FILE"
- "EXPORT_FILE_NAME" "EXPORT_TITLE" "ORDERED")
+ "EXPORT_FILE_NAME" "EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE"
+ "ORDERED" "NOBLOCKING" "COOKIE_DATA" "LOG_INTO_DRAWER"
+ "CLOCK_MODELINE_TOTAL" "STYLE")
"Some properties that are used by Org-mode for various purposes.
Being in this list makes sure that they are offered for completion.")
(call-interactively 'org-compute-property-at-point))
(t (error "No such property action %c" c)))))
+(defun org-set-effort (&optional value)
+ "Set the effort property of the current entry.
+With numerical prefix arg, use the nth allowed value, 0 stands for the 10th
+allowed value."
+ (interactive "P")
+ (if (equal value 0) (setq value 10))
+ (let* ((completion-ignore-case t)
+ (prop org-effort-property)
+ (cur (org-entry-get nil prop))
+ (allowed (org-property-get-allowed-values nil prop 'table))
+ (existing (mapcar 'list (org-property-values prop)))
+ rpl
+ (val (cond
+ ((stringp value) value)
+ ((and allowed (integerp value))
+ (or (car (nth (1- value) allowed))
+ (car (org-last allowed))))
+ (allowed
+ (message "Select 1-9,0, [RET%s]: %s"
+ (if cur (concat "=" cur) "")
+ (mapconcat 'car allowed " "))
+ (setq rpl (read-char-exclusive))
+ (if (equal rpl ?\r)
+ cur
+ (setq rpl (- rpl ?0))
+ (if (equal rpl 0) (setq rpl 10))
+ (if (and (> rpl 0) (<= rpl (length allowed)))
+ (car (nth (1- rpl) allowed))
+ (org-completing-read "Effort: " allowed nil))))
+ (t
+ (let (org-completion-use-ido org-completion-use-iswitchb)
+ (org-completing-read
+ (concat "Effort " (if (and cur (string-match "\\S-" cur))
+ (concat "[" cur "]") "")
+ ": ")
+ existing nil nil "" nil cur))))))
+ (unless (equal (org-entry-get nil prop) val)
+ (org-entry-put nil prop val))
+ (message "%s is now %s" prop val)))
+
(defun org-at-property-p ()
"Is the cursor in a property line?"
;; FIXME: Does not check if we are actually in the drawer.
)
(when (memq which '(all standard))
- ;; Get the standard properties, like :PORP: ...
+ ;; Get the standard properties, like :PROP: ...
(setq range (org-get-property-block beg end))
(when range
(goto-char (car range))
(setq rtn (append org-special-properties rtn)))
(when include-defaults
- (mapc (lambda (x) (add-to-list 'rtn x)) org-default-properties))
+ (mapc (lambda (x) (add-to-list 'rtn x)) org-default-properties)
+ (add-to-list 'rtn org-effort-property))
(when include-columns
(save-excursion
(interactive)
(org-back-to-heading t)
(looking-at outline-regexp)
- (let ((indent (- (match-end 0)(match-beginning 0)))
+ (let ((indent (if org-adapt-indentation
+ (- (match-end 0)(match-beginning 0))
+ 0))
(beg (point))
(re (concat "^[ \t]*" org-keyword-time-regexp))
end hiddenp)
(setq hiddenp (org-invisible-p))
(end-of-line 1)
(and (equal (char-after) ?\n) (forward-char 1))
- (while (looking-at "^[ \t]*\\(:CLOCK:\\|CLOCK\\|:END:\\)")
- (beginning-of-line 2))
+ (while (looking-at "^[ \t]*\\(:CLOCK:\\|:LOGBOOK:\\|CLOCK:\\|:END:\\)")
+ (if (member (match-string 1) '("CLOCK:" ":END:"))
+ ;; just skip this line
+ (beginning-of-line 2)
+ ;; Drawer start, find the end
+ (re-search-forward "^\\*+ \\|^[ \t]*:END:" nil t)
+ (beginning-of-line 1)))
(org-skip-over-state-notes)
(skip-chars-backward " \t\n\r")
(if (eq (char-before) ?*) (forward-char 1))
(interactive
(let* ((completion-ignore-case t)
(keys (org-buffer-property-keys nil t t))
- (prop0 (org-ido-completing-read "Property: " (mapcar 'list keys)))
+ (prop0 (org-icompleting-read "Property: " (mapcar 'list keys)))
(prop (if (member prop0 keys)
prop0
(or (cdr (assoc (downcase prop0)
(existing (mapcar 'list (org-property-values prop)))
(val (if allowed
(org-completing-read "Value: " allowed nil 'req-match)
- (org-completing-read
- (concat "Value" (if (and cur (string-match "\\S-" cur))
- (concat "[" cur "]") "")
- ": ")
- existing nil nil "" nil cur))))
+ (let (org-completion-use-ido org-completion-use-iswitchb)
+ (org-completing-read
+ (concat "Value " (if (and cur (string-match "\\S-" cur))
+ (concat "[" cur "]") "")
+ ": ")
+ existing nil nil "" nil cur)))))
(list prop (if (equal val "") cur val))))
(unless (equal (org-entry-get nil property) value)
(org-entry-put nil property value)))
"In the current entry, delete PROPERTY."
(interactive
(let* ((completion-ignore-case t)
- (prop (org-ido-completing-read
+ (prop (org-icompleting-read
"Property: " (org-entry-properties nil 'standard))))
(list prop)))
(message "Property %s %s" property
"Remove PROPERTY globally, from all entries."
(interactive
(let* ((completion-ignore-case t)
- (prop (org-ido-completing-read
+ (prop (org-icompleting-read
"Globally remove property: "
(mapcar 'list (org-buffer-property-keys)))))
(list prop)))
(when (re-search-forward
(concat "^[ \t]*:ID:[ \t]+" (regexp-quote id) "[ \t]*$")
nil t)
- (org-back-to-heading)
+ (org-back-to-heading t)
(point))))))
;;;; Timestamps
(defvar org-overriding-default-time nil) ; dynamically scoped
(defvar org-read-date-overlay nil)
(defvar org-dcst nil) ; dynamically scoped
+(defvar org-read-date-history nil)
+(defvar org-read-date-final-answer nil)
(defun org-read-date (&optional with-time to-time from-string prompt
default-time default-input)
(setcar (nthcdr 1 defdecode) 59)
(setq def (apply 'encode-time defdecode)
defdecode (decode-time def)))))
+ (calendar-frame-setup nil)
(calendar-move-hook nil)
(calendar-view-diary-initially-flag nil)
(view-diary-entries-initially nil)
(minibuffer-local-map (copy-keymap minibuffer-local-map)))
(org-defkey map (kbd "RET") 'org-calendar-select)
(org-defkey map (if (featurep 'xemacs) [button1] [mouse-1])
- 'org-calendar-select-mouse)
+ 'org-calendar-select-mouse)
(org-defkey map (if (featurep 'xemacs) [button2] [mouse-2])
- 'org-calendar-select-mouse)
+ 'org-calendar-select-mouse)
(org-defkey minibuffer-local-map [(meta shift left)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-backward-month 1))))
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-backward-month 1))))
(org-defkey minibuffer-local-map [(meta shift right)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-forward-month 1))))
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-forward-month 1))))
(org-defkey minibuffer-local-map [(meta shift up)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-backward-year 1))))
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-backward-year 1))))
(org-defkey minibuffer-local-map [(meta shift down)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-forward-year 1))))
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-forward-year 1))))
+ (org-defkey minibuffer-local-map [?\e (shift left)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-backward-month 1))))
+ (org-defkey minibuffer-local-map [?\e (shift right)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-forward-month 1))))
+ (org-defkey minibuffer-local-map [?\e (shift up)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-backward-year 1))))
+ (org-defkey minibuffer-local-map [?\e (shift down)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-forward-year 1))))
(org-defkey minibuffer-local-map [(shift up)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-backward-week 1))))
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-backward-week 1))))
(org-defkey minibuffer-local-map [(shift down)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-forward-week 1))))
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-forward-week 1))))
(org-defkey minibuffer-local-map [(shift left)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-backward-day 1))))
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-backward-day 1))))
(org-defkey minibuffer-local-map [(shift right)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-forward-day 1))))
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-forward-day 1))))
(org-defkey minibuffer-local-map ">"
- (lambda () (interactive)
- (org-eval-in-calendar '(scroll-calendar-left 1))))
+ (lambda () (interactive)
+ (org-eval-in-calendar '(scroll-calendar-left 1))))
(org-defkey minibuffer-local-map "<"
- (lambda () (interactive)
- (org-eval-in-calendar '(scroll-calendar-right 1))))
+ (lambda () (interactive)
+ (org-eval-in-calendar '(scroll-calendar-right 1))))
+ (run-hooks 'org-read-date-minibuffer-setup-hook)
(unwind-protect
(progn
(use-local-map map)
(add-hook 'post-command-hook 'org-read-date-display)
- (setq org-ans0 (read-string prompt default-input nil nil))
+ (setq org-ans0 (read-string prompt default-input
+ 'org-read-date-history nil))
;; org-ans0: from prompt
;; org-ans1: from mouse click
;; org-ans2: from calendar motion
(t ; Naked prompt only
(unwind-protect
- (setq ans (read-string prompt default-input nil timestr))
+ (setq ans (read-string prompt default-input
+ 'org-read-date-history timestr))
(when org-read-date-overlay
(org-delete-overlay org-read-date-overlay)
(setq org-read-date-overlay nil)))))
(setq final (org-read-date-analyze ans def defdecode))
+ (setq org-read-date-final-answer ans)
(if to-time
(apply 'encode-time final)
(nth 5 final) (nth 4 final) (nth 3 final)
(nth 2 final) (nth 1 final))
(format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final))))))
+
(defvar def)
(defvar defdecode)
(defvar with-time)
+(defvar org-read-date-analyze-futurep nil)
(defun org-read-date-display ()
"Display the current date prompt interpretation in the minibuffer."
(when org-read-date-display-live
(setq txt (concat (substring txt 0 (match-end 0)) "-"
org-end-time-was-given
(substring txt (match-end 0)))))
+ (when org-read-date-analyze-futurep
+ (setq txt (concat txt " (=>F)")))
(setq org-read-date-overlay
(org-make-overlay (1- (point-at-eol)) (point-at-eol)))
(org-overlay-display org-read-date-overlay txt 'secondary-selection))))
;; FIXME: cleanup and comment
(let (delta deltan deltaw deltadef year month day
hour minute second wday pm h2 m2 tl wday1
- iso-year iso-weekday iso-week iso-year iso-date)
-
+ iso-year iso-weekday iso-week iso-year iso-date futurep)
+ (setq org-read-date-analyze-futurep nil)
(when (string-match "\\`[ \t]*\\.[ \t]*\\'" ans)
(setq ans "+0"))
deltadef (nth 2 delta)))
;; Check if there is an iso week date in there
- ;; If yes, sore the info and postpone interpreting it until the rest
+ ;; If yes, store the info and postpone interpreting it until the rest
;; of the parsing is done
(when (string-match "\\<\\(?:\\([0-9]+\\)-\\)?[wW]\\([0-9]\\{1,2\\}\\)\\(?:-\\([0-6]\\)\\)?\\([ \t]\\|$\\)" ans)
(setq iso-year (if (match-end 1) (org-small-year-to-year (string-to-number (match-string 1 ans))))
month (or (nth 4 tl)
(if (and org-read-date-prefer-future
(nth 3 tl) (< (nth 3 tl) (nth 3 defdecode)))
- (1+ (nth 4 defdecode))
+ (prog1 (1+ (nth 4 defdecode)) (setq futurep t))
(nth 4 defdecode)))
year (or (nth 5 tl)
(if (and org-read-date-prefer-future
(nth 4 tl) (< (nth 4 tl) (nth 4 defdecode)))
- (1+ (nth 5 defdecode))
+ (prog1 (1+ (nth 5 defdecode)) (setq futurep t))
(nth 5 defdecode)))
hour (or (nth 2 tl) (nth 2 defdecode))
minute (or (nth 1 tl) (nth 1 defdecode))
second (or (nth 0 tl) 0)
wday (nth 6 tl))
+ (when (and (eq org-read-date-prefer-future 'time)
+ (not (nth 3 tl)) (not (nth 4 tl)) (not (nth 5 tl))
+ (equal day (nth 3 defdecode))
+ (equal month (nth 4 defdecode))
+ (equal year (nth 5 defdecode))
+ (nth 2 tl)
+ (or (< (nth 2 tl) (nth 2 defdecode))
+ (and (= (nth 2 tl) (nth 2 defdecode))
+ (nth 1 tl)
+ (< (nth 1 tl) (nth 1 defdecode)))))
+ (setq day (1+ day)
+ futurep t))
+
;; Special date definitions below
(cond
(iso-week
;; There was an iso week
+ (setq futurep nil)
(setq year (or iso-year year)
day (or iso-weekday wday 1)
wday nil ; to make sure that the trigger below does not match
year (nth 2 iso-date)
day (nth 1 iso-date)))
(deltan
+ (setq futurep nil)
(unless deltadef
(let ((now (decode-time (current-time))))
(setq day (nth 3 now) month (nth 4 now) year (nth 5 now))))
((equal deltaw "m") (setq month (+ month deltan)))
((equal deltaw "y") (setq year (+ year deltan)))))
((and wday (not (nth 3 tl)))
+ (setq futurep nil)
;; 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))))
(setq org-time-was-given t))
(if (< year 100) (setq year (+ 2000 year)))
(if (< year 1970) (setq year (nth 5 defdecode))) ; not representable
+ (setq org-read-date-analyze-futurep futurep)
(list second minute hour day month year)))
(defvar parse-time-weekdays)
(defun org-eval-in-calendar (form &optional keepdate)
"Eval FORM in the calendar window and return to current window.
Also, store the cursor date in variable org-ans2."
- (let ((sw (selected-window)))
- (select-window (get-buffer-window "*Calendar*"))
+ (let ((sf (selected-frame))
+ (sw (selected-window)))
+ (select-window (get-buffer-window "*Calendar*" t))
(eval form)
(when (and (not keepdate) (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 org-ans2 (format-time-string "%Y-%m-%d" time))))
(org-move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer))
- (select-window sw)))
+ (select-window sw)
+ (org-select-frame-set-input-focus sf)))
(defun org-calendar-select ()
"Return to `org-read-date' with the date currently selected.
t1 w1 with-hm tf time str w2 (off 0))
(save-match-data
(setq t1 (org-parse-time-string ts t))
- (if (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[dwmy]\\)?\\'" ts)
+ (if (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[dwmy]\\(/[0-9]+[dwmy]\\)?\\)?\\'" ts)
(setq off (- (match-end 0) (match-beginning 0)))))
(setq end (- end off))
(setq w1 (- end beg)
((<= org-deadline-warning-days 0)
;; 0 or negative, enforce this value no matter what
(- org-deadline-warning-days))
- ((string-match "-\\([0-9]+\\)\\([dwmy]\\)\\(\\'\\|>\\)" ts)
+ ((string-match "-\\([0-9]+\\)\\([dwmy]\\)\\(\\'\\|>\\| \\)" ts)
;; lead time is specified.
(floor (* (string-to-number (match-string 1 ts))
(cdr (assoc (match-string 2 ts)
(message "%d entries before %s"
(org-occur regexp nil callback) date)))
+(defun org-check-after-date (date)
+ "Check if there are deadlines or scheduled entries after DATE."
+ (interactive (list (org-read-date)))
+ (let ((case-fold-search nil)
+ (regexp (concat "\\<\\(" org-deadline-string
+ "\\|" org-scheduled-string
+ "\\) *<\\([^>]+\\)>"))
+ (callback
+ (lambda () (not
+ (time-less-p
+ (org-time-string-to-time (match-string 2))
+ (org-time-string-to-time date))))))
+ (message "%d entries after %s"
+ (org-occur regexp nil callback) date)))
+
(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
(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))
+ (t1 (org-float-time time1))
+ (t2 (org-float-time time2))
(diff (abs (- t2 t1)))
(negative (< (- t2 t1) 0))
;; (ys (floor (* 365 24 60 60)))
(defun org-time-string-to-time (s)
(apply 'encode-time (org-parse-time-string s)))
+(defun org-time-string-to-seconds (s)
+ (org-float-time (org-time-string-to-time s)))
(defun org-time-string-to-absolute (s &optional daynr prefer show-all)
"Convert a time stamp to an absolute day number.
If there is a specifyer for a cyclic time stamp, get the closest date to
DAYNR.
-PREFER and SHOW-ALL are passed through to `org-closest-date'."
+PREFER and SHOW-ALL are passed through to `org-closest-date'.
+the variable date is bound by the calendar when this is called."
(cond
((and daynr (string-match "\\`%%\\((.*)\\)" s))
(if (org-diary-sexp-entry (match-string 1 s) "" date)
(tmpfile (make-temp-name
(expand-file-name "orgics" tmpdir)))
buf rtn b e)
- (save-excursion
- (set-buffer frombuf)
+ (with-current-buffer frombuf
(icalendar-export-region (point-min) (point-max) tmpfile)
(setq buf (find-buffer-visiting tmpfile))
(set-buffer buf)
(setq n0 n1 n1 (min n1 n2) n2 (max n0 n2))
(if show-all
(cond
- ((eq prefer 'past) n1)
+ ((eq prefer 'past) (if (= cday n2) n2 n1))
((eq prefer 'future) (if (= cday n1) n1 n2))
(t (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1)))
(cond
- ((eq prefer 'past) n1)
+ ((eq prefer 'past) (if (= cday n2) n2 n1))
((eq prefer 'future) (if (= cday n1) n1 n2))
(t (if (= cday n1) n1 n2)))))))
(string-to-number (match-string 3 s))
(string-to-number (match-string 2 s))
nil nil nil)
- (make-list 9 0)))
+ (error "Not a standard Org-mode time string: %s" s)))
(defun org-timestamp-up (&optional arg)
"Increase the date item at the cursor by one.
ts (match-string 0))
(replace-match "")
(if (string-match
- "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?[-+][0-9]+[dwmy]\\)*\\)[]>]"
+ "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?[-+][0-9]+[dwmy]\\(/[0-9]+[dwmy]\\)?\\)*\\)[]>]"
ts)
(setq extra (match-string 1 ts)))
(if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts)
(+ (if (eq org-ts-what 'month) n 0) (nth 4 time0))
(+ (if (eq org-ts-what 'year) n 0) (nth 5 time0))
(nthcdr 6 time0)))
+ (when (and (member org-ts-what '(hour minute))
+ extra
+ (string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra))
+ (setq extra (org-modify-ts-extra
+ extra
+ (if (eq org-ts-what 'hour) 2 5)
+ n dm)))
(when (integerp org-ts-what)
(setq extra (org-modify-ts-extra extra org-ts-what n dm)))
(if (eq what 'calendar)
(format org-time-clocksum-format h m)))
(defun org-hh:mm-string-to-minutes (s)
- "Convert a string H:MM to a number of minutes."
- (if (string-match "\\([0-9]+\\):\\([0-9]+\\)" s)
- (+ (* (string-to-number (match-string 1 s)) 60)
- (string-to-number (match-string 2 s)))
- 0))
+ "Convert a string H:MM to a number of minutes.
+If the string is just a number, interpret it as minutes.
+In fact, the first hh:mm or number in the string will be taken,
+there can be extra stuff in the string.
+If no number is found, the return value is 0."
+ (cond
+ ((string-match "\\([0-9]+\\):\\([0-9]+\\)" s)
+ (+ (* (string-to-number (match-string 1 s)) 60)
+ (string-to-number (match-string 2 s))))
+ ((string-match "\\([0-9]+\\)" s)
+ (string-to-number (match-string 1 s)))
+ (t 0)))
-;;;; Agenda files
+;;;; Files
-;;;###autoload
-(defun org-iswitchb (&optional arg)
- "Use `iswitchb-read-buffer' to prompt for an Org buffer to switch to.
-With a prefix argument, restrict available to files.
-With two prefix arguments, restrict available buffers to agenda files.
+(defun org-save-all-org-buffers ()
+ "Save all Org-mode buffers without user confirmation."
+ (interactive)
+ (message "Saving all Org-mode buffers...")
+ (save-some-buffers t 'org-mode-p)
+ (when (featurep 'org-id) (org-id-locations-save))
+ (message "Saving all Org-mode buffers... done"))
+
+(defun org-revert-all-org-buffers ()
+ "Revert all Org-mode buffers.
+Prompt for confirmation when there are unsaved changes.
+Be sure you know what you are doing before letting this function
+overwrite your changes.
+
+This function is useful in a setup where one tracks org files
+with a version control system, to revert on one machine after pulling
+changes from another. I believe the procedure must be like this:
+
+1. M-x org-save-all-org-buffers
+2. Pull changes from the other machine, resolve conflicts
+3. M-x org-revert-all-org-buffers"
+ (interactive)
+ (unless (yes-or-no-p "Revert all Org buffers from their files? ")
+ (error "Abort"))
+ (save-excursion
+ (save-window-excursion
+ (mapc
+ (lambda (b)
+ (when (and (with-current-buffer b (org-mode-p))
+ (with-current-buffer b buffer-file-name))
+ (switch-to-buffer b)
+ (revert-buffer t 'no-confirm)))
+ (buffer-list))
+ (when (and (featurep 'org-id) org-id-track-globally)
+ (org-id-locations-load)))))
-Due to some yet unresolved reason, the global function
-`iswitchb-mode' needs to be active for this function to work."
- (interactive "P")
- (require 'iswitchb)
- (let ((enabled iswitchb-mode) blist)
- (or enabled (iswitchb-mode 1))
- (setq blist (cond ((equal arg '(4)) (org-buffer-list 'files))
- ((equal arg '(16)) (org-buffer-list 'agenda))
- (t (org-buffer-list))))
- (unwind-protect
- (let ((iswitchb-make-buflist-hook
- (lambda ()
- (setq iswitchb-temp-buflist
- (mapcar 'buffer-name blist)))))
- (switch-to-buffer
- (iswitchb-read-buffer
- "Switch-to: " nil t))
- (or enabled (iswitchb-mode -1))))))
+;;;; Agenda files
;;;###autoload
-(defun org-ido-switchb (&optional arg)
- "Use `org-ido-completing-read' to prompt for an Org buffer to switch to.
+(defun org-iswitchb (&optional arg)
+ "Use `org-icompleting-read' to prompt for an Org buffer to switch to.
With a prefix argument, restrict available to files.
With two prefix arguments, restrict available buffers to agenda files."
(interactive "P")
((equal arg '(16)) (org-buffer-list 'agenda))
(t (org-buffer-list)))))
(switch-to-buffer
- (org-ido-completing-read "Org buffer: "
- (mapcar 'buffer-name blist)
+ (org-icompleting-read "Org buffer: "
+ (mapcar 'list (mapcar 'buffer-name blist))
nil t))))
+;;;###autoload
+(defalias 'org-ido-switchb 'org-iswitchb)
+
(defun org-buffer-list (&optional predicate exclude-tmp)
"Return a list of Org buffers.
PREDICATE can be `export', `files' or `agenda'.
(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))
+ (let ((org-mode-hook nil) (org-inhibit-startup t)
+ (org-insert-mode-line-in-empty-file nil))
(setq org-agenda-files list)
(customize-save-variable 'org-agenda-files org-agenda-files))))
(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?"
+ (message "non-existent agenda file %s. [R]emove from list or [A]bort?"
(abbreviate-file-name file))
(let ((r (downcase (read-char-exclusive))))
(cond
(save-excursion
(save-restriction
(while (setq file (pop files))
- (if (bufferp file)
- (set-buffer file)
- (org-check-agenda-file file)
- (set-buffer (org-get-agenda-file-buffer file)))
- (widen)
- (setq bmp (buffer-modified-p))
- (org-refresh-category-properties)
- (setq org-todo-keywords-for-agenda
- (append org-todo-keywords-for-agenda org-todo-keywords-1))
- (setq org-done-keywords-for-agenda
- (append org-done-keywords-for-agenda org-done-keywords))
- (setq org-todo-keyword-alist-for-agenda
- (append org-todo-keyword-alist-for-agenda org-todo-key-alist))
- (setq org-tag-alist-for-agenda
- (append org-tag-alist-for-agenda org-tag-alist))
+ (catch 'nextfile
+ (if (bufferp file)
+ (set-buffer file)
+ (org-check-agenda-file file)
+ (set-buffer (org-get-agenda-file-buffer file)))
+ (widen)
+ (setq bmp (buffer-modified-p))
+ (org-refresh-category-properties)
+ (setq org-todo-keywords-for-agenda
+ (append org-todo-keywords-for-agenda org-todo-keywords-1))
+ (setq org-done-keywords-for-agenda
+ (append org-done-keywords-for-agenda org-done-keywords))
+ (setq org-todo-keyword-alist-for-agenda
+ (append org-todo-keyword-alist-for-agenda org-todo-key-alist))
+ (setq org-drawers-for-agenda
+ (append org-drawers-for-agenda org-drawers))
+ (setq org-tag-alist-for-agenda
+ (append org-tag-alist-for-agenda org-tag-alist))
- (save-excursion
- (remove-text-properties (point-min) (point-max) pall)
- (when org-agenda-skip-archived-trees
+ (save-excursion
+ (remove-text-properties (point-min) (point-max) pall)
+ (when org-agenda-skip-archived-trees
+ (goto-char (point-min))
+ (while (re-search-forward rea nil t)
+ (if (org-on-heading-p t)
+ (add-text-properties (point-at-bol) (org-end-of-subtree t) pa))))
(goto-char (point-min))
- (while (re-search-forward rea nil t)
- (if (org-on-heading-p t)
- (add-text-properties (point-at-bol) (org-end-of-subtree t) pa))))
- (goto-char (point-min))
- (setq re (concat "^\\*+ +" org-comment-string "\\>"))
- (while (re-search-forward re nil t)
- (add-text-properties
- (match-beginning 0) (org-end-of-subtree t) pc)))
- (set-buffer-modified-p bmp))))
+ (setq re (concat "^\\*+ +" org-comment-string "\\>"))
+ (while (re-search-forward re nil t)
+ (add-text-properties
+ (match-beginning 0) (org-end-of-subtree t) pc)))
+ (set-buffer-modified-p bmp)))))
(setq org-todo-keyword-alist-for-agenda
(org-uniquify org-todo-keyword-alist-for-agenda)
org-tag-alist-for-agenda (org-uniquify org-tag-alist-for-agenda))))
("$1" "\\([^$]\\)\\(\\$[^ \r\n,;.$]\\$\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil)
("$" "\\([^$]\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil)
("\\(" "\\\\([^\000]*?\\\\)" 0 nil)
- ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 t)
- ("$$" "\\$\\$[^\000]*?\\$\\$" 0 t))
+ ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil)
+ ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil))
"Regular expressions for matching embedded LaTeX.")
(defun org-format-latex (prefix &optional dir overlays msg at forbuffer)
- "Replace LaTeX fragments with links to an image, and produce images."
+ "Replace LaTeX fragments with links to an image, and produce images.
+Some of the options can be changed using the variable
+`org-format-latex-options'."
(if (and overlays (fboundp 'clear-image-cache)) (clear-image-cache))
(let* ((prefixnodir (file-name-nondirectory prefix))
(absprefix (expand-file-name prefix dir))
(opt org-format-latex-options)
(matchers (plist-get opt :matchers))
(re-list org-latex-regexps)
- (cnt 0) txt link beg end re e checkdir
+ (cnt 0) txt hash link beg end re e checkdir
+ executables-checked
m n block linkfile movefile ov)
- ;; Check if there are old images files with this prefix, and remove them
- (when (file-directory-p todir)
- (mapc 'delete-file
- (directory-files
- todir 'full
- (concat (regexp-quote prefixnodir) "_[0-9]+\\.png$"))))
;; Check the different regular expressions
(while (setq e (pop re-list))
(setq m (car e) re (nth 1 e) n (nth 2 e)
(when (member m matchers)
(goto-char (point-min))
(while (re-search-forward re nil t)
- (when (or (not at) (equal (cdr at) (match-beginning n)))
+ (when (and (or (not at) (equal (cdr at) (match-beginning n)))
+ (not (get-text-property (match-beginning n)
+ 'org-protected))
+ (or (not overlays)
+ (not (eq (get-char-property (match-beginning n)
+ 'org-overlay-type)
+ 'org-latex-overlay))))
(setq txt (match-string n)
beg (match-beginning n) end (match-end n)
cnt (1+ cnt)
- linkfile (format "%s_%04d.png" prefix cnt)
- movefile (format "%s_%04d.png" absprefix cnt)
link (concat block "[[file:" linkfile "]]" block))
+ (let (print-length print-level) ; make sure full list is printed
+ (setq hash (sha1 (prin1-to-string
+ (list org-format-latex-header
+ org-export-latex-packages-alist
+ org-format-latex-options
+ forbuffer txt)))
+ linkfile (format "%s_%s.png" prefix hash)
+ movefile (format "%s_%s.png" absprefix hash)))
(if msg (message msg cnt))
(goto-char beg)
(unless checkdir ; make sure the directory exists
(setq checkdir t)
(or (file-directory-p todir) (make-directory todir)))
- (org-create-formula-image
- txt movefile opt forbuffer)
+
+ (unless executables-checked
+ (org-check-external-command
+ "latex" "needed to convert LaTeX fragments to images")
+ (org-check-external-command
+ "dvipng" "needed to convert LaTeX fragments to images")
+ (setq executables-checked t))
+
+ (unless (file-exists-p movefile)
+ (org-create-formula-image
+ txt movefile opt forbuffer))
(if overlays
(progn
+ (mapc (lambda (o)
+ (if (eq (org-overlay-get o 'org-overlay-type)
+ 'org-latex-overlay)
+ (org-delete-overlay o)))
+ (org-overlays-in beg end))
(setq ov (org-make-overlay beg end))
+ (org-overlay-put ov 'org-overlay-type 'org-latex-overlay)
(if (featurep 'xemacs)
(progn
(org-overlay-put ov 'invisible t)
;; This function borrows from Ganesh Swami's latex2png.el
(defun org-create-formula-image (string tofile options buffer)
+ "This calls dvipng."
+ (require 'org-latex)
(let* ((tmpdir (if (featurep 'xemacs)
(temp-directory)
temporary-file-directory))
(if (eq bg 'default) (setq bg (org-dvipng-color :background)))
(with-temp-file texfile
(insert org-format-latex-header
+ (if org-export-latex-packages-alist
+ (concat "\n"
+ (mapconcat (lambda(p)
+ (if (equal "" (car p))
+ (format "\\usepackage{%s}" (cadr p))
+ (format "\\usepackage[%s]{%s}"
+ (car p) (cadr p))))
+ org-export-latex-packages-alist "\n"))
+ "")
"\n\\begin{document}\n" string "\n\\end{document}\n"))
(let ((dir default-directory))
(condition-case nil
(progn (message "Failed to create dvi file from %s" texfile) nil)
(condition-case nil
(call-process "dvipng" nil nil nil
- "-E" "-fg" fg "-bg" bg
+ "-fg" fg "-bg" bg
"-D" dpi
;;"-x" scale "-y" scale
"-T" "tight"
(org-defkey org-mode-map [?\C-c (left)] 'org-shiftleft)
(org-defkey org-mode-map [?\C-c (right)] 'org-shiftright)
(org-defkey org-mode-map [?\C-c ?\C-x (right)] 'org-shiftcontrolright)
- (org-defkey org-mode-map [?\C-c ?\C-x (left)] 'org-shiftcontrolleft))
+ (org-defkey org-mode-map [?\C-c ?\C-x (left)] 'org-shiftcontrolleft)
+ (org-defkey org-mode-map [?\e (tab)] 'org-complete)
+ (org-defkey org-mode-map [?\e (shift return)] 'org-insert-todo-heading)
+ (org-defkey org-mode-map [?\e (shift left)] 'org-shiftmetaleft)
+ (org-defkey org-mode-map [?\e (shift right)] 'org-shiftmetaright)
+ (org-defkey org-mode-map [?\e (shift up)] 'org-shiftmetaup)
+ (org-defkey org-mode-map [?\e (shift down)] 'org-shiftmetadown))
;; All the other keys
(if (boundp 'narrow-map)
(org-defkey narrow-map "s" 'org-narrow-to-subtree)
(org-defkey org-mode-map "\C-xns" 'org-narrow-to-subtree))
+(org-defkey org-mode-map "\C-c\C-f" 'org-forward-same-level)
+(org-defkey org-mode-map "\C-c\C-b" 'org-backward-same-level)
(org-defkey org-mode-map "\C-c$" 'org-archive-subtree)
(org-defkey org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree)
-(org-defkey org-mode-map "\C-c\C-x\C-a" 'org-toggle-archive-tag)
+(org-defkey org-mode-map "\C-c\C-x\C-a" 'org-archive-subtree-default)
(org-defkey org-mode-map "\C-c\C-xa" 'org-toggle-archive-tag)
(org-defkey org-mode-map "\C-c\C-xA" 'org-archive-to-archive-sibling)
(org-defkey org-mode-map "\C-c\C-xb" 'org-tree-to-indirect-buffer)
(org-defkey org-mode-map "\C-c\C-v" 'org-show-todo-tree)
(org-defkey org-mode-map "\C-c\C-w" 'org-refile)
(org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved
-(org-defkey org-mode-map "\C-c\\" 'org-tags-sparse-tree) ; Minor-mode res.
+(org-defkey org-mode-map "\C-c\\" 'org-match-sparse-tree) ; Minor-mode res.
(org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret)
(org-defkey org-mode-map "\M-\C-m" 'org-insert-heading)
+(org-defkey org-mode-map "\C-c\C-xc" 'org-clone-subtree-with-time-shift)
(org-defkey org-mode-map [(control return)] 'org-insert-heading-respect-content)
(org-defkey org-mode-map [(shift control return)] 'org-insert-todo-heading-respect-content)
(org-defkey org-mode-map "\C-c\C-x\C-n" 'org-next-link)
(org-defkey org-mode-map "\C-c^" 'org-sort)
(org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c)
(org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches)
-(org-defkey org-mode-map "\C-c#" 'org-update-checkbox-count)
+(org-defkey org-mode-map "\C-c#" 'org-update-statistics-cookies)
(org-defkey org-mode-map "\C-m" 'org-return)
(org-defkey org-mode-map "\C-j" 'org-return-indent)
(org-defkey org-mode-map "\C-c?" 'org-table-field-info)
(org-defkey org-mode-map "\C-c\C-e" 'org-export)
(org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width-section)
(org-defkey org-mode-map "\C-c\C-x\C-f" 'org-emphasize)
-(org-defkey org-mode-map "\C-c\C-xf" 'org-footnote-action)
+(org-defkey org-mode-map "\C-c\C-xf" 'org-footnote-action)
+(org-defkey org-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull)
+(org-defkey org-mode-map "\C-c\C-x\C-mp" 'org-mobile-push)
+(org-defkey org-mode-map [?\C-c (control ?*)] 'org-list-make-subtree)
+;;(org-defkey org-mode-map [?\C-c (control ?-)] 'org-list-make-list-from-subtree)
(org-defkey org-mode-map "\C-c\C-x\C-k" 'org-mark-entry-for-agenda-action)
(org-defkey org-mode-map "\C-c\C-x\C-w" 'org-cut-special)
(org-defkey org-mode-map "\C-c\C-x\C-l" 'org-preview-latex-fragment)
(org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox)
(org-defkey org-mode-map "\C-c\C-xp" 'org-set-property)
+(org-defkey org-mode-map "\C-c\C-xe" 'org-set-effort)
(org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property)
(org-defkey org-mode-map "\C-c\C-xi" 'org-insert-columns-dblock)
+(org-defkey org-mode-map [(control ?c) (control ?x) ?\;] 'org-timer-set-timer)
(org-defkey org-mode-map "\C-c\C-x." 'org-timer)
(org-defkey org-mode-map "\C-c\C-x-" 'org-timer-item)
(define-key org-mode-map "\C-c\C-x\C-c" 'org-columns)
+(define-key org-mode-map "\C-c\C-x!" 'org-reload)
+
+(define-key org-mode-map "\C-c\C-xg" 'org-feed-update-all)
+(define-key org-mode-map "\C-c\C-xG" 'org-feed-goto-inbox)
+
+(define-key org-mode-map "\C-c\C-x[" 'org-reftex-citation)
+
+
(when (featurep 'xemacs)
(org-defkey org-mode-map 'button3 'popup-mode-menu))
+
+(defconst org-speed-commands-default
+ '(
+ ("Outline Navigation")
+ ("n" . (org-speed-move-safe 'outline-next-visible-heading))
+ ("p" . (org-speed-move-safe 'outline-previous-visible-heading))
+ ("f" . (org-speed-move-safe 'org-forward-same-level))
+ ("b" . (org-speed-move-safe 'org-backward-same-level))
+ ("u" . (org-speed-move-safe 'outline-up-heading))
+ ("j" . org-goto)
+ ("g" . (org-refile t))
+ ("Outline Visibility")
+ ("c" . org-cycle)
+ ("C" . org-shifttab)
+ (" " . org-display-outline-path)
+ ("Outline Structure Editing")
+ ("U" . org-shiftmetaup)
+ ("D" . org-shiftmetadown)
+ ("r" . org-metaright)
+ ("l" . org-metaleft)
+ ("R" . org-shiftmetaright)
+ ("L" . org-shiftmetaleft)
+ ("i" . (progn (forward-char 1) (call-interactively
+ 'org-insert-heading-respect-content)))
+ ("^" . org-sort)
+ ("w" . org-refile)
+ ("a" . org-archive-subtree-default-with-confirmation)
+ ("." . outline-mark-subtree)
+ ("Clock Commands")
+ ("I" . org-clock-in)
+ ("O" . org-clock-out)
+ ("Meta Data Editing")
+ ("t" . org-todo)
+ ("0" . (org-priority ?\ ))
+ ("1" . (org-priority ?A))
+ ("2" . (org-priority ?B))
+ ("3" . (org-priority ?C))
+ (";" . org-set-tags-command)
+ ("e" . org-set-effort)
+ ("Agenda Views etc")
+ ("v" . org-agenda)
+ ("/" . org-sparse-tree)
+ ("Misc")
+ ("o" . org-open-at-point)
+ ("?" . org-speed-command-help)
+ )
+ "The default speed commands.")
+
+(defun org-print-speed-command (e)
+ (if (> (length (car e)) 1)
+ (progn
+ (princ "\n")
+ (princ (car e))
+ (princ "\n")
+ (princ (make-string (length (car e)) ?-))
+ (princ "\n"))
+ (princ (car e))
+ (princ " ")
+ (if (symbolp (cdr e))
+ (princ (symbol-name (cdr e)))
+ (prin1 (cdr e)))
+ (princ "\n")))
+
+(defun org-speed-command-help ()
+ "Show the available speed commands."
+ (interactive)
+ (if (not org-use-speed-commands)
+ (error "Speed commands are not activated, customize `org-use-speed-commands'")
+ (with-output-to-temp-buffer "*Help*"
+ (princ "User-defined Speed commands\n===========================\n")
+ (mapc 'org-print-speed-command org-speed-commands-user)
+ (princ "\n")
+ (princ "Built-in Speed commands\n=======================\n")
+ (mapc 'org-print-speed-command org-speed-commands-default))
+ (with-current-buffer "*Help*"
+ (setq truncate-lines t))))
+
+(defun org-speed-move-safe (cmd)
+ "Execute CMD, but make sure that the cursor always ends up in a headline.
+If not, return to the original position and throw an error."
+ (interactive)
+ (let ((pos (point)))
+ (call-interactively cmd)
+ (unless (and (bolp) (org-on-heading-p))
+ (goto-char pos)
+ (error "Boundary reached while executing %s" cmd))))
+
+(defvar org-self-insert-command-undo-counter 0)
+
(defvar org-table-auto-blank-field) ; defined in org-table.el
+(defvar org-speed-command nil)
(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 (featurep 'org-table) 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))
+ (cond
+ ((and org-use-speed-commands
+ (or (and (bolp) (looking-at outline-regexp))
+ (and (functionp org-use-speed-commands)
+ (funcall org-use-speed-commands)))
+ (setq
+ org-speed-command
+ (or (cdr (assoc (this-command-keys) org-speed-commands-user))
+ (cdr (assoc (this-command-keys) org-speed-commands-default)))))
+ (cond
+ ((commandp org-speed-command)
+ (setq this-command org-speed-command)
+ (call-interactively org-speed-command))
+ ((functionp org-speed-command)
+ (funcall org-speed-command))
+ ((and org-speed-command (listp org-speed-command))
+ (eval org-speed-command))
+ (t (let (org-use-speed-commands)
+ (call-interactively 'org-self-insert-command)))))
+ ((and
+ (org-table-p)
+ (progn
+ ;; check if we blank the field, and if that triggers align
+ (and (featurep 'org-table) org-table-auto-blank-field
+ (member last-command
+ '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c yas/expand))
+ (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)))
+ (t
(setq org-table-may-need-update t)
(self-insert-command N)
- (org-fix-tags-on-the-fly)))
+ (org-fix-tags-on-the-fly)
+ (if org-self-insert-cluster-for-undo
+ (if (not (eq last-command 'org-self-insert-command))
+ (setq org-self-insert-command-undo-counter 1)
+ (if (>= org-self-insert-command-undo-counter 20)
+ (setq org-self-insert-command-undo-counter 1)
+ (and (> org-self-insert-command-undo-counter 0)
+ buffer-undo-list
+ (not (cadr buffer-undo-list)) ; remove nil entry
+ (setcdr buffer-undo-list (cddr buffer-undo-list)))
+ (setq org-self-insert-command-undo-counter
+ (1+ org-self-insert-command-undo-counter))))))))
(defun org-fix-tags-on-the-fly ()
(when (and (equal (char-after (point-at-bol)) ?*)
'delete-backward-char 'org-delete-backward-char)
(org-defkey org-mode-map "|" 'org-force-self-insert))
+(defvar org-ctrl-c-ctrl-c-hook nil
+ "Hook for functions attaching themselves to `C-c C-c'.
+This can be used to add additional functionality to the C-c C-c key which
+executes context-dependent commands.
+Each function will be called with no arguments. The function must check
+if the context is appropriate for it to act. If yes, it should do its
+thing and then return a non-nil value. If the context is wrong,
+just do nothing and return nil.")
+
+(defvar org-tab-first-hook nil
+ "Hook for functions to attach themselves to TAB.
+See `org-ctrl-c-ctrl-c-hook' for more information.
+This hook runs as the first action when TAB is pressed, even before
+`org-cycle' messes around with the `outline-regexp' to cater for
+inline tasks and plain list item folding.
+If any function in this hook returns t, not other actions like table
+field motion visibility cycling will be done.")
+
+(defvar org-tab-after-check-for-table-hook nil
+ "Hook for functions to attach themselves to TAB.
+See `org-ctrl-c-ctrl-c-hook' for more information.
+This hook runs after it has been established that the cursor is not in a
+table, but before checking if the cursor is in a headline or if global cycling
+should be done.
+If any function in this hook returns t, not other actions like visibility
+cycling will be done.")
+
+(defvar org-tab-after-check-for-cycling-hook nil
+ "Hook for functions to attach themselves to TAB.
+See `org-ctrl-c-ctrl-c-hook' for more information.
+This hook runs after it has been established that not table field motion and
+not visibility should be done because of current context. This is probably
+the place where a package like yasnippets can hook in.")
+
+(defvar org-tab-before-tab-emulation-hook nil
+ "Hook for functions to attach themselves to TAB.
+See `org-ctrl-c-ctrl-c-hook' for more information.
+This hook runs after every other options for TAB have been exhausted, but
+before indentation and \t insertion takes place.")
+
+(defvar org-metaleft-hook nil
+ "Hook for functions attaching themselves to `M-left'.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-metaright-hook nil
+ "Hook for functions attaching themselves to `M-right'.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-metaup-hook nil
+ "Hook for functions attaching themselves to `M-up'.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-metadown-hook nil
+ "Hook for functions attaching themselves to `M-down'.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-shiftmetaleft-hook nil
+ "Hook for functions attaching themselves to `M-S-left'.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-shiftmetaright-hook nil
+ "Hook for functions attaching themselves to `M-S-right'.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-shiftmetaup-hook nil
+ "Hook for functions attaching themselves to `M-S-up'.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-shiftmetadown-hook nil
+ "Hook for functions attaching themselves to `M-S-down'.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-metareturn-hook nil
+ "Hook for functions attaching themselves to `M-RET'.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
+
(defun org-modifier-cursor-error ()
"Throw an error, a modified cursor command was applied in wrong context."
(error "This command is active in special context like tables, headlines or items"))
(defun org-shiftselect-error ()
"Throw an error because Shift-Cursor command was applied in wrong context."
(if (and (boundp 'shift-select-mode) shift-select-mode)
- (error "To use shift-selection with Org-mode, customize `org-support-shift-select'.")
- (error "This command works only in special context like headlines or timestamps.")))
+ (error "To use shift-selection with Org-mode, customize `org-support-shift-select'")
+ (error "This command works only in special context like headlines or timestamps")))
(defun org-call-for-shift-select (cmd)
(let ((this-command-keys-shift-translated t))
(cond
((org-at-table-p) (call-interactively 'org-table-previous-field))
((integerp arg)
- (message "Content view to level: %d" arg)
- (org-content (prefix-numeric-value arg))
- (setq org-cycle-global-status 'overview))
+ (let ((arg2 (if org-odd-levels-only (1- (* 2 arg)) arg)))
+ (message "Content view to level: %d" arg)
+ (org-content (prefix-numeric-value arg2))
+ (setq org-cycle-global-status 'overview)))
(t (call-interactively 'org-global-cycle))))
(defun org-shiftmetaleft ()
See the individual commands for more information."
(interactive)
(cond
+ ((run-hook-with-args-until-success 'org-shiftmetaleft-hook))
((org-at-table-p) (call-interactively 'org-table-delete-column))
((org-on-heading-p) (call-interactively 'org-promote-subtree))
((org-at-item-p) (call-interactively 'org-outdent-item))
See the individual commands for more information."
(interactive)
(cond
+ ((run-hook-with-args-until-success 'org-shiftmetaright-hook))
((org-at-table-p) (call-interactively 'org-table-insert-column))
((org-on-heading-p) (call-interactively 'org-demote-subtree))
((org-at-item-p) (call-interactively 'org-indent-item))
for more information."
(interactive "P")
(cond
+ ((run-hook-with-args-until-success 'org-shiftmetaup-hook))
((org-at-table-p) (call-interactively 'org-table-kill-row))
((org-on-heading-p) (call-interactively 'org-move-subtree-up))
((org-at-item-p) (call-interactively 'org-move-item-up))
(t (org-modifier-cursor-error))))
+
(defun org-shiftmetadown (&optional arg)
"Move subtree down or insert table row.
Calls `org-move-subtree-down' or `org-table-insert-row' or
commands for more information."
(interactive "P")
(cond
+ ((run-hook-with-args-until-success 'org-shiftmetadown-hook))
((org-at-table-p) (call-interactively 'org-table-insert-row))
((org-on-heading-p) (call-interactively 'org-move-subtree-down))
((org-at-item-p) (call-interactively 'org-move-item-down))
See the individual commands for more information."
(interactive "P")
(cond
+ ((run-hook-with-args-until-success 'org-metaleft-hook))
((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left))
- ((or (org-on-heading-p) (org-region-active-p))
+ ((or (org-on-heading-p)
+ (and (org-region-active-p)
+ (save-excursion
+ (goto-char (region-beginning))
+ (org-on-heading-p))))
(call-interactively 'org-do-promote))
- ((org-at-item-p) (call-interactively 'org-outdent-item))
+ ((or (org-at-item-p)
+ (and (org-region-active-p)
+ (save-excursion
+ (goto-char (region-beginning))
+ (org-at-item-p))))
+ (call-interactively 'org-outdent-item))
(t (call-interactively 'backward-word))))
(defun org-metaright (&optional arg)
See the individual commands for more information."
(interactive "P")
(cond
+ ((run-hook-with-args-until-success 'org-metaright-hook))
((org-at-table-p) (call-interactively 'org-table-move-column))
- ((or (org-on-heading-p) (org-region-active-p))
+ ((or (org-on-heading-p)
+ (and (org-region-active-p)
+ (save-excursion
+ (goto-char (region-beginning))
+ (org-on-heading-p))))
(call-interactively 'org-do-demote))
- ((org-at-item-p) (call-interactively 'org-indent-item))
+ ((or (org-at-item-p)
+ (and (org-region-active-p)
+ (save-excursion
+ (goto-char (region-beginning))
+ (org-at-item-p))))
+ (call-interactively 'org-indent-item))
(t (call-interactively 'forward-word))))
(defun org-metaup (&optional arg)
for more information."
(interactive "P")
(cond
+ ((run-hook-with-args-until-success 'org-metaup-hook))
((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up))
((org-on-heading-p) (call-interactively 'org-move-subtree-up))
((org-at-item-p) (call-interactively 'org-move-item-up))
commands for more information."
(interactive "P")
(cond
+ ((run-hook-with-args-until-success 'org-metadown-hook))
((org-at-table-p) (call-interactively 'org-table-move-row))
((org-on-heading-p) (call-interactively 'org-move-subtree-down))
((org-at-item-p) (call-interactively 'org-move-item-down))
(call-interactively (if org-edit-timestamp-down-means-later
'org-timestamp-down 'org-timestamp-up)))
((and (not (eq org-support-shift-select 'always))
+ org-enable-priority-commands
(org-on-heading-p))
(call-interactively 'org-priority-up))
((and (not org-support-shift-select) (org-at-item-p))
(call-interactively (if org-edit-timestamp-down-means-later
'org-timestamp-up 'org-timestamp-down)))
((and (not (eq org-support-shift-select 'always))
+ org-enable-priority-commands
(org-on-heading-p))
(call-interactively 'org-priority-down))
((and (not org-support-shift-select) (org-at-item-p))
(call-interactively 'org-next-item))
((org-clocktable-try-shift 'down arg))
- (org-support-shift-select
+ (org-support-shift-select
(org-call-for-shift-select 'next-line))
(t (org-shiftselect-error))))
((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day))
((and (not (eq org-support-shift-select 'always))
(org-on-heading-p))
- (org-call-with-arg 'org-todo 'right))
+ (let ((org-inhibit-logging
+ (not org-treat-S-cursor-todo-selection-as-state-change))
+ (org-inhibit-blocking
+ (not org-treat-S-cursor-todo-selection-as-state-change)))
+ (org-call-with-arg 'org-todo 'right)))
((or (and org-support-shift-select
(not (eq org-support-shift-select 'always))
(org-at-item-bullet-p))
(org-at-property-p))
(call-interactively 'org-property-next-allowed-value))
((org-clocktable-try-shift 'right arg))
- (org-support-shift-select
+ (org-support-shift-select
(org-call-for-shift-select 'forward-char))
(t (org-shiftselect-error))))
((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day))
((and (not (eq org-support-shift-select 'always))
(org-on-heading-p))
- (org-call-with-arg 'org-todo 'left))
+ (let ((org-inhibit-logging
+ (not org-treat-S-cursor-todo-selection-as-state-change))
+ (org-inhibit-blocking
+ (not org-treat-S-cursor-todo-selection-as-state-change)))
+ (org-call-with-arg 'org-todo 'left)))
((or (and org-support-shift-select
(not (eq org-support-shift-select 'always))
(org-at-item-bullet-p))
(org-at-property-p))
(call-interactively 'org-property-previous-allowed-value))
((org-clocktable-try-shift 'left arg))
- (org-support-shift-select
+ (org-support-shift-select
(org-call-for-shift-select 'backward-char))
(t (org-shiftselect-error))))
((org-edit-fixed-width-region))
(t (call-interactively 'ffap))))
+
(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 a function in `org-ctrl-c-ctrl-c-hook' recognizes this location,
+ this is what we do.
+
+- If the cursor is on a statistics cookie, update it.
+
- 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.
((and (local-variable-p 'org-finish-function (current-buffer))
(fboundp org-finish-function))
(funcall org-finish-function))
+ ((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook))
((org-at-property-p)
(call-interactively 'org-property-action))
((org-on-target-p) (call-interactively 'org-update-radio-target-regexp))
+ ((and (org-in-regexp "\\[\\([0-9]*%\\|[0-9]*/[0-9]*\\)\\]")
+ (or (org-on-heading-p) (org-at-item-p)))
+ (call-interactively 'org-update-statistics-cookies))
((org-on-heading-p) (call-interactively 'org-set-tags))
((org-at-table.el-p)
(require 'table)
((org-at-item-checkbox-p)
(call-interactively 'org-toggle-checkbox))
((org-at-item-p)
- (call-interactively 'org-maybe-renumber-ordered-list))
- ((save-excursion (beginning-of-line 1) (looking-at "#\\+BEGIN:"))
+ (if arg
+ (call-interactively 'org-toggle-checkbox)
+ (call-interactively 'org-maybe-renumber-ordered-list)))
+ ((save-excursion (beginning-of-line 1) (looking-at org-dblock-start-re))
;; Dynamic block
(beginning-of-line 1)
(save-excursion (org-update-dblock)))
- ((save-excursion (beginning-of-line 1) (looking-at "#\\+\\([A-Z]+\\)"))
+ ((save-excursion
+ (beginning-of-line 1)
+ (looking-at "[ \t]*#\\+\\([A-Z]+\\)"))
(cond
((equal (match-string 1) "TBLFM")
;; Recalculate the table before this line
(beginning-of-line 1)
(skip-chars-backward " \r\n\t")
(if (org-at-table-p)
- (org-call-with-arg 'org-table-recalculate t))))
+ (org-call-with-arg 'org-table-recalculate (or arg t)))))
(t
; (org-set-regexps-and-options)
; (org-restart-font-lock)
(let ((org-inhibit-startup t)) (org-mode-restart))
(message "Local setup has been refreshed"))))
- (t (error "C-c C-c can do nothing useful at this location.")))))
+ ((org-clock-update-time-maybe))
+ (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.
(interactive)
(cond
((bobp) (if indent (newline-and-indent) (newline)))
+ ((org-at-table-p)
+ (org-table-justify-field-maybe)
+ (call-interactively 'org-table-next-row))
+ ((and org-return-follows-link
+ (eq (get-text-property (point) 'face) 'org-link))
+ (call-interactively 'org-open-at-point))
((and (org-at-heading-p)
(looking-at
(org-re "\\([ \t]+\\(:[[:alnum:]_@:]+:\\)\\)[ \t]*$")))
(org-show-entry)
(end-of-line 1)
(newline))
- ((org-at-table-p)
- (org-table-justify-field-maybe)
- (call-interactively 'org-table-next-row))
(t (if indent (newline-and-indent) (newline)))))
(defun org-return-indent ()
If the first line is a heading, remove the stars from all headlines
in the region.
-If the first line is a plain list item, turn all plain list items into
-headings.
+If the first line is a plain list item, turn all plain list items
+into headings.
-If the first line is a normal line, turn each and every line in the region
-into a heading.
+If the first line is a normal line, turn each and every line in the
+region into a heading.
When converting a line into a heading, the number of stars is chosen
-such that the lines become children of the current entry. However, when
-a prefix argument is given, its value determines the number of stars to add."
+such that the lines become children of the current entry. However,
+when a prefix argument is given, its value determines the number of
+stars to add."
(interactive "P")
(let (l2 l itemp beg end)
(if (org-region-active-p)
(make-string (prefix-numeric-value current-prefix-arg)
?*)
(save-excursion
- (re-search-backward org-complex-heading-regexp nil t)
- (or (match-string 1) "*"))))
- (add-stars (if nstars "" (if org-odd-levels-only "**" "*")))
+ (if (re-search-backward org-complex-heading-regexp nil t)
+ (match-string 1) ""))))
+ (add-stars (cond (nstars "")
+ ((equal stars "") "*")
+ (org-odd-levels-only "**")
+ (t "*")))
(rpl (concat stars add-stars " ")))
(while (< (setq l (1+ l)) l2)
(if itemp
See the individual commands for more information."
(interactive "P")
(cond
+ ((run-hook-with-args-until-success 'org-metareturn-hook))
((org-at-table-p)
(call-interactively 'org-table-wrap-region))
(t (call-interactively 'org-insert-heading))))
["Cut Subtree" org-cut-special (not (org-at-table-p))]
["Paste Subtree" org-paste-special (not (org-at-table-p))]
"--"
+ ["Clone subtree, shift time" org-clone-subtree-with-time-shift t]
+ "--"
["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))]
["Footnote new/jump" org-footnote-action t]
["Footnote extra" (org-footnote-action t) :active t :keys "C-u C-c C-x f"])
("Archive"
- ["Toggle ARCHIVE tag" org-toggle-archive-tag t]
-; ["Check and Tag Children" (org-toggle-archive-tag (4))
-; :active t :keys "C-u C-c C-x C-a"]
- ["Sparse trees open ARCHIVE trees"
- (setq org-sparse-tree-open-archived-trees
- (not org-sparse-tree-open-archived-trees))
- :style toggle :selected org-sparse-tree-open-archived-trees]
- ["Cycling opens ARCHIVE trees"
- (setq org-cycle-open-archived-trees (not org-cycle-open-archived-trees))
- :style toggle :selected org-cycle-open-archived-trees]
+ ["Archive (default method)" org-archive-subtree-default t]
"--"
- ["Move subtree to archive sibling" org-archive-to-archive-sibling t]
- ["Move Subtree to Archive" org-advertized-archive-subtree t]
- ; ["Check and Move Children" (org-archive-subtree '(4))
- ; :active t :keys "C-u C-c C-x C-s"]
+ ["Move Subtree to Archive file" org-advertized-archive-subtree t]
+ ["Toggle ARCHIVE tag" org-toggle-archive-tag t]
+ ["Move subtree to Archive sibling" org-archive-to-archive-sibling t]
)
"--"
+ ("Hyperlinks"
+ ["Store Link (Global)" org-store-link t]
+ ["Find existing link to here" org-occur-link-in-agenda-files t]
+ ["Insert Link" org-insert-link t]
+ ["Follow Link" org-open-at-point t]
+ "--"
+ ["Next link" org-next-link t]
+ ["Previous link" org-previous-link 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))])
+ "--"
("TODO Lists"
["TODO/DONE/-" org-todo t]
("Select keyword"
"--"
["Set Priority" org-priority t]
["Priority Up" org-shiftup t]
- ["Priority Down" org-shiftdown t])
+ ["Priority Down" org-shiftdown t]
+ "--"
+ ["Get news from all feeds" org-feed-update-all t]
+ ["Go to the inbox of a feed..." org-feed-goto-inbox t]
+ ["Customize feeds" (customize-variable 'org-feed-alist) t])
("TAGS and Properties"
["Set Tags" org-set-tags-command t]
["Change tag in region" org-change-tag-in-region (org-region-active-p)]
["Insert Timer String" org-timer t]
["Insert Timer Item" org-timer-item t])
("Logging work"
- ["Clock in" org-clock-in t]
+ ["Clock in" org-clock-in :active t :keys "C-c C-x C-i"]
+ ["Switch task" (lambda () (interactive) (org-clock-in '(4))) :active t :keys "C-u C-c C-x C-i"]
["Clock out" org-clock-out t]
["Clock cancel" org-clock-cancel t]
+ "--"
+ ["Mark as default task" org-clock-mark-default-task t]
+ ["Clock in, mark as default" (lambda () (interactive) (org-clock-in '(16))) :active t :keys "C-u C-u C-c C-x C-i"]
["Goto running clock" org-clock-goto t]
+ "--"
["Display times" org-clock-display t]
["Create clock table" org-clock-report t]
"--"
["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]
- "--"
- ["Next link" org-next-link t]
- ["Previous link" org-previous-link 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))])
+ ["Tags/Property tree" org-match-sparse-tree t])
"--"
["Export/Publish..." org-export t]
("LaTeX"
["Insert math symbol" cdlatex-math-symbol (fboundp 'cdlatex-math-symbol)]
["Modify math symbol" org-cdlatex-math-modify
(org-inside-LaTeX-fragment-p)]
+ ["Insert citation" org-reftex-citation t]
+ "--"
["Export LaTeX fragments as images"
(if (featurep 'org-exp)
(setq org-export-with-LaTeX-fragments
:style toggle :selected (and (boundp 'org-export-with-LaTeX-fragments)
org-export-with-LaTeX-fragments)])
"--"
+ ("MobileOrg"
+ ["Push Files and Views" org-mobile-push t]
+ ["Get Captured and Flagged" org-mobile-pull t]
+ ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "C-c a ?"]
+ "--"
+ ["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t])
+ "--"
("Documentation"
["Show Version" org-version t]
["Info Documentation" org-info t])
"--"
["Expand This Menu" org-create-customize-menu
(fboundp 'customize-menu-create)])
+ ["Send bug report" org-submit-bug-report t]
"--"
- ["Refresh setup" org-mode-restart t]
+ ("Refresh/Reload"
+ ["Refresh setup current buffer" org-mode-restart t]
+ ["Reload Org (after update)" org-reload t]
+ ["Reload Org uncompiled" (org-reload t) :active t :keys "C-u C-c C-x r"])
))
(defun org-info (&optional node)
(interactive)
(info (format "(org)%s" (or node ""))))
+;;;###autoload
+(defun org-submit-bug-report ()
+ "Submit a bug report on Org-mode via mail.
+
+Don't hesitate to report any problems or inaccurate documentation.
+
+If you don't have setup sending mail from (X)Emacs, please copy the
+output buffer into your mail program, as it gives us important
+information about your Org-mode version and configuration."
+ (interactive)
+ (require 'reporter)
+ (org-load-modules-maybe)
+ (org-require-autoloaded-modules)
+ (let ((reporter-prompt-for-summary-p "Bug report subject: "))
+ (reporter-submit-bug-report
+ "emacs-orgmode@gnu.org"
+ (org-version)
+ (let (list)
+ (save-window-excursion
+ (switch-to-buffer (get-buffer-create "*Warn about privacy*"))
+ (delete-other-windows)
+ (erase-buffer)
+ (insert "You are about to submit a bug report to the Org-mode mailing list.
+
+We would like to add your full Org-mode and Outline configuration to the
+bug report. This greatly simplifies the work of the maintainer and
+other experts on the mailing list.
+
+HOWEVER, some variables you have customized may contain private
+information. The names of customers, colleagues, or friends, might
+appear in the form of file names, tags, todo states, or search strings.
+If you answer yes to the prompt, you might want to check and remove
+such private information before sending the email.")
+ (add-text-properties (point-min) (point-max) '(face org-warning))
+ (when (yes-or-no-p "Include your Org-mode configuration ")
+ (mapatoms
+ (lambda (v)
+ (and (boundp v)
+ (string-match "\\`\\(org-\\|outline-\\)" (symbol-name v))
+ (or (and (symbol-value v)
+ (string-match "\\(-hook\\|-function\\)\\'" (symbol-name v)))
+ (and
+ (get v 'custom-type) (get v 'standard-value)
+ (not (equal (symbol-value v) (eval (car (get v 'standard-value)))))))
+ (push v list)))))
+ (kill-buffer (get-buffer "*Warn about privacy*"))
+ list))
+ nil nil
+ "Remember to cover the basics, that is, what you expected to happen and
+what in fact did happen. You don't know how to make a good report? See
+
+ http://orgmode.org/manual/Feedback.html#Feedback
+
+Your bug report will be posted to the Org-mode mailing list.
+------------------------------------------------------------------------")
+ (save-excursion
+ (if (re-search-backward "^\\(Subject: \\)Org-mode version \\(.*?\\);[ \t]*\\(.*\\)" nil t)
+ (replace-match "\\1Bug: \\3 [\\2]")))))
+
+
(defun org-install-agenda-files-menu ()
(let ((bl (buffer-list)))
(save-excursion
(defun org-require-autoloaded-modules ()
(interactive)
(mapc 'require
- '(org-agenda org-archive org-attach org-clock org-colview
- org-exp org-id org-export-latex org-publish
- org-remember org-table org-timer)))
+ '(org-agenda org-archive org-ascii org-attach org-clock org-colview
+ org-docbook org-exp org-html org-icalendar
+ org-id org-latex
+ org-publish org-remember org-table
+ org-timer org-xoxo)))
+
+;;;###autoload
+(defun org-reload (&optional uncompiled)
+ "Reload all org lisp files.
+With prefix arg UNCOMPILED, load the uncompiled versions."
+ (interactive "P")
+ (require 'find-func)
+ (let* ((file-re "^\\(org\\|orgtbl\\)\\(\\.el\\|-.*\\.el\\)")
+ (dir-org (file-name-directory (org-find-library-name "org")))
+ (dir-org-contrib (ignore-errors
+ (file-name-directory
+ (org-find-library-name "org-contribdir"))))
+ (files
+ (append (directory-files dir-org t file-re)
+ (and dir-org-contrib
+ (directory-files dir-org-contrib t file-re))))
+ (remove-re (concat (if (featurep 'xemacs)
+ "org-colview" "org-colview-xemacs")
+ "\\'")))
+ (setq files (mapcar 'file-name-sans-extension files))
+ (setq files (mapcar
+ (lambda (x) (if (string-match remove-re x) nil x))
+ files))
+ (setq files (delq nil files))
+ (mapc
+ (lambda (f)
+ (when (featurep (intern (file-name-nondirectory f)))
+ (if (and (not uncompiled)
+ (file-exists-p (concat f ".elc")))
+ (load (concat f ".elc") nil nil t)
+ (load (concat f ".el") nil nil t))))
+ files))
+ (org-version))
;;;###autoload
(defun org-customize ()
;;; Generally useful functions
+(defun org-get-at-bol (property)
+ "Get text property PROPERTY at beginning of line."
+ (get-text-property (point-at-bol) property))
+
(defun org-find-text-property-in-string (prop s)
"Return the first non-nil value of property PROP in string S."
(or (get-text-property 0 prop s)
(display-buffer buf)
(sit-for 0))))
+(defun org-in-commented-line ()
+ "Is point in a line starting with `#'?"
+ (equal (char-after (point-at-bol)) ?#))
+
+(defun org-in-verbatim-emphasis ()
+ (save-match-data
+ (and (org-in-regexp org-emph-re 2) (member (match-string 3) '("=" "~")))))
+
(defun org-goto-marker-or-bmk (marker &optional bookmark)
"Go to MARKER, widen if necessary. When marker is not live, try BOOKMARK."
(if (and marker (marker-buffer marker)
(concat (make-string i1 ?\ ) l)
l)))
+(defun org-remove-indentation (code &optional n)
+ "Remove the maximum common indentation from the lines in CODE.
+N may optionally be the number of spaces to remove."
+ (with-temp-buffer
+ (insert code)
+ (org-do-remove-indentation n)
+ (buffer-string)))
+
+(defun org-do-remove-indentation (&optional n)
+ "Remove the maximum common indentation from the buffer."
+ (untabify (point-min) (point-max))
+ (let ((min 10000) re)
+ (if n
+ (setq min n)
+ (goto-char (point-min))
+ (while (re-search-forward "^ *[^ \n]" nil t)
+ (setq min (min min (1- (- (match-end 0) (match-beginning 0)))))))
+ (unless (or (= min 0) (= min 10000))
+ (setq re (format "^ \\{%d\\}" min))
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (replace-match "")
+ (end-of-line 1))
+ min)))
+
+(defun org-fill-template (template alist)
+ "Find each %key of ALIST in TEMPLATE and replace it."
+ (let (entry key value)
+ (setq alist (sort (copy-sequence alist)
+ (lambda (a b) (< (length (car a)) (length (car b))))))
+ (while (setq entry (pop alist))
+ (setq template
+ (replace-regexp-in-string
+ (concat "%" (regexp-quote (car entry)))
+ (cdr entry) template t t)))
+ template))
+
(defun org-base-buffer (buffer)
"Return the base buffer of BUFFER, if it has one. Else return the buffer."
(if (not buffer)
list)))
(nreverse list)))
+(defun org-quote-vert (s)
+ "Replace \"|\" with \"\\vert\"."
+ (while (string-match "|" s)
+ (setq s (replace-match "\\vert" t t s)))
+ s)
+
+(defun org-uuidgen-p (s)
+ "Is S an ID created by UUIDGEN?"
+ (string-match "\\`[0-9a-f]\\{8\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{12\\}\\'" (downcase s)))
+
(defun org-context ()
"Return a list of contexts of the current cursor position.
If several contexts apply, all are returned.
(push (org-point-in-group p 2 :todo-keyword) clist)
(push (org-point-in-group p 4 :tags) clist))
(goto-char p)
- (skip-chars-backward "^[\n\r \t") (or (eobp) (backward-char 1))
+ (skip-chars-backward "^[\n\r \t") (or (bobp) (backward-char 1))
(if (looking-at "\\[#[A-Z0-9]\\]")
(push (org-point-in-group p 0 :priority) clist)))
(add-to-list 'files f 'append)
(add-to-list 'tnames (file-truename f) 'append)))
(multi-occur
- (mapcar (lambda (x) (or (get-file-buffer x) (find-file-noselect x))) files)
+ (mapcar (lambda (x)
+ (with-current-buffer
+ (or (get-file-buffer x) (find-file-noselect x))
+ (widen)
+ (current-buffer)))
+ files)
regexp)))
(if (boundp 'occur-mode-find-occurrence-hook)
(goto-char pos)
(org-reveal)))))))
+(defun org-occur-link-in-agenda-files ()
+ "Create a link and search for it in the agendas.
+The link is not stored in `org-stored-links', it is just created
+for the search purpose."
+ (interactive)
+ (let ((link (condition-case nil
+ (org-store-link nil)
+ (error "Unable to create a link to here"))))
+ (org-occur-in-agenda-files (regexp-quote link))))
+
(defun org-uniquify (list)
"Remove duplicate elements from LIST."
(let (res)
(nreverse rtn)))
(defun org-find-base-buffer-visiting (file)
- "Like `find-buffer-visiting' but alway return the base buffer and
+ "Like `find-buffer-visiting' but always return the base buffer and
not an indirect buffer."
- (let ((buf (find-buffer-visiting file)))
+ (let ((buf (or (get-file-buffer file)
+ (find-buffer-visiting file))))
(if buf
(or (buffer-base-buffer buf) buf)
nil)))
(interactive)
(let* ((pos (point))
(itemp (org-at-item-p))
+ (case-fold-search t)
+ (org-drawer-regexp (or org-drawer-regexp "\000"))
column bpos bcol tpos tcol bullet btype bullet-type)
;; Find the previous relevant line
(beginning-of-line 1)
(cond
((looking-at "#") (setq column 0))
((looking-at "\\*+ ") (setq column 0))
+ ((and (looking-at "[ \t]*:END:")
+ (save-excursion (re-search-backward org-drawer-regexp nil t)))
+ (save-excursion
+ (goto-char (1- (match-beginning 1)))
+ (setq column (current-column))))
+ ((and (looking-at "[ \t]+#\\+end_\\([a-z]+\\)")
+ (save-excursion
+ (re-search-backward
+ (concat "^[ \t]*#\\+begin_" (downcase (match-string 1))) nil t)))
+ (setq column (org-get-indentation (match-string 0))))
(t
(beginning-of-line 0)
- (while (and (not (bobp)) (looking-at "[ \t]*[\n:#|]"))
+ (while (and (not (bobp)) (looking-at "[ \t]*[\n:#|]")
+ (not (looking-at "[ \t]*:END:"))
+ (not (looking-at org-drawer-regexp)))
(beginning-of-line 0))
(cond
((looking-at "\\*+[ \t]+")
(setq column 0)
(goto-char (match-end 0))
(setq column (current-column))))
+ ((looking-at org-drawer-regexp)
+ (goto-char (1- (match-beginning 1)))
+ (setq column (current-column)))
+ ((looking-at "\\([ \t]*\\):END:")
+ (goto-char (match-end 1))
+ (setq column (current-column)))
((org-in-item-p)
(org-beginning-of-item)
(looking-at "[ \t]*\\(\\S-+\\)[ \t]*\\(\\[[- X]\\][ \t]*\\|.*? :: \\)?")
(beginning-of-line 1)
(if (looking-at
"\\([ \t]+\\)\\(:[-_0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)")
- (replace-match (concat "\\1" (format org-property-format
- (match-string 2) (match-string 3)))
- t nil))
+ (replace-match (concat (match-string 1)
+ (format org-property-format
+ (match-string 2) (match-string 3)))
+ t t))
(org-move-to-column column)))
(defun org-set-autofill-regexps ()
;; text in a line directly attached to a headline would otherwise
;; fill the headline as well.
(org-set-local 'comment-start-skip "^#+[ \t]*")
- (org-set-local 'paragraph-separate "\f\\|\\*+ \\|[ ]*$\\|[ \t]*[:|]")
+ (org-set-local 'paragraph-separate "\f\\|\\*+ \\|[ ]*$\\|[ \t]*[:|#]")
;; The paragraph starter includes hand-formatted lists.
- (org-set-local 'paragraph-start
- "\f\\|[ ]*$\\|\\*+ \\|\f\\|[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)\\|[ \t]*[:|]")
+ (org-set-local
+ 'paragraph-start
+ (concat
+ "\f" "\\|"
+ "[ ]*$" "\\|"
+ "\\*+ " "\\|"
+ "[ \t]*#" "\\|"
+ "[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)" "\\|"
+ "[ \t]*[:|]" "\\|"
+ "\\$\\$" "\\|"
+ "\\\\\\(begin\\|end\\|[][]\\)"))
;; Inhibit auto-fill for headers, tables and fixed-width lines.
;; But only if the user has not turned off tables or fixed-width regions
(org-set-local
(end (if regionp (region-end)))
(nlines (or arg (if (and beg end) (count-lines beg end) 1)))
(case-fold-search nil)
- (re "[ \t]*\\(:\\)")
+ (re "[ \t]*\\(: \\)")
off)
(if regionp
(save-excursion
(cond
(arg
(org-move-to-column cc t)
- (insert ":\n")
+ (insert ": \n")
(forward-line -1))
((and off (looking-at re))
(replace-match "" t t nil 1))
- ((not off) (org-move-to-column cc t) (insert ":")))
+ ((not off) (org-move-to-column cc t) (insert ": ")))
(forward-line 1)))
(save-excursion
(org-back-to-heading)
(goto-char (match-end 0))
(insert org-quote-string " "))))))))
+(defun org-reftex-citation ()
+ "Use reftex-citation to insert a citation into the buffer.
+This looks for a line like
+
+#+BIBLIOGRAPHY: foo plain option:-d
+
+and derives from it that foo.bib is the bibliography file relevant
+for this document. It then installs the necessary environment for RefTeX
+to work in this buffer and calls `reftex-citation' to insert a citation
+into the buffer.
+
+Export of such citations to both LaTeX and HTML is handled by the contributed
+package org-exp-bibtex by Taru Karttunen."
+ (interactive)
+ (let ((reftex-docstruct-symbol 'rds)
+ (reftex-cite-format "\\cite{%l}")
+ rds bib)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (let ((case-fold-search t)
+ (re "^#\\+bibliography:[ \t]+\\([^ \t\n]+\\)"))
+ (if (not (save-excursion
+ (or (re-search-forward re nil t)
+ (re-search-backward re nil t))))
+ (error "No bibliography defined in file")
+ (setq bib (concat (match-string 1) ".bib")
+ rds (list (list 'bib bib)))))))
+ (call-interactively 'reftex-citation)))
+
;;;; Functions extending outline functionality
(defun org-beginning-of-line (&optional arg)
first attempt, and only move to after the tags when the cursor is already
beyond the end of the headline."
(interactive "P")
- (let ((pos (point)) refpos)
- (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-special-ctrl-a/e
+ (let ((pos (point))
+ (special (if (consp org-special-ctrl-a/e)
+ (car org-special-ctrl-a/e)
+ org-special-ctrl-a/e))
+ refpos)
+ (if (org-bound-and-true-p line-move-visual)
+ (beginning-of-visual-line 1)
+ (beginning-of-line 1))
+ (if (and arg (fboundp 'move-beginning-of-line))
+ (call-interactively 'move-beginning-of-line)
+ (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 special
(cond
((and (looking-at org-complex-heading-regexp)
(= (char-after (match-end 1)) ?\ ))
(setq refpos (min (1+ (or (match-end 3) (match-end 2) (match-end 1)))
(point-at-eol)))
(goto-char
- (if (eq org-special-ctrl-a/e t)
+ (if (eq special t)
(cond ((> pos refpos) refpos)
((= pos (point)) refpos)
(t (point)))
(t refpos)))))
((org-at-item-p)
(goto-char
- (if (eq org-special-ctrl-a/e t)
+ (if (eq special t)
(cond ((> pos (match-end 4)) (match-end 4))
((= pos (point)) (match-end 4))
(t (point)))
first attempt, and only move to after the tags when the cursor is already
beyond the end of the headline."
(interactive "P")
- (if (or (not org-special-ctrl-a/e)
- (not (org-on-heading-p)))
- (end-of-line arg)
- (let ((pos (point)))
- (beginning-of-line 1)
- (if (looking-at (org-re ".*?\\([ \t]*\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$"))
- (if (eq org-special-ctrl-a/e t)
- (if (or (< pos (match-beginning 1))
- (= pos (match-end 0)))
- (goto-char (match-beginning 1))
- (goto-char (match-end 0)))
- (if (or (< pos (match-end 0)) (not (eq this-command last-command)))
- (goto-char (match-end 0))
- (goto-char (match-beginning 1))))
- (end-of-line arg))))
- (org-no-warnings
- (and (featurep 'xemacs) (setq zmacs-region-stays t))))
-
+ (let ((special (if (consp org-special-ctrl-a/e)
+ (cdr org-special-ctrl-a/e)
+ org-special-ctrl-a/e)))
+ (if (or (not special)
+ (not (org-on-heading-p))
+ arg)
+ (call-interactively
+ (cond ((org-bound-and-true-p line-move-visual) 'end-of-visual-line)
+ ((fboundp 'move-end-of-line) 'move-end-of-line)
+ (t 'end-of-line)))
+ (let ((pos (point)))
+ (beginning-of-line 1)
+ (if (looking-at (org-re ".*?\\(?:\\([ \t]*\\)\\(:[[:alnum:]_@:]+:\\)?[ \t]*\\)?$"))
+ (if (eq special t)
+ (if (or (< pos (match-beginning 1))
+ (= pos (match-end 0)))
+ (goto-char (match-beginning 1))
+ (goto-char (match-end 0)))
+ (if (or (< pos (match-end 0)) (not (eq this-command last-command)))
+ (goto-char (match-end 0))
+ (goto-char (match-beginning 1))))
+ (call-interactively (if (fboundp 'move-end-of-line)
+ 'move-end-of-line
+ 'end-of-line)))))
+ (org-no-warnings
+ (and (featurep 'xemacs) (setq zmacs-region-stays t)))))
(define-key org-mode-map "\C-a" 'org-beginning-of-line)
(define-key org-mode-map "\C-e" 'org-end-of-line)
+(define-key org-mode-map [home] 'org-beginning-of-line)
+(define-key org-mode-map [end] 'org-end-of-line)
+
+(defun org-backward-sentence (&optional arg)
+ "Go to beginning of sentence, or beginning of table field.
+This will call `backward-sentence' or `org-table-beginning-of-field',
+depending on context."
+ (interactive "P")
+ (cond
+ ((org-at-table-p) (call-interactively 'org-table-beginning-of-field))
+ (t (call-interactively 'backward-sentence))))
+
+(defun org-forward-sentence (&optional arg)
+ "Go to end of sentence, or end of table field.
+This will call `forward-sentence' or `org-table-end-of-field',
+depending on context."
+ (interactive "P")
+ (cond
+ ((org-at-table-p) (call-interactively 'org-table-end-of-field))
+ (t (call-interactively 'forward-sentence))))
+
+(define-key org-mode-map "\M-a" 'org-backward-sentence)
+(define-key org-mode-map "\M-e" 'org-forward-sentence)
(defun org-kill-line (&optional arg)
"Kill line, to tags or end of line."
no special treatment. In particular, a simple `C-u' prefix will just
plainly yank the text as it is.
-\[1] Basically, the test checks if the first non-white line is a heading
+\[1] The test checks if the first non-white line is a heading
and if there are no other headings with fewer stars."
(interactive "P")
- (setq this-command 'yank)
+ (org-yank-generic 'yank arg))
+
+(defun org-yank-generic (command arg)
+ "Perform some yank-like command.
+
+This function implements the behavior described in the `org-yank'
+documentation. However, it has been generalized to work for any
+interactive command with similar behavior."
+
+ ;; pretend to be command COMMAND
+ (setq this-command command)
+
(if arg
- (call-interactively 'yank)
+ (call-interactively command)
+
(let ((subtreep ; is kill a subtree, and the yank position appropriate?
(and (org-kill-is-subtree-p)
(or (bolp)
end)
(if (and subtreep org-yank-adjusted-subtrees)
(org-paste-subtree nil nil 'for-yank)
- (call-interactively 'yank))
+ (call-interactively command))
+
(setq end (point))
(goto-char beg)
(when (and (bolp) subtreep
(error (goto-char end)))))
(when swallowp
(message
- "Yanked text not folded because that would swallow text"))
+ "Inserted text not folded because that would swallow text"))
+
(goto-char end)
(skip-chars-forward " \t\n\r")
(beginning-of-line 1)
(org-paste-subtree nil nil 'for-yank)
(push-mark beg 'nomsg)))
(t
- (call-interactively 'yank))))))
+ (call-interactively command))))))
(defun org-yank-folding-would-swallow-text (beg end)
"Would hide-subtree at BEG swallow any text after END?"
(save-excursion
(null (re-search-backward "^\\*+ " nil t))))
-(defalias 'org-on-heading-p 'outline-on-heading-p)
-(defalias 'org-at-heading-p 'outline-on-heading-p)
+(defun org-on-heading-p (&optional ignored)
+ (outline-on-heading-p t))
+(defun org-at-heading-p (&optional ignored)
+ (outline-on-heading-p t))
+
(defun org-at-heading-or-item-p ()
(or (org-on-heading-p) (org-at-item-p)))
(defun org-up-heading-safe ()
"Move to the heading line of which the present line is a subheading.
This version will not throw an error. It will return the level of the
-headline found, or nil if no higher level is found."
+headline found, or nil if no higher level is found.
+
+Also, this function will be a lot faster than `outline-up-heading',
+because it relies on stars being the outline starters. This can really
+make a significant difference in outlines with very many siblings."
(let (start-level re)
(org-back-to-heading t)
(setq start-level (funcall outline-level))
(save-excursion (outline-end-of-heading) (point))
flag))))
-(defun org-forward-same-level (arg)
- "Move forward to the ARG'th subheading at same level as this one.
-Stop at the first and last subheadings of a superior heading.
-This is like outline-forward-same-level, but invisible headings are ok."
- (interactive "p")
- (org-back-to-heading t)
- (while (> arg 0)
- (let ((point-to-move-to (save-excursion
- (org-get-next-sibling))))
- (if point-to-move-to
- (progn
- (goto-char point-to-move-to)
- (setq arg (1- arg)))
- (progn
- (setq arg 0)
- (error "No following same-level heading"))))))
-
(defun org-get-next-sibling ()
"Move to next heading of the same level, and return point.
If there is no such heading, return nil.
nil
(point))))
+(defun org-get-last-sibling ()
+ "Move to previous heading of the same level, and return point.
+If there is no such heading, return nil."
+ (let ((opoint (point))
+ (level (funcall outline-level)))
+ (outline-previous-heading)
+ (when (and (/= (point) opoint) (outline-on-heading-p t))
+ (while (and (> (funcall outline-level) level)
+ (not (bobp)))
+ (outline-previous-heading))
+ (if (< (funcall outline-level) level)
+ nil
+ (point)))))
+
(defun org-end-of-subtree (&optional invisible-OK to-heading)
- ;; This is an exact copy of the original function, but it uses
+ ;; This contains 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.
+ ;; Furthermore, when used inside Org, finding the end of a large subtree
+ ;; with many children and grandchildren etc, this can be much faster
+ ;; than the outline version.
(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 (and (org-mode-p) (< level 1000))
+ ;; A true heading (not a plain list item), in Org-mode
+ ;; This means we can easily find the end by looking
+ ;; only for the right number of stars. Using a regexp to do
+ ;; this is so much faster than using a Lisp loop.
+ (let ((re (concat "^\\*\\{1," (int-to-string level) "\\} ")))
+ (forward-char 1)
+ (and (re-search-forward re nil 'move) (beginning-of-line 1)))
+ ;; something else, do it the slow way
+ (while (and (not (eobp))
+ (or first (> (funcall outline-level) level)))
+ (setq first nil)
+ (outline-next-heading)))
(unless to-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))))))
+ (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))))))
(point))
+(defadvice outline-end-of-subtree (around prefer-org-version activate compile)
+ "Use Org version in org-mode, for dramatic speed-up."
+ (if (eq major-mode 'org-mode)
+ (progn
+ (org-end-of-subtree nil t)
+ (unless (eobp) (backward-char 1)))
+ ad-do-it))
+
+(defun org-forward-same-level (arg &optional invisible-ok)
+ "Move forward to the arg'th subheading at same level as this one.
+Stop at the first and last subheadings of a superior heading."
+ (interactive "p")
+ (org-back-to-heading invisible-ok)
+ (org-on-heading-p)
+ (let* ((level (- (match-end 0) (match-beginning 0) 1))
+ (re (format "^\\*\\{1,%d\\} " level))
+ l)
+ (forward-char 1)
+ (while (> arg 0)
+ (while (and (re-search-forward re nil 'move)
+ (setq l (- (match-end 0) (match-beginning 0) 1))
+ (= l level)
+ (not invisible-ok)
+ (org-invisible-p))
+ (if (< l level) (setq arg 1)))
+ (setq arg (1- arg)))
+ (beginning-of-line 1)))
+
+(defun org-backward-same-level (arg &optional invisible-ok)
+ "Move backward to the arg'th subheading at same level as this one.
+Stop at the first and last subheadings of a superior heading."
+ (interactive "p")
+ (org-back-to-heading)
+ (org-on-heading-p)
+ (let* ((level (- (match-end 0) (match-beginning 0) 1))
+ (re (format "^\\*\\{1,%d\\} " level))
+ l)
+ (while (> arg 0)
+ (while (and (re-search-backward re nil 'move)
+ (setq l (- (match-end 0) (match-beginning 0) 1))
+ (= l level)
+ (not invisible-ok)
+ (org-invisible-p))
+ (if (< l level) (setq arg 1)))
+ (setq arg (1- arg)))))
+
(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))
+ (org-end-of-subtree t t))
nil))
(defun org-show-entry ()
(outline-flag-region
(max (point-min) (1- (point)))
(save-excursion
- (re-search-forward
- (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move)
- (or (match-beginning 1) (point-max)))
- nil))
+ (if (re-search-forward
+ (concat "[\r\n]\\(" outline-regexp "\\)") nil t)
+ (match-beginning 1)
+ (point-max)))
+ nil)
+ (org-cycle-hide-drawers 'children))
(error nil))))
-(defun org-make-options-regexp (kwds)
+(defun org-make-options-regexp (kwds &optional extra)
"Make a regular expression for keyword lines."
(concat
"^"
"#?[ \t]*\\+\\("
(mapconcat 'regexp-quote kwds "\\|")
+ (if extra (concat "\\|" extra))
"\\):[ \t]*"
- "\\(.+\\)"))
+ "\\(.*\\)"))
;; Make isearch reveal the necessary context
(defun org-isearch-end ()
if no description is present"
(save-match-data
(if (string-match org-bracket-link-analytic-regexp link)
- (replace-match (or (match-string 5 link)
- (concat (match-string 1 link)
- (match-string 3 link)))
- nil nil link)
+ (replace-match (if (match-end 5)
+ (match-string 5 link)
+ (concat (match-string 1 link)
+ (match-string 3 link)))
+ nil t link)
link)))
;; Speedbar support
((setq p (text-property-any (point-at-bol) (point-at-eol)
'org-imenu t))
(setq m (get-text-property p 'org-imenu-marker))
- (save-excursion
- (save-restriction
- (set-buffer (marker-buffer m))
- (goto-char m)
- (org-agenda-set-restriction-lock 'subtree))))
+ (with-current-buffer (marker-buffer m)
+ (goto-char m)
+ (org-agenda-set-restriction-lock 'subtree)))
((setq p (text-property-any (point-at-bol) (point-at-eol)
'speedbar-function 'speedbar-find-file))
(setq tp (previous-single-property-change
dir (speedbar-line-directory)
txt (buffer-substring-no-properties (or tp (point-min))
(or np (point-max))))
- (save-excursion
- (save-restriction
- (set-buffer (find-file-noselect
- (let ((default-directory dir))
- (expand-file-name txt))))
- (unless (org-mode-p)
- (error "Cannot restrict to non-Org-mode file"))
- (org-agenda-set-restriction-lock 'file))))
+ (with-current-buffer (find-file-noselect
+ (let ((default-directory dir))
+ (expand-file-name txt)))
+ (unless (org-mode-p)
+ (error "Cannot restrict to non-Org-mode file"))
+ (org-agenda-set-restriction-lock 'file)))
(t (error "Don't know how to restrict Org-mode's agenda")))
(org-move-overlay org-speedbar-restriction-lock-overlay
(point-at-bol) (point-at-eol))
;; Make flyspell not check words in links, to not mess up our keymap
(defun org-mode-flyspell-verify ()
"Don't let flyspell put overlays at active buttons."
- (not (get-text-property (point) 'keymap)))
+ (and (not (get-text-property (point) 'keymap))
+ (not (get-text-property (point) 'org-no-flyspell))))
-;; Make `bookmark-jump' show the jump location if it was hidden.
+(defun org-remove-flyspell-overlays-in (beg end)
+ "Remove flyspell overlays in region."
+ (and (org-bound-and-true-p flyspell-mode)
+ (fboundp 'flyspell-delete-region-overlays)
+ (flyspell-delete-region-overlays beg end))
+ (add-text-properties beg end '(org-no-flyspell t)))
+
+;; Make `bookmark-jump' shows the jump location if it was hidden.
(eval-after-load "bookmark"
'(if (boundp 'bookmark-after-jump-hook)
;; We can use the hook
"Make the position visible."
(org-bookmark-jump-unhide))))
-;; Make sure saveplace show the location if it was hidden
+;; Make sure saveplace shows the location if it was hidden
(eval-after-load "saveplace"
'(defadvice save-place-find-file-hook (after org-make-visible activate)
"Make the position visible."
(org-bookmark-jump-unhide)))
+;; Make sure ecb shows the location if it was hidden
+(eval-after-load "ecb"
+ '(defadvice ecb-method-clicked (after esf/org-show-context activate)
+ "Make hierarchy visible when jumping into location from ECB tree buffer."
+ (if (eq major-mode 'org-mode)
+ (org-show-context))))
+
(defun org-bookmark-jump-unhide ()
"Unhide the current position, to show the bookmark location."
(and (org-mode-p)
Still experimental, may disappear in the future."
(interactive)
;; Get the time interval from the user.
- (let* ((time1 (time-to-seconds
+ (let* ((time1 (org-float-time
(org-read-date nil 'to-time nil "Starting date: ")))
- (time2 (time-to-seconds
+ (time2 (org-float-time
(org-read-date nil 'to-time nil "End date:")))
;; callback function
(callback (lambda ()
(let ((time
- (time-to-seconds
+ (org-float-time
(apply 'encode-time
(org-parse-time-string
(match-string 1))))))
;; make tree, check each match with the callback
(org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback)))
-
;;;; Finish up
(provide 'org)
;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd
;;; org.el ends here
+
HCoop / bpt / emacs.git / blobdiff