;;; org.el --- Outline-based notes management and organizer
;; Carstens outline-mode for keeping track of everything.
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Maintainer: Bastien Guerry <bzg at gnu dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.4
+;; Version: 7.8.09
;;
;; This file is part of GNU Emacs.
;;
(require 'gnus-sum))
(require 'calendar)
+(require 'format-spec)
;; Emacs 22 calendar compatibility: Make sure the new variables are available
(when (fboundp 'defvaralias)
(require 'org-compat)
(require 'org-faces)
(require 'org-list)
-(require 'org-complete)
+(require 'org-pcomplete)
(require 'org-src)
(require 'org-footnote)
+(declare-function org-inlinetask-at-task-p "org-inlinetask" ())
+(declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
+(declare-function org-inlinetask-toggle-visibility "org-inlinetask" ())
+(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label))
+(declare-function org-at-clock-log-p "org-clock" ())
+(declare-function org-clock-timestamps-up "org-clock" ())
+(declare-function org-clock-timestamps-down "org-clock" ())
+
;; babel
(require 'ob)
(require 'ob-table)
requirements) is loaded."
:group 'org-babel
:set 'org-babel-do-load-languages
+ :version "24.1"
:type '(alist :tag "Babel Languages"
:key-type
(choice
+ (const :tag "Awk" awk)
(const :tag "C" C)
(const :tag "R" R)
(const :tag "Asymptote" asymptote)
(const :tag "Ditaa" ditaa)
(const :tag "Dot" dot)
(const :tag "Emacs Lisp" emacs-lisp)
+ (const :tag "Fortran" fortran)
(const :tag "Gnuplot" gnuplot)
(const :tag "Haskell" haskell)
+ (const :tag "Java" java)
(const :tag "Javascript" js)
(const :tag "Latex" latex)
(const :tag "Ledger" ledger)
+ (const :tag "Lilypond" lilypond)
+ (const :tag "Maxima" maxima)
(const :tag "Matlab" matlab)
(const :tag "Mscgen" mscgen)
(const :tag "Ocaml" ocaml)
(const :tag "Octave" octave)
(const :tag "Org" org)
(const :tag "Perl" perl)
+ (const :tag "Pico Lisp" picolisp)
(const :tag "PlantUML" plantuml)
(const :tag "Python" python)
(const :tag "Ruby" ruby)
(const :tag "Scheme" scheme)
(const :tag "Screen" screen)
(const :tag "Shell Script" sh)
+ (const :tag "Shen" shen)
(const :tag "Sql" sql)
(const :tag "Sqlite" sqlite))
:value-type (boolean :tag "Activate" :value t)))
Otherwise they inherit the ID property with a new unique
identifier."
:type 'boolean
+ :version "24.1"
:group 'org-id)
;;; Version
-(defconst org-version "7.4"
+(defconst org-version "7.8.09"
"The version number of the file org.el.")
+;;;###autoload
(defun org-version (&optional here)
"Show the org-mode version in the echo area.
With prefix arg HERE, insert it at point."
:group 'org
:type 'hook)
+(defcustom org-log-buffer-setup-hook nil
+ "Hook that is run after an Org log buffer is created."
+ :group 'org
+ :version "24.1"
+ :type 'hook)
+
(defvar org-modules) ; defined below
(defvar org-modules-loaded nil
"Have the modules been loaded already?")
(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 " special-blocks: Turn blocks into LaTeX envs and HTML divs" org-special-blocks)
(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/paste from w3m to Org-mode." org-w3m)
(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 drill: Flashcards and spaced repetition for Org-mode" org-drill)
(const :tag "C elisp-symbol: Org-mode links to emacs-lisp symbols" org-elisp-symbol)
+ (const :tag "C eshell Support for links to working directories in eshell" org-eshell)
(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-mode entries" org-expiry)
(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 notmuch: Provide org links to notmuch searches or messages" org-notmuch)
(const :tag "C mac-iCal Imports events from iCal.app to the Emacs diary" org-mac-iCal)
(const :tag "C mac-link-grabber Grab links and URLs from various Mac applications" org-mac-link-grabber)
(const :tag "C man: Support for links to manpages in Org-mode" org-man)
(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 secretary: Team management with org-mode" org-secretary)
- (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)
(defcustom org-support-shift-select nil
"Non-nil means make shift-cursor commands select text when possible.
-In Emacs 23, when `shift-select-mode' is on, shifted cursor keys start
-selecting a region, or enlarge regions started in this way.
-In Org-mode, in special contexts, these same keys are used for other
-purposes, important enough to compete with shift selection. Org tries
-to balance these needs by supporting `shift-select-mode' outside these
-special contexts, under control of this variable.
+In Emacs 23, when `shift-select-mode' is on, shifted cursor keys
+start selecting a region, or enlarge regions started in this way.
+In Org-mode, in special contexts, these same keys are used for
+other purposes, important enough to compete with shift selection.
+Org tries to balance these needs by supporting `shift-select-mode'
+outside these special contexts, under control of this variable.
The default of this variable is nil, to avoid confusing behavior. Shifted
cursor keys will then execute Org commands in the following contexts:
- in the BEGIN line of a clock table (changing the time block).
Outside these contexts, the commands will throw an error.
-When this variable is t and the cursor is not in a special context,
-Org-mode will support shift-selection for making and enlarging regions.
-To make this more effective, the bullet cycling will no longer happen
-anywhere in an item line, but only if the cursor is exactly on the bullet.
+When this variable is t and the cursor is not in a special
+context, Org-mode will support shift-selection for making and
+enlarging regions. To make this more effective, the bullet
+cycling will no longer happen anywhere in an item line, but only
+if the cursor is exactly on the bullet.
If you set this variable to the symbol `always', then the keys
-will not be special in headlines, property lines, and item lines, to make
-shift selection work there as well. If this is what you want, you can
-use the following alternative commands: `C-c C-t' and `C-c ,' to
-change TODO state and priority, `C-u C-u C-c C-t' can be used to switch
-TODO sets, `C-c -' to cycle item bullet types, and properties can be
-edited by hand or in column view.
+will not be special in headlines, property lines, and item lines,
+to make shift selection work there as well. If this is what you
+want, you can use the following alternative commands: `C-c C-t'
+and `C-c ,' to change TODO state and priority, `C-u C-u C-c C-t'
+can be used to switch TODO sets, `C-c -' to cycle item bullet
+types, and properties can be edited by hand or in column view.
However, when the cursor is on a timestamp, shift-cursor commands
will still edit the time stamp - this is just too good to give up.
-XEmacs user should have this variable set to nil, because shift-select-mode
-is Emacs 23 only."
+XEmacs user should have this variable set to nil, because
+`shift-select-mode' is in Emacs 23 or later only."
:group 'org
:type '(choice
(const :tag "Never" nil)
(const :tag "When outside special context" t)
(const :tag "Everywhere except timestamps" always)))
+(defcustom org-loop-over-headlines-in-active-region nil
+ "Shall some commands act upon headlines in the active region?
+
+When set to `t', some commands will be performed in all headlines
+within the active region.
+
+When set to `start-level', some commands will be performed in all
+headlines within the active region, provided that these headlines
+are of the same level than the first one.
+
+When set to a string, those commands will be performed on the
+matching headlines within the active region. Such string must be
+a tags/property/todo match as it is used in the agenda tags view.
+
+The list of commands is: `org-schedule', `org-deadline',
+`org-todo', `org-archive-subtree', `org-archive-set-tag' and
+`org-archive-to-archive-sibling'. The archiving commands skip
+already archived entries."
+ :type '(choice (const :tag "Don't loop" nil)
+ (const :tag "All headlines in active region" t)
+ (const :tag "In active region, headlines at the same level than the first one" 'start-level)
+ (string :tag "Tags/Property/Todo matcher"))
+ :version "24.1"
+ :group 'org-todo
+ :group 'org-archive)
+
(defgroup org-startup nil
"Options concerning startup of Org-mode."
:tag "Org Startup"
This option can also be set with the +OPTIONS line, e.g. \"^:nil\"."
:group 'org-startup
:group 'org-export-translation
+ :version "24.1"
:type '(choice
(const :tag "Always interpret" t)
(const :tag "Only with braces" {})
#+STARTUP: beamer"
:group 'org-startup
+ :version "24.1"
:type 'boolean)
(defcustom org-startup-align-all-tables nil
#+STARTUP: inlineimages
#+STARTUP: noinlineimages"
:group 'org-startup
+ :version "24.1"
:type 'boolean)
(defcustom org-insert-mode-line-in-empty-file nil
(const :tag "No limit" nil)
(integer :tag "Maximum level")))
-(defcustom org-drawers '("PROPERTIES" "CLOCK" "LOGBOOK")
+(defcustom org-drawers '("PROPERTIES" "CLOCK" "LOGBOOK" "RESULTS")
"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:
Any other non-nil value will result in a query to the user, if it is
OK to kill that hidden subtree. When nil, kill without remorse."
:group 'org-edit-structure
+ :version "24.1"
:type '(choice
(const :tag "Do not protect hidden subtrees" nil)
(const :tag "Protect hidden subtrees with a security query" t)
(const :tag "Never kill a hidden subtree with C-k" error)))
+(defcustom org-catch-invisible-edits nil
+ "Check if in invisible region before inserting or deleting a character.
+Valid values are:
+
+nil Do not check, so just do invisible edits.
+error Throw an error and do nothing.
+show Make point visible, and do the requested edit.
+show-and-error Make point visible, then throw an error and abort the edit.
+smart Make point visible, and do insertion/deletion if it is
+ adjacent to visible text and the change feels predictable.
+ Never delete a previously invisible character or add in the
+ middle or right after an invisible region. Basically, this
+ allows insertion and backward-delete right before ellipses.
+ FIXME: maybe in this case we should not even show?"
+ :group 'org-edit-structure
+ :version "24.1"
+ :type '(choice
+ (const :tag "Do not check" nil)
+ (const :tag "Throw error when trying to edit" error)
+ (const :tag "Unhide, but do not do the edit" show-and-error)
+ (const :tag "Show invisible part and do the edit" show)
+ (const :tag "Be smart and do the right thing" smart)))
+
(defcustom org-yank-folded-subtrees t
"Non-nil means when yanking subtrees, fold them.
If the kill is a single subtree, or a sequence of subtrees, i.e. if
(defcustom org-blank-before-new-entry '((heading . auto)
(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. The cdr may lso be the symbol `auto', and then
-Org will look at the surrounding headings/items and try to make an
-intelligent decision wether to insert a blank line or not.
+The value is an alist, with `heading' and `plain-list-item' as CAR,
+and a boolean flag as CDR. The cdr may also be the symbol `auto', in
+which case Org will look at the surrounding headings/items and try to
+make an intelligent decision whether to insert a blank line or not.
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 avoid
(function)))))
(defcustom org-descriptive-links t
- "Non-nil means hide link part and only show description of bracket links.
-Bracket links are like [[link][description]]. This variable sets the initial
-state in new org-mode buffers. The setting can then be toggled on a
-per-buffer basis from the Org->Hyperlinks menu."
+ "Non-nil means Org will display descriptive links.
+E.g. [[http://orgmode.org][Org website]] will be displayed as
+\"Org Website\", hiding the link itself and just displaying its
+description. When set to `nil', Org will display the full links
+literally.
+
+You can interactively set the value of this variable by calling
+`org-toggle-link-display' or from the menu Org>Hyperlinks menu."
:group 'org-link
:type 'boolean)
%c correspondent. Usually \"from NAME\", but if you sent it yourself, it
will be \"to NAME\". See also the variable `org-from-is-user-regexp'.
%s subject
+%d date
%m message-id.
You may use normal field width specification between the % and the letter.
(defcustom org-link-search-must-match-exact-headline 'query-to-create
"Non-nil means internal links in Org files must exactly match a headline.
-When nil, the link search tries to match a phrase will all words
+When nil, the link search tries to match a phrase with all words
in the search text."
:group 'org-link-follow
+ :version "24.1"
:type '(choice
- (const :tag "Use fuzy text search" nil)
+ (const :tag "Use fuzzy text search" nil)
(const :tag "Match only exact headline" t)
- (const :tag "Match extact headline or query to create it"
+ (const :tag "Match exact headline or query to create it"
query-to-create)))
(defcustom org-link-frame-setup
set this up for the different types of links.
For VM, use any of
`vm-visit-folder'
+ `vm-visit-folder-other-window'
`vm-visit-folder-other-frame'
For Gnus, use any of
`gnus'
(const :tag "no confirmation (dangerous)" nil)))
(put 'org-confirm-shell-link-function
'safe-local-variable
- (lambda (x) (member x '(yes-or-no-p y-or-n-p))))
+ #'(lambda (x) (member x '(yes-or-no-p y-or-n-p))))
+
+(defcustom org-confirm-shell-link-not-regexp ""
+ "A regexp to skip confirmation for shell links."
+ :group 'org-link-follow
+ :version "24.1"
+ :type 'regexp)
(defcustom org-confirm-elisp-link-function 'yes-or-no-p
"Non-nil means ask for confirmation before executing Emacs Lisp links.
(const :tag "no confirmation (dangerous)" nil)))
(put 'org-confirm-shell-link-function
'safe-local-variable
- (lambda (x) (member x '(yes-or-no-p y-or-n-p))))
+ #'(lambda (x) (member x '(yes-or-no-p y-or-n-p))))
+
+(defcustom org-confirm-elisp-link-not-regexp ""
+ "A regexp to skip confirmation for Elisp links."
+ :group 'org-link-follow
+ :version "24.1"
+ :type 'regexp)
(defconst org-file-apps-defaults-gnu
'((remote . emacs)
will temporarily be changed to `time'."
:group 'org-refile
:group 'org-progress
+ :version "24.1"
:type '(choice
(const :tag "No logging" nil)
(const :tag "Record timestamp" time)
(defcustom org-refile-targets nil
"Targets for refiling entries with \\[org-refile].
-This is list of cons cells. Each cell contains:
+This is a list of cons cells. Each cell contains:
- a specification of the files to be considered, either a list of files,
or a symbol whose function or variable value will be used to retrieve
a file name or a list of file names. If you use `org-agenda-files' for
Note that, when `org-odd-levels-only' is set, level corresponds to
order in hierarchy, not to the number of stars.
+Each element of this list generates a set of possible targets.
+The union of these sets is presented (with completion) to
+the user by `org-refile'.
+
You can set the variable `org-refile-target-verify-function' to a function
to verify each headline found by the simple criteria above.
you need to clear the cache manually by pressing `C-0 C-c C-w' or, if you
find that easier, `C-u C-u C-u C-c C-w'."
:group 'org-refile
+ :version "24.1"
:type 'boolean)
(defcustom org-refile-use-outline-path nil
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."
+When `full-file-path', include the full file path."
:group 'org-refile
:type '(choice
(const :tag "Not" nil)
(const :tag "Always" t)
(const :tag "Prompt for confirmation" confirm)))
+(defcustom org-refile-active-region-within-subtree nil
+ "Non-nil means also refile active region within a subtree.
+
+By default `org-refile' doesn't allow refiling regions if they
+don't contain a set of subtrees, but it might be convenient to
+do so sometimes: in that case, the first line of the region is
+converted to a headline before refiling."
+ :group 'org-refile
+ :version "24.1"
+ :type 'boolean)
+
(defgroup org-todo nil
"Options concerning TODO items in Org-mode."
:tag "Org TODO"
:group 'org-time)
(defvar org-todo-interpretation-widgets
- '(
- (:tag "Sequence (cycling hits every state)" sequence)
+ '((: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-after-todo-state-change-hook nil
"Hook which is run after the state of a TODO item was changed.
The new state (a string with a TODO keyword, or nil) is available in the
-Lisp variable `state'."
+Lisp variable `org-state'."
:group 'org-todo
:type 'hook)
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."
+the child will also be blocked."
:set (lambda (var val)
(set var val)
(if val
empty string.
%t in the heading will be replaced by a time stamp.
%T will be an active time stamp instead the default inactive one
+%d will be replaced by a short-format time stamp.
+%D will be replaced by an active short-format 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.
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
+LOGBOOK is proposed as 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\".
"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))))
+ (let ((p (org-entry-get nil "LOG_INTO_DRAWER" 'inherit)))
(cond
((or (not p) (equal p "nil")) org-log-into-drawer)
((equal p "t") "LOGBOOK")
in a TODO_TYP set. But you can specify another task here.
alternatively, set the :REPEAT_TO_STATE: property of the entry."
:group 'org-todo
+ :version "24.1"
:type '(choice (const :tag "Head of sequence" nil)
(string :tag "Specific state")))
(defcustom org-default-priority ?B
"The default priority of TODO items.
-This is the priority an item get if no explicit priority is given."
+This is the priority an item gets if no explicit priority is given.
+When starting to cycle on an empty priority the first step in the cycle
+depends on `org-priority-start-cycle-with-default'. The resulting first
+step priority must not exceed the range from `org-highest-priority' to
+`org-lowest-priority' which means that `org-default-priority' has to be
+in this range exclusive or inclusive the range boundaries. Else the
+first step refuses to set the default and the second will fall back
+to (depending on the command used) the highest or lowest priority."
:group 'org-priorities
:type 'character)
(defcustom org-priority-start-cycle-with-default t
"Non-nil means start with default priority when starting to cycle.
When this is nil, the first step in the cycle will be (depending on the
-command used) one higher or lower that the default priority."
+command used) one higher or lower than the default priority.
+See also `org-default-priority'."
:group 'org-priorities
:type 'boolean)
The user can set a different function here, which should take a string
as an argument and return the numeric priority."
:group 'org-priorities
+ :version "24.1"
:type 'function)
(defgroup org-time nil
and by using a prefix arg to `S-up/down' to specify the exact number
of minutes to shift."
:group 'org-time
- :get (lambda (var) ; Make sure both elements are there
+ :get #'(lambda (var) ; Make sure both elements are there
(if (integerp (default-value var))
(list (default-value var) 5)
(default-value var)))
(defcustom org-time-stamp-custom-formats
'("<%m/%d/%y %a>" . "<%m/%d/%y %a %H:%M>") ; american
"Custom formats for time stamps. See `format-time-string' for the syntax.
-These are overlayed over the default ISO format if the variable
+These are overlaid 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. The custom formats are also honored by export
commands, if custom time display is turned on at the time of export."
(defcustom org-agenda-jump-prefer-future 'org-read-date-prefer-future
"Should the agenda jump command prefer the future for incomplete dates?
The default is to do the same as configured in `org-read-date-prefer-future'.
-But you can alse set a deviating value here.
+But you can also set a deviating value here.
This may t or nil, or the symbol `org-read-date-prefer-future'."
:group 'org-agenda
:group 'org-time
+ :version "24.1"
:type '(choice
(const :tag "Use org-read-date-prefer-future"
org-read-date-prefer-future)
(const :tag "Never" nil)
(const :tag "Always" t)))
+(defcustom org-read-date-force-compatible-dates t
+ "Should date/time prompt force dates that are guaranteed to work in Emacs?
+
+Depending on the system Emacs is running on, certain dates cannot
+be represented with the type used internally to represent time.
+Dates between 1970-1-1 and 2038-1-1 can always be represented
+correctly. Some systems allow for earlier dates, some for later,
+some for both. One way to find out it to insert any date into an
+Org buffer, putting the cursor on the year and hitting S-up and
+S-down to test the range.
+
+When this variable is set to t, the date/time prompt will not let
+you specify dates outside the 1970-2037 range, so it is certain that
+these dates will work in whatever version of Emacs you are
+running, and also that you can move a file from one Emacs implementation
+to another. WHenever Org is forcing the year for you, it will display
+a message and beep.
+
+When this variable is nil, Org will check if the date is
+representable in the specific Emacs implementation you are using.
+If not, it will force a year, usually the current year, and beep
+to remind you. Currently this setting is not recommended because
+the likelihood that you will open your Org files in an Emacs that
+has limited date range is not negligible.
+
+A workaround for this problem is to use diary sexp dates for time
+stamps outside of this range."
+ :group 'org-time
+ :version "24.1"
+ :type 'boolean)
+
(defcustom org-read-date-display-live t
"Non-nil means display current interpretation of date prompt live.
This display will be in an overlay, in the minibuffer."
:group 'org-time
:type 'integer)
+(defcustom org-use-effective-time nil
+ "If non-nil, consider `org-extend-today-until' when creating timestamps.
+For example, if `org-extend-today-until' is 8, and it's 4am, then the
+\"effective time\" of any timestamps between midnight and 8am will be
+23:59 of the previous day."
+ :group 'org-time
+ :version "24.1"
+ :type 'boolean)
+
(defcustom org-edit-timestamp-down-means-later nil
"Non-nil means S-down will increase the time in a time stamp.
When nil, S-up will increase."
'org-complete-tags-always-offer-all-agenda-tags)
t)))"
:group 'org-tags
+ :version "24.1"
:type 'boolean)
(defvar org-file-tags nil
"The column to which tags should be indented in a headline.
If this number is positive, it specifies the column. If it is negative,
it means that the tags should be flushright to that column. For example,
--80 works well for a normal 80 character screen."
+-80 works well for a normal 80 character screen.
+When 0, place tags directly after headline text, with only one space in
+between."
:group 'org-tags
:type 'integer)
(defcustom org-auto-align-tags t
- "Non-nil means realign tags after pro/demotion of TODO state change.
-These operations change the length of a headline and therefore shift
-the tags around. With this options turned on, after each such operation
-the tags are again aligned to `org-tags-column'."
+ "Non-nil keeps tags aligned when modifying headlines.
+Some operations (i.e. demoting) change the length of a headline and
+therefore shift the tags around. With this option turned on, after
+each such operation the tags are again aligned to `org-tags-column'."
:group 'org-tags
:type 'boolean)
:group 'org-properties
:type 'string)
+(defcustom org-properties-postprocess-alist nil
+ "Alist of properties and functions to adjust inserted values.
+Elements of this alist must be of the form
+
+ ([string] [function])
+
+where [string] must be a property name and [function] must be a
+lambda expression: this lambda expression must take one argument,
+the value to adjust, and return the new value as a string.
+
+For example, this element will allow the property \"Remaining\"
+to be updated wrt the relation between the \"Effort\" property
+and the clock summary:
+
+ ((\"Remaining\" (lambda(value)
+ (let ((clocksum (org-clock-sum-current-item))
+ (effort (org-duration-string-to-minutes
+ (org-entry-get (point) \"Effort\"))))
+ (org-minutes-to-hh:mm-string (- effort clocksum))))))"
+ :group 'org-properties
+ :version "24.1"
+ :type 'alist)
+
(defcustom org-use-property-inheritance nil
"Non-nil means properties apply also for sublevels.
If the file does not specify a category, then file's base name
is used instead.")
(make-variable-buffer-local 'org-category)
-(put 'org-category 'safe-local-variable (lambda (x) (or (symbolp x) (stringp x))))
+(put 'org-category 'safe-local-variable #'(lambda (x) (or (symbolp x) (stringp x))))
(defcustom org-agenda-files nil
"The files to be used for agenda display.
"Non-nil means signal an error when image creation of LaTeX snippets fails.
When nil, just push out a message."
:group 'org-latex
+ :version "24.1"
:type 'boolean)
+(defcustom org-latex-to-mathml-jar-file nil
+ "Value of\"%j\" in `org-latex-to-mathml-convert-command'.
+Use this to specify additional executable file say a jar file.
+
+When using MathToWeb as the converter, specify the full-path to
+your mathtoweb.jar file."
+ :group 'org-latex
+ :version "24.1"
+ :type '(choice
+ (const :tag "None" nil)
+ (file :tag "JAR file" :must-match t)))
+
+(defcustom org-latex-to-mathml-convert-command nil
+ "Command to convert LaTeX fragments to MathML.
+Replace format-specifiers in the command as noted below and use
+`shell-command' to convert LaTeX to MathML.
+%j: Executable file in fully expanded form as specified by
+ `org-latex-to-mathml-jar-file'.
+%I: Input LaTeX file in fully expanded form
+%o: Output MathML file
+This command is used by `org-create-math-formula'.
+
+When using MathToWeb as the converter, set this to
+\"java -jar %j -unicode -force -df %o %I\"."
+ :group 'org-latex
+ :version "24.1"
+ :type '(choice
+ (const :tag "None" nil)
+ (string :tag "\nShell command")))
+
+(defun org-format-latex-mathml-available-p ()
+ "Return t if `org-latex-to-mathml-convert-command' is usable."
+ (save-match-data
+ (when (and (boundp 'org-latex-to-mathml-convert-command)
+ org-latex-to-mathml-convert-command)
+ (let ((executable (car (split-string
+ org-latex-to-mathml-convert-command))))
+ (when (executable-find executable)
+ (if (string-match
+ "%j" org-latex-to-mathml-convert-command)
+ (file-readable-p org-latex-to-mathml-jar-file)
+ t))))))
(defcustom org-format-latex-header "\\documentclass{article}
\\usepackage[usenames]{color}
:group 'org-export-latex
:set 'org-set-packages-alist
:get 'org-get-packages-alist
+ :version "24.1"
:type '(repeat
(choice
(list :tag "options/package pair"
:type 'boolean)
(defcustom org-hidden-keywords nil
- "List of keywords that should be hidden when typed in the org buffer.
-For example, add #+TITLE to this list in order to make the
-document title appear in the buffer without the initial #+TITLE:
-keyword."
+ "List of symbols corresponding to keywords to be hidden the org buffer.
+For example, a value '(title) for this list will make the document's title
+appear in the buffer without the initial #+TITLE: keyword."
:group 'org-appearance
+ :version "24.1"
:type '(set (const :tag "#+AUTHOR" author)
(const :tag "#+DATE" date)
(const :tag "#+EMAIL" email)
- (const :tag "#+TITLE" title)))
+ (const :tag "#+TITLE" title)))
(defcustom org-fontify-done-headline nil
"Non-nil means change the face of a headline if it is marked DONE.
"Non-nil means show entities as UTF8 characters.
When nil, the \\name form remains in the buffer."
:group 'org-appearance
+ :version "24.1"
:type 'boolean)
(defcustom org-pretty-entities-include-sub-superscripts t
"Non-nil means, pretty entity display includes formatting sub/superscripts."
:group 'org-appearance
+ :version "24.1"
:type 'boolean)
(defvar org-emph-re nil
(defvar calc-embedded-close-formula)
(defvar calc-embedded-open-formula)
(declare-function cdlatex-tab "ext:cdlatex" ())
+(declare-function cdlatex-compute-tables "ext:cdlatex" ())
(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
(defvar font-lock-unfontify-region-function)
(declare-function iswitchb-read-buffer "iswitchb"
(defvar org-agenda-tags-todo-honor-ignore-options)
(declare-function org-agenda-skip "org-agenda" ())
(declare-function
- org-format-agenda-item "org-agenda"
+ org-agenda-format-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"
(defun org-clocktable-try-shift (dir n)
"Check if this line starts a clock table, if yes, shift the time block."
- (when (org-match-line "#\\+BEGIN: clocktable\\>")
+ (when (org-match-line "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>")
(org-clocktable-shift dir n)))
;; Autoload org-timer.el
\"~/org/archive.org::\"
Archive in file ~/org/archive.org (absolute path), as top-level trees.
-\"~/org/archive.org::From %s\"
+\"~/org/archive.org::* From %s\"
Archive in file ~/org/archive.org (absolute path), under headlines
\"From FILENAME\" where file name is the current file name.
(let* ((re (concat ":" org-archive-tag ":")))
(goto-char beg)
(while (re-search-forward re end t)
- (when (org-on-heading-p)
+ (when (org-at-heading-p)
(org-flag-subtree t)
(org-end-of-subtree t))))))
(make-variable-buffer-local 'org-complex-heading-regexp)
(defvar org-complex-heading-regexp-format nil
"Printf format to make regexp to match an exact headline.
-This regexp will match the headline of any node which hase the exact
-headline text that is put into the format, but may have any TODO state,
-priority and tags.")
+This regexp will match the headline of any node which has the
+exact headline text that is put into the format, but may have any
+TODO state, priority and tags.")
(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.")
(make-variable-buffer-local 'org-todo-line-tags-regexp)
-(defvar org-nl-done-regexp nil
- "Matches newline followed by a headline with the DONE keyword.")
-(make-variable-buffer-local 'org-nl-done-regexp)
-(defvar org-looking-at-done-regexp nil
- "Matches the DONE keyword a point.")
-(make-variable-buffer-local 'org-looking-at-done-regexp)
(defvar org-ds-keyword-length 12
"Maximum length of the Deadline and SCHEDULED keywords.")
(make-variable-buffer-local 'org-ds-keyword-length)
set this variable to if the option is found. An optional forth element PUSH
means to push this value onto the list in the variable.")
+(defun org-update-property-plist (key val props)
+ "Update PROPS with KEY and VAL."
+ (let* ((appending (string= "+" (substring key (- (length key) 1))))
+ (key (if appending (substring key 0 (- (length key) 1)) key))
+ (remainder (org-remove-if (lambda (p) (string= (car p) key)) props))
+ (previous (cdr (assoc key props))))
+ (if appending
+ (cons (cons key (if previous (concat previous " " val) val)) remainder)
+ (cons (cons key val) remainder))))
+
+(defconst org-block-regexp
+ "^[ \t]*#\\+begin_?\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$"
+ "Regular expression for hiding blocks.")
+(defconst org-heading-keyword-regexp-format
+ "^\\(\\*+\\)\\(?: +%s\\)\\(?: +\\(.*?\\)\\)?[ \t]*$"
+ "Printf format for a regexp matching an headline with some keyword.
+This regexp will match the headline of any node which has the
+exact keyword that is put into the format. The keyword isn't in
+any group by default, but the stars and the body are.")
+(defconst org-heading-keyword-maybe-regexp-format
+ "^\\(\\*+\\)\\(?: +%s\\)?\\(?: +\\(.*?\\)\\)?[ \t]*$"
+ "Printf format for a regexp matching an headline, possibly with some keyword.
+This regexp can match any headline with the specified keyword, or
+without a keyword. The keyword isn't in any group by default,
+but the stars and the body are.")
+
(defun org-set-regexps-and-options ()
"Precompute regular expressions for current buffer."
- (when (org-mode-p)
+ (when (eq major-mode 'org-mode)
(org-set-local 'org-todo-kwd-alist nil)
(org-set-local 'org-todo-key-alist nil)
(org-set-local 'org-todo-key-trigger nil)
(setq prio (org-split-string value " +")))
((equal key "PROPERTY")
(when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value)
- (push (cons (match-string 1 value) (match-string 2 value))
- props)))
+ (setq props (org-update-property-plist (match-string 1 value)
+ (match-string 2 value)
+ props))))
((equal key "FILETAGS")
(when (string-match "\\S-" value)
(setq ftags
(setq ext-setup-or-nil
(concat (substring ext-setup-or-nil 0 start)
"\n" setup-contents "\n"
- (substring ext-setup-or-nil start)))))
- ))))
+ (substring ext-setup-or-nil start)))))))
+ ;; search for property blocks
+ (goto-char (point-min))
+ (while (re-search-forward org-block-regexp nil t)
+ (when (equal "PROPERTY" (upcase (match-string 1)))
+ (setq value (replace-regexp-in-string
+ "[\n\r]" " " (match-string 4)))
+ (when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value)
+ (setq props (org-update-property-plist (match-string 1 value)
+ (match-string 2 value)
+ props)))))))
(org-set-local 'org-use-sub-superscripts scripts)
(when cat
(org-set-local 'org-category (intern cat))
(assoc (car e) org-tag-alist))
(push e org-tag-alist)))))
- ;; Compute the regular expressions and other local variables
+ ;; Compute the regular expressions and other local variables.
+ ;; Using `org-outline-regexp-bol' would complicate them much,
+ ;; because of the fixed white space at the end of that string.
(if (not org-done-keywords)
(setq org-done-keywords (and org-todo-keywords-1
(list (org-last org-todo-keywords-1)))))
org-not-done-keywords
(org-delete-all org-done-keywords (copy-sequence org-todo-keywords-1))
org-todo-regexp
- (concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords-1
- "\\|") "\\)\\>")
+ (concat "\\("
+ (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
+ "\\)")
org-not-done-regexp
- (concat "\\<\\("
+ (concat "\\("
(mapconcat 'regexp-quote org-not-done-keywords "\\|")
- "\\)\\>")
+ "\\)")
org-not-done-heading-regexp
- (concat "^\\(\\*+\\)[ \t]+\\("
- (mapconcat 'regexp-quote org-not-done-keywords "\\|")
- "\\)\\>")
+ (format org-heading-keyword-regexp-format org-not-done-regexp)
org-todo-line-regexp
- (concat "^\\(\\*+\\)[ \t]+\\(?:\\("
- (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
- "\\)\\>\\)?[ \t]*\\(.*\\)")
+ (format org-heading-keyword-maybe-regexp-format org-todo-regexp)
org-complex-heading-regexp
- (concat "^\\(\\*+\\)[ \t]+\\(?:\\("
- (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
- "\\)\\>\\)?\\(?:[ \t]*\\(\\[#.\\]\\)\\)?[ \t]*\\(.*?\\)"
- "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?[ \t]*$")
+ (concat "^\\(\\*+\\)"
+ "\\(?: +" org-todo-regexp "\\)?"
+ "\\(?: +\\(\\[#.\\]\\)\\)?"
+ "\\(?: +\\(.*?\\)\\)?"
+ (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?")
+ "[ \t]*$")
org-complex-heading-regexp-format
- (concat "^\\(\\*+\\)[ \t]+\\(?:\\("
- (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
- "\\)\\>\\)?"
- "\\(?:[ \t]*\\(\\[#.\\]\\)\\)?"
- "\\(?:[ \t]*\\(?:\\[[0-9%%/]+\\]\\)\\)?" ;; stats cookie
- "[ \t]*\\(%s\\)"
- "\\(?:[ \t]*\\(?:\\[[0-9%%/]+\\]\\)\\)?" ;; stats cookie
- "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?[ \t]*$")
- org-nl-done-regexp
- (concat "\n\\*+[ \t]+"
- "\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|")
- "\\)" "\\>")
+ (concat "^\\(\\*+\\)"
+ "\\(?: +" org-todo-regexp "\\)?"
+ "\\(?: +\\(\\[#.\\]\\)\\)?"
+ "\\(?: +"
+ ;; Stats cookies can be stuck to body.
+ "\\(?:\\[[0-9%%/]+\\] *\\)?"
+ "\\(%s\\)"
+ "\\(?: *\\[[0-9%%/]+\\]\\)?"
+ "\\)"
+ (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?")
+ "[ \t]*$")
org-todo-line-tags-regexp
- (concat "^\\(\\*+\\)[ \t]+\\(?:\\("
- (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
- (org-re
- "\\)\\>\\)? *\\(.*?\\([ \t]:[[:alnum:]:_@#%]+:[ \t]*\\)?$\\)"))
- org-looking-at-done-regexp
- (concat "^" "\\(?:"
- (mapconcat 'regexp-quote org-done-keywords "\\|") "\\)"
- "\\>")
+ (concat "^\\(\\*+\\)"
+ "\\(?: +" org-todo-regexp "\\)?"
+ "\\(?: +\\(.*?\\)\\)?"
+ (org-re "\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?")
+ "[ \t]*$")
org-deadline-regexp (concat "\\<" org-deadline-string)
org-deadline-time-regexp
(concat "\\<" org-deadline-string " *<\\([^>]+\\)>")
"\\|" org-deadline-string
"\\|" org-closed-string
"\\|" org-clock-string "\\)\\)?"
- " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^]\r\n>]*?[]>]\\|<%%([^\r\n>]*>\\)")
+ " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?[]>]\\|<%%([^\r\n>]*>\\)")
org-planning-or-clock-line-re
(concat "\\(?:^[ \t]*\\(" org-scheduled-string
"\\|" org-deadline-string
;; FIXME: Occasionally check by commenting these, to make sure
;; no other functions uses these, forgetting to let-bind them.
(defvar entry)
-(defvar last-state)
+(defvar org-last-state)
(defvar date)
;; Defined somewhere in this file, but used before definition.
(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-outline-regexp' ought to be a defconst but is let-binding in
+;; some places -- e.g. see the macro org-with-limited-levels.
+;;
+;; In Org buffers, the value of `outline-regexp' is that of
+;; `org-outline-regexp'. The only function still directly relying on
+;; `outline-regexp' is `org-overview' so that `org-cycle' can do its
+;; job when `orgstruct-mode' is active.
+(defvar org-outline-regexp "\\*+ "
+ "Regexp to match Org headlines.")
+(defconst org-outline-regexp-bol "^\\*+ "
+ "Regexp to match Org headlines.
+This is similar to `org-outline-regexp' but additionally makes
+sure that we are at the beginning of the line.")
+
+(defconst org-heading-regexp "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$"
+ "Matches an headline, putting stars and text into groups.
+Stars are put in group 1 and the trimmed body in group 2.")
+
+(defvar buffer-face-mode-face)
;;;###autoload
(define-derived-mode org-mode outline-mode "Org"
(org-set-local 'line-move-ignore-invisible t))
(org-set-local 'outline-regexp org-outline-regexp)
(org-set-local 'outline-level 'org-outline-level)
+ (setq bidi-paragraph-direction 'left-to-right)
(when (and org-ellipsis
(fboundp 'set-display-table-slot) (boundp 'buffer-display-table)
(fboundp 'make-glyph-code))
;; Beginning/end of defun
(org-set-local 'beginning-of-defun-function 'org-beginning-of-defun)
(org-set-local 'end-of-defun-function 'org-end-of-defun)
+ ;; Next error for sparse trees
+ (org-set-local 'next-error-function 'org-occur-next-match)
;; Make sure dependence stuff works reliably, even for users who set it
;; too late :-(
(if org-enforce-todo-dependencies
;; Setup the pcomplete hooks
(set (make-local-variable 'pcomplete-command-completion-function)
- 'org-complete-initial)
+ 'org-pcomplete-initial)
(set (make-local-variable 'pcomplete-command-name-function)
'org-command-at-point)
(set (make-local-variable 'pcomplete-default-completion-function)
(set (make-local-variable 'pcomplete-parse-arguments-function)
'org-parse-arguments)
(set (make-local-variable 'pcomplete-termination-string) "")
+ (when (>= emacs-major-version 23)
+ (set (make-local-variable 'buffer-face-mode-face) 'org-default)
+ (buffer-face-mode))
;; If empty file that did not turn on org-mode automatically, make it to.
(if (and org-insert-mode-line-in-empty-file
- (interactive-p)
+ (org-called-interactively-p 'any)
(= (point-min) (point-max)))
(insert "# -*- mode: org -*-\n\n"))
(unless org-inhibit-startup
(defvar org-match-substring-regexp
(concat
- "\\([^\\]\\)\\([_^]\\)\\("
+ "\\([^\\]\\|^\\)\\([_^]\\)\\("
"\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)"
"\\|"
"\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)"
(defvar org-match-substring-with-braces-regexp
(concat
- "\\([^\\]\\)\\([_^]\\)\\("
+ "\\([^\\]\\|^\\)\\([_^]\\)\\("
"\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)"
"\\)")
"The regular expression matching a sub- or superscript, forcing braces.")
(org-make-link-regexps)
-(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^\r\n>]*?\\)>"
+(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)>"
"Regular expression for fast time stamp matching.")
-(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^\r\n>]*?\\)[]>]"
+(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?\\)[]>]"
"Regular expression for fast time stamp matching.")
-(defconst org-ts-regexp0 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]-+0-9>\r\n ]*\\)\\( \\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
+(defconst org-ts-regexp0 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
"Regular expression matching time strings for analysis.
This one does not require the space after the date, so it can be used
on a string that terminates immediately after the date.")
-(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) +\\([^]-+0-9>\r\n ]*\\)\\( \\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
+(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
"Regular expression matching time strings for analysis.")
(defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,16\\}>")
"Regular expression matching time stamps, with groups.")
(defvar org-emph-face nil)
(defun org-do-emphasis-faces (limit)
- "Run through the buffer and add overlays to links."
+ "Run through the buffer and add overlays to emphasized strings."
(let (rtn a)
(while (and (not rtn) (re-search-forward org-emph-re limit t))
(if (not (= (char-after (match-beginning 3))
t)))))
(defun org-activate-code (limit)
- (if (re-search-forward "^[ \t]*\\(: .*\n?\\)" limit t)
+ (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)
(defcustom org-src-fontify-natively nil
"When non-nil, fontify code in code blocks."
:type 'boolean
+ :version "24.1"
:group 'org-appearance
:group 'org-babel)
(defun org-fontify-meta-lines-and-blocks (limit)
+ (condition-case nil
+ (org-fontify-meta-lines-and-blocks-1 limit)
+ (error (message "org-mode fontification error"))))
+
+(defun org-fontify-meta-lines-and-blocks-1 (limit)
"Fontify #+ lines and blocks, in the correct ways."
(let ((case-fold-search t))
(if (re-search-forward
(beg1 (line-beginning-position 2))
(dc1 (downcase (match-string 2)))
(dc3 (downcase (match-string 3)))
- end end1 quoting block-type)
+ end end1 quoting block-type ovl)
(cond
((member dc1 '("html:" "ascii:" "latex:" "docbook:"))
;; a single line of backend-specific content
(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)))
+ (setq end (min (point-max) (match-end 0))
+ end1 (min (point-max) (1- (match-beginning 0))))
(setq block-end (match-beginning 0))
(when quoting
(remove-text-properties beg end
beg end
'(font-lock-fontified t font-lock-multiline t))
(add-text-properties beg beg1 '(face org-meta-line))
- (add-text-properties end1 (+ end 1) '(face org-meta-line))
- ; for end_src
+ (add-text-properties end1 (min (point-max) (1+ end))
+ '(face org-meta-line)) ; for end_src
(cond
- ((and lang org-src-fontify-natively)
- (org-src-font-lock-fontify-block lang block-start block-end))
+ ((and lang (not (string= lang "")) org-src-fontify-natively)
+ (org-src-font-lock-fontify-block lang block-start block-end)
+ ;; remove old background overlays
+ (mapc (lambda (ov)
+ (if (eq (overlay-get ov 'face) 'org-block-background)
+ (delete-overlay ov)))
+ (overlays-at (/ (+ beg1 block-end) 2)))
+ ;; add a background overlay
+ (setq ovl (make-overlay beg1 block-end))
+ (overlay-put ovl 'face 'org-block-background)
+ (overlay-put ovl 'evaporate t)) ;; make it go away when empty
(quoting
- (add-text-properties beg1 (+ end1 1) '(face
- org-block)))
- ; end of source block
+ (add-text-properties beg1 (min (point-max) (1+ end1))
+ '(face org-block))) ; end of source block
((not org-fontify-quote-and-verse-blocks))
((string= block-type "quote")
- (add-text-properties beg1 end1 '(face org-quote)))
+ (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-quote)))
((string= block-type "verse")
- (add-text-properties beg1 end1 '(face org-verse))))
+ (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-verse))))
+ (add-text-properties beg beg1 '(face org-block-begin-line))
+ (add-text-properties (min (point-max) (1+ end)) (min (point-max) (1+ end1))
+ '(face org-block-end-line))
t))
((member dc1 '("title:" "author:" "email:" "date:"))
(add-text-properties
'(font-lock-fontified t face org-meta-line))
t)
((or (member dc1 '("begin:" "end:" "caption:" "label:"
- "orgtbl:" "tblfm:" "tblname:" "result:"
- "results:" "source:" "srcname:" "call:"))
+ "orgtbl:" "tblfm:" "tblname:" "results:"
+ "call:" "header:" "headers:" "name:"))
(and (match-end 4) (equal dc3 "attr")))
(add-text-properties
beg (match-end 0)
'(font-lock-fontified t face font-lock-comment-face)))
(t nil))))))
+(defun org-strip-protective-commas (beg end)
+ "Strip protective commas between BEG and END in the current buffer."
+ (interactive "r")
+ (save-excursion
+ (save-match-data
+ (goto-char beg)
+ (let ((front-line (save-excursion
+ (re-search-forward
+ "[^[:space:]]" end t)
+ (goto-char (match-beginning 0))
+ (current-column))))
+ (while (re-search-forward "^[ \t]*\\(,\\)\\([*]\\|#\\+\\)" end t)
+ (goto-char (match-beginning 1))
+ (when (= (current-column) front-line)
+ (replace-match "" nil nil nil 1)))))))
+
(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)
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:]+?[]:]\\)\\)"
- limit t)
- (progn
- (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
- (add-text-properties (match-beginning 2) (match-end 2)
+ "Run through the buffer and add overlays to footnotes."
+ (let ((fn (org-footnote-next-reference-or-definition limit)))
+ (when fn
+ (let ((beg (nth 1 fn)) (end (nth 2 fn)))
+ (org-remove-flyspell-overlays-in beg end)
+ (add-text-properties beg end
(list 'mouse-face 'highlight
'keymap org-mouse-map
'help-echo
- (if (= (point-at-bol) (match-beginning 2))
+ (if (= (point-at-bol) beg)
"Footnote definition"
"Footnote reference")
- ))
- (org-rear-nonsticky-at (match-end 2))
- t)))
+ 'font-lock-fontified t
+ 'font-lock-multiline t
+ 'face 'org-footnote))))))
(defun org-activate-bracket-links (limit)
"Run through the buffer and add overlays to bracketed links."
"\\<\\("
(mapconcat
(lambda (x)
+ (setq x (regexp-quote x))
(while (string-match " +" x)
(setq x (replace-match "\\s-+" t t x)))
x)
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."
+Use `org-reduced-level' to remove the effect of `org-odd-levels'."
(save-excursion
- (looking-at outline-regexp)
- (if (match-beginning 1)
- (+ (org-get-string-indentation (match-string 1)) 1000)
- (1- (- (match-end 0) (match-beginning 0))))))
+ (looking-at org-outline-regexp)
+ (1- (- (match-end 0) (match-beginning 0)))))
(defvar org-font-lock-keywords nil)
-(defconst org-property-re (org-re "^[ \t]*\\(:\\([-[:alnum:]_]+\\):\\)[ \t]*\\([^ \t\r\n].*\\)")
+(defconst org-property-re (org-re "^[ \t]*\\(:\\([-[:alnum:]_]+\\+?\\):\\)[ \t]*\\([^ \t\r\n].*\\)")
"Regular expression matching a property line.")
(defvar org-font-lock-hook nil
(defvar org-font-lock-set-keywords-hook nil
"Functions that can manipulate `org-font-lock-extra-keywords'.
-This is calles after `org-font-lock-extra-keywords' is defined, but before
+This is called after `org-font-lock-extra-keywords' is defined, but before
it is installed to be used by font lock. This can be useful if something
needs to be inserted at a specific position in the font-lock sequence.")
(if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t)))
(if (memq 'radio lk) '(org-activate-target-links (0 'org-link t)))
(if (memq 'date lk) '(org-activate-dates (0 'org-date t)))
- (if (memq 'footnote lk) '(org-activate-footnote-links
- (2 'org-footnote t)))
+ (if (memq 'footnote lk) '(org-activate-footnote-links))
'("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t))
'(org-hide-wide-columns (0 nil append))
- ;; TODO lines
- (list (concat "^\\*+[ \t]+" org-todo-regexp "\\([ \t]\\|$\\)")
- '(1 (org-get-todo-face 1) t))
+ ;; TODO keyword
+ (list (format org-heading-keyword-regexp-format
+ org-todo-regexp)
+ '(2 (org-get-todo-face 2) t))
;; DONE
(if org-fontify-done-headline
- (list (concat "^[*]+ +\\<\\("
- (mapconcat 'regexp-quote org-done-keywords "\\|")
- "\\)\\(.*\\)")
+ (list (format org-heading-keyword-regexp-format
+ (concat
+ "\\(?:"
+ (mapconcat 'regexp-quote org-done-keywords "\\|")
+ "\\)"))
'(2 'org-headline-done t))
nil)
;; Priorities
'("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]"
(0 (org-get-checkbox-statistics-face) t)))
;; Description list items
- '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\(.*? ::\\)"
- 2 'bold prepend)
+ '("^[ \t]*[-+*][ \t]+\\(.*?[ \t]+::\\)\\([ \t]+\\|$\\)"
+ 1 'bold prepend)
;; ARCHIVEd headings
- (list (concat "^\\*+ \\(.*:" org-archive-tag ":.*\\)")
+ (list (concat
+ org-outline-regexp-bol
+ "\\(.*:" org-archive-tag ":.*\\)")
'(1 'org-archived prepend))
;; Specials
'(org-do-latex-and-special-faces)
;; Code
'(org-activate-code (1 'org-code t))
;; COMMENT
- (list (concat "^\\*+[ \t]+\\<\\(" org-comment-string
- "\\|" org-quote-string "\\)\\>")
- '(1 'org-special-keyword t))
+ (list (format org-heading-keyword-regexp-format
+ (concat "\\("
+ org-comment-string "\\|" org-quote-string
+ "\\)"))
+ '(2 'org-special-keyword t))
'("^#.*" (0 'font-lock-comment-face t))
;; Blocks and meta lines
'(org-fontify-meta-lines-and-blocks)
(when org-pretty-entities
(catch 'match
(while (re-search-forward
- "\\\\\\([a-zA-Z][a-zA-Z0-9]*\\)\\($\\|[^[:alnum:]\n]\\)"
+ "\\\\\\(frac[13][24]\\|[a-zA-Z]+\\)\\($\\|[^[:alpha:]\n]\\)"
limit t)
(if (and (not (org-in-indented-comment-line))
(setq ee (org-entity-get (match-string 1)))
(inhibit-modification-hooks t)
deactivate-mark buffer-file-name buffer-file-truename)
(org-decompose-region beg end)
- (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 org-emphasis t)
- '(mouse-face t keymap t org-linked-text t
- invisible t intangible t
- org-no-flyspell t org-emphasis t)))
+ (remove-text-properties beg end
+ '(mouse-face t keymap t org-linked-text t
+ invisible t intangible t
+ org-no-flyspell t org-emphasis t))
(org-remove-font-lock-display-properties beg end)))
(defconst org-script-display '(((raise -0.3) (height 0.7))
(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) "+ ")))))
+ (org-outline-regexp
+ (if (not (eq major-mode 'org-mode))
+ outline-regexp
+ (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ "))))
(bob-special (and org-cycle-global-at-bob (not arg) (bobp)
- (not (looking-at outline-regexp))))
+ (not (looking-at org-outline-regexp))))
(org-cycle-hook
(if bob-special
(delq 'org-optimize-window-after-visibility-change
(show-all)
(message "Entire buffer visible, including drawers"))
+ ;; Table: enter it or move to the next field.
((org-at-table-p 'any)
- ;; Enter the table or move to the next field in the table
(if (org-at-table.el-p)
(message "Use C-c ' to edit table.el tables")
(if arg (org-table-edit-field t)
((run-hook-with-args-until-success
'org-tab-after-check-for-table-hook))
- ((eq arg t) ;; Global cycling
- (org-cycle-internal-global))
+ ;; Global cycling: delegate to `org-cycle-internal-global'.
+ ((eq arg t) (org-cycle-internal-global))
+ ;; Drawers: delegate to `org-flag-drawer'.
((and org-drawers org-drawer-regexp
(save-excursion
(beginning-of-line 1)
(looking-at org-drawer-regexp)))
- ;; Toggle block visibility
- (org-flag-drawer
+ (org-flag-drawer ; toggle block visibility
(not (get-char-property (match-end 0) 'invisible))))
+ ;; Show-subtree, ARG levels up from here.
((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)))
- ((and (save-excursion (beginning-of-line 1) (looking-at outline-regexp))
+ ;; Inline task: delegate to `org-inlinetask-toggle-visibility'.
+ ((and (featurep 'org-inlinetask)
+ (org-inlinetask-at-task-p)
(or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
+ (org-inlinetask-toggle-visibility))
+
+ ((org-try-cdlatex-tab))
+ ;; At an item/headline: delegate to `org-cycle-internal-local'.
+ ((and (or (and org-cycle-include-plain-lists (org-at-item-p))
+ (save-excursion (beginning-of-line 1)
+ (looking-at org-outline-regexp)))
+ (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
(org-cycle-internal-local))
- ;; TAB emulation and template completion
+ ;; From there: TAB emulation and template completion.
(buffer-read-only (org-back-to-heading))
((run-hook-with-args-until-success
((org-try-structure-completion))
- ((org-try-cdlatex-tab))
-
((run-hook-with-args-until-success
'org-tab-before-tab-emulation-hook))
((and (eq org-cycle-emulate-tab 'exc-hl-bol)
(or (not (bolp))
- (not (looking-at outline-regexp))))
+ (not (looking-at org-outline-regexp))))
(call-interactively (global-key-binding "\t")))
((if (and (memq org-cycle-emulate-tab '(white whitestart))
(defun org-cycle-internal-local ()
"Do the local cycling action."
- (let ((goal-column 0) eoh eol eos level has-children children-skipped)
- ;; First, some boundaries
+ (let ((goal-column 0) eoh eol eos has-children children-skipped struct)
+ ;; First, determine end of headline (EOH), end of subtree or item
+ ;; (EOS), and if item or heading has children (HAS-CHILDREN).
(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))
+ (if (org-at-item-p)
+ (progn
+ (beginning-of-line)
+ (setq struct (org-list-struct))
+ (setq eoh (point-at-eol))
+ (setq eos (org-list-get-item-end-before-blank (point) struct))
+ (setq has-children (org-list-has-child-p (point) struct)))
+ (org-back-to-heading)
+ (setq eoh (save-excursion (outline-end-of-heading) (point)))
+ (setq eos (save-excursion
+ (org-end-of-subtree t)
+ (unless (eobp)
+ (skip-chars-forward " \t\n"))
+ (if (eobp) (point) (1- (point)))))
+ (setq has-children
+ (or (save-excursion
+ (let ((level (funcall outline-level)))
+ (outline-next-heading)
+ (and (org-at-heading-p t)
+ (> (funcall outline-level) level))))
+ (save-excursion
+ (org-list-search-forward (org-item-beginning-re) eos t)))))
+ ;; Determine end invisible part of buffer (EOL)
+ (beginning-of-line 2)
+ ;; XEmacs doesn't have `next-single-char-property-change'
+ (if (featurep 'xemacs)
(while (and (not (eobp)) ;; this is like `next-line'
(get-char-property (1- (point)) 'invisible))
- (goto-char (next-single-char-property-change (point) 'invisible))
- (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))))
- ;; if we're in a list, org-end-of-subtree is in fact org-end-of-item.
- (if (org-at-item-p)
- (setq eos (if (and (org-end-of-item) (bolp))
- (1- (point))
- (point)))
- (org-end-of-subtree t)
- (unless (eobp)
- (skip-chars-forward " \t\n"))
- (setq eos (if (eobp) (point) (1- (point))))))
+ (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))
+ (and (eolp) (beginning-of-line 2))))
+ (setq eol (point)))
;; Find out what to do next and set `this-command'
(cond
((= eos eoh)
(save-excursion
(goto-char eos)
(outline-next-heading)
- (if (org-invisible-p) (org-flag-heading nil))))
+ (if (outline-invisible-p) (org-flag-heading nil))))
((and (or (>= eol eos)
(not (string-match "\\S-" (buffer-substring eol eos))))
(or has-children
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)
+ (if (org-at-item-p)
+ (org-list-set-item-visibility (point-at-bol) struct 'children)
+ (org-show-entry)
+ (org-with-limited-levels (show-children))
+ ;; FIXME: This slows down the func way too much.
+ ;; How keep drawers hidden in subtree anyway?
+ ;; (when (memq 'org-cycle-hide-drawers org-cycle-hook)
+ ;; (org-cycle-hide-drawers 'subtree))
+
+ ;; Fold every list in subtree to top-level items.
+ (when (eq org-cycle-include-plain-lists 'integrate)
+ (save-excursion
+ (org-back-to-heading)
+ (while (org-list-search-forward (org-item-beginning-re) eos t)
+ (beginning-of-line 1)
+ (let* ((struct (org-list-struct))
+ (prevs (org-list-prevs-alist struct))
+ (end (org-list-get-bottom-point struct)))
+ (mapc (lambda (e) (org-list-set-item-visibility e struct 'folded))
+ (org-list-get-all-items (point) struct prevs))
+ (goto-char end))))))
(message "CHILDREN")
(save-excursion
(goto-char eos)
(outline-next-heading)
- (if (org-invisible-p) (org-flag-heading nil)))
+ (if (outline-invisible-p) (org-flag-heading nil)))
(setq org-cycle-subtree-status 'children)
(run-hook-with-args 'org-cycle-hook 'children))
((or children-skipped
With a numeric prefix, show all headlines up to that level."
(interactive "P")
(let ((org-cycle-include-plain-lists
- (if (org-mode-p) org-cycle-include-plain-lists nil)))
+ (if (eq major-mode 'org-mode) org-cycle-include-plain-lists nil)))
(cond
((integerp arg)
(show-all)
(org-cycle-hide-drawers 'all)
(org-cycle-show-empty-lines 'all)))))
+;; This function uses outline-regexp instead of the more fundamental
+;; org-outline-regexp so that org-cycle-global works outside of Org
+;; buffers, where outline-regexp is needed.
(defun org-overview ()
"Switch to overview mode, showing only top-level headlines.
Really, this shows all headlines with level equal or greater than the level
(outline-previous-visible-heading 1)
(error (goto-char (point-min))))
t)
- (looking-at outline-regexp))
+ (looking-at org-outline-regexp))
(if (integerp arg)
(show-children (1- arg))
(show-branches))
;; Properly fold already folded siblings
(goto-char (point-min))
(while (re-search-forward re nil t)
- (if (and (not (org-invisible-p))
+ (if (and (not (outline-invisible-p))
(save-excursion
- (goto-char (point-at-eol)) (org-invisible-p)))
+ (goto-char (point-at-eol)) (outline-invisible-p)))
(hide-entry))))
(org-cycle-show-empty-lines 'overview)
(org-cycle-hide-drawers 'overview)))))
(org-back-over-empty-lines)
(if (save-excursion
(goto-char (max (point-min) (1- (point))))
- (org-on-heading-p))
+ (org-at-heading-p))
(1- (point))
(point))))
(setq b (match-beginning 1)))
(defun org-cycle-hide-drawers (state)
"Re-hide all drawers after a visibility state change."
- (when (and (org-mode-p)
+ (when (and (eq major-mode 'org-mode)
(not (memq state '(overview folded contents))))
(save-excursion
(let* ((globalp (memq state '(contents all)))
(save-excursion
(beginning-of-line 1)
(when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:")
- (let ((b (match-end 0))
- (outline-regexp org-outline-regexp))
+ (let ((b (match-end 0)))
(if (re-search-forward
"^[ \t]*:END:"
(save-excursion (outline-next-heading) (point)) t)
"Move cursor to the first headline and recenter the headline.
Optional argument N means put the headline into the Nth line of the window."
(goto-char (point-min))
- (when (re-search-forward (concat "^\\(" outline-regexp "\\)") nil t)
+ (when (re-search-forward (concat "^\\(" org-outline-regexp "\\)") nil t)
(beginning-of-line)
(recenter (prefix-numeric-value N))))
(widen)
(show-all)
(mapc (lambda (c)
- (setq o (make-overlay (car c) (cdr c)))
- (overlay-put o 'invisible 'outline))
+ (outline-flag-region (car c) (cdr c) t))
data)))))
;;; 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)
in an indirect buffer, in overview mode. You can dive into the tree in
that copy, use org-occur and incremental search to find a location.
When pressing RET or `Q', the command returns to the original buffer in
-which the visibility is still unchanged. After RET is will also jump to
-the location selected in the indirect buffer and expose
-the headline hierarchy above."
+which the visibility is still unchanged. After RET it will also jump to
+the location selected in the indirect buffer and expose the headline
+hierarchy above."
(interactive "P")
(let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level))))
(org-refile-use-outline-path t)
(selected-point
(if (eq interface 'outline)
(car (org-get-location (current-buffer) org-goto-help))
- (let ((pa (org-refile-get-location "Goto: ")))
+ (let ((pa (org-refile-get-location "Goto" nil nil t)))
(org-refile-check-position pa)
(nth 3 pa)))))
(if selected-point
(progn
(org-mark-ring-push org-goto-start-pos)
(goto-char selected-point)
- (if (or (org-invisible-p) (org-invisible-p2))
+ (if (or (outline-invisible-p) (org-invisible-p2))
(org-show-context 'org-goto)))
(message "Quit"))))
(save-window-excursion
(delete-other-windows)
(and (get-buffer "*org-goto*") (kill-buffer "*org-goto*"))
- (switch-to-buffer
+ (org-pop-to-buffer-same-window
(condition-case nil
(make-indirect-buffer (current-buffer) "*org-goto*")
(error (make-indirect-buffer (current-buffer) "*org-goto*"))))
(org-show-siblings t)
(org-show-following-heading t))
(goto-char org-goto-start-pos)
- (and (org-invisible-p) (org-show-context)))
+ (and (outline-invisible-p) (org-show-context)))
(goto-char (point-min)))
(let (org-special-ctrl-a/e) (org-beginning-of-line))
(message "Select location and press RET")
(defun org-goto-left ()
"Finish `org-goto' by going to the new location."
(interactive)
- (if (org-on-heading-p)
+ (if (org-at-heading-p)
(progn
(beginning-of-line 1)
(setq org-goto-selected-point (point)
(defun org-goto-right ()
"Finish `org-goto' by going to the new location."
(interactive)
- (if (org-on-heading-p)
+ (if (org-at-heading-p)
(progn
(setq org-goto-selected-point (point)
org-goto-exit-command 'right)
(setq beg (point)
heading (org-get-heading))
(org-end-of-subtree t t)
- (if (org-on-heading-p) (backward-char 1))
+ (if (org-at-heading-p) (backward-char 1))
(setq end (point)))
(if (and (buffer-live-p org-last-indirect-buffer)
(not (eq org-indirect-buffer-display 'new-frame))
(and arg (eq org-indirect-buffer-display 'dedicated-frame)))
(select-frame (make-frame))
(delete-other-windows)
- (switch-to-buffer ibuf)
+ (org-pop-to-buffer-same-window ibuf)
(org-set-frame-title heading))
((eq org-indirect-buffer-display 'dedicated-frame)
(raise-frame
org-indirect-dedicated-frame)
(setq org-indirect-dedicated-frame (make-frame)))))
(delete-other-windows)
- (switch-to-buffer ibuf)
+ (org-pop-to-buffer-same-window ibuf)
(org-set-frame-title (concat "Indirect: " heading)))
((eq org-indirect-buffer-display 'current-window)
- (switch-to-buffer ibuf))
+ (org-pop-to-buffer-same-window ibuf))
((eq org-indirect-buffer-display 'other-window)
(pop-to-buffer ibuf))
(t (error "Invalid value")))
(narrow-to-region beg end)
(show-all)
(goto-char pos)
+ (run-hook-with-args 'org-cycle-hook 'all)
(and (window-live-p cwin) (select-window cwin))))
(defun org-get-indirect-buffer (&optional buffer)
(if (or (= (buffer-size) 0)
(and (not (save-excursion
(and (ignore-errors (org-back-to-heading invisible-ok))
- (org-on-heading-p))))
- (not (org-in-item-p))))
+ (org-at-heading-p))))
+ (or force-heading (not (org-in-item-p)))))
(progn
(insert "\n* ")
(run-hooks 'org-insert-heading-hook))
(when (or force-heading (not (org-insert-item)))
(let* ((empty-line-p nil)
(level nil)
- (on-heading (org-on-heading-p))
+ (on-heading (org-at-heading-p))
(head (save-excursion
(condition-case nil
(progn
;; Find a heading level before the inline task
(while (and (setq level (org-up-heading-safe))
(>= level org-inlinetask-min-level)))
- (if (org-on-heading-p)
+ (if (org-at-heading-p)
(org-back-to-heading invisible-ok)
(error "This should not happen")))
(setq empty-line-p (org-previous-line-empty-p))
(blank (if (eq blank-a 'auto) empty-line-p blank-a))
pos hide-previous previous-pos)
(cond
- ((and (org-on-heading-p) (bolp)
+ ((and (org-at-heading-p) (bolp)
(or (bobp)
- (save-excursion (backward-char 1) (not (org-invisible-p)))))
+ (save-excursion (backward-char 1) (not (outline-invisible-p)))))
;; 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)))))
+ (backward-char 1) (not (outline-invisible-p)))))
;; insert right here
nil)
(t
(save-excursion
(setq previous-pos (point-at-bol))
(end-of-line)
- (setq hide-previous (org-invisible-p)))
+ (setq hide-previous (outline-invisible-p)))
(and org-insert-heading-respect-content (org-show-subtree))
(let ((split
(and (org-get-alist-option org-M-RET-may-split-line 'headline)
(let ((p (point)))
(goto-char (point-at-bol))
(and (looking-at org-complex-heading-regexp)
+ (match-beginning 4)
(> p (match-beginning 4)))))))
tags pos)
(cond
(or (org-previous-line-empty-p)
(and blank (newline)))
(open-line 1))
- ((org-on-heading-p)
+ ((org-at-heading-p)
(when hide-previous
(show-children)
(org-show-entry))
(hide-subtree)))
(run-hooks 'org-insert-heading-hook)))))
-(defun org-get-heading (&optional no-tags)
- "Return the heading of the current entry, without the stars."
+(defun org-get-heading (&optional no-tags no-todo)
+ "Return the heading of the current entry, without the stars.
+When NO-TAGS is non-nil, don't include tags.
+When NO-TODO is non-nil, don't include TODO keywords."
(save-excursion
(org-back-to-heading t)
- (if (looking-at
- (if no-tags
- (org-re "\\*+[ \t]+\\([^\n\r]*?\\)\\([ \t]+:[[:alnum:]:_@#%]+:[ \t]*\\)?$")
- "\\*+[ \t]+\\([^\r\n]*\\)"))
- (match-string 1) "")))
+ (cond
+ ((and no-tags no-todo)
+ (looking-at org-complex-heading-regexp)
+ (match-string 4))
+ (no-tags
+ (looking-at (concat org-outline-regexp
+ "\\(.*?\\)"
+ "\\(?:[ \t]+:[[:alnum:]:_@#%]+:\\)?[ \t]*$"))
+ (match-string 1))
+ (no-todo
+ (looking-at org-todo-line-regexp)
+ (match-string 3))
+ (t (looking-at org-heading-regexp)
+ (match-string 2)))))
(defun org-heading-components ()
"Return the components of the current heading.
'org-todo-get-default-hook new-mark-x nil)
new-mark-x)))
(beginning-of-line 1)
- (and (looking-at "\\*+ ") (goto-char (match-end 0))
+ (and (looking-at org-outline-regexp) (goto-char (match-end 0))
(if org-treat-insert-todo-heading-as-state-change
(org-todo new-mark)
(insert new-mark " "))))
(interactive "P")
(org-insert-heading arg)
(cond
- ((org-on-heading-p) (org-do-demote))
+ ((org-at-heading-p) (org-do-demote))
((org-at-item-p) (org-indent-item))))
(defun org-insert-todo-subheading (arg)
(interactive "P")
(org-insert-todo-heading arg)
(cond
- ((org-on-heading-p) (org-do-demote))
+ ((org-at-heading-p) (org-do-demote))
((org-at-item-p) (org-indent-item))))
;;; Promotion and Demotion
See also `org-promote'."
(interactive)
(save-excursion
- (org-map-tree 'org-promote))
+ (org-with-limited-levels (org-map-tree 'org-promote)))
(org-fix-position-after-promote))
(defun org-demote-subtree ()
See also `org-promote'."
(interactive)
(save-excursion
- (org-map-tree 'org-demote))
+ (org-with-limited-levels (org-map-tree 'org-demote)))
(org-fix-position-after-promote))
"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
- (let ((outline-regexp (org-get-limited-outline-regexp)))
- (condition-case nil
- (progn
- (org-back-to-heading t)
- (funcall outline-level))
- (error nil)))))
+ (org-with-limited-levels
+ (if (ignore-errors (org-back-to-heading t))
+ (funcall outline-level)))))
(defun org-get-previous-line-level ()
"Return the outline depth of the last headline before the current line.
(defun org-reduced-level (l)
"Compute the effective level of a heading.
This takes into account the setting of `org-odd-levels-only'."
- (if org-odd-levels-only (1+ (floor (/ l 2))) l))
+ (cond
+ ((zerop l) 0)
+ (org-odd-levels-only (1+ (floor (/ l 2))))
+ (t l)))
(defun org-level-increment ()
"Return the number of stars that will be added or removed at a
in the region."
(org-back-to-heading t)
(let* ((level (save-match-data (funcall outline-level)))
+ (after-change-functions (remove 'flyspell-after-change-function
+ after-change-functions))
(up-head (concat (make-string (org-get-valid-level level -1) ?*) " "))
(diff (abs (- level (length up-head) -1))))
- (if (= level 1) (error "Cannot promote to level 0. UNDO to recover if necessary"))
+ (if (= level 1) (error "Cannot promote to level 0. UNDO to recover if necessary"))
(replace-match up-head nil t)
;; Fixup tag positioning
(and org-auto-align-tags (org-set-tags nil t))
in the region."
(org-back-to-heading t)
(let* ((level (save-match-data (funcall outline-level)))
+ (after-change-functions (remove 'flyspell-after-change-function
+ after-change-functions))
(down-head (concat (make-string (org-get-valid-level level 1) ?*) " "))
(diff (abs (- level (length down-head) -1))))
(replace-match down-head nil t)
(save-excursion
(setq end (copy-marker end))
(goto-char beg)
- (if (and (re-search-forward (concat "^" outline-regexp) nil t)
+ (if (and (re-search-forward org-outline-regexp-bol nil t)
(< (point) end))
(funcall fun))
(while (and (progn
(not (eobp)))
(funcall fun)))))
+(defvar org-property-end-re) ; silence byte-compiler
(defun org-fixup-indentation (diff)
"Change the indentation in the current entry by DIFF.
However, if any line in the current entry has no indentation, or if it
level 5 etc."
(interactive)
(when (yes-or-no-p "Are you sure you want to globally change levels to odd? ")
- (let ((outline-regexp org-outline-regexp)
- (outline-level 'org-outline-level)
+ (let ((outline-level 'org-outline-level)
(org-odd-levels-only nil) n)
(save-excursion
(goto-char (point-min))
'org-get-last-sibling))
(ins-point (make-marker))
(cnt (abs arg))
+ (col (current-column))
beg beg0 end txt folded ne-beg ne-end ne-ins ins-end)
;; Select the tree
(org-back-to-heading)
(setq beg (point)))
(save-match-data
(save-excursion (outline-end-of-heading)
- (setq folded (org-invisible-p)))
+ (setq folded (outline-invisible-p)))
(outline-end-of-subtree))
(outline-next-heading)
(setq ne-end (org-back-over-empty-lines))
(setq beg (point))))
;; Find insertion point, with error handling
(while (> cnt 0)
- (or (and (funcall movfunc) (looking-at outline-regexp))
+ (or (and (funcall movfunc) (looking-at org-outline-regexp))
(progn (goto-char beg0)
(error "Cannot move past superior level or buffer limit")))
(setq cnt (1- cnt)))
(org-show-entry)
(show-children)
(org-cycle-hide-drawers 'children))
- (org-clean-visibility-after-subtree-move)))
+ (org-clean-visibility-after-subtree-move)
+ ;; move back to the initial column we were at
+ (move-to-column col)))
(defvar org-subtree-clip ""
"Clipboard for cut and paste of subtrees.
useful if the caller implements cut-and-paste as copy-then-paste-then-cut."
(interactive "p")
(let (beg end folded (beg0 (point)))
- (if (interactive-p)
+ (if (org-called-interactively-p 'any)
(org-back-to-heading nil) ; take what looks like a subtree
(org-back-to-heading t)) ; take what is really there
(org-back-over-empty-lines)
(skip-chars-forward " \t\r\n")
(save-match-data
(save-excursion (outline-end-of-heading)
- (setq folded (org-invisible-p)))
+ (setq folded (outline-invisible-p)))
(condition-case nil
(org-forward-same-level (1- n) t)
(error nil))
(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 tree)
- (^re (concat "^\\(" outline-regexp "\\)"))
- (re (concat "\\(" outline-regexp "\\)"))
- (^re_ (concat "\\(\\*+\\)[ \t]*"))
-
- (old-level (if (string-match ^re txt)
- (- (match-end 0) (match-beginning 0) 1)
- -1))
- (force-level (cond (level (prefix-numeric-value level))
- ((and (looking-at "[ \t]*$")
- (string-match
- ^re_ (buffer-substring
- (point-at-bol) (point))))
- (- (match-end 1) (match-beginning 1)))
- ((and (bolp)
- (looking-at org-outline-regexp))
- (- (match-end 0) (point) 1))
- (t nil)))
- (previous-level (save-excursion
- (condition-case nil
- (progn
- (outline-previous-visible-heading 1)
- (if (looking-at re)
- (- (match-end 0) (match-beginning 0) 1)
- 1))
- (error 1))))
- (next-level (save-excursion
- (condition-case nil
- (progn
- (or (looking-at outline-regexp)
- (outline-next-visible-heading 1))
- (if (looking-at re)
- (- (match-end 0) (match-beginning 0) 1)
- 1))
- (error 1))))
- (new-level (or force-level (max previous-level next-level)))
- (shift (if (or (= old-level -1)
- (= new-level -1)
- (= old-level new-level))
- 0
- (- new-level old-level)))
- (delta (if (> shift 0) -1 1))
- (func (if (> shift 0) 'org-demote 'org-promote))
- (org-odd-levels-only nil)
- beg end newend)
- ;; Remove the forced level indicator
- (if force-level
- (delete-region (point-at-bol) (point)))
- ;; Paste
- (beginning-of-line 1)
- (unless for-yank (org-back-over-empty-lines))
- (setq beg (point))
- (and (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt))
- (insert-before-markers txt)
- (unless (string-match "\n\\'" txt) (insert "\n"))
- (setq newend (point))
- (org-reinstall-markers-in-region beg)
- (setq end (point))
- (goto-char beg)
- (skip-chars-forward " \t\n\r")
- (setq beg (point))
- (if (and (org-invisible-p) visp)
- (save-excursion (outline-show-heading)))
- ;; Shift if necessary
- (unless (= shift 0)
- (save-restriction
- (narrow-to-region beg end)
- (while (not (= shift 0))
- (org-map-region func (point-min) (point-max))
- (setq shift (+ delta shift)))
- (goto-char (point-min))
- (setq newend (point-max))))
- (when (or (interactive-p) for-yank)
- (message "Clipboard pasted as level %d subtree" new-level))
- (if (and (not for-yank) ; in this case, org-yank will decide about folding
- kill-ring
- (eq org-subtree-clip (current-kill 0))
- org-subtree-clip-folded)
- ;; The tree was folded before it was killed/copied
- (hide-subtree))
- (and for-yank (goto-char newend))))
+ (org-with-limited-levels
+ (let* ((visp (not (outline-invisible-p)))
+ (txt tree)
+ (^re_ "\\(\\*+\\)[ \t]*")
+ (old-level (if (string-match org-outline-regexp-bol txt)
+ (- (match-end 0) (match-beginning 0) 1)
+ -1))
+ (force-level (cond (level (prefix-numeric-value level))
+ ((and (looking-at "[ \t]*$")
+ (string-match
+ "^\\*+$" (buffer-substring
+ (point-at-bol) (point))))
+ (- (match-end 1) (match-beginning 1)))
+ ((and (bolp)
+ (looking-at org-outline-regexp))
+ (- (match-end 0) (point) 1))
+ (t nil)))
+ (previous-level (save-excursion
+ (condition-case nil
+ (progn
+ (outline-previous-visible-heading 1)
+ (if (looking-at ^re_)
+ (- (match-end 0) (match-beginning 0) 1)
+ 1))
+ (error 1))))
+ (next-level (save-excursion
+ (condition-case nil
+ (progn
+ (or (looking-at org-outline-regexp)
+ (outline-next-visible-heading 1))
+ (if (looking-at ^re_)
+ (- (match-end 0) (match-beginning 0) 1)
+ 1))
+ (error 1))))
+ (new-level (or force-level (max previous-level next-level)))
+ (shift (if (or (= old-level -1)
+ (= new-level -1)
+ (= old-level new-level))
+ 0
+ (- new-level old-level)))
+ (delta (if (> shift 0) -1 1))
+ (func (if (> shift 0) 'org-demote 'org-promote))
+ (org-odd-levels-only nil)
+ beg end newend)
+ ;; Remove the forced level indicator
+ (if force-level
+ (delete-region (point-at-bol) (point)))
+ ;; Paste
+ (beginning-of-line (if (bolp) 1 2))
+ (unless for-yank (org-back-over-empty-lines))
+ (setq beg (point))
+ (and (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt))
+ (insert-before-markers txt)
+ (unless (string-match "\n\\'" txt) (insert "\n"))
+ (setq newend (point))
+ (org-reinstall-markers-in-region beg)
+ (setq end (point))
+ (goto-char beg)
+ (skip-chars-forward " \t\n\r")
+ (setq beg (point))
+ (if (and (outline-invisible-p) visp)
+ (save-excursion (outline-show-heading)))
+ ;; Shift if necessary
+ (unless (= shift 0)
+ (save-restriction
+ (narrow-to-region beg end)
+ (while (not (= shift 0))
+ (org-map-region func (point-min) (point-max))
+ (setq shift (+ delta shift)))
+ (goto-char (point-min))
+ (setq newend (point-max))))
+ (when (or (org-called-interactively-p 'interactive) for-yank)
+ (message "Clipboard pasted as level %d subtree" new-level))
+ (if (and (not for-yank) ; in this case, org-yank will decide about folding
+ kill-ring
+ (eq org-subtree-clip (current-kill 0))
+ org-subtree-clip-folded)
+ ;; The tree was folded before it was killed/copied
+ (hide-subtree))
+ (and for-yank (goto-char newend)))))
(defun org-kill-is-subtree-p (&optional txt)
"Check if the current kill is an outline subtree, or a set of trees.
which is OK for `org-paste-subtree'.
If optional TXT is given, check this string instead of the current kill."
(let* ((kill (or txt (and kill-ring (current-kill 0)) ""))
+ (re (org-get-limited-outline-regexp))
+ (^re (concat "^" re))
(start-level (and kill
- (string-match (concat "\\`\\([ \t\n\r]*?\n\\)?\\("
- org-outline-regexp "\\)")
- kill)
+ (string-match
+ (concat "\\`\\([ \t\n\r]*?\n\\)?\\(" re "\\)")
+ kill)
(- (match-end 2) (match-beginning 2) 1)))
- (re (concat "^" org-outline-regexp))
(start (1+ (or (match-beginning 2) -1))))
(if (not start-level)
(progn
nil) ;; does not even start with a heading
(catch 'exit
- (while (setq start (string-match re kill (1+ start)))
+ (while (setq start (string-match ^re kill (1+ start)))
(when (< (- (match-end 0) (match-beginning 0) 1) start-level)
(throw 'exit nil)))
t))))
(interactive)
(save-excursion
(save-match-data
- (narrow-to-region
- (progn (org-back-to-heading t) (point))
- (progn (org-end-of-subtree t t)
- (if (and (org-on-heading-p) (not (eobp))) (backward-char 1))
- (point))))))
+ (org-with-limited-levels
+ (narrow-to-region
+ (progn (org-back-to-heading t) (point))
+ (progn (org-end-of-subtree t t)
+ (if (and (org-at-heading-p) (not (eobp))) (backward-char 1))
+ (point)))))))
+
+(defun org-narrow-to-block ()
+ "Narrow buffer to the current block."
+ (interactive)
+ (let* ((case-fold-search t)
+ (blockp (org-between-regexps-p "^[ \t]*#\\+begin_.*"
+ "^[ \t]*#\\+end_.*")))
+ (if blockp
+ (narrow-to-region (car blockp) (cdr blockp))
+ (error "Not in a block"))))
(eval-when-compile
(defvar org-property-drawer-re))
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,
+In 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 idprop
- shift-n shift-what doshift nmin nmax (n-no-remove -1))
+ shift-n shift-what doshift nmin nmax (n-no-remove -1)
+ (drawer-re org-drawer-regexp))
(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)))
(setq end (point))
(setq template (buffer-substring beg end))
(when (and doshift
- (string-match "<[^<>\n]+ \\+[0-9]+[dwmy][^<>\n]*>" template))
+ (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))
(insert template)
(org-mode)
(goto-char (point-min))
+ (org-show-subtree)
(and idprop (if org-clone-delete-id
(org-entry-delete nil "ID")
(org-id-get-create t)))
- (while (re-search-forward org-property-start-re nil t)
- (org-remove-empty-drawer-at "PROPERTIES" (point)))
+ (unless (= n 0)
+ (while (re-search-forward "^[ \t]*CLOCK:.*$" nil t)
+ (kill-whole-line))
+ (goto-char (point-min))
+ (while (re-search-forward drawer-re nil t)
+ (mapc (lambda (d)
+ (org-remove-empty-drawer-at d (point))) org-drawers)))
(goto-char (point-min))
(when doshift
(while (re-search-forward org-ts-regexp-both nil t)
(while (re-search-forward org-ts-regexp nil t)
(save-excursion
(goto-char (match-beginning 0))
- (if (looking-at "<[^<>\n]+\\( +\\+[0-9]+[dwmy]\\)")
+ (if (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[dwmy]\\)")
(delete-region (match-beginning 1) (match-end 1)))))))
(setq task (buffer-string)))
(insert task))
(defun org-sort (with-case)
"Call `org-sort-entries', `org-table-sort-lines' or `org-sort-list'.
-Optional argument WITH-CASE means sort case-sensitively.
-With a double prefix argument, also remove duplicate entries."
+Optional argument WITH-CASE means sort case-sensitively."
(interactive "P")
(cond
((org-at-table-p) (org-call-with-arg 'org-table-sort-lines with-case))
(setq end (region-end)
what "region")
(goto-char (region-beginning))
- (if (not (org-on-heading-p)) (outline-next-heading))
+ (if (not (org-at-heading-p)) (outline-next-heading))
(setq start (point)))
- ((or (org-on-heading-p)
+ ((or (org-at-heading-p)
(condition-case nil (progn (org-back-to-heading) t) (error nil)))
;; we will sort the children of the current headline
(org-back-to-heading)
(t
;; we will sort the top-level entries in this file
(goto-char (point-min))
- (or (org-on-heading-p) (outline-next-heading))
+ (or (org-at-heading-p) (outline-next-heading))
(setq start (point))
(goto-char (point-max))
(beginning-of-line 1)
(looking-at "\\(\\*+\\)")
(setq stars (match-string 1)
re (concat "^" (regexp-quote stars) " +")
- re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[^*]")
+ re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[ \t\n]")
txt (buffer-substring beg end))
(if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n")))
(if (and (not (equal stars "*")) (string-match re2 txt))
(prog1 (or (and (memq 'table contexts)
(looking-at "[ \t]*|"))
(and (memq 'headline contexts)
-;;????????? (looking-at "\\*+"))
- (looking-at outline-regexp))
+ (looking-at org-outline-regexp))
(and (memq 'item contexts)
(looking-at "[ \t]*\\([-+*] \\|[0-9]+[.)] \\)"))
(and (memq 'item-body contexts)
x nil))
varlist))))
+(defun org-clone-local-variables (from-buffer &optional regexp)
+ "Clone local variables from FROM-BUFFER.
+Optional argument REGEXP selects variables to clone."
+ (mapc
+ (lambda (pair)
+ (and (symbolp (car pair))
+ (or (null regexp)
+ (string-match regexp (symbol-name (car pair))))
+ (set (make-local-variable (car pair))
+ (cdr pair))))
+ (buffer-local-variables from-buffer)))
+
;;;###autoload
(defun org-run-like-in-org-mode (cmd)
"Run a command, pretending that the current buffer is in Org-mode.
;;;; Archiving
-(defun org-get-category (&optional pos)
+(defun org-get-category (&optional pos force-refresh)
"Get the category applying to position POS."
- (get-text-property (or pos (point)) 'org-category))
+ (save-match-data
+ (if force-refresh (org-refresh-category-properties))
+ (let ((pos (or pos (point))))
+ (or (get-text-property pos 'org-category)
+ (progn (org-refresh-category-properties)
+ (get-text-property pos 'org-category))))))
(defun org-refresh-category-properties ()
"Refresh category text properties in the buffer."
(org-back-to-heading t)
(setq beg (point) end (org-end-of-subtree t t)))
(put-text-property beg end 'org-category cat)
+ (put-text-property beg end 'org-category-position beg)
(goto-char pos)))))))
(defun org-link-expand-abbrev (link)
"Apply replacements as defined in `org-link-abbrev-alist."
- (if (string-match "^\\([a-zA-Z][-_a-zA-Z0-9]*\\)\\(::?\\(.*\\)\\)?$" link)
+ (if (string-match "^\\([^:]*\\)\\(::?\\(.*\\)\\)?$" link)
(let* ((key (match-string 1 link))
(as (or (assoc key org-link-abbrev-alist-local)
(assoc key org-link-abbrev-alist)))
It should be a function accepting three arguments:
path the path of the link, the text after the prefix (like \"http:\")
- desc the description of the link, if any, nil if there was no description
+ desc the description of the link, if any, or a description added by
+ org-export-normalize-links if there is none
format the export format, a symbol like `html' or `latex' or `ascii'..
The function may use the FORMAT information to return different values
(interactive "P")
(org-load-modules-maybe)
(setq org-store-link-plist nil) ; reset
- (let ((outline-regexp (org-get-limited-outline-regexp))
- link cpltxt desc description search txt custom-id agenda-link)
- (cond
-
- ((run-hook-with-args-until-success 'org-store-link-functions)
- (setq link (plist-get org-store-link-plist :link)
- desc (or (plist-get org-store-link-plist :description) link)))
-
- ((equal (buffer-name) "*Org Edit Src Example*")
- (let (label gc)
- (while (or (not label)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (re-search-forward
- (regexp-quote (format org-coderef-label-format label))
- nil t))))
- (when label (message "Label exists already") (sit-for 2))
- (setq label (read-string "Code line label: " label)))
- (end-of-line 1)
- (setq link (format org-coderef-label-format label))
- (setq gc (- 79 (length link)))
- (if (< (current-column) gc) (org-move-to-column gc t) (insert " "))
- (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
- (setq agenda-link
- (if (interactive-p)
- (call-interactively 'org-store-link)
- (org-store-link nil)))))))
-
- ((eq major-mode 'calendar-mode)
- (let ((cd (calendar-cursor-to-date)))
- (setq link
- (format-time-string
- (car org-time-stamp-formats)
- (apply 'encode-time
- (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd)
- nil nil nil))))
- (org-store-link-props :type "calendar" :date cd)))
-
- ((eq major-mode 'w3-mode)
- (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)
- (setq cpltxt (or w3m-current-title w3m-current-url)
- link (org-make-link w3m-current-url))
- (org-store-link-props :type "w3m" :url (url-view-url t)))
-
- ((setq search (run-hook-with-args-until-success
- 'org-create-file-search-functions))
- (setq link (concat "file:" (abbreviate-file-name buffer-file-name)
- "::" search))
- (setq cpltxt (or description link)))
-
- ((eq major-mode 'image-mode)
- (setq cpltxt (concat "file:"
- (abbreviate-file-name buffer-file-name))
- link (org-make-link cpltxt))
- (org-store-link-props :type "image" :file buffer-file-name))
-
- ((eq major-mode 'dired-mode)
- ;; link to the file in the current line
- (let ((file (dired-get-filename nil t)))
- (setq file (if file
- (abbreviate-file-name
- (expand-file-name (dired-get-filename nil t)))
- ;; otherwise, no file so use current directory.
- default-directory))
- (setq cpltxt (concat "file:" file)
- link (org-make-link cpltxt))))
-
- ((and (buffer-file-name (buffer-base-buffer)) (org-mode-p))
- (setq custom-id (ignore-errors (org-entry-get nil "CUSTOM_ID")))
- (cond
- ((org-in-regexp "<<\\(.*?\\)>>")
- (setq cpltxt
- (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer)))
- "::" (match-string 1))
- link (org-make-link cpltxt)))
- ((and (featurep 'org-id)
- (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")
- (error nil)))))
- ;; We can make a link using the ID.
- (setq link (condition-case nil
- (prog1 (org-id-store-link)
- (setq desc (plist-get org-store-link-plist
- :description)))
- (error
- ;; probably before first headline, link to file only
- (concat "file:"
+ (org-with-limited-levels
+ (let (link cpltxt desc description search txt custom-id agenda-link)
+ (cond
+
+ ((run-hook-with-args-until-success 'org-store-link-functions)
+ (setq link (plist-get org-store-link-plist :link)
+ desc (or (plist-get org-store-link-plist :description) link)))
+
+ ((org-src-edit-buffer-p)
+ (let (label gc)
+ (while (or (not label)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (re-search-forward
+ (regexp-quote (format org-coderef-label-format label))
+ nil t))))
+ (when label (message "Label exists already") (sit-for 2))
+ (setq label (read-string "Code line label: " label)))
+ (end-of-line 1)
+ (setq link (format org-coderef-label-format label))
+ (setq gc (- 79 (length link)))
+ (if (< (current-column) gc) (org-move-to-column gc t) (insert " "))
+ (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
+ (setq agenda-link
+ (if (org-called-interactively-p 'any)
+ (call-interactively 'org-store-link)
+ (org-store-link nil)))))))
+
+ ((eq major-mode 'calendar-mode)
+ (let ((cd (calendar-cursor-to-date)))
+ (setq link
+ (format-time-string
+ (car org-time-stamp-formats)
+ (apply 'encode-time
+ (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd)
+ nil nil nil))))
+ (org-store-link-props :type "calendar" :date cd)))
+
+ ((eq major-mode 'w3-mode)
+ (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)
+ (setq cpltxt (or w3m-current-title w3m-current-url)
+ link (org-make-link w3m-current-url))
+ (org-store-link-props :type "w3m" :url (url-view-url t)))
+
+ ((setq search (run-hook-with-args-until-success
+ 'org-create-file-search-functions))
+ (setq link (concat "file:" (abbreviate-file-name buffer-file-name)
+ "::" search))
+ (setq cpltxt (or description link)))
+
+ ((eq major-mode 'image-mode)
+ (setq cpltxt (concat "file:"
+ (abbreviate-file-name buffer-file-name))
+ link (org-make-link cpltxt))
+ (org-store-link-props :type "image" :file buffer-file-name))
+
+ ((eq major-mode 'dired-mode)
+ ;; link to the file in the current line
+ (let ((file (dired-get-filename nil t)))
+ (setq file (if file
+ (abbreviate-file-name
+ (expand-file-name (dired-get-filename nil t)))
+ ;; otherwise, no file so use current directory.
+ default-directory))
+ (setq cpltxt (concat "file:" file)
+ link (org-make-link cpltxt))))
+
+ ((and (buffer-file-name (buffer-base-buffer)) (eq major-mode 'org-mode))
+ (setq custom-id (org-entry-get nil "CUSTOM_ID"))
+ (cond
+ ((org-in-regexp "<<\\(.*?\\)>>")
+ (setq cpltxt
+ (concat "file:"
+ (abbreviate-file-name
+ (buffer-file-name (buffer-base-buffer)))
+ "::" (match-string 1))
+ link (org-make-link cpltxt)))
+ ((and (featurep 'org-id)
+ (or (eq org-link-to-org-use-id t)
+ (and (eq org-link-to-org-use-id 'create-if-interactive)
+ (org-called-interactively-p 'any))
+ (and (eq org-link-to-org-use-id
+ 'create-if-interactive-and-no-custom-id)
+ (org-called-interactively-p 'any)
+ (not custom-id))
+ (and org-link-to-org-use-id
+ (org-entry-get nil "ID"))))
+ ;; We can make a link using the ID.
+ (setq link (condition-case nil
+ (prog1 (org-id-store-link)
+ (setq desc (plist-get org-store-link-plist
+ :description)))
+ (error
+ ;; probably before first headline, link to file only
+ (concat "file:"
+ (abbreviate-file-name
+ (buffer-file-name (buffer-base-buffer))))))))
+ (t
+ ;; Just link to current headline
+ (setq cpltxt (concat "file:"
(abbreviate-file-name
- (buffer-file-name (buffer-base-buffer))))))))
- (t
- ;; Just link to current headline
- (setq cpltxt (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer)))))
- ;; Add a context search string
- (when (org-xor org-context-in-file-links arg)
- (setq txt (cond
- ((org-on-heading-p) nil)
- ((org-region-active-p)
- (buffer-substring (region-beginning) (region-end)))
- (t nil)))
- (when (or (null txt) (string-match "\\S-" txt))
- (setq cpltxt
- (concat cpltxt "::"
- (condition-case nil
- (org-make-org-heading-search-string txt)
- (error "")))
- 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)))))
-
- ((buffer-file-name (buffer-base-buffer))
- ;; Just link to this file here.
- (setq cpltxt (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer)))))
- ;; Add a context string
- (when (org-xor org-context-in-file-links arg)
- (setq txt (if (org-region-active-p)
- (buffer-substring (region-beginning) (region-end))
- (buffer-substring (point-at-bol) (point-at-eol))))
- ;; Only use search option if there is some text.
- (when (string-match "\\S-" txt)
- (setq cpltxt
- (concat cpltxt "::" (org-make-org-heading-search-string txt))
- desc "NONE")))
- (setq link (org-make-link cpltxt)))
-
- ((interactive-p)
- (error "Cannot link to a buffer which is not visiting a file"))
-
- (t (setq link nil)))
-
- (if (consp link) (setq cpltxt (car link) link (cdr link)))
- (setq link (or link cpltxt)
- desc (or desc cpltxt))
- (if (equal desc "NONE") (setq desc nil))
-
- (if (and (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))
- (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))))
- (or agenda-link (and link (org-make-link-string link desc))))))
+ (buffer-file-name (buffer-base-buffer)))))
+ ;; Add a context search string
+ (when (org-xor org-context-in-file-links arg)
+ (setq txt (cond
+ ((org-at-heading-p) nil)
+ ((org-region-active-p)
+ (buffer-substring (region-beginning) (region-end)))
+ (t nil)))
+ (when (or (null txt) (string-match "\\S-" txt))
+ (setq cpltxt
+ (concat cpltxt "::"
+ (condition-case nil
+ (org-make-org-heading-search-string txt)
+ (error "")))
+ 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)))))
+
+ ((buffer-file-name (buffer-base-buffer))
+ ;; Just link to this file here.
+ (setq cpltxt (concat "file:"
+ (abbreviate-file-name
+ (buffer-file-name (buffer-base-buffer)))))
+ ;; Add a context string
+ (when (org-xor org-context-in-file-links arg)
+ (setq txt (if (org-region-active-p)
+ (buffer-substring (region-beginning) (region-end))
+ (buffer-substring (point-at-bol) (point-at-eol))))
+ ;; Only use search option if there is some text.
+ (when (string-match "\\S-" txt)
+ (setq cpltxt
+ (concat cpltxt "::" (org-make-org-heading-search-string txt))
+ desc "NONE")))
+ (setq link (org-make-link cpltxt)))
+
+ ((org-called-interactively-p 'interactive)
+ (error "Cannot link to a buffer which is not visiting a file"))
+
+ (t (setq link nil)))
+
+ (if (consp link) (setq cpltxt (car link) link (cdr link)))
+ (setq link (or link cpltxt)
+ desc (or desc cpltxt))
+ (if (equal desc "NONE") (setq desc nil))
+
+ (if (and (or (org-called-interactively-p 'any) executing-kbd-macro) link)
+ (progn
+ (setq org-stored-links
+ (cons (list link desc) org-stored-links))
+ (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))))
+ (or agenda-link (and link (org-make-link-string link desc)))))))
(defun org-store-link-props (&rest plist)
"Store link properties, extract names and addresses."
(cons "%T" (plist-get p :to))
(cons "%t" (or (plist-get p :toname) (plist-get p :toaddress) "?"))
(cons "%s" (plist-get p :subject))
+ (cons "%d" (plist-get p :date))
(cons "%m" (plist-get p :message-id)))))
(when (string-match "%c" fmt)
;; Check if the user wrote this message
(setq description (replace-match "{" t t description)))
(while (string-match "\\]" description)
(setq description (replace-match "}" t t description))))
- (when (equal (org-link-escape link) description)
+ (when (equal link description)
;; No description needed, it is identical
(setq description nil))
(when (and (not description)
+ (not (string-match (org-image-file-name-regexp) link))
(not (equal link (org-link-escape link))))
(setq description (org-extract-attributes link)))
- (setq link (if (string-match org-link-types-re link)
- (concat (match-string 1 link)
- (org-link-escape (substring link (match-end 1))))
- (org-link-escape link)))
+ (setq link
+ (cond ((string-match (org-image-file-name-regexp) link) link)
+ ((string-match org-link-types-re link)
+ (concat (match-string 1 link)
+ (org-link-escape (substring link (match-end 1)))))
+ (t (org-link-escape link))))
(concat "[[" link "]"
(if description (concat "[" description "]") "")
"]"))
(defconst org-link-escape-chars
- '((?\ . "%20")
- (?\[ . "%5B")
- (?\] . "%5D")
- (?\340 . "%E0") ; `a
- (?\342 . "%E2") ; ^a
- (?\347 . "%E7") ; ,c
- (?\350 . "%E8") ; `e
- (?\351 . "%E9") ; 'e
- (?\352 . "%EA") ; ^e
- (?\356 . "%EE") ; ^i
- (?\364 . "%F4") ; ^o
- (?\371 . "%F9") ; `u
- (?\373 . "%FB") ; ^u
- (?\; . "%3B")
-;; (?? . "%3F")
- (?= . "%3D")
- (?+ . "%2B")
- )
- "Association list of escapes for some characters problematic in links.
+ '(?\ ?\[ ?\] ?\; ?\= ?\+)
+ "List of characters that should be escaped in link.
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.
+ '(?\ )
+ "List of escapes for characters that are problematic in links.
This is the list that is used before handing over to the browser.")
-(defun org-link-escape (text &optional table)
- "Escape characters in TEXT that are problematic for links."
+(defun org-link-escape (text &optional table merge)
+ "Return percent escaped representation of TEXT.
+TEXT is a string with the text to escape.
+Optional argument TABLE is a list with characters that should be
+escaped. When nil, `org-link-escape-chars' is used.
+If optional argument MERGE is set, merge TABLE into
+`org-link-escape-chars'."
(if (and org-url-encoding-use-url-hexify (not table))
(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))))
-
-(defun org-link-unescape (text &optional table)
- "Reverse the action of `org-link-escape'."
- (if (and org-url-encoding-use-url-hexify (not table))
- (url-unhex-string text)
- (setq table (or table org-link-escape-chars))
- (when text
- (let ((case-fold-search t)
- (re (mapconcat (lambda (x) (regexp-quote (downcase (cdr x))))
- table "\\|")))
- (while (string-match re text)
- (setq text
- (replace-match
- (char-to-string (car (rassoc (upcase (match-string 0 text))
- table)))
- t t text)))
- text))))
+ (cond
+ ((and table merge)
+ (mapc (lambda (defchr)
+ (unless (member defchr table)
+ (setq table (cons defchr table)))) org-link-escape-chars))
+ ((null table)
+ (setq table org-link-escape-chars)))
+ (mapconcat
+ (lambda (char)
+ (if (or (member char table)
+ (< char 32) (= char 37) (> char 126))
+ (mapconcat (lambda (sequence-element)
+ (format "%%%.2X" sequence-element))
+ (or (encode-coding-char char 'utf-8)
+ (error "Unable to percent escape character: %s"
+ (char-to-string char))) "")
+ (char-to-string char))) text "")))
+
+(defun org-link-unescape (str)
+ "Unhex hexified Unicode strings as returned from the JavaScript function
+encodeURIComponent. E.g. `%C3%B6' is the german Umlaut `ö'."
+ (unless (and (null str) (string= "" str))
+ (let ((pos 0) (case-fold-search t) unhexed)
+ (while (setq pos (string-match "\\(%[0-9a-f][0-9a-f]\\)+" str pos))
+ (setq unhexed (org-link-unescape-compound (match-string 0 str)))
+ (setq str (replace-match unhexed t t str))
+ (setq pos (+ pos (length unhexed))))))
+ str)
+
+(defun org-link-unescape-compound (hex)
+ "Unhexify Unicode hex-chars. E.g. `%C3%B6' is the German Umlaut `ö'.
+Note: this function also decodes single byte encodings like
+`%E1' (\"á\") if not followed by another `%[A-F0-9]{2}' group."
+ (save-match-data
+ (let* ((bytes (cdr (split-string hex "%")))
+ (ret "")
+ (eat 0)
+ (sum 0))
+ (while bytes
+ (let* ((val (string-to-number (pop bytes) 16))
+ (shift-xor
+ (if (= 0 eat)
+ (cond
+ ((>= val 252) (cons 6 252))
+ ((>= val 248) (cons 5 248))
+ ((>= val 240) (cons 4 240))
+ ((>= val 224) (cons 3 224))
+ ((>= val 192) (cons 2 192))
+ (t (cons 0 0)))
+ (cons 6 128))))
+ (if (>= val 192) (setq eat (car shift-xor)))
+ (setq val (logxor val (cdr shift-xor)))
+ (setq sum (+ (lsh sum (car shift-xor)) val))
+ (if (> eat 0) (setq eat (- eat 1)))
+ (cond
+ ((= 0 eat) ;multi byte
+ (setq ret (concat ret (org-char-to-string sum)))
+ (setq sum 0))
+ ((not bytes) ; single byte(s)
+ (setq ret (org-link-unescape-single-byte-sequence hex))))
+ )) ;; end (while bytes
+ ret )))
+
+(defun org-link-unescape-single-byte-sequence (hex)
+ "Unhexify hex-encoded single byte character sequences."
+ (mapconcat (lambda (byte)
+ (char-to-string (string-to-number byte 16)))
+ (cdr (split-string hex "%")) ""))
(defun org-xor (a b)
"Exclusive or."
(org-load-modules-maybe)
(org-run-like-in-org-mode 'org-insert-link))
-(defun org-insert-link (&optional complete-file link-location)
+(defun org-insert-link (&optional complete-file link-location default-description)
"Insert a link. At the prompt, enter the link.
Completion can be used to insert any of the link protocol prefixes like
link description.
If the LINK-LOCATION parameter is non-nil, this value will be
-used as the link location instead of reading one interactively."
+used as the link location instead of reading one interactively.
+
+If the DEFAULT-DESCRIPTION parameter is non-nil, this value will
+be used as the default description."
(interactive "P")
(let* ((wcf (current-window-configuration))
(region (if (org-region-active-p)
(reverse org-stored-links) "\n"))))
(let ((cw (selected-window)))
(select-window (get-buffer-window "*Org Links*" 'visible))
- (setq truncate-lines t)
+ (with-current-buffer "*Org Links*" (setq truncate-lines t))
(unless (pos-visible-in-window-p (point-max))
(org-fit-window-to-buffer))
(and (window-live-p cw) (select-window cw)))
(setq desc path))))
(if org-make-link-description-function
- (setq desc (funcall org-make-link-description-function link desc)))
+ (setq desc (funcall org-make-link-description-function link desc))
+ (if default-description (setq desc default-description)))
(setq desc (read-string "Description: " desc))
(unless (string-match "\\S-" desc) (setq desc nil))
(defun org-completing-read (&rest args)
"Completing-read with SPACE being a normal character."
- (let ((minibuffer-local-completion-map
+ (let ((enable-recursive-minibuffers t)
+ (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)
+ (org-defkey minibuffer-local-completion-map (kbd "C-c !") 'org-time-stamp-inactive)
(apply 'org-icompleting-read args)))
(defun org-completing-read-no-i (&rest 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))
+ (mapcar 'car (nth 1 args))
(nth 1 args))
(cddr args)))
(if (and org-completion-use-iswitchb
(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))
+ (mapcar 'car (nth 1 args))
(nth 1 args))
(cddr args))
(apply 'completing-read args)))))
(if (re-search-forward org-any-link-re nil t)
(progn
(goto-char (match-beginning 0))
- (if (org-invisible-p) (org-show-context)))
+ (if (outline-invisible-p) (org-show-context)))
(goto-char pos)
(setq org-link-search-failed t)
(error "No further link found"))))
(if (re-search-backward org-any-link-re nil t)
(progn
(goto-char (match-beginning 0))
- (if (org-invisible-p) (org-show-context)))
+ (if (outline-invisible-p) (org-show-context)))
(goto-char pos)
(setq org-link-search-failed t)
(error "No further link found"))))
(org-open-at-point 'in-emacs))
(defun org-open-at-mouse (ev)
- "Open file link or URL at mouse."
+ "Open file link or URL at mouse.
+See the docstring of `org-open-file' for details."
(interactive "e")
(mouse-set-point ev)
(if (eq major-mode 'org-agenda-mode)
(interactive "sLink: \nP")
(let ((reference-buffer (or reference-buffer (current-buffer))))
(with-temp-buffer
- (let ((org-inhibit-startup t))
+ (let ((org-inhibit-startup (not reference-buffer)))
(org-mode)
(insert s)
(goto-char (point-min))
a link at point. If they don't find anything interesting at point,
they must return nil.")
-(defun org-open-at-point (&optional in-emacs reference-buffer)
+(defun org-open-at-point (&optional arg 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 line.
Normally, files will be opened by an appropriate application. If the
-optional argument IN-EMACS is non-nil, Emacs will visit the file.
+optional prefix argument ARG is non-nil, Emacs will visit the file.
With a double prefix argument, try to open outside of Emacs, in the
application the system uses for this file type."
(interactive "P")
(setq org-window-config-before-follow-link (current-window-configuration))
(org-remove-occur-highlights nil nil t)
(cond
- ((and (org-on-heading-p)
+ ((and (org-at-heading-p)
(not (org-in-regexp
(concat org-plain-link-re "\\|"
org-bracket-link-regexp "\\|"
org-angle-link-re "\\|"
"[ \t]:[^ \t\n]+:[ \t]*$")))
(not (get-text-property (point) 'org-linked-text)))
- (or (org-offer-links-in-entry in-emacs)
+ (or (org-offer-links-in-entry arg)
(progn (require 'org-attach) (org-attach-reveal 'if-exists))))
((run-hook-with-args-until-success 'org-open-at-point-functions))
((org-at-timestamp-p t) (org-follow-timestamp-link))
pos (if (get-text-property (1+ (point)) 'org-linked-text)
(1+ (point)) (point))
path (buffer-substring
- (previous-single-property-change pos 'org-linked-text)
- (next-single-property-change pos 'org-linked-text)))
+ (or (previous-single-property-change pos 'org-linked-text)
+ (point-min))
+ (or (next-single-property-change pos 'org-linked-text)
+ (point-max))))
(throw 'match t))
(save-excursion
(when (or (org-in-regexp org-angle-link-re)
(org-in-regexp org-plain-link-re))
- (setq type (match-string 1) path (match-string 2))
+ (setq type (match-string 1)
+ path (org-link-unescape (match-string 2)))
(throw 'match t)))
(save-excursion
(when (org-in-regexp (org-re "\\(:[[:alnum:]_@#%:]+\\):[ \t]*$"))
(apply cmd (nreverse args1))))
((member type '("http" "https" "ftp" "news"))
- (browse-url (concat type ":" (org-link-escape
- path org-link-escape-chars-browser))))
+ (browse-url (concat type ":" (if (org-string-match-p "[[:nonascii:] ]" path)
+ (org-link-escape
+ path org-link-escape-chars-browser)
+ path))))
((string= type "doi")
- (browse-url (concat "http://dx.doi.org/"
- (org-link-escape
- path org-link-escape-chars-browser))))
+ (browse-url (concat "http://dx.doi.org/" (if (org-string-match-p "[[:nonascii:] ]" path)
+ (org-link-escape
+ path org-link-escape-chars-browser)
+ path))))
((member type '("message"))
(browse-url (concat type ":" path)))
((string= type "tags")
- (org-tags-view in-emacs path))
+ (org-tags-view arg path))
((string= type "tree-match")
(org-occur (concat "\\[" (regexp-quote 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)))
+ (org-open-file path arg line search)))
((string= type "shell")
(let ((cmd path))
- (if (or (not org-confirm-shell-link-function)
+ (if (or (and (not (string= org-confirm-shell-link-not-regexp ""))
+ (string-match org-confirm-shell-link-not-regexp cmd))
+ (not org-confirm-shell-link-function)
(funcall org-confirm-shell-link-function
(format "Execute \"%s\" in shell? "
(org-add-props cmd nil
((string= type "elisp")
(let ((cmd path))
- (if (or (not org-confirm-elisp-link-function)
+ (if (or (and (not (string= org-confirm-elisp-link-not-regexp ""))
+ (string-match org-confirm-elisp-link-not-regexp cmd))
+ (not org-confirm-elisp-link-function)
(funcall org-confirm-elisp-link-function
(format "Execute \"%s\" as elisp? "
(org-add-props cmd nil
'org-open-link-functions path)))
((string= type "thisfile")
- (if in-emacs
+ (if arg
(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)
+ ,(cond ((equal arg '(4)) ''occur)
+ ((equal arg '(16)) ''org-occur)
(t nil))
,pos)))
- (condition-case nil (eval cmd)
+ (condition-case nil (let ((org-link-search-inhibit-query t))
+ (eval cmd))
(error (progn (widen) (eval cmd))))))
(t
((equal (length links) 1)
(setq link (list (car links))))
((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth)))
- (setq link (nth (if have-zero nth (1- nth)) links)))
+ (setq link (list (nth (if have-zero nth (1- nth)) links))))
(t ; we have to select a link
(save-excursion
(save-window-excursion
(set-window-configuration org-window-config-before-follow-link)")
(defvar org-link-search-inhibit-query nil) ;; dynamically scoped
-(defun org-link-search (s &optional type avoid-pos)
+(defun org-link-search (s &optional type avoid-pos stealth)
"Search for a link search option.
If S is surrounded by forward slashes, it is interpreted as a
regular expression. In org-mode files, this will create an `org-occur'
sparse tree. In ordinary files, `occur' will be used to list matches.
If the current buffer is in `dired-mode', grep will be used to search
-in all files. If AVOID-POS is given, ignore matches near that position."
+in all files. If AVOID-POS is given, ignore matches near that position.
+
+When optional argument STEALTH is non-nil, do not modify
+visibility around point, thus ignoring
+`org-show-hierarchy-above', `org-show-following-heading' and
+`org-show-siblings' variables."
(let ((case-fold-search t)
(s0 (mapconcat 'identity (org-split-string s "[ \t\r\n]+") " "))
(markers (concat "\\(?:" (mapconcat (lambda (x) (regexp-quote (car x)))
((string-match "^/\\(.*\\)/$" s)
;; A regular expression
(cond
- ((org-mode-p)
+ ((eq major-mode 'org-mode)
(org-occur (match-string 1 s)))
;;((eq major-mode 'dired-mode)
;; (grep (concat "grep -n -e '" (match-string 1 s) "' *")))
(t (org-do-occur (match-string 1 s)))))
- ((and (org-mode-p) org-link-search-must-match-exact-headline)
+ ((and (eq major-mode 'org-mode) org-link-search-must-match-exact-headline)
(and (equal (string-to-char s) ?*) (setq s (substring s 1)))
(goto-char (point-min))
(cond
(goto-char (match-beginning 1))
(goto-char pos)
(error "No match"))))))
- (and (org-mode-p) (org-show-context 'link-search))
+ (and (eq major-mode 'org-mode)
+ (not stealth)
+ (org-show-context 'link-search))
type))
(defun org-search-not-self (group &rest args)
(setq p org-mark-ring))
(setq org-mark-ring-last-goto p)
(setq m (car p))
- (switch-to-buffer (marker-buffer m))
+ (org-pop-to-buffer-same-window (marker-buffer m))
(goto-char m)
- (if (or (org-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto))))
+ (if (or (outline-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto))))
(defun org-remove-angle-brackets (s)
(if (equal (substring s 0 1) "<") (setq s (substring s 1)))
;;; Following file links
+(declare-function mailcap-parse-mailcaps "mailcap" (&optional path force))
+(declare-function mailcap-extension-to-mime "mailcap" (extn))
+(declare-function mailcap-mime-info
+ "mailcap" (string &optional request no-decode))
(defvar org-wait nil)
(defun org-open-file (path &optional in-emacs line search)
"Open the file at PATH.
to search for. If LINE or SEARCH is given, the file will be
opened in Emacs, unless an entry from org-file-apps that makes
use of groups in a regexp matches.
+
+If you want to change the way frames are used when following a
+link, please customize `org-link-frame-setup'.
+
If the file does not exist, an error is thrown."
(let* ((file (if (equal path "")
buffer-file-name
match)
(progn (setq in-emacs (or in-emacs line search))
nil))) ; if we have no match in apps-dlink,
- ; always open the file in emacs if line or search
- ; is given (for backwards compatibility)
+ ; always open the file in emacs if line or search
+ ; is given (for backwards compatibility)
(assoc-default dfile (org-apps-regexp-alist apps a-m-a-p)
'string-match)
(cdr (assoc ext apps))
(set-match-data link-match-data)
(eval cmd))))
(t (funcall (cdr (assq 'file org-link-frame-setup)) file)))
- (and (org-mode-p) (eq old-mode 'org-mode)
+ (and (eq major-mode 'org-mode) (eq old-mode 'org-mode)
(or (not (equal old-buffer (current-buffer)))
(not (equal old-pos (point))))
(org-mark-ring-push old-pos old-buffer))))
(defvar org-refile-cache nil
"Cache for refile targets.")
-
(defvar org-refile-markers nil
"All the markers used for caching refile locations.")
org-refile-cache))))
(and set (org-refile-cache-check-set set) set)))))
-(defun org-get-refile-targets (&optional default-buffer)
+(defun org-refile-get-targets (&optional default-buffer excluded-entries)
"Produce a table with refile targets."
(let ((case-fold-search nil)
;; otherwise org confuses "TODO" as a kw and "Todo" as a word
(save-match-data
(or (funcall org-refile-target-verify-function)
(throw 'next t))))
- (when (looking-at org-complex-heading-regexp)
+ (when (and (looking-at org-complex-heading-regexp)
+ (not (member (match-string 4) excluded-entries))
+ (match-string 4))
(setq level (org-reduced-level
(- (match-end 1) (match-beginning 1)))
txt (org-link-display-format (match-string 4))
(interactive "P")
(let* ((bfn (buffer-file-name (buffer-base-buffer)))
(case-fold-search nil)
- (path (and (org-mode-p) (org-get-outline-path))))
+ (path (and (eq major-mode 'org-mode) (org-get-outline-path))))
(if current (setq path (append path
(save-excursion
(org-back-to-heading t)
(defvar org-capture-last-stored-marker)
(defun org-refile (&optional goto default-buffer rfloc)
- "Move the entry at point to another heading.
+ "Move the entry or entries 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
-and will therefore always be up-to-date.
+`org-refile-targets', which see.
-At the target location, the entry is filed as a subitem of the target heading.
-Depending on `org-reverse-note-order', the new subitem will either be the
-first or the last subitem.
+At the target location, the entry is filed as a subitem of the target
+heading. Depending on `org-reverse-note-order', the new subitem will
+either be the first or the last subitem.
If there is an active region, all entries in that region will be moved.
However, the region must fulfill the requirement that the first heading
is the first one sets the top-level of the moved text - at most siblings
below it are allowed.
-With prefix arg GOTO, the command will only visit the target location,
-not actually move anything.
+With prefix arg GOTO, the command will only visit the target location
+and not actually move anything.
+
With a double prefix arg \\[universal-argument] \\[universal-argument], \
-go to the location where the last refiling
-operation has put the subtree.
+go to the location where the last refiling 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.
If you are using target caching (see `org-refile-use-cache'),
You have to clear the target cache in order to find new targets.
-This can be done with a 0 prefix: `C-0 C-c C-w'"
+This can be done with a 0 prefix (`C-0 C-c C-w') or a triple
+prefix argument (`C-u C-u C-u C-c C-w')."
+
(interactive "P")
(if (member goto '(0 (64)))
(org-refile-cache-clear)
(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))
+ (unless (or (org-kill-is-subtree-p
+ (buffer-substring region-start region-end))
+ (prog1 org-refile-active-region-within-subtree
+ (org-toggle-heading)))
(error "The region is not a (sequence of) subtree(s)")))
(if (equal goto '(16))
(org-refile-goto-last-stored)
(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)))))
+ (let (heading-text)
+ (save-excursion
+ (unless goto
+ (org-back-to-heading t)
+ (setq heading-text
+ (nth 4 (org-heading-components))))
+ (org-refile-get-location
+ (cond (goto "Goto")
+ (regionp "Refile region to")
+ (t (concat "Refile subtree \""
+ heading-text "\" to")))
+ default-buffer
+ (and (not (equal '(4) goto))
+ org-refile-allow-creating-parent-nodes)
+ goto))))))
(setq file (nth 1 it)
re (nth 2 it)
pos (nth 3 it))
(find-file-noselect file)))
(if goto
(progn
- (switch-to-buffer nbuf)
+ (org-pop-to-buffer-same-window nbuf)
(goto-char pos)
(org-show-context 'org-goto))
(if regionp
(if pos
(progn
(goto-char pos)
- (looking-at outline-regexp)
+ (looking-at org-outline-regexp)
(setq level (org-get-valid-level (funcall outline-level) 1))
(goto-char
(if reversed
(bookmark-jump "org-refile-last-stored")
(message "This is the location of the last refile"))
-(defun org-refile-get-location (&optional prompt default-buffer new-nodes)
- "Prompt the user for a refile location, using PROMPT."
+(defun org-refile-get-location (&optional prompt default-buffer new-nodes
+ no-exclude)
+ "Prompt the user for a refile location, using PROMPT.
+PROMPT should not be suffixed with a colon and a space, because
+this function appends the default value from
+`org-refile-history' automatically, if that is not empty.
+When NO-EXCLUDE is set, do not exclude headlines in the current subtree,
+this is used for the GOTO interface."
(let ((org-refile-targets org-refile-targets)
- (org-refile-use-outline-path org-refile-use-outline-path))
- (setq org-refile-target-table (org-get-refile-targets default-buffer)))
+ (org-refile-use-outline-path org-refile-use-outline-path)
+ excluded-entries)
+ (when (and (eq major-mode 'org-mode)
+ (not org-refile-use-cache)
+ (not no-exclude))
+ (org-map-tree
+ (lambda()
+ (setq excluded-entries
+ (append excluded-entries (list (org-get-heading t t)))))))
+ (setq org-refile-target-table
+ (org-refile-get-targets default-buffer excluded-entries)))
(unless org-refile-target-table
(error "No refile targets"))
- (let* ((cbuf (current-buffer))
+ (let* ((prompt (concat prompt
+ (and (car org-refile-history)
+ (concat " (default " (car org-refile-history) ")"))
+ ": "))
+ (cbuf (current-buffer))
(partial-completion-mode nil)
(cfn (buffer-file-name (buffer-base-buffer cbuf)))
(cfunc (if (and org-refile-use-outline-path
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))
+ nil 'org-refile-history (car org-refile-history)))
(setq pa (or (assoc answ tbl) (assoc (concat answ "/") tbl)))
(org-refile-check-position pa)
(if pa
(goto-char pos)
(beginning-of-line 1)
(unless (org-looking-at-p re)
- (error "Invalid refile position, please rebuild the cache"))))))))
+ (error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling"))))))))
(defun org-refile-new-child (parent-target child)
"Use refile target PARENT-TARGET to add new CHILD below it."
(goto-char pos)
(goto-char (point-max))
(if (not (bolp)) (newline)))
- (when (looking-at outline-regexp)
+ (when (looking-at org-outline-regexp)
(setq level (funcall outline-level))
(org-end-of-subtree t t))
(org-back-over-empty-lines)
(let (pos)
(save-excursion
(goto-char (point-min))
- (setq pos (and (re-search-forward (concat "^#\\+BEGIN:[ \t]+" name "\\>")
+ (setq pos (and (re-search-forward (concat "^[ \t]*#\\+BEGIN:[ \t]+" name "\\>")
nil t)
(match-beginning 0))))
(if pos (goto-char pos))
"Update all dynamic blocks in the buffer.
This function can be used in a hook."
(interactive)
- (when (org-mode-p)
+ (when (eq major-mode 'org-mode)
(org-map-dblocks 'org-update-dblock)))
"BEGIN_CENTER" "END_CENTER"
"BEGIN_SRC" "END_SRC"
"BEGIN_RESULT" "END_RESULT"
- "SOURCE:" "SRCNAME:" "FUNCTION:"
- "RESULTS:"
+ "NAME:" "RESULTS:"
"HEADER:" "HEADERS:"
- "BABEL:"
"CATEGORY:" "COLUMNS:" "PROPERTY:"
"CAPTION:" "LABEL:"
"SETUPFILE:"
"<example>\n?\n</example>")
("q" "#+begin_quote\n?\n#+end_quote"
"<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"
+ ("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: "
"<literal style=\"latex\">?</literal>")
"<literal style=\"html\">?</literal>")
("a" "#+begin_ascii\n?\n#+end_ascii")
("A" "#+ascii: ")
- ("i" "#+include %file ?"
+ ("i" "#+index: ?"
+ "#+index: ?")
+ ("I" "#+include %file ?"
"<include file=%file markup=\"?\">")
)
"Structure completion elements.
This is a list of abbreviation keys and values. The value gets inserted
if you type `<' followed by the key and then press the completion key,
usually `M-TAB'. %file will be replaced by a file name after prompting
-for the file using completion.
+for the file using completion. The cursor will be placed at the position
+of the `?` in the template.
There are two templates for each key, the first uses the original Org syntax,
the second uses Emacs Muse-like syntax tags. These Muse-like tags become
the default when the /org-mtags.el/ module has been loaded. See also the
(let ((l (buffer-substring (point-at-bol) (point)))
a)
(when (and (looking-at "[ \t]*$")
- (string-match "^[ \t]*<\\([a-z]+\\)$"l)
+ (string-match "^[ \t]*<\\([a-zA-Z]+\\)$" l)
(setq a (assoc (match-string 1 l) org-structure-template-alist)))
(org-complete-expand-structure-template (+ -1 (point-at-bol)
(match-beginning 1)) a)
(save-excursion
(org-back-to-heading)
(let (case-fold-search)
- (if (looking-at (concat outline-regexp
- "\\( *\\<" org-comment-string "\\>[ \t]*\\)"))
- (replace-match "" t t nil 1)
- (if (looking-at outline-regexp)
- (progn
- (goto-char (match-end 0))
- (insert org-comment-string " ")))))))
+ (cond
+ ((looking-at (format org-heading-keyword-regexp-format
+ org-comment-string))
+ (goto-char (match-end 1))
+ (looking-at (concat " +" org-comment-string))
+ (replace-match "" t t)
+ (when (eolp) (insert " ")))
+ ((looking-at org-outline-regexp)
+ (goto-char (match-end 0))
+ (insert org-comment-string " "))))))
(defvar org-last-todo-state-is-todo nil
"This is non-nil when the last TODO state change led to a TODO state.
(defvar org-agenda-headline-snapshot-before-repeat)
+(defun org-current-effective-time ()
+ "Return current time adjusted for `org-extend-today-until' variable"
+ (let* ((ct (org-current-time))
+ (dct (decode-time ct))
+ (ct1
+ (if (and org-use-effective-time
+ (< (nth 2 dct) org-extend-today-until))
+ (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct))
+ ct)))
+ ct1))
+
+(defun org-todo-yesterday (&optional arg)
+ "Like `org-todo' but the time of change will be 23:59 of yesterday."
+ (interactive "P")
+ (if (eq major-mode 'org-agenda-mode)
+ (apply 'org-agenda-todo-yesterday arg)
+ (let* ((hour (third (decode-time
+ (org-current-time))))
+ (org-extend-today-until (1+ hour)))
+ (org-todo arg))))
+
(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 a double \\[universal-argument] prefix, switch to the next set of TODO \
keywords (nextset).
With a triple \\[universal-argument] prefix, circumvent any state blocking.
+With a numeric prefix arg of 0, inhibit note taking for the change.
For calling through lisp, arg is also interpreted in the following way:
'none -> empty state
\"WAITING\" -> switch to the specified keyword, but only if it
really is a member of `org-todo-keywords'."
(interactive "P")
- (if (equal arg '(16)) (setq arg 'nextset))
- (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 t)
- (if (looking-at outline-regexp) (goto-char (1- (match-end 0))))
- (or (looking-at (concat " +" org-todo-regexp "\\( +\\|$\\)"))
- (looking-at " *"))
- (let* ((match-data (match-data))
- (startpos (point-at-bol))
- (logging (save-match-data (org-entry-get nil "LOGGING" t t)))
- (org-log-done org-log-done)
- (org-log-repeat org-log-repeat)
- (org-todo-log-states org-todo-log-states)
- (this (match-string 1))
- (hl-pos (match-beginning 0))
- (head (org-get-todo-sequence-head this))
- (ass (assoc head org-todo-kwd-alist))
- (interpret (nth 1 ass))
- (done-word (nth 3 ass))
- (final-done-word (nth 4 ass))
- (last-state (or this ""))
- (completion-ignore-case t)
- (member (member this org-todo-keywords-1))
- (tail (cdr member))
- (state (cond
- ((and org-todo-key-trigger
- (or (and (equal arg '(4))
- (eq org-use-fast-todo-selection 'prefix))
- (and (not arg) org-use-fast-todo-selection
- (not (eq org-use-fast-todo-selection
- 'prefix)))))
- ;; Use fast selection
- (org-fast-todo-selection))
- ((and (equal arg '(4))
- (or (not org-use-fast-todo-selection)
- (not org-todo-key-trigger)))
- ;; Read a state with completion
- (org-icompleting-read
- "State: " (mapcar (lambda(x) (list x))
- org-todo-keywords-1)
- nil t))
- ((eq arg 'right)
- (if this
- (if tail (car tail) nil)
- (car org-todo-keywords-1)))
- ((eq arg 'left)
- (if (equal member org-todo-keywords-1)
- nil
+ (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
+ (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
+ 'region-start-level 'region))
+ org-loop-over-headlines-in-active-region)
+ (org-map-entries
+ `(org-todo ,arg)
+ org-loop-over-headlines-in-active-region
+ cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ (if (equal arg '(16)) (setq arg 'nextset))
+ (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 t)
+ (if (looking-at org-outline-regexp) (goto-char (1- (match-end 0))))
+ (or (looking-at (concat " +" org-todo-regexp "\\( +\\|[ \t]*$\\)"))
+ (looking-at "\\(?: *\\|[ \t]*$\\)"))
+ (let* ((match-data (match-data))
+ (startpos (point-at-bol))
+ (logging (save-match-data (org-entry-get nil "LOGGING" t t)))
+ (org-log-done org-log-done)
+ (org-log-repeat org-log-repeat)
+ (org-todo-log-states org-todo-log-states)
+ (org-inhibit-logging
+ (if (equal arg 0)
+ (progn (setq arg nil) 'note) org-inhibit-logging))
+ (this (match-string 1))
+ (hl-pos (match-beginning 0))
+ (head (org-get-todo-sequence-head this))
+ (ass (assoc head org-todo-kwd-alist))
+ (interpret (nth 1 ass))
+ (done-word (nth 3 ass))
+ (final-done-word (nth 4 ass))
+ (org-last-state (or this ""))
+ (completion-ignore-case t)
+ (member (member this org-todo-keywords-1))
+ (tail (cdr member))
+ (org-state (cond
+ ((and org-todo-key-trigger
+ (or (and (equal arg '(4))
+ (eq org-use-fast-todo-selection 'prefix))
+ (and (not arg) org-use-fast-todo-selection
+ (not (eq org-use-fast-todo-selection
+ 'prefix)))))
+ ;; Use fast selection
+ (org-fast-todo-selection))
+ ((and (equal arg '(4))
+ (or (not org-use-fast-todo-selection)
+ (not org-todo-key-trigger)))
+ ;; Read a state with completion
+ (org-icompleting-read
+ "State: " (mapcar (lambda(x) (list x))
+ org-todo-keywords-1)
+ nil t))
+ ((eq arg 'right)
(if this
- (nth (- (length org-todo-keywords-1)
- (length tail) 2)
- org-todo-keywords-1)
- (org-last org-todo-keywords-1))))
- ((and (eq org-use-fast-todo-selection t) (equal arg '(4))
- (setq arg nil))) ; hack to fall back to cycling
- (arg
- ;; user or caller requests a specific state
- (cond
- ((equal arg "") nil)
- ((eq arg 'none) nil)
- ((eq arg 'done) (or done-word (car org-done-keywords)))
- ((eq arg 'nextset)
- (or (car (cdr (member head org-todo-heads)))
- (car org-todo-heads)))
- ((eq arg 'previousset)
- (let ((org-todo-heads (reverse org-todo-heads)))
+ (if tail (car tail) nil)
+ (car org-todo-keywords-1)))
+ ((eq arg 'left)
+ (if (equal member org-todo-keywords-1)
+ nil
+ (if this
+ (nth (- (length org-todo-keywords-1)
+ (length tail) 2)
+ org-todo-keywords-1)
+ (org-last org-todo-keywords-1))))
+ ((and (eq org-use-fast-todo-selection t) (equal arg '(4))
+ (setq arg nil))) ; hack to fall back to cycling
+ (arg
+ ;; user or caller requests a specific state
+ (cond
+ ((equal arg "") nil)
+ ((eq arg 'none) nil)
+ ((eq arg 'done) (or done-word (car org-done-keywords)))
+ ((eq arg 'nextset)
(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
- ((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
- (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))
- dolog now-done-p)
- (when org-blocker-hook
+ (car org-todo-heads)))
+ ((eq arg 'previousset)
+ (let ((org-todo-heads (reverse org-todo-heads)))
+ (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
+ ((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
+ (car tail))))
+ (org-state (or
+ (run-hook-with-args-until-success
+ 'org-todo-get-default-hook org-state org-last-state)
+ org-state))
+ (next (if org-state (concat " " org-state " ") " "))
+ (change-plist (list :type 'todo-state-change :from this :to org-state
+ :position startpos))
+ dolog now-done-p)
+ (when org-blocker-hook
+ (setq org-last-todo-state-is-todo
+ (not (member this org-done-keywords)))
+ (unless (save-excursion
+ (save-match-data
+ (org-with-wide-buffer
+ (run-hook-with-args-until-failure
+ 'org-blocker-hook change-plist))))
+ (if (org-called-interactively-p 'interactive)
+ (error "TODO state change from %s to %s blocked" this org-state)
+ ;; fail silently
+ (message "TODO state change from %s to %s blocked" this org-state)
+ (throw 'exit nil))))
+ (store-match-data match-data)
+ (replace-match next t t)
+ (unless (pos-visible-in-window-p hl-pos)
+ (message "TODO state changed to %s" (org-trim next)))
+ (unless head
+ (setq head (org-get-todo-sequence-head org-state)
+ ass (assoc head org-todo-kwd-alist)
+ interpret (nth 1 ass)
+ done-word (nth 3 ass)
+ final-done-word (nth 4 ass)))
+ (when (memq arg '(nextset previousset))
+ (message "Keyword-Set %d/%d: %s"
+ (- (length org-todo-sets) -1
+ (length (memq (assoc org-state org-todo-sets) org-todo-sets)))
+ (length org-todo-sets)
+ (mapconcat 'identity (assoc org-state org-todo-sets) " ")))
(setq org-last-todo-state-is-todo
- (not (member this org-done-keywords)))
- (unless (save-excursion
- (save-match-data
- (run-hook-with-args-until-failure
- 'org-blocker-hook change-plist)))
- (if (interactive-p)
- (error "TODO state change from %s to %s blocked" this state)
- ;; fail silently
- (message "TODO state change from %s to %s blocked" this state)
- (throw 'exit nil))))
- (store-match-data match-data)
- (replace-match next t t)
- (unless (pos-visible-in-window-p hl-pos)
- (message "TODO state changed to %s" (org-trim next)))
- (unless head
- (setq head (org-get-todo-sequence-head state)
- ass (assoc head org-todo-kwd-alist)
- interpret (nth 1 ass)
- done-word (nth 3 ass)
- final-done-word (nth 4 ass)))
- (when (memq arg '(nextset previousset))
- (message "Keyword-Set %d/%d: %s"
- (- (length org-todo-sets) -1
- (length (memq (assoc state org-todo-sets) org-todo-sets)))
- (length org-todo-sets)
- (mapconcat 'identity (assoc state org-todo-sets) " ")))
- (setq org-last-todo-state-is-todo
- (not (member state org-done-keywords)))
- (setq now-done-p (and (member state org-done-keywords)
- (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)))
- ;; This is now a todo state and was not one before
- ;; If there was a CLOSED time stamp, get rid of it.
- (org-add-planning-info nil nil 'closed))
- (when (and now-done-p org-log-done)
- ;; 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 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 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))
- (when org-provide-todo-statistics
- (org-update-parent-todo-statistics))
- (run-hooks 'org-after-todo-state-change-hook)
- (if (and arg (not (member state org-done-keywords)))
- (setq head (org-get-todo-sequence-head state)))
- (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head)
- ;; Do we need to trigger a repeat?
- (when now-done-p
- (when (boundp 'org-agenda-headline-snapshot-before-repeat)
- ;; This is for the agenda, take a snapshot of the headline.
- (save-match-data
- (setq org-agenda-headline-snapshot-before-repeat
- (org-get-heading))))
- (org-auto-repeat-maybe state))
- ;; Fixup cursor location if close to the keyword
- (if (and (outline-on-heading-p)
- (not (bolp))
- (save-excursion (beginning-of-line 1)
- (looking-at org-todo-line-regexp))
- (< (point) (+ 2 (or (match-end 2) (match-end 1)))))
- (progn
- (goto-char (or (match-end 2) (match-end 1)))
- (and (looking-at " ") (just-one-space))))
- (when org-trigger-hook
- (save-excursion
- (run-hook-with-args 'org-trigger-hook change-plist))))))))
+ (not (member org-state org-done-keywords)))
+ (setq now-done-p (and (member org-state org-done-keywords)
+ (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 org-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 org-state
+ (member org-state org-not-done-keywords)
+ (not (member this org-not-done-keywords)))
+ ;; This is now a todo state and was not one before
+ ;; If there was a CLOSED time stamp, get rid of it.
+ (org-add-planning-info nil nil 'closed))
+ (when (and now-done-p org-log-done)
+ ;; It is now done, and it was not done before
+ (org-add-planning-info 'closed (org-current-effective-time))
+ (if (and (not dolog) (eq 'note org-log-done))
+ (org-add-log-setup 'done org-state this 'findpos 'note)))
+ (when (and org-state dolog)
+ ;; This is a non-nil state, and we need to log it
+ (org-add-log-setup 'state org-state this 'findpos dolog)))
+ ;; Fixup tag positioning
+ (org-todo-trigger-tag-changes org-state)
+ (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t))
+ (when org-provide-todo-statistics
+ (org-update-parent-todo-statistics))
+ (run-hooks 'org-after-todo-state-change-hook)
+ (if (and arg (not (member org-state org-done-keywords)))
+ (setq head (org-get-todo-sequence-head org-state)))
+ (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head)
+ ;; Do we need to trigger a repeat?
+ (when now-done-p
+ (when (boundp 'org-agenda-headline-snapshot-before-repeat)
+ ;; This is for the agenda, take a snapshot of the headline.
+ (save-match-data
+ (setq org-agenda-headline-snapshot-before-repeat
+ (org-get-heading))))
+ (org-auto-repeat-maybe org-state))
+ ;; Fixup cursor location if close to the keyword
+ (if (and (outline-on-heading-p)
+ (not (bolp))
+ (save-excursion (beginning-of-line 1)
+ (looking-at org-todo-line-regexp))
+ (< (point) (+ 2 (or (match-end 2) (match-end 1)))))
+ (progn
+ (goto-char (or (match-end 2) (match-end 1)))
+ (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-or-parent (change-plist)
"Block turning an entry into a TODO, using the hierarchy.
(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
+ ;; Search further up the hierarchy, to see if an ancestor is blocked
(while t
(goto-char parent-pos)
(if (not (looking-at org-not-done-heading-regexp))
(outline-next-heading)
(setq end (point))
(goto-char beg)
- (if (re-search-forward "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\[[- ]\\]"
- end t)
+ (if (org-list-search-forward
+ (concat (org-item-beginning-re)
+ "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?"
+ "\\[[- ]\\]")
+ end t)
(progn
(if (boundp 'org-blocked-by-checkboxes)
(setq org-blocked-by-checkboxes t))
(progn
(org-update-checkbox-count 'all)
(org-map-entries 'org-update-parent-todo-statistics))
- (if (not (org-on-heading-p))
+ (if (not (org-at-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))
+ (if (not (org-at-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)))
+ (if (org-at-heading-p) (setq l2 (org-outline-level)))
(point)))
(if (and (save-excursion
(re-search-forward
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* ((lim 0) prop
+ (let* ((prop (save-excursion (org-up-heading-safe)
+ (org-entry-get nil "COOKIE_DATA" 'inherit)))
(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))
+ (and prop (string-match "\\<recursive\\>" prop))))
+ (lim (or (and prop (marker-position org-entry-property-inherited-from))
+ 0))
(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)
+ (cnt-all 0) (cnt-done 0) is-percent kwd
+ checkbox-beg ov ovs ove cookie-present)
(catch 'exit
(save-excursion
(beginning-of-line 1)
- (if (org-at-heading-p)
- (setq ltoggle (funcall outline-level))
- (error "This should not happen"))
+ (setq ltoggle (funcall outline-level))
+ ;; Three situations are to consider:
+
+ ;; 1. if `org-hierarchical-todo-statistics' is nil, repeat up
+ ;; to the top-level ancestor on the headline;
+
+ ;; 2. If parent has "recursive" property, repeat up to the
+ ;; headline setting that property, taking inheritance into
+ ;; account;
+
+ ;; 3. Else, move up to direct parent and proceed only once.
(while (and (setq level (org-up-heading-safe))
(or recursive first)
(>= (point) lim))
(unless (and level
(not (string-match
"\\<checkbox\\>"
- (downcase
- (or (org-entry-get
- nil "COOKIE_DATA")
- "")))))
+ (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))
+ (setq is-percent (match-end 2) checkbox-beg (match-beginning 0))
(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 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))
+ (if is-percent
+ (format "[%d%%]" (/ (* 100 cnt-done) (max 1 cnt-all)))
+ (format "[%d/%d]" cnt-done cnt-all))
+ ndel (- (match-end 0) checkbox-beg))
+ ;; handle overlays when updating cookie from column view
+ (when (setq ov (car (overlays-at checkbox-beg)))
+ (setq ovs (overlay-start ov) ove (overlay-end ov))
+ (delete-overlay ov))
+ (goto-char checkbox-beg)
(insert new)
- (delete-region (point) (+ (point) ndel)))
+ (delete-region (point) (+ (point) ndel))
+ (when org-auto-align-tags (org-fix-tags-on-the-fly))
+ (when ov (move-overlay ov ovs ove)))
(when cookie-present
(run-hook-with-args 'org-after-todo-statistics-hook
cnt-done (- cnt-all cnt-done))))))
This function is run automatically after each state change to a DONE state."
;; last-state is dynamically scoped into this function
(let* ((repeat (org-get-repeat))
- (aa (assoc last-state org-todo-kwd-alist))
+ (aa (assoc org-last-state org-todo-kwd-alist))
(interpret (nth 1 aa))
(head (nth 2 aa))
(whata '(("d" . day) ("m" . month) ("y" . year)))
(setq to-state (or (org-entry-get nil "REPEAT_TO_STATE")
org-todo-repeat-to-state))
(unless (and to-state (member to-state org-todo-keywords-1))
- (setq to-state (if (eq interpret 'type) last-state head)))
+ (setq to-state (if (eq interpret 'type) org-last-state head)))
(org-todo to-state)
(when (or org-log-repeat (org-entry-get nil "CLOCK"))
(org-entry-put nil "LAST_REPEAT" (format-time-string
(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
+ org-last-state
'findpos org-log-repeat)))
(org-back-to-heading t)
(org-add-planning-info nil nil 'closed)
((equal (match-string 1 ts) ".")
;; Shift starting date to today
(org-timestamp-change
- (- (time-to-days (current-time)) (time-to-days time))
+ (- (org-today) (time-to-days time))
'day))
((equal (match-string 1 ts) "+")
(let ((nshiftmax 10) (nshift 0))
org-todo-keywords-1)))
(t (error "Invalid prefix argument: %s" arg)))))
(message "%d TODO entries found"
- (org-occur (concat "^" outline-regexp " *" kwd-re )))))
+ (org-occur (concat "^" org-outline-regexp " *" kwd-re )))))
(defun org-deadline (&optional remove time)
"Insert the \"DEADLINE:\" string with a timestamp to make a deadline.
With argument REMOVE, remove any deadline from the item.
-When TIME is set, it should be an internal time specification, and the
-scheduling will use the corresponding date."
+With argument TIME, set the deadline at the corresponding date. TIME
+can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
(interactive "P")
- (let* ((old-date (org-entry-get nil "DEADLINE"))
- (repeater (and old-date
- (string-match "\\([.+]+[0-9]+[dwmy]\\) ?" old-date)
- (match-string 1 old-date))))
- (if remove
- (progn
- (when (and old-date org-log-redeadline)
- (org-add-log-setup 'deldeadline nil old-date 'findpos
- org-log-redeadline))
- (org-remove-timestamp-with-keyword org-deadline-string)
- (message "Item no longer has a deadline."))
- (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))
- (when repeater
- (save-excursion
- (org-back-to-heading t)
- (when (re-search-forward (concat org-deadline-string " "
- org-last-inserted-timestamp)
- (save-excursion
- (outline-next-heading) (point)) t)
- (goto-char (1- (match-end 0)))
- (insert " " repeater)
- (setq org-last-inserted-timestamp
- (concat (substring org-last-inserted-timestamp 0 -1)
- " " repeater
- (substring org-last-inserted-timestamp -1))))))
- (message "Deadline on %s" org-last-inserted-timestamp))))
+ (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
+ (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
+ 'region-start-level 'region))
+ org-loop-over-headlines-in-active-region)
+ (org-map-entries
+ `(org-deadline ',remove ,time)
+ org-loop-over-headlines-in-active-region
+ cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ (let* ((old-date (org-entry-get nil "DEADLINE"))
+ (repeater (and old-date
+ (string-match
+ "\\([.+-]+[0-9]+[dwmy]\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?"
+ old-date)
+ (match-string 1 old-date))))
+ (if remove
+ (progn
+ (when (and old-date org-log-redeadline)
+ (org-add-log-setup 'deldeadline nil old-date 'findpos
+ org-log-redeadline))
+ (org-remove-timestamp-with-keyword org-deadline-string)
+ (message "Item no longer has a deadline."))
+ (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))
+ (when repeater
+ (save-excursion
+ (org-back-to-heading t)
+ (when (re-search-forward (concat org-deadline-string " "
+ org-last-inserted-timestamp)
+ (save-excursion
+ (outline-next-heading) (point)) t)
+ (goto-char (1- (match-end 0)))
+ (insert " " repeater)
+ (setq org-last-inserted-timestamp
+ (concat (substring org-last-inserted-timestamp 0 -1)
+ " " repeater
+ (substring org-last-inserted-timestamp -1))))))
+ (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.
With argument REMOVE, remove any scheduling date from the item.
-When TIME is set, it should be an internal time specification, and the
-scheduling will use the corresponding date."
+With argument TIME, scheduled at the corresponding date. TIME can
+either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
(interactive "P")
- (let* ((old-date (org-entry-get nil "SCHEDULED"))
- (repeater (and old-date
- (string-match "\\([.+]+[0-9]+[dwmy]\\) ?" old-date)
- (match-string 1 old-date))))
- (if remove
- (progn
- (when (and old-date org-log-reschedule)
- (org-add-log-setup 'delschedule nil old-date 'findpos
- org-log-reschedule))
- (org-remove-timestamp-with-keyword org-scheduled-string)
- (message "Item is no longer scheduled."))
- (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))
- (when repeater
- (save-excursion
- (org-back-to-heading t)
- (when (re-search-forward (concat org-scheduled-string " "
- org-last-inserted-timestamp)
- (save-excursion
- (outline-next-heading) (point)) t)
- (goto-char (1- (match-end 0)))
- (insert " " repeater)
- (setq org-last-inserted-timestamp
- (concat (substring org-last-inserted-timestamp 0 -1)
- " " repeater
- (substring org-last-inserted-timestamp -1))))))
- (message "Scheduled to %s" org-last-inserted-timestamp))))
+ (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
+ (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
+ 'region-start-level 'region))
+ org-loop-over-headlines-in-active-region)
+ (org-map-entries
+ `(org-schedule ',remove ,time)
+ org-loop-over-headlines-in-active-region
+ cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ (let* ((old-date (org-entry-get nil "SCHEDULED"))
+ (repeater (and old-date
+ (string-match
+ "\\([.+-]+[0-9]+[dwmy]\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?"
+ old-date)
+ (match-string 1 old-date))))
+ (if remove
+ (progn
+ (when (and old-date org-log-reschedule)
+ (org-add-log-setup 'delschedule nil old-date 'findpos
+ org-log-reschedule))
+ (org-remove-timestamp-with-keyword org-scheduled-string)
+ (message "Item is no longer scheduled."))
+ (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))
+ (when repeater
+ (save-excursion
+ (org-back-to-heading t)
+ (when (re-search-forward (concat org-scheduled-string " "
+ org-last-inserted-timestamp)
+ (save-excursion
+ (outline-next-heading) (point)) t)
+ (goto-char (1- (match-end 0)))
+ (insert " " repeater)
+ (setq org-last-inserted-timestamp
+ (concat (substring org-last-inserted-timestamp 0 -1)
+ " " repeater
+ (substring org-last-inserted-timestamp -1))))))
+ (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
(defun org-add-planning-info (what &optional time &rest remove)
"Insert new timestamp with keyword in the line directly after the headline.
-WHAT indicates what kind of time stamp to add. TIME indicated the time to use.
+WHAT indicates what kind of time stamp to add. TIME indicates the time to use.
If non is given, the user is prompted for a date.
REMOVE indicates what kind of entries to remove. An old WHAT entry will also
be removed."
end default-time default-input)
(catch 'exit
- (when (and (not time) (memq what '(scheduled deadline)))
+ (when (and (memq what '(scheduled deadline))
+ (or (not time)
+ (and (stringp time)
+ (string-match "^[-+]+[0-9]" time))))
;; Try to get a default date/time from existing timestamp
(save-excursion
(org-back-to-heading t)
(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))))
+ (setq time
+ (if (stringp time)
+ ;; This is a string (relative or absolute), set proper date
+ (apply 'encode-time
+ (org-read-date-analyze
+ time default-time (decode-time default-time)))
+ ;; If necessary, get the time from the user
+ (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)))
(save-restriction
(let (col list elt ts buffer-invisibility-spec)
(org-back-to-heading t)
- (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*"))
+ (looking-at (concat org-outline-regexp "\\( *\\)[^\r\n]*"))
(goto-char (match-end 1))
(setq col (current-column))
(goto-char (match-end 0))
org-keyword-time-not-clock-regexp))))
;; Nothing to add, nothing to remove...... :-)
(throw 'exit nil))
- (if (and (not (looking-at outline-regexp))
+ (if (and (not (looking-at org-outline-regexp))
(looking-at (concat "[^\r\n]*?" org-keyword-time-regexp
"[^\r\n]*"))
(not (equal (match-string 1) org-clock-string)))
(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)
(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))
+ (if (looking-at "--+<[^>]+>") (replace-match ""))))
+ (and (looking-at "[ \t]+") (replace-match ""))
(and org-adapt-indentation (bolp) (org-indent-to-column col))
(when what
(insert
(and (eq what 'closed) org-log-done-with-time))
(eq what 'closed)
nil nil (list org-end-time-was-given)))
+ (insert
+ (if (not (or (bolp) (eq (char-before) ?\ )
+ (memq (char-after) '(32 10))
+ (eobp))) " " ""))
(end-of-line 1))
(goto-char (point-min))
(widen)
(defvar org-log-note-extra nil)
(defvar org-log-note-window-configuration nil)
(defvar org-log-note-return-to (make-marker))
+(defvar org-log-note-effective-time nil
+ "Remembered current time so that dynamically scoped
+`org-extend-today-until' affects tha timestamps in state change
+log")
+
(defvar org-log-post-message nil
"Message to be displayed after a log note has been stored.
The auto-repeater uses this.")
(org-back-to-heading t)
(narrow-to-region (point) (save-excursion
(outline-next-heading) (point)))
- (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*"
+ (looking-at (concat org-outline-regexp "\\( *\\)[^\r\n]*"
"\\(\n[^\r\n]*?" org-keyword-time-not-clock-regexp
"[^\r\n]*\\)?"))
(goto-char (match-end 0))
org-log-note-state state
org-log-note-previous-state prev-state
org-log-note-how how
- org-log-note-extra extra)
+ org-log-note-extra extra
+ org-log-note-effective-time (org-current-effective-time))
(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."
(if (looking-at "\n[ \t]*- State") (forward-char 1))
- (when (org-in-item-p)
- (let ((limit (org-list-bottom-point)))
+ (when (ignore-errors (goto-char (org-in-item-p)))
+ (let* ((struct (org-list-struct))
+ (prevs (org-list-prevs-alist struct)))
(while (looking-at "[ \t]*- State")
- (goto-char (or (org-get-next-item (point) limit)
- (org-get-end-of-item limit)))))))
+ (goto-char (or (org-list-get-next-item (point) struct prevs)
+ (org-list-get-item-end (point) struct)))))))
(defun org-add-log-note (&optional purpose)
"Pop up a window for taking a note, and add this note later at point."
(setq org-log-note-window-configuration (current-window-configuration))
(delete-other-windows)
(move-marker org-log-note-return-to (point))
- (switch-to-buffer (marker-buffer org-log-note-marker))
+ (org-pop-to-buffer-same-window (marker-buffer org-log-note-marker))
(goto-char org-log-note-marker)
(org-switch-to-buffer-other-window "*Org Note*")
(erase-buffer)
"this entry")
(t (error "This should not happen")))))
(if org-log-note-extra (insert org-log-note-extra))
- (org-set-local 'org-finish-function 'org-store-log-note)))
+ (org-set-local 'org-finish-function 'org-store-log-note)
+ (run-hooks 'org-log-buffer-setup-hook)))
(defvar org-note-abort nil) ; dynamically scoped
(defun org-store-log-note ()
(cons "%U" user-full-name)
(cons "%t" (format-time-string
(org-time-stamp-format 'long 'inactive)
- (current-time)))
+ org-log-note-effective-time))
(cons "%T" (format-time-string
(org-time-stamp-format 'long nil)
- (current-time)))
+ org-log-note-effective-time))
+ (cons "%d" (format-time-string
+ (org-time-stamp-format nil 'inactive)
+ org-log-note-effective-time))
+ (cons "%D" (format-time-string
+ (org-time-stamp-format nil nil)
+ org-log-note-effective-time))
(cons "%s" (if org-log-note-state
(concat "\"" org-log-note-state "\"")
""))
(end-of-line 1)
(if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n")))
(setq ind (save-excursion
- (if (org-in-item-p)
- (progn
- (goto-char (org-list-top-point))
- (org-get-indentation))
+ (if (ignore-errors (goto-char (org-in-item-p)))
+ (let ((struct (org-list-struct)))
+ (org-list-get-ind
+ (org-list-get-top-point struct) struct))
(skip-chars-backward " \r\t\n")
(cond
((and (org-at-heading-p)
a Show deadlines and scheduled items after a date."
(interactive "P")
(let (ans kwd value)
- (message "Sparse tree: [r]egexp [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty\n [d]eadlines [b]efore-date [a]fter-date")
+ (message "Sparse tree: [r]egexp [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty\n [d]eadlines [b]efore-date [a]fter-date [D]ates range")
(setq ans (read-char-exclusive))
(cond
((equal ans ?d)
(call-interactively 'org-check-before-date))
((equal ans ?a)
(call-interactively 'org-check-after-date))
+ ((equal ans ?D)
+ (call-interactively 'org-check-dates-range))
((equal ans ?t)
(org-show-todo-tree nil))
((equal ans ?T)
(unless org-sparse-tree-open-archived-trees
(org-hide-archived-subtrees (point-min) (point-max)))
(run-hooks 'org-occur-hook)
- (if (interactive-p)
+ (if (org-called-interactively-p 'interactive)
(message "%d match(es) for regexp %s" cnt regexp))
cnt))
+(defun org-occur-next-match (&optional n reset)
+ "Function for `next-error-function' to find sparse tree matches.
+N is the number of matches to move, when negative move backwards.
+RESET is entirely ignored - this function always goes back to the
+starting point when no match is found."
+ (let* ((limit (if (< n 0) (point-min) (point-max)))
+ (search-func (if (< n 0)
+ 'previous-single-char-property-change
+ 'next-single-char-property-change))
+ (n (abs n))
+ (pos (point))
+ p1)
+ (catch 'exit
+ (while (setq p1 (funcall search-func (point) 'org-type))
+ (when (equal p1 limit)
+ (goto-char pos)
+ (error "No more matches"))
+ (when (equal (get-char-property p1 'org-type) 'org-occur)
+ (setq n (1- n))
+ (when (= n 0)
+ (goto-char p1)
+ (throw 'exit (point))))
+ (goto-char p1))
+ (goto-char p1)
+ (error "No more matches"))))
+
(defun org-show-context (&optional key)
"Make sure point and context are visible.
How much context is shown depends upon the variables
-`org-show-hierarchy-above', `org-show-following-heading'. and
-`org-show-siblings'."
- (let ((heading-p (org-on-heading-p t))
+`org-show-hierarchy-above', `org-show-following-heading',
+`org-show-entry-below' and `org-show-siblings'."
+ (let ((heading-p (org-at-heading-p t))
(hierarchy-p (org-get-alist-option org-show-hierarchy-above key))
(following-p (org-get-alist-option org-show-following-heading key))
(entry-p (org-get-alist-option org-show-entry-below key))
;; Show heading or entry text
(if (and heading-p (not entry-p))
(org-flag-heading nil) ; only show the heading
- (and (or entry-p (org-invisible-p) (org-invisible-p2))
+ (and (or entry-p (outline-invisible-p) (org-invisible-p2))
(org-show-hidden-entry))) ; show entire entry
(when following-p
;; Show next sibling, or heading below text
"Highlight from BEG to END and mark the highlight is an occur headline."
(let ((ov (make-overlay beg end)))
(overlay-put ov 'face 'secondary-selection)
+ (overlay-put ov 'org-type 'org-occur)
(push ov org-occur-highlights)))
(defun org-remove-occur-highlights (&optional beg end noremove)
(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))
+ have t))
(cond
((eq action 'remove)
(setq remove t new ?\ ))
(error "Priority must be between `%c' and `%c'"
org-highest-priority org-lowest-priority))))
((eq action 'up)
- (if (and (not have) (eq last-command this-command))
- (setq new org-lowest-priority)
- (setq new (if (and org-priority-start-cycle-with-default (not have))
- org-default-priority (1- current)))))
+ (setq new (if have
+ (1- current) ; normal cycling
+ ;; last priority was empty
+ (if (eq last-command this-command)
+ org-lowest-priority ; wrap around empty to lowest
+ ;; default
+ (if org-priority-start-cycle-with-default
+ org-default-priority
+ (1- org-default-priority))))))
((eq action 'down)
- (if (and (not have) (eq last-command this-command))
- (setq new org-highest-priority)
- (setq new (if (and org-priority-start-cycle-with-default (not have))
- org-default-priority (1+ current)))))
+ (setq new (if have
+ (1+ current) ; normal cycling
+ ;; last priority was empty
+ (if (eq last-command this-command)
+ org-highest-priority ; wrap around empty to highest
+ ;; default
+ (if org-priority-start-cycle-with-default
+ org-default-priority
+ (1+ org-default-priority))))))
(t (error "Invalid action")))
(if (or (< (upcase new) org-highest-priority)
(> (upcase new) org-lowest-priority))
- (setq remove t))
+ (if (and (memq action '(up down))
+ (not have) (not (eq last-command this-command)))
+ ;; `new' is from default priority
+ (error
+ "The default can not be set, see `org-default-priority' why")
+ ;; normal cycling: `new' is beyond highest/lowest priority
+ ;; and is wrapped around to the empty priority
+ (setq remove t)))
(setq news (format "%c" new))
(if have
(if remove
(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'.")
+Can be set by the action argument to `org-scan-tags' 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.
+ "Should `org-get-tags-at' use the tags for 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
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)
+(defun org-scan-tags (action matcher todo-only &optional start-level)
"Scan headline tags with inheritance and produce output ACTION.
ACTION can be `sparse-tree' to produce a sparse tree in the current buffer,
MATCHER is a Lisp form to be evaluated, testing if a given set of tags
qualifies a headline for inclusion. When TODO-ONLY is non-nil,
-only lines with a TODO keyword are included in the output."
+only lines with a not-done TODO keyword are included in the output.
+This should be the same variable that was scoped into
+and set by `org-make-tags-matcher' when it constructed MATCHER.
+
+START-LEVEL can be a string with asterisks, reducing the scope to
+headlines matching this string."
(require 'org-agenda)
- (let* ((re (concat "^" outline-regexp " *\\(\\<\\("
+ (let* ((re (concat "^"
+ (if start-level
+ ;; Get the correct level to match
+ (concat "\\*\\{" (number-to-string start-level) "\\} ")
+ org-outline-regexp)
+ " *\\(\\<\\("
(mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
(org-re
"\\>\\)\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$")))
'mouse-face 'highlight
'org-not-done-regexp org-not-done-regexp
'org-todo-regexp org-todo-regexp
+ 'org-complex-heading-regexp org-complex-heading-regexp
'help-echo
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name
(org-overview)
(org-remove-occur-highlights))
(while (re-search-forward re nil t)
+ (setq org-map-continue-from nil)
(catch :skip
(setq todo (if (match-end 1) (org-match-string-no-properties 2))
tags (if (match-end 4) (org-match-string-no-properties 4)))
org-tags-exclude-from-inheritance))
;; selective inheritance, remove uninherited ones
(setcdr (car tags-alist)
- (org-remove-uniherited-tags (cdar tags-alist))))
- (when (and (or (not todo-only)
- (and (member todo org-not-done-keywords)
- (or (not org-agenda-tags-todo-honor-ignore-options)
- (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item)))))
- (let ((case-fold-search t)) (eval matcher))
- (or
- (not (member org-archive-tag tags-list))
- ;; we have an archive tag, should we use this anyway?
- (or (not org-agenda-skip-archived-trees)
- (and (eq action 'agenda) org-agenda-archives-mode))))
- (unless (eq action 'sparse-tree) (org-agenda-skip))
+ (org-remove-uninherited-tags (cdar tags-alist))))
+ (when (and
+
+ ;; eval matcher only when the todo condition is OK
+ (and (or (not todo-only) (member todo org-not-done-keywords))
+ (let ((case-fold-search t)) (eval matcher)))
+
+ ;; Call the skipper, but return t if it does not skip,
+ ;; so that the `and' form continues evaluating
+ (progn
+ (unless (eq action 'sparse-tree) (org-agenda-skip))
+ t)
+
+ ;; Check if timestamps are deselecting this entry
+ (or (not todo-only)
+ (and (member todo org-not-done-keywords)
+ (or (not org-agenda-tags-todo-honor-ignore-options)
+ (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item)))))
+
+ ;; Extra check for the archive tag
+ ;; FIXME: Does the skipper already do this????
+ (or
+ (not (member org-archive-tag tags-list))
+ ;; we have an archive tag, should we use this anyway?
+ (or (not org-agenda-skip-archived-trees)
+ (and (eq action 'agenda) org-agenda-archives-mode))))
;; select this headline
(and org-highlight-sparse-tree-matches
(org-get-heading) (match-end 0)
(org-highlight-new-match
- (match-beginning 0) (match-beginning 1)))
+ (match-beginning 1) (match-end 1)))
(org-show-context 'tags-tree))
((eq action 'agenda)
- (setq txt (org-format-agenda-item
+ (setq txt (org-agenda-format-item
""
(concat
(if (eq org-tags-match-list-sublevels 'indented)
(org-hide-archived-subtrees (point-min) (point-max)))
(nreverse rtn)))
-(defun org-remove-uniherited-tags (tags)
+(defun org-remove-uninherited-tags (tags)
"Remove all tags that are not inherited from the list TAGS."
(cond
((eq org-use-tag-inheritance t)
(if (member x org-use-tag-inheritance) x nil))
tags)))))
-(defvar todo-only) ;; dynamically scoped
-
(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
(org-entry-properties pom)))))))
(defun org-global-tags-completion-table (&optional files)
- "Return the list of all tags in all agenda buffer/files."
+ "Return the list of all tags in all agenda buffer/files.
+Optional FILES argument is a list of files to which can be used
+instead of the agenda files."
(save-excursion
(org-uniquify
(delq nil
(org-agenda-files))))))))
(defun org-make-tags-matcher (match)
- "Create the TAGS//TODO matcher form for the selection string MATCH."
- ;; todo-only is scoped dynamically into this function, and the function
- ;; may change it if the matcher asks for it.
+ "Create the TAGS/TODO matcher form for the selection string MATCH.
+
+The variable `todo-only' is scoped dynamically into this function; it will be
+set to t if the matcher restricts matching to TODO entries,
+otherwise will not be touched.
+
+Returns a cons of the selection string MATCH and the constructed
+lisp form implementing the matcher. The matcher is to be
+evaluated at an Org entry, with point on the headline,
+and returns t if the entry matches the
+selection string MATCH. The returned lisp form references
+two variables with information about the entry, which must be
+bound around the form's evaluation: todo, the TODO keyword at the
+entry (or nil of none); and tags-list, the list of all tags at the
+entry including inherited ones. Additionally, the category
+of the entry (if any) must be specified as the text property
+'org-category on the headline.
+
+See also `org-scan-tags'.
+"
+ (declare (special todo-only))
+ (unless (boundp 'todo-only)
+ (error "org-make-tags-matcher expects todo-only to be scoped in"))
(unless match
;; Get a new match request, with completion
(let ((org-last-tags-completion-table
(setq matcher (if todomatcher
(list 'and tagsmatcher todomatcher)
tagsmatcher))
+ (when todo-only
+ (setq matcher (list 'and '(member todo org-not-done-keywords)
+ matcher)))
(cons match0 matcher)))
(defun org-op-to-function (op &optional stringp)
(setq ltags (mapcar 'org-add-prop-inherited ltags)))
(setq tags (append
(if parent
- (org-remove-uniherited-tags ltags)
+ (org-remove-uninherited-tags ltags)
ltags)
tags)))
(or org-use-tag-inheritance (throw 'done t))
(or (org-up-heading-safe) (error nil))
(setq parent t)))
(error nil)))))
- (append (org-remove-uniherited-tags org-file-tags) tags)))))
+ (if local
+ tags
+ (append (org-remove-uninherited-tags org-file-tags) tags))))))
(defun org-add-prop-inherited (s)
(add-text-properties 0 (length s) '(inherited t) s)
(goto-char (match-beginning 1))
(insert " ")
(delete-region (point) (1+ (match-beginning 2)))
- (setq ncol (max (1+ (current-column))
+ (setq ncol (max (current-column)
(1+ col)
(if (> to-col 0)
to-col
(defun org-set-tags-command (&optional arg just-align)
"Call the set-tags command for the current entry."
(interactive "P")
- (if (org-on-heading-p)
+ (if (org-at-heading-p)
(org-set-tags arg just-align)
(save-excursion
(org-back-to-heading t)
(save-excursion
(or (ignore-errors (org-back-to-heading t))
(outline-next-heading))
- (if (org-on-heading-p)
+ (if (org-at-heading-p)
(org-set-tags t)
(message "No headings"))))
"Set the tags for the current headline.
With prefix ARG, realign all tags in headings in the current buffer."
(interactive "P")
- (let* ((re (concat "^" outline-regexp))
+ (let* ((re org-outline-regexp-bol)
(current (org-get-tags-string))
(col (current-column))
(org-setting-tags t)
current-tags inherited-tags table
(if org-fast-tag-selection-include-todo
org-todo-key-alist))
- (let ((org-add-colon-after-tag-completion t))
+ (let ((org-add-colon-after-tag-completion (< 1 (length table))))
(org-trim
- (org-without-partial-completion
- (org-icompleting-read "Tags: "
- 'org-tags-completion-function
- nil nil current 'org-tags-history)))))))
+ (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))))
- (setq tags (replace-regexp-in-string "[ ,]" ":" tags))
+ (setq tags (replace-regexp-in-string "[,]" ":" tags))
(if org-tags-sort-function
(setq tags (mapconcat 'identity
(interactive
(list (region-beginning) (region-end)
(let ((org-last-tags-completion-table
- (if (org-mode-p)
+ (if (eq major-mode 'org-mode)
(org-get-buffer-tags)
(org-global-tags-completion-table))))
(org-icompleting-read
(loop for l from l1 to l2 do
(org-goto-line l)
(setq m (get-text-property (point) 'org-hd-marker))
- (when (or (and (org-mode-p) (org-on-heading-p))
+ (when (or (and (eq major-mode 'org-mode) (org-at-heading-p))
(and agendap m))
(setq buf (if agendap (marker-buffer m) (current-buffer))
pos (if agendap m (point)))
(setq exit-after-next (not exit-after-next)))
(setq expert nil)
(delete-other-windows)
- (split-window-vertically)
+ (set-window-buffer (split-window-vertically) " *Org tags*")
(org-switch-to-buffer-other-window " *Org tags*")
(org-fit-window-to-buffer)))
((or (= c ?\C-g)
(defun org-get-tags-string ()
"Get the TAGS string in the current headline."
- (unless (org-on-heading-p t)
+ (unless (org-at-heading-p t)
(error "Not on a heading"))
(save-excursion
(beginning-of-line 1)
nil The current buffer, respecting the restriction if any
tree The subtree started with the entry at point
+region The entries within the active region, if any
+region-start-level
+ The entries within the active region, but only those at
+ the same level than the first one.
file The current buffer, without restriction
file-with-archives
The current buffer, and any archives associated with it
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-agenda-skip-function
- (car (org-delete-all '(comment archive) skip)))
- (org-tags-match-list-sublevels t)
- matcher file res
- 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)
+ (unless (and (or (eq scope 'region) (eq scope 'region-start-level))
+ (not (org-region-active-p)))
+ (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-agenda-skip-function
+ (car (org-delete-all '(comment archive) skip)))
+ (org-tags-match-list-sublevels t)
+ (start-level (eq scope 'region-start-level))
+ matcher file res
+ 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
+ todo-only)
- (cond
- ((eq match t) (setq matcher t))
- ((eq match nil) (setq matcher t))
- (t (setq matcher (if match (cdr (org-make-tags-matcher match)) t))))
+ (cond
+ ((eq match t) (setq matcher t))
+ ((eq match nil) (setq matcher t))
+ (t (setq matcher (if match (cdr (org-make-tags-matcher match)) t))))
- (save-excursion
- (save-restriction
- (when (eq scope 'tree)
- (org-back-to-heading t)
- (org-narrow-to-subtree)
- (setq scope nil))
+ (save-excursion
+ (save-restriction
+ (cond ((eq scope 'tree)
+ (org-back-to-heading t)
+ (org-narrow-to-subtree)
+ (setq scope nil))
+ ((and (or (eq scope 'region) (eq scope 'region-start-level))
+ (org-region-active-p))
+ ;; If needed, set start-level to a string like "2"
+ (when start-level
+ (save-excursion
+ (goto-char (region-beginning))
+ (unless (org-at-heading-p) (outline-next-heading))
+ (setq start-level (org-current-level))))
+ (narrow-to-region (region-beginning)
+ (save-excursion
+ (goto-char (region-end))
+ (unless (and (bolp) (org-at-heading-p))
+ (outline-next-heading))
+ (point)))
+ (setq scope nil)))
- (if (not scope)
- (progn
- (org-prepare-agenda-buffers
- (list (buffer-file-name (current-buffer))))
- (setq res (org-scan-tags func matcher)))
- ;; Get the right scope
- (cond
- ((and scope (listp scope) (symbolp (car scope)))
- (setq scope (eval scope)))
- ((eq scope 'agenda)
- (setq scope (org-agenda-files t)))
- ((eq scope 'agenda-with-archives)
- (setq scope (org-agenda-files t))
- (setq scope (org-add-archive-files scope)))
- ((eq scope 'file)
- (setq scope (list (buffer-file-name))))
- ((eq scope 'file-with-archives)
- (setq scope (org-add-archive-files (list (buffer-file-name))))))
- (org-prepare-agenda-buffers scope)
- (while (setq file (pop scope))
- (with-current-buffer (org-find-base-buffer-visiting file)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (setq res (append res (org-scan-tags func matcher))))))))))
- res))
+ (if (not scope)
+ (progn
+ (org-prepare-agenda-buffers
+ (list (buffer-file-name (current-buffer))))
+ (setq res (org-scan-tags func matcher todo-only start-level)))
+ ;; Get the right scope
+ (cond
+ ((and scope (listp scope) (symbolp (car scope)))
+ (setq scope (eval scope)))
+ ((eq scope 'agenda)
+ (setq scope (org-agenda-files t)))
+ ((eq scope 'agenda-with-archives)
+ (setq scope (org-agenda-files t))
+ (setq scope (org-add-archive-files scope)))
+ ((eq scope 'file)
+ (setq scope (list (buffer-file-name))))
+ ((eq scope 'file-with-archives)
+ (setq scope (org-add-archive-files (list (buffer-file-name))))))
+ (org-prepare-agenda-buffers scope)
+ (while (setq file (pop scope))
+ (with-current-buffer (org-find-base-buffer-visiting file)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (setq res (append res (org-scan-tags func matcher todo-only))))))))))
+ res)))
;;;; Properties
(defconst org-special-properties
'("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOCK" "CLOSED" "PRIORITY"
- "TIMESTAMP" "TIMESTAMP_IA" "BLOCKED")
+ "TIMESTAMP" "TIMESTAMP_IA" "BLOCKED" "FILE" "CLOCKSUM")
"The special properties valid in Org-mode.
These are properties that are not defined in the property drawer,
'("ARCHIVE" "CATEGORY" "SUMMARY" "DESCRIPTION" "CUSTOM_ID"
"LOCATION" "LOGGING" "COLUMNS" "VISIBILITY"
"TABLE_EXPORT_FORMAT" "TABLE_EXPORT_FILE"
- "EXPORT_FILE_NAME" "EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE"
+ "EXPORT_OPTIONS" "EXPORT_TEXT" "EXPORT_FILE_NAME"
+ "EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE"
"ORDERED" "NOBLOCKING" "COOKIE_DATA" "LOG_INTO_DRAWER" "REPEAT_TO_STATE"
"CLOCK_MODELINE_TOTAL" "STYLE" "HTML_CONTAINER_CLASS")
"Some properties that are used by Org-mode for various purposes.
org-property-end-re "\\)\n?")
"Matches an entire clock drawer.")
+(defsubst org-re-property (property)
+ "Return a regexp matching PROPERTY.
+Match group 1 will be set to the value "
+ (concat "^[ \t]*:" (regexp-quote property) ":[ \t]*\\(\\S-.*\\)"))
+
(defun org-property-action ()
"Do an action on properties."
(interactive)
beg end range props sum-props key key1 value string clocksum)
(save-excursion
(when (condition-case nil
- (and (org-mode-p) (org-back-to-heading t))
+ (and (eq major-mode 'org-mode) (org-back-to-heading t))
(error nil))
(setq beg (point))
(setq sum-props (get-text-property (point) 'org-summaries))
(when (and (or (not specific) (string= specific "PRIORITY"))
(looking-at org-priority-regexp))
(push (cons "PRIORITY" (org-match-string-no-properties 2)) props))
+ (when (or (not specific) (string= specific "FILE"))
+ (push (cons "FILE" buffer-file-name) props))
(when (and (or (not specific) (string= specific "TAGS"))
(setq value (org-get-tags-string))
(string-match "\\S-" value))
(member specific
'("SCHEDULED" "DEADLINE" "CLOCK" "CLOSED"
"TIMESTAMP" "TIMESTAMP_IA")))
- (while (re-search-forward org-maybe-keyword-time-regexp end t)
- (setq key (if (match-end 1)
- (substring (org-match-string-no-properties 1)
- 0 -1))
- string (if (equal key clockstr)
- (org-no-properties
- (org-trim
- (buffer-substring
- (match-beginning 3) (goto-char
- (point-at-eol)))))
- (substring (org-match-string-no-properties 3)
- 1 -1)))
- ;; Get the correct property name from the key. This is
- ;; necessary if the user has configured time keywords.
- (setq key1 (concat key ":"))
- (cond
- ((not key)
- (setq key
- (if (= (char-after (match-beginning 3)) ?\[)
- "TIMESTAMP_IA" "TIMESTAMP")))
- ((equal key1 org-scheduled-string) (setq key "SCHEDULED"))
- ((equal key1 org-deadline-string) (setq key "DEADLINE"))
- ((equal key1 org-closed-string) (setq key "CLOSED"))
- ((equal key1 org-clock-string) (setq key "CLOCK")))
- (when (or (equal key "CLOCK") (not (assoc key props)))
- (push (cons key string) props))))
+ (catch 'match
+ (while (re-search-forward org-maybe-keyword-time-regexp end t)
+ (setq key (if (match-end 1)
+ (substring (org-match-string-no-properties 1)
+ 0 -1))
+ string (if (equal key clockstr)
+ (org-no-properties
+ (org-trim
+ (buffer-substring
+ (match-beginning 3) (goto-char
+ (point-at-eol)))))
+ (substring (org-match-string-no-properties 3)
+ 1 -1)))
+ ;; Get the correct property name from the key. This is
+ ;; necessary if the user has configured time keywords.
+ (setq key1 (concat key ":"))
+ (cond
+ ((not key)
+ (setq key
+ (if (= (char-after (match-beginning 3)) ?\[)
+ "TIMESTAMP_IA" "TIMESTAMP")))
+ ((equal key1 org-scheduled-string) (setq key "SCHEDULED"))
+ ((equal key1 org-deadline-string) (setq key "DEADLINE"))
+ ((equal key1 org-closed-string) (setq key "CLOSED"))
+ ((equal key1 org-clock-string) (setq key "CLOCK")))
+ (if (and specific (equal key specific) (not (equal key "CLOCK")))
+ (progn
+ (push (cons key string) props)
+ ;; no need to search further if match is found
+ (throw 'match t))
+ (when (or (equal key "CLOCK") (not (assoc key props)))
+ (push (cons key string) props))))))
)
(when (memq which '(all standard))
'add_times))
props))
(unless (assoc "CATEGORY" props)
- (setq value (or (org-get-category)
- (progn (org-refresh-category-properties)
- (org-get-category))))
- (push (cons "CATEGORY" value) props))
+ (push (cons "CATEGORY" (org-get-category)) props))
(append sum-props (nreverse props)))))))
(defun org-entry-get (pom property &optional inherit literal-nil)
;; We need a special property. Use `org-entry-properties' to
;; retrieve it, but specify the wanted property
(cdr (assoc property (org-entry-properties nil 'special property)))
- (let ((range (org-get-property-block)))
- (if (and range
- (goto-char (car range))
- (re-search-forward
- (concat "^[ \t]*:" property ":[ \t]*\\(.*[^ \t\r\n\f\v]\\)?")
- (cdr range) t))
- ;; Found the property, return it.
- (if (match-end 1)
- (if literal-nil
- (org-match-string-no-properties 1)
- (org-not-nil (org-match-string-no-properties 1)))
- "")))))))
+ (let ((range (unless (org-before-first-heading-p)
+ (org-get-property-block)))
+ (props (list (or (assoc property org-file-properties)
+ (assoc property org-global-properties)
+ (assoc property org-global-properties-fixed))))
+ val)
+ (flet ((ap (key)
+ (when (re-search-forward
+ (org-re-property key) (cdr range) t)
+ (setq props
+ (org-update-property-plist
+ key
+ (if (match-end 1)
+ (org-match-string-no-properties 1) "")
+ props)))))
+ (when (and range (goto-char (car range)))
+ (ap property)
+ (goto-char (car range))
+ (while (ap (concat property "+")))
+ (setq val (cdr (assoc property props)))
+ (when val (if literal-nil val (org-not-nil val))))))))))
(defun org-property-or-variable-value (var &optional inherit)
"Check if there is a property fixing the value of VAR.
(if (and range
(goto-char (car range))
(re-search-forward
- (concat "^[ \t]*:" property ":[ \t]*\\(.*[^ \t\r\n\f\v]\\)")
+ (org-re-property property)
(cdr range) t))
(progn
(delete-region (match-beginning 0) (1+ (point-at-eol)))
However, if LITERAL-NIL is set, return the string value \"nil\" instead."
(move-marker org-entry-property-inherited-from nil)
(let (tmp)
- (save-excursion
- (save-restriction
- (widen)
- (catch 'ex
- (while t
- (when (setq tmp (org-entry-get nil property nil 'literal-nil))
- (org-back-to-heading t)
- (move-marker org-entry-property-inherited-from (point))
- (throw 'ex tmp))
- (or (org-up-heading-safe) (throw 'ex nil)))))
- (setq tmp (or tmp
- (cdr (assoc property org-file-properties))
- (cdr (assoc property org-global-properties))
- (cdr (assoc property org-global-properties-fixed))))
- (if literal-nil tmp (org-not-nil tmp)))))
+ (unless (org-before-first-heading-p)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (catch 'ex
+ (while t
+ (when (setq tmp (org-entry-get nil property nil 'literal-nil))
+ (org-back-to-heading t)
+ (move-marker org-entry-property-inherited-from (point))
+ (throw 'ex tmp))
+ (or (org-up-heading-safe) (throw 'ex nil)))))))
+ (setq tmp (or tmp
+ (cdr (assoc property org-file-properties))
+ (cdr (assoc property org-global-properties))
+ (cdr (assoc property org-global-properties-fixed))))
+ (if literal-nil tmp (org-not-nil tmp))))
(defvar org-property-changed-functions nil
"Hook called when the value of a property has changed.
(setq range (org-get-property-block beg end 'force))
(goto-char (car range))
(if (re-search-forward
- (concat "^[ \t]*:" property ":\\(.*\\)") (cdr range) t)
+ (org-re-property property) (cdr range) t)
(progn
- (delete-region (match-beginning 1) (match-end 1))
- (goto-char (match-beginning 1)))
+ (delete-region (match-beginning 0) (match-end 0))
+ (goto-char (match-beginning 0)))
(goto-char (cdr range))
(insert "\n")
(backward-char 1)
- (org-indent-line-function)
- (insert ":" property ":"))
+ (org-indent-line-function))
+ (insert ":" property ":")
(and value (insert " " value))
(org-indent-line-function)))))
(run-hook-with-args 'org-property-changed-functions property value)))
With INCLUDE-SPECIALS, also list the special properties that reflect things
like tags and TODO state.
With INCLUDE-DEFAULTS, also include properties that has special meaning
-internally: ARCHIVE, CATEGORY, SUMMARY, DESCRIPTION, LOCATION, and LOGGING.
+internally: ARCHIVE, CATEGORY, SUMMARY, DESCRIPTION, LOCATION, and LOGGING
+and others.
With INCLUDE-COLUMNS, also include property names given in COLUMN
formats in the current buffer."
(let (rtn range cfmt s p)
(sort rtn (lambda (a b) (string< (upcase a) (upcase b))))))
(defun org-property-values (key)
- "Return a list of all values of property KEY."
+ "Return a list of all values of property KEY in the current buffer."
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
- (let ((re (concat "^[ \t]*:" key ":[ \t]*\\(\\S-.*\\)"))
+ (let ((re (org-re-property key))
values)
(while (re-search-forward re nil t)
(add-to-list 'values (org-trim (match-string 1))))
"Insert a property drawer into the current entry."
(interactive)
(org-back-to-heading t)
- (looking-at outline-regexp)
+ (looking-at org-outline-regexp)
(let ((indent (if org-adapt-indentation
(- (match-end 0)(match-beginning 0))
0))
(setq end (point))
(goto-char beg)
(while (re-search-forward re end t))
- (setq hiddenp (org-invisible-p))
+ (setq hiddenp (outline-invisible-p))
(end-of-line 1)
(and (equal (char-after) ?\n) (forward-char 1))
(while (looking-at "^[ \t]*\\(:CLOCK:\\|:LOGBOOK:\\|CLOCK:\\|:END:\\)")
(hide-entry))
(org-flag-drawer t))))
+(defvar org-property-set-functions-alist nil
+ "Property set function alist.
+Each entry should have the following format:
+
+ (PROPERTY . READ-FUNCTION)
+
+The read function will be called with the same argument as
+`org-completing-read'.")
+
+(defun org-set-property-function (property)
+ "Get the function that should be used to set PROPERTY.
+This is computed according to `org-property-set-functions-alist'."
+ (or (cdr (assoc property org-property-set-functions-alist))
+ 'org-completing-read))
+
+(defun org-read-property-value (property)
+ "Read PROPERTY value from user."
+ (let* ((completion-ignore-case t)
+ (allowed (org-property-get-allowed-values nil property 'table))
+ (cur (org-entry-get nil property))
+ (prompt (concat property " value"
+ (if (and cur (string-match "\\S-" cur))
+ (concat " [" cur "]") "") ": "))
+ (set-function (org-set-property-function property))
+ (val (if allowed
+ (funcall set-function prompt allowed nil
+ (not (get-text-property 0 'org-unrestricted
+ (caar allowed))))
+ (let (org-completion-use-ido org-completion-use-iswitchb)
+ (funcall set-function prompt
+ (mapcar 'list (org-property-values property))
+ nil nil "" nil cur)))))
+ (if (equal val "")
+ cur
+ val)))
+
+(defvar org-last-set-property nil)
+(defun org-read-property-name ()
+ "Read a property name."
+ (let* ((completion-ignore-case t)
+ (keys (org-buffer-property-keys nil t t))
+ (default-prop (or (save-excursion
+ (save-match-data
+ (beginning-of-line)
+ (and (looking-at "^\\s-*:\\([^:\n]+\\):")
+ (null (string= (match-string 1) "END"))
+ (match-string 1))))
+ org-last-set-property))
+ (property (org-icompleting-read
+ (concat "Property"
+ (if default-prop (concat " [" default-prop "]") "")
+ ": ")
+ (mapcar 'list keys)
+ nil nil nil nil
+ default-prop
+ )))
+ (if (member property keys)
+ property
+ (or (cdr (assoc (downcase property)
+ (mapcar (lambda (x) (cons (downcase x) x))
+ keys)))
+ property))))
+
(defun org-set-property (property value)
"In the current entry, set PROPERTY to VALUE.
When called interactively, this will prompt for a property name, offering
for a value, offering completion either on allowed values (via an inherited
xxx_ALL property) or on existing values in other instances of this property
in the current file."
- (interactive
- (let* ((completion-ignore-case t)
- (keys (org-buffer-property-keys nil t t))
- (prop0 (org-icompleting-read "Property: " (mapcar 'list keys)))
- (prop (if (member prop0 keys)
- prop0
- (or (cdr (assoc (downcase prop0)
- (mapcar (lambda (x) (cons (downcase x) x))
- keys)))
- prop0)))
- (cur (org-entry-get nil prop))
- (prompt (concat prop " value"
- (if (and cur (string-match "\\S-" cur))
- (concat " [" cur "]") "") ": "))
- (allowed (org-property-get-allowed-values nil prop 'table))
- (existing (mapcar 'list (org-property-values prop)))
- (val (if allowed
- (org-completing-read prompt allowed nil
- (not (get-text-property 0 'org-unrestricted
- (caar allowed))))
- (let (org-completion-use-ido org-completion-use-iswitchb)
- (org-completing-read prompt 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)))
+ (interactive (list nil nil))
+ (let* ((property (or property (org-read-property-name)))
+ (value (or value (org-read-property-value property)))
+ (fn (assoc property org-properties-postprocess-alist)))
+ (setq org-last-set-property property)
+ ;; Possibly postprocess the inserted value:
+ (when fn (setq value (funcall (cadr fn) value)))
+ (unless (equal (org-entry-get nil property) value)
+ (org-entry-put nil property value))))
(defun org-delete-property (property)
"In the current entry, delete PROPERTY."
(goto-char (point-min))
(let ((cnt 0))
(while (re-search-forward
- (concat "^[ \t]*:" (regexp-quote property) ":.*\n?")
+ (org-re-property property)
nil t)
(setq cnt (1+ cnt))
- (replace-match ""))
+ (delete-region (match-beginning 0) (1+ (point-at-eol))))
(message "Property \"%s\" removed from %d entries" property cnt)))))
(defvar org-columns-current-fmt-compiled) ; defined in org-colview.el
(level 1)
(lmin 1)
(lmax 1)
- limit re end found pos heading cnt)
+ limit re end found pos heading cnt flevel)
(unless buffer (error "File not found :%s" file))
(with-current-buffer buffer
(save-excursion
(while (re-search-forward re end t)
(setq level (- (match-end 1) (match-beginning 1)))
(if (and (>= level lmin) (<= level lmax))
- (setq found (match-beginning 0) cnt (1+ cnt))))
+ (setq found (match-beginning 0) flevel level cnt (1+ cnt))))
(when (= cnt 0) (error "Heading not found on level %d: %s"
lmax heading))
(when (> cnt 1) (error "Heading not unique on level %d: %s"
lmax heading))
(goto-char found)
- (setq lmin (1+ level) lmax (+ lmin (if org-odd-levels-only 1 0)))
+ (setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0)))
(setq end (save-excursion (org-end-of-subtree t t))))
- (when (org-on-heading-p)
+ (when (org-at-heading-p)
(move-marker (make-marker) (point))))))))
(defun org-find-exact-headline-in-buffer (heading &optional buffer pos-only)
(apply 'encode-time (org-parse-time-string (match-string 1)))
(current-time)))
(default-input (and ts (org-get-compact-tod ts)))
+ (repeater (save-excursion
+ (save-match-data
+ (beginning-of-line)
+ (when (re-search-forward
+ "\\([.+-]+[0-9]+[dwmy] ?\\)+" ;;\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?"
+ (save-excursion (progn (end-of-line) (point))) t)
+ (match-string 0)))))
org-time-was-given org-end-time-was-given time)
(cond
((and (org-at-timestamp-p t)
(setq org-last-changed-timestamp
(org-insert-time-stamp
time (or org-time-was-given arg)
- inactive nil nil (list org-end-time-was-given))))
+ inactive nil nil (list org-end-time-was-given)))
+ (when repeater (goto-char (1- (point))) (insert " " repeater)
+ (setq org-last-changed-timestamp
+ (concat (substring org-last-inserted-timestamp 0 -1)
+ " " repeater ">"))))
(message "Timestamp updated"))
(t
(setq time (let ((this-command this-command))
(defvar org-dcst nil) ; dynamically scoped
(defvar org-read-date-history nil)
(defvar org-read-date-final-answer nil)
+(defvar org-read-date-analyze-futurep nil)
+(defvar org-read-date-analyze-forced-year nil)
-(defun org-read-date (&optional with-time to-time from-string prompt
+(defun org-read-date (&optional org-with-time to-time from-string prompt
default-time default-input)
"Read a date, possibly a time, and make things smooth for the user.
The prompt will suggest to enter an ISO date, but you can also enter anything
which will at least partially be understood by `parse-time-string'.
Unrecognized parts of the date will default to the current day, month, year,
hour and minute. If this command is called to replace a timestamp at point,
-of to enter the second timestamp of a range, the default time is taken
+or to enter the second timestamp of a range, the default time is taken
from the existing stamp. Furthermore, the command prefers the future,
so if you are giving a date where the year is not given, and the day-month
combination is already past in the current year, it will assume you
+2w --> two weeks from today
++5 --> five days from default date
-The function understands only English month and weekday abbreviations,
-but this can be configured with the variables `parse-time-months' and
-`parse-time-weekdays'.
+The function understands only English month and weekday abbreviations.
While prompting, a calendar is popped up - you can also select the
date with the mouse (button 1). The calendar shows a period of three
user."
(require 'parse-time)
(let* ((org-time-stamp-rounding-minutes
- (if (equal with-time '(16)) '(0 0) org-time-stamp-rounding-minutes))
+ (if (equal org-with-time '(16)) '(0 0) org-time-stamp-rounding-minutes))
(org-dcst org-display-custom-times)
(ct (org-current-time))
- (def (or org-overriding-default-time default-time ct))
- (defdecode (decode-time def))
+ (org-def (or org-overriding-default-time default-time ct))
+ (org-defdecode (decode-time org-def))
(dummy (progn
- (when (< (nth 2 defdecode) org-extend-today-until)
- (setcar (nthcdr 2 defdecode) -1)
- (setcar (nthcdr 1 defdecode) 59)
- (setq def (apply 'encode-time defdecode)
- defdecode (decode-time def)))))
+ (when (< (nth 2 org-defdecode) org-extend-today-until)
+ (setcar (nthcdr 2 org-defdecode) -1)
+ (setcar (nthcdr 1 org-defdecode) 59)
+ (setq org-def (apply 'encode-time org-defdecode)
+ org-defdecode (decode-time org-def)))))
(calendar-frame-setup nil)
(calendar-setup nil)
(calendar-move-hook nil)
(calendar-view-diary-initially-flag nil)
(calendar-view-holidays-initially-flag nil)
(timestr (format-time-string
- (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") def))
+ (if org-with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") org-def))
(prompt (concat (if prompt (concat prompt " ") "")
(format "Date+time [%s]: " timestr)))
ans (org-ans0 "") org-ans1 org-ans2 final)
(save-excursion
(save-window-excursion
(calendar)
- (calendar-forward-day (- (time-to-days def)
- (calendar-absolute-from-gregorian
- (calendar-current-date))))
- (org-eval-in-calendar nil t)
- (let* ((old-map (current-local-map))
- (map (copy-keymap calendar-mode-map))
- (minibuffer-local-map (copy-keymap minibuffer-local-map)))
- (org-defkey map (kbd "RET") 'org-calendar-select)
- (org-defkey map [mouse-1] 'org-calendar-select-mouse)
- (org-defkey map [mouse-2] 'org-calendar-select-mouse)
- (org-defkey minibuffer-local-map [(meta shift left)]
- (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))))
- (org-defkey minibuffer-local-map [(meta shift up)]
- (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))))
- (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))))
- (org-defkey minibuffer-local-map [(shift down)]
- (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))))
- (org-defkey minibuffer-local-map [(shift right)]
- (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))))
- (org-defkey minibuffer-local-map "<"
- (lambda () (interactive)
- (org-eval-in-calendar '(scroll-calendar-right 1))))
- (org-defkey minibuffer-local-map "\C-v"
- (lambda () (interactive)
- (org-eval-in-calendar
- '(calendar-scroll-left-three-months 1))))
- (org-defkey minibuffer-local-map "\M-v"
- (lambda () (interactive)
- (org-eval-in-calendar
- '(calendar-scroll-right-three-months 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
- 'org-read-date-history nil))
- ;; org-ans0: from prompt
- ;; org-ans1: from mouse click
- ;; org-ans2: from calendar motion
- (setq ans (concat org-ans0 " " (or org-ans1 org-ans2))))
- (remove-hook 'post-command-hook 'org-read-date-display)
- (use-local-map old-map)
- (when org-read-date-overlay
- (delete-overlay org-read-date-overlay)
- (setq org-read-date-overlay nil)))))))
+ (unwind-protect
+ (progn
+ (calendar-forward-day (- (time-to-days org-def)
+ (calendar-absolute-from-gregorian
+ (calendar-current-date))))
+ (org-eval-in-calendar nil t)
+ (let* ((old-map (current-local-map))
+ (map (copy-keymap calendar-mode-map))
+ (minibuffer-local-map (copy-keymap minibuffer-local-map)))
+ (org-defkey map (kbd "RET") 'org-calendar-select)
+ (org-defkey map [mouse-1] 'org-calendar-select-mouse)
+ (org-defkey map [mouse-2] 'org-calendar-select-mouse)
+ (org-defkey minibuffer-local-map [(meta shift left)]
+ (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))))
+ (org-defkey minibuffer-local-map [(meta shift up)]
+ (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))))
+ (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))))
+ (org-defkey minibuffer-local-map [(shift down)]
+ (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))))
+ (org-defkey minibuffer-local-map [(shift right)]
+ (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))))
+ (org-defkey minibuffer-local-map "<"
+ (lambda () (interactive)
+ (org-eval-in-calendar '(scroll-calendar-right 1))))
+ (org-defkey minibuffer-local-map "\C-v"
+ (lambda () (interactive)
+ (org-eval-in-calendar
+ '(calendar-scroll-left-three-months 1))))
+ (org-defkey minibuffer-local-map "\M-v"
+ (lambda () (interactive)
+ (org-eval-in-calendar
+ '(calendar-scroll-right-three-months 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
+ 'org-read-date-history nil))
+ ;; org-ans0: from prompt
+ ;; org-ans1: from mouse click
+ ;; org-ans2: from calendar motion
+ (setq ans (concat org-ans0 " " (or org-ans1 org-ans2))))
+ (remove-hook 'post-command-hook 'org-read-date-display)
+ (use-local-map old-map)
+ (when org-read-date-overlay
+ (delete-overlay org-read-date-overlay)
+ (setq org-read-date-overlay nil)))))
+ (bury-buffer "*Calendar*")))))
(t ; Naked prompt only
(unwind-protect
(delete-overlay org-read-date-overlay)
(setq org-read-date-overlay nil)))))
- (setq final (org-read-date-analyze ans def defdecode))
+ (setq final (org-read-date-analyze ans org-def org-defdecode))
+
+ (when org-read-date-analyze-forced-year
+ (message "Year was forced into %s"
+ (if org-read-date-force-compatible-dates
+ "compatible range (1970-2037)"
+ "range representable on this machine"))
+ (ding))
;; One round trip to get rid of 34th of August and stuff like that....
(setq final (decode-time (apply 'encode-time 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)
+(defvar org-def)
+(defvar org-defdecode)
+(defvar org-with-time)
(defun org-read-date-display ()
"Display the current date prompt interpretation in the minibuffer."
(when org-read-date-display-live
(let* ((ans (concat (buffer-substring (point-at-bol) (point-max))
" " (or org-ans1 org-ans2)))
(org-end-time-was-given nil)
- (f (org-read-date-analyze ans def defdecode))
+ (f (org-read-date-analyze ans org-def org-defdecode))
(fmts (if org-dcst
org-time-stamp-custom-formats
org-time-stamp-formats))
- (fmt (if (or with-time
+ (fmt (if (or org-with-time
(and (boundp 'org-time-was-given) org-time-was-given))
(cdr fmts)
(car fmts)))
(make-overlay (1- (point-at-eol)) (point-at-eol)))
(org-overlay-display org-read-date-overlay txt 'secondary-selection))))
-(defun org-read-date-analyze (ans def defdecode)
+(defun org-read-date-analyze (ans org-def org-defdecode)
"Analyze the combined answer of the date prompt."
;; FIXME: cleanup and comment
(let ((nowdecode (decode-time (current-time)))
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 futurep kill-year)
- (setq org-read-date-analyze-futurep nil)
+ (setq org-read-date-analyze-futurep nil
+ org-read-date-analyze-forced-year nil)
(when (string-match "\\`[ \t]*\\.[ \t]*\\'" ans)
(setq ans "+0"))
- (when (setq delta (org-read-date-get-relative ans (current-time) def))
+ (when (setq delta (org-read-date-get-relative ans (current-time) org-def))
(setq ans (replace-match "" t t ans)
deltan (car delta)
deltaw (nth 1 delta)
(if (< year 100) (setq year (+ 2000 year)))
(setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day)
t nil ans)))
+
+ ;; Help matching dotted european dates
+ (when (string-match
+ "^ *\\(3[01]\\|0?[1-9]\\|[12][0-9]\\)\\. ?\\(0?[1-9]\\|1[012]\\)\\. ?\\([1-9][0-9][0-9][0-9]\\)?" ans)
+ (setq year (if (match-end 3)
+ (string-to-number (match-string 3 ans))
+ (progn (setq kill-year t)
+ (string-to-number (format-time-string "%Y"))))
+ day (string-to-number (match-string 1 ans))
+ month (string-to-number (match-string 2 ans))
+ ans (replace-match (format "%04d-%02d-%02d\\5" year month day)
+ t nil ans)))
+
;; Help matching american dates, like 5/30 or 5/30/7
(when (string-match
"^ *\\(0?[1-9]\\|1[012]\\)/\\(0?[1-9]\\|[12][0-9]\\|3[01]\\)\\(/\\([0-9]+\\)\\)?\\([^/0-9]\\|$\\)" ans)
(substring ans (match-end 7))))))
(setq tl (parse-time-string ans)
- day (or (nth 3 tl) (nth 3 defdecode))
+ day (or (nth 3 tl) (nth 3 org-defdecode))
month (or (nth 4 tl)
(if (and org-read-date-prefer-future
(nth 3 tl) (< (nth 3 tl) (nth 3 nowdecode)))
(prog1 (1+ (nth 4 nowdecode)) (setq futurep t))
- (nth 4 defdecode)))
+ (nth 4 org-defdecode)))
year (or (and (not kill-year) (nth 5 tl))
(if (and org-read-date-prefer-future
(nth 4 tl) (< (nth 4 tl) (nth 4 nowdecode)))
(prog1 (1+ (nth 5 nowdecode)) (setq futurep t))
- (nth 5 defdecode)))
- hour (or (nth 2 tl) (nth 2 defdecode))
- minute (or (nth 1 tl) (nth 1 defdecode))
+ (nth 5 org-defdecode)))
+ hour (or (nth 2 tl) (nth 2 org-defdecode))
+ minute (or (nth 1 tl) (nth 1 org-defdecode))
second (or (nth 0 tl) 0)
wday (nth 6 tl))
(nth 2 tl))
(setq org-time-was-given t))
(if (< year 100) (setq year (+ 2000 year)))
- (if (< year 1970) (setq year (nth 5 defdecode))) ; not representable
+ ;; Check of the date is representable
+ (if org-read-date-force-compatible-dates
+ (progn
+ (if (< year 1970)
+ (setq year 1970 org-read-date-analyze-forced-year t))
+ (if (> year 2037)
+ (setq year 2037 org-read-date-analyze-forced-year t)))
+ (condition-case nil
+ (ignore (encode-time second minute hour day month year))
+ (error
+ (setq year (nth 5 org-defdecode))
+ (setq org-read-date-analyze-forced-year t))))
(setq org-read-date-analyze-futurep futurep)
(list second minute hour day month year)))
(defvar parse-time-weekdays)
-
(defun org-read-date-get-relative (s today default)
"Check string S for special relative date string.
TODAY and DEFAULT are internal times, for today and for a default.
N is the number of WHATs to shift.
DEF-FLAG is t when a double ++ or -- indicates shift relative to
the DEFAULT date rather than TODAY."
+ (require 'parse-time)
(when (and
(string-match
(concat
(org-restart-font-lock)
(setq org-table-may-need-update t)
(if org-display-custom-times
- (message "Time stamps are overlayed with custom format")
+ (message "Time stamps are overlaid with custom format")
(message "Time stamp overlays removed")))
(defun org-display-custom-time (beg end)
(message "%d entries after %s"
(org-occur regexp nil callback) date)))
+(defun org-check-dates-range (start-date end-date)
+ "Check for deadlines/scheduled entries between START-DATE and END-DATE."
+ (interactive (list (org-read-date nil nil nil "Range starts")
+ (org-read-date nil nil nil "Range end")))
+ (let ((case-fold-search nil)
+ (regexp (concat "\\<\\(" org-deadline-string
+ "\\|" org-scheduled-string
+ "\\) *<\\([^>]+\\)>"))
+ (callback
+ (lambda ()
+ (let ((match (match-string 2)))
+ (and
+ (not (time-less-p
+ (org-time-string-to-time match)
+ (org-time-string-to-time start-date)))
+ (time-less-p
+ (org-time-string-to-time match)
+ (org-time-string-to-time end-date)))))))
+ (message "%d entries between %s and %s"
+ (org-occur regexp nil callback) start-date end-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
l (push m l)))
(apply 'format fmt (nreverse l))))
-(defun org-time-string-to-time (s)
- (apply 'encode-time (org-parse-time-string s)))
+(defun org-time-string-to-time (s &optional buffer pos)
+ (condition-case errdata
+ (apply 'encode-time (org-parse-time-string s))
+ (error (error "Bad timestamp `%s'%s\nError was: %s"
+ s (if (not (and buffer pos))
+ ""
+ (format " at %d in buffer `%s'" pos buffer))
+ (cdr errdata)))))
+
(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)
+(defun org-time-string-to-absolute (s &optional daynr prefer show-all buffer pos)
"Convert a time stamp to an absolute day number.
If there is a specifier for a cyclic time stamp, get the closest date to
DAYNR.
PREFER and SHOW-ALL are passed through to `org-closest-date'.
-the variable date is bound by the calendar when this is called."
+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)
(org-closest-date s (if (and (boundp 'daynr) (integerp daynr)) daynr
(time-to-days (current-time))) (match-string 0 s)
prefer show-all))
- (t (time-to-days (apply 'encode-time (org-parse-time-string s))))))
+ (t (time-to-days
+ (condition-case errdata
+ (apply 'encode-time (org-parse-time-string s))
+ (error (error "Bad timestamp `%s'%s\nError was: %s"
+ s (if (not (and buffer pos))
+ ""
+ (format " at %d in buffer `%s'" pos buffer))
+ (cdr errdata))))))))
(defun org-days-to-iso-week (days)
"Return the iso week number."
(defun org-closest-date (start current change prefer show-all)
"Find the date closest to CURRENT that is consistent with START and CHANGE.
-When PREFER is `past' return a date that is either CURRENT or past.
+When PREFER is `past', return a date that is either CURRENT or past.
When PREFER is `future', return a date that is either CURRENT or future.
When SHOW-ALL is nil, only return the current occurrence of a time stamp."
;; Make the proper lists from the dates
(defun org-timestamp-up (&optional arg)
"Increase the date item at the cursor by one.
-If the cursor is on the year, change the year. If it is on the month or
-the day, change that.
+If the cursor is on the year, change the year. If it is on the month,
+the day or the time, change that.
With prefix ARG, change by that many units."
(interactive "p")
(org-timestamp-change (prefix-numeric-value arg) nil 'updown))
(defun org-timestamp-down (&optional arg)
"Decrease the date item at the cursor by one.
-If the cursor is on the year, change the year. If it is on the month or
-the day, change that.
+If the cursor is on the year, change the year. If it is on the month,
+the day or the time, change that.
With prefix ARG, change by that many units."
(interactive "p")
(org-timestamp-change (- (prefix-numeric-value arg)) nil 'updown))
With prefix ARG, change that many days."
(interactive "p")
(if (and (not (org-at-timestamp-p t))
- (org-on-heading-p))
+ (org-at-heading-p))
(org-todo 'up)
(org-timestamp-change (prefix-numeric-value arg) 'day 'updown)))
With prefix ARG, change that many days."
(interactive "p")
(if (and (not (org-at-timestamp-p t))
- (org-on-heading-p))
+ (org-at-heading-p))
(org-todo 'down)
(org-timestamp-change (- (prefix-numeric-value arg)) 'day) 'updown))
(setq org-ts-what
(cond
((= pos (match-beginning 0)) 'bracket)
- ((= pos (1- (match-end 0))) 'bracket)
+ ;; Point is considered to be "on the bracket" whether
+ ;; it's really on it or right after it.
+ ((or (= pos (1- (match-end 0)))
+ (= pos (match-end 0))) 'bracket)
((org-pos-in-match-range pos 2) 'year)
((org-pos-in-match-range pos 3) 'month)
((org-pos-in-match-range pos 7) 'hour)
The date will be changed by N times WHAT. WHAT can be `day', `month',
`year', `minute', `second'. If WHAT is not given, the cursor position
in the timestamp determines what will be changed."
- (let ((pos (point))
+ (let ((origin (point)) origin-cat
with-hm inactive
(dm (max (nth 1 org-time-stamp-rounding-minutes) 1))
org-ts-what
(error "Not at a timestamp"))
(if (and (not what) (eq org-ts-what 'bracket))
(org-toggle-timestamp-type)
+ ;; Point isn't on brackets. Remember the part of the time-stamp
+ ;; the point was in. Indeed, size of time-stamps may change,
+ ;; but point must be kept in the same category nonetheless.
+ (setq origin-cat org-ts-what)
(if (and (not what) (not (eq org-ts-what 'day))
org-display-custom-times
(get-text-property (point) 'display)
(setcar (nthcdr 1 time0) (or (nth 1 time0) 0))
(setcar (nthcdr 2 time0) (or (nth 2 time0) 0))
(setq time (apply 'encode-time time0))))
- (setq org-last-changed-timestamp
- (org-insert-time-stamp time with-hm inactive nil nil extra))
+ ;; Insert the new time-stamp, and ensure point stays in the same
+ ;; category as before (i.e. not after the last position in that
+ ;; category).
+ (let ((pos (point)))
+ ;; Stay before inserted string. `save-excursion' is of no use.
+ (setq org-last-changed-timestamp
+ (org-insert-time-stamp time with-hm inactive nil nil extra))
+ (goto-char pos))
+ (save-match-data
+ (looking-at org-ts-regexp3)
+ (goto-char (cond
+ ;; `day' category ends before `hour' if any, or at
+ ;; the end of the day name.
+ ((eq origin-cat 'day)
+ (min (or (match-beginning 7) (1- (match-end 5))) origin))
+ ((eq origin-cat 'hour) (min (match-end 7) origin))
+ ((eq origin-cat 'minute) (min (1- (match-end 8)) origin))
+ ((integerp origin-cat) (min (1- (match-end 0)) origin))
+ ;; `year' and `month' have both fixed size: point
+ ;; couldn't have moved into another part.
+ (t origin))))
+ ;; Update clock if on a CLOCK line.
(org-clock-update-time-maybe)
- (goto-char pos)
- ;; Try to recenter the calendar window, if any
+ ;; Try to recenter the calendar window, if any.
(if (and org-calendar-follow-timestamp-change
(get-buffer-window "*Calendar*" t)
(memq org-ts-what '(day month year)))
(defun org-recenter-calendar (date)
"If the calendar is visible, recenter it to DATE."
- (let* ((win (selected-window))
- (cwin (get-buffer-window "*Calendar*" t))
- (calendar-move-hook nil))
+ (let ((cwin (get-buffer-window "*Calendar*" t)))
(when cwin
- (select-window cwin)
- (calendar-goto-date (if (listp date) date
- (calendar-gregorian-from-absolute date)))
- (select-window win))))
+ (let ((calendar-move-hook nil))
+ (with-selected-window cwin
+ (calendar-goto-date (if (listp date) date
+ (calendar-gregorian-from-absolute date))))))))
(defun org-goto-calendar (&optional arg)
"Go to the Emacs calendar at the current date.
there can be extra stuff in the string.
If no number is found, the return value is 0."
(cond
+ ((integerp s) s)
((string-match "\\([0-9]+\\):\\([0-9]+\\)" s)
(+ (* (string-to-number (match-string 1 s)) 60)
(string-to-number (match-string 2 s))))
(string-to-number (match-string 1 s)))
(t 0)))
+(defcustom org-effort-durations
+ `(("h" . 60)
+ ("d" . ,(* 60 8))
+ ("w" . ,(* 60 8 5))
+ ("m" . ,(* 60 8 5 4))
+ ("y" . ,(* 60 8 5 40)))
+ "Conversion factor to minutes for an effort modifier.
+
+Each entry has the form (MODIFIER . MINUTES).
+
+In an effort string, a number followed by MODIFIER is multiplied
+by the specified number of MINUTES to obtain an effort in
+minutes.
+
+For example, if the value of this variable is ((\"hours\" . 60)), then an
+effort string \"2hours\" is equivalent to 120 minutes."
+ :group 'org-agenda
+ :version "24.1"
+ :type '(alist :key-type (string :tag "Modifier")
+ :value-type (number :tag "Minutes")))
+
+(defun org-duration-string-to-minutes (s)
+ "Convert a duration string S to minutes.
+
+A bare number is interpreted as minutes, modifiers can be set by
+customizing `org-effort-durations' (which see).
+
+Entries containing a colon are interpreted as H:MM by
+`org-hh:mm-string-to-minutes'."
+ (let ((result 0)
+ (re (concat "\\([0-9]+\\) *\\("
+ (regexp-opt (mapcar 'car org-effort-durations))
+ "\\)")))
+ (while (string-match re s)
+ (incf result (* (cdr (assoc (match-string 2 s) org-effort-durations))
+ (string-to-number (match-string 1 s))))
+ (setq s (replace-match "" nil t s)))
+ (incf result (org-hh:mm-string-to-minutes s))
+ result))
+
;;;; 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)
+ (save-some-buffers t (lambda () (eq major-mode 'org-mode)))
(when (featurep 'org-id) (org-id-locations-save))
(message "Saving all Org-mode buffers... done"))
(save-window-excursion
(mapc
(lambda (b)
- (when (and (with-current-buffer b (org-mode-p))
+ (when (and (with-current-buffer b (eq major-mode 'org-mode))
(with-current-buffer b buffer-file-name))
- (switch-to-buffer b)
+ (org-pop-to-buffer-same-window b)
(revert-buffer t 'no-confirm)))
(buffer-list))
(when (and (featurep 'org-id) org-id-track-globally)
;;;###autoload
(defun org-switchb (&optional arg)
"Switch between Org buffers.
-With a prefix argument, restrict available to files.
+With one prefix argument, restrict available buffers to files.
With two prefix arguments, restrict available buffers to agenda files.
Defaults to `iswitchb' for buffer name completion.
(org-completion-use-ido org-completion-use-ido))
(unless (or org-completion-use-ido org-completion-use-iswitchb)
(setq org-completion-use-iswitchb t))
- (switch-to-buffer
+ (org-pop-to-buffer-same-window
(org-icompleting-read "Org buffer: "
(mapcar 'list (mapcar 'buffer-name blist))
nil t))))
(find-file (car files))
(throw 'exit t))))
(find-file (car fs)))
- (if (buffer-base-buffer) (switch-to-buffer (buffer-base-buffer)))))
+ (if (buffer-base-buffer) (org-pop-to-buffer-same-window (buffer-base-buffer)))))
(defun org-agenda-file-to-front (&optional to-end)
"Move/add the current file to the top of the agenda file list.
(when org-agenda-skip-archived-trees
(goto-char (point-min))
(while (re-search-forward rea nil t)
- (if (org-on-heading-p t)
+ (if (org-at-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 "\\>"))
+ (setq re (format org-heading-keyword-regexp-format
+ org-comment-string))
(while (re-search-forward re nil t)
(add-text-properties
(match-beginning 0) (org-end-of-subtree t) pc)))
in Org-mode.
\\{org-cdlatex-mode-map}"
nil " OCDL" nil
- (when org-cdlatex-mode (require 'cdlatex))
+ (when org-cdlatex-mode
+ (require 'cdlatex)
+ (run-hooks 'cdlatex-mode-hook)
+ (cdlatex-compute-tables))
(unless org-cdlatex-texmathp-advice-is-done
(setq org-cdlatex-texmathp-advice-is-done t)
(defadvice texmathp (around org-math-always-on activate)
(interactive)
(let (p)
(cond
- ((not (org-mode-p)) ad-do-it)
+ ((not (eq major-mode 'org-mode)) ad-do-it)
((eq this-command 'cdlatex-math-symbol)
(setq ad-return-value t
texmathp-why '("cdlatex-math-symbol in org-mode" . 0)))
Even though the matchers for math are configurable, this function assumes
that \\begin, \\(, \\[, and $$ are always used. Only the single dollar
delimiters are skipped when they have been removed by customization.
-The return value is nil, or a cons cell with the delimiter
-and the position of this delimiter.
+The return value is nil, or a cons cell with the delimiter and the
+position of this delimiter.
This function does a reasonably good job, but can locally be fooled by
for example currency specifications. For example it will assume being in
insert a LaTeX environment."
(when org-cdlatex-mode
(cond
+ ;; Before any word on the line: No expansion possible.
+ ((save-excursion (skip-chars-backward " \t") (bolp)) nil)
+ ;; Just after first word on the line: Expand it. Make sure it
+ ;; cannot happen on headlines, though.
((save-excursion
(skip-chars-backward "a-zA-Z0-9*")
(skip-chars-backward " \t")
- (bolp))
- (cdlatex-tab) t)
- ((org-inside-LaTeX-fragment-p)
+ (and (bolp) (not (org-at-heading-p))))
(cdlatex-tab) t)
- (t nil))))
+ ((org-inside-LaTeX-fragment-p) (cdlatex-tab) t))))
(defun org-cdlatex-underscore-caret (&optional arg)
"Execute `cdlatex-sub-superscript' in LaTeX fragments.
display all fragments in the buffer.
The images can be removed again with \\[org-ctrl-c-ctrl-c]."
(interactive "P")
+ (unless buffer-file-name
+ (error "Can't preview LaTeX fragment in a non-file buffer"))
(org-remove-latex-fragment-image-overlays)
(save-excursion
(save-restriction
(cond
((or (equal subtree '(16))
(not (save-excursion
- (re-search-backward (concat "^" outline-regexp) nil t))))
+ (re-search-backward org-outline-regexp-bol nil t))))
(setq beg (point-min) end (point-max)
msg "Creating images for buffer...%s"))
((equal subtree '(4))
'(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t)
;; ("$" "\\([ (]\\|^\\)\\(\\(\\([$]\\)\\([^ \r\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \r\n,.$]\\)\\4\\)\\)\\([ .,?;:'\")]\\|$\\)" 2 nil)
;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p
- ("$1" "\\([^$]\\)\\(\\$[^ \r\n,;.$]\\$\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil)
- ("$" "\\([^$]\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil)
+ ("$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 nil)
("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil))
(plist-get (org-infile-export-plist) :latex-header-extra))
(cnt 0) txt hash link beg end re e checkdir
executables-checked string
- m n block linkfile movefile ov)
+ m n block-type block linkfile movefile ov)
;; Check the different regular expressions
(while (setq e (pop re-list))
- (setq m (car e) re (nth 1 e) n (nth 2 e)
- block (if (nth 3 e) "\n\n" ""))
+ (setq m (car e) re (nth 1 e) n (nth 2 e) block-type (nth 3 e)
+ block (if block-type "\n\n" ""))
(when (member m matchers)
(goto-char (point-min))
(while (re-search-forward re nil t)
'(org-protected t))))
(add-text-properties (match-beginning n) (match-end n)
'(org-protected t))))
- ((or (eq processing-type 'dvipng) t)
+ ((eq processing-type 'dvipng)
;; Process to an image
(setq txt (match-string n)
beg (match-beginning n) end (match-end n)
(insert (org-add-props link
(list 'org-latex-src
(replace-regexp-in-string
- "\"" "" txt)))))))))))))
+ "\"" "" txt)
+ 'org-latex-src-embed-type
+ (if block-type 'paragraph 'character))))))
+ ((eq processing-type 'mathml)
+ ;; Process to MathML
+ (unless executables-checked
+ (unless (save-match-data (org-format-latex-mathml-available-p))
+ (error "LaTeX to MathML converter not configured"))
+ (setq executables-checked t))
+ (setq txt (match-string n)
+ beg (match-beginning n) end (match-end n)
+ cnt (1+ cnt))
+ (if msg (message msg cnt))
+ (goto-char beg)
+ (delete-region beg end)
+ (insert (org-format-latex-as-mathml
+ txt block-type prefix dir)))
+ (t
+ (error "Unknown conversion type %s for latex fragments"
+ processing-type)))))))))
+
+(defun org-create-math-formula (latex-frag &optional mathml-file)
+ "Convert LATEX-FRAG to MathML and store it in MATHML-FILE.
+Use `org-latex-to-mathml-convert-command'. If the conversion is
+sucessful, return the portion between \"<math...> </math>\"
+elements otherwise return nil. When MATHML-FILE is specified,
+write the results in to that file. When invoked as an
+interactive command, prompt for LATEX-FRAG, with initial value
+set to the current active region and echo the results for user
+inspection."
+ (interactive (list (let ((frag (when (region-active-p)
+ (buffer-substring-no-properties
+ (region-beginning) (region-end)))))
+ (read-string "LaTeX Fragment: " frag nil frag))))
+ (unless latex-frag (error "Invalid latex-frag"))
+ (let* ((tmp-in-file (file-relative-name
+ (make-temp-name (expand-file-name "ltxmathml-in"))))
+ (ignore (write-region latex-frag nil tmp-in-file))
+ (tmp-out-file (file-relative-name
+ (make-temp-name (expand-file-name "ltxmathml-out"))))
+ (cmd (format-spec
+ org-latex-to-mathml-convert-command
+ `((?j . ,(shell-quote-argument
+ (expand-file-name org-latex-to-mathml-jar-file)))
+ (?I . ,(shell-quote-argument tmp-in-file))
+ (?o . ,(shell-quote-argument tmp-out-file)))))
+ mathml shell-command-output)
+ (when (org-called-interactively-p 'any)
+ (unless (org-format-latex-mathml-available-p)
+ (error "LaTeX to MathML converter not configured")))
+ (message "Running %s" cmd)
+ (setq shell-command-output (shell-command-to-string cmd))
+ (setq mathml
+ (when (file-readable-p tmp-out-file)
+ (with-current-buffer (find-file-noselect tmp-out-file t)
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat
+ (regexp-quote
+ "<math xmlns=\"http://www.w3.org/1998/Math/MathML\">")
+ "\\(.\\|\n\\)*"
+ (regexp-quote "</math>")) nil t)
+ (prog1 (match-string 0) (kill-buffer))))))
+ (cond
+ (mathml
+ (setq mathml
+ (concat "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" mathml))
+ (when mathml-file
+ (write-region mathml nil mathml-file))
+ (when (org-called-interactively-p 'any)
+ (message mathml)))
+ ((message "LaTeX to MathML conversion failed")
+ (message shell-command-output)))
+ (delete-file tmp-in-file)
+ (when (file-exists-p tmp-out-file)
+ (delete-file tmp-out-file))
+ mathml))
+
+(defun org-format-latex-as-mathml (latex-frag latex-frag-type
+ prefix &optional dir)
+ "Use `org-create-math-formula' but check local cache first."
+ (let* ((absprefix (expand-file-name prefix dir))
+ (print-length nil) (print-level nil)
+ (formula-id (concat
+ "formula-"
+ (sha1
+ (prin1-to-string
+ (list latex-frag
+ org-latex-to-mathml-convert-command)))))
+ (formula-cache (format "%s-%s.mathml" absprefix formula-id))
+ (formula-cache-dir (file-name-directory formula-cache)))
+
+ (unless (file-directory-p formula-cache-dir)
+ (make-directory formula-cache-dir t))
+
+ (unless (file-exists-p formula-cache)
+ (org-create-math-formula latex-frag formula-cache))
+
+ (if (file-exists-p formula-cache)
+ ;; Successful conversion. Return the link to MathML file.
+ (org-add-props
+ (format "[[file:%s]]" (file-relative-name formula-cache dir))
+ (list 'org-latex-src (replace-regexp-in-string "\"" "" latex-frag)
+ 'org-latex-src-embed-type (if latex-frag-type
+ 'paragraph 'character)))
+ ;; Failed conversion. Return the LaTeX fragment verbatim
+ (add-text-properties
+ 0 (1- (length latex-frag)) '(org-protected t) latex-frag)
+ latex-frag)))
;; This function borrows from Ganesh Swami's latex2png.el
(defun org-create-formula-image (string tofile options buffer)
(dvifile (concat texfilebase ".dvi"))
(pngfile (concat texfilebase ".png"))
(fnh (if (featurep 'xemacs)
- (font-height (get-face-font 'default))
+ (font-height (face-font 'default))
(face-attribute 'default :height nil)))
(scale (or (plist-get options (if buffer :scale :html-scale)) 1.0))
(dpi (number-to-string (* scale (floor (* 0.9 (if buffer fnh 140.))))))
(if (not (file-exists-p dvifile))
(progn (message "Failed to create dvi file from %s" texfile) nil)
(condition-case nil
- (call-process "dvipng" nil nil nil
+ (if (featurep 'xemacs)
+ (call-process "dvipng" nil nil nil
"-fg" fg "-bg" bg
- "-D" dpi
- ;;"-x" scale "-y" scale
"-T" "tight"
"-o" pngfile
dvifile)
+ (call-process "dvipng" nil nil nil
+ "-fg" fg "-bg" bg
+ "-D" dpi
+ ;;"-x" scale "-y" scale
+ "-T" "tight"
+ "-o" pngfile
+ dvifile))
(error nil))
(if (not (file-exists-p pngfile))
(if org-format-latex-signal-error
"Return an rgb color specification for dvipng."
(apply 'format "rgb %s %s %s"
(mapcar 'org-normalize-color
- (color-values (face-attribute 'default attr nil)))))
+ (if (featurep 'xemacs)
+ (color-rgb-components
+ (face-property 'default
+ (cond ((eq attr :foreground) 'foreground)
+ ((eq attr :background) 'background))))
+ (color-values (face-attribute 'default attr nil))))))
(defun org-normalize-color (value)
"Return string to be used as color value for an RGB component."
(interactive "P")
(unless refresh
(org-remove-inline-images)
- (clear-image-cache))
+ (if (fboundp 'clear-image-cache) (clear-image-cache)))
(save-excursion
(save-restriction
(widen)
(setq beg (or beg (point-min)) end (or end (point-max)))
- (goto-char (point-min))
+ (goto-char beg)
(let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?"
(substring (org-image-file-name-regexp) 0 -2)
"\\)\\]" (if include-linked "" "\\]")))
;;;; Key bindings
+;; Outline functions from `outline-mode-prefix-map'
+;; that can be remapped in Org:
+(define-key org-mode-map [remap outline-mark-subtree] 'org-mark-subtree)
+(define-key org-mode-map [remap show-subtree] 'org-show-subtree)
+(define-key org-mode-map [remap outline-forward-same-level]
+ 'org-forward-same-level)
+(define-key org-mode-map [remap outline-backward-same-level]
+ 'org-backward-same-level)
+(define-key org-mode-map [remap show-branches]
+ 'org-kill-note-or-show-branches)
+(define-key org-mode-map [remap outline-promote] 'org-promote-subtree)
+(define-key org-mode-map [remap outline-demote] 'org-demote-subtree)
+(define-key org-mode-map [remap outline-insert-heading] 'org-ctrl-c-ret)
+
+;; Outline functions from `outline-mode-prefix-map'
+;; that can not be remapped in Org:
+;; - the column "key binding" shows whether the Outline function is still
+;; available in Org mode on the same key that it has been bound to in
+;; Outline mode:
+;; - "overridden": key used for a different functionality in Org mode
+;; - else: key still bound to the same Outline function in Org mode
+;; | Outline function | key binding | Org replacement |
+;; |------------------------------------+-------------+-----------------------|
+;; | `outline-next-visible-heading' | `C-c C-n' | still same function |
+;; | `outline-previous-visible-heading' | `C-c C-p' | still same function |
+;; | `show-children' | `C-c C-i' | visibility cycling |
+;; | `hide-subtree' | overridden | visibility cycling |
+;; | `outline-up-heading' | `C-c C-u' | still same function |
+;; | `hide-body' | overridden | no replacement |
+;; | `show-all' | overridden | no replacement |
+;; | `hide-entry' | overridden | visibility cycling |
+;; | `show-entry' | overridden | no replacement |
+;; | `hide-leaves' | overridden | no replacement |
+;; | `hide-sublevels' | overridden | no replacement |
+;; | `hide-other' | overridden | no replacement |
+;; | `outline-move-subtree-up' | `C-c C-^' | better: org-shiftup |
+;; | `outline-move-subtree-down' | overridden | better: org-shiftdown |
+
;; Make `C-c C-x' a prefix key
(org-defkey org-mode-map "\C-c\C-x" (make-sparse-keymap))
(org-defkey org-mode-map "\C-i" 'org-cycle)
(org-defkey org-mode-map [(tab)] 'org-cycle)
(org-defkey org-mode-map [(control tab)] 'org-force-cycle-archived)
-(org-defkey org-mode-map [(meta tab)] 'pcomplete)
(org-defkey org-mode-map "\M-\t" 'pcomplete)
-(org-defkey org-mode-map "\M-\C-i" 'pcomplete)
;; The following line is necessary under Suse GNU/Linux
(unless (featurep 'xemacs)
(org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab))
(org-defkey org-mode-map [(control shift right)] 'org-shiftcontrolright)
(org-defkey org-mode-map [(control shift left)] 'org-shiftcontrolleft)
+(org-defkey org-mode-map [(control shift up)] 'org-shiftcontrolup)
+(org-defkey org-mode-map [(control shift down)] 'org-shiftcontroldown)
;; Babel keys
(define-key org-mode-map org-babel-key-prefix org-babel-map)
(if (boundp 'narrow-map)
(org-defkey narrow-map "s" 'org-narrow-to-subtree)
(org-defkey org-mode-map "\C-xns" 'org-narrow-to-subtree))
+(if (boundp 'narrow-map)
+ (org-defkey narrow-map "b" 'org-narrow-to-block)
+ (org-defkey org-mode-map "\C-xnb" 'org-narrow-to-block))
(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-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 "\C-c\C-xv" 'org-copy-visible)
(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)
(interactive)
(let ((pos (point)))
(call-interactively cmd)
- (unless (and (bolp) (org-on-heading-p))
+ (unless (and (bolp) (org-at-heading-p))
(goto-char pos)
(error "Boundary reached while executing %s" cmd))))
"Hook for activating single-letter speed commands.
`org-speed-commands-default' specifies a minimal command set.
Use `org-speed-commands-user' for further customization."
- (when (or (and (bolp) (looking-at outline-regexp))
+ (when (or (and (bolp) (looking-at org-outline-regexp))
(and (functionp org-use-speed-commands)
(funcall org-use-speed-commands)))
(cdr (assoc keys (append org-speed-commands-user
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")
+ (org-check-before-invisible-edit 'insert)
(cond
((and org-use-speed-commands
(setq org-speed-command
(looking-at "[^|\n]* |"))
(let (org-table-may-need-update)
(goto-char (1- (match-end 0)))
- (delete-backward-char 1)
+ (backward-delete-char 1)
(goto-char (match-beginning 0))
(self-insert-command N)))
(t
(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
+ buffer-undo-list (listp 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-check-before-invisible-edit (kind)
+ "Check is editing if kind KIND would be dangerous with invisible text around.
+The detailed reaction depends on the user option `org-catch-invisible-edits'."
+ ;; First, try to get out of here as quickly as possible, to reduce overhead
+ (if (and org-catch-invisible-edits
+ (or (not (boundp 'visible-mode)) (not visible-mode))
+ (or (get-char-property (point) 'invisible)
+ (get-char-property (max (point-min) (1- (point))) 'invisible)))
+ ;; OK, we need to take a closer look
+ (let* ((invisible-at-point (get-char-property (point) 'invisible))
+ (invisible-before-point (if (bobp) nil (get-char-property
+ (1- (point)) 'invisible)))
+ (border-and-ok-direction
+ (or
+ ;; Check if we are acting predictably before invisible text
+ (and invisible-at-point (not invisible-before-point)
+ (memq kind '(insert delete-backward)))
+ ;; Check if we are acting predictably after invisible text
+ ;; This works not well, and I have turned it off. It seems
+ ;; better to always show and stop after invisible text.
+ ;; (and (not invisible-at-point) invisible-before-point
+ ;; (memq kind '(insert delete)))
+ )))
+
+ (when (or (memq invisible-at-point '(outline org-hide-block))
+ (memq invisible-before-point '(outline org-hide-block)))
+ (if (eq org-catch-invisible-edits 'error)
+ (error "Editing in invisible areas is prohibited - make visible first"))
+ ;; Make the area visible
+ (save-excursion
+ (if invisible-before-point
+ (goto-char (previous-single-char-property-change
+ (point) 'invisible)))
+ (org-cycle))
+ (cond
+ ((eq org-catch-invisible-edits 'show)
+ ;; That's it, we do the edit after showing
+ (message
+ "Unfolding invisible region around point before editing")
+ (sit-for 1))
+ ((and (eq org-catch-invisible-edits 'smart)
+ border-and-ok-direction)
+ (message "Unfolding invisible region around point before editing"))
+ (t
+ ;; Don't do the edit, make the user repeat it in full visibility
+ (error "Edit in invisible region aborted, repeat to confirm with text visible")))))))
+
(defun org-fix-tags-on-the-fly ()
(when (and (equal (char-after (point-at-bol)) ?*)
- (org-on-heading-p))
+ (org-at-heading-p))
(org-align-tags-here org-tags-column)))
(defun org-delete-backward-char (N)
still be marked for re-alignment if the field did fill the entire column,
because, in this case the deletion might narrow the column."
(interactive "p")
+ (org-check-before-invisible-edit 'delete-backward)
(if (and (org-table-p)
(eq N 1)
(string-match "|" (buffer-substring (point-at-bol) (point)))
still be marked for re-alignment if the field did fill the entire column,
because, in this case the deletion might narrow the column."
(interactive "p")
+ (org-check-before-invisible-edit 'delete)
(if (and (org-table-p)
(not (bolp))
(not (= (char-after) ?|))
(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.")
+ "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. This hook is run
+before any other test, while `org-ctrl-c-ctrl-c-final-hook' is
+run after the last test.
+
+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-ctrl-c-ctrl-c-final-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. This hook is run
+after any other test, while `org-ctrl-c-ctrl-c-hook' is run
+before the first test.
+
+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.
(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-heading-p) (call-interactively 'org-promote-subtree))
((org-at-item-p) (call-interactively 'org-outdent-item-tree))
(t (org-modifier-cursor-error))))
(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-heading-p) (call-interactively 'org-demote-subtree))
((org-at-item-p) (call-interactively 'org-indent-item-tree))
(t (org-modifier-cursor-error))))
(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-heading-p) (call-interactively 'org-move-subtree-up))
((org-at-item-p) (call-interactively 'org-move-item-up))
(t (org-modifier-cursor-error))))
(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-heading-p) (call-interactively 'org-move-subtree-down))
((org-at-item-p) (call-interactively 'org-move-item-down))
(t (org-modifier-cursor-error))))
(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)
- (and (org-region-active-p)
- (save-excursion
- (goto-char (region-beginning))
- (org-on-heading-p))))
+ ((org-with-limited-levels
+ (or (org-at-heading-p)
+ (and (org-region-active-p)
+ (save-excursion
+ (goto-char (region-beginning))
+ (org-at-heading-p)))))
(when (org-check-for-hidden 'headlines) (org-hidden-tree-error))
(call-interactively 'org-do-promote))
+ ;; At an inline task.
+ ((org-at-heading-p)
+ (call-interactively 'org-inlinetask-promote))
((or (org-at-item-p)
(and (org-region-active-p)
(save-excursion
(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)
- (and (org-region-active-p)
- (save-excursion
- (goto-char (region-beginning))
- (org-on-heading-p))))
+ ((org-with-limited-levels
+ (or (org-at-heading-p)
+ (and (org-region-active-p)
+ (save-excursion
+ (goto-char (region-beginning))
+ (org-at-heading-p)))))
(when (org-check-for-hidden 'headlines) (org-hidden-tree-error))
(call-interactively 'org-do-demote))
+ ;; At an inline task.
+ ((org-at-heading-p)
+ (call-interactively 'org-inlinetask-demote))
((or (org-at-item-p)
(and (org-region-active-p)
(save-excursion
an outline or item heading and it has a folded subtree below it,
this function returns t, nil otherwise."
(let ((re (cond
- ((eq what 'headlines) (concat "^" org-outline-regexp))
- ((eq what 'items) (concat "^" (org-item-re t)))
+ ((eq what 'headlines) org-outline-regexp-bol)
+ ((eq what 'items) (org-item-beginning-re))
(t (error "This should not happen"))))
beg end)
(save-excursion
(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-heading-p) (call-interactively 'org-move-subtree-up))
((org-at-item-p) (call-interactively 'org-move-item-up))
(t (transpose-lines 1) (beginning-of-line -1))))
(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-heading-p) (call-interactively 'org-move-subtree-down))
((org-at-item-p) (call-interactively 'org-move-item-down))
(t (beginning-of-line 2) (transpose-lines 1) (beginning-of-line 0))))
'org-timestamp-down 'org-timestamp-up)))
((and (not (eq org-support-shift-select 'always))
org-enable-priority-commands
- (org-on-heading-p))
+ (org-at-heading-p))
(call-interactively 'org-priority-up))
((and (not org-support-shift-select) (org-at-item-p))
(call-interactively 'org-previous-item))
'org-timestamp-up 'org-timestamp-down)))
((and (not (eq org-support-shift-select 'always))
org-enable-priority-commands
- (org-on-heading-p))
+ (org-at-heading-p))
(call-interactively 'org-priority-down))
((and (not org-support-shift-select) (org-at-item-p))
(call-interactively 'org-next-item))
(org-call-for-shift-select 'forward-char))
((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day))
((and (not (eq org-support-shift-select 'always))
- (org-on-heading-p))
+ (org-at-heading-p))
(let ((org-inhibit-logging
(not org-treat-S-cursor-todo-selection-as-state-change))
(org-inhibit-blocking
(org-call-for-shift-select 'backward-char))
((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day))
((and (not (eq org-support-shift-select 'always))
- (org-on-heading-p))
+ (org-at-heading-p))
(let ((org-inhibit-logging
(not org-treat-S-cursor-todo-selection-as-state-change))
(org-inhibit-blocking
((and org-support-shift-select (org-region-active-p))
(org-call-for-shift-select 'forward-word))
((and (not (eq org-support-shift-select 'always))
- (org-on-heading-p))
+ (org-at-heading-p))
(org-call-with-arg 'org-todo 'nextset))
(org-support-shift-select
(org-call-for-shift-select 'forward-word))
((and org-support-shift-select (org-region-active-p))
(org-call-for-shift-select 'backward-word))
((and (not (eq org-support-shift-select 'always))
- (org-on-heading-p))
+ (org-at-heading-p))
(org-call-with-arg 'org-todo 'previousset))
(org-support-shift-select
(org-call-for-shift-select 'backward-word))
(t (org-shiftselect-error))))
+(defun org-shiftcontrolup ()
+ "Change timestamps synchronously up in CLOCK log lines."
+ (interactive)
+ (cond ((and (not org-support-shift-select)
+ (org-at-clock-log-p)
+ (org-at-timestamp-p t))
+ (org-clock-timestamps-up))
+ (t (org-shiftselect-error))))
+
+(defun org-shiftcontroldown ()
+ "Change timestamps synchronously down in CLOCK log lines."
+ (interactive)
+ (cond ((and (not org-support-shift-select)
+ (org-at-clock-log-p)
+ (org-at-timestamp-p t))
+ (org-clock-timestamps-down))
+ (t (org-shiftselect-error))))
+
(defun org-ctrl-c-ret ()
"Call `org-table-hline-and-move' or `org-insert-heading' dep. on context."
(interactive)
((org-at-table-p) (call-interactively 'org-table-hline-and-move))
(t (call-interactively 'org-insert-heading))))
+(defun org-find-visible ()
+ (let ((s (point)))
+ (while (and (not (= (point-max) (setq s (next-overlay-change s))))
+ (get-char-property s 'invisible)))
+ s))
+(defun org-find-invisible ()
+ (let ((s (point)))
+ (while (and (not (= (point-max) (setq s (next-overlay-change s))))
+ (not (get-char-property s 'invisible))))
+ s))
+
+(defun org-copy-visible (beg end)
+ "Copy the visible parts of the region."
+ (interactive "r")
+ (let (snippets s)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (setq s (goto-char (point-min)))
+ (while (not (= (point) (point-max)))
+ (goto-char (org-find-invisible))
+ (push (buffer-substring s (point)) snippets)
+ (setq s (goto-char (org-find-visible))))))
+ (kill-new (apply 'concat (nreverse snippets)))))
+
(defun org-copy-special ()
"Copy region in table or copy current subtree.
Calls `org-table-copy' or `org-copy-subtree', depending on context.
(call-interactively 'org-table-edit-formulas))
(t (call-interactively 'ffap))))
+(defvar org-table-coordinate-overlays) ; defined in org-table.el
(defun org-ctrl-c-ctrl-c (&optional arg)
"Set tags in headline, or update according to changed information at point.
(fboundp org-finish-function))
(funcall org-finish-function))
((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook))
+ ((org-in-regexp org-ts-regexp-both)
+ (org-timestamp-change 0 'day))
((or (looking-at org-property-start-re)
(org-at-property-p))
(call-interactively 'org-property-action))
- ((org-on-target-p) (call-interactively 'org-update-radio-target-regexp))
+ ((org-at-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)))
+ (or (org-at-heading-p) (org-at-item-p)))
(call-interactively 'org-update-statistics-cookies))
- ((org-on-heading-p) (call-interactively 'org-set-tags))
+ ((org-at-heading-p) (call-interactively 'org-set-tags))
((org-at-table.el-p)
(message "Use C-c ' to edit table.el tables"))
((org-at-table-p)
(org-footnote-at-definition-p))
(call-interactively 'org-footnote-action))
((org-at-item-checkbox-p)
- (call-interactively 'org-list-repair)
- (call-interactively 'org-toggle-checkbox)
- (org-list-send-list 'maybe))
+ ;; Cursor at a checkbox: repair list and update checkboxes. Send
+ ;; list only if at top item.
+ (let* ((cbox (match-string 1))
+ (struct (org-list-struct))
+ (old-struct (copy-tree struct))
+ (parents (org-list-parents-alist struct))
+ (orderedp (org-entry-get nil "ORDERED"))
+ (firstp (= (org-list-get-top-point struct) (point-at-bol)))
+ block-item)
+ ;; Use a light version of `org-toggle-checkbox' to avoid
+ ;; computing list structure twice.
+ (let ((new-box (cond
+ ((equal arg '(16)) "[-]")
+ ((equal arg '(4)) nil)
+ ((equal "[X]" cbox) "[ ]")
+ (t "[X]"))))
+ (if (and firstp arg)
+ ;; If at first item of sub-list, remove check-box from
+ ;; every item at the same level.
+ (mapc
+ (lambda (pos) (org-list-set-checkbox pos struct new-box))
+ (org-list-get-all-items
+ (point-at-bol) struct (org-list-prevs-alist struct)))
+ (org-list-set-checkbox (point-at-bol) struct new-box)))
+ ;; Replicate `org-list-write-struct', while grabbing a return
+ ;; value from `org-list-struct-fix-box'.
+ (org-list-struct-fix-ind struct parents 2)
+ (org-list-struct-fix-item-end struct)
+ (let ((prevs (org-list-prevs-alist struct)))
+ (org-list-struct-fix-bul struct prevs)
+ (org-list-struct-fix-ind struct parents)
+ (setq block-item
+ (org-list-struct-fix-box struct parents prevs orderedp)))
+ (org-list-struct-apply-struct struct old-struct)
+ (org-update-checkbox-count-maybe)
+ (when block-item
+ (message
+ "Checkboxes were removed due to unchecked box at line %d"
+ (org-current-line block-item)))
+ (when firstp (org-list-send-list 'maybe))))
((org-at-item-p)
- (call-interactively 'org-list-repair)
- (when arg (call-interactively 'org-toggle-checkbox))
- (org-list-send-list 'maybe))
+ ;; Cursor at an item: repair list. Do checkbox related actions
+ ;; only if function was called with an argument. Send list only
+ ;; if at top item.
+ (let* ((struct (org-list-struct))
+ (firstp (= (org-list-get-top-point struct) (point-at-bol)))
+ old-struct)
+ (when arg
+ (setq old-struct (copy-tree struct))
+ (if firstp
+ ;; If at first item of sub-list, add check-box to every
+ ;; item at the same level.
+ (mapc
+ (lambda (pos)
+ (unless (org-list-get-checkbox pos struct)
+ (org-list-set-checkbox pos struct "[ ]")))
+ (org-list-get-all-items
+ (point-at-bol) struct (org-list-prevs-alist struct)))
+ (org-list-set-checkbox (point-at-bol) struct "[ ]")))
+ (org-list-write-struct
+ struct (org-list-parents-alist struct) old-struct)
+ (when arg (org-update-checkbox-count-maybe))
+ (when firstp (org-list-send-list 'maybe))))
((save-excursion (beginning-of-line 1) (looking-at org-dblock-start-re))
;; Dynamic block
(beginning-of-line 1)
(t
(let ((org-inhibit-startup-visibility-stuff t)
(org-startup-align-all-tables nil))
+ (when (boundp 'org-table-coordinate-overlays)
+ (mapc 'delete-overlay org-table-coordinate-overlays)
+ (setq org-table-coordinate-overlays nil))
(org-save-outline-visibility 'use-markers (org-mode-restart)))
(message "Local setup has been refreshed"))))
((org-clock-update-time-maybe))
- (t (error "C-c C-c can do nothing useful at this location")))))
+ (t
+ (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook)
+ (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.
((org-at-table-p)
(org-table-justify-field-maybe)
(call-interactively 'org-table-next-row))
+ ;; when `newline-and-indent' is called within a list, make sure
+ ;; text moved stays inside the item.
+ ((and (org-in-item-p) indent)
+ (if (and (org-at-item-p) (>= (point) (match-end 0)))
+ (progn
+ (save-match-data (newline))
+ (org-indent-line-to (length (match-string 0))))
+ (let ((ind (org-get-indentation)))
+ (newline)
+ (if (org-looking-back org-list-end-re)
+ (org-indent-line-function)
+ (org-indent-line-to ind)))))
((and org-return-follows-link
- (eq (get-text-property (point) 'face) 'org-link))
+ (let ((tprop (get-text-property (point) 'face)))
+ (or (eq tprop 'org-link)
+ (and (listp tprop) (memq 'org-link tprop)))))
(call-interactively 'org-open-at-point))
((and (org-at-heading-p)
(looking-at
(t
(call-interactively 'org-toggle-item))))
-(defun org-toggle-item ()
+(defun org-toggle-item (arg)
"Convert headings or normal lines to items, items to normal lines.
If there is no active region, only the current line is considered.
-If the first line in the region is a headline, convert all headlines to items.
+If the first non blank line in the region is an headline, convert
+all headlines to items, shifting text accordingly.
-If the first line in the region is an item, convert all items to normal lines.
+If it is an item, convert all items to normal lines.
-If the first line is normal text, add an item bullet to each line."
- (interactive)
- (let (l2 l beg end)
+If it is normal text, change region into an item. With a prefix
+argument ARG, change each line in region into an item."
+ (interactive "P")
+ (let ((shift-text
+ (function
+ ;; Shift text in current section to IND, from point to END.
+ ;; The function leaves point to END line.
+ (lambda (ind end)
+ (let ((min-i 1000) (end (copy-marker end)))
+ ;; First determine the minimum indentation (MIN-I) of
+ ;; the text.
+ (save-excursion
+ (catch 'exit
+ (while (< (point) end)
+ (let ((i (org-get-indentation)))
+ (cond
+ ;; Skip blank lines and inline tasks.
+ ((looking-at "^[ \t]*$"))
+ ((looking-at org-outline-regexp-bol))
+ ;; We can't find less than 0 indentation.
+ ((zerop i) (throw 'exit (setq min-i 0)))
+ ((< i min-i) (setq min-i i))))
+ (forward-line))))
+ ;; Then indent each line so that a line indented to
+ ;; MIN-I becomes indented to IND. Ignore blank lines
+ ;; and inline tasks in the process.
+ (let ((delta (- ind min-i)))
+ (while (< (point) end)
+ (unless (or (looking-at "^[ \t]*$")
+ (looking-at org-outline-regexp-bol))
+ (org-indent-line-to (+ (org-get-indentation) delta)))
+ (forward-line)))))))
+ (skip-blanks
+ (function
+ ;; Return beginning of first non-blank line, starting from
+ ;; line at POS.
+ (lambda (pos)
+ (save-excursion
+ (goto-char pos)
+ (skip-chars-forward " \r\t\n")
+ (point-at-bol)))))
+ beg end)
+ ;; Determine boundaries of changes.
(if (org-region-active-p)
- (setq beg (region-beginning) end (region-end))
- (setq beg (point-at-bol)
- end (min (1+ (point-at-eol)) (point-max))))
- (save-excursion
- (goto-char end)
- (setq l2 (org-current-line))
- (goto-char beg)
- (beginning-of-line 1)
- (setq l (1- (org-current-line)))
- (if (org-at-item-p)
- ;; We already have items, de-itemize
- (while (< (setq l (1+ l)) l2)
- (when (org-at-item-p)
- (skip-chars-forward " \t")
- (delete-region (point) (match-end 0)))
- (beginning-of-line 2))
- (if (org-on-heading-p)
- ;; Headings, convert to items
- (while (< (setq l (1+ l)) l2)
- (if (looking-at org-outline-regexp)
- (replace-match (org-list-bullet-string "-") t t))
- (beginning-of-line 2))
- ;; normal lines, turn them into items
- (while (< (setq l (1+ l)) l2)
- (unless (org-at-item-p)
- (if (looking-at "\\([ \t]*\\)\\(\\S-\\)")
- (replace-match
- (concat "\\1" (org-list-bullet-string "-") "\\2"))))
- (beginning-of-line 2)))))))
+ (setq beg (funcall skip-blanks (region-beginning))
+ end (copy-marker (region-end)))
+ (setq beg (funcall skip-blanks (point-at-bol))
+ end (copy-marker (point-at-eol))))
+ ;; Depending on the starting line, choose an action on the text
+ ;; between BEG and END.
+ (org-with-limited-levels
+ (save-excursion
+ (goto-char beg)
+ (cond
+ ;; Case 1. Start at an item: de-itemize. Note that it only
+ ;; happens when a region is active: `org-ctrl-c-minus'
+ ;; would call `org-cycle-list-bullet' otherwise.
+ ((org-at-item-p)
+ (while (< (point) end)
+ (when (org-at-item-p)
+ (skip-chars-forward " \t")
+ (delete-region (point) (match-end 0)))
+ (forward-line)))
+ ;; Case 2. Start at an heading: convert to items.
+ ((org-at-heading-p)
+ (let* ((bul (org-list-bullet-string "-"))
+ (bul-len (length bul))
+ ;; Indentation of the first heading. It should be
+ ;; relative to the indentation of its parent, if any.
+ (start-ind (save-excursion
+ (cond
+ ((not org-adapt-indentation) 0)
+ ((not (outline-previous-heading)) 0)
+ (t (length (match-string 0))))))
+ ;; Level of first heading. Further headings will be
+ ;; compared to it to determine hierarchy in the list.
+ (ref-level (org-reduced-level (org-outline-level))))
+ (while (< (point) end)
+ (let* ((level (org-reduced-level (org-outline-level)))
+ (delta (max 0 (- level ref-level))))
+ ;; If current headline is less indented than the first
+ ;; one, set it as reference, in order to preserve
+ ;; subtrees.
+ (when (< level ref-level) (setq ref-level level))
+ (replace-match bul t t)
+ (org-indent-line-to (+ start-ind (* delta bul-len)))
+ ;; Ensure all text down to END (or SECTION-END) belongs
+ ;; to the newly created item.
+ (let ((section-end (save-excursion
+ (or (outline-next-heading) (point)))))
+ (forward-line)
+ (funcall shift-text
+ (+ start-ind (* (1+ delta) bul-len))
+ (min end section-end)))))))
+ ;; Case 3. Normal line with ARG: turn each non-item line into
+ ;; an item.
+ (arg
+ (while (< (point) end)
+ (unless (or (org-at-heading-p) (org-at-item-p))
+ (if (looking-at "\\([ \t]*\\)\\(\\S-\\)")
+ (replace-match
+ (concat "\\1" (org-list-bullet-string "-") "\\2"))))
+ (forward-line)))
+ ;; Case 4. Normal line without ARG: make the first line of
+ ;; region an item, and shift indentation of others
+ ;; lines to set them as item's body.
+ (t (let* ((bul (org-list-bullet-string "-"))
+ (bul-len (length bul))
+ (ref-ind (org-get-indentation)))
+ (skip-chars-forward " \t")
+ (insert bul)
+ (forward-line)
+ (while (< (point) end)
+ ;; Ensure that lines less indented than first one
+ ;; still get included in item body.
+ (funcall shift-text
+ (+ ref-ind bul-len)
+ (min end (save-excursion (or (outline-next-heading)
+ (point)))))
+ (forward-line)))))))))
(defun org-toggle-heading (&optional nstars)
"Convert headings to normal text, or items or text to headings.
If there is no active region, only the current line is considered.
-If the first line is a heading, remove the stars from all headlines
-in the region.
+If the first non blank line is an headline, 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 it 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 it is a normal line, turn each and every normal line (i.e. not
+an heading or an item) 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."
(interactive "P")
- (let (l2 l itemp beg end)
+ (let ((skip-blanks
+ (function
+ ;; Return beginning of first non-blank line, starting from
+ ;; line at POS.
+ (lambda (pos)
+ (save-excursion
+ (goto-char pos)
+ (skip-chars-forward " \r\t\n")
+ (point-at-bol)))))
+ beg end)
+ ;; Determine boundaries of changes. If region ends at a bol, do
+ ;; not consider the last line to be in the region.
(if (org-region-active-p)
- (setq beg (region-beginning) end (region-end))
- (setq beg (point-at-bol)
- end (min (1+ (point-at-eol)) (point-max))))
- (save-excursion
- (goto-char end)
- (setq l2 (org-current-line))
- (goto-char beg)
- (beginning-of-line 1)
- (setq l (1- (org-current-line)))
- (if (org-on-heading-p)
- ;; We already have headlines, de-star them
- (while (< (setq l (1+ l)) l2)
- (when (org-on-heading-p t)
- (and (looking-at outline-regexp) (replace-match "")))
- (beginning-of-line 2))
- (setq itemp (org-at-item-p))
- (let* ((stars
- (if nstars
- (make-string (prefix-numeric-value current-prefix-arg)
- ?*)
- (save-excursion
- (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
- (and (org-at-item-p) (replace-match rpl t t))
- (unless (org-on-heading-p)
- (if (looking-at "\\([ \t]*\\)\\(\\S-\\)")
- (replace-match (concat rpl (match-string 2))))))
- (beginning-of-line 2)))))))
+ (setq beg (funcall skip-blanks (region-beginning))
+ end (copy-marker (save-excursion
+ (goto-char (region-end))
+ (if (bolp) (point) (point-at-eol)))))
+ (setq beg (funcall skip-blanks (point-at-bol))
+ end (copy-marker (point-at-eol))))
+ ;; Ensure inline tasks don't count as headings.
+ (org-with-limited-levels
+ (save-excursion
+ (goto-char beg)
+ (cond
+ ;; Case 1. Started at an heading: de-star headings.
+ ((org-at-heading-p)
+ (while (< (point) end)
+ (when (org-at-heading-p t)
+ (looking-at org-outline-regexp) (replace-match ""))
+ (forward-line)))
+ ;; Case 2. Started at an item: change items into headlines.
+ ;; One star will be added by `org-list-to-subtree'.
+ ((org-at-item-p)
+ (let* ((stars (make-string
+ (if nstars
+ ;; subtract the star that will be added again by
+ ;; `org-list-to-subtree'
+ (1- (prefix-numeric-value current-prefix-arg))
+ (or (org-current-level) 0))
+ ?*))
+ (add-stars
+ (cond (nstars "") ; stars from prefix only
+ ((equal stars "") "") ; before first heading
+ (org-odd-levels-only "*") ; inside heading, odd
+ (t "")))) ; inside heading, oddeven
+ (while (< (point) end)
+ (when (org-at-item-p)
+ ;; Pay attention to cases when region ends before list.
+ (let* ((struct (org-list-struct))
+ (list-end (min (org-list-get-bottom-point struct) (1+ end))))
+ (save-restriction
+ (narrow-to-region (point) list-end)
+ (insert
+ (org-list-to-subtree
+ (org-list-parse-list t)
+ '(:istart (concat stars add-stars (funcall get-stars depth))
+ :icount (concat stars add-stars (funcall get-stars depth))))))))
+ (forward-line))))
+ ;; Case 3. Started at normal text: make every line an heading,
+ ;; skipping headlines and items.
+ (t (let* ((stars (make-string
+ (if nstars
+ (prefix-numeric-value current-prefix-arg)
+ (or (org-current-level) 0))
+ ?*))
+ (add-stars
+ (cond (nstars "") ; stars from prefix only
+ ((equal stars "") "*") ; before first heading
+ (org-odd-levels-only "**") ; inside heading, odd
+ (t "*"))) ; inside heading, oddeven
+ (rpl (concat stars add-stars " ")))
+ (while (< (point) end)
+ (when (and (not (org-at-heading-p)) (not (org-at-item-p))
+ (looking-at "\\([ \t]*\\)\\(\\S-\\)"))
+ (replace-match (concat rpl (match-string 2))))
+ (forward-line)))))))))
(defun org-meta-return (&optional arg)
"Insert a new heading or wrap a region in a table.
"--"
["Clone subtree, shift time" org-clone-subtree-with-time-shift t]
"--"
+ ["Copy visible text" org-copy-visible 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))]
["Previous link" org-previous-link t]
"--"
["Descriptive Links"
- (progn (add-to-invisibility-spec '(org-link)) (org-restart-font-lock))
+ org-toggle-link-display
:style radio
- :selected (member '(org-link) buffer-invisibility-spec)]
+ :selected org-descriptive-links
+ ]
["Literal Links"
- (progn
- (org-remove-from-invisibility-spec '(org-link)) (org-restart-font-lock))
+ org-toggle-link-display
:style radio
- :selected (not (member '(org-link) buffer-invisibility-spec))])
+ :selected (not org-descriptive-links)])
"--"
("TODO Lists"
["TODO/DONE/-" org-todo t]
("Select keyword"
- ["Next keyword" org-shiftright (org-on-heading-p)]
- ["Previous keyword" org-shiftleft (org-on-heading-p)]
+ ["Next keyword" org-shiftright (org-at-heading-p)]
+ ["Previous keyword" org-shiftleft (org-at-heading-p)]
["Complete Keyword" pcomplete (assq :todo-keyword (org-context))]
- ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))]
- ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))])
+ ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-at-heading-p))]
+ ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-at-heading-p))])
["Show TODO Tree" org-show-todo-tree :active t :keys "C-c / t"]
["Global TODO list" org-todo-list :active t :keys "C-c a t"]
"--"
:selected org-enforce-todo-dependencies :style toggle :active t]
"Settings for tree at point"
["Do Children sequentially" org-toggle-ordered-property :style radio
- :selected (ignore-errors (org-entry-get nil "ORDERED"))
+ :selected (org-entry-get nil "ORDERED")
:active org-enforce-todo-dependencies :keys "C-c C-x o"]
["Do Children parallel" org-toggle-ordered-property :style radio
- :selected (ignore-errors (not (org-entry-get nil "ORDERED")))
+ :selected (not (org-entry-get nil "ORDERED"))
:active org-enforce-todo-dependencies :keys "C-c C-x o"]
"--"
["Set Priority" org-priority t]
(org-inside-LaTeX-fragment-p)]
["Insert citation" org-reftex-citation t]
"--"
- ["Template for BEAMER" org-insert-beamer-options-template t])
+ ["Template for BEAMER" (progn (require 'org-beamer)
+ (org-insert-beamer-options-template)) t])
"--"
("MobileOrg"
["Push Files and Views" org-mobile-push t]
(org-version)
(let (list)
(save-window-excursion
- (switch-to-buffer (get-buffer-create "*Warn about privacy*"))
+ (org-pop-to-buffer-same-window (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.
(save-excursion
(while bl
(set-buffer (pop bl))
- (if (org-mode-p) (setq bl nil)))
- (when (org-mode-p)
+ (if (eq major-mode 'org-mode) (setq bl nil)))
+ (when (eq major-mode 'org-mode)
(easy-menu-change
'("Org") "File List for Agenda"
(append
(display-buffer buf)
(sit-for 0))))
+(defun org-eval (form)
+ "Eval FORM and return result."
+ (condition-case error
+ (eval form)
+ (error (format "%%![Error: %s]" error))))
+
+(defun org-in-clocktable-p ()
+ "Check if the cursor is in a clocktable."
+ (let ((pos (point)) start)
+ (save-excursion
+ (end-of-line 1)
+ (and (re-search-backward "^[ \t]*#\\+BEGIN:[ \t]+clocktable" nil t)
+ (setq start (match-beginning 0))
+ (re-search-forward "^[ \t]*#\\+END:.*" nil t)
+ (>= (match-end 0) pos)
+ start))))
+
(defun org-in-commented-line ()
"Is point in a line starting with `#'?"
(equal (char-after (point-at-bol)) ?#))
(if (and marker (marker-buffer marker)
(buffer-live-p (marker-buffer marker)))
(progn
- (switch-to-buffer (marker-buffer marker))
+ (org-pop-to-buffer-same-window (marker-buffer marker))
(if (or (> marker (point-max)) (< marker (point-min)))
(widen))
(goto-char marker)
(concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")
s))
-(defun org-plist-delete (plist property)
- "Delete PROPERTY from PLIST.
-This is in contrast to merely setting it to 0."
- (let (p)
- (while plist
- (if (not (eq property (car plist)))
- (setq p (plist-put p (car plist) (nth 1 plist))))
- (setq plist (cddr plist)))
- p))
-
(defun org-force-self-insert (N)
"Needed to enforce self-insert under remapping."
(interactive "p")
(skip-chars-forward " \t")
(current-column))))
+(defun org-get-string-indentation (s)
+ "What indentation has S due to SPACE and TAB at the beginning of the string?"
+ (let ((n -1) (i 0) (w tab-width) c)
+ (catch 'exit
+ (while (< (setq n (1+ n)) (length s))
+ (setq c (aref s n))
+ (cond ((= c ?\ ) (setq i (1+ i)))
+ ((= c ?\t) (setq i (* (/ (+ w i) w) w)))
+ (t (throw 'exit t)))))
+ i))
+
(defun org-remove-tabs (s &optional width)
"Replace tabulators in S with spaces.
Assumes that s is a single line, starting in column 0."
:target on a <<target>>
:radio-target on a <<<radio-target>>>
:latex-fragment on a LaTeX fragment
-:latex-preview on a LaTeX fragment with overlayed preview image
+:latex-preview on a LaTeX fragment with overlaid preview image
This function expects the position to be visible because it uses font-lock
faces as a help to recognize the following contexts: :table-special, :link,
(p (point)) clist o)
;; First the large context
(cond
- ((org-on-heading-p t)
+ ((org-at-heading-p t)
(push (list :headline (point-at-bol) (point-at-eol)) clist)
(when (progn
(beginning-of-line 1)
(push (list :keyword
(previous-single-property-change p 'face)
(next-single-property-change p 'face)) clist))
- ((org-on-target-p)
+ ((org-at-target-p)
(push (org-point-in-group p 0 :target) clist)
(goto-char (1- (match-beginning 0)))
(if (looking-at org-radio-target-regexp)
(throw 'exit t)))
nil))))
-(defun org-in-regexps-block-p (start-re end-re &optional bound)
- "Return t if the current point is between matches of START-RE and END-RE.
-This will also return t if point is on one of the two matches or
-in an unfinished block. END-RE can be a string or a form
-returning a string.
+(defun org-between-regexps-p (start-re end-re &optional lim-up lim-down)
+ "Non-nil when point is between matches of START-RE and END-RE.
-An optional third argument bounds the search for START-RE.
-It defaults to previous heading or `point-min'."
- (let ((pos (point))
- (limit (or bound (save-excursion (outline-previous-heading)))))
- (save-excursion
- ;; we're on a block when point is on start-re...
- (or (org-at-regexp-p start-re)
- ;; ... or start-re can be found above...
- (and (re-search-backward start-re limit t)
- ;; ... but no end-re between start-re and point.
- (not (re-search-forward (eval end-re) pos t)))))))
+Also return a non-nil value when point is on one of the matches.
+
+Optional arguments LIM-UP and LIM-DOWN bound the search; they are
+buffer positions. Default values are the positions of headlines
+surrounding the point.
+
+The functions returns a cons cell whose car (resp. cdr) is the
+position before START-RE (resp. after END-RE)."
+ (save-match-data
+ (let ((pos (point))
+ (limit-up (or lim-up (save-excursion (outline-previous-heading))))
+ (limit-down (or lim-down (save-excursion (outline-next-heading))))
+ beg end)
+ (save-excursion
+ ;; Point is on a block when on START-RE or if START-RE can be
+ ;; found before it...
+ (and (or (org-at-regexp-p start-re)
+ (re-search-backward start-re limit-up t))
+ (setq beg (match-beginning 0))
+ ;; ... and END-RE after it...
+ (goto-char (match-end 0))
+ (re-search-forward end-re limit-down t)
+ (> (setq end (match-end 0)) pos)
+ ;; ... without another START-RE in-between.
+ (goto-char (match-beginning 0))
+ (not (re-search-backward start-re (1+ beg) t))
+ ;; Return value.
+ (cons beg end))))))
+
+(defun org-in-block-p (names)
+ "Non-nil when point belongs to a block whose name belongs to NAMES.
+
+NAMES is a list of strings containing names of blocks.
+
+Return first block name matched, or nil. Beware that in case of
+nested blocks, the returned name may not belong to the closest
+block from point."
+ (save-match-data
+ (catch 'exit
+ (let ((case-fold-search t)
+ (lim-up (save-excursion (outline-previous-heading)))
+ (lim-down (save-excursion (outline-next-heading))))
+ (mapc (lambda (name)
+ (let ((n (regexp-quote name)))
+ (when (org-between-regexps-p
+ (concat "^[ \t]*#\\+begin_" n)
+ (concat "^[ \t]*#\\+end_" n)
+ lim-up lim-down)
+ (throw 'exit n))))
+ names))
+ nil)))
(defun org-occur-in-agenda-files (regexp &optional nlines)
"Call `multi-occur' with buffers for all agenda files."
;; Emacs 23
(add-hook 'occur-mode-find-occurrence-hook
(lambda ()
- (when (org-mode-p)
+ (when (eq major-mode 'org-mode)
(org-reveal))))
;; Emacs 22
(defadvice occur-mode-goto-occurrence
(after org-occur-reveal activate)
- (and (org-mode-p) (org-reveal)))
+ (and (eq major-mode 'org-mode) (org-reveal)))
(defadvice occur-mode-goto-occurrence-other-window
(after org-occur-reveal activate)
- (and (org-mode-p) (org-reveal)))
+ (and (eq major-mode 'org-mode) (org-reveal)))
(defadvice occur-mode-display-occurrence
(after org-occur-reveal activate)
- (when (org-mode-p)
+ (when (eq major-mode 'org-mode)
(let ((pos (occur-mode-find-occurrence)))
(with-current-buffer (marker-buffer pos)
(save-excursion
(if (funcall predicate e) (push e res)))
(nreverse res)))
+(defun org-reduce (cl-func cl-seq &rest cl-keys)
+ "Reduce two-argument FUNCTION across SEQ.
+Taken from `reduce' in cl-seq.el with all keyword arguments but
+\":initial-value\" removed."
+ (let ((cl-accum (cond ((memq :initial-value cl-keys)
+ (cadr (memq :initial-value cl-keys)))
+ (cl-seq (pop cl-seq))
+ (t (funcall cl-func)))))
+ (while cl-seq
+ (setq cl-accum (funcall cl-func cl-accum (pop cl-seq))))
+ cl-accum))
+
(defun org-back-over-empty-lines ()
"Move backwards over whitespace, to the beginning of the first empty line.
Returns the number of empty lines passed."
(let ((pos (point)))
- (skip-chars-backward " \t\n\r")
+ (if (cdr (assoc 'heading org-blank-before-new-entry))
+ (skip-chars-backward " \t\n\r")
+ (unless (eobp)
+ (forward-line -1)))
(beginning-of-line 2)
(goto-char (min (point) pos))
(count-lines (point) pos)))
(cond
(inline-task-p (org-inlinetask-goto-beginning))
((org-at-heading-p) (beginning-of-line))
- (t (let ((outline-regexp (org-get-limited-outline-regexp)))
- (outline-previous-visible-heading 1))))
+ (t (org-with-limited-levels (outline-previous-visible-heading 1))))
(setq beg (point))
;; Get end of it
(if inline-task-p
(org-drawer-regexp (or org-drawer-regexp "\000"))
(inline-task-p (and (featurep 'org-inlinetask)
(org-inlinetask-in-task-p)))
- column bpos bcol tpos tcol)
+ (inline-re (and inline-task-p
+ (org-inlinetask-outline-regexp)))
+ column)
(beginning-of-line 1)
(cond
;; Comments
((looking-at "# ") (setq column 0))
;; Headings
- ((looking-at "\\*+ ") (setq column 0))
+ ((looking-at org-outline-regexp) (setq column 0))
+ ;; Included files
+ ((looking-at "#\\+include:") (setq column 0))
+ ;; Footnote definition
+ ((looking-at org-footnote-definition-re) (setq column 0))
;; Literal examples
- ((looking-at "[ \t]*:[ \t]")
+ ((looking-at "[ \t]*:\\( \\|$\\)")
(setq column (org-get-indentation))) ; do nothing
+ ;; Lists
+ ((ignore-errors (goto-char (org-in-item-p)))
+ (setq column (if itemp
+ (org-get-indentation)
+ (org-list-item-body-column (point))))
+ (goto-char pos))
;; Drawers
((and (looking-at "[ \t]*:END:")
(save-excursion (re-search-backward org-drawer-regexp nil t)))
(concat "^[ \t]*#\\+begin_" (downcase (match-string 1))) nil t)))
(setq column (org-get-indentation (match-string 0))))
((and (not (looking-at "[ \t]*#\\+begin_"))
- (org-in-regexps-block-p "^[ \t]*#\\+begin_" "[ \t]*#\\+end_"))
+ (org-between-regexps-p "^[ \t]*#\\+begin_" "[ \t]*#\\+end_"))
(save-excursion
(re-search-backward "^[ \t]*#\\+begin_\\([a-z]+\\)" nil t))
(setq column
- (if (equal (downcase (match-string 1)) "src")
- ;; src blocks: let `org-edit-src-exit' handle them
- (org-get-indentation)
- (org-get-indentation (match-string 0)))))
- ;; Lists
- ((org-in-item-p)
- (org-beginning-of-item)
- (looking-at "[ \t]*\\(\\S-+\\)[ \t]*\\(\\(:?\\[@\\(:?start:\\)?[0-9]+\\][ \t]*\\)?\\[[- X]\\][ \t]*\\|.*? :: \\)?")
- (setq bpos (match-beginning 1) tpos (match-end 0)
- bcol (progn (goto-char bpos) (current-column))
- tcol (progn (goto-char tpos) (current-column)))
- (if (> tcol (+ bcol org-description-max-indent))
- (setq tcol (+ bcol 5)))
- (goto-char pos)
- (setq column (if itemp (org-get-indentation) tcol)))
+ (cond ((equal (downcase (match-string 1)) "src")
+ ;; src blocks: let `org-edit-src-exit' handle them
+ (org-get-indentation))
+ ((equal (downcase (match-string 1)) "example")
+ (max (org-get-indentation)
+ (org-get-indentation (match-string 0))))
+ (t
+ (org-get-indentation (match-string 0))))))
;; This line has nothing special, look at the previous relevant
;; line to compute indentation
(t
(beginning-of-line 0)
(while (and (not (bobp))
(not (looking-at org-drawer-regexp))
- ;; skip comments, verbatim, empty lines, tables,
- ;; inline tasks, lists, drawers and blocks
+ ;; When point started in an inline task, do not move
+ ;; above task starting line.
+ (not (and inline-task-p (looking-at inline-re)))
+ ;; Skip drawers, blocks, empty lines, verbatim,
+ ;; comments, tables, footnotes definitions, lists,
+ ;; inline tasks.
(or (and (looking-at "[ \t]*:END:")
(re-search-backward org-drawer-regexp nil t))
(and (looking-at "[ \t]*#\\+end_")
(re-search-backward "[ \t]*#\\+begin_"nil t))
(looking-at "[ \t]*[\n:#|]")
- (and (org-in-item-p) (goto-char (org-list-top-point)))
+ (looking-at org-footnote-definition-re)
+ (and (ignore-errors (goto-char (org-in-item-p)))
+ (goto-char
+ (org-list-get-top-point (org-list-struct))))
(and (not inline-task-p)
(featurep 'org-inlinetask)
(org-inlinetask-in-task-p)
(concat
"\f" "\\|"
"[ ]*$" "\\|"
- "\\*+ " "\\|"
+ org-outline-regexp "\\|"
"[ \t]*#" "\\|"
- "[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)" "\\|"
+ (org-item-re) "\\|"
"[ \t]*[:|]" "\\|"
"\\$\\$" "\\|"
"\\\\\\(begin\\|end\\|[][]\\)"))
;; But only if the user has not turned off tables or fixed-width regions
(org-set-local
'auto-fill-inhibit-regexp
- (concat "\\*+ \\|#\\+"
+ (concat org-outline-regexp
+ "\\|#\\+"
"\\|[ \t]*" org-keyword-time-regexp
(if (or org-enable-table-editor org-enable-fixed-width-editor)
(concat
;; and fixed-width regions are not wrapped. That function will pass
;; through to `fill-paragraph' when appropriate.
(org-set-local 'fill-paragraph-function 'org-fill-paragraph)
+ ;; Prevent auto-fill from inserting unwanted new items.
+ (if (boundp 'fill-nobreak-predicate)
+ (org-set-local 'fill-nobreak-predicate
+ (if (memq 'org-fill-item-nobreak-p fill-nobreak-predicate)
+ fill-nobreak-predicate
+ (cons 'org-fill-item-nobreak-p fill-nobreak-predicate))))
;; Adaptive filling: To get full control, first make sure that
;; `adaptive-fill-regexp' never matches. Then install our own matcher.
(unless (local-variable-p 'adaptive-fill-regexp (current-buffer))
(org-set-local 'org-adaptive-fill-regexp-backup
adaptive-fill-regexp))
(org-set-local 'adaptive-fill-regexp "\000")
+ (org-set-local 'normal-auto-fill-function 'org-auto-fill-function)
(org-set-local 'adaptive-fill-function
'org-adaptive-fill-function)
(org-set-local
(regexp . "^#\\+[A-Z_]+:\\(\\s-*\\)\\S-+")
(modes . '(org-mode))))))
+(defun org-fill-item-nobreak-p ()
+ "Non-nil when a line break at point would insert a new item."
+ (and (looking-at (org-item-re)) (org-list-in-valid-context-p)))
+
(defun org-fill-paragraph (&optional justify)
"Re-align a table, pass through to fill-paragraph if no table."
(let ((table-p (org-at-table-p))
- (table.el-p (org-at-table.el-p)))
+ (table.el-p (org-at-table.el-p))
+ (itemp (org-in-item-p)))
(cond ((and (equal (char-after (point-at-bol)) ?*)
(save-excursion (goto-char (point-at-bol))
- (looking-at outline-regexp)))
- t) ; skip headlines
- (table.el-p t) ; skip table.el tables
- (table-p (org-table-align) t) ; align org-mode tables
- (t nil)))) ; call paragraph-fill
+ (looking-at org-outline-regexp)))
+ t) ; skip headlines
+ (table.el-p t) ; skip table.el tables
+ (table-p (org-table-align) t) ; align Org tables
+ (itemp ; align text in items
+ (let* ((struct (save-excursion (goto-char itemp)
+ (org-list-struct)))
+ (parents (org-list-parents-alist struct))
+ (children (org-list-get-children itemp struct parents))
+ beg end prev next prefix)
+ ;; Determine in which part of item point is: before
+ ;; first child, after last child, between two
+ ;; sub-lists, or simply in item if there's no child.
+ (cond
+ ((not children)
+ (setq prefix (make-string (org-list-item-body-column itemp) ?\ )
+ beg itemp
+ end (org-list-get-item-end itemp struct)))
+ ((< (point) (setq next (car children)))
+ (setq prefix (make-string (org-list-item-body-column itemp) ?\ )
+ beg itemp
+ end next))
+ ((> (point) (setq prev (car (last children))))
+ (setq beg (org-list-get-item-end prev struct)
+ end (org-list-get-item-end itemp struct)
+ prefix (save-excursion
+ (goto-char beg)
+ (skip-chars-forward " \t")
+ (make-string (current-column) ?\ ))))
+ (t (catch 'exit
+ (while (setq next (pop children))
+ (if (> (point) next)
+ (setq prev next)
+ (setq beg (org-list-get-item-end prev struct)
+ end next
+ prefix (save-excursion
+ (goto-char beg)
+ (skip-chars-forward " \t")
+ (make-string (current-column) ?\ )))
+ (throw 'exit nil))))))
+ ;; Use `fill-paragraph' with buffer narrowed to item
+ ;; without any child, and with our computed PREFIX.
+ (flet ((fill-context-prefix (from to &optional flr) prefix))
+ (save-restriction
+ (narrow-to-region beg end)
+ (save-excursion (fill-paragraph justify)))) t))
+ ;; Special case where point is not in a list but is on
+ ;; a paragraph adjacent to a list: make sure this paragraph
+ ;; doesn't get merged with the end of the list by narrowing
+ ;; buffer first.
+ ((save-excursion (forward-paragraph -1)
+ (setq itemp (org-in-item-p)))
+ (let ((struct (save-excursion (goto-char itemp)
+ (org-list-struct))))
+ (save-restriction
+ (narrow-to-region (org-list-get-bottom-point struct)
+ (save-excursion (forward-paragraph 1)
+ (point)))
+ (fill-paragraph justify) t)))
+ ;; Else simply call `fill-paragraph'.
+ (t nil))))
;; For reference, this is the default value of adaptive-fill-regexp
;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*"
(defun org-adaptive-fill-function ()
- "Return a fill prefix for org-mode files.
-In particular, this makes sure hanging paragraphs for hand-formatted lists
-work correctly."
- (cond
- ;; Comment line
- ((looking-at "#[ \t]+")
- (match-string-no-properties 0))
- ;; Description list
- ((looking-at "[ \t]*\\([-*+] .*? :: \\)")
- (save-excursion
- (if (> (match-end 1) (+ (match-beginning 1)
- org-description-max-indent))
- (goto-char (+ (match-beginning 1) 5))
- (goto-char (match-end 0)))
- (make-string (current-column) ?\ )))
- ;; Ordered or unordered list
- ((looking-at "[ \t]*\\([-*+] \\|[0-9]+[.)] ?\\)")
- (save-excursion
- (goto-char (match-end 0))
- (make-string (current-column) ?\ )))
- ;; Other text
- ((looking-at org-adaptive-fill-regexp-backup)
- (match-string-no-properties 0))))
+ "Return a fill prefix for org-mode files."
+ (let (itemp)
+ (save-excursion
+ (cond
+ ;; Comment line
+ ((looking-at "#[ \t]+")
+ (match-string-no-properties 0))
+ ;; Plain list item
+ ((org-at-item-p)
+ (make-string (org-list-item-body-column (point-at-bol)) ?\ ))
+ ;; Point is in a list after `backward-paragraph': original
+ ;; point wasn't in the list, or filling would have been taken
+ ;; care of by `org-auto-fill-function', but the list and the
+ ;; real paragraph are not separated by a blank line. Thus, move
+ ;; point after the list to go back to real paragraph and
+ ;; determine fill-prefix.
+ ((setq itemp (org-in-item-p))
+ (goto-char itemp)
+ (let* ((struct (org-list-struct))
+ (bottom (org-list-get-bottom-point struct)))
+ (goto-char bottom)
+ (make-string (org-get-indentation) ?\ )))
+ ;; Other text
+ ((looking-at org-adaptive-fill-regexp-backup)
+ (match-string-no-properties 0))))))
+
+(defun org-auto-fill-function ()
+ "Auto-fill function."
+ (let (itemp prefix)
+ ;; When in a list, compute an appropriate fill-prefix and make
+ ;; sure it will be used by `do-auto-fill'.
+ (if (setq itemp (org-in-item-p))
+ (progn
+ (setq prefix (make-string (org-list-item-body-column itemp) ?\ ))
+ (flet ((fill-context-prefix (from to &optional flr) prefix))
+ (do-auto-fill)))
+ ;; Else just use `do-auto-fill'.
+ (do-auto-fill))))
;;; Other stuff.
(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
(forward-line 1)))
(save-excursion
(org-back-to-heading)
- (if (looking-at (concat outline-regexp
- "\\( *\\<" org-quote-string "\\>[ \t]*\\)"))
- (replace-match "" t t nil 1)
- (if (looking-at outline-regexp)
- (progn
- (goto-char (match-end 0))
- (insert org-quote-string " "))))))))
+ (cond
+ ((looking-at (format org-heading-keyword-regexp-format
+ org-quote-string))
+ (goto-char (match-end 1))
+ (looking-at (concat " +" org-quote-string))
+ (replace-match "" t t)
+ (when (eolp) (insert " ")))
+ ((looking-at org-outline-regexp)
+ (goto-char (match-end 0))
+ (insert org-quote-string " ")))))))
(defun org-reftex-citation ()
"Use reftex-citation to insert a citation into the buffer.
((not (eq last-command this-command)) (point))
(t refpos)))))
((org-at-item-p)
- (goto-char
- (if (eq special t)
- (cond ((> pos (match-end 4)) (match-end 4))
- ((= pos (point)) (match-end 4))
- (t (point)))
- (cond ((> pos (point)) (point))
- ((not (eq last-command this-command)) (point))
- (t (match-end 4))))))))
+ ;; Being at an item and not looking at an the item means point
+ ;; was previously moved to beginning of a visual line, which
+ ;; doesn't contain the item. Therefore, do nothing special,
+ ;; just stay here.
+ (when (looking-at org-list-full-item-re)
+ ;; Set special position at first white space character after
+ ;; bullet, and check-box, if any.
+ (let ((after-bullet
+ (let ((box (match-end 3)))
+ (if (not box) (match-end 1)
+ (let ((after (char-after box)))
+ (if (and after (= after ? )) (1+ box) box))))))
+ ;; Special case: Move point to special position when
+ ;; currently after it or at beginning of line.
+ (if (eq special t)
+ (when (or (> pos after-bullet) (= (point) pos))
+ (goto-char after-bullet))
+ ;; Reversed case: Move point to special position when
+ ;; point was already at beginning of line and command is
+ ;; repeated.
+ (when (and (= (point) pos) (eq last-command this-command))
+ (goto-char after-bullet))))))))
(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)))
+ (cond
+ ((or (not special) arg
+ (not (or (org-at-heading-p) (org-at-item-p) (org-at-drawer-p))))
+ (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))))
+ ((org-at-heading-p)
(let ((pos (point)))
(beginning-of-line 1)
(if (looking-at (org-re ".*?\\(?:\\([ \t]*\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\)?$"))
(call-interactively (if (fboundp 'move-end-of-line)
'move-end-of-line
'end-of-line)))))
+ ((org-at-drawer-p)
+ (move-end-of-line 1)
+ (when (overlays-at (1- (point))) (backward-char 1)))
+ ;; At an item: Move before any hidden text.
+ (t (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)))))
(org-no-warnings
(and (featurep 'xemacs) (setq zmacs-region-stays t)))))
(cond
((or (not org-special-ctrl-k)
(bolp)
- (not (org-on-heading-p)))
+ (not (org-at-heading-p)))
(if (and (get-char-property (min (point-max) (point-at-eol)) 'invisible)
org-ctrl-k-protect-subtree)
(if (or (eq org-ctrl-k-protect-subtree 'error)
(when (and (bolp) subtreep
(not (setq swallowp
(org-yank-folding-would-swallow-text beg end))))
- (or (looking-at outline-regexp)
- (re-search-forward (concat "^" outline-regexp) end t))
- (while (and (< (point) end) (looking-at outline-regexp))
- (hide-subtree)
- (org-cycle-show-empty-lines 'folded)
- (condition-case nil
- (outline-forward-same-level 1)
- (error (goto-char end)))))
+ (org-with-limited-levels
+ (or (looking-at org-outline-regexp)
+ (re-search-forward org-outline-regexp-bol end t))
+ (while (and (< (point) end) (looking-at org-outline-regexp))
+ (hide-subtree)
+ (org-cycle-show-empty-lines 'folded)
+ (condition-case nil
+ (outline-forward-same-level 1)
+ (error (goto-char end))))))
(when swallowp
(message
- "Inserted 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")
(defun org-yank-folding-would-swallow-text (beg end)
"Would hide-subtree at BEG swallow any text after END?"
(let (level)
- (save-excursion
- (goto-char beg)
- (when (or (looking-at outline-regexp)
- (re-search-forward (concat "^" outline-regexp) end t))
- (setq level (org-outline-level)))
- (goto-char end)
- (skip-chars-forward " \t\r\n\v\f")
- (if (or (eobp)
- (and (bolp) (looking-at org-outline-regexp)
- (<= (org-outline-level) level)))
- nil ; Nothing would be swallowed
- t)))) ; something would swallow
+ (org-with-limited-levels
+ (save-excursion
+ (goto-char beg)
+ (when (or (looking-at org-outline-regexp)
+ (re-search-forward org-outline-regexp-bol end t))
+ (setq level (org-outline-level)))
+ (goto-char end)
+ (skip-chars-forward " \t\r\n\v\f")
+ (if (or (eobp)
+ (and (bolp) (looking-at org-outline-regexp)
+ (<= (org-outline-level) level)))
+ nil ; Nothing would be swallowed
+ t))))) ; something would swallow
(define-key org-mode-map "\C-y" 'org-yank)
-(defun org-invisible-p ()
- "Check if point is at a character currently not visible."
- ;; Early versions of noutline don't have `outline-invisible-p'.
- (if (fboundp 'outline-invisible-p)
- (outline-invisible-p)
- (get-char-property (point) 'invisible)))
-
(defun org-truely-invisible-p ()
"Check if point is at a character currently not visible.
This version does not only check the character property, but also
;; Early versions of noutline don't have `outline-invisible-p'.
(if (org-bound-and-true-p visible-mode)
nil
- (if (fboundp 'outline-invisible-p)
- (outline-invisible-p)
- (get-char-property (point) 'invisible))))
+ (outline-invisible-p)))
(defun org-invisible-p2 ()
"Check if point is at a character currently not visible."
(save-excursion
(if (and (eolp) (not (bobp))) (backward-char 1))
;; Early versions of noutline don't have `outline-invisible-p'.
- (if (fboundp 'outline-invisible-p)
- (outline-invisible-p)
- (get-char-property (point) 'invisible))))
+ (outline-invisible-p)))
(defun org-back-to-heading (&optional invisible-ok)
"Call `outline-back-to-heading', but provide a better error message."
(defun org-before-first-heading-p ()
"Before first heading?"
(save-excursion
- (null (re-search-backward "^\\*+ " nil t))))
+ (end-of-line)
+ (null (re-search-backward org-outline-regexp-bol nil t))))
-(defun org-on-heading-p (&optional ignored)
- (outline-on-heading-p t))
(defun org-at-heading-p (&optional ignored)
(outline-on-heading-p t))
+;; Compatibility alias with Org versions < 7.8.03
+(defalias 'org-on-heading-p 'org-at-heading-p)
+
+(defun org-at-drawer-p nil
+ "Whether point is at a drawer."
+ (save-excursion
+ (move-beginning-of-line 1)
+ (looking-at org-drawer-regexp)))
(defun org-point-at-end-of-empty-headline ()
"If point is at the end of an empty headline, return t, else nil.
If the heading only contains a TODO keyword, it is still still considered
empty."
(and (looking-at "[ \t]*$")
- (save-excursion
- (beginning-of-line 1)
- (looking-at (concat "^\\(\\*+\\)[ \t]+\\(" org-todo-regexp
- "\\)?[ \t]*$")))))
+ (when org-todo-line-regexp
+ (save-excursion
+ (beginning-of-line 1)
+ (let ((case-fold-search nil))
+ (looking-at org-todo-line-regexp)
+ (string= (match-string 3) ""))))))
+
(defun org-at-heading-or-item-p ()
- (or (org-on-heading-p) (org-at-item-p)))
+ (or (org-at-heading-p) (org-at-item-p)))
-(defun org-on-target-p ()
+(defun org-at-target-p ()
(or (org-in-regexp org-radio-target-regexp)
(org-in-regexp org-target-regexp)))
+;; Compatibility alias with Org versions < 7.8.03
+(defalias 'org-on-target-p 'org-at-target-p)
(defun org-up-heading-all (arg)
"Move to the heading line of which the present line is a subheading.
(defun org-first-sibling-p ()
"Is this heading the first child of its parents?"
(interactive)
- (let ((re (concat "^" outline-regexp))
+ (let ((re org-outline-regexp-bol)
level l)
(unless (org-at-heading-p t)
(error "Not at a heading"))
move point."
(let ((fun (if previous 're-search-backward 're-search-forward))
(pos (point))
- (re (concat "^" outline-regexp))
+ (re org-outline-regexp-bol)
level l)
(when (condition-case nil (org-back-to-heading t) (error nil))
(setq level (funcall outline-level))
"Goto the first child, even if it is invisible.
Return t when a child was found. Otherwise don't move point and
return nil."
- (let (level (pos (point)) (re (concat "^" outline-regexp)))
+ (let (level (pos (point)) (re org-outline-regexp-bol))
(when (condition-case nil (org-back-to-heading t) (error nil))
(setq level (outline-level))
(forward-char 1)
(org-back-to-heading invisible-OK)
(let ((first t)
(level (funcall outline-level)))
- (if (and (org-mode-p) (< level 1000))
+ (if (and (eq major-mode 'org-mode) (< 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
(unless (eobp) (backward-char 1)))
ad-do-it))
+(defun org-end-of-meta-data-and-drawers ()
+ "Jump to the first text after meta data and drawers in the current entry.
+This will move over empty lines, lines with planning time stamps,
+clocking lines, and drawers."
+ (org-back-to-heading t)
+ (let ((end (save-excursion (outline-next-heading) (point)))
+ (re (concat "\\(" org-drawer-regexp "\\)"
+ "\\|" "[ \t]*" org-keyword-time-regexp)))
+ (forward-line 1)
+ (while (re-search-forward re end t)
+ (if (not (match-end 1))
+ ;; empty or planning line
+ (forward-line 1)
+ ;; a drawer, find the end
+ (re-search-forward "^[ \t]*:END:" end 'move)
+ (forward-line 1)))
+ (and (re-search-forward "[^\n]" nil t) (backward-char 1))
+ (point)))
+
(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.
it wil also look at invisible ones."
(interactive "p")
(org-back-to-heading invisible-ok)
- (org-on-heading-p)
+ (org-at-heading-p)
(let* ((level (- (match-end 0) (match-beginning 0) 1))
(re (format "^\\*\\{1,%d\\} " level))
l)
(setq l (- (match-end 0) (match-beginning 0) 1))
(= l level)
(not invisible-ok)
- (progn (backward-char 1) (org-invisible-p)))
+ (progn (backward-char 1) (outline-invisible-p)))
(if (< l level) (setq arg 1)))
(setq arg (1- arg)))
(beginning-of-line 1)))
Stop at the first and last subheadings of a superior heading."
(interactive "p")
(org-back-to-heading)
- (org-on-heading-p)
+ (org-at-heading-p)
(let* ((level (- (match-end 0) (match-beginning 0) 1))
(re (format "^\\*\\{1,%d\\} " level))
l)
(setq l (- (match-end 0) (match-beginning 0) 1))
(= l level)
(not invisible-ok)
- (org-invisible-p))
+ (outline-invisible-p))
(if (< l level) (setq arg 1)))
(setq arg (1- arg)))))
(defun org-show-subtree ()
"Show everything after this heading at deeper levels."
+ (interactive)
(outline-flag-region
(point)
(save-excursion
(max (point-min) (1- (point)))
(save-excursion
(if (re-search-forward
- (concat "[\r\n]\\(" outline-regexp "\\)") nil t)
+ (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t)
(match-beginning 1)
(point-max)))
nil)
(mapc (lambda (x) (move-marker x nil)) org-imenu-markers)
(setq org-imenu-markers nil)
(let* ((n org-imenu-depth)
- (re (concat "^" outline-regexp))
+ (re (concat "^" (org-get-limited-outline-regexp)))
(subs (make-vector (1+ n) nil))
(last-level 0)
m level head)
(goto-char (point-max))
(while (re-search-backward re nil t)
(setq level (org-reduced-level (funcall outline-level)))
- (when (<= level n)
- (looking-at org-complex-heading-regexp)
+ (when (and (<= level n)
+ (looking-at org-complex-heading-regexp))
(setq head (org-link-display-format
(org-match-string-no-properties 4))
m (org-imenu-new-marker))
nil t link)
link)))
+(defun org-toggle-link-display ()
+ "Toggle the literal or descriptive display of links."
+ (interactive)
+ (if org-descriptive-links
+ (progn (org-remove-from-invisibility-spec '(org-link))
+ (org-restart-font-lock)
+ (setq org-descriptive-links nil))
+ (progn (add-to-invisibility-spec '(org-link))
+ (org-restart-font-lock)
+ (setq org-descriptive-links t))))
+
;; Speedbar support
(defvar org-speedbar-restriction-lock-overlay (make-overlay 1 1)
(with-current-buffer (find-file-noselect
(let ((default-directory dir))
(expand-file-name txt)))
- (unless (org-mode-p)
+ (unless (eq major-mode 'org-mode)
(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")))
(define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock)
(define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
(add-hook 'speedbar-visiting-tag-hook
- (lambda () (and (org-mode-p) (org-show-context 'org-goto))))))
+ (lambda () (and (eq major-mode 'org-mode) (org-show-context 'org-goto))))))
;;; Fixes and Hacks for problems with other packages
;; 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."
- (and (not (get-text-property (max (1- (point)) (point-min)) 'keymap))
- (not (get-text-property (max (1- (point)) (point-min)) 'org-no-flyspell))))
+ "Don't let flyspell put overlays at active buttons, or on
+ {todo,all-time,additional-option-like}-keywords."
+ (let ((pos (max (1- (point)) (point-min)))
+ (word (thing-at-point 'word)))
+ (and (not (get-text-property pos 'keymap))
+ (not (get-text-property pos 'org-no-flyspell))
+ (not (member word org-todo-keywords-1))
+ (not (member word org-all-time-keywords))
+ (not (member word org-additional-option-like-keywords)))))
(defun org-remove-flyspell-overlays-in (beg end)
"Remove flyspell overlays in region."
(defun org-bookmark-jump-unhide ()
"Unhide the current position, to show the bookmark location."
- (and (org-mode-p)
- (or (org-invisible-p)
+ (and (eq major-mode 'org-mode)
+ (or (outline-invisible-p)
(save-excursion (goto-char (max (point-min) (1- (point))))
- (org-invisible-p)))
+ (outline-invisible-p)))
(org-show-context 'bookmark-jump)))
;; Make session.el ignore our circular variable
(run-hooks 'org-load-hook)
-
;;; org.el ends here