;;; org.el --- Outline-based notes management and organizer -*- lexical-binding: t; -*-
|
|
;; Carstens outline-mode for keeping track of everything.
|
;; Copyright (C) 2004-2018 Free Software Foundation, Inc.
|
;;
|
;; Author: Carsten Dominik <carsten at orgmode dot org>
|
;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
|
;; Keywords: outlines, hypermedia, calendar, wp
|
;; Homepage: https://orgmode.org
|
;; Version: 9.1.14
|
;;
|
;; This file is part of GNU Emacs.
|
;;
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
;; it under the terms of the GNU General Public License as published by
|
;; the Free Software Foundation, either version 3 of the License, or
|
;; (at your option) any later version.
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
;; GNU General Public License for more details.
|
|
;; You should have received a copy of the GNU General Public License
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
;;
|
;;; Commentary:
|
;;
|
;; Org is a mode for keeping notes, maintaining ToDo lists, and doing
|
;; project planning with a fast and effective plain-text system.
|
;;
|
;; Org mode develops organizational tasks around NOTES files that
|
;; contain information about projects as plain text. Org mode is
|
;; implemented on top of outline-mode, which makes it possible to keep
|
;; the content of large files well structured. Visibility cycling and
|
;; structure editing help to work with the tree. Tables are easily
|
;; created with a built-in table editor. Org mode supports ToDo
|
;; items, deadlines, time stamps, and scheduling. It dynamically
|
;; compiles entries into an agenda that utilizes and smoothly
|
;; integrates much of the Emacs calendar and diary. Plain text
|
;; URL-like links connect to websites, emails, Usenet messages, BBDB
|
;; entries, and any files related to the projects. For printing and
|
;; sharing of notes, an Org file can be exported as a structured ASCII
|
;; file, as HTML, or (todo and agenda items only) as an iCalendar
|
;; file. It can also serve as a publishing tool for a set of linked
|
;; webpages.
|
;;
|
;; Installation and Activation
|
;; ---------------------------
|
;; See the corresponding sections in the manual at
|
;;
|
;; https://orgmode.org/org.html#Installation
|
;;
|
;; Documentation
|
;; -------------
|
;; The documentation of Org mode can be found in the TeXInfo file. The
|
;; distribution also contains a PDF version of it. At the homepage of
|
;; Org mode, you can read the same text online as HTML. There is also an
|
;; excellent reference card made by Philip Rooke. This card can be found
|
;; in the doc/ directory.
|
;;
|
;; A list of recent changes can be found at
|
;; https://orgmode.org/Changes.html
|
;;
|
;;; Code:
|
|
(defvar org-inhibit-highlight-removal nil) ; dynamically scoped param
|
(defvar-local org-table-formula-constants-local nil
|
"Local version of `org-table-formula-constants'.")
|
|
;;;; Require other packages
|
|
(require 'cl-lib)
|
|
(eval-when-compile (require 'gnus-sum))
|
|
(require 'calendar)
|
(require 'find-func)
|
(require 'format-spec)
|
|
(or (eq this-command 'eval-buffer)
|
(condition-case nil
|
(load (concat (file-name-directory load-file-name)
|
"org-loaddefs.el")
|
nil t t t)
|
(error
|
(message "WARNING: No org-loaddefs.el file could be found from where org.el is loaded.")
|
(sit-for 3)
|
(message "You need to run \"make\" or \"make autoloads\" from Org lisp directory")
|
(sit-for 3))))
|
|
(require 'org-macs)
|
(require 'org-compat)
|
|
;; `org-outline-regexp' ought to be a defconst but is let-bound 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.")
|
|
(defvar 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.")
|
|
(defvar org-heading-regexp "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$"
|
"Matches a headline, putting stars and text into groups.
|
Stars are put in group 1 and the trimmed body in group 2.")
|
|
(declare-function calendar-check-holidays "holidays" (date))
|
(declare-function cdlatex-environment "ext:cdlatex" (environment item))
|
(declare-function isearch-no-upper-case-p "isearch" (string regexp-flag))
|
(declare-function org-add-archive-files "org-archive" (files))
|
(declare-function org-agenda-entry-get-agenda-timestamp "org-agenda" (pom))
|
(declare-function org-agenda-list "org-agenda" (&optional arg start-day span with-hour))
|
(declare-function org-agenda-redo "org-agenda" (&optional all))
|
(declare-function org-babel-do-in-edit-buffer "ob-core" (&rest body) t)
|
(declare-function org-babel-tangle-file "ob-tangle" (file &optional target-file lang))
|
(declare-function org-beamer-mode "ox-beamer" (&optional prefix) t)
|
(declare-function org-clock-get-last-clock-out-time "org-clock" ())
|
(declare-function org-clock-out "org-clock" (&optional switch-to-state fail-quietly at-time))
|
(declare-function org-clock-remove-overlays "org-clock" (&optional beg end noremove))
|
(declare-function org-clock-sum "org-clock" (&optional tstart tend headline-filter propname))
|
(declare-function org-clock-sum-current-item "org-clock" (&optional tstart))
|
(declare-function org-clock-timestamps-down "org-clock" (&optional n))
|
(declare-function org-clock-timestamps-up "org-clock" (&optional n))
|
(declare-function org-clock-update-time-maybe "org-clock" ())
|
(declare-function org-clocking-buffer "org-clock" ())
|
(declare-function org-clocktable-shift "org-clock" (dir n))
|
(declare-function
|
org-duration-from-minutes "org-duration" (minutes &optional fmt canonical))
|
(declare-function org-element-at-point "org-element" ())
|
(declare-function org-element-cache-refresh "org-element" (pos))
|
(declare-function org-element-cache-reset "org-element" (&optional all))
|
(declare-function org-element-contents "org-element" (element))
|
(declare-function org-element-context "org-element" (&optional element))
|
(declare-function org-element-copy "org-element" (datum))
|
(declare-function org-element-interpret-data "org-element" (data))
|
(declare-function org-element-lineage "org-element" (blob &optional types with-self))
|
(declare-function org-element-link-parser "org-element" ())
|
(declare-function org-element-nested-p "org-element" (elem-a elem-b))
|
(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only))
|
(declare-function org-element-property "org-element" (property element))
|
(declare-function org-element-put-property "org-element" (element property value))
|
(declare-function org-element-swap-A-B "org-element" (elem-a elem-b))
|
(declare-function org-element-type "org-element" (element))
|
(declare-function org-element-update-syntax "org-element" ())
|
(declare-function org-id-find-id-file "org-id" (id))
|
(declare-function org-id-get-create "org-id" (&optional force))
|
(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-plot/gnuplot "org-plot" (&optional params))
|
(declare-function org-table-align "org-table" ())
|
(declare-function org-table-begin "org-table" (&optional table-type))
|
(declare-function org-table-beginning-of-field "org-table" (&optional n))
|
(declare-function org-table-blank-field "org-table" ())
|
(declare-function org-table-calc-current-TBLFM "org-table" (&optional arg))
|
(declare-function org-table-copy-region "org-table" (beg end &optional cut))
|
(declare-function org-table-cut-region "org-table" (beg end))
|
(declare-function org-table-edit-field "org-table" (arg))
|
(declare-function org-table-end "org-table" (&optional table-type))
|
(declare-function org-table-end-of-field "org-table" (&optional n))
|
(declare-function org-table-insert-row "org-table" (&optional arg))
|
(declare-function org-table-justify-field-maybe "org-table" (&optional new))
|
(declare-function org-table-maybe-eval-formula "org-table" ())
|
(declare-function org-table-maybe-recalculate-line "org-table" ())
|
(declare-function org-table-next-row "org-table" ())
|
(declare-function org-table-paste-rectangle "org-table" ())
|
(declare-function org-table-recalculate "org-table" (&optional all noalign))
|
(declare-function
|
org-table-sort-lines "org-table"
|
(&optional with-case sorting-type getkey-func compare-func interactive?))
|
(declare-function org-table-wrap-region "org-table" (arg))
|
(declare-function org-tags-view "org-agenda" (&optional todo-only match))
|
(declare-function orgtbl-ascii-plot "org-table" (&optional ask))
|
(declare-function orgtbl-mode "org-table" (&optional arg))
|
(declare-function org-export-get-backend "ox" (name))
|
(declare-function org-export-get-environment "ox" (&optional backend subtreep ext-plist))
|
(declare-function org-latex-make-preamble "ox-latex" (info &optional template snippet?))
|
|
(defvar ffap-url-regexp)
|
(defvar org-element-paragraph-separate)
|
|
(defsubst org-uniquify (list)
|
"Non-destructively remove duplicate elements from LIST."
|
(let ((res (copy-sequence list))) (delete-dups res)))
|
|
(defsubst org-get-at-bol (property)
|
"Get text property PROPERTY at the beginning of line."
|
(get-text-property (point-at-bol) property))
|
|
(defsubst org-trim (s &optional keep-lead)
|
"Remove whitespace at the beginning and the end of string S.
|
When optional argument KEEP-LEAD is non-nil, removing blank lines
|
at the beginning of the string does not affect leading indentation."
|
(replace-regexp-in-string
|
(if keep-lead "\\`\\([ \t]*\n\\)+" "\\`[ \t\n\r]+") ""
|
(replace-regexp-in-string "[ \t\n\r]+\\'" "" s)))
|
|
;; load languages based on value of `org-babel-load-languages'
|
(defvar org-babel-load-languages)
|
|
;;;###autoload
|
(defun org-babel-do-load-languages (sym value)
|
"Load the languages defined in `org-babel-load-languages'."
|
(set-default sym value)
|
(dolist (pair org-babel-load-languages)
|
(let ((active (cdr pair)) (lang (symbol-name (car pair))))
|
(if active
|
(require (intern (concat "ob-" lang)))
|
(funcall 'fmakunbound
|
(intern (concat "org-babel-execute:" lang)))
|
(funcall 'fmakunbound
|
(intern (concat "org-babel-expand-body:" lang)))))))
|
|
(declare-function org-babel-tangle-file "ob-tangle" (file &optional target-file lang))
|
;;;###autoload
|
(defun org-babel-load-file (file &optional compile)
|
"Load Emacs Lisp source code blocks in the Org FILE.
|
This function exports the source code using `org-babel-tangle'
|
and then loads the resulting file using `load-file'. With prefix
|
arg (noninteractively: 2nd arg) COMPILE the tangled Emacs Lisp
|
file to byte-code before it is loaded."
|
(interactive "fFile to load: \nP")
|
(let* ((age (lambda (file)
|
(float-time
|
(time-subtract (current-time)
|
(nth 5 (or (file-attributes (file-truename file))
|
(file-attributes file)))))))
|
(base-name (file-name-sans-extension file))
|
(exported-file (concat base-name ".el")))
|
;; tangle if the Org file is newer than the elisp file
|
(unless (and (file-exists-p exported-file)
|
(> (funcall age file) (funcall age exported-file)))
|
;; Tangle-file traversal returns reversed list of tangled files
|
;; and we want to evaluate the first target.
|
(setq exported-file
|
(car (last (org-babel-tangle-file file exported-file "emacs-lisp")))))
|
(message "%s %s"
|
(if compile
|
(progn (byte-compile-file exported-file 'load)
|
"Compiled and loaded")
|
(progn (load-file exported-file) "Loaded"))
|
exported-file)))
|
|
(defcustom org-babel-load-languages '((emacs-lisp . t))
|
"Languages which can be evaluated in Org buffers.
|
This list can be used to load support for any of the languages
|
below, note that each language will depend on a different set of
|
system executables and/or Emacs modes. When a language is
|
\"loaded\", then code blocks in that language can be evaluated
|
with `org-babel-execute-src-block' bound by default to C-c
|
C-c (note the `org-babel-no-eval-on-ctrl-c-ctrl-c' variable can
|
be set to remove code block evaluation from the C-c C-c
|
keybinding. By default only Emacs Lisp (which has no
|
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 "Calc" calc)
|
(const :tag "Clojure" clojure)
|
(const :tag "CSS" css)
|
(const :tag "Ditaa" ditaa)
|
(const :tag "Dot" dot)
|
(const :tag "Ebnf2ps" ebnf2ps)
|
(const :tag "Emacs Lisp" emacs-lisp)
|
(const :tag "Forth" forth)
|
(const :tag "Fortran" fortran)
|
(const :tag "Gnuplot" gnuplot)
|
(const :tag "Haskell" haskell)
|
(const :tag "hledger" hledger)
|
(const :tag "IO" io)
|
(const :tag "J" J)
|
(const :tag "Java" java)
|
(const :tag "Javascript" js)
|
(const :tag "LaTeX" latex)
|
(const :tag "Ledger" ledger)
|
(const :tag "Lilypond" lilypond)
|
(const :tag "Lisp" lisp)
|
(const :tag "Makefile" makefile)
|
(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 "Sass" sass)
|
(const :tag "Scala" scala)
|
(const :tag "Scheme" scheme)
|
(const :tag "Screen" screen)
|
(const :tag "Shell Script" shell)
|
(const :tag "Shen" shen)
|
(const :tag "Sql" sql)
|
(const :tag "Sqlite" sqlite)
|
(const :tag "Stan" stan)
|
(const :tag "Vala" vala))
|
:value-type (boolean :tag "Activate" :value t)))
|
|
;;;; Customization variables
|
(defcustom org-clone-delete-id nil
|
"Remove ID property of clones of a subtree.
|
When non-nil, clones of a subtree don't inherit the ID property.
|
Otherwise they inherit the ID property with a new unique
|
identifier."
|
:type 'boolean
|
:version "24.1"
|
:group 'org-id)
|
|
;;; Version
|
(org-check-version)
|
|
;;;###autoload
|
(defun org-version (&optional here full message)
|
"Show the Org version.
|
Interactively, or when MESSAGE is non-nil, show it in echo area.
|
With prefix argument, or when HERE is non-nil, insert it at point.
|
In non-interactive uses, a reduced version string is output unless
|
FULL is given."
|
(interactive (list current-prefix-arg t (not current-prefix-arg)))
|
(let ((org-dir (ignore-errors (org-find-library-dir "org")))
|
(save-load-suffixes (when (boundp 'load-suffixes) load-suffixes))
|
(load-suffixes (list ".el"))
|
(org-install-dir
|
(ignore-errors (org-find-library-dir "org-loaddefs"))))
|
(unless (and (fboundp 'org-release) (fboundp 'org-git-version))
|
(org-load-noerror-mustsuffix (concat org-dir "org-version")))
|
(let* ((load-suffixes save-load-suffixes)
|
(release (org-release))
|
(git-version (org-git-version))
|
(version (format "Org mode version %s (%s @ %s)"
|
release
|
git-version
|
(if org-install-dir
|
(if (string= org-dir org-install-dir)
|
org-install-dir
|
(concat "mixed installation! "
|
org-install-dir
|
" and "
|
org-dir))
|
"org-loaddefs.el can not be found!")))
|
(version1 (if full version release)))
|
(when here (insert version1))
|
(when message (message "%s" version1))
|
version1)))
|
|
(defconst org-version (org-version))
|
|
|
;;; Syntax Constants
|
|
;;;; Block
|
|
(defconst org-block-regexp
|
"^[ \t]*#\\+begin_?\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$"
|
"Regular expression for hiding blocks.")
|
|
(defconst org-dblock-start-re
|
"^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?"
|
"Matches the start line of a dynamic block, with parameters.")
|
|
(defconst org-dblock-end-re "^[ \t]*#\\+\\(?:END\\|end\\)\\([: \t\r\n]\\|$\\)"
|
"Matches the end of a dynamic block.")
|
|
;;;; Clock and Planning
|
|
(defconst org-clock-string "CLOCK:"
|
"String used as prefix for timestamps clocking work hours on an item.")
|
|
(defvar org-closed-string "CLOSED:"
|
"String used as the prefix for timestamps logging closing a TODO entry.")
|
|
(defvar org-deadline-string "DEADLINE:"
|
"String to mark deadline entries.
|
\\<org-mode-map>
|
A deadline is this string, followed by a time stamp. It must be
|
a word, terminated by a colon. You can insert a schedule keyword
|
and a timestamp with `\\[org-deadline]'.")
|
|
(defvar org-scheduled-string "SCHEDULED:"
|
"String to mark scheduled TODO entries.
|
\\<org-mode-map>
|
A schedule is this string, followed by a time stamp. It must be
|
a word, terminated by a colon. You can insert a schedule keyword
|
and a timestamp with `\\[org-schedule]'.")
|
|
(defconst org-ds-keyword-length
|
(+ 2
|
(apply #'max
|
(mapcar #'length
|
(list org-deadline-string org-scheduled-string
|
org-clock-string org-closed-string))))
|
"Maximum length of the DEADLINE and SCHEDULED keywords.")
|
|
(defconst org-planning-line-re
|
(concat "^[ \t]*"
|
(regexp-opt
|
(list org-closed-string org-deadline-string org-scheduled-string)
|
t))
|
"Matches a line with planning info.
|
Matched keyword is in group 1.")
|
|
(defconst org-clock-line-re
|
(concat "^[ \t]*" org-clock-string)
|
"Matches a line with clock info.")
|
|
(defconst org-deadline-regexp (concat "\\<" org-deadline-string)
|
"Matches the DEADLINE keyword.")
|
|
(defconst org-deadline-time-regexp
|
(concat "\\<" org-deadline-string " *<\\([^>]+\\)>")
|
"Matches the DEADLINE keyword together with a time stamp.")
|
|
(defconst org-deadline-time-hour-regexp
|
(concat "\\<" org-deadline-string
|
" *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>")
|
"Matches the DEADLINE keyword together with a time-and-hour stamp.")
|
|
(defconst org-deadline-line-regexp
|
(concat "\\<\\(" org-deadline-string "\\).*")
|
"Matches the DEADLINE keyword and the rest of the line.")
|
|
(defconst org-scheduled-regexp (concat "\\<" org-scheduled-string)
|
"Matches the SCHEDULED keyword.")
|
|
(defconst org-scheduled-time-regexp
|
(concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")
|
"Matches the SCHEDULED keyword together with a time stamp.")
|
|
(defconst org-scheduled-time-hour-regexp
|
(concat "\\<" org-scheduled-string
|
" *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>")
|
"Matches the SCHEDULED keyword together with a time-and-hour stamp.")
|
|
(defconst org-closed-time-regexp
|
(concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]")
|
"Matches the CLOSED keyword together with a time stamp.")
|
|
(defconst org-keyword-time-regexp
|
(concat "\\<"
|
(regexp-opt
|
(list org-scheduled-string org-deadline-string org-closed-string
|
org-clock-string)
|
t)
|
" *[[<]\\([^]>]+\\)[]>]")
|
"Matches any of the 4 keywords, together with the time stamp.")
|
|
(defconst org-keyword-time-not-clock-regexp
|
(concat
|
"\\<"
|
(regexp-opt
|
(list org-scheduled-string org-deadline-string org-closed-string) t)
|
" *[[<]\\([^]>]+\\)[]>]")
|
"Matches any of the 3 keywords, together with the time stamp.")
|
|
(defconst org-maybe-keyword-time-regexp
|
(concat "\\(\\<"
|
(regexp-opt
|
(list org-scheduled-string org-deadline-string org-closed-string
|
org-clock-string)
|
t)
|
"\\)?"
|
" *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?[]>]"
|
"\\|"
|
"<%%([^\r\n>]*>\\)")
|
"Matches a timestamp, possibly preceded by a keyword.")
|
|
(defconst org-all-time-keywords
|
(mapcar (lambda (w) (substring w 0 -1))
|
(list org-scheduled-string org-deadline-string
|
org-clock-string org-closed-string))
|
"List of time keywords.")
|
|
;;;; Drawer
|
|
(defconst org-drawer-regexp "^[ \t]*:\\(\\(?:\\w\\|[-_]\\)+\\):[ \t]*$"
|
"Matches first or last line of a hidden block.
|
Group 1 contains drawer's name or \"END\".")
|
|
(defconst org-property-start-re "^[ \t]*:PROPERTIES:[ \t]*$"
|
"Regular expression matching the first line of a property drawer.")
|
|
(defconst org-property-end-re "^[ \t]*:END:[ \t]*$"
|
"Regular expression matching the last line of a property drawer.")
|
|
(defconst org-clock-drawer-start-re "^[ \t]*:CLOCK:[ \t]*$"
|
"Regular expression matching the first line of a clock drawer.")
|
|
(defconst org-clock-drawer-end-re "^[ \t]*:END:[ \t]*$"
|
"Regular expression matching the last line of a clock drawer.")
|
|
(defconst org-property-drawer-re
|
(concat "^[ \t]*:PROPERTIES:[ \t]*\n"
|
"\\(?:[ \t]*:\\S-+:\\(?: .*\\)?[ \t]*\n\\)*?"
|
"[ \t]*:END:[ \t]*$")
|
"Matches an entire property drawer.")
|
|
(defconst org-clock-drawer-re
|
(concat "\\(" org-clock-drawer-start-re "\\)[^\000]*?\\("
|
org-clock-drawer-end-re "\\)\n?")
|
"Matches an entire clock drawer.")
|
|
;;;; Headline
|
|
(defconst org-heading-keyword-regexp-format
|
"^\\(\\*+\\)\\(?: +%s\\)\\(?: +\\(.*?\\)\\)?[ \t]*$"
|
"Printf format for a regexp matching a 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 a 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.")
|
|
(defconst org-archive-tag "ARCHIVE"
|
"The tag that marks a subtree as archived.
|
An archived subtree does not open during visibility cycling, and does
|
not contribute to the agenda listings.")
|
|
(eval-and-compile
|
(defconst org-comment-string "COMMENT"
|
"Entries starting with this keyword will never be exported.
|
\\<org-mode-map>
|
An entry can be toggled between COMMENT and normal with
|
`\\[org-toggle-comment]'."))
|
|
|
;;;; LaTeX Environments and Fragments
|
|
(defconst org-latex-regexps
|
'(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t)
|
;; ("$" "\\([ \t(]\\|^\\)\\(\\(\\([$]\\)\\([^ \t\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \t\n,.$]\\)\\4\\)\\)\\([ \t.,?;:'\")]\\|$\\)" 2 nil)
|
;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p
|
("$1" "\\([^$]\\|^\\)\\(\\$[^ \t\r\n,;.$]\\$\\)\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|\000\\|'\\|$\\)" 2 nil)
|
("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \t\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \t\n,.$]\\)\\$\\)\\)\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|\000\\|'\\|$\\)" 2 nil)
|
("\\(" "\\\\([^\000]*?\\\\)" 0 nil)
|
("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil)
|
("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil))
|
"Regular expressions for matching embedded LaTeX.")
|
|
;;;; Node Property
|
|
(defconst org-effort-property "Effort"
|
"The property that is being used to keep track of effort estimates.
|
Effort estimates given in this property need to have the format H:MM.")
|
|
;;;; Table
|
|
(defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)"
|
"Detect an org-type or table-type table.")
|
|
(defconst org-table-line-regexp "^[ \t]*|"
|
"Detect an org-type table line.")
|
|
(defconst org-table-dataline-regexp "^[ \t]*|[^-]"
|
"Detect an org-type table line.")
|
|
(defconst org-table-hline-regexp "^[ \t]*|-"
|
"Detect an org-type table hline.")
|
|
(defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]"
|
"Detect a table-type table hline.")
|
|
(defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]"
|
"Detect the first line outside a table when searching from within it.
|
This works for both table types.")
|
|
(defconst org-TBLFM-regexp "^[ \t]*#\\+TBLFM: "
|
"Detect a #+TBLFM line.")
|
|
;;;; Timestamp
|
|
(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-inactive
|
"\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)\\]"
|
"Regular expression for fast inactive time stamp matching.")
|
|
(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?\\)[]>]"
|
"Regular expression for fast time stamp matching.")
|
|
(defconst org-ts-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]\\{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.")
|
|
(defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[^]>\n]\\{0,16\\}[]>]")
|
"Regular expression matching time stamps (also [..]), with groups.")
|
|
(defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp)
|
"Regular expression matching a time stamp range.")
|
|
(defconst org-tr-regexp-both
|
(concat org-ts-regexp-both "--?-?" org-ts-regexp-both)
|
"Regular expression matching a time stamp range.")
|
|
(defconst org-tsr-regexp (concat org-ts-regexp "\\(--?-?"
|
org-ts-regexp "\\)?")
|
"Regular expression matching a time stamp or time stamp range.")
|
|
(defconst org-tsr-regexp-both
|
(concat org-ts-regexp-both "\\(--?-?"
|
org-ts-regexp-both "\\)?")
|
"Regular expression matching a time stamp or time stamp range.
|
The time stamps may be either active or inactive.")
|
|
(defconst org-repeat-re
|
"<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*?\\([.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)"
|
"Regular expression for specifying repeated events.
|
After a match, group 1 contains the repeat expression.")
|
|
(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>")
|
"Formats for `format-time-string' which are used for time stamps.")
|
|
|
;;; The custom variables
|
|
(defgroup org nil
|
"Outline-based notes management and organizer."
|
:tag "Org"
|
:group 'outlines
|
:group 'calendar)
|
|
(defcustom org-mode-hook nil
|
"Mode hook for Org mode, run after the mode was turned on."
|
:group 'org
|
:type 'hook)
|
|
(defcustom org-load-hook nil
|
"Hook that is run after org.el has been loaded."
|
:group 'org
|
: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?")
|
|
(defun org-load-modules-maybe (&optional force)
|
"Load all extensions listed in `org-modules'."
|
(when (or force (not org-modules-loaded))
|
(dolist (ext org-modules)
|
(condition-case nil (require ext)
|
(error (message "Problems while trying to load feature `%s'" ext))))
|
(setq org-modules-loaded t)))
|
|
(defun org-set-modules (var value)
|
"Set VAR to VALUE and call `org-load-modules-maybe' with the force flag."
|
(set var value)
|
(when (featurep 'org)
|
(org-load-modules-maybe 'force)
|
(org-element-cache-reset 'all)))
|
|
(defcustom org-modules '(org-w3m org-bbdb org-bibtex org-docview org-gnus org-info org-irc org-mhe org-rmail)
|
"Modules that should always be loaded together with org.el.
|
|
If a description starts with <C>, the file is not part of Emacs
|
and loading it will require that you have downloaded and properly
|
installed the Org mode distribution.
|
|
You can also use this system to load external packages (i.e. neither Org
|
core modules, nor modules from the CONTRIB directory). Just add symbols
|
to the end of the list. If the package is called org-xyz.el, then you need
|
to add the symbol `xyz', and the package must have a call to:
|
|
(provide \\='org-xyz)
|
|
For export specific modules, see also `org-export-backends'."
|
:group 'org
|
:set 'org-set-modules
|
:version "24.4"
|
:package-version '(Org . "8.0")
|
:type
|
'(set :greedy t
|
(const :tag " bbdb: Links to BBDB entries" org-bbdb)
|
(const :tag " bibtex: Links to BibTeX entries" org-bibtex)
|
(const :tag " crypt: Encryption of subtrees" org-crypt)
|
(const :tag " ctags: Access to Emacs tags with links" org-ctags)
|
(const :tag " docview: Links to doc-view buffers" org-docview)
|
(const :tag " eww: Store link to url of eww" org-eww)
|
(const :tag " gnus: Links to GNUS folders/messages" org-gnus)
|
(const :tag " habit: Track your consistency with habits" org-habit)
|
(const :tag " id: Global IDs for identifying entries" org-id)
|
(const :tag " info: Links to Info nodes" org-info)
|
(const :tag " inlinetask: Tasks independent of outline hierarchy" org-inlinetask)
|
(const :tag " irc: Links to IRC/ERC chat sessions" org-irc)
|
(const :tag " mhe: Links to MHE folders/messages" org-mhe)
|
(const :tag " mouse: Additional mouse support" org-mouse)
|
(const :tag " protocol: Intercept calls from emacsclient" org-protocol)
|
(const :tag " rmail: Links to RMAIL folders/messages" org-rmail)
|
(const :tag " w3m: Special cut/paste from w3m to Org mode." org-w3m)
|
|
(const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file)
|
(const :tag "C bookmark: Org links to bookmarks" org-bookmark)
|
(const :tag "C checklist: Extra functions for checklists in repeated tasks" org-checklist)
|
(const :tag "C choose: Use TODO keywords to mark decisions states" org-choose)
|
(const :tag "C collector: Collect properties into tables" org-collector)
|
(const :tag "C depend: TODO dependencies for Org mode\n\t\t\t(PARTIALLY OBSOLETE, see built-in dependency support))" org-depend)
|
(const :tag "C drill: Flashcards and spaced repetition for Org mode" org-drill)
|
(const :tag "C elisp-symbol: Org 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-light: Evaluate inbuffer-code on demand" org-eval-light)
|
(const :tag "C eval: Include command output as text" org-eval)
|
(const :tag "C expiry: Expiry mechanism for Org entries" org-expiry)
|
(const :tag "C favtable: Lookup table of favorite references and links" org-favtable)
|
(const :tag "C git-link: Provide org links to specific file version" org-git-link)
|
(const :tag "C interactive-query: Interactive modification of tags query\n\t\t\t(PARTIALLY OBSOLETE, see secondary filtering)" org-interactive-query)
|
(const :tag "C invoice: Help manage client invoices in Org mode" org-invoice)
|
(const :tag "C learn: SuperMemo's incremental learning algorithm" org-learn)
|
(const :tag "C mac-iCal Imports events from iCal.app to the Emacs diary" org-mac-iCal)
|
(const :tag "C mac-link: Grab links and url from various mac Applications" org-mac-link)
|
(const :tag "C mairix: Hook mairix search into Org for different MUAs" org-mairix)
|
(const :tag "C man: Support for links to manpages in Org mode" org-man)
|
(const :tag "C mew: Links to Mew folders/messages" org-mew)
|
(const :tag "C mtags: Support for muse-like tags" org-mtags)
|
(const :tag "C notmuch: Provide org links to notmuch searches or messages" org-notmuch)
|
(const :tag "C panel: Simple routines for us with bad memory" org-panel)
|
(const :tag "C registry: A registry for Org links" org-registry)
|
(const :tag "C screen: Visit screen sessions through Org links" org-screen)
|
(const :tag "C secretary: Team management with Org" org-secretary)
|
(const :tag "C sqlinsert: Convert Org tables to SQL insertions" orgtbl-sqlinsert)
|
(const :tag "C toc: Table of contents for Org buffer" org-toc)
|
(const :tag "C track: Keep up with Org mode development" org-track)
|
(const :tag "C velocity Something like Notational Velocity for Org" org-velocity)
|
(const :tag "C vm: Links to VM folders/messages" org-vm)
|
(const :tag "C wikinodes: CamelCase wiki-like links" org-wikinodes)
|
(const :tag "C wl: Links to Wanderlust folders/messages" org-wl)
|
(repeat :tag "External packages" :inline t (symbol :tag "Package"))))
|
|
(defvar org-export-registered-backends) ; From ox.el.
|
(declare-function org-export-derived-backend-p "ox" (backend &rest backends))
|
(declare-function org-export-backend-name "ox" (backend) t)
|
(defcustom org-export-backends '(ascii html icalendar latex odt)
|
"List of export back-ends that should be always available.
|
|
If a description starts with <C>, the file is not part of Emacs
|
and loading it will require that you have downloaded and properly
|
installed the Org mode distribution.
|
|
Unlike to `org-modules', libraries in this list will not be
|
loaded along with Org, but only once the export framework is
|
needed.
|
|
This variable needs to be set before org.el is loaded. If you
|
need to make a change while Emacs is running, use the customize
|
interface or run the following code, where VAL stands for the new
|
value of the variable, after updating it:
|
|
(progn
|
(setq org-export-registered-backends
|
(cl-remove-if-not
|
(lambda (backend)
|
(let ((name (org-export-backend-name backend)))
|
(or (memq name val)
|
(catch \\='parentp
|
(dolist (b val)
|
(and (org-export-derived-backend-p b name)
|
(throw \\='parentp t)))))))
|
org-export-registered-backends))
|
(let ((new-list (mapcar #\\='org-export-backend-name
|
org-export-registered-backends)))
|
(dolist (backend val)
|
(cond
|
((not (load (format \"ox-%s\" backend) t t))
|
(message \"Problems while trying to load export back-end \\=`%s\\='\"
|
backend))
|
((not (memq backend new-list)) (push backend new-list))))
|
(set-default \\='org-export-backends new-list)))
|
|
Adding a back-end to this list will also pull the back-end it
|
depends on, if any."
|
:group 'org
|
:group 'org-export
|
:version "26.1"
|
:package-version '(Org . "9.0")
|
:initialize 'custom-initialize-set
|
:set (lambda (var val)
|
(if (not (featurep 'ox)) (set-default var val)
|
;; Any back-end not required anymore (not present in VAL and not
|
;; a parent of any back-end in the new value) is removed from the
|
;; list of registered back-ends.
|
(setq org-export-registered-backends
|
(cl-remove-if-not
|
(lambda (backend)
|
(let ((name (org-export-backend-name backend)))
|
(or (memq name val)
|
(catch 'parentp
|
(dolist (b val)
|
(and (org-export-derived-backend-p b name)
|
(throw 'parentp t)))))))
|
org-export-registered-backends))
|
;; Now build NEW-LIST of both new back-ends and required
|
;; parents.
|
(let ((new-list (mapcar #'org-export-backend-name
|
org-export-registered-backends)))
|
(dolist (backend val)
|
(cond
|
((not (load (format "ox-%s" backend) t t))
|
(message "Problems while trying to load export back-end `%s'"
|
backend))
|
((not (memq backend new-list)) (push backend new-list))))
|
;; Set VAR to that list with fixed dependencies.
|
(set-default var new-list))))
|
:type '(set :greedy t
|
(const :tag " ascii Export buffer to ASCII format" ascii)
|
(const :tag " beamer Export buffer to Beamer presentation" beamer)
|
(const :tag " html Export buffer to HTML format" html)
|
(const :tag " icalendar Export buffer to iCalendar format" icalendar)
|
(const :tag " latex Export buffer to LaTeX format" latex)
|
(const :tag " man Export buffer to MAN format" man)
|
(const :tag " md Export buffer to Markdown format" md)
|
(const :tag " odt Export buffer to ODT format" odt)
|
(const :tag " org Export buffer to Org format" org)
|
(const :tag " texinfo Export buffer to Texinfo format" texinfo)
|
(const :tag "C confluence Export buffer to Confluence Wiki format" confluence)
|
(const :tag "C deck Export buffer to deck.js presentations" deck)
|
(const :tag "C freemind Export buffer to Freemind mindmap format" freemind)
|
(const :tag "C groff Export buffer to Groff format" groff)
|
(const :tag "C koma-letter Export buffer to KOMA Scrlttrl2 format" koma-letter)
|
(const :tag "C RSS 2.0 Export buffer to RSS 2.0 format" rss)
|
(const :tag "C s5 Export buffer to s5 presentations" s5)
|
(const :tag "C taskjuggler Export buffer to TaskJuggler format" taskjuggler)))
|
|
(eval-after-load 'ox
|
'(dolist (backend org-export-backends)
|
(condition-case nil (require (intern (format "ox-%s" backend)))
|
(error (message "Problems while trying to load export back-end `%s'"
|
backend)))))
|
|
(defcustom org-support-shift-select nil
|
"Non-nil means make shift-cursor commands select text when possible.
|
\\<org-mode-map>\
|
|
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:
|
- on a headline, changing TODO state (left/right) and priority (up/down)
|
- on a time stamp, changing the time
|
- in a plain list item, changing the bullet type
|
- in a property definition line, switching between allowed values
|
- 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.
|
|
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:
|
`\\[org-todo]' and `\\[org-priority]' \
|
to change TODO state and priority,
|
`\\[universal-argument] \\[universal-argument] \\[org-todo]' \
|
can be used to switch TODO sets,
|
`\\[org-ctrl-c-minus]' 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."
|
: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"
|
:group 'org)
|
|
(defcustom org-startup-folded t
|
"Non-nil means entering Org mode will switch to OVERVIEW.
|
|
This can also be configured on a per-file basis by adding one of
|
the following lines anywhere in the buffer:
|
|
#+STARTUP: fold (or `overview', this is equivalent)
|
#+STARTUP: nofold (or `showall', this is equivalent)
|
#+STARTUP: content
|
#+STARTUP: showeverything
|
|
Set `org-agenda-inhibit-startup' to a non-nil value if you want
|
to ignore this option when Org opens agenda files for the first
|
time."
|
:group 'org-startup
|
:type '(choice
|
(const :tag "nofold: show all" nil)
|
(const :tag "fold: overview" t)
|
(const :tag "content: all headlines" content)
|
(const :tag "show everything, even drawers" showeverything)))
|
|
(defcustom org-startup-truncated t
|
"Non-nil means entering Org mode will set `truncate-lines'.
|
This is useful since some lines containing links can be very long and
|
uninteresting. Also tables look terrible when wrapped.
|
|
The variable `org-startup-truncated' allows to configure
|
truncation for Org mode different to the other modes that use the
|
variable `truncate-lines' and as a shortcut instead of putting
|
the variable `truncate-lines' into the `org-mode-hook'. If one
|
wants to configure truncation for Org mode not statically but
|
dynamically e. g. in a hook like `ediff-prepare-buffer-hook' then
|
the variable `truncate-lines' has to be used because in such a
|
case it is too late to set the variable `org-startup-truncated'."
|
:group 'org-startup
|
:type 'boolean)
|
|
(defcustom org-startup-indented nil
|
"Non-nil means turn on `org-indent-mode' on startup.
|
This can also be configured on a per-file basis by adding one of
|
the following lines anywhere in the buffer:
|
|
#+STARTUP: indent
|
#+STARTUP: noindent"
|
:group 'org-structure
|
:type '(choice
|
(const :tag "Not" nil)
|
(const :tag "Globally (slow on startup in large files)" t)))
|
|
(defcustom org-use-sub-superscripts t
|
"Non-nil means interpret \"_\" and \"^\" for display.
|
|
If you want to control how Org exports those characters, see
|
`org-export-with-sub-superscripts'. `org-use-sub-superscripts'
|
used to be an alias for `org-export-with-sub-superscripts' in
|
Org <8.0, it is not anymore.
|
|
When this option is turned on, you can use TeX-like syntax for
|
sub- and superscripts within the buffer. Several characters after
|
\"_\" or \"^\" will be considered as a single item - so grouping
|
with {} is normally not needed. For example, the following things
|
will be parsed as single sub- or superscripts:
|
|
10^24 or 10^tau several digits will be considered 1 item.
|
10^-12 or 10^-tau a leading sign with digits or a word
|
x^2-y^3 will be read as x^2 - y^3, because items are
|
terminated by almost any nonword/nondigit char.
|
x_{i^2} or x^(2-i) braces or parenthesis do grouping.
|
|
Still, ambiguity is possible. So when in doubt, use {} to enclose
|
the sub/superscript. If you set this variable to the symbol `{}',
|
the braces are *required* in order to trigger interpretations as
|
sub/superscript. This can be helpful in documents that need \"_\"
|
frequently in plain text."
|
:group 'org-startup
|
:version "24.4"
|
:package-version '(Org . "8.0")
|
:type '(choice
|
(const :tag "Always interpret" t)
|
(const :tag "Only with braces" {})
|
(const :tag "Never interpret" nil)))
|
|
(defcustom org-startup-with-beamer-mode nil
|
"Non-nil means turn on `org-beamer-mode' on startup.
|
This can also be configured on a per-file basis by adding one of
|
the following lines anywhere in the buffer:
|
|
#+STARTUP: beamer"
|
:group 'org-startup
|
:version "24.1"
|
:type 'boolean)
|
|
(defcustom org-startup-align-all-tables nil
|
"Non-nil means align all tables when visiting a file.
|
This is useful when the column width in tables is forced with <N> cookies
|
in table fields. Such tables will look correct only after the first re-align.
|
This can also be configured on a per-file basis by adding one of
|
the following lines anywhere in the buffer:
|
#+STARTUP: align
|
#+STARTUP: noalign"
|
:group 'org-startup
|
:type 'boolean)
|
|
(defcustom org-startup-with-inline-images nil
|
"Non-nil means show inline images when loading a new Org file.
|
This can also be configured on a per-file basis by adding one of
|
the following lines anywhere in the buffer:
|
#+STARTUP: inlineimages
|
#+STARTUP: noinlineimages"
|
:group 'org-startup
|
:version "24.1"
|
:type 'boolean)
|
|
(defcustom org-startup-with-latex-preview nil
|
"Non-nil means preview LaTeX fragments when loading a new Org file.
|
|
This can also be configured on a per-file basis by adding one of
|
the following lines anywhere in the buffer:
|
#+STARTUP: latexpreview
|
#+STARTUP: nolatexpreview"
|
:group 'org-startup
|
:version "24.4"
|
:package-version '(Org . "8.0")
|
:type 'boolean)
|
|
(defcustom org-insert-mode-line-in-empty-file nil
|
"Non-nil means insert the first line setting Org mode in empty files.
|
When the function `org-mode' is called interactively in an empty file, this
|
normally means that the file name does not automatically trigger Org mode.
|
To ensure that the file will always be in Org mode in the future, a
|
line enforcing Org mode will be inserted into the buffer, if this option
|
has been set."
|
:group 'org-startup
|
:type 'boolean)
|
|
(defcustom org-replace-disputed-keys nil
|
"Non-nil means use alternative key bindings for some keys.
|
Org mode uses S-<cursor> keys for changing timestamps and priorities.
|
These keys are also used by other packages like shift-selection-mode'
|
\(built into Emacs 23), `CUA-mode' or `windmove.el'.
|
If you want to use Org mode together with one of these other modes,
|
or more generally if you would like to move some Org mode commands to
|
other keys, set this variable and configure the keys with the variable
|
`org-disputed-keys'.
|
|
This option is only relevant at load-time of Org mode, and must be set
|
*before* org.el is loaded. Changing it requires a restart of Emacs to
|
become effective."
|
:group 'org-startup
|
:type 'boolean)
|
|
(defcustom org-use-extra-keys nil
|
"Non-nil means use extra key sequence definitions for certain commands.
|
This happens automatically if `window-system' is nil. This
|
variable lets you do the same manually. You must set it before
|
loading Org."
|
:group 'org-startup
|
:type 'boolean)
|
|
(defvaralias 'org-CUA-compatible 'org-replace-disputed-keys)
|
|
(defcustom org-disputed-keys
|
'(([(shift up)] . [(meta p)])
|
([(shift down)] . [(meta n)])
|
([(shift left)] . [(meta -)])
|
([(shift right)] . [(meta +)])
|
([(control shift right)] . [(meta shift +)])
|
([(control shift left)] . [(meta shift -)]))
|
"Keys for which Org mode and other modes compete.
|
This is an alist, cars are the default keys, second element specifies
|
the alternative to use when `org-replace-disputed-keys' is t.
|
|
Keys can be specified in any syntax supported by `define-key'.
|
The value of this option takes effect only at Org mode startup,
|
therefore you'll have to restart Emacs to apply it after changing."
|
:group 'org-startup
|
:type 'alist)
|
|
(defun org-key (key)
|
"Select key according to `org-replace-disputed-keys' and `org-disputed-keys'.
|
Or return the original if not disputed."
|
(when org-replace-disputed-keys
|
(let* ((nkey (key-description key))
|
(x (cl-find-if (lambda (x) (equal (key-description (car x)) nkey))
|
org-disputed-keys)))
|
(setq key (if x (cdr x) key))))
|
key)
|
|
(defun org-defkey (keymap key def)
|
"Define a key, possibly translated, as returned by `org-key'."
|
(define-key keymap (org-key key) def))
|
|
(defcustom org-ellipsis nil
|
"The ellipsis to use in the Org mode outline.
|
|
When nil, just use the standard three dots. When a non-empty string,
|
use that string instead.
|
|
The change affects only Org mode (which will then use its own display table).
|
Changing this requires executing `\\[org-mode]' in a buffer to become
|
effective."
|
:group 'org-startup
|
:type '(choice (const :tag "Default" nil)
|
(string :tag "String" :value "...#"))
|
:safe (lambda (v) (and (string-or-null-p v) (not (equal "" v)))))
|
|
(defvar org-display-table nil
|
"The display table for Org mode, in case `org-ellipsis' is non-nil.")
|
|
(defgroup org-keywords nil
|
"Keywords in Org mode."
|
:tag "Org Keywords"
|
:group 'org)
|
|
(defcustom org-closed-keep-when-no-todo nil
|
"Remove CLOSED: time-stamp when switching back to a non-todo state?"
|
:group 'org-todo
|
:group 'org-keywords
|
:version "24.4"
|
:package-version '(Org . "8.0")
|
:type 'boolean)
|
|
(defgroup org-structure nil
|
"Options concerning the general structure of Org files."
|
:tag "Org Structure"
|
:group 'org)
|
|
(defgroup org-reveal-location nil
|
"Options about how to make context of a location visible."
|
:tag "Org Reveal Location"
|
:group 'org-structure)
|
|
(defcustom org-show-context-detail '((agenda . local)
|
(bookmark-jump . lineage)
|
(isearch . lineage)
|
(default . ancestors))
|
"Alist between context and visibility span when revealing a location.
|
|
\\<org-mode-map>Some actions may move point into invisible
|
locations. As a consequence, Org always expose a neighborhood
|
around point. How much is shown depends on the initial action,
|
or context. Valid contexts are
|
|
agenda when exposing an entry from the agenda
|
org-goto when using the command `org-goto' (`\\[org-goto]')
|
occur-tree when using the command `org-occur' (`\\[org-sparse-tree] /')
|
tags-tree when constructing a sparse tree based on tags matches
|
link-search when exposing search matches associated with a link
|
mark-goto when exposing the jump goal of a mark
|
bookmark-jump when exposing a bookmark location
|
isearch when exiting from an incremental search
|
default default for all contexts not set explicitly
|
|
Allowed visibility spans are
|
|
minimal show current headline; if point is not on headline,
|
also show entry
|
|
local show current headline, entry and next headline
|
|
ancestors show current headline and its direct ancestors; if
|
point is not on headline, also show entry
|
|
lineage show current headline, its direct ancestors and all
|
their children; if point is not on headline, also show
|
entry and first child
|
|
tree show current headline, its direct ancestors and all
|
their children; if point is not on headline, also show
|
entry and all children
|
|
canonical show current headline, its direct ancestors along with
|
their entries and children; if point is not located on
|
the headline, also show current entry and all children
|
|
As special cases, a nil or t value means show all contexts in
|
`minimal' or `canonical' view, respectively.
|
|
Some views can make displayed information very compact, but also
|
make it harder to edit the location of the match. In such
|
a case, use the command `org-reveal' (`\\[org-reveal]') to show
|
more context."
|
:group 'org-reveal-location
|
:version "26.1"
|
:package-version '(Org . "9.0")
|
:type '(choice
|
(const :tag "Canonical" t)
|
(const :tag "Minimal" nil)
|
(repeat :greedy t :tag "Individual contexts"
|
(cons
|
(choice :tag "Context"
|
(const agenda)
|
(const org-goto)
|
(const occur-tree)
|
(const tags-tree)
|
(const link-search)
|
(const mark-goto)
|
(const bookmark-jump)
|
(const isearch)
|
(const default))
|
(choice :tag "Detail level"
|
(const minimal)
|
(const local)
|
(const ancestors)
|
(const lineage)
|
(const tree)
|
(const canonical))))))
|
|
(defcustom org-indirect-buffer-display 'other-window
|
"How should indirect tree buffers be displayed?
|
|
This applies to indirect buffers created with the commands
|
`org-tree-to-indirect-buffer' and `org-agenda-tree-to-indirect-buffer'.
|
|
Valid values are:
|
current-window Display in the current window
|
other-window Just display in another window.
|
dedicated-frame Create one new frame, and re-use it each time.
|
new-frame Make a new frame each time. Note that in this case
|
previously-made indirect buffers are kept, and you need to
|
kill these buffers yourself."
|
:group 'org-structure
|
:group 'org-agenda-windows
|
:type '(choice
|
(const :tag "In current window" current-window)
|
(const :tag "In current frame, other window" other-window)
|
(const :tag "Each time a new frame" new-frame)
|
(const :tag "One dedicated frame" dedicated-frame)))
|
|
(defcustom org-use-speed-commands nil
|
"Non-nil means activate single letter commands at beginning of a headline.
|
This may also be a function to test for appropriate locations where speed
|
commands should be active.
|
|
For example, to activate speed commands when the point is on any
|
star at the beginning of the headline, you can do this:
|
|
(setq org-use-speed-commands
|
(lambda () (and (looking-at org-outline-regexp) (looking-back \"^\\**\"))))"
|
:group 'org-structure
|
:type '(choice
|
(const :tag "Never" nil)
|
(const :tag "At beginning of headline stars" t)
|
(function)))
|
|
(defcustom org-speed-commands-user nil
|
"Alist of additional speed commands.
|
This list will be checked before `org-speed-commands-default'
|
when the variable `org-use-speed-commands' is non-nil
|
and when the cursor is at the beginning of a headline.
|
The car of each entry is a string with a single letter, which must
|
be assigned to `self-insert-command' in the global map.
|
The cdr is either a command to be called interactively, a function
|
to be called, or a form to be evaluated.
|
An entry that is just a list with a single string will be interpreted
|
as a descriptive headline that will be added when listing the speed
|
commands in the Help buffer using the `?' speed command."
|
:group 'org-structure
|
:type '(repeat :value ("k" . ignore)
|
(choice :value ("k" . ignore)
|
(list :tag "Descriptive Headline" (string :tag "Headline"))
|
(cons :tag "Letter and Command"
|
(string :tag "Command letter")
|
(choice
|
(function)
|
(sexp))))))
|
|
(defcustom org-bookmark-names-plist
|
'(:last-capture "org-capture-last-stored"
|
:last-refile "org-refile-last-stored"
|
:last-capture-marker "org-capture-last-stored-marker")
|
"Names for bookmarks automatically set by some Org commands.
|
This can provide strings as names for a number of bookmarks Org sets
|
automatically. The following keys are currently implemented:
|
:last-capture
|
:last-capture-marker
|
:last-refile
|
When a key does not show up in the property list, the corresponding bookmark
|
is not set."
|
:group 'org-structure
|
:type 'plist)
|
|
(defgroup org-cycle nil
|
"Options concerning visibility cycling in Org mode."
|
:tag "Org Cycle"
|
:group 'org-structure)
|
|
(defcustom org-cycle-skip-children-state-if-no-children t
|
"Non-nil means skip CHILDREN state in entries that don't have any."
|
:group 'org-cycle
|
:type 'boolean)
|
|
(defcustom org-cycle-max-level nil
|
"Maximum level which should still be subject to visibility cycling.
|
Levels higher than this will, for cycling, be treated as text, not a headline.
|
When `org-odd-levels-only' is set, a value of N in this variable actually
|
means 2N-1 stars as the limiting headline.
|
When nil, cycle all levels.
|
Note that the limiting level of cycling is also influenced by
|
`org-inlinetask-min-level'. When `org-cycle-max-level' is not set but
|
`org-inlinetask-min-level' is, cycling will be limited to levels one less
|
than its value."
|
:group 'org-cycle
|
:type '(choice
|
(const :tag "No limit" nil)
|
(integer :tag "Maximum level")))
|
|
(defcustom org-hide-block-startup nil
|
"Non-nil means entering Org mode will fold all blocks.
|
This can also be set in on a per-file basis with
|
|
#+STARTUP: hideblocks
|
#+STARTUP: showblocks"
|
:group 'org-startup
|
:group 'org-cycle
|
:type 'boolean)
|
|
(defcustom org-cycle-global-at-bob nil
|
"Cycle globally if cursor is at beginning of buffer and not at a headline.
|
|
This makes it possible to do global cycling without having to use `S-TAB'
|
or `\\[universal-argument] TAB'. For this special case to work, the first \
|
line of the buffer
|
must not be a headline -- it may be empty or some other text.
|
|
When used in this way, `org-cycle-hook' is disabled temporarily to make
|
sure the cursor stays at the beginning of the buffer.
|
|
When this option is nil, don't do anything special at the beginning of
|
the buffer."
|
:group 'org-cycle
|
:type 'boolean)
|
|
(defcustom org-cycle-level-after-item/entry-creation t
|
"Non-nil means cycle entry level or item indentation in new empty entries.
|
|
When the cursor is at the end of an empty headline, i.e., with only stars
|
and maybe a TODO keyword, TAB will then switch the entry to become a child,
|
and then all possible ancestor states, before returning to the original state.
|
This makes data entry extremely fast: M-RET to create a new headline,
|
on TAB to make it a child, two or more tabs to make it a (grand-)uncle.
|
|
When the cursor is at the end of an empty plain list item, one TAB will
|
make it a subitem, two or more tabs will back up to make this an item
|
higher up in the item hierarchy."
|
:group 'org-cycle
|
:type 'boolean)
|
|
(defcustom org-cycle-emulate-tab t
|
"Where should `org-cycle' emulate TAB.
|
nil Never
|
white Only in completely white lines
|
whitestart Only at the beginning of lines, before the first non-white char
|
t Everywhere except in headlines
|
exc-hl-bol Everywhere except at the start of a headline
|
If TAB is used in a place where it does not emulate TAB, the current subtree
|
visibility is cycled."
|
:group 'org-cycle
|
:type '(choice (const :tag "Never" nil)
|
(const :tag "Only in completely white lines" white)
|
(const :tag "Before first char in a line" whitestart)
|
(const :tag "Everywhere except in headlines" t)
|
(const :tag "Everywhere except at bol in headlines" exc-hl-bol)))
|
|
(defcustom org-cycle-separator-lines 2
|
"Number of empty lines needed to keep an empty line between collapsed trees.
|
If you leave an empty line between the end of a subtree and the following
|
headline, this empty line is hidden when the subtree is folded.
|
Org mode will leave (exactly) one empty line visible if the number of
|
empty lines is equal or larger to the number given in this variable.
|
So the default 2 means at least 2 empty lines after the end of a subtree
|
are needed to produce free space between a collapsed subtree and the
|
following headline.
|
|
If the number is negative, and the number of empty lines is at least -N,
|
all empty lines are shown.
|
|
Special case: when 0, never leave empty lines in collapsed view."
|
:group 'org-cycle
|
:type 'integer)
|
(put 'org-cycle-separator-lines 'safe-local-variable 'integerp)
|
|
(defcustom org-pre-cycle-hook nil
|
"Hook that is run before visibility cycling is happening.
|
The function(s) in this hook must accept a single argument which indicates
|
the new state that will be set right after running this hook. The
|
argument is a symbol. Before a global state change, it can have the values
|
`overview', `content', or `all'. Before a local state change, it can have
|
the values `folded', `children', or `subtree'."
|
:group 'org-cycle
|
:type 'hook)
|
|
(defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees
|
org-cycle-hide-drawers
|
org-cycle-show-empty-lines
|
org-optimize-window-after-visibility-change)
|
"Hook that is run after `org-cycle' has changed the buffer visibility.
|
The function(s) in this hook must accept a single argument which indicates
|
the new state that was set by the most recent `org-cycle' command. The
|
argument is a symbol. After a global state change, it can have the values
|
`overview', `contents', or `all'. After a local state change, it can have
|
the values `folded', `children', or `subtree'."
|
:group 'org-cycle
|
:type 'hook
|
:version "26.1"
|
:package-version '(Org . "8.3"))
|
|
(defgroup org-edit-structure nil
|
"Options concerning structure editing in Org mode."
|
:tag "Org Edit Structure"
|
:group 'org-structure)
|
|
(defcustom org-odd-levels-only nil
|
"Non-nil means skip even levels and only use odd levels for the outline.
|
This has the effect that two stars are being added/taken away in
|
promotion/demotion commands. It also influences how levels are
|
handled by the exporters.
|
Changing it requires restart of `font-lock-mode' to become effective
|
for fontification also in regions already fontified.
|
You may also set this on a per-file basis by adding one of the following
|
lines to the buffer:
|
|
#+STARTUP: odd
|
#+STARTUP: oddeven"
|
:group 'org-edit-structure
|
:group 'org-appearance
|
:type 'boolean)
|
|
(defcustom org-adapt-indentation t
|
"Non-nil means adapt indentation to outline node level.
|
|
When this variable is set, Org assumes that you write outlines by
|
indenting text in each node to align with the headline (after the
|
stars). The following issues are influenced by this variable:
|
|
- The indentation is increased by one space in a demotion
|
command, and decreased by one in a promotion command. However,
|
in the latter case, if shifting some line in the entry body
|
would alter document structure (e.g., insert a new headline),
|
indentation is not changed at all.
|
|
- Property drawers and planning information is inserted indented
|
when this variable is set. When nil, they will not be indented.
|
|
- TAB indents a line relative to current level. The lines below
|
a headline will be indented when this variable is set.
|
|
Note that this is all about true indentation, by adding and
|
removing space characters. See also `org-indent.el' which does
|
level-dependent indentation in a virtual way, i.e. at display
|
time in Emacs."
|
:group 'org-edit-structure
|
:type 'boolean)
|
|
(defcustom org-special-ctrl-a/e nil
|
"Non-nil means `C-a' and `C-e' behave specially in headlines and items.
|
|
When t, `C-a' will bring back the cursor to the beginning of the
|
headline text, i.e. after the stars and after a possible TODO
|
keyword. In an item, this will be the position after bullet and
|
check-box, if any. When the cursor is already at that position,
|
another `C-a' will bring it to the beginning of the line.
|
|
`C-e' will jump to the end of the headline, ignoring the presence
|
of tags in the headline. A second `C-e' will then jump to the
|
true end of the line, after any tags. This also means that, when
|
this variable is non-nil, `C-e' also will never jump beyond the
|
end of the heading of a folded section, i.e. not after the
|
ellipses.
|
|
When set to the symbol `reversed', the first `C-a' or `C-e' works
|
normally, going to the true line boundary first. Only a directly
|
following, identical keypress will bring the cursor to the
|
special positions.
|
|
This may also be a cons cell where the behavior for `C-a' and
|
`C-e' is set separately."
|
:group 'org-edit-structure
|
:type '(choice
|
(const :tag "off" nil)
|
(const :tag "on: after stars/bullet and before tags first" t)
|
(const :tag "reversed: true line boundary first" reversed)
|
(cons :tag "Set C-a and C-e separately"
|
(choice :tag "Special C-a"
|
(const :tag "off" nil)
|
(const :tag "on: after stars/bullet first" t)
|
(const :tag "reversed: before stars/bullet first" reversed))
|
(choice :tag "Special C-e"
|
(const :tag "off" nil)
|
(const :tag "on: before tags first" t)
|
(const :tag "reversed: after tags first" reversed)))))
|
(defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e)
|
|
(defcustom org-special-ctrl-k nil
|
"Non-nil means `C-k' will behave specially in headlines.
|
When nil, `C-k' will call the default `kill-line' command.
|
When t, the following will happen while the cursor is in the headline:
|
|
- When the cursor is at the beginning of a headline, kill the entire
|
line and possible the folded subtree below the line.
|
- When in the middle of the headline text, kill the headline up to the tags.
|
- When after the headline text, kill the tags."
|
:group 'org-edit-structure
|
:type 'boolean)
|
|
(defcustom org-ctrl-k-protect-subtree nil
|
"Non-nil means, do not delete a hidden subtree with C-k.
|
When set to the symbol `error', simply throw an error when C-k is
|
used to kill (part-of) a headline that has hidden text behind it.
|
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-special-ctrl-o t
|
"Non-nil means, make `C-o' insert a row in tables."
|
:group 'org-edit-structure
|
:type 'boolean)
|
|
(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
|
it starts with a heading and all other headings in it are either children
|
or siblings, then fold all the subtrees. However, do this only if no
|
text after the yank would be swallowed into a folded tree by this action."
|
:group 'org-edit-structure
|
:type 'boolean)
|
|
(defcustom org-yank-adjusted-subtrees nil
|
"Non-nil means when yanking subtrees, adjust the level.
|
With this setting, `org-paste-subtree' is used to insert the subtree, see
|
this function for details."
|
:group 'org-edit-structure
|
:type 'boolean)
|
|
(defcustom org-M-RET-may-split-line '((default . t))
|
"Non-nil means M-RET will split the line at the cursor position.
|
When nil, it will go to the end of the line before making a
|
new line.
|
You may also set this option in a different way for different
|
contexts. Valid contexts are:
|
|
headline when creating a new headline
|
item when creating a new item
|
table in a table field
|
default the value to be used for all contexts not explicitly
|
customized"
|
:group 'org-structure
|
:group 'org-table
|
:type '(choice
|
(const :tag "Always" t)
|
(const :tag "Never" nil)
|
(repeat :greedy t :tag "Individual contexts"
|
(cons
|
(choice :tag "Context"
|
(const headline)
|
(const item)
|
(const table)
|
(const default))
|
(boolean)))))
|
|
|
(defcustom org-insert-heading-respect-content nil
|
"Non-nil means insert new headings after the current subtree.
|
\\<org-mode-map>
|
When nil, the new heading is created directly after the current line.
|
The commands `\\[org-insert-heading-respect-content]' and \
|
`\\[org-insert-todo-heading-respect-content]' turn this variable on
|
for the duration of the command."
|
:group 'org-structure
|
:type 'boolean)
|
|
(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 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."
|
:group 'org-edit-structure
|
:type '(list
|
(cons (const heading)
|
(choice (const :tag "Never" nil)
|
(const :tag "Always" t)
|
(const :tag "Auto" auto)))
|
(cons (const plain-list-item)
|
(choice (const :tag "Never" nil)
|
(const :tag "Always" t)
|
(const :tag "Auto" auto)))))
|
|
(defcustom org-insert-heading-hook nil
|
"Hook being run after inserting a new heading."
|
:group 'org-edit-structure
|
:type 'hook)
|
|
(defcustom org-enable-fixed-width-editor t
|
"Non-nil means lines starting with \":\" are treated as fixed-width.
|
This currently only means they are never auto-wrapped.
|
When nil, such lines will be treated like ordinary lines."
|
:group 'org-edit-structure
|
:type 'boolean)
|
|
(defcustom org-goto-auto-isearch t
|
"Non-nil means typing characters in `org-goto' starts incremental search.
|
When nil, you can use these keybindings to navigate the buffer:
|
|
q Quit the org-goto interface
|
n Go to the next visible heading
|
p Go to the previous visible heading
|
f Go one heading forward on same level
|
b Go one heading backward on same level
|
u Go one heading up"
|
:group 'org-edit-structure
|
:type 'boolean)
|
|
(defgroup org-sparse-trees nil
|
"Options concerning sparse trees in Org mode."
|
:tag "Org Sparse Trees"
|
:group 'org-structure)
|
|
(defcustom org-highlight-sparse-tree-matches t
|
"Non-nil means highlight all matches that define a sparse tree.
|
The highlights will automatically disappear the next time the buffer is
|
changed by an edit command."
|
:group 'org-sparse-trees
|
:type 'boolean)
|
|
(defcustom org-remove-highlights-with-change t
|
"Non-nil means any change to the buffer will remove temporary highlights.
|
\\<org-mode-map>\
|
Such highlights are created by `org-occur' and `org-clock-display'.
|
When nil, `\\[org-ctrl-c-ctrl-c]' needs to be used \
|
to get rid of the highlights.
|
The highlights created by `org-toggle-latex-fragment' always need
|
`\\[org-toggle-latex-fragment]' to be removed."
|
:group 'org-sparse-trees
|
:group 'org-time
|
:type 'boolean)
|
|
(defcustom org-occur-case-fold-search t
|
"Non-nil means `org-occur' should be case-insensitive.
|
If set to `smart' the search will be case-insensitive only if it
|
doesn't specify any upper case character."
|
:group 'org-sparse-trees
|
:version "26.1"
|
:type '(choice
|
(const :tag "Case-sensitive" nil)
|
(const :tag "Case-insensitive" t)
|
(const :tag "Case-insensitive for lower case searches only" smart)))
|
|
(defcustom org-occur-hook '(org-first-headline-recenter)
|
"Hook that is run after `org-occur' has constructed a sparse tree.
|
This can be used to recenter the window to show as much of the structure
|
as possible."
|
:group 'org-sparse-trees
|
:type 'hook)
|
|
(defgroup org-imenu-and-speedbar nil
|
"Options concerning imenu and speedbar in Org mode."
|
:tag "Org Imenu and Speedbar"
|
:group 'org-structure)
|
|
(defcustom org-imenu-depth 2
|
"The maximum level for Imenu access to Org headlines.
|
This also applied for speedbar access."
|
:group 'org-imenu-and-speedbar
|
:type 'integer)
|
|
(defgroup org-table nil
|
"Options concerning tables in Org mode."
|
:tag "Org Table"
|
:group 'org)
|
|
(defcustom org-self-insert-cluster-for-undo nil
|
"Non-nil means cluster self-insert commands for undo when possible.
|
If this is set, then, like in the Emacs command loop, 20 consecutive
|
characters will be undone together.
|
This is configurable, because there is some impact on typing performance."
|
:group 'org-table
|
:type 'boolean)
|
|
(defcustom org-table-tab-recognizes-table.el t
|
"Non-nil means TAB will automatically notice a table.el table.
|
When it sees such a table, it moves point into it and - if necessary -
|
calls `table-recognize-table'."
|
:group 'org-table-editing
|
:type 'boolean)
|
|
(defgroup org-link nil
|
"Options concerning links in Org mode."
|
:tag "Org Link"
|
:group 'org)
|
|
(defvar-local org-link-abbrev-alist-local nil
|
"Buffer-local version of `org-link-abbrev-alist', which see.
|
The value of this is taken from the #+LINK lines.")
|
|
(defcustom org-link-parameters
|
'(("doi" :follow org--open-doi-link)
|
("elisp" :follow org--open-elisp-link)
|
("file" :complete org-file-complete-link)
|
("ftp" :follow (lambda (path) (browse-url (concat "ftp:" path))))
|
("help" :follow org--open-help-link)
|
("http" :follow (lambda (path) (browse-url (concat "http:" path))))
|
("https" :follow (lambda (path) (browse-url (concat "https:" path))))
|
("mailto" :follow (lambda (path) (browse-url (concat "mailto:" path))))
|
("news" :follow (lambda (path) (browse-url (concat "news:" path))))
|
("shell" :follow org--open-shell-link))
|
"An alist of properties that defines all the links in Org mode.
|
The key in each association is a string of the link type.
|
Subsequent optional elements make up a p-list of link properties.
|
|
:follow - A function that takes the link path as an argument.
|
|
:export - A function that takes the link path, description and
|
export-backend as arguments.
|
|
:store - A function responsible for storing the link. See the
|
function `org-store-link-functions'.
|
|
:complete - A function that inserts a link with completion. The
|
function takes one optional prefix arg.
|
|
:face - A face for the link, or a function that returns a face.
|
The function takes one argument which is the link path. The
|
default face is `org-link'.
|
|
:mouse-face - The mouse-face. The default is `highlight'.
|
|
:display - `full' will not fold the link in descriptive
|
display. Default is `org-link'.
|
|
:help-echo - A string or function that takes (window object position)
|
as arguments and returns a string.
|
|
:keymap - A keymap that is active on the link. The default is
|
`org-mouse-map'.
|
|
:htmlize-link - A function for the htmlize-link. Defaults
|
to (list :uri \"type:path\")
|
|
:activate-func - A function to run at the end of font-lock
|
activation. The function must accept (link-start link-end path bracketp)
|
as arguments."
|
:group 'org-link
|
:type '(alist :tag "Link display parameters"
|
:value-type plist)
|
:version "26.1"
|
:package-version '(Org . "9.1"))
|
|
(defun org-link-get-parameter (type key)
|
"Get TYPE link property for KEY.
|
TYPE is a string and KEY is a plist keyword."
|
(plist-get
|
(cdr (assoc type org-link-parameters))
|
key))
|
|
(defun org-link-set-parameters (type &rest parameters)
|
"Set link TYPE properties to PARAMETERS.
|
PARAMETERS should be :key val pairs."
|
(let ((data (assoc type org-link-parameters)))
|
(if data (setcdr data (org-combine-plists (cdr data) parameters))
|
(push (cons type parameters) org-link-parameters)
|
(org-make-link-regexps)
|
(org-element-update-syntax))))
|
|
(defun org-link-types ()
|
"Return a list of known link types."
|
(mapcar #'car org-link-parameters))
|
|
(defcustom org-link-abbrev-alist nil
|
"Alist of link abbreviations.
|
The car of each element is a string, to be replaced at the start of a link.
|
The cdrs are replacement values, like (\"linkkey\" . REPLACE). Abbreviated
|
links in Org buffers can have an optional tag after a double colon, e.g.,
|
|
[[linkkey:tag][description]]
|
|
The `linkkey' must be a single word, starting with a letter, followed
|
by letters, numbers, `-' or `_'.
|
|
If REPLACE is a string, the tag will simply be appended to create the link.
|
If the string contains \"%s\", the tag will be inserted there. If the string
|
contains \"%h\", it will cause a url-encoded version of the tag to be inserted
|
at that point (see the function `url-hexify-string'). If the string contains
|
the specifier \"%(my-function)\", then the custom function `my-function' will
|
be invoked: this function takes the tag as its only argument and must return
|
a string.
|
|
REPLACE may also be a function that will be called with the tag as the
|
only argument to create the link, which should be returned as a string.
|
|
See the manual for examples."
|
:group 'org-link
|
:type '(repeat
|
(cons
|
(string :tag "Protocol")
|
(choice
|
(string :tag "Format")
|
(function)))))
|
|
(defcustom org-descriptive-links t
|
"Non-nil means Org will display descriptive links.
|
E.g. [[https://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)
|
|
(defcustom org-link-file-path-type 'adaptive
|
"How the path name in file links should be stored.
|
Valid values are:
|
|
relative Relative to the current directory, i.e. the directory of the file
|
into which the link is being inserted.
|
absolute Absolute path, if possible with ~ for home directory.
|
noabbrev Absolute path, no abbreviation of home directory.
|
adaptive Use relative path for files in the current directory and sub-
|
directories of it. For other files, use an absolute path."
|
:group 'org-link
|
:type '(choice
|
(const relative)
|
(const absolute)
|
(const noabbrev)
|
(const adaptive)))
|
|
(defvaralias 'org-activate-links 'org-highlight-links)
|
(defcustom org-highlight-links '(bracket angle plain radio tag date footnote)
|
"Types of links that should be highlighted in Org files.
|
|
This is a list of symbols, each one of them leading to the
|
highlighting of a certain link type.
|
|
You can still open links that are not highlighted.
|
|
In principle, it does not hurt to turn on highlighting for all
|
link types. There may be a small gain when turning off unused
|
link types. The types are:
|
|
bracket The recommended [[link][description]] or [[link]] links with hiding.
|
angle Links in angular brackets that may contain whitespace like
|
<bbdb:Carsten Dominik>.
|
plain Plain links in normal text, no whitespace, like http://google.com.
|
radio Text that is matched by a radio target, see manual for details.
|
tag Tag settings in a headline (link to tag search).
|
date Time stamps (link to calendar).
|
footnote Footnote labels.
|
|
If you set this variable during an Emacs session, use `org-mode-restart'
|
in the Org buffer so that the change takes effect."
|
:group 'org-link
|
:group 'org-appearance
|
:type '(set :greedy t
|
(const :tag "Double bracket links" bracket)
|
(const :tag "Angular bracket links" angle)
|
(const :tag "Plain text links" plain)
|
(const :tag "Radio target matches" radio)
|
(const :tag "Tags" tag)
|
(const :tag "Timestamps" date)
|
(const :tag "Footnotes" footnote)))
|
|
(defcustom org-make-link-description-function nil
|
"Function to use for generating link descriptions from links.
|
This function must take two parameters: the first one is the
|
link, the second one is the description generated by
|
`org-insert-link'. The function should return the description to
|
use."
|
:group 'org-link
|
:type '(choice (const nil) (function)))
|
|
(defgroup org-link-store nil
|
"Options concerning storing links in Org mode."
|
:tag "Org Store Link"
|
:group 'org-link)
|
|
(defcustom org-url-hexify-p t
|
"When non-nil, hexify URL when creating a link."
|
:type 'boolean
|
:version "24.3"
|
:group 'org-link-store)
|
|
(defcustom org-email-link-description-format "Email %c: %.30s"
|
"Format of the description part of a link to an email or usenet message.
|
The following %-escapes will be replaced by corresponding information:
|
|
%F full \"From\" field
|
%f name, taken from \"From\" field, address if no name
|
%T full \"To\" field
|
%t first name in \"To\" field, address if no name
|
%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.
|
This is for example useful to limit the length of the subject.
|
|
Examples: \"%f on: %.30s\", \"Email from %f\", \"Email %c\""
|
:group 'org-link-store
|
:type 'string)
|
|
(defcustom org-from-is-user-regexp
|
(let (r1 r2)
|
(when (and user-mail-address (not (string= user-mail-address "")))
|
(setq r1 (concat "\\<" (regexp-quote user-mail-address) "\\>")))
|
(when (and user-full-name (not (string= user-full-name "")))
|
(setq r2 (concat "\\<" (regexp-quote user-full-name) "\\>")))
|
(if (and r1 r2) (concat r1 "\\|" r2) (or r1 r2)))
|
"Regexp matched against the \"From:\" header of an email or usenet message.
|
It should match if the message is from the user him/herself."
|
:group 'org-link-store
|
:type 'regexp)
|
|
(defcustom org-context-in-file-links t
|
"Non-nil means file links from `org-store-link' contain context.
|
\\<org-mode-map>
|
A search string will be added to the file name with :: as separator
|
and used to find the context when the link is activated by the command
|
`org-open-at-point'. When this option is t, the entire active region
|
will be placed in the search string of the file link. If set to a
|
positive integer, only the first n lines of context will be stored.
|
|
Using a prefix arg to the command `org-store-link' (`\\[universal-argument] \
|
\\[org-store-link]')
|
negates this setting for the duration of the command."
|
:group 'org-link-store
|
:type '(choice boolean integer))
|
|
(defcustom org-keep-stored-link-after-insertion nil
|
"Non-nil means keep link in list for entire session.
|
\\<org-mode-map>
|
The command `org-store-link' adds a link pointing to the current
|
location to an internal list. These links accumulate during a session.
|
The command `org-insert-link' can be used to insert links into any
|
Org file (offering completion for all stored links).
|
|
When this option is nil, every link which has been inserted once using
|
`\\[org-insert-link]' will be removed from the list, to make completing the \
|
unused
|
links more efficient."
|
:group 'org-link-store
|
:type 'boolean)
|
|
(defgroup org-link-follow nil
|
"Options concerning following links in Org mode."
|
:tag "Org Follow Link"
|
:group 'org-link)
|
|
(defcustom org-link-translation-function nil
|
"Function to translate links with different syntax to Org syntax.
|
This can be used to translate links created for example by the Planner
|
or emacs-wiki packages to Org syntax.
|
The function must accept two parameters, a TYPE containing the link
|
protocol name like \"rmail\" or \"gnus\" as a string, and the linked path,
|
which is everything after the link protocol. It should return a cons
|
with possibly modified values of type and path.
|
Org contains a function for this, so if you set this variable to
|
`org-translate-link-from-planner', you should be able follow many
|
links created by planner."
|
:group 'org-link-follow
|
:type '(choice (const nil) (function)))
|
|
(defcustom org-follow-link-hook nil
|
"Hook that is run after a link has been followed."
|
:group 'org-link-follow
|
:type 'hook)
|
|
(defcustom org-tab-follows-link nil
|
"Non-nil means on links TAB will follow the link.
|
Needs to be set before org.el is loaded.
|
This really should not be used, it does not make sense, and the
|
implementation is bad."
|
:group 'org-link-follow
|
:type 'boolean)
|
|
(defcustom org-return-follows-link nil
|
"Non-nil means on links RET will follow the link.
|
In tables, the special behavior of RET has precedence."
|
:group 'org-link-follow
|
:type 'boolean)
|
|
(defcustom org-mouse-1-follows-link
|
(if (boundp 'mouse-1-click-follows-link) mouse-1-click-follows-link t)
|
"Non-nil means mouse-1 on a link will follow the link.
|
A longer mouse click will still set point. Needs to be set
|
before org.el is loaded."
|
:group 'org-link-follow
|
:version "26.1"
|
:package-version '(Org . "8.3")
|
:type '(choice
|
(const :tag "A double click follows the link" double)
|
(const :tag "Unconditionally follow the link with mouse-1" t)
|
(integer :tag "mouse-1 click does not follow the link if longer than N ms" 450)))
|
|
(defcustom org-mark-ring-length 4
|
"Number of different positions to be recorded in the ring.
|
Changing this requires a restart of Emacs to work correctly."
|
:group 'org-link-follow
|
:type 'integer)
|
|
(defcustom org-link-search-must-match-exact-headline 'query-to-create
|
"Non-nil means internal fuzzy links can only match headlines.
|
|
When nil, the a fuzzy link may point to a target or a named
|
construct in the document. When set to the special value
|
`query-to-create', offer to create a new headline when none
|
matched.
|
|
Spaces and statistics cookies are ignored during heading searches."
|
:group 'org-link-follow
|
:version "24.1"
|
:type '(choice
|
(const :tag "Use fuzzy text search" nil)
|
(const :tag "Match only exact headline" t)
|
(const :tag "Match exact headline or query to create it"
|
query-to-create))
|
:safe #'symbolp)
|
|
(defcustom org-link-frame-setup
|
'((vm . vm-visit-folder-other-frame)
|
(vm-imap . vm-visit-imap-folder-other-frame)
|
(gnus . org-gnus-no-new-news)
|
(file . find-file-other-window)
|
(wl . wl-other-frame))
|
"Setup the frame configuration for following links.
|
When following a link with Emacs, it may often be useful to display
|
this link in another window or frame. This variable can be used to
|
set this up for the different types of links.
|
For VM, use any of
|
`vm-visit-folder'
|
`vm-visit-folder-other-window'
|
`vm-visit-folder-other-frame'
|
For Gnus, use any of
|
`gnus'
|
`gnus-other-frame'
|
`org-gnus-no-new-news'
|
For FILE, use any of
|
`find-file'
|
`find-file-other-window'
|
`find-file-other-frame'
|
For Wanderlust use any of
|
`wl'
|
`wl-other-frame'
|
For the calendar, use the variable `calendar-setup'.
|
For BBDB, it is currently only possible to display the matches in
|
another window."
|
:group 'org-link-follow
|
:type '(list
|
(cons (const vm)
|
(choice
|
(const vm-visit-folder)
|
(const vm-visit-folder-other-window)
|
(const vm-visit-folder-other-frame)))
|
(cons (const vm-imap)
|
(choice
|
(const vm-visit-imap-folder)
|
(const vm-visit-imap-folder-other-window)
|
(const vm-visit-imap-folder-other-frame)))
|
(cons (const gnus)
|
(choice
|
(const gnus)
|
(const gnus-other-frame)
|
(const org-gnus-no-new-news)))
|
(cons (const file)
|
(choice
|
(const find-file)
|
(const find-file-other-window)
|
(const find-file-other-frame)))
|
(cons (const wl)
|
(choice
|
(const wl)
|
(const wl-other-frame)))))
|
|
(defcustom org-display-internal-link-with-indirect-buffer nil
|
"Non-nil means use indirect buffer to display infile links.
|
Activating internal links (from one location in a file to another location
|
in the same file) normally just jumps to the location. When the link is
|
activated with a `\\[universal-argument]' prefix (or with mouse-3), the link \
|
is displayed in
|
another window. When this option is set, the other window actually displays
|
an indirect buffer clone of the current buffer, to avoid any visibility
|
changes to the current buffer."
|
:group 'org-link-follow
|
:type 'boolean)
|
|
(defcustom org-open-non-existing-files nil
|
"Non-nil means `org-open-file' will open non-existing files.
|
When nil, an error will be generated.
|
This variable applies only to external applications because they
|
might choke on non-existing files. If the link is to a file that
|
will be opened in Emacs, the variable is ignored."
|
:group 'org-link-follow
|
:type 'boolean)
|
|
(defcustom org-open-directory-means-index-dot-org nil
|
"Non-nil means a link to a directory really means to index.org.
|
When nil, following a directory link will run dired or open a finder/explorer
|
window on that directory."
|
:group 'org-link-follow
|
:type 'boolean)
|
|
(defcustom org-confirm-shell-link-function 'yes-or-no-p
|
"Non-nil means ask for confirmation before executing shell links.
|
Shell links can be dangerous: just think about a link
|
|
[[shell:rm -rf ~/*][Google Search]]
|
|
This link would show up in your Org document as \"Google Search\",
|
but really it would remove your entire home directory.
|
Therefore we advise against setting this variable to nil.
|
Just change it to `y-or-n-p' if you want to confirm with a
|
single keystroke rather than having to type \"yes\"."
|
:group 'org-link-follow
|
:type '(choice
|
(const :tag "with yes-or-no (safer)" yes-or-no-p)
|
(const :tag "with y-or-n (faster)" y-or-n-p)
|
(const :tag "no confirmation (dangerous)" nil)))
|
(put 'org-confirm-shell-link-function
|
'safe-local-variable
|
(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.
|
Elisp links can be dangerous: just think about a link
|
|
[[elisp:(shell-command \"rm -rf ~/*\")][Google Search]]
|
|
This link would show up in your Org document as \"Google Search\",
|
but really it would remove your entire home directory.
|
Therefore we advise against setting this variable to nil.
|
Just change it to `y-or-n-p' if you want to confirm with a
|
single keystroke rather than having to type \"yes\"."
|
:group 'org-link-follow
|
:type '(choice
|
(const :tag "with yes-or-no (safer)" yes-or-no-p)
|
(const :tag "with y-or-n (faster)" y-or-n-p)
|
(const :tag "no confirmation (dangerous)" nil)))
|
(put 'org-confirm-shell-link-function
|
'safe-local-variable
|
(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)
|
(system . mailcap)
|
(t . mailcap))
|
"Default file applications on a UNIX or GNU/Linux system.
|
See `org-file-apps'.")
|
|
(defconst org-file-apps-defaults-macosx
|
'((remote . emacs)
|
(system . "open %s")
|
("ps.gz" . "gv %s")
|
("eps.gz" . "gv %s")
|
("dvi" . "xdvi %s")
|
("fig" . "xfig %s")
|
(t . "open %s"))
|
"Default file applications on a macOS system.
|
The system \"open\" is known as a default, but we use X11 applications
|
for some files for which the OS does not have a good default.
|
See `org-file-apps'.")
|
|
(defconst org-file-apps-defaults-windowsnt
|
(list '(remote . emacs)
|
(cons 'system (lambda (file _path)
|
(with-no-warnings (w32-shell-execute "open" file))))
|
(cons t (lambda (file _path)
|
(with-no-warnings (w32-shell-execute "open" file)))))
|
"Default file applications on a Windows NT system.
|
The system \"open\" is used for most files.
|
See `org-file-apps'.")
|
|
(defcustom org-file-apps
|
'((auto-mode . emacs)
|
("\\.mm\\'" . default)
|
("\\.x?html?\\'" . default)
|
("\\.pdf\\'" . default))
|
"External applications for opening `file:path' items in a document.
|
\\<org-mode-map>\
|
|
Org mode uses system defaults for different file types, but
|
you can use this variable to set the application for a given file
|
extension. The entries in this list are cons cells where the car identifies
|
files and the cdr the corresponding command.
|
|
Possible values for the file identifier are:
|
|
\"string\" A string as a file identifier can be interpreted in different
|
ways, depending on its contents:
|
|
- Alphanumeric characters only:
|
Match links with this file extension.
|
Example: (\"pdf\" . \"evince %s\")
|
to open PDFs with evince.
|
|
- Regular expression: Match links where the
|
filename matches the regexp. If you want to
|
use groups here, use shy groups.
|
|
Example: (\"\\\\.x?html\\\\\\='\" . \"firefox %s\")
|
(\"\\\\(?:xhtml\\\\|html\\\\)\\\\\\='\" . \"firefox %s\")
|
to open *.html and *.xhtml with firefox.
|
|
- Regular expression which contains (non-shy) groups:
|
Match links where the whole link, including \"::\", and
|
anything after that, matches the regexp.
|
In a custom command string, %1, %2, etc. are replaced with
|
the parts of the link that were matched by the groups.
|
For backwards compatibility, if a command string is given
|
that does not use any of the group matches, this case is
|
handled identically to the second one (i.e. match against
|
file name only).
|
In a custom function, you can access the group matches with
|
(match-string n link).
|
|
Example: (\"\\\\.pdf::\\\\([0-9]+\\\\)\\\\\\='\" . \
|
\"evince -p %1 %s\")
|
to open [[file:document.pdf::5]] with evince at page 5.
|
|
`directory' Matches a directory
|
`remote' Matches a remote file, accessible through tramp or efs.
|
Remote files most likely should be visited through Emacs
|
because external applications cannot handle such paths.
|
`auto-mode' Matches files that are matched by any entry in `auto-mode-alist',
|
so all files Emacs knows how to handle. Using this with
|
command `emacs' will open most files in Emacs. Beware that this
|
will also open html files inside Emacs, unless you add
|
(\"html\" . default) to the list as well.
|
`system' The system command to open files, like `open' on Windows
|
and macOS, and mailcap under GNU/Linux. This is the command
|
that will be selected if you call `org-open-at-point' with a
|
double prefix argument (`\\[universal-argument] \
|
\\[universal-argument] \\[org-open-at-point]').
|
t Default for files not matched by any of the other options.
|
|
Possible values for the command are:
|
|
`emacs' The file will be visited by the current Emacs process.
|
`default' Use the default application for this file type, which is the
|
association for t in the list, most likely in the system-specific
|
part. This can be used to overrule an unwanted setting in the
|
system-specific variable.
|
`system' Use the system command for opening files, like \"open\".
|
This command is specified by the entry whose car is `system'.
|
Most likely, the system-specific version of this variable
|
does define this command, but you can overrule/replace it
|
here.
|
`mailcap' Use command specified in the mailcaps.
|
string A command to be executed by a shell; %s will be replaced
|
by the path to the file.
|
function A Lisp function, which will be called with two arguments:
|
the file path and the original link string, without the
|
\"file:\" prefix.
|
|
For more examples, see the system specific constants
|
`org-file-apps-defaults-macosx'
|
`org-file-apps-defaults-windowsnt'
|
`org-file-apps-defaults-gnu'."
|
:group 'org-link-follow
|
:type '(repeat
|
(cons (choice :value ""
|
(string :tag "Extension")
|
(const :tag "System command to open files" system)
|
(const :tag "Default for unrecognized files" t)
|
(const :tag "Remote file" remote)
|
(const :tag "Links to a directory" directory)
|
(const :tag "Any files that have Emacs modes"
|
auto-mode))
|
(choice :value ""
|
(const :tag "Visit with Emacs" emacs)
|
(const :tag "Use default" default)
|
(const :tag "Use the system command" system)
|
(string :tag "Command")
|
(function :tag "Function")))))
|
|
(defcustom org-doi-server-url "http://dx.doi.org/"
|
"The URL of the DOI server."
|
:type 'string
|
:version "24.3"
|
:group 'org-link-follow)
|
|
(defgroup org-refile nil
|
"Options concerning refiling entries in Org mode."
|
:tag "Org Refile"
|
:group 'org)
|
|
(defcustom org-directory "~/org"
|
"Directory with Org files.
|
This is just a default location to look for Org files. There is no need
|
at all to put your files into this directory. It is used in the
|
following situations:
|
|
1. When a capture template specifies a target file that is not an
|
absolute path. The path will then be interpreted relative to
|
`org-directory'
|
2. When the value of variable `org-agenda-files' is a single file, any
|
relative paths in this file will be taken as relative to
|
`org-directory'."
|
:group 'org-refile
|
:group 'org-capture
|
:type 'directory)
|
|
(defcustom org-default-notes-file (convert-standard-filename "~/.notes")
|
"Default target for storing notes.
|
Used as a fall back file for org-capture.el, for templates that
|
do not specify a target file."
|
:group 'org-refile
|
:group 'org-capture
|
:type 'file)
|
|
(defcustom org-goto-interface 'outline
|
"The default interface to be used for `org-goto'.
|
Allowed values are:
|
outline The interface shows an outline of the relevant file
|
and the correct heading is found by moving through
|
the outline or by searching with incremental search.
|
outline-path-completion Headlines in the current buffer are offered via
|
completion. This is the interface also used by
|
the refile command."
|
:group 'org-refile
|
:type '(choice
|
(const :tag "Outline" outline)
|
(const :tag "Outline-path-completion" outline-path-completion)))
|
|
(defcustom org-goto-max-level 5
|
"Maximum target level when running `org-goto' with refile interface."
|
:group 'org-refile
|
:type 'integer)
|
|
(defcustom org-reverse-note-order nil
|
"Non-nil means store new notes at the beginning of a file or entry.
|
When nil, new notes will be filed to the end of a file or entry.
|
This can also be a list with cons cells of regular expressions that
|
are matched against file names, and values."
|
:group 'org-capture
|
:group 'org-refile
|
:type '(choice
|
(const :tag "Reverse always" t)
|
(const :tag "Reverse never" nil)
|
(repeat :tag "By file name regexp"
|
(cons regexp boolean))))
|
|
(defcustom org-log-refile nil
|
"Information to record when a task is refiled.
|
|
Possible values are:
|
|
nil Don't add anything
|
time Add a time stamp to the task
|
note Prompt for a note and add it with template `org-log-note-headings'
|
|
This option can also be set with on a per-file-basis with
|
|
#+STARTUP: nologrefile
|
#+STARTUP: logrefile
|
#+STARTUP: lognoterefile
|
|
You can have local logging settings for a subtree by setting the LOGGING
|
property to one or more of these keywords.
|
|
When bulk-refiling from the agenda, the value `note' is forbidden and
|
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)
|
(const :tag "Record timestamp with note." note)))
|
|
(defcustom org-refile-targets nil
|
"Targets for refiling entries with `\\[org-refile]'.
|
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
|
that, all agenda files will be scanned for targets. Nil means consider
|
headings in the current buffer.
|
- A specification of how to find candidate refile targets. This may be
|
any of:
|
- a cons cell (:tag . \"TAG\") to identify refile targets by a tag.
|
This tag has to be present in all target headlines, inheritance will
|
not be considered.
|
- a cons cell (:todo . \"KEYWORD\") to identify refile targets by
|
todo keyword.
|
- a cons cell (:regexp . \"REGEXP\") with a regular expression matching
|
headlines that are refiling targets.
|
- a cons cell (:level . N). Any headline of level N is considered a target.
|
Note that, when `org-odd-levels-only' is set, level corresponds to
|
order in hierarchy, not to the number of stars.
|
- a cons cell (:maxlevel . N). Any headline with level <= N is a target.
|
Note that, when `org-odd-levels-only' is set, level corresponds to
|
order in hierarchy, not to the number of stars.
|
|
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.
|
|
When this variable is nil, all top-level headlines in the current buffer
|
are used, equivalent to the value `((nil . (:level . 1))'."
|
:group 'org-refile
|
:type '(repeat
|
(cons
|
(choice :value org-agenda-files
|
(const :tag "All agenda files" org-agenda-files)
|
(const :tag "Current buffer" nil)
|
(function) (variable) (file))
|
(choice :tag "Identify target headline by"
|
(cons :tag "Specific tag" (const :value :tag) (string))
|
(cons :tag "TODO keyword" (const :value :todo) (string))
|
(cons :tag "Regular expression" (const :value :regexp) (regexp))
|
(cons :tag "Level number" (const :value :level) (integer))
|
(cons :tag "Max Level number" (const :value :maxlevel) (integer))))))
|
|
(defcustom org-refile-target-verify-function nil
|
"Function to verify if the headline at point should be a refile target.
|
The function will be called without arguments, with point at the
|
beginning of the headline. It should return t and leave point
|
where it is if the headline is a valid target for refiling.
|
|
If the target should not be selected, the function must return nil.
|
In addition to this, it may move point to a place from where the search
|
should be continued. For example, the function may decide that the entire
|
subtree of the current entry should be excluded and move point to the end
|
of the subtree."
|
:group 'org-refile
|
:type '(choice
|
(const nil)
|
(function)))
|
|
(defcustom org-refile-use-cache nil
|
"Non-nil means cache refile targets to speed up the process.
|
\\<org-mode-map>\
|
The cache for a particular file will be updated automatically when
|
the buffer has been killed, or when any of the marker used for flagging
|
refile targets no longer points at a live buffer.
|
If you have added new entries to a buffer that might themselves be targets,
|
you need to clear the cache manually by pressing `C-0 \\[org-refile]' or,
|
if you find that easier, \
|
`\\[universal-argument] \\[universal-argument] \\[universal-argument] \
|
\\[org-refile]'."
|
:group 'org-refile
|
:version "24.1"
|
:type 'boolean)
|
|
(defcustom org-refile-use-outline-path nil
|
"Non-nil means provide refile targets as paths.
|
So a level 3 headline will be available as level1/level2/level3.
|
|
When the value is `file', also include the file name (without directory)
|
into the path. 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 `buffer-name', use the buffer name."
|
:group 'org-refile
|
:type '(choice
|
(const :tag "Not" nil)
|
(const :tag "Yes" t)
|
(const :tag "Start with file name" file)
|
(const :tag "Start with full file path" full-file-path)
|
(const :tag "Start with buffer name" buffer-name)))
|
|
(defcustom org-outline-path-complete-in-steps t
|
"Non-nil means complete the outline path in hierarchical steps.
|
When Org uses the refile interface to select an outline path (see
|
`org-refile-use-outline-path'), the completion of the path can be
|
done in a single go, or it can be done in steps down the headline
|
hierarchy. Going in steps is probably the best if you do not use
|
a special completion package like `ido' or `icicles'. However,
|
when using these packages, going in one step can be very fast,
|
while still showing the whole path to the entry."
|
:group 'org-refile
|
:type 'boolean)
|
|
(defcustom org-refile-allow-creating-parent-nodes nil
|
"Non-nil means allow the creation of new nodes as refile targets.
|
New nodes are then created by adding \"/new node name\" to the completion
|
of an existing node. When the value of this variable is `confirm',
|
new node creation must be confirmed by the user (recommended).
|
When nil, the completion must match an existing entry.
|
|
Note that, if the new heading is not seen by the criteria
|
listed in `org-refile-targets', multiple instances of the same
|
heading would be created by trying again to file under the new
|
heading."
|
:group 'org-refile
|
:type '(choice
|
(const :tag "Never" nil)
|
(const :tag "Always" t)
|
(const :tag "Prompt for confirmation" confirm)))
|
|
(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)
|
|
(defgroup org-progress nil
|
"Options concerning Progress logging in Org mode."
|
:tag "Org Progress"
|
:group 'org-time)
|
|
(defvar org-todo-interpretation-widgets
|
'((:tag "Sequence (cycling hits every state)" sequence)
|
(:tag "Type (cycling directly to DONE)" type))
|
"The available interpretation symbols for customizing `org-todo-keywords'.
|
Interested libraries should add to this list.")
|
|
(defcustom org-todo-keywords '((sequence "TODO" "DONE"))
|
"List of TODO entry keyword sequences and their interpretation.
|
\\<org-mode-map>This is a list of sequences.
|
|
Each sequence starts with a symbol, either `sequence' or `type',
|
indicating if the keywords should be interpreted as a sequence of
|
action steps, or as different types of TODO items. The first
|
keywords are states requiring action - these states will select a headline
|
for inclusion into the global TODO list Org produces. If one of the
|
\"keywords\" is the vertical bar, \"|\", the remaining keywords
|
signify that no further action is necessary. If \"|\" is not found,
|
the last keyword is treated as the only DONE state of the sequence.
|
|
The command `\\[org-todo]' cycles an entry through these states, and one
|
additional state where no keyword is present. For details about this
|
cycling, see the manual.
|
|
TODO keywords and interpretation can also be set on a per-file basis with
|
the special #+SEQ_TODO and #+TYP_TODO lines.
|
|
Each keyword can optionally specify a character for fast state selection
|
\(in combination with the variable `org-use-fast-todo-selection')
|
and specifiers for state change logging, using the same syntax that
|
is used in the \"#+TODO:\" lines. For example, \"WAIT(w)\" says that
|
the WAIT state can be selected with the \"w\" key. \"WAIT(w!)\"
|
indicates to record a time stamp each time this state is selected.
|
|
Each keyword may also specify if a timestamp or a note should be
|
recorded when entering or leaving the state, by adding additional
|
characters in the parenthesis after the keyword. This looks like this:
|
\"WAIT(w@/!)\". \"@\" means to add a note (with time), \"!\" means to
|
record only the time of the state change. With X and Y being either
|
\"@\" or \"!\", \"X/Y\" means use X when entering the state, and use
|
Y when leaving the state if and only if the *target* state does not
|
define X. You may omit any of the fast-selection key or X or /Y,
|
so WAIT(w@), WAIT(w/@) and WAIT(@/@) are all valid.
|
|
For backward compatibility, this variable may also be just a list
|
of keywords. In this case the interpretation (sequence or type) will be
|
taken from the (otherwise obsolete) variable `org-todo-interpretation'."
|
:group 'org-todo
|
:group 'org-keywords
|
:type '(choice
|
(repeat :tag "Old syntax, just keywords"
|
(string :tag "Keyword"))
|
(repeat :tag "New syntax"
|
(cons
|
(choice
|
:tag "Interpretation"
|
;;Quick and dirty way to see
|
;;`org-todo-interpretations'. This takes the
|
;;place of item arguments
|
:convert-widget
|
(lambda (widget)
|
(widget-put widget
|
:args (mapcar
|
(lambda (x)
|
(widget-convert
|
(cons 'const x)))
|
org-todo-interpretation-widgets))
|
widget))
|
(repeat
|
(string :tag "Keyword"))))))
|
|
(defvar-local org-todo-keywords-1 nil
|
"All TODO and DONE keywords active in a buffer.")
|
(defvar org-todo-keywords-for-agenda nil)
|
(defvar org-done-keywords-for-agenda nil)
|
(defvar org-todo-keyword-alist-for-agenda nil)
|
(defvar org-tag-alist-for-agenda nil
|
"Alist of all tags from all agenda files.")
|
(defvar org-tag-groups-alist-for-agenda nil
|
"Alist of all groups tags from all current agenda files.")
|
(defvar-local org-tag-groups-alist nil)
|
(defvar org-agenda-contributing-files nil)
|
(defvar-local org-current-tag-alist nil
|
"Alist of all tag groups in current buffer.
|
This variable takes into consideration `org-tag-alist',
|
`org-tag-persistent-alist' and TAGS keywords in the buffer.")
|
(defvar-local org-not-done-keywords nil)
|
(defvar-local org-done-keywords nil)
|
(defvar-local org-todo-heads nil)
|
(defvar-local org-todo-sets nil)
|
(defvar-local org-todo-log-states nil)
|
(defvar-local org-todo-kwd-alist nil)
|
(defvar-local org-todo-key-alist nil)
|
(defvar-local org-todo-key-trigger nil)
|
|
(defcustom org-todo-interpretation 'sequence
|
"Controls how TODO keywords are interpreted.
|
This variable is in principle obsolete and is only used for
|
backward compatibility, if the interpretation of todo keywords is
|
not given already in `org-todo-keywords'. See that variable for
|
more information."
|
:group 'org-todo
|
:group 'org-keywords
|
:type '(choice (const sequence)
|
(const type)))
|
|
(defcustom org-use-fast-todo-selection t
|
"\\<org-mode-map>\
|
Non-nil means use the fast todo selection scheme with `\\[org-todo]'.
|
This variable describes if and under what circumstances the cycling
|
mechanism for TODO keywords will be replaced by a single-key, direct
|
selection scheme.
|
|
When nil, fast selection is never used.
|
|
When the symbol `prefix', it will be used when `org-todo' is called
|
with a prefix argument, i.e. `\\[universal-argument] \\[org-todo]' \
|
in an Org buffer, and
|
`\\[universal-argument] t' in an agenda buffer.
|
|
When t, fast selection is used by default. In this case, the prefix
|
argument forces cycling instead.
|
|
In all cases, the special interface is only used if access keys have
|
actually been assigned by the user, i.e. if keywords in the configuration
|
are followed by a letter in parenthesis, like TODO(t)."
|
:group 'org-todo
|
:type '(choice
|
(const :tag "Never" nil)
|
(const :tag "By default" t)
|
(const :tag "Only with C-u C-c C-t" prefix)))
|
|
(defcustom org-provide-todo-statistics t
|
"Non-nil means update todo statistics after insert and toggle.
|
ALL-HEADLINES means update todo statistics by including headlines
|
with no TODO keyword as well, counting them as not done.
|
A list of TODO keywords means the same, but skip keywords that are
|
not in this list.
|
When set to a list of two lists, the first list contains keywords
|
to consider as TODO keywords, the second list contains keywords
|
to consider as DONE keywords.
|
|
When this is set, todo statistics is updated in the parent of the
|
current entry each time a todo state is changed."
|
:group 'org-todo
|
:type '(choice
|
(const :tag "Yes, only for TODO entries" t)
|
(const :tag "Yes, including all entries" all-headlines)
|
(repeat :tag "Yes, for TODOs in this list"
|
(string :tag "TODO keyword"))
|
(list :tag "Yes, for TODOs and DONEs in these lists"
|
(repeat (string :tag "TODO keyword"))
|
(repeat (string :tag "DONE keyword")))
|
(other :tag "No TODO statistics" nil)))
|
|
(defcustom org-hierarchical-todo-statistics t
|
"Non-nil means TODO statistics covers just direct children.
|
When nil, all entries in the subtree are considered.
|
This has only an effect if `org-provide-todo-statistics' is set.
|
To set this to nil for only a single subtree, use a COOKIE_DATA
|
property and include the word \"recursive\" into the value."
|
:group 'org-todo
|
:type 'boolean)
|
|
(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 `org-state'."
|
:group 'org-todo
|
:type 'hook)
|
|
(defvar org-blocker-hook nil
|
"Hook for functions that are allowed to block a state change.
|
|
Functions in this hook should not modify the buffer.
|
Each function gets as its single argument a property list,
|
see `org-trigger-hook' for more information about this list.
|
|
If any of the functions in this hook returns nil, the state change
|
is blocked.")
|
|
(defvar org-trigger-hook nil
|
"Hook for functions that are triggered by a state change.
|
|
Each function gets as its single argument a property list with at
|
least the following elements:
|
|
(:type type-of-change :position pos-at-entry-start
|
:from old-state :to new-state)
|
|
Depending on the type, more properties may be present.
|
|
This mechanism is currently implemented for:
|
|
TODO state changes
|
------------------
|
:type todo-state-change
|
:from previous state (keyword as a string), or nil, or a symbol
|
`todo' or `done', to indicate the general type of state.
|
:to new state, like in :from")
|
|
(defcustom org-enforce-todo-dependencies nil
|
"Non-nil means undone TODO entries will block switching the parent to DONE.
|
Also, if a parent has an :ORDERED: property, switching an entry to DONE will
|
be blocked if any prior sibling is not yet done.
|
Finally, if the parent is blocked because of ordered siblings of its own,
|
the child will also be blocked."
|
:set (lambda (var val)
|
(set var val)
|
(if val
|
(add-hook 'org-blocker-hook
|
'org-block-todo-from-children-or-siblings-or-parent)
|
(remove-hook 'org-blocker-hook
|
'org-block-todo-from-children-or-siblings-or-parent)))
|
:group 'org-todo
|
:type 'boolean)
|
|
(defcustom org-enforce-todo-checkbox-dependencies nil
|
"Non-nil means unchecked boxes will block switching the parent to DONE.
|
When this is nil, checkboxes have no influence on switching TODO states.
|
When non-nil, you first need to check off all check boxes before the TODO
|
entry can be switched to DONE.
|
This variable needs to be set before org.el is loaded, and you need to
|
restart Emacs after a change to make the change effective. The only way
|
to change is while Emacs is running is through the customize interface."
|
:set (lambda (var val)
|
(set var val)
|
(if val
|
(add-hook 'org-blocker-hook
|
'org-block-todo-from-checkboxes)
|
(remove-hook 'org-blocker-hook
|
'org-block-todo-from-checkboxes)))
|
:group 'org-todo
|
:type 'boolean)
|
|
(defcustom org-treat-insert-todo-heading-as-state-change nil
|
"Non-nil means inserting a TODO heading is treated as state change.
|
So when the command `\\[org-insert-todo-heading]' is used, state change
|
logging will apply if appropriate. When nil, the new TODO item will
|
be inserted directly, and no logging will take place."
|
:group 'org-todo
|
:type 'boolean)
|
|
(defcustom org-treat-S-cursor-todo-selection-as-state-change t
|
"Non-nil means switching TODO states with S-cursor counts as state change.
|
This is the default behavior. However, setting this to nil allows a
|
convenient way to select a TODO state and bypass any logging associated
|
with that."
|
:group 'org-todo
|
:type 'boolean)
|
|
(defcustom org-todo-state-tags-triggers nil
|
"Tag changes that should be triggered by TODO state changes.
|
This is a list. Each entry is
|
|
(state-change (tag . flag) .......)
|
|
State-change can be a string with a state, and empty string to indicate the
|
state that has no TODO keyword, or it can be one of the symbols `todo'
|
or `done', meaning any not-done or done state, respectively."
|
:group 'org-todo
|
:group 'org-tags
|
:type '(repeat
|
(cons (choice :tag "When changing to"
|
(const :tag "Not-done state" todo)
|
(const :tag "Done state" done)
|
(string :tag "State"))
|
(repeat
|
(cons :tag "Tag action"
|
(string :tag "Tag")
|
(choice (const :tag "Add" t) (const :tag "Remove" nil)))))))
|
|
(defcustom org-log-done nil
|
"Information to record when a task moves to the DONE state.
|
|
Possible values are:
|
|
nil Don't add anything, just change the keyword
|
time Add a time stamp to the task
|
note Prompt for a note and add it with template `org-log-note-headings'
|
|
This option can also be set with on a per-file-basis with
|
|
#+STARTUP: nologdone
|
#+STARTUP: logdone
|
#+STARTUP: lognotedone
|
|
You can have local logging settings for a subtree by setting the LOGGING
|
property to one or more of these keywords."
|
:group 'org-todo
|
:group 'org-progress
|
:type '(choice
|
(const :tag "No logging" nil)
|
(const :tag "Record CLOSED timestamp" time)
|
(const :tag "Record CLOSED timestamp with note." note)))
|
|
;; Normalize old uses of org-log-done.
|
(cond
|
((eq org-log-done t) (setq org-log-done 'time))
|
((and (listp org-log-done) (memq 'done org-log-done))
|
(setq org-log-done 'note)))
|
|
(defcustom org-log-reschedule nil
|
"Information to record when the scheduling date of a tasks is modified.
|
|
Possible values are:
|
|
nil Don't add anything, just change the date
|
time Add a time stamp to the task
|
note Prompt for a note and add it with template `org-log-note-headings'
|
|
This option can also be set with on a per-file-basis with
|
|
#+STARTUP: nologreschedule
|
#+STARTUP: logreschedule
|
#+STARTUP: lognotereschedule"
|
:group 'org-todo
|
:group 'org-progress
|
:type '(choice
|
(const :tag "No logging" nil)
|
(const :tag "Record timestamp" time)
|
(const :tag "Record timestamp with note." note)))
|
|
(defcustom org-log-redeadline nil
|
"Information to record when the deadline date of a tasks is modified.
|
|
Possible values are:
|
|
nil Don't add anything, just change the date
|
time Add a time stamp to the task
|
note Prompt for a note and add it with template `org-log-note-headings'
|
|
This option can also be set with on a per-file-basis with
|
|
#+STARTUP: nologredeadline
|
#+STARTUP: logredeadline
|
#+STARTUP: lognoteredeadline
|
|
You can have local logging settings for a subtree by setting the LOGGING
|
property to one or more of these keywords."
|
:group 'org-todo
|
:group 'org-progress
|
:type '(choice
|
(const :tag "No logging" nil)
|
(const :tag "Record timestamp" time)
|
(const :tag "Record timestamp with note." note)))
|
|
(defcustom org-log-note-clock-out nil
|
"Non-nil means record a note when clocking out of an item.
|
This can also be configured on a per-file basis by adding one of
|
the following lines anywhere in the buffer:
|
|
#+STARTUP: lognoteclock-out
|
#+STARTUP: nolognoteclock-out"
|
:group 'org-todo
|
:group 'org-progress
|
:type 'boolean)
|
|
(defcustom org-log-done-with-time t
|
"Non-nil means the CLOSED time stamp will contain date and time.
|
When nil, only the date will be recorded."
|
:group 'org-progress
|
:type 'boolean)
|
|
(defcustom org-log-note-headings
|
'((done . "CLOSING NOTE %t")
|
(state . "State %-12s from %-12S %t")
|
(note . "Note taken on %t")
|
(reschedule . "Rescheduled from %S on %t")
|
(delschedule . "Not scheduled, was %S on %t")
|
(redeadline . "New deadline from %S on %t")
|
(deldeadline . "Removed deadline, was %S on %t")
|
(refile . "Refiled on %t")
|
(clock-out . ""))
|
"Headings for notes added to entries.
|
|
The value is an alist, with the car being a symbol indicating the
|
note context, and the cdr is the heading to be used. The heading
|
may also be the empty string. The following placeholders can be
|
used:
|
|
%t a time stamp.
|
%T an active time stamp instead the default inactive one
|
%d a short-format time stamp.
|
%D an active short-format time stamp.
|
%s the new TODO state or time stamp (inactive), in double quotes.
|
%S the old TODO state or time stamp (inactive), in double quotes.
|
%u the user name.
|
%U full user name.
|
|
In fact, it is not a good idea to change the `state' entry,
|
because Agenda Log mode depends on the format of these entries."
|
:group 'org-todo
|
:group 'org-progress
|
:type '(list :greedy t
|
(cons (const :tag "Heading when closing an item" done) string)
|
(cons (const :tag
|
"Heading when changing todo state (todo sequence only)"
|
state) string)
|
(cons (const :tag "Heading when just taking a note" note) string)
|
(cons (const :tag "Heading when rescheduling" reschedule) string)
|
(cons (const :tag "Heading when an item is no longer scheduled" delschedule) string)
|
(cons (const :tag "Heading when changing deadline" redeadline) string)
|
(cons (const :tag "Heading when deleting a deadline" deldeadline) string)
|
(cons (const :tag "Heading when refiling" refile) string)
|
(cons (const :tag "Heading when clocking out" clock-out) string)))
|
|
(unless (assq 'note org-log-note-headings)
|
(push '(note . "%t") org-log-note-headings))
|
|
(defcustom org-log-into-drawer nil
|
"Non-nil means insert state change notes and time stamps into a drawer.
|
When nil, state changes notes will be inserted after the headline and
|
any scheduling and clock lines, but not inside a drawer.
|
|
The value of this variable should be the name of the drawer to use.
|
LOGBOOK is proposed 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\".
|
|
A value of t or nil can also be set with on a per-file-basis with
|
|
#+STARTUP: logdrawer
|
#+STARTUP: nologdrawer
|
|
If this variable is set, `org-log-state-notes-insert-after-drawers'
|
will be ignored.
|
|
You can set the property LOG_INTO_DRAWER to overrule this setting for
|
a subtree.
|
|
Do not check directly this variable in a Lisp program. Call
|
function `org-log-into-drawer' instead."
|
:group 'org-todo
|
:group 'org-progress
|
:type '(choice
|
(const :tag "Not into a drawer" nil)
|
(const :tag "LOGBOOK" t)
|
(string :tag "Other")))
|
|
(defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer)
|
|
(defun org-log-into-drawer ()
|
"Name of the log drawer, as a string, or nil.
|
This is the value of `org-log-into-drawer'. However, if the
|
current entry has or inherits a LOG_INTO_DRAWER property, it will
|
be used instead of the default value."
|
(let ((p (org-entry-get nil "LOG_INTO_DRAWER" 'inherit t)))
|
(cond ((equal p "nil") nil)
|
((equal p "t") "LOGBOOK")
|
((stringp p) p)
|
(p "LOGBOOK")
|
((stringp org-log-into-drawer) org-log-into-drawer)
|
(org-log-into-drawer "LOGBOOK"))))
|
|
(defcustom org-log-state-notes-insert-after-drawers nil
|
"Non-nil means insert state change notes after any drawers in entry.
|
Only the drawers that *immediately* follow the headline and the
|
deadline/scheduled line are skipped.
|
When nil, insert notes right after the heading and perhaps the line
|
with deadline/scheduling if present.
|
|
This variable will have no effect if `org-log-into-drawer' is
|
set."
|
:group 'org-todo
|
:group 'org-progress
|
:type 'boolean)
|
|
(defcustom org-log-states-order-reversed t
|
"Non-nil means the latest state note will be directly after heading.
|
When nil, the state change notes will be ordered according to time.
|
|
This option can also be set with on a per-file-basis with
|
|
#+STARTUP: logstatesreversed
|
#+STARTUP: nologstatesreversed"
|
:group 'org-todo
|
:group 'org-progress
|
:type 'boolean)
|
|
(defcustom org-todo-repeat-to-state nil
|
"The TODO state to which a repeater should return the repeating task.
|
By default this is the first task in a TODO sequence, or the previous state
|
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-log-repeat 'time
|
"Non-nil means record moving through the DONE state when triggering repeat.
|
An auto-repeating task is immediately switched back to TODO when
|
marked DONE. If you are not logging state changes (by adding \"@\"
|
or \"!\" to the TODO keyword definition), or set `org-log-done' to
|
record a closing note, there will be no record of the task moving
|
through DONE. This variable forces taking a note anyway.
|
|
nil Don't force a record
|
time Record a time stamp
|
note Prompt for a note and add it with template `org-log-note-headings'
|
|
This option can also be set with on a per-file-basis with
|
|
#+STARTUP: nologrepeat
|
#+STARTUP: logrepeat
|
#+STARTUP: lognoterepeat
|
|
You can have local logging settings for a subtree by setting the LOGGING
|
property to one or more of these keywords."
|
:group 'org-todo
|
:group 'org-progress
|
:type '(choice
|
(const :tag "Don't force a record" nil)
|
(const :tag "Force recording the DONE state" time)
|
(const :tag "Force recording a note with the DONE state" note)))
|
|
|
(defgroup org-priorities nil
|
"Priorities in Org mode."
|
:tag "Org Priorities"
|
:group 'org-todo)
|
|
(defcustom org-enable-priority-commands t
|
"Non-nil means priority commands are active.
|
When nil, these commands will be disabled, so that you never accidentally
|
set a priority."
|
:group 'org-priorities
|
:type 'boolean)
|
|
(defcustom org-highest-priority ?A
|
"The highest priority of TODO items. A character like ?A, ?B etc.
|
Must have a smaller ASCII number than `org-lowest-priority'."
|
:group 'org-priorities
|
:type 'character)
|
|
(defcustom org-lowest-priority ?C
|
"The lowest priority of TODO items. A character like ?A, ?B etc.
|
Must have a larger ASCII number than `org-highest-priority'."
|
:group 'org-priorities
|
:type 'character)
|
|
(defcustom org-default-priority ?B
|
"The default priority of TODO items.
|
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 than the default priority.
|
See also `org-default-priority'."
|
:group 'org-priorities
|
:type 'boolean)
|
|
(defcustom org-get-priority-function nil
|
"Function to extract the priority from a string.
|
The string is normally the headline. If this is nil Org computes the
|
priority from the priority cookie like [#A] in the headline. It returns
|
an integer, increasing by 1000 for each priority level.
|
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 '(choice
|
(const nil)
|
(function)))
|
|
(defgroup org-time nil
|
"Options concerning time stamps and deadlines in Org mode."
|
:tag "Org Time"
|
:group 'org)
|
|
(defcustom org-time-stamp-rounding-minutes '(0 5)
|
"Number of minutes to round time stamps to.
|
\\<org-mode-map>\
|
These are two values, the first applies when first creating a time stamp.
|
The second applies when changing it with the commands `S-up' and `S-down'.
|
When changing the time stamp, this means that it will change in steps
|
of N minutes, as given by the second value.
|
|
When a setting is 0 or 1, insert the time unmodified. Useful rounding
|
numbers should be factors of 60, so for example 5, 10, 15.
|
|
When this is larger than 1, you can still force an exact time stamp by using
|
a double prefix argument to a time stamp command like \
|
`\\[org-time-stamp]' or `\\[org-time-stamp-inactive],
|
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
|
(if (integerp (default-value var))
|
(list (default-value var) 5)
|
(default-value var)))
|
:type '(list
|
(integer :tag "when inserting times")
|
(integer :tag "when modifying times")))
|
|
;; Normalize old customizations of this variable.
|
(when (integerp org-time-stamp-rounding-minutes)
|
(setq org-time-stamp-rounding-minutes
|
(list org-time-stamp-rounding-minutes
|
org-time-stamp-rounding-minutes)))
|
|
(defcustom org-display-custom-times nil
|
"Non-nil means overlay custom formats over all time stamps.
|
The formats are defined through the variable `org-time-stamp-custom-formats'.
|
To turn this on on a per-file basis, insert anywhere in the file:
|
#+STARTUP: customtime"
|
:group 'org-time
|
:set 'set-default
|
:type 'sexp)
|
(make-variable-buffer-local 'org-display-custom-times)
|
|
(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 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."
|
:group 'org-time
|
:type 'sexp)
|
|
(defun org-time-stamp-format (&optional long inactive)
|
"Get the right format for a time string."
|
(let ((f (if long (cdr org-time-stamp-formats)
|
(car org-time-stamp-formats))))
|
(if inactive
|
(concat "[" (substring f 1 -1) "]")
|
f)))
|
|
(defcustom org-deadline-warning-days 14
|
"Number of days before expiration during which a deadline becomes active.
|
This variable governs the display in sparse trees and in the agenda.
|
When 0 or negative, it means use this number (the absolute value of it)
|
even if a deadline has a different individual lead time specified.
|
|
Custom commands can set this variable in the options section."
|
:group 'org-time
|
:group 'org-agenda-daily/weekly
|
:type 'integer)
|
|
(defcustom org-scheduled-delay-days 0
|
"Number of days before a scheduled item becomes active.
|
This variable governs the display in sparse trees and in the agenda.
|
The default value (i.e. 0) means: don't delay scheduled item.
|
When negative, it means use this number (the absolute value of it)
|
even if a scheduled item has a different individual delay time
|
specified.
|
|
Custom commands can set this variable in the options section."
|
:group 'org-time
|
:group 'org-agenda-daily/weekly
|
:version "24.4"
|
:package-version '(Org . "8.0")
|
:type 'integer)
|
|
(defcustom org-read-date-prefer-future t
|
"Non-nil means assume future for incomplete date input from user.
|
This affects the following situations:
|
1. The user gives a month but not a year.
|
For example, if it is April and you enter \"feb 2\", this will be read
|
as Feb 2, *next* year. \"May 5\", however, will be this year.
|
2. The user gives a day, but no month.
|
For example, if today is the 15th, and you enter \"3\", Org will read
|
this as the third of *next* month. However, if you enter \"17\",
|
it will be considered as *this* month.
|
|
If you set this variable to the symbol `time', then also the following
|
will work:
|
|
3. If the user gives a time.
|
If the time is before now, it will be interpreted as tomorrow.
|
|
Currently none of this works for ISO week specifications.
|
|
When this option is nil, the current day, month and year will always be
|
used as defaults.
|
|
See also `org-agenda-jump-prefer-future'."
|
:group 'org-time
|
:type '(choice
|
(const :tag "Never" nil)
|
(const :tag "Check month and day" t)
|
(const :tag "Check month, day, and time" time)))
|
|
(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 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 'boolean)
|
|
(defcustom org-read-date-popup-calendar t
|
"Non-nil means pop up a calendar when prompting for a date.
|
In the calendar, the date can be selected with mouse-1. However, the
|
minibuffer will also be active, and you can simply enter the date as well.
|
When nil, only the minibuffer will be available."
|
:group 'org-time
|
:type 'boolean)
|
(defvaralias 'org-popup-calendar-for-date-prompt
|
'org-read-date-popup-calendar)
|
|
(defcustom org-extend-today-until 0
|
"The hour when your day really ends. Must be an integer.
|
This has influence for the following applications:
|
- When switching the agenda to \"today\". It it is still earlier than
|
the time given here, the day recognized as TODAY is actually yesterday.
|
- When a date is read from the user and it is still before the time given
|
here, the current date and time will be assumed to be yesterday, 23:59.
|
Also, timestamps inserted in capture templates follow this rule.
|
|
IMPORTANT: This is a feature whose implementation is and likely will
|
remain incomplete. Really, it is only here because past midnight seems to
|
be the favorite working time of John Wiegley :-)"
|
: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-use-last-clock-out-time-as-effective-time nil
|
"When non-nil, use the last clock out time for `org-todo'.
|
Note that this option has precedence over the combined use of
|
`org-use-effective-time' and `org-extend-today-until'."
|
:group 'org-time
|
:version "24.4"
|
:package-version '(Org . "8.0")
|
: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."
|
:group 'org-time
|
:type 'boolean)
|
|
(defcustom org-calendar-follow-timestamp-change t
|
"Non-nil means make the calendar window follow timestamp changes.
|
When a timestamp is modified and the calendar window is visible, it will be
|
moved to the new date."
|
:group 'org-time
|
:type 'boolean)
|
|
(defgroup org-tags nil
|
"Options concerning tags in Org mode."
|
:tag "Org Tags"
|
:group 'org)
|
|
(defcustom org-tag-alist nil
|
"Default tags available in Org files.
|
|
The value of this variable is an alist. Associations either:
|
|
(TAG)
|
(TAG . SELECT)
|
(SPECIAL)
|
|
where TAG is a tag as a string, SELECT is character, used to
|
select that tag through the fast tag selection interface, and
|
SPECIAL is one of the following keywords: `:startgroup',
|
`:startgrouptag', `:grouptags', `:engroup', `:endgrouptag' or
|
`:newline'. These keywords are used to define a hierarchy of
|
tags. See manual for details.
|
|
When this variable is nil, Org mode bases tag input on what is
|
already in the buffer. The value can be overridden locally by
|
using a TAGS keyword, e.g.,
|
|
#+TAGS: tag1 tag2
|
|
See also `org-tag-persistent-alist' to sidestep this behavior."
|
:group 'org-tags
|
:type '(repeat
|
(choice
|
(cons :tag "Tag with key"
|
(string :tag "Tag name")
|
(character :tag "Access char"))
|
(list :tag "Tag" (string :tag "Tag name"))
|
(const :tag "Start radio group" (:startgroup))
|
(const :tag "Start tag group, non distinct" (:startgrouptag))
|
(const :tag "Group tags delimiter" (:grouptags))
|
(const :tag "End radio group" (:endgroup))
|
(const :tag "End tag group, non distinct" (:endgrouptag))
|
(const :tag "New line" (:newline)))))
|
|
(defcustom org-tag-persistent-alist nil
|
"Tags always available in Org files.
|
|
The value of this variable is an alist. Associations either:
|
|
(TAG)
|
(TAG . SELECT)
|
(SPECIAL)
|
|
where TAG is a tag as a string, SELECT is a character, used to
|
select that tag through the fast tag selection interface, and
|
SPECIAL is one of the following keywords: `:startgroup',
|
`:startgrouptag', `:grouptags', `:engroup', `:endgrouptag' or
|
`:newline'. These keywords are used to define a hierarchy of
|
tags. See manual for details.
|
|
Unlike to `org-tag-alist', tags defined in this variable do not
|
depend on a local TAGS keyword. Instead, to disable these tags
|
on a per-file basis, insert anywhere in the file:
|
|
#+STARTUP: noptag"
|
:group 'org-tags
|
:type '(repeat
|
(choice
|
(cons :tag "Tag with key"
|
(string :tag "Tag name")
|
(character :tag "Access char"))
|
(list :tag "Tag" (string :tag "Tag name"))
|
(const :tag "Start radio group" (:startgroup))
|
(const :tag "Start tag group, non distinct" (:startgrouptag))
|
(const :tag "Group tags delimiter" (:grouptags))
|
(const :tag "End radio group" (:endgroup))
|
(const :tag "End tag group, non distinct" (:endgrouptag))
|
(const :tag "New line" (:newline)))))
|
|
(defcustom org-complete-tags-always-offer-all-agenda-tags nil
|
"If non-nil, always offer completion for all tags of all agenda files.
|
Instead of customizing this variable directly, you might want to
|
set it locally for capture buffers, because there no list of
|
tags in that file can be created dynamically (there are none).
|
|
(add-hook \\='org-capture-mode-hook
|
(lambda ()
|
(setq-local org-complete-tags-always-offer-all-agenda-tags t)))"
|
:group 'org-tags
|
:version "24.1"
|
:type 'boolean)
|
|
(defvar org-file-tags nil
|
"List of tags that can be inherited by all entries in the file.
|
The tags will be inherited if the variable `org-use-tag-inheritance'
|
says they should be.
|
This variable is populated from #+FILETAGS lines.")
|
|
(defcustom org-use-fast-tag-selection 'auto
|
"Non-nil means use fast tag selection scheme.
|
This is a special interface to select and deselect tags with single keys.
|
When nil, fast selection is never used.
|
When the symbol `auto', fast selection is used if and only if selection
|
characters for tags have been configured, either through the variable
|
`org-tag-alist' or through a #+TAGS line in the buffer.
|
When t, fast selection is always used and selection keys are assigned
|
automatically if necessary."
|
:group 'org-tags
|
:type '(choice
|
(const :tag "Always" t)
|
(const :tag "Never" nil)
|
(const :tag "When selection characters are configured" auto)))
|
|
(defcustom org-fast-tag-selection-single-key nil
|
"Non-nil means fast tag selection exits after first change.
|
When nil, you have to press RET to exit it.
|
During fast tag selection, you can toggle this flag with `C-c'.
|
This variable can also have the value `expert'. In this case, the window
|
displaying the tags menu is not even shown, until you press C-c again."
|
:group 'org-tags
|
:type '(choice
|
(const :tag "No" nil)
|
(const :tag "Yes" t)
|
(const :tag "Expert" expert)))
|
|
(defvar org-fast-tag-selection-include-todo nil
|
"Non-nil means fast tags selection interface will also offer TODO states.
|
This is an undocumented feature, you should not rely on it.")
|
|
(defcustom org-tags-column -77
|
"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.
|
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 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)
|
|
(defcustom org-use-tag-inheritance t
|
"Non-nil means tags in levels apply also for sublevels.
|
When nil, only the tags directly given in a specific line apply there.
|
This may also be a list of tags that should be inherited, or a regexp that
|
matches tags that should be inherited. Additional control is possible
|
with the variable `org-tags-exclude-from-inheritance' which gives an
|
explicit list of tags to be excluded from inheritance, even if the value of
|
`org-use-tag-inheritance' would select it for inheritance.
|
|
If this option is t, a match early-on in a tree can lead to a large
|
number of matches in the subtree when constructing the agenda or creating
|
a sparse tree. If you only want to see the first match in a tree during
|
a search, check out the variable `org-tags-match-list-sublevels'."
|
:group 'org-tags
|
:type '(choice
|
(const :tag "Not" nil)
|
(const :tag "Always" t)
|
(repeat :tag "Specific tags" (string :tag "Tag"))
|
(regexp :tag "Tags matched by regexp")))
|
|
(defcustom org-tags-exclude-from-inheritance nil
|
"List of tags that should never be inherited.
|
This is a way to exclude a few tags from inheritance. For way to do
|
the opposite, to actively allow inheritance for selected tags,
|
see the variable `org-use-tag-inheritance'."
|
:group 'org-tags
|
:type '(repeat (string :tag "Tag")))
|
|
(defun org-tag-inherit-p (tag)
|
"Check if TAG is one that should be inherited."
|
(cond
|
((member tag org-tags-exclude-from-inheritance) nil)
|
((eq org-use-tag-inheritance t) t)
|
((not org-use-tag-inheritance) nil)
|
((stringp org-use-tag-inheritance)
|
(string-match org-use-tag-inheritance tag))
|
((listp org-use-tag-inheritance)
|
(member tag org-use-tag-inheritance))
|
(t (error "Invalid setting of `org-use-tag-inheritance'"))))
|
|
(defcustom org-tags-match-list-sublevels t
|
"Non-nil means list also sublevels of headlines matching a search.
|
This variable applies to tags/property searches, and also to stuck
|
projects because this search is based on a tags match as well.
|
|
When set to the symbol `indented', sublevels are indented with
|
leading dots.
|
|
Because of tag inheritance (see variable `org-use-tag-inheritance'),
|
the sublevels of a headline matching a tag search often also match
|
the same search. Listing all of them can create very long lists.
|
Setting this variable to nil causes subtrees of a match to be skipped.
|
|
This variable is semi-obsolete and probably should always be true. It
|
is better to limit inheritance to certain tags using the variables
|
`org-use-tag-inheritance' and `org-tags-exclude-from-inheritance'."
|
:group 'org-tags
|
:type '(choice
|
(const :tag "No, don't list them" nil)
|
(const :tag "Yes, do list them" t)
|
(const :tag "List them, indented with leading dots" indented)))
|
|
(defcustom org-tags-sort-function nil
|
"When set, tags are sorted using this function as a comparator."
|
:group 'org-tags
|
:type '(choice
|
(const :tag "No sorting" nil)
|
(const :tag "Alphabetical" string<)
|
(const :tag "Reverse alphabetical" string>)
|
(function :tag "Custom function" nil)))
|
|
(defvar org-tags-history nil
|
"History of minibuffer reads for tags.")
|
(defvar org-last-tags-completion-table nil
|
"The last used completion table for tags.")
|
(defvar org-after-tags-change-hook nil
|
"Hook that is run after the tags in a line have changed.")
|
|
(defgroup org-properties nil
|
"Options concerning properties in Org mode."
|
:tag "Org Properties"
|
:group 'org)
|
|
(defcustom org-property-format "%-10s %s"
|
"How property key/value pairs should be formatted by `indent-line'.
|
When `indent-line' hits a property definition, it will format the line
|
according to this format, mainly to make sure that the values are
|
lined-up with respect to each other."
|
: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-to-minutes
|
(org-entry-get (point) \"Effort\"))))
|
(org-minutes-to-clocksum-string (- effort clocksum))))))"
|
:group 'org-properties
|
:version "24.1"
|
:type '(alist :key-type (string :tag "Property")
|
:value-type (function :tag "Function")))
|
|
(defcustom org-use-property-inheritance nil
|
"Non-nil means properties apply also for sublevels.
|
|
This setting is chiefly used during property searches. Turning it on can
|
cause significant overhead when doing a search, which is why it is not
|
on by default.
|
|
When nil, only the properties directly given in the current entry count.
|
When t, every property is inherited. The value may also be a list of
|
properties that should have inheritance, or a regular expression matching
|
properties that should be inherited.
|
|
However, note that some special properties use inheritance under special
|
circumstances (not in searches). Examples are CATEGORY, ARCHIVE, COLUMNS,
|
and the properties ending in \"_ALL\" when they are used as descriptor
|
for valid values of a property.
|
|
Note for programmers:
|
When querying an entry with `org-entry-get', you can control if inheritance
|
should be used. By default, `org-entry-get' looks only at the local
|
properties. You can request inheritance by setting the inherit argument
|
to t (to force inheritance) or to `selective' (to respect the setting
|
in this variable)."
|
:group 'org-properties
|
:type '(choice
|
(const :tag "Not" nil)
|
(const :tag "Always" t)
|
(repeat :tag "Specific properties" (string :tag "Property"))
|
(regexp :tag "Properties matched by regexp")))
|
|
(defun org-property-inherit-p (property)
|
"Return a non-nil value if PROPERTY should be inherited."
|
(cond
|
((eq org-use-property-inheritance t) t)
|
((not org-use-property-inheritance) nil)
|
((stringp org-use-property-inheritance)
|
(string-match org-use-property-inheritance property))
|
((listp org-use-property-inheritance)
|
(member-ignore-case property org-use-property-inheritance))
|
(t (error "Invalid setting of `org-use-property-inheritance'"))))
|
|
(defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS"
|
"The default column format, if no other format has been defined.
|
This variable can be set on the per-file basis by inserting a line
|
|
#+COLUMNS: %25ITEM ....."
|
:group 'org-properties
|
:type 'string)
|
|
(defcustom org-columns-ellipses ".."
|
"The ellipses to be used when a field in column view is truncated.
|
When this is the empty string, as many characters as possible are shown,
|
but then there will be no visual indication that the field has been truncated.
|
When this is a string of length N, the last N characters of a truncated
|
field are replaced by this string. If the column is narrower than the
|
ellipses string, only part of the ellipses string will be shown."
|
:group 'org-properties
|
:type 'string)
|
|
(defconst org-global-properties-fixed
|
'(("VISIBILITY_ALL" . "folded children content all")
|
("CLOCK_MODELINE_TOTAL_ALL" . "current today repeat all auto"))
|
"List of property/value pairs that can be inherited by any entry.
|
|
These are fixed values, for the preset properties. The user variable
|
that can be used to add to this list is `org-global-properties'.
|
|
The entries in this list are cons cells where the car is a property
|
name and cdr is a string with the value. If the value represents
|
multiple items like an \"_ALL\" property, separate the items by
|
spaces.")
|
|
(defcustom org-global-properties nil
|
"List of property/value pairs that can be inherited by any entry.
|
|
This list will be combined with the constant `org-global-properties-fixed'.
|
|
The entries in this list are cons cells where the car is a property
|
name and cdr is a string with the value.
|
|
You can set buffer-local values for the same purpose in the variable
|
`org-file-properties' this by adding lines like
|
|
#+PROPERTY: NAME VALUE"
|
:group 'org-properties
|
:type '(repeat
|
(cons (string :tag "Property")
|
(string :tag "Value"))))
|
|
(defvar-local org-file-properties nil
|
"List of property/value pairs that can be inherited by any entry.
|
Valid for the current buffer.
|
This variable is populated from #+PROPERTY lines.")
|
|
(defgroup org-agenda nil
|
"Options concerning agenda views in Org mode."
|
:tag "Org Agenda"
|
:group 'org)
|
|
(defvar-local org-category nil
|
"Variable used by Org files to set a category for agenda display.
|
Such files should use a file variable to set it, for example
|
|
# -*- mode: org; org-category: \"ELisp\"
|
|
or contain a special line
|
|
#+CATEGORY: ELisp
|
|
If the file does not specify a category, then file's base name
|
is used instead.")
|
(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.
|
|
If an entry is a directory, all files in that directory that are matched
|
by `org-agenda-file-regexp' will be part of the file list.
|
|
If the value of the variable is not a list but a single file name, then
|
the list of agenda files is actually stored and maintained in that file,
|
one agenda file per line. In this file paths can be given relative to
|
`org-directory'. Tilde expansion and environment variable substitution
|
are also made.
|
|
Entries may be added to this list with `\\[org-agenda-file-to-front]'
|
and removed with `\\[org-remove-file]'."
|
:group 'org-agenda
|
:type '(choice
|
(repeat :tag "List of files and directories" file)
|
(file :tag "Store list in a file\n" :value "~/.agenda_files")))
|
|
(defcustom org-agenda-file-regexp "\\`[^.].*\\.org\\'"
|
"Regular expression to match files for `org-agenda-files'.
|
If any element in the list in that variable contains a directory instead
|
of a normal file, all files in that directory that are matched by this
|
regular expression will be included."
|
:group 'org-agenda
|
:type 'regexp)
|
|
(defcustom org-agenda-text-search-extra-files nil
|
"List of extra files to be searched by text search commands.
|
These files will be searched in addition to the agenda files by the
|
commands `org-search-view' (`\\[org-agenda] s') \
|
and `org-occur-in-agenda-files'.
|
Note that these files will only be searched for text search commands,
|
not for the other agenda views like todo lists, tag searches or the weekly
|
agenda. This variable is intended to list notes and possibly archive files
|
that should also be searched by these two commands.
|
In fact, if the first element in the list is the symbol `agenda-archives',
|
then all archive files of all agenda files will be added to the search
|
scope."
|
:group 'org-agenda
|
:type '(set :greedy t
|
(const :tag "Agenda Archives" agenda-archives)
|
(repeat :inline t (file))))
|
|
(defvaralias 'org-agenda-multi-occur-extra-files
|
'org-agenda-text-search-extra-files)
|
|
(defcustom org-agenda-skip-unavailable-files nil
|
"Non-nil means to just skip non-reachable files in `org-agenda-files'.
|
A nil value means to remove them, after a query, from the list."
|
:group 'org-agenda
|
:type 'boolean)
|
|
(defcustom org-calendar-to-agenda-key [?c]
|
"The key to be installed in `calendar-mode-map' for switching to the agenda.
|
The command `org-calendar-goto-agenda' will be bound to this key. The
|
default is the character `c' because then `c' can be used to switch back and
|
forth between agenda and calendar."
|
:group 'org-agenda
|
:type 'sexp)
|
|
(defcustom org-calendar-insert-diary-entry-key [?i]
|
"The key to be installed in `calendar-mode-map' for adding diary entries.
|
This option is irrelevant until `org-agenda-diary-file' has been configured
|
to point to an Org file. When that is the case, the command
|
`org-agenda-diary-entry' will be bound to the key given here, by default
|
`i'. In the calendar, `i' normally adds entries to `diary-file'. So
|
if you want to continue doing this, you need to change this to a different
|
key."
|
:group 'org-agenda
|
:type 'sexp)
|
|
(defcustom org-agenda-diary-file 'diary-file
|
"File to which to add new entries with the `i' key in agenda and calendar.
|
When this is the symbol `diary-file', the functionality in the Emacs
|
calendar will be used to add entries to the `diary-file'. But when this
|
points to a file, `org-agenda-diary-entry' will be used instead."
|
:group 'org-agenda
|
:type '(choice
|
(const :tag "The standard Emacs diary file" diary-file)
|
(file :tag "Special Org file diary entries")))
|
|
(eval-after-load "calendar"
|
'(progn
|
(org-defkey calendar-mode-map org-calendar-to-agenda-key
|
'org-calendar-goto-agenda)
|
(add-hook 'calendar-mode-hook
|
(lambda ()
|
(unless (eq org-agenda-diary-file 'diary-file)
|
(define-key calendar-mode-map
|
org-calendar-insert-diary-entry-key
|
'org-agenda-diary-entry))))))
|
|
(defgroup org-latex nil
|
"Options for embedding LaTeX code into Org mode."
|
:tag "Org LaTeX"
|
:group 'org)
|
|
(defcustom org-format-latex-options
|
'(:foreground default :background default :scale 1.0
|
:html-foreground "Black" :html-background "Transparent"
|
:html-scale 1.0 :matchers ("begin" "$1" "$" "$$" "\\(" "\\["))
|
"Options for creating images from LaTeX fragments.
|
This is a property list with the following properties:
|
:foreground the foreground color for images embedded in Emacs, e.g. \"Black\".
|
`default' means use the foreground of the default face.
|
`auto' means use the foreground from the text face.
|
:background the background color, or \"Transparent\".
|
`default' means use the background of the default face.
|
`auto' means use the background from the text face.
|
:scale a scaling factor for the size of the images, to get more pixels
|
:html-foreground, :html-background, :html-scale
|
the same numbers for HTML export.
|
:matchers a list indicating which matchers should be used to
|
find LaTeX fragments. Valid members of this list are:
|
\"begin\" find environments
|
\"$1\" find single characters surrounded by $.$
|
\"$\" find math expressions surrounded by $...$
|
\"$$\" find math expressions surrounded by $$....$$
|
\"\\(\" find math expressions surrounded by \\(...\\)
|
\"\\=\\[\" find math expressions surrounded by \\=\\[...\\]"
|
:group 'org-latex
|
:type 'plist)
|
|
(defcustom org-format-latex-signal-error t
|
"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.
|
%i: The latex fragment to be converted.
|
%o: Output MathML file.
|
|
This command is used by `org-create-math-formula'.
|
|
When using MathToWeb as the converter, set this option to
|
\"java -jar %j -unicode -force -df %o %I\".
|
|
When using LaTeXML set this option to
|
\"latexmlmath \"%i\" --presentationmathml=%o\"."
|
:group 'org-latex
|
:version "24.1"
|
:type '(choice
|
(const :tag "None" nil)
|
(string :tag "\nShell command")))
|
|
(defcustom org-preview-latex-default-process 'dvipng
|
"The default process to convert LaTeX fragments to image files.
|
All available processes and theirs documents can be found in
|
`org-preview-latex-process-alist', which see."
|
:group 'org-latex
|
:version "26.1"
|
:package-version '(Org . "9.0")
|
:type 'symbol)
|
|
(defcustom org-preview-latex-process-alist
|
'((dvipng
|
:programs ("latex" "dvipng")
|
:description "dvi > png"
|
:message "you need to install the programs: latex and dvipng."
|
:image-input-type "dvi"
|
:image-output-type "png"
|
:image-size-adjust (1.0 . 1.0)
|
:latex-compiler ("latex -interaction nonstopmode -output-directory %o %f")
|
:image-converter ("dvipng -fg %F -bg %B -D %D -T tight -o %O %f"))
|
(dvisvgm
|
:programs ("latex" "dvisvgm")
|
:description "dvi > svg"
|
:message "you need to install the programs: latex and dvisvgm."
|
:use-xcolor t
|
:image-input-type "dvi"
|
:image-output-type "svg"
|
:image-size-adjust (1.7 . 1.5)
|
:latex-compiler ("latex -interaction nonstopmode -output-directory %o %f")
|
:image-converter ("dvisvgm %f -n -b min -c %S -o %O"))
|
(imagemagick
|
:programs ("latex" "convert")
|
:description "pdf > png"
|
:message "you need to install the programs: latex and imagemagick."
|
:use-xcolor t
|
:image-input-type "pdf"
|
:image-output-type "png"
|
:image-size-adjust (1.0 . 1.0)
|
:latex-compiler ("pdflatex -interaction nonstopmode -output-directory %o %f")
|
:image-converter
|
("convert -density %D -trim -antialias %f -quality 100 %O")))
|
"Definitions of external processes for LaTeX previewing.
|
Org mode can use some external commands to generate TeX snippet's images for
|
previewing or inserting into HTML files, e.g., \"dvipng\". This variable tells
|
`org-create-formula-image' how to call them.
|
|
The value is an alist with the pattern (NAME . PROPERTIES). NAME is a symbol.
|
PROPERTIES accepts the following attributes:
|
|
:programs list of strings, required programs.
|
:description string, describe the process.
|
:message string, message it when required programs cannot be found.
|
:image-input-type string, input file type of image converter (e.g., \"dvi\").
|
:image-output-type string, output file type of image converter (e.g., \"png\").
|
:use-xcolor boolean, when non-nil, LaTeX \"xcolor\" macro is used to
|
deal with background and foreground color of image.
|
Otherwise, dvipng style background and foreground color
|
format are generated. You may then refer to them in
|
command options with \"%F\" and \"%B\".
|
:image-size-adjust cons of numbers, the car element is used to adjust LaTeX
|
image size showed in buffer and the cdr element is for
|
HTML file. This option is only useful for process
|
developers, users should use variable
|
`org-format-latex-options' instead.
|
:post-clean list of strings, files matched are to be cleaned up once
|
the image is generated. When nil, the files with \".dvi\",
|
\".xdv\", \".pdf\", \".tex\", \".aux\", \".log\", \".svg\",
|
\".png\", \".jpg\", \".jpeg\" or \".out\" extension will
|
be cleaned up.
|
:latex-header list of strings, the LaTeX header of the snippet file.
|
When nil, the fallback value is used instead, which is
|
controlled by `org-format-latex-header',
|
`org-latex-default-packages-alist' and
|
`org-latex-packages-alist', which see.
|
:latex-compiler list of LaTeX commands, as strings. Each of them is given
|
to the shell. Place-holders \"%t\", \"%b\" and \"%o\" are
|
replaced with values defined below.
|
:image-converter list of image converter commands strings. Each of them is
|
given to the shell and supports any of the following
|
place-holders defined below.
|
|
Place-holders used by `:image-converter' and `:latex-compiler':
|
|
%f input file name
|
%b base name of input file
|
%o base directory of input file
|
%O absolute output file name
|
|
Place-holders only used by `:image-converter':
|
|
%F foreground of image
|
%B background of image
|
%D dpi, which is used to adjust image size by some processing commands.
|
%S the image size scale ratio, which is used to adjust image size by some
|
processing commands."
|
:group 'org-latex
|
:version "26.1"
|
:package-version '(Org . "9.0")
|
:type '(alist :tag "LaTeX to image backends"
|
:value-type (plist)))
|
|
(defcustom org-preview-latex-image-directory "ltximg/"
|
"Path to store latex preview images.
|
A relative path here creates many directories relative to the
|
processed Org files paths. An absolute path puts all preview
|
images at the same place."
|
:group 'org-latex
|
:version "26.1"
|
:package-version '(Org . "9.0")
|
:type 'string)
|
|
(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}
|
\[PACKAGES]
|
\[DEFAULT-PACKAGES]
|
\\pagestyle{empty} % do not remove
|
% The settings below are copied from fullpage.sty
|
\\setlength{\\textwidth}{\\paperwidth}
|
\\addtolength{\\textwidth}{-3cm}
|
\\setlength{\\oddsidemargin}{1.5cm}
|
\\addtolength{\\oddsidemargin}{-2.54cm}
|
\\setlength{\\evensidemargin}{\\oddsidemargin}
|
\\setlength{\\textheight}{\\paperheight}
|
\\addtolength{\\textheight}{-\\headheight}
|
\\addtolength{\\textheight}{-\\headsep}
|
\\addtolength{\\textheight}{-\\footskip}
|
\\addtolength{\\textheight}{-3cm}
|
\\setlength{\\topmargin}{1.5cm}
|
\\addtolength{\\topmargin}{-2.54cm}"
|
"The document header used for processing LaTeX fragments.
|
It is imperative that this header make sure that no page number
|
appears on the page. The package defined in the variables
|
`org-latex-default-packages-alist' and `org-latex-packages-alist'
|
will either replace the placeholder \"[PACKAGES]\" in this
|
header, or they will be appended."
|
:group 'org-latex
|
:type 'string)
|
|
(defun org-set-packages-alist (var val)
|
"Set the packages alist and make sure it has 3 elements per entry."
|
(set var (mapcar (lambda (x)
|
(if (and (consp x) (= (length x) 2))
|
(list (car x) (nth 1 x) t)
|
x))
|
val)))
|
|
(defun org-get-packages-alist (var)
|
"Get the packages alist and make sure it has 3 elements per entry."
|
(mapcar (lambda (x)
|
(if (and (consp x) (= (length x) 2))
|
(list (car x) (nth 1 x) t)
|
x))
|
(default-value var)))
|
|
(defcustom org-latex-default-packages-alist
|
'(("AUTO" "inputenc" t ("pdflatex"))
|
("T1" "fontenc" t ("pdflatex"))
|
("" "graphicx" t)
|
("" "grffile" t)
|
("" "longtable" nil)
|
("" "wrapfig" nil)
|
("" "rotating" nil)
|
("normalem" "ulem" t)
|
("" "amsmath" t)
|
("" "textcomp" t)
|
("" "amssymb" t)
|
("" "capt-of" nil)
|
("" "hyperref" nil))
|
"Alist of default packages to be inserted in the header.
|
|
Change this only if one of the packages here causes an
|
incompatibility with another package you are using.
|
|
The packages in this list are needed by one part or another of
|
Org mode to function properly:
|
|
- inputenc, fontenc: for basic font and character selection
|
- graphicx: for including images
|
- grffile: allow periods and spaces in graphics file names
|
- longtable: For multipage tables
|
- wrapfig: for figure placement
|
- rotating: for sideways figures and tables
|
- ulem: for underline and strike-through
|
- amsmath: for subscript and superscript and math environments
|
- textcomp, amssymb: for various symbols used
|
for interpreting the entities in `org-entities'. You can skip
|
some of these packages if you don't use any of their symbols.
|
- capt-of: for captions outside of floats
|
- hyperref: for cross references
|
|
Therefore you should not modify this variable unless you know
|
what you are doing. The one reason to change it anyway is that
|
you might be loading some other package that conflicts with one
|
of the default packages. Each element is either a cell or
|
a string.
|
|
A cell is of the format
|
|
(\"options\" \"package\" SNIPPET-FLAG COMPILERS)
|
|
If SNIPPET-FLAG is non-nil, the package also needs to be included
|
when compiling LaTeX snippets into images for inclusion into
|
non-LaTeX output. COMPILERS is a list of compilers that should
|
include the package, see `org-latex-compiler'. If the document
|
compiler is not in the list, and the list is non-nil, the package
|
will not be inserted in the final document.
|
|
A string will be inserted as-is in the header of the document."
|
:group 'org-latex
|
:group 'org-export-latex
|
:set 'org-set-packages-alist
|
:get 'org-get-packages-alist
|
:version "26.1"
|
:package-version '(Org . "8.3")
|
:type '(repeat
|
(choice
|
(list :tag "options/package pair"
|
(string :tag "options")
|
(string :tag "package")
|
(boolean :tag "Snippet")
|
(choice
|
(const :tag "For all compilers" nil)
|
(repeat :tag "Allowed compiler" string)))
|
(string :tag "A line of LaTeX"))))
|
|
(defcustom org-latex-packages-alist nil
|
"Alist of packages to be inserted in every LaTeX header.
|
|
These will be inserted after `org-latex-default-packages-alist'.
|
Each element is either a cell or a string.
|
|
A cell is of the format:
|
|
(\"options\" \"package\" SNIPPET-FLAG)
|
|
SNIPPET-FLAG, when non-nil, indicates that this package is also
|
needed when turning LaTeX snippets into images for inclusion into
|
non-LaTeX output.
|
|
A string will be inserted as-is in the header of the document.
|
|
Make sure that you only list packages here which:
|
|
- you want in every file;
|
- do not conflict with the setup in `org-format-latex-header';
|
- do not conflict with the default packages in
|
`org-latex-default-packages-alist'."
|
:group 'org-latex
|
:group 'org-export-latex
|
:set 'org-set-packages-alist
|
:get 'org-get-packages-alist
|
:type '(repeat
|
(choice
|
(list :tag "options/package pair"
|
(string :tag "options")
|
(string :tag "package")
|
(boolean :tag "Snippet"))
|
(string :tag "A line of LaTeX"))))
|
|
(defgroup org-appearance nil
|
"Settings for Org mode appearance."
|
:tag "Org Appearance"
|
:group 'org)
|
|
(defcustom org-level-color-stars-only nil
|
"Non-nil means fontify only the stars in each headline.
|
When nil, the entire headline is fontified.
|
Changing it requires restart of `font-lock-mode' to become effective
|
also in regions already fontified."
|
:group 'org-appearance
|
:type 'boolean)
|
|
(defcustom org-hide-leading-stars nil
|
"Non-nil means hide the first N-1 stars in a headline.
|
This works by using the face `org-hide' for these stars. This
|
face is white for a light background, and black for a dark
|
background. You may have to customize the face `org-hide' to
|
make this work.
|
Changing it requires restart of `font-lock-mode' to become effective
|
also in regions already fontified.
|
You may also set this on a per-file basis by adding one of the following
|
lines to the buffer:
|
|
#+STARTUP: hidestars
|
#+STARTUP: showstars"
|
:group 'org-appearance
|
:type 'boolean)
|
|
(defcustom org-hidden-keywords nil
|
"List of symbols corresponding to keywords to be hidden in the Org buffer.
|
For example, a value \\='(title) for this list makes the document's title
|
appear in the buffer without the initial \"#+TITLE:\" part."
|
:group 'org-appearance
|
:version "24.1"
|
:type '(set (const :tag "#+AUTHOR" author)
|
(const :tag "#+DATE" date)
|
(const :tag "#+EMAIL" email)
|
(const :tag "#+TITLE" title)))
|
|
(defcustom org-custom-properties nil
|
"List of properties (as strings) with a special meaning.
|
The default use of these custom properties is to let the user
|
hide them with `org-toggle-custom-properties-visibility'."
|
:group 'org-properties
|
:group 'org-appearance
|
:version "24.3"
|
:type '(repeat (string :tag "Property Name")))
|
|
(defcustom org-fontify-done-headline nil
|
"Non-nil means change the face of a headline if it is marked DONE.
|
Normally, only the TODO/DONE keyword indicates the state of a headline.
|
When this is non-nil, the headline after the keyword is set to the
|
`org-headline-done' as an additional indication."
|
:group 'org-appearance
|
:type 'boolean)
|
|
(defcustom org-fontify-emphasized-text t
|
"Non-nil means fontify *bold*, /italic/ and _underlined_ text.
|
Changing this variable requires a restart of Emacs to take effect."
|
:group 'org-appearance
|
:type 'boolean)
|
|
(defcustom org-fontify-whole-heading-line nil
|
"Non-nil means fontify the whole line for headings.
|
This is useful when setting a background color for the
|
org-level-* faces."
|
:group 'org-appearance
|
:type 'boolean)
|
|
(defcustom org-highlight-latex-and-related nil
|
"Non-nil means highlight LaTeX related syntax in the buffer.
|
When non nil, the value should be a list containing any of the
|
following symbols:
|
`latex' Highlight LaTeX snippets and environments.
|
`script' Highlight subscript and superscript.
|
`entities' Highlight entities."
|
:group 'org-appearance
|
:version "24.4"
|
:package-version '(Org . "8.0")
|
:type '(choice
|
(const :tag "No highlighting" nil)
|
(set :greedy t :tag "Highlight"
|
(const :tag "LaTeX snippets and environments" latex)
|
(const :tag "Subscript and superscript" script)
|
(const :tag "Entities" entities))))
|
|
(defcustom org-hide-emphasis-markers nil
|
"Non-nil mean font-lock should hide the emphasis marker characters."
|
:group 'org-appearance
|
:type 'boolean)
|
|
(defcustom org-hide-macro-markers nil
|
"Non-nil mean font-lock should hide the brackets marking macro calls."
|
:group 'org-appearance
|
:type 'boolean)
|
|
(defcustom org-pretty-entities nil
|
"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
|
"Regular expression for matching emphasis.
|
After a match, the match groups contain these elements:
|
0 The match of the full regular expression, including the characters
|
before and after the proper match
|
1 The character before the proper match, or empty at beginning of line
|
2 The proper match, including the leading and trailing markers
|
3 The leading marker like * or /, indicating the type of highlighting
|
4 The text between the emphasis markers, not including the markers
|
5 The character after the match, empty at the end of a line")
|
|
(defvar org-verbatim-re nil
|
"Regular expression for matching verbatim text.")
|
|
(defvar org-emphasis-regexp-components) ; defined just below
|
(defvar org-emphasis-alist) ; defined just below
|
(defun org-set-emph-re (var val)
|
"Set variable and compute the emphasis regular expression."
|
(set var val)
|
(when (and (boundp 'org-emphasis-alist)
|
(boundp 'org-emphasis-regexp-components)
|
org-emphasis-alist org-emphasis-regexp-components)
|
(pcase-let*
|
((`(,pre ,post ,border ,body ,nl) org-emphasis-regexp-components)
|
(body (if (<= nl 0) body
|
(format "%s*?\\(?:\n%s*?\\)\\{0,%d\\}" body body nl)))
|
(template
|
(format (concat "\\([%s]\\|^\\)" ;before markers
|
"\\(\\([%%s]\\)\\([^%s]\\|[^%s]%s[^%s]\\)\\3\\)"
|
"\\([%s]\\|$\\)") ;after markers
|
pre border border body border post)))
|
(setq org-emph-re (format template "*/_+"))
|
(setq org-verbatim-re (format template "=~")))))
|
|
;; This used to be a defcustom (Org <8.0) but allowing the users to
|
;; set this option proved cumbersome. See this message/thread:
|
;; http://article.gmane.org/gmane.emacs.orgmode/68681
|
(defvar org-emphasis-regexp-components
|
'("- \t('\"{" "- \t.,:!?;'\")}\\[" " \t\r\n" "." 1)
|
"Components used to build the regular expression for emphasis.
|
This is a list with five entries. Terminology: In an emphasis string
|
like \" *strong word* \", we call the initial space PREMATCH, the final
|
space POSTMATCH, the stars MARKERS, \"s\" and \"d\" are BORDER characters
|
and \"trong wor\" is the body. The different components in this variable
|
specify what is allowed/forbidden in each part:
|
|
pre Chars allowed as prematch. Beginning of line will be allowed too.
|
post Chars allowed as postmatch. End of line will be allowed too.
|
border The chars *forbidden* as border characters.
|
body-regexp A regexp like \".\" to match a body character. Don't use
|
non-shy groups here, and don't allow newline here.
|
newline The maximum number of newlines allowed in an emphasis exp.
|
|
You need to reload Org or to restart Emacs after customizing this.")
|
|
(defcustom org-emphasis-alist
|
'(("*" bold)
|
("/" italic)
|
("_" underline)
|
("=" org-verbatim verbatim)
|
("~" org-code verbatim)
|
("+" (:strike-through t)))
|
"Alist of characters and faces to emphasize text.
|
Text starting and ending with a special character will be emphasized,
|
for example *bold*, _underlined_ and /italic/. This variable sets the
|
marker characters and the face to be used by font-lock for highlighting
|
in Org buffers.
|
|
You need to reload Org or to restart Emacs after customizing this."
|
:group 'org-appearance
|
:set 'org-set-emph-re
|
:version "24.4"
|
:package-version '(Org . "8.0")
|
:type '(repeat
|
(list
|
(string :tag "Marker character")
|
(choice
|
(face :tag "Font-lock-face")
|
(plist :tag "Face property list"))
|
(option (const verbatim)))))
|
|
(defvar org-protecting-blocks '("src" "example" "export")
|
"Blocks that contain text that is quoted, i.e. not processed as Org syntax.
|
This is needed for font-lock setup.")
|
|
;;; Functions and variables from their packages
|
;; Declared here to avoid compiler warnings
|
(defvar mark-active)
|
|
;; Various packages
|
(declare-function calc-eval "calc" (str &optional separator &rest args))
|
(declare-function calendar-forward-day "cal-move" (arg))
|
(declare-function calendar-goto-date "cal-move" (date))
|
(declare-function calendar-goto-today "cal-move" ())
|
(declare-function calendar-iso-from-absolute "cal-iso" (date))
|
(declare-function calendar-iso-to-absolute "cal-iso" (date))
|
(declare-function cdlatex-compute-tables "ext:cdlatex" ())
|
(declare-function cdlatex-tab "ext:cdlatex" ())
|
(declare-function dired-get-filename
|
"dired"
|
(&optional localp no-error-if-not-filep))
|
(declare-function iswitchb-read-buffer
|
"iswitchb"
|
(prompt &optional
|
default require-match _predicate start matches-set))
|
(declare-function org-agenda-change-all-lines
|
"org-agenda"
|
(newhead hdmarker &optional fixface just-this))
|
(declare-function org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
|
"org-agenda"
|
(&optional end))
|
(declare-function org-agenda-copy-local-variable "org-agenda" (var))
|
(declare-function org-agenda-format-item
|
"org-agenda"
|
(extra txt &optional level category tags dotime
|
remove-re habitp))
|
(declare-function org-agenda-maybe-redo "org-agenda" ())
|
(declare-function org-agenda-new-marker "org-agenda" (&optional pos))
|
(declare-function org-agenda-save-markers-for-cut-and-paste
|
"org-agenda"
|
(beg end))
|
(declare-function org-agenda-set-restriction-lock "org-agenda" (&optional type))
|
(declare-function org-agenda-skip "org-agenda" ())
|
(declare-function org-attach-reveal "org-attach" (&optional if-exists))
|
(declare-function org-gnus-follow-link "org-gnus" (&optional group article))
|
(declare-function org-indent-mode "org-indent" (&optional arg))
|
(declare-function org-inlinetask-goto-beginning "org-inlinetask" ())
|
(declare-function org-inlinetask-goto-end "org-inlinetask" ())
|
(declare-function org-inlinetask-in-task-p "org-inlinetask" ())
|
(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
|
(declare-function orgtbl-send-table "org-table" (&optional maybe))
|
(declare-function parse-time-string "parse-time" (string))
|
(declare-function speedbar-line-directory "speedbar" (&optional depth))
|
|
(defvar align-mode-rules-list)
|
(defvar calc-embedded-close-formula)
|
(defvar calc-embedded-open-formula)
|
(defvar calc-embedded-open-mode)
|
(defvar font-lock-unfontify-region-function)
|
(defvar iswitchb-temp-buflist)
|
(defvar org-agenda-tags-todo-honor-ignore-options)
|
(defvar remember-data-file)
|
(defvar texmathp-why)
|
|
;;;###autoload
|
(defun turn-on-orgtbl ()
|
"Unconditionally turn on `orgtbl-mode'."
|
(require 'org-table)
|
(orgtbl-mode 1))
|
|
(defun org-at-table-p (&optional table-type)
|
"Non-nil if the cursor is inside an Org table.
|
If TABLE-TYPE is non-nil, also check for table.el-type tables."
|
(and (org-match-line (if table-type "[ \t]*[|+]" "[ \t]*|"))
|
(or (not (derived-mode-p 'org-mode))
|
(let ((e (org-element-lineage (org-element-at-point) '(table) t)))
|
(and e (or table-type
|
(eq 'org (org-element-property :type e))))))))
|
|
(defun org-at-table.el-p ()
|
"Non-nil when point is at a table.el table."
|
(and (org-match-line "[ \t]*[|+]")
|
(let ((element (org-element-at-point)))
|
(and (eq (org-element-type element) 'table)
|
(eq (org-element-property :type element) 'table.el)))))
|
|
(defun org-at-table-hline-p ()
|
"Non-nil when point is inside a hline in a table.
|
Assume point is already in a table."
|
(org-match-line org-table-hline-regexp))
|
|
(defun org-table-map-tables (function &optional quietly)
|
"Apply FUNCTION to the start of all tables in the buffer."
|
(org-with-wide-buffer
|
(goto-char (point-min))
|
(while (re-search-forward org-table-any-line-regexp nil t)
|
(unless quietly
|
(message "Mapping tables: %d%%"
|
(floor (* 100.0 (point)) (buffer-size))))
|
(beginning-of-line 1)
|
(when (and (looking-at org-table-line-regexp)
|
;; Exclude tables in src/example/verbatim/clocktable blocks
|
(not (org-in-block-p '("src" "example" "verbatim" "clocktable"))))
|
(save-excursion (funcall function))
|
(or (looking-at org-table-line-regexp)
|
(forward-char 1)))
|
(re-search-forward org-table-any-border-regexp nil 1)))
|
(unless quietly (message "Mapping tables: done")))
|
|
(declare-function org-clock-save-markers-for-cut-and-paste "org-clock" (beg end))
|
(declare-function org-clock-update-mode-line "org-clock" ())
|
(declare-function org-resolve-clocks "org-clock"
|
(&optional also-non-dangling-p prompt last-valid))
|
|
(defun org-at-TBLFM-p (&optional pos)
|
"Non-nil when point (or POS) is in #+TBLFM line."
|
(save-excursion
|
(goto-char (or pos (point)))
|
(beginning-of-line)
|
(and (let ((case-fold-search t)) (looking-at org-TBLFM-regexp))
|
(eq (org-element-type (org-element-at-point)) 'table))))
|
|
(defvar org-clock-start-time)
|
(defvar org-clock-marker (make-marker)
|
"Marker recording the last clock-in.")
|
(defvar org-clock-hd-marker (make-marker)
|
"Marker recording the last clock-in, but the headline position.")
|
(defvar org-clock-heading ""
|
"The heading of the current clock entry.")
|
(defun org-clock-is-active ()
|
"Return the buffer where the clock is currently running.
|
Return nil if no clock is running."
|
(marker-buffer org-clock-marker))
|
|
(defun org-check-running-clock ()
|
"Check if the current buffer contains the running clock.
|
If yes, offer to stop it and to save the buffer with the changes."
|
(when (and (equal (marker-buffer org-clock-marker) (current-buffer))
|
(y-or-n-p (format "Clock-out in buffer %s before killing it? "
|
(buffer-name))))
|
(org-clock-out)
|
(when (y-or-n-p "Save changed buffer?")
|
(save-buffer))))
|
|
(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 "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>")
|
(org-clocktable-shift dir n)))
|
|
;;;###autoload
|
(defun org-clock-persistence-insinuate ()
|
"Set up hooks for clock persistence."
|
(require 'org-clock)
|
(add-hook 'org-mode-hook 'org-clock-load)
|
(add-hook 'kill-emacs-hook 'org-clock-save))
|
|
(defgroup org-archive nil
|
"Options concerning archiving in Org mode."
|
:tag "Org Archive"
|
:group 'org-structure)
|
|
(defcustom org-archive-location "%s_archive::"
|
"The location where subtrees should be archived.
|
|
The value of this variable is a string, consisting of two parts,
|
separated by a double-colon. The first part is a filename and
|
the second part is a headline.
|
|
When the filename is omitted, archiving happens in the same file.
|
%s in the filename will be replaced by the current file
|
name (without the directory part). Archiving to a different file
|
is useful to keep archived entries from contributing to the
|
Org Agenda.
|
|
The archived entries will be filed as subtrees of the specified
|
headline. When the headline is omitted, the subtrees are simply
|
filed away at the end of the file, as top-level entries. Also in
|
the heading you can use %s to represent the file name, this can be
|
useful when using the same archive for a number of different files.
|
|
Here are a few examples:
|
\"%s_archive::\"
|
If the current file is Projects.org, archive in file
|
Projects.org_archive, as top-level trees. This is the default.
|
|
\"::* Archived Tasks\"
|
Archive in the current file, under the top-level headline
|
\"* Archived Tasks\".
|
|
\"~/org/archive.org::\"
|
Archive in file ~/org/archive.org (absolute path), as top-level trees.
|
|
\"~/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.
|
|
\"~/org/datetree.org::datetree/* Finished Tasks\"
|
The \"datetree/\" string is special, signifying to archive
|
items to the datetree. Items are placed in either the CLOSED
|
date of the item, or the current date if there is no CLOSED date.
|
The heading will be a subentry to the current date. There doesn't
|
need to be a heading, but there always needs to be a slash after
|
datetree. For example, to store archived items directly in the
|
datetree, use \"~/org/datetree.org::datetree/\".
|
|
\"basement::** Finished Tasks\"
|
Archive in file ./basement (relative path), as level 3 trees
|
below the level 2 heading \"** Finished Tasks\".
|
|
You may set this option on a per-file basis by adding to the buffer a
|
line like
|
|
#+ARCHIVE: basement::** Finished Tasks
|
|
You may also define it locally for a subtree by setting an ARCHIVE property
|
in the entry. If such a property is found in an entry, or anywhere up
|
the hierarchy, it will be used."
|
:group 'org-archive
|
:type 'string)
|
|
(defcustom org-agenda-skip-archived-trees t
|
"Non-nil means the agenda will skip any items located in archived trees.
|
An archived tree is a tree marked with the tag ARCHIVE. The use of this
|
variable is no longer recommended, you should leave it at the value t.
|
Instead, use the key `v' to cycle the archives-mode in the agenda."
|
:group 'org-archive
|
:group 'org-agenda-skip
|
:type 'boolean)
|
|
(defcustom org-columns-skip-archived-trees t
|
"Non-nil means ignore archived trees when creating column view."
|
:group 'org-archive
|
:group 'org-properties
|
:type 'boolean)
|
|
(defcustom org-cycle-open-archived-trees nil
|
"Non-nil means `org-cycle' will open archived trees.
|
An archived tree is a tree marked with the tag ARCHIVE.
|
When nil, archived trees will stay folded. You can still open them with
|
normal outline commands like `show-all', but not with the cycling commands."
|
:group 'org-archive
|
:group 'org-cycle
|
:type 'boolean)
|
|
(defcustom org-sparse-tree-open-archived-trees nil
|
"Non-nil means sparse tree construction shows matches in archived trees.
|
When nil, matches in these trees are highlighted, but the trees are kept in
|
collapsed state."
|
:group 'org-archive
|
:group 'org-sparse-trees
|
:type 'boolean)
|
|
(defcustom org-sparse-tree-default-date-type nil
|
"The default date type when building a sparse tree.
|
When this is nil, a date is a scheduled or a deadline timestamp.
|
Otherwise, these types are allowed:
|
|
all: all timestamps
|
active: only active timestamps (<...>)
|
inactive: only inactive timestamps ([...])
|
scheduled: only scheduled timestamps
|
deadline: only deadline timestamps"
|
:type '(choice (const :tag "Scheduled or deadline" nil)
|
(const :tag "All timestamps" all)
|
(const :tag "Only active timestamps" active)
|
(const :tag "Only inactive timestamps" inactive)
|
(const :tag "Only scheduled timestamps" scheduled)
|
(const :tag "Only deadline timestamps" deadline)
|
(const :tag "Only closed timestamps" closed))
|
:version "26.1"
|
:package-version '(Org . "8.3")
|
:group 'org-sparse-trees)
|
|
(defun org-cycle-hide-archived-subtrees (state)
|
"Re-hide all archived subtrees after a visibility state change.
|
STATE should be one of the symbols listed in the docstring of
|
`org-cycle-hook'."
|
(when (and (not org-cycle-open-archived-trees)
|
(not (memq state '(overview folded))))
|
(save-excursion
|
(let* ((globalp (memq state '(contents all)))
|
(beg (if globalp (point-min) (point)))
|
(end (if globalp (point-max) (org-end-of-subtree t))))
|
(org-hide-archived-subtrees beg end)
|
(goto-char beg)
|
(when (looking-at-p (concat ".*:" org-archive-tag ":"))
|
(message "%s" (substitute-command-keys
|
"Subtree is archived and stays closed. Use \
|
`\\[org-force-cycle-archived]' to cycle it anyway.")))))))
|
|
(defun org-force-cycle-archived ()
|
"Cycle subtree even if it is archived."
|
(interactive)
|
(setq this-command 'org-cycle)
|
(let ((org-cycle-open-archived-trees t))
|
(call-interactively 'org-cycle)))
|
|
(defun org-hide-archived-subtrees (beg end)
|
"Re-hide all archived subtrees after a visibility state change."
|
(org-with-wide-buffer
|
(let ((case-fold-search nil)
|
(re (concat org-outline-regexp-bol ".*:" org-archive-tag ":")))
|
(goto-char beg)
|
;; Include headline point is currently on.
|
(beginning-of-line)
|
(while (and (< (point) end) (re-search-forward re end t))
|
(when (member org-archive-tag (org-get-tags))
|
(org-flag-subtree t)
|
(org-end-of-subtree t))))))
|
|
(declare-function outline-end-of-heading "outline" ())
|
(declare-function outline-flag-region "outline" (from to flag))
|
(defun org-flag-subtree (flag)
|
(save-excursion
|
(org-back-to-heading t)
|
(outline-end-of-heading)
|
(outline-flag-region (point)
|
(progn (org-end-of-subtree t) (point))
|
flag)))
|
|
(defalias 'org-advertized-archive-subtree 'org-archive-subtree)
|
|
;; Declare Column View Code
|
|
(declare-function org-columns-get-format-and-top-level "org-colview" ())
|
(declare-function org-columns-compute "org-colview" (property))
|
|
;; Declare ID code
|
|
(declare-function org-id-store-link "org-id")
|
(declare-function org-id-locations-load "org-id")
|
(declare-function org-id-locations-save "org-id")
|
(defvar org-id-track-globally)
|
|
;;; Variables for pre-computed regular expressions, all buffer local
|
|
(defvar-local org-todo-regexp nil
|
"Matches any of the TODO state keywords.
|
Since TODO keywords are case-sensitive, `case-fold-search' is
|
expected to be bound to nil when matching against this regexp.")
|
|
(defvar-local org-not-done-regexp nil
|
"Matches any of the TODO state keywords except the last one.
|
Since TODO keywords are case-sensitive, `case-fold-search' is
|
expected to be bound to nil when matching against this regexp.")
|
|
(defvar-local org-not-done-heading-regexp nil
|
"Matches a TODO headline that is not done.
|
Since TODO keywords are case-sensitive, `case-fold-search' is
|
expected to be bound to nil when matching against this regexp.")
|
|
(defvar-local org-todo-line-regexp nil
|
"Matches a headline and puts TODO state into group 2 if present.
|
Since TODO keywords are case-sensitive, `case-fold-search' is
|
expected to be bound to nil when matching against this regexp.")
|
|
(defvar-local org-complex-heading-regexp nil
|
"Matches a headline and puts everything into groups:
|
|
group 1: Stars
|
group 2: The TODO keyword, maybe
|
group 3: Priority cookie
|
group 4: True headline
|
group 5: Tags
|
|
Since TODO keywords are case-sensitive, `case-fold-search' is
|
expected to be bound to nil when matching against this regexp.")
|
|
(defvar-local 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 has the
|
exact headline text that is put into the format, but may have any
|
TODO state, priority and tags.")
|
|
(defvar-local 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.")
|
|
(defconst org-plain-time-of-day-regexp
|
(concat
|
"\\(\\<[012]?[0-9]"
|
"\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)"
|
"\\(--?"
|
"\\(\\<[012]?[0-9]"
|
"\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)"
|
"\\)?")
|
"Regular expression to match a plain time or time range.
|
Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following
|
groups carry important information:
|
0 the full match
|
1 the first time, range or not
|
8 the second time, if it is a range.")
|
|
(defconst org-plain-time-extension-regexp
|
(concat
|
"\\(\\<[012]?[0-9]"
|
"\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)"
|
"\\+\\([0-9]+\\)\\(:\\([0-5][0-9]\\)\\)?")
|
"Regular expression to match a time range like 13:30+2:10 = 13:30-15:40.
|
Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following
|
groups carry important information:
|
0 the full match
|
7 hours of duration
|
9 minutes of duration")
|
|
(defconst org-stamp-time-of-day-regexp
|
(concat
|
"<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} +\\sw+ +\\)"
|
"\\([012][0-9]:[0-5][0-9]\\(-\\([012][0-9]:[0-5][0-9]\\)\\)?[^\n\r>]*?\\)>"
|
"\\(--?"
|
"<\\1\\([012][0-9]:[0-5][0-9]\\)>\\)?")
|
"Regular expression to match a timestamp time or time range.
|
After a match, the following groups carry important information:
|
0 the full match
|
1 date plus weekday, for back referencing to make sure both times are on the same day
|
2 the first time, range or not
|
4 the second time, if it is a range.")
|
|
(defconst org-startup-options
|
'(("fold" org-startup-folded t)
|
("overview" org-startup-folded t)
|
("nofold" org-startup-folded nil)
|
("showall" org-startup-folded nil)
|
("showeverything" org-startup-folded showeverything)
|
("content" org-startup-folded content)
|
("indent" org-startup-indented t)
|
("noindent" org-startup-indented nil)
|
("hidestars" org-hide-leading-stars t)
|
("showstars" org-hide-leading-stars nil)
|
("odd" org-odd-levels-only t)
|
("oddeven" org-odd-levels-only nil)
|
("align" org-startup-align-all-tables t)
|
("noalign" org-startup-align-all-tables nil)
|
("inlineimages" org-startup-with-inline-images t)
|
("noinlineimages" org-startup-with-inline-images nil)
|
("latexpreview" org-startup-with-latex-preview t)
|
("nolatexpreview" org-startup-with-latex-preview nil)
|
("customtime" org-display-custom-times t)
|
("logdone" org-log-done time)
|
("lognotedone" org-log-done note)
|
("nologdone" org-log-done nil)
|
("lognoteclock-out" org-log-note-clock-out t)
|
("nolognoteclock-out" org-log-note-clock-out nil)
|
("logrepeat" org-log-repeat state)
|
("lognoterepeat" org-log-repeat note)
|
("logdrawer" org-log-into-drawer t)
|
("nologdrawer" org-log-into-drawer nil)
|
("logstatesreversed" org-log-states-order-reversed t)
|
("nologstatesreversed" org-log-states-order-reversed nil)
|
("nologrepeat" org-log-repeat nil)
|
("logreschedule" org-log-reschedule time)
|
("lognotereschedule" org-log-reschedule note)
|
("nologreschedule" org-log-reschedule nil)
|
("logredeadline" org-log-redeadline time)
|
("lognoteredeadline" org-log-redeadline note)
|
("nologredeadline" org-log-redeadline nil)
|
("logrefile" org-log-refile time)
|
("lognoterefile" org-log-refile note)
|
("nologrefile" org-log-refile nil)
|
("fninline" org-footnote-define-inline t)
|
("nofninline" org-footnote-define-inline nil)
|
("fnlocal" org-footnote-section nil)
|
("fnauto" org-footnote-auto-label t)
|
("fnprompt" org-footnote-auto-label nil)
|
("fnconfirm" org-footnote-auto-label confirm)
|
("fnplain" org-footnote-auto-label plain)
|
("fnadjust" org-footnote-auto-adjust t)
|
("nofnadjust" org-footnote-auto-adjust nil)
|
("constcgs" constants-unit-system cgs)
|
("constSI" constants-unit-system SI)
|
("noptag" org-tag-persistent-alist nil)
|
("hideblocks" org-hide-block-startup t)
|
("nohideblocks" org-hide-block-startup nil)
|
("beamer" org-startup-with-beamer-mode t)
|
("entitiespretty" org-pretty-entities t)
|
("entitiesplain" org-pretty-entities nil))
|
"Variable associated with STARTUP options for Org.
|
Each element is a list of three items: the startup options (as written
|
in the #+STARTUP line), the corresponding variable, and the value to 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.")
|
|
(defcustom org-group-tags t
|
"When non-nil (the default), use group tags.
|
This can be turned on/off through `org-toggle-tags-groups'."
|
:group 'org-tags
|
:group 'org-startup
|
:type 'boolean)
|
|
(defvar org-inhibit-startup nil) ; Dynamically-scoped param.
|
|
(defun org-toggle-tags-groups ()
|
"Toggle support for group tags.
|
Support for group tags is controlled by the option
|
`org-group-tags', which is non-nil by default."
|
(interactive)
|
(setq org-group-tags (not org-group-tags))
|
(cond ((and (derived-mode-p 'org-agenda-mode)
|
org-group-tags)
|
(org-agenda-redo))
|
((derived-mode-p 'org-mode)
|
(let ((org-inhibit-startup t)) (org-mode))))
|
(message "Groups tags support has been turned %s"
|
(if org-group-tags "on" "off")))
|
|
(defun org--tag-add-to-alist (alist1 alist2)
|
"Merge tags from ALIST1 into ALIST2.
|
|
Duplicates tags outside a group are removed. Keywords and order
|
are preserved.
|
|
The function assumes ALIST1 and ALIST2 are proper tag alists.
|
See `org-tag-alist' for their structure."
|
(cond
|
((null alist2) alist1)
|
((null alist1) alist2)
|
(t
|
(let ((to-add nil)
|
(group-flag nil))
|
(dolist (tag-pair alist1)
|
(pcase tag-pair
|
(`(,(or :startgrouptag :startgroup))
|
(setq group-flag t)
|
(push tag-pair to-add))
|
(`(,(or :endgrouptag :endgroup))
|
(setq group-flag nil)
|
(push tag-pair to-add))
|
(`(,(or :grouptags :newline))
|
(push tag-pair to-add))
|
(`(,tag . ,_)
|
;; Remove duplicates from ALIST1, unless they are in
|
;; a group. Indeed, it makes sense to have a tag appear in
|
;; multiple groups.
|
(when (or group-flag (not (assoc tag alist2)))
|
(push tag-pair to-add)))
|
(_ (error "Invalid association in tag alist: %S" tag-pair))))
|
;; Preserve order of ALIST1.
|
(append (nreverse to-add) alist2)))))
|
|
(defun org-set-regexps-and-options (&optional tags-only)
|
"Precompute regular expressions used in the current buffer.
|
When optional argument TAGS-ONLY is non-nil, only compute tags
|
related expressions."
|
(when (derived-mode-p 'org-mode)
|
(let ((alist (org--setup-collect-keywords
|
(org-make-options-regexp
|
(append '("FILETAGS" "TAGS" "SETUPFILE")
|
(and (not tags-only)
|
'("ARCHIVE" "CATEGORY" "COLUMNS" "CONSTANTS"
|
"LINK" "OPTIONS" "PRIORITIES" "PROPERTY"
|
"SEQ_TODO" "STARTUP" "TODO" "TYP_TODO")))))))
|
;; Startup options. Get this early since it does change
|
;; behavior for other options (e.g., tags).
|
(let ((startup (cdr (assq 'startup alist))))
|
(dolist (option startup)
|
(let ((entry (assoc-string option org-startup-options t)))
|
(when entry
|
(let ((var (nth 1 entry))
|
(val (nth 2 entry)))
|
(if (not (nth 3 entry)) (set (make-local-variable var) val)
|
(unless (listp (symbol-value var))
|
(set (make-local-variable var) nil))
|
(add-to-list var val)))))))
|
(setq-local org-file-tags
|
(mapcar #'org-add-prop-inherited
|
(cdr (assq 'filetags alist))))
|
(setq org-current-tag-alist
|
(org--tag-add-to-alist
|
org-tag-persistent-alist
|
(let ((tags (cdr (assq 'tags alist))))
|
(if tags (org-tag-string-to-alist tags)
|
org-tag-alist))))
|
(setq org-tag-groups-alist
|
(org-tag-alist-to-groups org-current-tag-alist))
|
(unless tags-only
|
;; File properties.
|
(setq-local org-file-properties (cdr (assq 'property alist)))
|
;; Archive location.
|
(let ((archive (cdr (assq 'archive alist))))
|
(when archive (setq-local org-archive-location archive)))
|
;; Category.
|
(let ((cat (org-string-nw-p (cdr (assq 'category alist)))))
|
(when cat
|
(setq-local org-category (intern cat))
|
(setq-local org-file-properties
|
(org--update-property-plist
|
"CATEGORY" cat org-file-properties))))
|
;; Columns.
|
(let ((column (cdr (assq 'columns alist))))
|
(when column (setq-local org-columns-default-format column)))
|
;; Constants.
|
(setq org-table-formula-constants-local (cdr (assq 'constants alist)))
|
;; Link abbreviations.
|
(let ((links (cdr (assq 'link alist))))
|
(when links (setq org-link-abbrev-alist-local (nreverse links))))
|
;; Priorities.
|
(let ((priorities (cdr (assq 'priorities alist))))
|
(when priorities
|
(setq-local org-highest-priority (nth 0 priorities))
|
(setq-local org-lowest-priority (nth 1 priorities))
|
(setq-local org-default-priority (nth 2 priorities))))
|
;; Scripts.
|
(let ((scripts (assq 'scripts alist)))
|
(when scripts
|
(setq-local org-use-sub-superscripts (cdr scripts))))
|
;; TODO keywords.
|
(setq-local org-todo-kwd-alist nil)
|
(setq-local org-todo-key-alist nil)
|
(setq-local org-todo-key-trigger nil)
|
(setq-local org-todo-keywords-1 nil)
|
(setq-local org-done-keywords nil)
|
(setq-local org-todo-heads nil)
|
(setq-local org-todo-sets nil)
|
(setq-local org-todo-log-states nil)
|
(let ((todo-sequences
|
(or (nreverse (cdr (assq 'todo alist)))
|
(let ((d (default-value 'org-todo-keywords)))
|
(if (not (stringp (car d))) d
|
;; XXX: Backward compatibility code.
|
(list (cons org-todo-interpretation d)))))))
|
(dolist (sequence todo-sequences)
|
(let* ((sequence (or (run-hook-with-args-until-success
|
'org-todo-setup-filter-hook sequence)
|
sequence))
|
(sequence-type (car sequence))
|
(keywords (cdr sequence))
|
(sep (member "|" keywords))
|
names alist)
|
(dolist (k (remove "|" keywords))
|
(unless (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$"
|
k)
|
(error "Invalid TODO keyword %s" k))
|
(let ((name (match-string 1 k))
|
(key (match-string 2 k))
|
(log (org-extract-log-state-settings k)))
|
(push name names)
|
(push (cons name (and key (string-to-char key))) alist)
|
(when log (push log org-todo-log-states))))
|
(let* ((names (nreverse names))
|
(done (if sep (org-remove-keyword-keys (cdr sep))
|
(last names)))
|
(head (car names))
|
(tail (list sequence-type head (car done) (org-last done))))
|
(add-to-list 'org-todo-heads head 'append)
|
(push names org-todo-sets)
|
(setq org-done-keywords (append org-done-keywords done nil))
|
(setq org-todo-keywords-1 (append org-todo-keywords-1 names nil))
|
(setq org-todo-key-alist
|
(append org-todo-key-alist
|
(and alist
|
(append '((:startgroup))
|
(nreverse alist)
|
'((:endgroup))))))
|
(dolist (k names) (push (cons k tail) org-todo-kwd-alist))))))
|
(setq org-todo-sets (nreverse org-todo-sets)
|
org-todo-kwd-alist (nreverse org-todo-kwd-alist)
|
org-todo-key-trigger (delq nil (mapcar #'cdr org-todo-key-alist))
|
org-todo-key-alist (org-assign-fast-keys org-todo-key-alist))
|
;; 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.
|
(unless org-done-keywords
|
(setq org-done-keywords
|
(and org-todo-keywords-1 (last org-todo-keywords-1))))
|
(setq org-not-done-keywords
|
(org-delete-all org-done-keywords
|
(copy-sequence org-todo-keywords-1))
|
org-todo-regexp (regexp-opt org-todo-keywords-1 t)
|
org-not-done-regexp (regexp-opt org-not-done-keywords t)
|
org-not-done-heading-regexp
|
(format org-heading-keyword-regexp-format org-not-done-regexp)
|
org-todo-line-regexp
|
(format org-heading-keyword-maybe-regexp-format org-todo-regexp)
|
org-complex-heading-regexp
|
(concat "^\\(\\*+\\)"
|
"\\(?: +" org-todo-regexp "\\)?"
|
"\\(?: +\\(\\[#.\\]\\)\\)?"
|
"\\(?: +\\(.*?\\)\\)??"
|
"\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?"
|
"[ \t]*$")
|
org-complex-heading-regexp-format
|
(concat "^\\(\\*+\\)"
|
"\\(?: +" org-todo-regexp "\\)?"
|
"\\(?: +\\(\\[#.\\]\\)\\)?"
|
"\\(?: +"
|
;; Stats cookies can be stuck to body.
|
"\\(?:\\[[0-9%%/]+\\] *\\)*"
|
"\\(%s\\)"
|
"\\(?: *\\[[0-9%%/]+\\]\\)*"
|
"\\)"
|
"\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?"
|
"[ \t]*$")
|
org-todo-line-tags-regexp
|
(concat "^\\(\\*+\\)"
|
"\\(?: +" org-todo-regexp "\\)?"
|
"\\(?: +\\(.*?\\)\\)??"
|
"\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?"
|
"[ \t]*$"))
|
(org-compute-latex-and-related-regexp)))))
|
|
(defun org--setup-collect-keywords (regexp &optional files alist)
|
"Return setup keywords values as an alist.
|
|
REGEXP matches a subset of setup keywords. FILES is a list of
|
file names already visited. It is used to avoid circular setup
|
files. ALIST, when non-nil, is the alist computed so far.
|
|
Return value contains the following keys: `archive', `category',
|
`columns', `constants', `filetags', `link', `priorities',
|
`property', `scripts', `startup', `tags' and `todo'."
|
(org-with-wide-buffer
|
(goto-char (point-min))
|
(let ((case-fold-search t))
|
(while (re-search-forward regexp nil t)
|
(let ((element (org-element-at-point)))
|
(when (eq (org-element-type element) 'keyword)
|
(let ((key (org-element-property :key element))
|
(value (org-element-property :value element)))
|
(cond
|
((equal key "ARCHIVE")
|
(when (org-string-nw-p value)
|
(push (cons 'archive value) alist)))
|
((equal key "CATEGORY") (push (cons 'category value) alist))
|
((equal key "COLUMNS") (push (cons 'columns value) alist))
|
((equal key "CONSTANTS")
|
(let* ((constants (assq 'constants alist))
|
(store (cdr constants)))
|
(dolist (pair (split-string value))
|
(when (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)"
|
pair)
|
(let* ((name (match-string 1 pair))
|
(value (match-string 2 pair))
|
(old (assoc name store)))
|
(if old (setcdr old value)
|
(push (cons name value) store)))))
|
(if constants (setcdr constants store)
|
(push (cons 'constants store) alist))))
|
((equal key "FILETAGS")
|
(when (org-string-nw-p value)
|
(let ((old (assq 'filetags alist))
|
(new (apply #'nconc
|
(mapcar (lambda (x) (org-split-string x ":"))
|
(split-string value)))))
|
(if old (setcdr old (append new (cdr old)))
|
(push (cons 'filetags new) alist)))))
|
((equal key "LINK")
|
(when (string-match "\\`\\(\\S-+\\)[ \t]+\\(.+\\)" value)
|
(let ((links (assq 'link alist))
|
(pair (cons (match-string-no-properties 1 value)
|
(match-string-no-properties 2 value))))
|
(if links (push pair (cdr links))
|
(push (list 'link pair) alist)))))
|
((equal key "OPTIONS")
|
(when (and (org-string-nw-p value)
|
(string-match "\\^:\\(t\\|nil\\|{}\\)" value))
|
(push (cons 'scripts (read (match-string 1 value))) alist)))
|
((equal key "PRIORITIES")
|
(push (cons 'priorities
|
(let ((prio (split-string value)))
|
(if (< (length prio) 3) '(?A ?C ?B)
|
(mapcar #'string-to-char prio))))
|
alist))
|
((equal key "PROPERTY")
|
(when (string-match "\\(\\S-+\\)[ \t]+\\(.*\\)" value)
|
(let* ((property (assq 'property alist))
|
(value (org--update-property-plist
|
(match-string-no-properties 1 value)
|
(match-string-no-properties 2 value)
|
(cdr property))))
|
(if property (setcdr property value)
|
(push (cons 'property value) alist)))))
|
((equal key "STARTUP")
|
(let ((startup (assq 'startup alist)))
|
(if startup
|
(setcdr startup
|
(append (cdr startup) (split-string value)))
|
(push (cons 'startup (split-string value)) alist))))
|
((equal key "TAGS")
|
(let ((tag-cell (assq 'tags alist)))
|
(if tag-cell
|
(setcdr tag-cell (concat (cdr tag-cell) "\n" value))
|
(push (cons 'tags value) alist))))
|
((member key '("TODO" "SEQ_TODO" "TYP_TODO"))
|
(let ((todo (assq 'todo alist))
|
(value (cons (if (equal key "TYP_TODO") 'type 'sequence)
|
(split-string value))))
|
(if todo (push value (cdr todo))
|
(push (list 'todo value) alist))))
|
((equal key "SETUPFILE")
|
(unless buffer-read-only ; Do not check in Gnus messages.
|
(let ((f (and (org-string-nw-p value)
|
(expand-file-name
|
(org-unbracket-string "\"" "\"" value)))))
|
(when (and f (file-readable-p f) (not (member f files)))
|
(with-temp-buffer
|
(setq default-directory (file-name-directory f))
|
(insert-file-contents f)
|
(setq alist
|
;; Fake Org mode to benefit from cache
|
;; without recurring needlessly.
|
(let ((major-mode 'org-mode))
|
(org--setup-collect-keywords
|
regexp (cons f files) alist)))))))))))))))
|
alist)
|
|
(defun org-tag-string-to-alist (s)
|
"Return tag alist associated to string S.
|
S is a value for TAGS keyword or produced with
|
`org-tag-alist-to-string'. Return value is an alist suitable for
|
`org-tag-alist' or `org-tag-persistent-alist'."
|
(let ((lines (mapcar #'split-string (split-string s "\n" t)))
|
(tag-re (concat "\\`\\([[:alnum:]_@#%]+"
|
"\\|{.+?}\\)" ; regular expression
|
"\\(?:(\\(.\\))\\)?\\'"))
|
alist group-flag)
|
(dolist (tokens lines (cdr (nreverse alist)))
|
(push '(:newline) alist)
|
(while tokens
|
(let ((token (pop tokens)))
|
(pcase token
|
("{"
|
(push '(:startgroup) alist)
|
(when (equal (nth 1 tokens) ":") (setq group-flag t)))
|
("}"
|
(push '(:endgroup) alist)
|
(setq group-flag nil))
|
("["
|
(push '(:startgrouptag) alist)
|
(when (equal (nth 1 tokens) ":") (setq group-flag t)))
|
("]"
|
(push '(:endgrouptag) alist)
|
(setq group-flag nil))
|
(":"
|
(push '(:grouptags) alist))
|
((guard (string-match tag-re token))
|
(let ((tag (match-string 1 token))
|
(key (and (match-beginning 2)
|
(string-to-char (match-string 2 token)))))
|
;; Push all tags in groups, no matter if they already
|
;; appear somewhere else in the list.
|
(when (or group-flag (not (assoc tag alist)))
|
(push (cons tag key) alist))))))))))
|
|
(defun org-tag-alist-to-string (alist &optional skip-key)
|
"Return tag string associated to ALIST.
|
|
ALIST is an alist, as defined in `org-tag-alist' or
|
`org-tag-persistent-alist', or produced with
|
`org-tag-string-to-alist'.
|
|
Return value is a string suitable as a value for \"TAGS\"
|
keyword.
|
|
When optional argument SKIP-KEY is non-nil, skip selection keys
|
next to tags."
|
(mapconcat (lambda (token)
|
(pcase token
|
(`(:startgroup) "{")
|
(`(:endgroup) "}")
|
(`(:startgrouptag) "[")
|
(`(:endgrouptag) "]")
|
(`(:grouptags) ":")
|
(`(:newline) "\\n")
|
((and
|
(guard (not skip-key))
|
`(,(and tag (pred stringp)) . ,(and key (pred characterp))))
|
(format "%s(%c)" tag key))
|
(`(,(and tag (pred stringp)) . ,_) tag)
|
(_ (user-error "Invalid tag token: %S" token))))
|
alist
|
" "))
|
|
(defun org-tag-alist-to-groups (alist)
|
"Return group alist from tag ALIST.
|
ALIST is an alist, as defined in `org-tag-alist' or
|
`org-tag-persistent-alist', or produced with
|
`org-tag-string-to-alist'. Return value is an alist following
|
the pattern (GROUP-TAG TAGS) where GROUP-TAG is the tag, as
|
a string, summarizing TAGS, as a list of strings."
|
(let (groups group-status current-group)
|
(dolist (token alist (nreverse groups))
|
(pcase token
|
(`(,(or :startgroup :startgrouptag)) (setq group-status t))
|
(`(,(or :endgroup :endgrouptag))
|
(when (eq group-status 'append)
|
(push (nreverse current-group) groups))
|
(setq group-status nil current-group nil))
|
(`(:grouptags) (setq group-status 'append))
|
((and `(,tag . ,_) (guard group-status))
|
(if (eq group-status 'append) (push tag current-group)
|
(setq current-group (list tag))))
|
(_ nil)))))
|
|
(defvar org--file-cache (make-hash-table :test #'equal)
|
"Hash table to store contents of files referenced via a URL.
|
This is the cache of file URLs read using `org-file-contents'.")
|
|
(defun org-reset-file-cache ()
|
"Reset the cache of files downloaded by `org-file-contents'."
|
(clrhash org--file-cache))
|
|
(defun org-file-url-p (file)
|
"Non-nil if FILE is a URL."
|
(require 'ffap)
|
(string-match-p ffap-url-regexp file))
|
|
(defun org-file-contents (file &optional noerror nocache)
|
"Return the contents of FILE, as a string.
|
|
FILE can be a file name or URL.
|
|
If FILE is a URL, download the contents. If the URL contents are
|
already cached in the `org--file-cache' hash table, the download step
|
is skipped.
|
|
If NOERROR is non-nil, ignore the error when unable to read the FILE
|
from file or URL.
|
|
If NOCACHE is non-nil, do a fresh fetch of FILE even if cached version
|
is available. This option applies only if FILE is a URL."
|
(let* ((is-url (org-file-url-p file))
|
(cache (and is-url
|
(not nocache)
|
(gethash file org--file-cache))))
|
(cond
|
(cache)
|
(is-url
|
(with-current-buffer (url-retrieve-synchronously file)
|
(goto-char (point-min))
|
;; Move point to after the url-retrieve header.
|
(search-forward "\n\n" nil :move)
|
;; Search for the success code only in the url-retrieve header.
|
(if (save-excursion
|
(re-search-backward "HTTP.*\\s-+200\\s-OK" nil :noerror))
|
;; Update the cache `org--file-cache' and return contents.
|
(puthash file
|
(buffer-substring-no-properties (point) (point-max))
|
org--file-cache)
|
(funcall (if noerror #'message #'user-error)
|
"Unable to fetch file from %S"
|
file))))
|
(t
|
(with-temp-buffer
|
(condition-case nil
|
(progn
|
(insert-file-contents file)
|
(buffer-string))
|
(file-error
|
(funcall (if noerror #'message #'user-error)
|
"Unable to read file %S"
|
file))))))))
|
|
(defun org-extract-log-state-settings (x)
|
"Extract the log state setting from a TODO keyword string.
|
This will extract info from a string like \"WAIT(w@/!)\"."
|
(when (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?\\([!@]\\)?\\(?:/\\([!@]\\)\\)?)\\)?$" x)
|
(let ((kw (match-string 1 x))
|
(log1 (and (match-end 3) (match-string 3 x)))
|
(log2 (and (match-end 4) (match-string 4 x))))
|
(and (or log1 log2)
|
(list kw
|
(and log1 (if (equal log1 "!") 'time 'note))
|
(and log2 (if (equal log2 "!") 'time 'note)))))))
|
|
(defun org-remove-keyword-keys (list)
|
"Remove a pair of parenthesis at the end of each string in LIST."
|
(mapcar (lambda (x)
|
(if (string-match "(.*)$" x)
|
(substring x 0 (match-beginning 0))
|
x))
|
list))
|
|
(defun org-assign-fast-keys (alist)
|
"Assign fast keys to a keyword-key alist.
|
Respect keys that are already there."
|
(let (new e (alt ?0))
|
(while (setq e (pop alist))
|
(if (or (memq (car e) '(:newline :grouptags :endgroup :startgroup))
|
(cdr e)) ;; Key already assigned.
|
(push e new)
|
(let ((clist (string-to-list (downcase (car e))))
|
(used (append new alist)))
|
(when (= (car clist) ?@)
|
(pop clist))
|
(while (and clist (rassoc (car clist) used))
|
(pop clist))
|
(unless clist
|
(while (rassoc alt used)
|
(cl-incf alt)))
|
(push (cons (car e) (or (car clist) alt)) new))))
|
(nreverse new)))
|
|
;;; Some variables used in various places
|
|
(defvar org-window-configuration nil
|
"Used in various places to store a window configuration.")
|
(defvar org-selected-window nil
|
"Used in various places to store a window configuration.")
|
(defvar org-finish-function nil
|
"Function to be called when `C-c C-c' is used.
|
This is for getting out of special buffers like capture.")
|
(defvar org-last-state)
|
|
;; Defined somewhere in this file, but used before definition.
|
(defvar org-entities) ;; defined in org-entities.el
|
(defvar org-struct-menu)
|
(defvar org-org-menu)
|
(defvar org-tbl-menu)
|
|
;;;; Define the Org mode
|
|
;; We use a before-change function to check if a table might need
|
;; an update.
|
(defvar org-table-may-need-update t
|
"Indicates that a table might need an update.
|
This variable is set by `org-before-change-function'.
|
`org-table-align' sets it back to nil.")
|
(defun org-before-change-function (_beg _end)
|
"Every change indicates that a table might need an update."
|
(setq org-table-may-need-update t))
|
(defvar org-mode-map)
|
(defvar org-inhibit-startup-visibility-stuff nil) ; Dynamically-scoped param.
|
(defvar org-agenda-keep-modes nil) ; Dynamically-scoped param.
|
(defvar org-inhibit-logging nil) ; Dynamically-scoped param.
|
(defvar org-inhibit-blocking nil) ; Dynamically-scoped param.
|
(defvar org-table-buffer-is-an nil)
|
|
(defvar bidi-paragraph-direction)
|
(defvar buffer-face-mode-face)
|
|
(require 'outline)
|
|
;; Other stuff we need.
|
(require 'time-date)
|
(unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time))
|
(require 'easymenu)
|
(autoload 'easy-menu-add "easymenu")
|
(require 'overlay)
|
|
;; (require 'org-macs) moved higher up in the file before it is first used
|
(require 'org-entities)
|
;; (require 'org-compat) moved higher up in the file before it is first used
|
(require 'org-faces)
|
(require 'org-list)
|
(require 'org-pcomplete)
|
(require 'org-src)
|
(require 'org-footnote)
|
(require 'org-macro)
|
|
;; babel
|
(require 'ob)
|
|
;;;###autoload
|
(define-derived-mode org-mode outline-mode "Org"
|
"Outline-based notes management and organizer, alias
|
\"Carsten's outline-mode for keeping track of everything.\"
|
|
Org mode develops organizational tasks around a NOTES file which
|
contains information about projects as plain text. Org mode is
|
implemented on top of Outline mode, which is ideal to keep the content
|
of large files well structured. It supports ToDo items, deadlines and
|
time stamps, which magically appear in the diary listing of the Emacs
|
calendar. Tables are easily created with a built-in table editor.
|
Plain text URL-like links connect to websites, emails (VM), Usenet
|
messages (Gnus), BBDB entries, and any files related to the project.
|
For printing and sharing of notes, an Org file (or a part of it)
|
can be exported as a structured ASCII or HTML file.
|
|
The following commands are available:
|
|
\\{org-mode-map}"
|
|
;; Get rid of Outline menus, they are not needed
|
;; Need to do this here because define-derived-mode sets up
|
;; the keymap so late. Still, it is a waste to call this each time
|
;; we switch another buffer into Org mode.
|
(define-key org-mode-map [menu-bar headings] 'undefined)
|
(define-key org-mode-map [menu-bar hide] 'undefined)
|
(define-key org-mode-map [menu-bar show] 'undefined)
|
|
(org-load-modules-maybe)
|
(org-install-agenda-files-menu)
|
(when org-descriptive-links (add-to-invisibility-spec '(org-link)))
|
(add-to-invisibility-spec '(org-cwidth))
|
(add-to-invisibility-spec '(org-hide-block . t))
|
(setq-local outline-regexp org-outline-regexp)
|
(setq-local outline-level 'org-outline-level)
|
(setq bidi-paragraph-direction 'left-to-right)
|
(when (and (stringp org-ellipsis) (not (equal "" org-ellipsis)))
|
(unless org-display-table
|
(setq org-display-table (make-display-table)))
|
(set-display-table-slot
|
org-display-table 4
|
(vconcat (mapcar (lambda (c) (make-glyph-code c 'org-ellipsis))
|
org-ellipsis)))
|
(setq buffer-display-table org-display-table))
|
(org-set-regexps-and-options)
|
(org-set-font-lock-defaults)
|
(when (and org-tag-faces (not org-tags-special-faces-re))
|
;; tag faces set outside customize.... force initialization.
|
(org-set-tag-faces 'org-tag-faces org-tag-faces))
|
;; Calc embedded
|
(setq-local calc-embedded-open-mode "# ")
|
;; Modify a few syntax entries
|
(modify-syntax-entry ?@ "w")
|
(modify-syntax-entry ?\" "\"")
|
(modify-syntax-entry ?\\ "_")
|
(modify-syntax-entry ?~ "_")
|
(setq-local font-lock-unfontify-region-function 'org-unfontify-region)
|
;; Activate before-change-function
|
(setq-local org-table-may-need-update t)
|
(add-hook 'before-change-functions 'org-before-change-function nil 'local)
|
;; Check for running clock before killing a buffer
|
(add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local)
|
;; Initialize macros templates.
|
(org-macro-initialize-templates)
|
;; Initialize radio targets.
|
(org-update-radio-target-regexp)
|
;; Indentation.
|
(setq-local indent-line-function 'org-indent-line)
|
(setq-local indent-region-function 'org-indent-region)
|
;; Filling and auto-filling.
|
(org-setup-filling)
|
;; Comments.
|
(org-setup-comments-handling)
|
;; Initialize cache.
|
(org-element-cache-reset)
|
;; Beginning/end of defun
|
(setq-local beginning-of-defun-function 'org-backward-element)
|
(setq-local end-of-defun-function
|
(lambda ()
|
(if (not (org-at-heading-p))
|
(org-forward-element)
|
(org-forward-element)
|
(forward-char -1))))
|
;; Next error for sparse trees
|
(setq-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
|
(add-hook 'org-blocker-hook
|
'org-block-todo-from-children-or-siblings-or-parent)
|
(remove-hook 'org-blocker-hook
|
'org-block-todo-from-children-or-siblings-or-parent))
|
(if org-enforce-todo-checkbox-dependencies
|
(add-hook 'org-blocker-hook
|
'org-block-todo-from-checkboxes)
|
(remove-hook 'org-blocker-hook
|
'org-block-todo-from-checkboxes))
|
|
;; Align options lines
|
(setq-local
|
align-mode-rules-list
|
'((org-in-buffer-settings
|
(regexp . "^[ \t]*#\\+[A-Z_]+:\\(\\s-*\\)\\S-+")
|
(modes . '(org-mode)))))
|
|
;; Imenu
|
(setq-local imenu-create-index-function 'org-imenu-get-tree)
|
|
;; Make isearch reveal context
|
(setq-local outline-isearch-open-invisible-function
|
(lambda (&rest _) (org-show-context 'isearch)))
|
|
;; Setup the pcomplete hooks
|
(setq-local pcomplete-command-completion-function 'org-pcomplete-initial)
|
(setq-local pcomplete-command-name-function 'org-command-at-point)
|
(setq-local pcomplete-default-completion-function 'ignore)
|
(setq-local pcomplete-parse-arguments-function 'org-parse-arguments)
|
(setq-local pcomplete-termination-string "")
|
(setq-local buffer-face-mode-face 'org-default)
|
|
;; If empty file that did not turn on Org mode automatically, make
|
;; it to.
|
(when (and org-insert-mode-line-in-empty-file
|
(called-interactively-p 'any)
|
(= (point-min) (point-max)))
|
(insert "# -*- mode: org -*-\n\n"))
|
(unless org-inhibit-startup
|
(org-unmodified
|
(when org-startup-with-beamer-mode (org-beamer-mode))
|
(when org-startup-align-all-tables
|
(org-table-map-tables #'org-table-align t))
|
(when org-startup-with-inline-images (org-display-inline-images))
|
(when org-startup-with-latex-preview (org-toggle-latex-fragment '(16)))
|
(unless org-inhibit-startup-visibility-stuff (org-set-startup-visibility))
|
(when org-startup-truncated (setq truncate-lines t))
|
(when org-startup-indented (require 'org-indent) (org-indent-mode 1))
|
(org-refresh-effort-properties)))
|
;; Try to set `org-hide' face correctly.
|
(let ((foreground (org-find-invisible-foreground)))
|
(when foreground
|
(set-face-foreground 'org-hide foreground))))
|
|
;; Update `customize-package-emacs-version-alist'
|
(add-to-list 'customize-package-emacs-version-alist
|
'(Org ("8.0" . "24.4")
|
("8.1" . "24.4")
|
("8.2" . "24.4")
|
("8.2.7" . "24.4")
|
("8.3" . "26.1")
|
("9.0" . "26.1")
|
("9.1" . "26.1")))
|
|
(defvar org-mode-transpose-word-syntax-table
|
(let ((st (make-syntax-table text-mode-syntax-table)))
|
(dolist (c org-emphasis-alist st)
|
(modify-syntax-entry (string-to-char (car c)) "w p" st))))
|
|
(when (fboundp 'abbrev-table-put)
|
(abbrev-table-put org-mode-abbrev-table
|
:parents (list text-mode-abbrev-table)))
|
|
(defun org-find-invisible-foreground ()
|
(let ((candidates (remove
|
"unspecified-bg"
|
(nconc
|
(list (face-background 'default)
|
(face-background 'org-default))
|
(mapcar
|
(lambda (alist)
|
(when (boundp alist)
|
(cdr (assq 'background-color (symbol-value alist)))))
|
'(default-frame-alist initial-frame-alist window-system-default-frame-alist))
|
(list (face-foreground 'org-hide))))))
|
(car (remove nil candidates))))
|
|
(defun org-current-time (&optional rounding-minutes past)
|
"Current time, possibly rounded to ROUNDING-MINUTES.
|
When ROUNDING-MINUTES is not an integer, fall back on the car of
|
`org-time-stamp-rounding-minutes'. When PAST is non-nil, ensure
|
the rounding returns a past time."
|
(let ((r (or (and (integerp rounding-minutes) rounding-minutes)
|
(car org-time-stamp-rounding-minutes)))
|
(time (decode-time)) res)
|
(if (< r 1)
|
(current-time)
|
(setq res
|
(apply 'encode-time
|
(append (list 0 (* r (floor (+ .5 (/ (float (nth 1 time)) r)))))
|
(nthcdr 2 time))))
|
(if (and past (< (float-time (time-subtract (current-time) res)) 0))
|
(seconds-to-time (- (float-time res) (* r 60)))
|
res))))
|
|
(defun org-today ()
|
"Return today date, considering `org-extend-today-until'."
|
(time-to-days
|
(time-subtract (current-time)
|
(list 0 (* 3600 org-extend-today-until) 0))))
|
|
;;;; Font-Lock stuff, including the activators
|
|
(defvar org-mouse-map (make-sparse-keymap))
|
(org-defkey org-mouse-map [mouse-2] 'org-open-at-mouse)
|
(org-defkey org-mouse-map [mouse-3] 'org-find-file-at-mouse)
|
(when org-mouse-1-follows-link
|
(org-defkey org-mouse-map [follow-link] 'mouse-face))
|
(when org-tab-follows-link
|
(org-defkey org-mouse-map [(tab)] 'org-open-at-point)
|
(org-defkey org-mouse-map "\C-i" 'org-open-at-point))
|
|
(require 'font-lock)
|
|
(defconst org-non-link-chars "]\t\n\r<>")
|
(defvar org-link-types-re nil
|
"Matches a link that has a url-like prefix like \"http:\"")
|
(defvar org-link-re-with-space nil
|
"Matches a link with spaces, optional angular brackets around it.")
|
(defvar org-link-re-with-space2 nil
|
"Matches a link with spaces, optional angular brackets around it.")
|
(defvar org-link-re-with-space3 nil
|
"Matches a link with spaces, only for internal part in bracket links.")
|
(defvar org-angle-link-re nil
|
"Matches link with angular brackets, spaces are allowed.")
|
(defvar org-plain-link-re nil
|
"Matches plain link, without spaces.")
|
(defvar org-bracket-link-regexp nil
|
"Matches a link in double brackets.")
|
(defvar org-bracket-link-analytic-regexp nil
|
"Regular expression used to analyze links.
|
Here is what the match groups contain after a match:
|
1: http:
|
2: http
|
3: path
|
4: [desc]
|
5: desc")
|
(defvar org-bracket-link-analytic-regexp++ nil
|
"Like `org-bracket-link-analytic-regexp', but include coderef internal type.")
|
(defvar org-any-link-re nil
|
"Regular expression matching any link.")
|
|
(defconst org-match-sexp-depth 3
|
"Number of stacked braces for sub/superscript matching.")
|
|
(defun org-create-multibrace-regexp (left right n)
|
"Create a regular expression which will match a balanced sexp.
|
Opening delimiter is LEFT, and closing delimiter is RIGHT, both given
|
as single character strings.
|
The regexp returned will match the entire expression including the
|
delimiters. It will also define a single group which contains the
|
match except for the outermost delimiters. The maximum depth of
|
stacked delimiters is N. Escaping delimiters is not possible."
|
(let* ((nothing (concat "[^" left right "]*?"))
|
(or "\\|")
|
(re nothing)
|
(next (concat "\\(?:" nothing left nothing right "\\)+" nothing)))
|
(while (> n 1)
|
(setq n (1- n)
|
re (concat re or next)
|
next (concat "\\(?:" nothing left next right "\\)+" nothing)))
|
(concat left "\\(" re "\\)" right)))
|
|
(defconst org-match-substring-regexp
|
(concat
|
"\\(\\S-\\)\\([_^]\\)\\("
|
"\\(?:" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)"
|
"\\|"
|
"\\(?:" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)"
|
"\\|"
|
"\\(?:\\*\\|[+-]?[[:alnum:].,\\]*[[:alnum:]]\\)\\)")
|
"The regular expression matching a sub- or superscript.")
|
|
(defconst org-match-substring-with-braces-regexp
|
(concat
|
"\\(\\S-\\)\\([_^]\\)"
|
"\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)")
|
"The regular expression matching a sub- or superscript, forcing braces.")
|
|
(defun org-make-link-regexps ()
|
"Update the link regular expressions.
|
This should be called after the variable `org-link-parameters' has changed."
|
(let ((types-re (regexp-opt (org-link-types) t)))
|
(setq org-link-types-re
|
(concat "\\`" types-re ":")
|
org-link-re-with-space
|
(concat "<?" types-re ":"
|
"\\([^" org-non-link-chars " ]"
|
"[^" org-non-link-chars "]*"
|
"[^" org-non-link-chars " ]\\)>?")
|
org-link-re-with-space2
|
(concat "<?" types-re ":"
|
"\\([^" org-non-link-chars " ]"
|
"[^\t\n\r]*"
|
"[^" org-non-link-chars " ]\\)>?")
|
org-link-re-with-space3
|
(concat "<?" types-re ":"
|
"\\([^" org-non-link-chars " ]"
|
"[^\t\n\r]*\\)")
|
org-angle-link-re
|
(format "<%s:\\([^>\n]*\\(?:\n[ \t]*[^> \t\n][^>\n]*\\)*\\)>"
|
types-re)
|
org-plain-link-re
|
(concat
|
"\\<" types-re ":"
|
"\\([^][ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)")
|
;; "\\([^]\t\n\r<>() ]+[^]\t\n\r<>,.;() ]\\)")
|
org-bracket-link-regexp
|
"\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]"
|
org-bracket-link-analytic-regexp
|
(concat
|
"\\[\\["
|
"\\(" types-re ":\\)?"
|
"\\([^]]+\\)"
|
"\\]"
|
"\\(\\[" "\\([^]]+\\)" "\\]\\)?"
|
"\\]")
|
org-bracket-link-analytic-regexp++
|
(concat
|
"\\[\\["
|
"\\(" (regexp-opt (cons "coderef" (org-link-types)) t) ":\\)?"
|
"\\([^]]+\\)"
|
"\\]"
|
"\\(\\[" "\\([^]]+\\)" "\\]\\)?"
|
"\\]")
|
org-any-link-re
|
(concat "\\(" org-bracket-link-regexp "\\)\\|\\("
|
org-angle-link-re "\\)\\|\\("
|
org-plain-link-re "\\)"))))
|
|
(org-make-link-regexps)
|
|
(defvar org-emph-face nil)
|
|
(defun org-do-emphasis-faces (limit)
|
"Run through the buffer and emphasize strings."
|
(let ((quick-re (format "\\([%s]\\|^\\)\\([~=*/_+]\\)"
|
(car org-emphasis-regexp-components))))
|
(catch :exit
|
(while (re-search-forward quick-re limit t)
|
(let* ((marker (match-string 2))
|
(verbatim? (member marker '("~" "="))))
|
(when (save-excursion
|
(goto-char (match-beginning 0))
|
(and
|
;; Do not match table hlines.
|
(not (and (equal marker "+")
|
(org-match-line
|
"[ \t]*\\(|[-+]+|?\\|\\+[-+]+\\+\\)[ \t]*$")))
|
;; Do not match headline stars. Do not consider
|
;; stars of a headline as closing marker for bold
|
;; markup either.
|
(not (and (equal marker "*")
|
(save-excursion
|
(forward-char)
|
(skip-chars-backward "*")
|
(looking-at-p org-outline-regexp-bol))))
|
;; Match full emphasis markup regexp.
|
(looking-at (if verbatim? org-verbatim-re org-emph-re))
|
;; Do not span over paragraph boundaries.
|
(not (string-match-p org-element-paragraph-separate
|
(match-string 2)))
|
;; Do not span over cells in table rows.
|
(not (and (save-match-data (org-match-line "[ \t]*|"))
|
(string-match-p "|" (match-string 4))))))
|
(pcase-let ((`(,_ ,face ,_) (assoc marker org-emphasis-alist)))
|
(font-lock-prepend-text-property
|
(match-beginning 2) (match-end 2) 'face face)
|
(when verbatim?
|
(org-remove-flyspell-overlays-in
|
(match-beginning 0) (match-end 0)))
|
(add-text-properties (match-beginning 2) (match-end 2)
|
'(font-lock-multiline t org-emphasis t))
|
(when org-hide-emphasis-markers
|
(add-text-properties (match-end 4) (match-beginning 5)
|
'(invisible org-link))
|
(add-text-properties (match-beginning 3) (match-end 3)
|
'(invisible org-link)))
|
(throw :exit t))))))))
|
|
(defun org-emphasize (&optional char)
|
"Insert or change an emphasis, i.e. a font like bold or italic.
|
If there is an active region, change that region to a new emphasis.
|
If there is no region, just insert the marker characters and position
|
the cursor between them.
|
CHAR should be the marker character. If it is a space, it means to
|
remove the emphasis of the selected region.
|
If CHAR is not given (for example in an interactive call) it will be
|
prompted for."
|
(interactive)
|
(let ((erc org-emphasis-regexp-components)
|
(string "") beg end move s)
|
(if (org-region-active-p)
|
(setq beg (region-beginning)
|
end (region-end)
|
string (buffer-substring beg end))
|
(setq move t))
|
|
(unless char
|
(message "Emphasis marker or tag: [%s]"
|
(mapconcat #'car org-emphasis-alist ""))
|
(setq char (read-char-exclusive)))
|
(if (equal char ?\s)
|
(setq s ""
|
move nil)
|
(unless (assoc (char-to-string char) org-emphasis-alist)
|
(user-error "No such emphasis marker: \"%c\"" char))
|
(setq s (char-to-string char)))
|
(while (and (> (length string) 1)
|
(equal (substring string 0 1) (substring string -1))
|
(assoc (substring string 0 1) org-emphasis-alist))
|
(setq string (substring string 1 -1)))
|
(setq string (concat s string s))
|
(when beg (delete-region beg end))
|
(unless (or (bolp)
|
(string-match (concat "[" (nth 0 erc) "\n]")
|
(char-to-string (char-before (point)))))
|
(insert " "))
|
(unless (or (eobp)
|
(string-match (concat "[" (nth 1 erc) "\n]")
|
(char-to-string (char-after (point)))))
|
(insert " ") (backward-char 1))
|
(insert string)
|
(and move (backward-char 1))))
|
|
(defconst org-nonsticky-props
|
'(mouse-face highlight keymap invisible intangible help-echo org-linked-text htmlize-link))
|
|
(defsubst org-rear-nonsticky-at (pos)
|
(add-text-properties (1- pos) pos (list 'rear-nonsticky org-nonsticky-props)))
|
|
(defun org-activate-links (limit)
|
"Add link properties to links.
|
This includes angle, plain, and bracket links."
|
(catch :exit
|
(while (re-search-forward org-any-link-re limit t)
|
(let* ((start (match-beginning 0))
|
(end (match-end 0))
|
(style (cond ((eq ?< (char-after start)) 'angle)
|
((eq ?\[ (char-after (1+ start))) 'bracket)
|
(t 'plain))))
|
(when (and (memq style org-highlight-links)
|
;; Do not confuse plain links with tags.
|
(not (and (eq style 'plain)
|
(let ((face (get-text-property
|
(max (1- start) (point-min)) 'face)))
|
(if (consp face) (memq 'org-tag face)
|
(eq 'org-tag face))))))
|
(let* ((link-object (save-excursion
|
(goto-char start)
|
(save-match-data (org-element-link-parser))))
|
(link (org-element-property :raw-link link-object))
|
(type (org-element-property :type link-object))
|
(path (org-element-property :path link-object))
|
(properties ;for link's visible part
|
(list
|
'face (pcase (org-link-get-parameter type :face)
|
((and (pred functionp) face) (funcall face path))
|
((and (pred facep) face) face)
|
((and (pred consp) face) face) ;anonymous
|
(_ 'org-link))
|
'mouse-face (or (org-link-get-parameter type :mouse-face)
|
'highlight)
|
'keymap (or (org-link-get-parameter type :keymap)
|
org-mouse-map)
|
'help-echo (pcase (org-link-get-parameter type :help-echo)
|
((and (pred stringp) echo) echo)
|
((and (pred functionp) echo) echo)
|
(_ (concat "LINK: " link)))
|
'htmlize-link (pcase (org-link-get-parameter type
|
:htmlize-link)
|
((and (pred functionp) f) (funcall f))
|
(_ `(:uri ,link)))
|
'font-lock-multiline t)))
|
(org-remove-flyspell-overlays-in start end)
|
(org-rear-nonsticky-at end)
|
(if (not (eq 'bracket style))
|
(add-text-properties start end properties)
|
;; Handle invisible parts in bracket links.
|
(remove-text-properties start end '(invisible nil))
|
(let ((hidden
|
(append `(invisible
|
,(or (org-link-get-parameter type :display)
|
'org-link))
|
properties))
|
(visible-start (or (match-beginning 4) (match-beginning 2)))
|
(visible-end (or (match-end 4) (match-end 2))))
|
(add-text-properties start visible-start hidden)
|
(add-text-properties visible-start visible-end properties)
|
(add-text-properties visible-end end hidden)
|
(org-rear-nonsticky-at visible-start)
|
(org-rear-nonsticky-at visible-end)))
|
(let ((f (org-link-get-parameter type :activate-func)))
|
(when (functionp f)
|
(funcall f start end path (eq style 'bracket))))
|
(throw :exit t))))) ;signal success
|
nil))
|
|
(defun org-activate-code (limit)
|
(when (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t)
|
(org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
|
(remove-text-properties (match-beginning 0) (match-end 0)
|
'(display t invisible t intangible t))
|
t))
|
|
(defcustom org-src-fontify-natively t
|
"When non-nil, fontify code in code blocks.
|
See also the `org-block' face."
|
:type 'boolean
|
:version "26.1"
|
:package-version '(Org . "8.3")
|
:group 'org-appearance
|
:group 'org-babel)
|
|
(defcustom org-allow-promoting-top-level-subtree nil
|
"When non-nil, allow promoting a top level subtree.
|
The leading star of the top level headline will be replaced
|
by a #."
|
:type 'boolean
|
:version "24.1"
|
:group 'org-appearance)
|
|
(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 in %S at %d"
|
(current-buffer)
|
(line-number-at-pos)))))
|
|
(defun org-fontify-meta-lines-and-blocks-1 (limit)
|
"Fontify #+ lines and blocks."
|
(let ((case-fold-search t))
|
(when (re-search-forward
|
"^\\([ \t]*#\\(\\(\\+[a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)"
|
limit t)
|
(let ((beg (match-beginning 0))
|
(block-start (match-end 0))
|
(block-end nil)
|
(lang (match-string 7))
|
(beg1 (line-beginning-position 2))
|
(dc1 (downcase (match-string 2)))
|
(dc3 (downcase (match-string 3)))
|
end end1 quoting block-type)
|
(cond
|
((and (match-end 4) (equal dc3 "+begin"))
|
;; Truly a block
|
(setq block-type (downcase (match-string 5))
|
quoting (member block-type org-protecting-blocks))
|
(when (re-search-forward
|
(concat "^[ \t]*#\\+end" (match-string 4) "\\>.*")
|
nil t) ;; on purpose, we look further than LIMIT
|
(setq end (min (point-max) (match-end 0))
|
end1 (min (point-max) (1- (match-beginning 0))))
|
(setq block-end (match-beginning 0))
|
(when quoting
|
(org-remove-flyspell-overlays-in beg1 end1)
|
(remove-text-properties beg end
|
'(display t invisible t intangible t)))
|
(add-text-properties
|
beg end '(font-lock-fontified t font-lock-multiline t))
|
(add-text-properties beg beg1 '(face org-meta-line))
|
(org-remove-flyspell-overlays-in beg beg1)
|
(add-text-properties ; For end_src
|
end1 (min (point-max) (1+ end)) '(face org-meta-line))
|
(org-remove-flyspell-overlays-in end1 end)
|
(cond
|
((and lang (not (string= lang "")) org-src-fontify-natively)
|
(org-src-font-lock-fontify-block lang block-start block-end)
|
(add-text-properties beg1 block-end '(src-block t)))
|
(quoting
|
(add-text-properties beg1 (min (point-max) (1+ end1))
|
(list 'face
|
(list :inherit
|
(let ((face-name
|
(intern (format "org-block-%s" lang))))
|
(append (and (facep face-name) (list face-name))
|
'(org-block))))))) ; end of source block
|
((not org-fontify-quote-and-verse-blocks))
|
((string= block-type "quote")
|
(add-face-text-property
|
beg1 (min (point-max) (1+ end1)) 'org-quote t))
|
((string= block-type "verse")
|
(add-face-text-property
|
beg1 (min (point-max) (1+ end1)) 'org-verse t)))
|
(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:"))
|
(org-remove-flyspell-overlays-in
|
(match-beginning 0)
|
(if (equal "+title:" dc1) (match-end 2) (match-end 0)))
|
(add-text-properties
|
beg (match-end 3)
|
(if (member (intern (substring dc1 1 -1)) org-hidden-keywords)
|
'(font-lock-fontified t invisible t)
|
'(font-lock-fontified t face org-document-info-keyword)))
|
(add-text-properties
|
(match-beginning 6) (min (point-max) (1+ (match-end 6)))
|
(if (string-equal dc1 "+title:")
|
'(font-lock-fontified t face org-document-title)
|
'(font-lock-fontified t face org-document-info))))
|
((string-prefix-p "+caption" dc1)
|
(org-remove-flyspell-overlays-in (match-end 2) (match-end 0))
|
(remove-text-properties (match-beginning 0) (match-end 0)
|
'(display t invisible t intangible t))
|
;; Handle short captions.
|
(save-excursion
|
(beginning-of-line)
|
(looking-at "\\([ \t]*#\\+caption\\(?:\\[.*\\]\\)?:\\)[ \t]*"))
|
(add-text-properties (line-beginning-position) (match-end 1)
|
'(font-lock-fontified t face org-meta-line))
|
(add-text-properties (match-end 0) (line-end-position)
|
'(font-lock-fontified t face org-block))
|
t)
|
((member dc3 '(" " ""))
|
(org-remove-flyspell-overlays-in beg (match-end 0))
|
(add-text-properties
|
beg (match-end 0)
|
'(font-lock-fontified t face font-lock-comment-face)))
|
(t ;; just any other in-buffer setting, but not indented
|
(org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
|
(remove-text-properties (match-beginning 0) (match-end 0)
|
'(display t invisible t intangible t))
|
(add-text-properties beg (match-end 0)
|
'(font-lock-fontified t face org-meta-line))
|
t))))))
|
|
(defun org-fontify-drawers (limit)
|
"Fontify drawers."
|
(when (re-search-forward org-drawer-regexp limit t)
|
(add-text-properties
|
(match-beginning 0) (match-end 0)
|
'(font-lock-fontified t face org-special-keyword))
|
(org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
|
t))
|
|
(defun org-fontify-macros (limit)
|
"Fontify macros."
|
(when (re-search-forward "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)" limit t)
|
(let ((begin (match-beginning 0))
|
(opening-end (match-beginning 1)))
|
(when (and (re-search-forward "\n[ \t]*\n\\|\\(}}}\\)" limit t)
|
(match-string 1))
|
(let ((end (match-end 1))
|
(closing-start (match-beginning 1)))
|
(add-text-properties
|
begin end
|
'(font-lock-multiline t font-lock-fontified t face org-macro))
|
(org-remove-flyspell-overlays-in begin end)
|
(when org-hide-macro-markers
|
(add-text-properties begin opening-end '(invisible t))
|
(add-text-properties closing-start end '(invisible t)))
|
t)))))
|
|
(defun org-activate-footnote-links (limit)
|
"Add text properties for footnotes."
|
(let ((fn (org-footnote-next-reference-or-definition limit)))
|
(when fn
|
(let* ((beg (nth 1 fn))
|
(end (nth 2 fn))
|
(label (car fn))
|
(referencep (/= (line-beginning-position) beg)))
|
(when (and referencep (nth 3 fn))
|
(save-excursion
|
(goto-char beg)
|
(search-forward (or label "fn:"))
|
(org-remove-flyspell-overlays-in beg (match-end 0))))
|
(add-text-properties beg end
|
(list 'mouse-face 'highlight
|
'keymap org-mouse-map
|
'help-echo
|
(if referencep "Footnote reference"
|
"Footnote definition")
|
'font-lock-fontified t
|
'font-lock-multiline t
|
'face 'org-footnote))))))
|
|
(defun org-activate-dates (limit)
|
"Add text properties for dates."
|
(when (and (re-search-forward org-tsr-regexp-both limit t)
|
(not (equal (char-before (match-beginning 0)) 91)))
|
(org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
|
(add-text-properties (match-beginning 0) (match-end 0)
|
(list 'mouse-face 'highlight
|
'keymap org-mouse-map))
|
(org-rear-nonsticky-at (match-end 0))
|
(when org-display-custom-times
|
;; If it's a date range, activate custom time for second date.
|
(when (match-end 3)
|
(org-display-custom-time (match-beginning 3) (match-end 3)))
|
(org-display-custom-time (match-beginning 1) (match-end 1)))
|
t))
|
|
(defvar-local org-target-link-regexp nil
|
"Regular expression matching radio targets in plain text.")
|
|
(defconst org-target-regexp (let ((border "[^<>\n\r \t]"))
|
(format "<<\\(%s\\|%s[^<>\n\r]*%s\\)>>"
|
border border border))
|
"Regular expression matching a link target.")
|
|
(defconst org-radio-target-regexp (format "<%s>" org-target-regexp)
|
"Regular expression matching a radio target.")
|
|
(defconst org-any-target-regexp
|
(format "%s\\|%s" org-radio-target-regexp org-target-regexp)
|
"Regular expression matching any target.")
|
|
(defun org-activate-target-links (limit)
|
"Add text properties for target matches."
|
(when org-target-link-regexp
|
(let ((case-fold-search t))
|
(when (re-search-forward org-target-link-regexp limit t)
|
(org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1))
|
(add-text-properties (match-beginning 1) (match-end 1)
|
(list 'mouse-face 'highlight
|
'keymap org-mouse-map
|
'help-echo "Radio target link"
|
'org-linked-text t))
|
(org-rear-nonsticky-at (match-end 1))
|
t))))
|
|
(defun org-update-radio-target-regexp ()
|
"Find all radio targets in this file and update the regular expression.
|
Also refresh fontification if needed."
|
(interactive)
|
(let ((old-regexp org-target-link-regexp)
|
(before-re "\\(?:^\\|[^[:alnum:]]\\)\\(")
|
(after-re "\\)\\(?:$\\|[^[:alnum:]]\\)")
|
(targets
|
(org-with-wide-buffer
|
(goto-char (point-min))
|
(let (rtn)
|
(while (re-search-forward org-radio-target-regexp nil t)
|
;; Make sure point is really within the object.
|
(backward-char)
|
(let ((obj (org-element-context)))
|
(when (eq (org-element-type obj) 'radio-target)
|
(cl-pushnew (org-element-property :value obj) rtn
|
:test #'equal))))
|
rtn))))
|
(setq org-target-link-regexp
|
(and targets
|
(concat before-re
|
(mapconcat
|
(lambda (x)
|
(replace-regexp-in-string
|
" +" "\\s-+" (regexp-quote x) t t))
|
targets
|
"\\|")
|
after-re)))
|
(unless (equal old-regexp org-target-link-regexp)
|
;; Clean-up cache.
|
(let ((regexp (cond ((not old-regexp) org-target-link-regexp)
|
((not org-target-link-regexp) old-regexp)
|
(t
|
(concat before-re
|
(mapconcat
|
(lambda (re)
|
(substring re (length before-re)
|
(- (length after-re))))
|
(list old-regexp org-target-link-regexp)
|
"\\|")
|
after-re)))))
|
(org-with-wide-buffer
|
(goto-char (point-min))
|
(while (re-search-forward regexp nil t)
|
(org-element-cache-refresh (match-beginning 1)))))
|
;; Re fontify buffer.
|
(when (memq 'radio org-highlight-links)
|
(org-restart-font-lock)))))
|
|
(defun org-hide-wide-columns (limit)
|
(let (s e)
|
(setq s (text-property-any (point) (or limit (point-max))
|
'org-cwidth t))
|
(when s
|
(setq e (next-single-property-change s 'org-cwidth))
|
(add-text-properties s e '(invisible org-cwidth))
|
(goto-char e)
|
t)))
|
|
(defvar org-latex-and-related-regexp nil
|
"Regular expression for highlighting LaTeX, entities and sub/superscript.")
|
|
(defun org-compute-latex-and-related-regexp ()
|
"Compute regular expression for LaTeX, entities and sub/superscript.
|
Result depends on variable `org-highlight-latex-and-related'."
|
(setq-local
|
org-latex-and-related-regexp
|
(let* ((re-sub
|
(cond ((not (memq 'script org-highlight-latex-and-related)) nil)
|
((eq org-use-sub-superscripts '{})
|
(list org-match-substring-with-braces-regexp))
|
(org-use-sub-superscripts (list org-match-substring-regexp))))
|
(re-latex
|
(when (memq 'latex org-highlight-latex-and-related)
|
(let ((matchers (plist-get org-format-latex-options :matchers)))
|
(delq nil
|
(mapcar (lambda (x)
|
(and (member (car x) matchers) (nth 1 x)))
|
org-latex-regexps)))))
|
(re-entities
|
(when (memq 'entities org-highlight-latex-and-related)
|
(list "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)"))))
|
(mapconcat 'identity (append re-latex re-entities re-sub) "\\|"))))
|
|
(defun org-do-latex-and-related (limit)
|
"Highlight LaTeX snippets and environments, entities and sub/superscript.
|
LIMIT bounds the search for syntax to highlight. Stop at first
|
highlighted object, if any. Return t if some highlighting was
|
done, nil otherwise."
|
(when (org-string-nw-p org-latex-and-related-regexp)
|
(catch 'found
|
(while (re-search-forward org-latex-and-related-regexp limit t)
|
(unless
|
(cl-some
|
(lambda (f)
|
(memq f '(org-code org-verbatim underline org-special-keyword)))
|
(save-excursion
|
(goto-char (1+ (match-beginning 0)))
|
(face-at-point nil t)))
|
(let ((offset (if (memq (char-after (1+ (match-beginning 0)))
|
'(?_ ?^))
|
1
|
0)))
|
(font-lock-prepend-text-property
|
(+ offset (match-beginning 0)) (match-end 0)
|
'face 'org-latex-and-related)
|
(add-text-properties (+ offset (match-beginning 0)) (match-end 0)
|
'(font-lock-multiline t)))
|
(throw 'found t)))
|
nil)))
|
|
(defun org-restart-font-lock ()
|
"Restart `font-lock-mode', to force refontification."
|
(when (and (boundp 'font-lock-mode) font-lock-mode)
|
(font-lock-mode -1)
|
(font-lock-mode 1)))
|
|
(defun org-activate-tags (limit)
|
(when (re-search-forward
|
"^\\*+.*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" limit t)
|
(org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1))
|
(add-text-properties (match-beginning 1) (match-end 1)
|
(list 'mouse-face 'highlight
|
'keymap org-mouse-map))
|
(org-rear-nonsticky-at (match-end 1))
|
t))
|
|
(defun org-outline-level ()
|
"Compute the outline level of the heading at point.
|
|
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'. Unlike to `org-current-level', this function
|
takes into consideration inlinetasks."
|
(org-with-wide-buffer
|
(end-of-line)
|
(if (re-search-backward org-outline-regexp-bol nil t)
|
(1- (- (match-end 0) (match-beginning 0)))
|
0)))
|
|
(defvar org-font-lock-keywords nil)
|
|
(defsubst org-re-property (property &optional literal allow-null value)
|
"Return a regexp matching a PROPERTY line.
|
|
When optional argument LITERAL is non-nil, do not quote PROPERTY.
|
This is useful when PROPERTY is a regexp. When ALLOW-NULL is
|
non-nil, match properties even without a value.
|
|
Match group 3 is set to the value when it exists. If there is no
|
value and ALLOW-NULL is non-nil, it is set to the empty string.
|
|
With optional argument VALUE, match only property lines with
|
that value; in this case, ALLOW-NULL is ignored. VALUE is quoted
|
unless LITERAL is non-nil."
|
(concat
|
"^\\(?4:[ \t]*\\)"
|
(format "\\(?1::\\(?2:%s\\):\\)"
|
(if literal property (regexp-quote property)))
|
(cond (value
|
(format "[ \t]+\\(?3:%s\\)\\(?5:[ \t]*\\)$"
|
(if literal value (regexp-quote value))))
|
(allow-null
|
"\\(?:\\(?3:$\\)\\|[ \t]+\\(?3:.*?\\)\\)\\(?5:[ \t]*\\)$")
|
(t
|
"[ \t]+\\(?3:[^ \r\t\n]+.*?\\)\\(?5:[ \t]*\\)$"))))
|
|
(defconst org-property-re
|
(org-re-property "\\S-+" 'literal t)
|
"Regular expression matching a property line.
|
There are four matching groups:
|
1: :PROPKEY: including the leading and trailing colon,
|
2: PROPKEY without the leading and trailing colon,
|
3: PROPVAL without leading or trailing spaces,
|
4: the indentation of the current line,
|
5: trailing whitespace.")
|
|
(defvar org-font-lock-hook nil
|
"Functions to be called for special font lock stuff.")
|
|
(defvar org-font-lock-extra-keywords nil) ;Dynamically scoped.
|
|
(defvar org-font-lock-set-keywords-hook nil
|
"Functions that can manipulate `org-font-lock-extra-keywords'.
|
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.")
|
|
(defun org-font-lock-hook (limit)
|
"Run `org-font-lock-hook' within LIMIT."
|
(run-hook-with-args 'org-font-lock-hook limit))
|
|
(defun org-set-font-lock-defaults ()
|
"Set font lock defaults for the current buffer."
|
(let* ((em org-fontify-emphasized-text)
|
(lk org-highlight-links)
|
(org-font-lock-extra-keywords
|
(list
|
;; Call the hook
|
'(org-font-lock-hook)
|
;; Headlines
|
`(,(if org-fontify-whole-heading-line
|
"^\\(\\**\\)\\(\\* \\)\\(.*\n?\\)"
|
"^\\(\\**\\)\\(\\* \\)\\(.*\\)")
|
(1 (org-get-level-face 1))
|
(2 (org-get-level-face 2))
|
(3 (org-get-level-face 3)))
|
;; Table lines
|
'("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
|
(1 'org-table t))
|
;; Table internals
|
'("^[ \t]*|\\(?:.*?|\\)? *\\(:?=[^|\n]*\\)" (1 'org-formula t))
|
'("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t))
|
'("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t))
|
'("| *\\(<[lrc]?[0-9]*>\\)" (1 'org-formula t))
|
;; Drawers
|
'(org-fontify-drawers)
|
;; Properties
|
(list org-property-re
|
'(1 'org-special-keyword t)
|
'(3 'org-property-value t))
|
;; Link related fontification.
|
'(org-activate-links)
|
(when (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend)))
|
(when (memq 'radio lk) '(org-activate-target-links (1 'org-link t)))
|
(when (memq 'date lk) '(org-activate-dates (0 'org-date t)))
|
(when (memq 'footnote lk) '(org-activate-footnote-links))
|
;; Targets.
|
(list org-any-target-regexp '(0 'org-target t))
|
;; Diary sexps.
|
'("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t))
|
;; Macro
|
'(org-fontify-macros)
|
'(org-hide-wide-columns (0 nil append))
|
;; 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 (format org-heading-keyword-regexp-format
|
(concat
|
"\\(?:"
|
(mapconcat 'regexp-quote org-done-keywords "\\|")
|
"\\)"))
|
'(2 'org-headline-done t))
|
nil)
|
;; Priorities
|
'(org-font-lock-add-priority-faces)
|
;; Tags
|
'(org-font-lock-add-tag-faces)
|
;; Tags groups
|
(when (and org-group-tags org-tag-groups-alist)
|
(list (concat org-outline-regexp-bol ".+\\(:"
|
(regexp-opt (mapcar 'car org-tag-groups-alist))
|
":\\).*$")
|
'(1 'org-tag-group prepend)))
|
;; Special keywords
|
(list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t))
|
(list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t))
|
(list (concat "\\<" org-closed-string) '(0 'org-special-keyword t))
|
(list (concat "\\<" org-clock-string) '(0 'org-special-keyword t))
|
;; Emphasis
|
(when em '(org-do-emphasis-faces))
|
;; Checkboxes
|
'("^[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)"
|
1 'org-checkbox prepend)
|
(when (cdr (assq 'checkbox org-list-automatic-rules))
|
'("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]"
|
(0 (org-get-checkbox-statistics-face) t)))
|
;; Description list items
|
'("^[ \t]*[-+*][ \t]+\\(.*?[ \t]+::\\)\\([ \t]+\\|$\\)"
|
1 'org-list-dt prepend)
|
;; ARCHIVEd headings
|
(list (concat
|
org-outline-regexp-bol
|
"\\(.*:" org-archive-tag ":.*\\)")
|
'(1 'org-archived prepend))
|
;; Specials
|
'(org-do-latex-and-related)
|
'(org-fontify-entities)
|
'(org-raise-scripts)
|
;; Code
|
'(org-activate-code (1 'org-code t))
|
;; COMMENT
|
(list (format
|
"^\\*+\\(?: +%s\\)?\\(?: +\\[#[A-Z0-9]\\]\\)? +\\(?9:%s\\)\\(?: \\|$\\)"
|
org-todo-regexp
|
org-comment-string)
|
'(9 'org-special-keyword t))
|
;; Blocks and meta lines
|
'(org-fontify-meta-lines-and-blocks))))
|
(setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords))
|
(run-hooks 'org-font-lock-set-keywords-hook)
|
;; Now set the full font-lock-keywords
|
(setq-local org-font-lock-keywords org-font-lock-extra-keywords)
|
(setq-local font-lock-defaults
|
'(org-font-lock-keywords t nil nil backward-paragraph))
|
(kill-local-variable 'font-lock-keywords)
|
nil))
|
|
(defun org-toggle-pretty-entities ()
|
"Toggle the composition display of entities as UTF8 characters."
|
(interactive)
|
(setq-local org-pretty-entities (not org-pretty-entities))
|
(org-restart-font-lock)
|
(if org-pretty-entities
|
(message "Entities are now displayed as UTF8 characters")
|
(save-restriction
|
(widen)
|
(decompose-region (point-min) (point-max))
|
(message "Entities are now displayed as plain text"))))
|
|
(defvar-local org-custom-properties-overlays nil
|
"List of overlays used for custom properties.")
|
|
(defun org-toggle-custom-properties-visibility ()
|
"Display or hide properties in `org-custom-properties'."
|
(interactive)
|
(if org-custom-properties-overlays
|
(progn (mapc #'delete-overlay org-custom-properties-overlays)
|
(setq org-custom-properties-overlays nil))
|
(when org-custom-properties
|
(org-with-wide-buffer
|
(goto-char (point-min))
|
(let ((regexp (org-re-property (regexp-opt org-custom-properties) t t)))
|
(while (re-search-forward regexp nil t)
|
(let ((end (cdr (save-match-data (org-get-property-block)))))
|
(when (and end (< (point) end))
|
;; Hide first custom property in current drawer.
|
(let ((o (make-overlay (match-beginning 0) (1+ (match-end 0)))))
|
(overlay-put o 'invisible t)
|
(overlay-put o 'org-custom-property t)
|
(push o org-custom-properties-overlays))
|
;; Hide additional custom properties in the same drawer.
|
(while (re-search-forward regexp end t)
|
(let ((o (make-overlay (match-beginning 0) (1+ (match-end 0)))))
|
(overlay-put o 'invisible t)
|
(overlay-put o 'org-custom-property t)
|
(push o org-custom-properties-overlays)))))
|
;; Each entry is limited to a single property drawer.
|
(outline-next-heading)))))))
|
|
(defun org-fontify-entities (limit)
|
"Find an entity to fontify."
|
(let (ee)
|
(when org-pretty-entities
|
(catch 'match
|
;; "\_ "-family is left out on purpose. Only the first one,
|
;; i.e., "\_ ", could be fontified anyway, and it would be
|
;; confusing when adding a second white space character.
|
(while (re-search-forward
|
"\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]\n]\\)"
|
limit t)
|
(when (and (not (org-at-comment-p))
|
(setq ee (org-entity-get (match-string 1)))
|
(= (length (nth 6 ee)) 1))
|
(let* ((end (if (equal (match-string 2) "{}")
|
(match-end 2)
|
(match-end 1))))
|
(add-text-properties
|
(match-beginning 0) end
|
(list 'font-lock-fontified t))
|
(compose-region (match-beginning 0) end
|
(nth 6 ee) nil)
|
(backward-char 1)
|
(throw 'match t))))
|
nil))))
|
|
(defun org-fontify-like-in-org-mode (s &optional odd-levels)
|
"Fontify string S like in Org mode."
|
(with-temp-buffer
|
(insert s)
|
(let ((org-odd-levels-only odd-levels))
|
(org-mode)
|
(org-font-lock-ensure)
|
(buffer-string))))
|
|
(defvar org-m nil)
|
(defvar org-l nil)
|
(defvar org-f nil)
|
(defun org-get-level-face (n)
|
"Get the right face for match N in font-lock matching of headlines."
|
(setq org-l (- (match-end 2) (match-beginning 1) 1))
|
(when org-odd-levels-only (setq org-l (1+ (/ org-l 2))))
|
(if org-cycle-level-faces
|
(setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces))
|
(setq org-f (nth (1- (min org-l org-n-level-faces)) org-level-faces)))
|
(cond
|
((eq n 1) (if org-hide-leading-stars 'org-hide org-f))
|
((eq n 2) org-f)
|
(t (unless org-level-color-stars-only org-f))))
|
|
(defun org-face-from-face-or-color (context inherit face-or-color)
|
"Create a face list that inherits INHERIT, but sets the foreground color.
|
When FACE-OR-COLOR is not a string, just return it."
|
(if (stringp face-or-color)
|
(list :inherit inherit
|
(cdr (assoc context org-faces-easy-properties))
|
face-or-color)
|
face-or-color))
|
|
(defun org-get-todo-face (kwd)
|
"Get the right face for a TODO keyword KWD.
|
If KWD is a number, get the corresponding match group."
|
(when (numberp kwd) (setq kwd (match-string kwd)))
|
(or (org-face-from-face-or-color
|
'todo 'org-todo (cdr (assoc kwd org-todo-keyword-faces)))
|
(and (member kwd org-done-keywords) 'org-done)
|
'org-todo))
|
|
(defun org-get-priority-face (priority)
|
"Get the right face for PRIORITY.
|
PRIORITY is a character."
|
(or (org-face-from-face-or-color
|
'priority 'org-priority (cdr (assq priority org-priority-faces)))
|
'org-priority))
|
|
(defun org-get-tag-face (tag)
|
"Get the right face for TAG.
|
If TAG is a number, get the corresponding match group."
|
(let ((tag (if (wholenump tag) (match-string tag) tag)))
|
(or (org-face-from-face-or-color
|
'tag 'org-tag (cdr (assoc tag org-tag-faces)))
|
'org-tag)))
|
|
(defun org-font-lock-add-priority-faces (limit)
|
"Add the special priority faces."
|
(while (re-search-forward "^\\*+ .*?\\(\\[#\\(.\\)\\]\\)" limit t)
|
(add-text-properties
|
(match-beginning 1) (match-end 1)
|
(list 'face (org-get-priority-face (string-to-char (match-string 2)))
|
'font-lock-fontified t))))
|
|
(defun org-font-lock-add-tag-faces (limit)
|
"Add the special tag faces."
|
(when (and org-tag-faces org-tags-special-faces-re)
|
(while (re-search-forward org-tags-special-faces-re limit t)
|
(add-text-properties (match-beginning 1) (match-end 1)
|
(list 'face (org-get-tag-face 1)
|
'font-lock-fontified t))
|
(backward-char 1))))
|
|
(defun org-unfontify-region (beg end &optional _maybe_loudly)
|
"Remove fontification and activation overlays from links."
|
(font-lock-default-unfontify-region beg end)
|
(let* ((buffer-undo-list t)
|
(inhibit-read-only t) (inhibit-point-motion-hooks t)
|
(inhibit-modification-hooks t)
|
deactivate-mark buffer-file-name buffer-file-truename)
|
(decompose-region beg end)
|
(remove-text-properties beg end
|
'(mouse-face t keymap t org-linked-text t
|
invisible t intangible t
|
org-emphasis t))
|
(org-remove-font-lock-display-properties beg end)))
|
|
(defconst org-script-display '(((raise -0.3) (height 0.7))
|
((raise 0.3) (height 0.7))
|
((raise -0.5))
|
((raise 0.5)))
|
"Display properties for showing superscripts and subscripts.")
|
|
(defun org-remove-font-lock-display-properties (beg end)
|
"Remove specific display properties that have been added by font lock.
|
The will remove the raise properties that are used to show superscripts
|
and subscripts."
|
(let (next prop)
|
(while (< beg end)
|
(setq next (next-single-property-change beg 'display nil end)
|
prop (get-text-property beg 'display))
|
(when (member prop org-script-display)
|
(put-text-property beg next 'display nil))
|
(setq beg next))))
|
|
(defun org-raise-scripts (limit)
|
"Add raise properties to sub/superscripts."
|
(when (and org-pretty-entities org-pretty-entities-include-sub-superscripts
|
(re-search-forward
|
(if (eq org-use-sub-superscripts t)
|
org-match-substring-regexp
|
org-match-substring-with-braces-regexp)
|
limit t))
|
(let* ((pos (point)) table-p comment-p
|
(mpos (match-beginning 3))
|
(emph-p (get-text-property mpos 'org-emphasis))
|
(link-p (get-text-property mpos 'mouse-face))
|
(keyw-p (eq 'org-special-keyword (get-text-property mpos 'face))))
|
(goto-char (point-at-bol))
|
(setq table-p (looking-at-p org-table-dataline-regexp)
|
comment-p (looking-at-p "^[ \t]*#[ +]"))
|
(goto-char pos)
|
;; Handle a_b^c
|
(when (member (char-after) '(?_ ?^)) (goto-char (1- pos)))
|
(unless (or comment-p emph-p link-p keyw-p)
|
(put-text-property (match-beginning 3) (match-end 0)
|
'display
|
(if (equal (char-after (match-beginning 2)) ?^)
|
(nth (if table-p 3 1) org-script-display)
|
(nth (if table-p 2 0) org-script-display)))
|
(add-text-properties (match-beginning 2) (match-end 2)
|
(list 'invisible t))
|
(when (and (eq (char-after (match-beginning 3)) ?{)
|
(eq (char-before (match-end 3)) ?}))
|
(add-text-properties (match-beginning 3) (1+ (match-beginning 3))
|
(list 'invisible t))
|
(add-text-properties (1- (match-end 3)) (match-end 3)
|
(list 'invisible t))))
|
t)))
|
|
;;;; Visibility cycling, including org-goto and indirect buffer
|
|
;;; Cycling
|
|
(defvar-local org-cycle-global-status nil)
|
(put 'org-cycle-global-status 'org-state t)
|
(defvar-local org-cycle-subtree-status nil)
|
(put 'org-cycle-subtree-status 'org-state t)
|
|
(defvar org-inlinetask-min-level)
|
|
(defun org-unlogged-message (&rest args)
|
"Display a message, but avoid logging it in the *Messages* buffer."
|
(let ((message-log-max nil))
|
(apply 'message args)))
|
|
;;;###autoload
|
(defun org-cycle (&optional arg)
|
"TAB-action and visibility cycling for Org mode.
|
|
This is the command invoked in Org mode by the `TAB' key. Its main
|
purpose is outline visibility cycling, but it also invokes other actions
|
in special contexts.
|
|
When this function is called with a `\\[universal-argument]' prefix, rotate \
|
the entire
|
buffer through 3 states (global cycling)
|
1. OVERVIEW: Show only top-level headlines.
|
2. CONTENTS: Show all headlines of all levels, but no body text.
|
3. SHOW ALL: Show everything.
|
|
With a `\\[universal-argument] \\[universal-argument]' prefix argument, \
|
switch to the startup visibility,
|
determined by the variable `org-startup-folded', and by any VISIBILITY
|
properties in the buffer.
|
|
With a `\\[universal-argument] \\[universal-argument] \
|
\\[universal-argument]' prefix argument, show the entire buffer, including
|
any drawers.
|
|
When inside a table, re-align the table and move to the next field.
|
|
When point is at the beginning of a headline, rotate the subtree started
|
by this line through 3 different states (local cycling)
|
1. FOLDED: Only the main headline is shown.
|
2. CHILDREN: The main headline and the direct children are shown.
|
From this state, you can move to one of the children
|
and zoom in further.
|
3. SUBTREE: Show the entire subtree, including body text.
|
If there is no subtree, switch directly from CHILDREN to FOLDED.
|
|
When point is at the beginning of an empty headline and the variable
|
`org-cycle-level-after-item/entry-creation' is set, cycle the level
|
of the headline by demoting and promoting it to likely levels. This
|
speeds up creation document structure by pressing `TAB' once or several
|
times right after creating a new headline.
|
|
When there is a numeric prefix, go up to a heading with level ARG, do
|
a `show-subtree' and return to the previous cursor position. If ARG
|
is negative, go up that many levels.
|
|
When point is not at the beginning of a headline, execute the global
|
binding for `TAB', which is re-indenting the line. See the option
|
`org-cycle-emulate-tab' for details.
|
|
As a special case, if point is at the beginning of the buffer and there is
|
no headline in line 1, this function will act as if called with prefix arg
|
\(`\\[universal-argument] TAB', same as `S-TAB') also when called without \
|
prefix arg, but only
|
if the variable `org-cycle-global-at-bob' is t."
|
(interactive "P")
|
(org-load-modules-maybe)
|
(unless (or (run-hook-with-args-until-success 'org-tab-first-hook)
|
(and org-cycle-level-after-item/entry-creation
|
(or (org-cycle-level)
|
(org-cycle-item-indentation))))
|
(let* ((limit-level
|
(or org-cycle-max-level
|
(and (boundp 'org-inlinetask-min-level)
|
org-inlinetask-min-level
|
(1- org-inlinetask-min-level))))
|
(nstars (and limit-level
|
(if org-odd-levels-only
|
(and limit-level (1- (* limit-level 2)))
|
limit-level)))
|
(org-outline-regexp
|
(if (not (derived-mode-p '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 org-outline-regexp))))
|
(org-cycle-hook
|
(if bob-special
|
(delq 'org-optimize-window-after-visibility-change
|
(copy-sequence org-cycle-hook))
|
org-cycle-hook))
|
(pos (point)))
|
|
(cond
|
|
((equal arg '(16))
|
(setq last-command 'dummy)
|
(org-set-startup-visibility)
|
(org-unlogged-message "Startup visibility, plus VISIBILITY properties"))
|
|
((equal arg '(64))
|
(outline-show-all)
|
(org-unlogged-message "Entire buffer visible, including drawers"))
|
|
((equal arg '(4)) (org-cycle-internal-global))
|
|
;; Try hiding block at point.
|
((org-hide-block-toggle-maybe))
|
|
;; Try cdlatex TAB completion
|
((org-try-cdlatex-tab))
|
|
;; Table: enter it or move to the next field.
|
((org-at-table-p 'any)
|
(if (org-at-table.el-p)
|
(message "%s" (substitute-command-keys "\\<org-mode-map>\
|
Use `\\[org-edit-special]' to edit table.el tables"))
|
(if arg (org-table-edit-field t)
|
(org-table-justify-field-maybe)
|
(call-interactively 'org-table-next-field))))
|
|
((run-hook-with-args-until-success 'org-tab-after-check-for-table-hook))
|
|
;; Global cycling: delegate to `org-cycle-internal-global'.
|
(bob-special (org-cycle-internal-global))
|
|
;; Drawers: delegate to `org-flag-drawer'.
|
((save-excursion
|
(beginning-of-line 1)
|
(looking-at org-drawer-regexp))
|
(org-flag-drawer ; toggle block visibility
|
(not (get-char-property (match-end 0) 'invisible))))
|
|
;; Show-subtree, ARG levels up from here.
|
((integerp arg)
|
(save-excursion
|
(org-back-to-heading)
|
(outline-up-heading (if (< arg 0) (- arg)
|
(- (funcall outline-level) arg)))
|
(org-show-subtree)))
|
|
;; 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))
|
|
;; At an item/headline: delegate to `org-cycle-internal-local'.
|
((and (or (and org-cycle-include-plain-lists (org-at-item-p))
|
(save-excursion (move-beginning-of-line 1)
|
(looking-at org-outline-regexp)))
|
(or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
|
(org-cycle-internal-local))
|
|
;; From there: TAB emulation and template completion.
|
(buffer-read-only (org-back-to-heading))
|
|
((run-hook-with-args-until-success
|
'org-tab-after-check-for-cycling-hook))
|
|
((org-try-structure-completion))
|
|
((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 org-outline-regexp))))
|
(call-interactively (global-key-binding "\t")))
|
|
((if (and (memq org-cycle-emulate-tab '(white whitestart))
|
(save-excursion (beginning-of-line 1) (looking-at "[ \t]*"))
|
(or (and (eq org-cycle-emulate-tab 'white)
|
(= (match-end 0) (point-at-eol)))
|
(and (eq org-cycle-emulate-tab 'whitestart)
|
(>= (match-end 0) pos))))
|
t
|
(eq org-cycle-emulate-tab t))
|
(call-interactively (global-key-binding "\t")))
|
|
(t (save-excursion
|
(org-back-to-heading)
|
(org-cycle)))))))
|
|
(defun org-cycle-internal-global ()
|
"Do the global cycling action."
|
;; Hack to avoid display of messages for .org attachments in Gnus
|
(let ((ga (string-match "\\*fontification" (buffer-name))))
|
(cond
|
((and (eq last-command this-command)
|
(eq org-cycle-global-status 'overview))
|
;; We just created the overview - now do table of contents
|
;; This can be slow in very large buffers, so indicate action
|
(run-hook-with-args 'org-pre-cycle-hook 'contents)
|
(unless ga (org-unlogged-message "CONTENTS..."))
|
(org-content)
|
(unless ga (org-unlogged-message "CONTENTS...done"))
|
(setq org-cycle-global-status 'contents)
|
(run-hook-with-args 'org-cycle-hook 'contents))
|
|
((and (eq last-command this-command)
|
(eq org-cycle-global-status 'contents))
|
;; We just showed the table of contents - now show everything
|
(run-hook-with-args 'org-pre-cycle-hook 'all)
|
(outline-show-all)
|
(unless ga (org-unlogged-message "SHOW ALL"))
|
(setq org-cycle-global-status 'all)
|
(run-hook-with-args 'org-cycle-hook 'all))
|
|
(t
|
;; Default action: go to overview
|
(run-hook-with-args 'org-pre-cycle-hook 'overview)
|
(org-overview)
|
(unless ga (org-unlogged-message "OVERVIEW"))
|
(setq org-cycle-global-status 'overview)
|
(run-hook-with-args 'org-cycle-hook 'overview)))))
|
|
(defvar org-called-with-limited-levels nil
|
"Non-nil when `org-with-limited-levels' is currently active.")
|
|
(defun org-invisible-p (&optional pos)
|
"Non-nil if the character after POS is invisible.
|
If POS is nil, use `point' instead."
|
(get-char-property (or pos (point)) 'invisible))
|
|
(defun org-cycle-internal-local ()
|
"Do the local cycling action."
|
(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
|
(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 t)
|
(when (bolp) (backward-char)) (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)
|
(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)
|
;; Nothing is hidden behind this heading
|
(unless (org-before-first-heading-p)
|
(run-hook-with-args 'org-pre-cycle-hook 'empty))
|
(org-unlogged-message "EMPTY ENTRY")
|
(setq org-cycle-subtree-status nil)
|
(save-excursion
|
(goto-char eos)
|
(outline-next-heading)
|
(when (org-invisible-p) (org-flag-heading nil))))
|
((and (or (>= eol eos)
|
(not (string-match "\\S-" (buffer-substring eol eos))))
|
(or has-children
|
(not (setq children-skipped
|
org-cycle-skip-children-state-if-no-children))))
|
;; Entire subtree is hidden in one line: children view
|
(unless (org-before-first-heading-p)
|
(run-hook-with-args 'org-pre-cycle-hook 'children))
|
(if (org-at-item-p)
|
(org-list-set-item-visibility (point-at-bol) struct 'children)
|
(org-show-entry)
|
(org-with-limited-levels (org-show-children))
|
(org-show-set-visibility 'canonical)
|
;; 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)))
|
(dolist (e (org-list-get-all-items (point) struct prevs))
|
(org-list-set-item-visibility e struct 'folded))
|
(goto-char (if (< end eos) end eos)))))))
|
(org-unlogged-message "CHILDREN")
|
(save-excursion
|
(goto-char eos)
|
(outline-next-heading)
|
(when (org-invisible-p) (org-flag-heading nil)))
|
(setq org-cycle-subtree-status 'children)
|
(unless (org-before-first-heading-p)
|
(run-hook-with-args 'org-cycle-hook 'children)))
|
((or children-skipped
|
(and (eq last-command this-command)
|
(eq org-cycle-subtree-status 'children)))
|
;; We just showed the children, or no children are there,
|
;; now show everything.
|
(unless (org-before-first-heading-p)
|
(run-hook-with-args 'org-pre-cycle-hook 'subtree))
|
(outline-flag-region eoh eos nil)
|
(org-unlogged-message
|
(if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE"))
|
(setq org-cycle-subtree-status 'subtree)
|
(unless (org-before-first-heading-p)
|
(run-hook-with-args 'org-cycle-hook 'subtree)))
|
(t
|
;; Default action: hide the subtree.
|
(run-hook-with-args 'org-pre-cycle-hook 'folded)
|
(outline-flag-region eoh eos t)
|
(org-unlogged-message "FOLDED")
|
(setq org-cycle-subtree-status 'folded)
|
(unless (org-before-first-heading-p)
|
(run-hook-with-args 'org-cycle-hook 'folded))))))
|
|
;;;###autoload
|
(defun org-global-cycle (&optional arg)
|
"Cycle the global visibility. For details see `org-cycle'.
|
With `\\[universal-argument]' prefix ARG, switch to startup visibility.
|
With a numeric prefix, show all headlines up to that level."
|
(interactive "P")
|
(let ((org-cycle-include-plain-lists
|
(if (derived-mode-p 'org-mode) org-cycle-include-plain-lists nil)))
|
(cond
|
((integerp arg)
|
(outline-show-all)
|
(outline-hide-sublevels arg)
|
(setq org-cycle-global-status 'contents))
|
((equal arg '(4))
|
(org-set-startup-visibility)
|
(org-unlogged-message "Startup visibility, plus VISIBILITY properties."))
|
(t
|
(org-cycle '(4))))))
|
|
(defun org-set-startup-visibility ()
|
"Set the visibility required by startup options and properties."
|
(cond
|
((eq org-startup-folded t)
|
(org-overview))
|
((eq org-startup-folded 'content)
|
(org-content))
|
((or (eq org-startup-folded 'showeverything)
|
(eq org-startup-folded nil))
|
(outline-show-all)))
|
(unless (eq org-startup-folded 'showeverything)
|
(when org-hide-block-startup (org-hide-block-all))
|
(org-set-visibility-according-to-property 'no-cleanup)
|
(org-cycle-hide-archived-subtrees 'all)
|
(org-cycle-hide-drawers 'all)
|
(org-cycle-show-empty-lines t)))
|
|
(defun org-set-visibility-according-to-property (&optional no-cleanup)
|
"Switch subtree visibilities according to :VISIBILITY: property."
|
(interactive)
|
(org-with-wide-buffer
|
(goto-char (point-min))
|
(while (re-search-forward "^[ \t]*:VISIBILITY:" nil t)
|
(if (not (org-at-property-p)) (outline-next-heading)
|
(let ((state (match-string 3)))
|
(save-excursion
|
(org-back-to-heading t)
|
(outline-hide-subtree)
|
(org-reveal))
|
(cond
|
((equal state "folded")
|
(outline-hide-subtree)
|
(org-end-of-subtree t t))
|
((equal state "children")
|
(org-show-hidden-entry)
|
(org-show-children))
|
((equal state "content")
|
(save-excursion
|
(save-restriction
|
(org-narrow-to-subtree)
|
(org-content)))
|
(org-end-of-subtree t t))
|
((member state '("all" "showall"))
|
(outline-show-subtree))))))
|
(unless no-cleanup
|
(org-cycle-hide-archived-subtrees '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.
|
This shows all headlines with a level equal or greater than the level
|
of the first headline in the buffer. This is important, because if the
|
first headline is not level one, then (hide-sublevels 1) gives confusing
|
results."
|
(interactive)
|
(save-excursion
|
(let ((level
|
(save-excursion
|
(goto-char (point-min))
|
(when (re-search-forward (concat "^" outline-regexp) nil t)
|
(goto-char (match-beginning 0))
|
(funcall outline-level)))))
|
(and level (outline-hide-sublevels level)))))
|
|
(defun org-content (&optional arg)
|
"Show all headlines in the buffer, like a table of contents.
|
With numerical argument N, show content up to level N."
|
(interactive "P")
|
(org-overview)
|
(save-excursion
|
;; Visit all headings and show their offspring
|
(and (integerp arg) (org-overview))
|
(goto-char (point-max))
|
(catch 'exit
|
(while (and (progn (condition-case nil
|
(outline-previous-visible-heading 1)
|
(error (goto-char (point-min))))
|
t)
|
(looking-at org-outline-regexp))
|
(if (integerp arg)
|
(org-show-children (1- arg))
|
(outline-show-branches))
|
(when (bobp) (throw 'exit nil))))))
|
|
(defun org-optimize-window-after-visibility-change (state)
|
"Adjust the window after a change in outline visibility.
|
This function is the default value of the hook `org-cycle-hook'."
|
(when (get-buffer-window (current-buffer))
|
(cond
|
((eq state 'content) nil)
|
((eq state 'all) nil)
|
((eq state 'folded) nil)
|
((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1)))
|
((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1))))))
|
|
(defun org-remove-empty-overlays-at (pos)
|
"Remove outline overlays that do not contain non-white stuff."
|
(dolist (o (overlays-at pos))
|
(and (eq 'outline (overlay-get o 'invisible))
|
(not (string-match "\\S-" (buffer-substring (overlay-start o)
|
(overlay-end o))))
|
(delete-overlay o))))
|
|
(defun org-clean-visibility-after-subtree-move ()
|
"Fix visibility issues after moving a subtree."
|
;; First, find a reasonable region to look at:
|
;; Start two siblings above, end three below
|
(let* ((beg (save-excursion
|
(and (org-get-last-sibling)
|
(org-get-last-sibling))
|
(point)))
|
(end (save-excursion
|
(and (org-get-next-sibling)
|
(org-get-next-sibling)
|
(org-get-next-sibling))
|
(if (org-at-heading-p)
|
(point-at-eol)
|
(point))))
|
(level (looking-at "\\*+"))
|
(re (when level (concat "^" (regexp-quote (match-string 0)) " "))))
|
(save-excursion
|
(save-restriction
|
(narrow-to-region beg end)
|
(when re
|
;; Properly fold already folded siblings
|
(goto-char (point-min))
|
(while (re-search-forward re nil t)
|
(when (and (not (org-invisible-p))
|
(save-excursion
|
(goto-char (point-at-eol)) (org-invisible-p)))
|
(outline-hide-entry))))
|
(org-cycle-show-empty-lines 'overview)
|
(org-cycle-hide-drawers 'overview)))))
|
|
(defun org-cycle-show-empty-lines (state)
|
"Show empty lines above all visible headlines.
|
The region to be covered depends on STATE when called through
|
`org-cycle-hook'. Lisp program can use t for STATE to get the
|
entire buffer covered. Note that an empty line is only shown if there
|
are at least `org-cycle-separator-lines' empty lines before the headline."
|
(when (/= org-cycle-separator-lines 0)
|
(save-excursion
|
(let* ((n (abs org-cycle-separator-lines))
|
(re (cond
|
((= n 1) "\\(\n[ \t]*\n\\*+\\) ")
|
((= n 2) "^[ \t]*\\(\n[ \t]*\n\\*+\\) ")
|
(t (let ((ns (number-to-string (- n 2))))
|
(concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}"
|
"[ \t]*\\(\n[ \t]*\n\\*+\\) ")))))
|
beg end)
|
(cond
|
((memq state '(overview contents t))
|
(setq beg (point-min) end (point-max)))
|
((memq state '(children folded))
|
(setq beg (point)
|
end (progn (org-end-of-subtree t t)
|
(line-beginning-position 2)))))
|
(when beg
|
(goto-char beg)
|
(while (re-search-forward re end t)
|
(unless (get-char-property (match-end 1) 'invisible)
|
(let ((e (match-end 1))
|
(b (if (>= org-cycle-separator-lines 0)
|
(match-beginning 1)
|
(save-excursion
|
(goto-char (match-beginning 0))
|
(skip-chars-backward " \t\n")
|
(line-end-position)))))
|
(outline-flag-region b e nil))))))))
|
;; Never hide empty lines at the end of the file.
|
(save-excursion
|
(goto-char (point-max))
|
(outline-previous-heading)
|
(outline-end-of-heading)
|
(when (and (looking-at "[ \t\n]+")
|
(= (match-end 0) (point-max)))
|
(outline-flag-region (point) (match-end 0) nil))))
|
|
(defun org-show-empty-lines-in-parent ()
|
"Move to the parent and re-show empty lines before visible headlines."
|
(save-excursion
|
(let ((context (if (org-up-heading-safe) 'children 'overview)))
|
(org-cycle-show-empty-lines context))))
|
|
(defun org-files-list ()
|
"Return `org-agenda-files' list, plus all open Org files.
|
This is useful for operations that need to scan all of a user's
|
open and agenda-wise Org files."
|
(let ((files (mapcar #'expand-file-name (org-agenda-files))))
|
(dolist (buf (buffer-list))
|
(with-current-buffer buf
|
(when (and (derived-mode-p 'org-mode) (buffer-file-name))
|
(cl-pushnew (expand-file-name (buffer-file-name)) files
|
:test #'equal))))
|
files))
|
|
(defsubst org-entry-beginning-position ()
|
"Return the beginning position of the current entry."
|
(save-excursion (org-back-to-heading t) (point)))
|
|
(defsubst org-entry-end-position ()
|
"Return the end position of the current entry."
|
(save-excursion (outline-next-heading) (point)))
|
|
(defun org-cycle-hide-drawers (state &optional exceptions)
|
"Re-hide all drawers after a visibility state change.
|
STATE should be one of the symbols listed in the docstring of
|
`org-cycle-hook'. When non-nil, optional argument EXCEPTIONS is
|
a list of strings specifying which drawers should not be hidden."
|
(when (and (derived-mode-p 'org-mode)
|
(not (memq state '(overview folded contents))))
|
(save-excursion
|
(let* ((globalp (eq state 'all))
|
(beg (if globalp (point-min) (point)))
|
(end (if globalp (point-max)
|
(if (eq state 'children)
|
(save-excursion (outline-next-heading) (point))
|
(org-end-of-subtree t)))))
|
(goto-char beg)
|
(while (re-search-forward org-drawer-regexp (max end (point)) t)
|
(unless (member-ignore-case (match-string 1) exceptions)
|
(let ((drawer (org-element-at-point)))
|
(when (memq (org-element-type drawer) '(drawer property-drawer))
|
(org-flag-drawer t drawer)
|
;; Make sure to skip drawer entirely or we might flag
|
;; it another time when matching its ending line with
|
;; `org-drawer-regexp'.
|
(goto-char (org-element-property :end drawer))))))))))
|
|
(defun org-flag-drawer (flag &optional element)
|
"When FLAG is non-nil, hide the drawer we are at.
|
Otherwise make it visible. When optional argument ELEMENT is
|
a parsed drawer, as returned by `org-element-at-point', hide or
|
show that drawer instead."
|
(let ((drawer (or element
|
(and (save-excursion
|
(beginning-of-line)
|
(looking-at-p org-drawer-regexp))
|
(org-element-at-point)))))
|
(when (memq (org-element-type drawer) '(drawer property-drawer))
|
(let ((post (org-element-property :post-affiliated drawer)))
|
(save-excursion
|
(outline-flag-region
|
(progn (goto-char post) (line-end-position))
|
(progn (goto-char (org-element-property :end drawer))
|
(skip-chars-backward " \r\t\n")
|
(line-end-position))
|
flag))
|
;; When the drawer is hidden away, make sure point lies in
|
;; a visible part of the buffer.
|
(when (and flag (> (line-beginning-position) post))
|
(goto-char post))))))
|
|
(defun org-subtree-end-visible-p ()
|
"Is the end of the current subtree visible?"
|
(pos-visible-in-window-p
|
(save-excursion (org-end-of-subtree t) (point))))
|
|
(defun org-first-headline-recenter ()
|
"Move cursor to the first headline and recenter the headline."
|
(let ((window (get-buffer-window)))
|
(when window
|
(goto-char (point-min))
|
(when (re-search-forward (concat "^\\(" org-outline-regexp "\\)") nil t)
|
(set-window-start window (line-beginning-position))))))
|
|
;;; Saving and restoring visibility
|
|
(defun org-outline-overlay-data (&optional use-markers)
|
"Return a list of the locations of all outline overlays.
|
These are overlays with the `invisible' property value `outline'.
|
The return value is a list of cons cells, with start and stop
|
positions for each overlay.
|
If USE-MARKERS is set, return the positions as markers."
|
(let (beg end)
|
(org-with-wide-buffer
|
(delq nil
|
(mapcar (lambda (o)
|
(when (eq (overlay-get o 'invisible) 'outline)
|
(setq beg (overlay-start o)
|
end (overlay-end o))
|
(and beg end (> end beg)
|
(if use-markers
|
(cons (copy-marker beg)
|
(copy-marker end t))
|
(cons beg end)))))
|
(overlays-in (point-min) (point-max)))))))
|
|
(defun org-set-outline-overlay-data (data)
|
"Create visibility overlays for all positions in DATA.
|
DATA should have been made by `org-outline-overlay-data'."
|
(org-with-wide-buffer
|
(outline-show-all)
|
(dolist (c data) (outline-flag-region (car c) (cdr c) t))))
|
|
;;; Folding of blocks
|
|
(defvar-local org-hide-block-overlays nil
|
"Overlays hiding blocks.")
|
|
(defun org-block-map (function &optional start end)
|
"Call FUNCTION at the head of all source blocks in the current buffer.
|
Optional arguments START and END can be used to limit the range."
|
(let ((start (or start (point-min)))
|
(end (or end (point-max))))
|
(save-excursion
|
(goto-char start)
|
(while (and (< (point) end) (re-search-forward org-block-regexp end t))
|
(save-excursion
|
(save-match-data
|
(goto-char (match-beginning 0))
|
(funcall function)))))))
|
|
(defun org-hide-block-toggle-all ()
|
"Toggle the visibility of all blocks in the current buffer."
|
(org-block-map 'org-hide-block-toggle))
|
|
(defun org-hide-block-all ()
|
"Fold all blocks in the current buffer."
|
(interactive)
|
(org-show-block-all)
|
(org-block-map 'org-hide-block-toggle-maybe))
|
|
(defun org-show-block-all ()
|
"Unfold all blocks in the current buffer."
|
(interactive)
|
(mapc #'delete-overlay org-hide-block-overlays)
|
(setq org-hide-block-overlays nil))
|
|
(defun org-hide-block-toggle-maybe ()
|
"Toggle visibility of block at point.
|
Unlike to `org-hide-block-toggle', this function does not throw
|
an error. Return a non-nil value when toggling is successful."
|
(interactive)
|
(ignore-errors (org-hide-block-toggle)))
|
|
(defun org-hide-block-toggle (&optional force)
|
"Toggle the visibility of the current block.
|
When optional argument FORCE is `off', make block visible. If it
|
is non-nil, hide it unconditionally. Throw an error when not at
|
a block. Return a non-nil value when toggling is successful."
|
(interactive)
|
(let ((element (org-element-at-point)))
|
(unless (memq (org-element-type element)
|
'(center-block comment-block dynamic-block example-block
|
export-block quote-block special-block
|
src-block verse-block))
|
(user-error "Not at a block"))
|
(let* ((start (save-excursion
|
(goto-char (org-element-property :post-affiliated element))
|
(line-end-position)))
|
(end (save-excursion
|
(goto-char (org-element-property :end element))
|
(skip-chars-backward " \r\t\n")
|
(line-end-position)))
|
(overlays (overlays-at start)))
|
(cond
|
;; Do nothing when not before or at the block opening line or
|
;; at the block closing line.
|
((let ((eol (line-end-position))) (and (> eol start) (/= eol end))) nil)
|
((and (not (eq force 'off))
|
(not (memq t (mapcar
|
(lambda (o)
|
(eq (overlay-get o 'invisible) 'org-hide-block))
|
overlays))))
|
(let ((ov (make-overlay start end)))
|
(overlay-put ov 'invisible 'org-hide-block)
|
;; Make the block accessible to `isearch'.
|
(overlay-put
|
ov 'isearch-open-invisible
|
(lambda (ov)
|
(when (memq ov org-hide-block-overlays)
|
(setq org-hide-block-overlays (delq ov org-hide-block-overlays)))
|
(when (eq (overlay-get ov 'invisible) 'org-hide-block)
|
(delete-overlay ov))))
|
(push ov org-hide-block-overlays)
|
;; When the block is hidden away, make sure point is left in
|
;; a visible part of the buffer.
|
(when (> (line-beginning-position) start)
|
(goto-char start)
|
(beginning-of-line))
|
;; Signal successful toggling.
|
t))
|
((or (not force) (eq force 'off))
|
(dolist (ov overlays t)
|
(when (memq ov org-hide-block-overlays)
|
(setq org-hide-block-overlays (delq ov org-hide-block-overlays)))
|
(when (eq (overlay-get ov 'invisible) 'org-hide-block)
|
(delete-overlay ov))))))))
|
|
;; Remove overlays when changing major mode
|
(add-hook 'org-mode-hook
|
(lambda () (add-hook 'change-major-mode-hook
|
'org-show-block-all 'append 'local)))
|
|
;;; Org-goto
|
|
(defvar org-goto-window-configuration nil)
|
(defvar org-goto-marker nil)
|
(defvar org-goto-map)
|
(defun org-goto-map ()
|
"Set the keymap `org-goto'."
|
(setq org-goto-map
|
(let ((map (make-sparse-keymap)))
|
(let ((cmds '(isearch-forward isearch-backward kill-ring-save set-mark-command
|
mouse-drag-region universal-argument org-occur)))
|
(dolist (cmd cmds)
|
(substitute-key-definition cmd cmd map global-map)))
|
(suppress-keymap map)
|
(org-defkey map "\C-m" 'org-goto-ret)
|
(org-defkey map [(return)] 'org-goto-ret)
|
(org-defkey map [(left)] 'org-goto-left)
|
(org-defkey map [(right)] 'org-goto-right)
|
(org-defkey map [(control ?g)] 'org-goto-quit)
|
(org-defkey map "\C-i" 'org-cycle)
|
(org-defkey map [(tab)] 'org-cycle)
|
(org-defkey map [(down)] 'outline-next-visible-heading)
|
(org-defkey map [(up)] 'outline-previous-visible-heading)
|
(if org-goto-auto-isearch
|
(if (fboundp 'define-key-after)
|
(define-key-after map [t] 'org-goto-local-auto-isearch)
|
nil)
|
(org-defkey map "q" 'org-goto-quit)
|
(org-defkey map "n" 'outline-next-visible-heading)
|
(org-defkey map "p" 'outline-previous-visible-heading)
|
(org-defkey map "f" 'outline-forward-same-level)
|
(org-defkey map "b" 'outline-backward-same-level)
|
(org-defkey map "u" 'outline-up-heading))
|
(org-defkey map "/" 'org-occur)
|
(org-defkey map "\C-c\C-n" 'outline-next-visible-heading)
|
(org-defkey map "\C-c\C-p" 'outline-previous-visible-heading)
|
(org-defkey map "\C-c\C-f" 'outline-forward-same-level)
|
(org-defkey map "\C-c\C-b" 'outline-backward-same-level)
|
(org-defkey map "\C-c\C-u" 'outline-up-heading)
|
map)))
|
|
(defconst org-goto-help
|
"Browse buffer copy, to find location or copy text.%s
|
RET=jump to location C-g=quit and return to previous location
|
\[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur")
|
|
(defvar org-goto-start-pos) ; dynamically scoped parameter
|
|
(defun org-goto (&optional alternative-interface)
|
"Look up a different location in the current file, keeping current visibility.
|
|
When you want look-up or go to a different location in a
|
document, the fastest way is often to fold the entire buffer and
|
then dive into the tree. This method has the disadvantage, that
|
the previous location will be folded, which may not be what you
|
want.
|
|
This command works around this by showing a copy of the current
|
buffer in 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 it will also jump to the location selected
|
in the indirect buffer and expose the headline hierarchy above.
|
|
With a prefix argument, use the alternative interface: e.g., if
|
`org-goto-interface' is `outline' use `outline-path-completion'."
|
(interactive "P")
|
(org-goto-map)
|
(let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level))))
|
(org-refile-use-outline-path t)
|
(org-refile-target-verify-function nil)
|
(interface
|
(if (not alternative-interface)
|
org-goto-interface
|
(if (eq org-goto-interface 'outline)
|
'outline-path-completion
|
'outline)))
|
(org-goto-start-pos (point))
|
(selected-point
|
(if (eq interface 'outline)
|
(car (org-get-location (current-buffer) org-goto-help))
|
(let ((pa (org-refile-get-location "Goto")))
|
(org-refile-check-position pa)
|
(nth 3 pa)))))
|
(if selected-point
|
(progn
|
(org-mark-ring-push org-goto-start-pos)
|
(goto-char selected-point)
|
(when (or (org-invisible-p) (org-invisible-p2))
|
(org-show-context 'org-goto)))
|
(message "Quit"))))
|
|
(defvar org-goto-selected-point nil) ; dynamically scoped parameter
|
(defvar org-goto-exit-command nil) ; dynamically scoped parameter
|
(defvar org-goto-local-auto-isearch-map) ; defined below
|
|
(defun org-get-location (_buf help)
|
"Let the user select a location in current buffer.
|
This function uses a recursive edit. It returns the selected position
|
or nil."
|
(org-no-popups
|
(let ((isearch-mode-map org-goto-local-auto-isearch-map)
|
(isearch-hide-immediately nil)
|
(isearch-search-fun-function
|
(lambda () 'org-goto-local-search-headings))
|
(org-goto-selected-point org-goto-exit-command))
|
(save-excursion
|
(save-window-excursion
|
(delete-other-windows)
|
(and (get-buffer "*org-goto*") (kill-buffer "*org-goto*"))
|
(pop-to-buffer-same-window
|
(condition-case nil
|
(make-indirect-buffer (current-buffer) "*org-goto*")
|
(error (make-indirect-buffer (current-buffer) "*org-goto*"))))
|
(with-output-to-temp-buffer "*Org Help*"
|
(princ (format help (if org-goto-auto-isearch
|
" Just type for auto-isearch."
|
" n/p/f/b/u to navigate, q to quit."))))
|
(org-fit-window-to-buffer (get-buffer-window "*Org Help*"))
|
(setq buffer-read-only nil)
|
(let ((org-startup-truncated t)
|
(org-startup-folded nil)
|
(org-startup-align-all-tables nil))
|
(org-mode)
|
(org-overview))
|
(setq buffer-read-only t)
|
(if (and (boundp 'org-goto-start-pos)
|
(integer-or-marker-p org-goto-start-pos))
|
(progn (goto-char org-goto-start-pos)
|
(when (org-invisible-p)
|
(org-show-set-visibility 'lineage)))
|
(goto-char (point-min)))
|
(let (org-special-ctrl-a/e) (org-beginning-of-line))
|
(message "Select location and press RET")
|
(use-local-map org-goto-map)
|
(recursive-edit)))
|
(kill-buffer "*org-goto*")
|
(cons org-goto-selected-point org-goto-exit-command))))
|
|
(defvar org-goto-local-auto-isearch-map (make-sparse-keymap))
|
(set-keymap-parent org-goto-local-auto-isearch-map isearch-mode-map)
|
;; `isearch-other-control-char' was removed in Emacs 24.4.
|
(if (fboundp 'isearch-other-control-char)
|
(progn
|
(define-key org-goto-local-auto-isearch-map "\C-i" 'isearch-other-control-char)
|
(define-key org-goto-local-auto-isearch-map "\C-m" 'isearch-other-control-char))
|
(define-key org-goto-local-auto-isearch-map "\C-i" nil)
|
(define-key org-goto-local-auto-isearch-map "\C-m" nil)
|
(define-key org-goto-local-auto-isearch-map [return] nil))
|
|
(defun org-goto-local-search-headings (string bound noerror)
|
"Search and make sure that any matches are in headlines."
|
(catch 'return
|
(while (if isearch-forward
|
(search-forward string bound noerror)
|
(search-backward string bound noerror))
|
(when (save-match-data
|
(and (save-excursion
|
(beginning-of-line)
|
(looking-at org-complex-heading-regexp))
|
(or (not (match-beginning 5))
|
(< (point) (match-beginning 5)))))
|
(throw 'return (point))))))
|
|
(defun org-goto-local-auto-isearch ()
|
"Start isearch."
|
(interactive)
|
(goto-char (point-min))
|
(let ((keys (this-command-keys)))
|
(when (eq (lookup-key isearch-mode-map keys) 'isearch-printing-char)
|
(isearch-mode t)
|
(isearch-process-search-char (string-to-char keys)))))
|
|
(defun org-goto-ret (&optional _arg)
|
"Finish `org-goto' by going to the new location."
|
(interactive "P")
|
(setq org-goto-selected-point (point))
|
(setq org-goto-exit-command 'return)
|
(throw 'exit nil))
|
|
(defun org-goto-left ()
|
"Finish `org-goto' by going to the new location."
|
(interactive)
|
(if (org-at-heading-p)
|
(progn
|
(beginning-of-line 1)
|
(setq org-goto-selected-point (point)
|
org-goto-exit-command 'left)
|
(throw 'exit nil))
|
(user-error "Not on a heading")))
|
|
(defun org-goto-right ()
|
"Finish `org-goto' by going to the new location."
|
(interactive)
|
(if (org-at-heading-p)
|
(progn
|
(setq org-goto-selected-point (point)
|
org-goto-exit-command 'right)
|
(throw 'exit nil))
|
(user-error "Not on a heading")))
|
|
(defun org-goto-quit ()
|
"Finish `org-goto' without cursor motion."
|
(interactive)
|
(setq org-goto-selected-point nil)
|
(setq org-goto-exit-command 'quit)
|
(throw 'exit nil))
|
|
;;; Indirect buffer display of subtrees
|
|
(defvar org-indirect-dedicated-frame nil
|
"This is the frame being used for indirect tree display.")
|
(defvar org-last-indirect-buffer nil)
|
|
(defun org-tree-to-indirect-buffer (&optional arg)
|
"Create indirect buffer and narrow it to current subtree.
|
|
With a numerical prefix ARG, go up to this level and then take that tree.
|
If ARG is negative, go up that many levels.
|
|
If `org-indirect-buffer-display' is not `new-frame', the command removes the
|
indirect buffer previously made with this command, to avoid proliferation of
|
indirect buffers. However, when you call the command with a \
|
`\\[universal-argument]' prefix, or
|
when `org-indirect-buffer-display' is `new-frame', the last buffer is kept
|
so that you can work with several indirect buffers at the same time. If
|
`org-indirect-buffer-display' is `dedicated-frame', the \
|
`\\[universal-argument]' prefix also
|
requests that a new frame be made for the new buffer, so that the dedicated
|
frame is not changed."
|
(interactive "P")
|
(let ((cbuf (current-buffer))
|
(cwin (selected-window))
|
(pos (point))
|
beg end level heading ibuf)
|
(save-excursion
|
(org-back-to-heading t)
|
(when (numberp arg)
|
(setq level (org-outline-level))
|
(when (< arg 0) (setq arg (+ level arg)))
|
(while (> (setq level (org-outline-level)) arg)
|
(org-up-heading-safe)))
|
(setq beg (point)
|
heading (org-get-heading 'no-tags))
|
(org-end-of-subtree t t)
|
(when (org-at-heading-p) (backward-char 1))
|
(setq end (point)))
|
(when (and (buffer-live-p org-last-indirect-buffer)
|
(not (eq org-indirect-buffer-display 'new-frame))
|
(not arg))
|
(kill-buffer org-last-indirect-buffer))
|
(setq ibuf (org-get-indirect-buffer cbuf heading)
|
org-last-indirect-buffer ibuf)
|
(cond
|
((or (eq org-indirect-buffer-display 'new-frame)
|
(and arg (eq org-indirect-buffer-display 'dedicated-frame)))
|
(select-frame (make-frame))
|
(delete-other-windows)
|
(pop-to-buffer-same-window ibuf)
|
(org-set-frame-title heading))
|
((eq org-indirect-buffer-display 'dedicated-frame)
|
(raise-frame
|
(select-frame (or (and org-indirect-dedicated-frame
|
(frame-live-p org-indirect-dedicated-frame)
|
org-indirect-dedicated-frame)
|
(setq org-indirect-dedicated-frame (make-frame)))))
|
(delete-other-windows)
|
(pop-to-buffer-same-window ibuf)
|
(org-set-frame-title (concat "Indirect: " heading)))
|
((eq org-indirect-buffer-display 'current-window)
|
(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)
|
(outline-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 heading)
|
(setq buffer (or buffer (current-buffer)))
|
(let ((n 1) (base (buffer-name buffer)) bname)
|
(while (buffer-live-p
|
(get-buffer
|
(setq bname
|
(concat base "-"
|
(if heading (concat heading "-" (number-to-string n))
|
(number-to-string n))))))
|
(setq n (1+ n)))
|
(condition-case nil
|
(make-indirect-buffer buffer bname 'clone)
|
(error (make-indirect-buffer buffer bname)))))
|
|
(defun org-set-frame-title (title)
|
"Set the title of the current frame to the string TITLE."
|
(modify-frame-parameters (selected-frame) (list (cons 'name title))))
|
|
;;;; Structure editing
|
|
;;; Inserting headlines
|
|
(defun org--line-empty-p (n)
|
"Is the Nth next line empty?
|
|
Counts the current line as N = 1 and the previous line as N = 0;
|
see `beginning-of-line'."
|
(save-excursion
|
(and (not (bobp))
|
(or (beginning-of-line n) t)
|
(save-match-data
|
(looking-at "[ \t]*$")))))
|
|
(defun org-previous-line-empty-p ()
|
"Is the previous line a blank line?
|
When NEXT is non-nil, check the next line instead."
|
(org--line-empty-p 0))
|
|
(defun org-next-line-empty-p ()
|
"Is the previous line a blank line?
|
When NEXT is non-nil, check the next line instead."
|
(org--line-empty-p 2))
|
|
(defun org--blank-before-heading-p (&optional parent)
|
"Non-nil when an empty line should precede a new heading here.
|
When optional argument PARENT is non-nil, consider parent
|
headline instead of current one."
|
(pcase (assq 'heading org-blank-before-new-entry)
|
(`(heading . auto)
|
(save-excursion
|
(org-with-limited-levels
|
(unless (and (org-before-first-heading-p)
|
(not (outline-next-heading)))
|
(org-back-to-heading t)
|
(when parent (org-up-heading-safe))
|
(cond ((not (bobp))
|
(org-previous-line-empty-p))
|
((outline-next-heading)
|
(org-previous-line-empty-p))
|
;; Ignore trailing spaces on last buffer line.
|
((progn (skip-chars-backward " \t") (bolp))
|
(org-previous-line-empty-p))
|
(t nil))))))
|
(`(heading . ,value) value)
|
(_ nil)))
|
|
(defun org-insert-heading (&optional arg invisible-ok top)
|
"Insert a new heading or an item with the same depth at point.
|
|
If point is at the beginning of a heading, insert a new heading
|
or a new headline above the current one. When at the beginning
|
of a regular line of text, turn it into a heading.
|
|
If point is in the middle of a line, split it and create a new
|
headline with the text in the current line after point (see
|
`org-M-RET-may-split-line' on how to modify this behavior). As
|
a special case, on a headline, splitting can only happen on the
|
title itself. E.g., this excludes breaking stars or tags.
|
|
With a `\\[universal-argument]' prefix, set \
|
`org-insert-heading-respect-content' to
|
a non-nil value for the duration of the command. This forces the
|
insertion of a heading after the current subtree, independently
|
on the location of point.
|
|
With a `\\[universal-argument] \\[universal-argument]' prefix, \
|
insert the heading at the end of the tree
|
above the current heading. For example, if point is within a
|
2nd-level heading, then it will insert a 2nd-level heading at
|
the end of the 1st-level parent subtree.
|
|
When INVISIBLE-OK is set, stop at invisible headlines when going
|
back. This is important for non-interactive uses of the
|
command.
|
|
When optional argument TOP is non-nil, insert a level 1 heading,
|
unconditionally."
|
(interactive "P")
|
(let* ((blank? (org--blank-before-heading-p (equal arg '(16))))
|
(level (org-current-level))
|
(stars (make-string (if (and level (not top)) level 1) ?*)))
|
(cond
|
((or org-insert-heading-respect-content
|
(member arg '((4) (16)))
|
(and (not invisible-ok)
|
(invisible-p (max (1- (point)) (point-min)))))
|
;; Position point at the location of insertion.
|
(if (not level) ;before first headline
|
(org-with-limited-levels (outline-next-heading))
|
;; Make sure we end up on a visible headline if INVISIBLE-OK
|
;; is nil.
|
(org-with-limited-levels (org-back-to-heading invisible-ok))
|
(cond ((equal arg '(16))
|
(org-up-heading-safe)
|
(org-end-of-subtree t t))
|
(t
|
(org-end-of-subtree t t))))
|
(unless (bolp) (insert "\n")) ;ensure final newline
|
(unless (and blank? (org-previous-line-empty-p))
|
(org-N-empty-lines-before-current (if blank? 1 0)))
|
(insert stars " \n")
|
(forward-char -1))
|
;; At a headline...
|
((org-at-heading-p)
|
(cond ((bolp)
|
(when blank? (save-excursion (insert "\n")))
|
(save-excursion (insert stars " \n"))
|
(unless (and blank? (org-previous-line-empty-p))
|
(org-N-empty-lines-before-current (if blank? 1 0)))
|
(end-of-line))
|
((and (org-get-alist-option org-M-RET-may-split-line 'headline)
|
(org-match-line org-complex-heading-regexp)
|
(org-pos-in-match-range (point) 4))
|
;; Grab the text that should moved to the new headline.
|
;; Preserve tags.
|
(let ((split (delete-and-extract-region (point) (match-end 4))))
|
(if (looking-at "[ \t]*$") (replace-match "")
|
(org-set-tags nil t))
|
(end-of-line)
|
(when blank? (insert "\n"))
|
(insert "\n" stars " ")
|
(when (org-string-nw-p split) (insert split))
|
(when (eobp) (save-excursion (insert "\n")))))
|
(t
|
(end-of-line)
|
(when blank? (insert "\n"))
|
(insert "\n" stars " ")
|
(when (eobp) (save-excursion (insert "\n"))))))
|
;; On regular text, turn line into a headline or split, if
|
;; appropriate.
|
((bolp)
|
(insert stars " ")
|
(unless (and blank? (org-previous-line-empty-p))
|
(org-N-empty-lines-before-current (if blank? 1 0))))
|
(t
|
(unless (org-get-alist-option org-M-RET-may-split-line 'headline)
|
(end-of-line))
|
(insert "\n" stars " ")
|
(unless (and blank? (org-previous-line-empty-p))
|
(org-N-empty-lines-before-current (if blank? 1 0))))))
|
(run-hooks 'org-insert-heading-hook))
|
|
(defun org-N-empty-lines-before-current (n)
|
"Make the number of empty lines before current exactly N.
|
So this will delete or add empty lines."
|
(let ((column (current-column)))
|
(beginning-of-line)
|
(unless (bobp)
|
(let ((start (save-excursion
|
(skip-chars-backward " \r\t\n")
|
(line-end-position))))
|
(delete-region start (line-end-position 0))))
|
(insert (make-string n ?\n))
|
(move-to-column column)))
|
|
(defun org-get-heading (&optional no-tags no-todo no-priority no-comment)
|
"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.
|
When NO-PRIORITY is non-nil, don't include priority cookie.
|
When NO-COMMENT is non-nil, don't include COMMENT string."
|
(save-excursion
|
(org-back-to-heading t)
|
(let ((case-fold-search nil))
|
(looking-at org-complex-heading-regexp)
|
(let ((todo (and (not no-todo) (match-string 2)))
|
(priority (and (not no-priority) (match-string 3)))
|
(headline (pcase (match-string 4)
|
(`nil "")
|
((and (guard no-comment) h)
|
(replace-regexp-in-string
|
(eval-when-compile
|
(format "\\`%s[ \t]+" org-comment-string))
|
"" h))
|
(h h)))
|
(tags (and (not no-tags) (match-string 5))))
|
(mapconcat #'identity
|
(delq nil (list todo priority headline tags))
|
" ")))))
|
|
(defvar orgstruct-mode) ; defined below
|
|
(defun org-heading-components ()
|
"Return the components of the current heading.
|
This is a list with the following elements:
|
- the level as an integer
|
- the reduced level, different if `org-odd-levels-only' is set.
|
- the TODO keyword, or nil
|
- the priority character, like ?A, or nil if no priority is given
|
- the headline text itself, or the tags string if no headline text
|
- the tags string, or nil."
|
(save-excursion
|
(org-back-to-heading t)
|
(when (let (case-fold-search)
|
(looking-at
|
(if orgstruct-mode
|
org-heading-regexp
|
org-complex-heading-regexp)))
|
(if orgstruct-mode
|
(list (length (match-string 1))
|
(org-reduced-level (length (match-string 1)))
|
nil
|
nil
|
(match-string 2)
|
nil)
|
(list (length (match-string 1))
|
(org-reduced-level (length (match-string 1)))
|
(match-string-no-properties 2)
|
(and (match-end 3) (aref (match-string 3) 2))
|
(match-string-no-properties 4)
|
(match-string-no-properties 5))))))
|
|
(defun org-get-entry ()
|
"Get the entry text, after heading, entire subtree."
|
(save-excursion
|
(org-back-to-heading t)
|
(buffer-substring (point-at-bol 2) (org-end-of-subtree t))))
|
|
(defun org-edit-headline (&optional heading)
|
"Edit the current headline.
|
Set it to HEADING when provided."
|
(interactive)
|
(org-with-wide-buffer
|
(org-back-to-heading t)
|
(let ((case-fold-search nil))
|
(when (looking-at org-complex-heading-regexp)
|
(let* ((old (match-string-no-properties 4))
|
(new (save-match-data
|
(org-trim (or heading (read-string "Edit: " old))))))
|
(unless (equal old new)
|
(if old (replace-match new t t nil 4)
|
(goto-char (or (match-end 3) (match-end 2) (match-end 1)))
|
(insert " " new))
|
(org-set-tags nil t)
|
(when (looking-at "[ \t]*$") (replace-match ""))))))))
|
|
(defun org-insert-heading-after-current ()
|
"Insert a new heading with same level as current, after current subtree."
|
(interactive)
|
(org-back-to-heading)
|
(org-insert-heading)
|
(org-move-subtree-down)
|
(end-of-line 1))
|
|
(defun org-insert-heading-respect-content (&optional invisible-ok)
|
"Insert heading with `org-insert-heading-respect-content' set to t."
|
(interactive)
|
(org-insert-heading '(4) invisible-ok))
|
|
(defun org-insert-todo-heading-respect-content (&optional force-state)
|
"Insert TODO heading with `org-insert-heading-respect-content' set to t."
|
(interactive)
|
(org-insert-todo-heading force-state '(4)))
|
|
(defun org-insert-todo-heading (arg &optional force-heading)
|
"Insert a new heading with the same level and TODO state as current heading.
|
|
If the heading has no TODO state, or if the state is DONE, use
|
the first state (TODO by default). Also with one prefix arg,
|
force first state. With two prefix args, force inserting at the
|
end of the parent subtree.
|
|
When called at a plain list item, insert a new item with an
|
unchecked check box."
|
(interactive "P")
|
(when (or force-heading (not (org-insert-item 'checkbox)))
|
(org-insert-heading (or (and (equal arg '(16)) '(16))
|
force-heading))
|
(save-excursion
|
(org-forward-heading-same-level -1)
|
(let ((case-fold-search nil)) (looking-at org-todo-line-regexp)))
|
(let* ((new-mark-x
|
(if (or (equal arg '(4))
|
(not (match-beginning 2))
|
(member (match-string 2) org-done-keywords))
|
(car org-todo-keywords-1)
|
(match-string 2)))
|
(new-mark
|
(or
|
(run-hook-with-args-until-success
|
'org-todo-get-default-hook new-mark-x nil)
|
new-mark-x)))
|
(beginning-of-line 1)
|
(and (looking-at org-outline-regexp) (goto-char (match-end 0))
|
(if org-treat-insert-todo-heading-as-state-change
|
(org-todo new-mark)
|
(insert new-mark " "))))
|
(when org-provide-todo-statistics
|
(org-update-parent-todo-statistics))))
|
|
(defun org-insert-subheading (arg)
|
"Insert a new subheading and demote it.
|
Works for outline headings and for plain lists alike."
|
(interactive "P")
|
(org-insert-heading arg)
|
(cond
|
((org-at-heading-p) (org-do-demote))
|
((org-at-item-p) (org-indent-item))))
|
|
(defun org-insert-todo-subheading (arg)
|
"Insert a new subheading with TODO keyword or checkbox and demote it.
|
Works for outline headings and for plain lists alike."
|
(interactive "P")
|
(org-insert-todo-heading arg)
|
(cond
|
((org-at-heading-p) (org-do-demote))
|
((org-at-item-p) (org-indent-item))))
|
|
;;; Promotion and Demotion
|
|
(defvar org-after-demote-entry-hook nil
|
"Hook run after an entry has been demoted.
|
The cursor will be at the beginning of the entry.
|
When a subtree is being demoted, the hook will be called for each node.")
|
|
(defvar org-after-promote-entry-hook nil
|
"Hook run after an entry has been promoted.
|
The cursor will be at the beginning of the entry.
|
When a subtree is being promoted, the hook will be called for each node.")
|
|
(defun org-promote-subtree ()
|
"Promote the entire subtree.
|
See also `org-promote'."
|
(interactive)
|
(save-excursion
|
(org-with-limited-levels (org-map-tree 'org-promote)))
|
(org-fix-position-after-promote))
|
|
(defun org-demote-subtree ()
|
"Demote the entire subtree.
|
See `org-demote' and `org-promote'."
|
(interactive)
|
(save-excursion
|
(org-with-limited-levels (org-map-tree 'org-demote)))
|
(org-fix-position-after-promote))
|
|
(defun org-do-promote ()
|
"Promote the current heading higher up the tree.
|
If the region is active in `transient-mark-mode', promote all
|
headings in the region."
|
(interactive)
|
(save-excursion
|
(if (org-region-active-p)
|
(org-map-region 'org-promote (region-beginning) (region-end))
|
(org-promote)))
|
(org-fix-position-after-promote))
|
|
(defun org-do-demote ()
|
"Demote the current heading lower down the tree.
|
If the region is active in `transient-mark-mode', demote all
|
headings in the region."
|
(interactive)
|
(save-excursion
|
(if (org-region-active-p)
|
(org-map-region 'org-demote (region-beginning) (region-end))
|
(org-demote)))
|
(org-fix-position-after-promote))
|
|
(defun org-fix-position-after-promote ()
|
"Fix cursor position and indentation after demoting/promoting."
|
(let ((pos (point)))
|
(when (save-excursion
|
(beginning-of-line)
|
(let ((case-fold-search nil)) (looking-at org-todo-line-regexp))
|
(or (eq pos (match-end 1)) (eq pos (match-end 2))))
|
(cond ((eobp) (insert " "))
|
((eolp) (insert " "))
|
((equal (char-after) ?\s) (forward-char 1))))))
|
|
(defun org-current-level ()
|
"Return the level of the current entry, or nil if before the first headline.
|
The level is the number of stars at the beginning of the
|
headline. Use `org-reduced-level' to remove the effect of
|
`org-odd-levels'. Unlike to `org-outline-level', this function
|
ignores inlinetasks."
|
(let ((level (org-with-limited-levels (org-outline-level))))
|
(and (> level 0) level)))
|
|
(defun org-get-previous-line-level ()
|
"Return the outline depth of the last headline before the current line.
|
Returns 0 for the first headline in the buffer, and nil if before the
|
first headline."
|
(and (org-current-level)
|
(or (and (/= (line-beginning-position) (point-min))
|
(save-excursion (beginning-of-line 0) (org-current-level)))
|
0)))
|
|
(defun org-reduced-level (l)
|
"Compute the effective level of a heading.
|
This takes into account the setting of `org-odd-levels-only'."
|
(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
|
time to headlines when structure editing, based on the value of
|
`org-odd-levels-only'."
|
(if org-odd-levels-only 2 1))
|
|
(defun org-get-valid-level (level &optional change)
|
"Rectify a level change under the influence of `org-odd-levels-only'.
|
LEVEL is a current level, CHANGE is by how much the level should
|
be modified. Even if CHANGE is nil, LEVEL may be returned
|
modified because even level numbers will become the next higher
|
odd number. Returns values greater than 0."
|
(if org-odd-levels-only
|
(cond ((or (not change) (= 0 change)) (1+ (* 2 (/ level 2))))
|
((> change 0) (1+ (* 2 (/ (+ (1- level) (* 2 change)) 2))))
|
((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2))))))
|
(max 1 (+ level (or change 0)))))
|
|
(defun org-promote ()
|
"Promote the current heading higher up the tree."
|
(org-with-wide-buffer
|
(org-back-to-heading t)
|
(let* ((after-change-functions (remq 'flyspell-after-change-function
|
after-change-functions))
|
(level (save-match-data (funcall outline-level)))
|
(up-head (concat (make-string (org-get-valid-level level -1) ?*) " "))
|
(diff (abs (- level (length up-head) -1))))
|
(cond
|
((and (= level 1) org-allow-promoting-top-level-subtree)
|
(replace-match "# " nil t))
|
((= level 1)
|
(user-error "Cannot promote to level 0. UNDO to recover if necessary"))
|
(t (replace-match up-head nil t)))
|
(unless (= level 1)
|
(when org-auto-align-tags (org-set-tags nil 'ignore-column))
|
(when org-adapt-indentation (org-fixup-indentation (- diff))))
|
(run-hooks 'org-after-promote-entry-hook))))
|
|
(defun org-demote ()
|
"Demote the current heading lower down the tree."
|
(org-with-wide-buffer
|
(org-back-to-heading t)
|
(let* ((after-change-functions (remq 'flyspell-after-change-function
|
after-change-functions))
|
(level (save-match-data (funcall outline-level)))
|
(down-head (concat (make-string (org-get-valid-level level 1) ?*) " "))
|
(diff (abs (- level (length down-head) -1))))
|
(replace-match down-head nil t)
|
(when org-auto-align-tags (org-set-tags nil 'ignore-column))
|
(when org-adapt-indentation (org-fixup-indentation diff))
|
(run-hooks 'org-after-demote-entry-hook))))
|
|
(defun org-cycle-level ()
|
"Cycle the level of an empty headline through possible states.
|
This goes first to child, then to parent, level, then up the hierarchy.
|
After top level, it switches back to sibling level."
|
(interactive)
|
(let ((org-adapt-indentation nil))
|
(when (org-point-at-end-of-empty-headline)
|
(setq this-command 'org-cycle-level) ; Only needed for caching
|
(let ((cur-level (org-current-level))
|
(prev-level (org-get-previous-line-level)))
|
(cond
|
;; If first headline in file, promote to top-level.
|
((= prev-level 0)
|
(cl-loop repeat (/ (- cur-level 1) (org-level-increment))
|
do (org-do-promote)))
|
;; If same level as prev, demote one.
|
((= prev-level cur-level)
|
(org-do-demote))
|
;; If parent is top-level, promote to top level if not already.
|
((= prev-level 1)
|
(cl-loop repeat (/ (- cur-level 1) (org-level-increment))
|
do (org-do-promote)))
|
;; If top-level, return to prev-level.
|
((= cur-level 1)
|
(cl-loop repeat (/ (- prev-level 1) (org-level-increment))
|
do (org-do-demote)))
|
;; If less than prev-level, promote one.
|
((< cur-level prev-level)
|
(org-do-promote))
|
;; If deeper than prev-level, promote until higher than
|
;; prev-level.
|
((> cur-level prev-level)
|
(cl-loop repeat (+ 1 (/ (- cur-level prev-level) (org-level-increment)))
|
do (org-do-promote))))
|
t))))
|
|
(defun org-map-tree (fun)
|
"Call FUN for every heading underneath the current one."
|
(org-back-to-heading t)
|
(let ((level (funcall outline-level)))
|
(save-excursion
|
(funcall fun)
|
(while (and (progn
|
(outline-next-heading)
|
(> (funcall outline-level) level))
|
(not (eobp)))
|
(funcall fun)))))
|
|
(defun org-map-region (fun beg end)
|
"Call FUN for every heading between BEG and END."
|
(let ((org-ignore-region t))
|
(save-excursion
|
(setq end (copy-marker end))
|
(goto-char beg)
|
(when (and (re-search-forward org-outline-regexp-bol nil t)
|
(< (point) end))
|
(funcall fun))
|
(while (and (progn
|
(outline-next-heading)
|
(< (point) end))
|
(not (eobp)))
|
(funcall fun)))))
|
|
(defun org-fixup-indentation (diff)
|
"Change the indentation in the current entry by DIFF.
|
|
DIFF is an integer. Indentation is done according to the
|
following rules:
|
|
- Planning information and property drawers are always indented
|
according to the new level of the headline;
|
|
- Footnote definitions and their contents are ignored;
|
|
- Inlinetasks' boundaries are not shifted;
|
|
- Empty lines are ignored;
|
|
- Other lines' indentation are shifted by DIFF columns, unless
|
it would introduce a structural change in the document, in
|
which case no shifting is done at all.
|
|
Assume point is at a heading or an inlinetask beginning."
|
(org-with-wide-buffer
|
(narrow-to-region (line-beginning-position)
|
(save-excursion
|
(if (org-with-limited-levels (org-at-heading-p))
|
(org-with-limited-levels (outline-next-heading))
|
(org-inlinetask-goto-end))
|
(point)))
|
(forward-line)
|
;; Indent properly planning info and property drawer.
|
(when (looking-at-p org-planning-line-re)
|
(org-indent-line)
|
(forward-line))
|
(when (looking-at org-property-drawer-re)
|
(goto-char (match-end 0))
|
(forward-line)
|
(save-excursion (org-indent-region (match-beginning 0) (match-end 0))))
|
(catch 'no-shift
|
(when (zerop diff) (throw 'no-shift nil))
|
;; If DIFF is negative, first check if a shift is possible at all
|
;; (e.g., it doesn't break structure). This can only happen if
|
;; some contents are not properly indented.
|
(let ((case-fold-search t))
|
(when (< diff 0)
|
(let ((diff (- diff))
|
(forbidden-re (concat org-outline-regexp
|
"\\|"
|
(substring org-footnote-definition-re 1))))
|
(save-excursion
|
(while (not (eobp))
|
(cond
|
((looking-at-p "[ \t]*$") (forward-line))
|
((and (looking-at-p org-footnote-definition-re)
|
(let ((e (org-element-at-point)))
|
(and (eq (org-element-type e) 'footnote-definition)
|
(goto-char (org-element-property :end e))))))
|
((looking-at-p org-outline-regexp) (forward-line))
|
;; Give up if shifting would move before column 0 or
|
;; if it would introduce a headline or a footnote
|
;; definition.
|
(t
|
(skip-chars-forward " \t")
|
(let ((ind (current-column)))
|
(when (or (< ind diff)
|
(and (= ind diff) (looking-at-p forbidden-re)))
|
(throw 'no-shift nil)))
|
;; Ignore contents of example blocks and source
|
;; blocks if their indentation is meant to be
|
;; preserved. Jump to block's closing line.
|
(beginning-of-line)
|
(or (and (looking-at-p "[ \t]*#\\+BEGIN_\\(EXAMPLE\\|SRC\\)")
|
(let ((e (org-element-at-point)))
|
(and (memq (org-element-type e)
|
'(example-block src-block))
|
(or org-src-preserve-indentation
|
(org-element-property :preserve-indent e))
|
(goto-char (org-element-property :end e))
|
(progn (skip-chars-backward " \r\t\n")
|
(beginning-of-line)
|
t))))
|
(forward-line))))))))
|
;; Shift lines but footnote definitions, inlinetasks boundaries
|
;; by DIFF. Also skip contents of source or example blocks
|
;; when indentation is meant to be preserved.
|
(while (not (eobp))
|
(cond
|
((and (looking-at-p org-footnote-definition-re)
|
(let ((e (org-element-at-point)))
|
(and (eq (org-element-type e) 'footnote-definition)
|
(goto-char (org-element-property :end e))))))
|
((looking-at-p org-outline-regexp) (forward-line))
|
((looking-at-p "[ \t]*$") (forward-line))
|
(t
|
(indent-line-to (+ (org-get-indentation) diff))
|
(beginning-of-line)
|
(or (and (looking-at-p "[ \t]*#\\+BEGIN_\\(EXAMPLE\\|SRC\\)")
|
(let ((e (org-element-at-point)))
|
(and (memq (org-element-type e)
|
'(example-block src-block))
|
(or org-src-preserve-indentation
|
(org-element-property :preserve-indent e))
|
(goto-char (org-element-property :end e))
|
(progn (skip-chars-backward " \r\t\n")
|
(beginning-of-line)
|
t))))
|
(forward-line)))))))))
|
|
(defun org-convert-to-odd-levels ()
|
"Convert an Org file with all levels allowed to one with odd levels.
|
This will leave level 1 alone, convert level 2 to level 3, level 3 to
|
level 5 etc."
|
(interactive)
|
(when (yes-or-no-p "Are you sure you want to globally change levels to odd? ")
|
(let ((outline-level 'org-outline-level)
|
(org-odd-levels-only nil) n)
|
(save-excursion
|
(goto-char (point-min))
|
(while (re-search-forward "^\\*\\*+ " nil t)
|
(setq n (- (length (match-string 0)) 2))
|
(while (>= (setq n (1- n)) 0)
|
(org-demote))
|
(end-of-line 1))))))
|
|
(defun org-convert-to-oddeven-levels ()
|
"Convert an Org file with only odd levels to one with odd/even levels.
|
This promotes level 3 to level 2, level 5 to level 3 etc. If the
|
file contains a section with an even level, conversion would
|
destroy the structure of the file. An error is signaled in this
|
case."
|
(interactive)
|
(goto-char (point-min))
|
;; First check if there are no even levels
|
(when (re-search-forward "^\\(\\*\\*\\)+ " nil t)
|
(org-show-set-visibility 'canonical)
|
(error "Not all levels are odd in this file. Conversion not possible"))
|
(when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ")
|
(let ((outline-regexp org-outline-regexp)
|
(outline-level 'org-outline-level)
|
(org-odd-levels-only nil) n)
|
(save-excursion
|
(goto-char (point-min))
|
(while (re-search-forward "^\\*\\*+ " nil t)
|
(setq n (/ (1- (length (match-string 0))) 2))
|
(while (>= (setq n (1- n)) 0)
|
(org-promote))
|
(end-of-line 1))))))
|
|
(defun org-tr-level (n)
|
"Make N odd if required."
|
(if org-odd-levels-only (1+ (/ n 2)) n))
|
|
;;; Vertical tree motion, cutting and pasting of subtrees
|
|
(defun org-move-subtree-up (&optional arg)
|
"Move the current subtree up past ARG headlines of the same level."
|
(interactive "p")
|
(org-move-subtree-down (- (prefix-numeric-value arg))))
|
|
(defun org-move-subtree-down (&optional arg)
|
"Move the current subtree down past ARG headlines of the same level."
|
(interactive "p")
|
(setq arg (prefix-numeric-value arg))
|
(let ((movfunc (if (> arg 0) 'org-get-next-sibling
|
'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 beg0 (point))
|
(save-excursion
|
(setq ne-beg (org-back-over-empty-lines))
|
(setq beg (point)))
|
(save-match-data
|
(save-excursion (outline-end-of-heading)
|
(setq folded (org-invisible-p)))
|
(progn (org-end-of-subtree nil t)
|
(unless (eobp) (backward-char))))
|
(outline-next-heading)
|
(setq ne-end (org-back-over-empty-lines))
|
(setq end (point))
|
(goto-char beg0)
|
(when (and (> arg 0) (org-first-sibling-p) (< ne-end ne-beg))
|
;; include less whitespace
|
(save-excursion
|
(goto-char beg)
|
(forward-line (- ne-beg ne-end))
|
(setq beg (point))))
|
;; Find insertion point, with error handling
|
(while (> cnt 0)
|
(or (and (funcall movfunc) (looking-at org-outline-regexp))
|
(progn (goto-char beg0)
|
(user-error "Cannot move past superior level or buffer limit")))
|
(setq cnt (1- cnt)))
|
(when (> arg 0)
|
;; Moving forward - still need to move over subtree
|
(org-end-of-subtree t t)
|
(save-excursion
|
(org-back-over-empty-lines)
|
(or (bolp) (newline))))
|
(setq ne-ins (org-back-over-empty-lines))
|
(move-marker ins-point (point))
|
(setq txt (buffer-substring beg end))
|
(org-save-markers-in-region beg end)
|
(delete-region beg end)
|
(org-remove-empty-overlays-at beg)
|
(or (= beg (point-min)) (outline-flag-region (1- beg) beg nil))
|
(or (bobp) (outline-flag-region (1- (point)) (point) nil))
|
(and (not (bolp)) (looking-at "\n") (forward-char 1))
|
(let ((bbb (point)))
|
(insert-before-markers txt)
|
(org-reinstall-markers-in-region bbb)
|
(move-marker ins-point bbb))
|
(or (bolp) (insert "\n"))
|
(setq ins-end (point))
|
(goto-char ins-point)
|
(org-skip-whitespace)
|
(when (and (< arg 0)
|
(org-first-sibling-p)
|
(> ne-ins ne-beg))
|
;; Move whitespace back to beginning
|
(save-excursion
|
(goto-char ins-end)
|
(let ((kill-whole-line t))
|
(kill-line (- ne-ins ne-beg)) (point)))
|
(insert (make-string (- ne-ins ne-beg) ?\n)))
|
(move-marker ins-point nil)
|
(if folded
|
(outline-hide-subtree)
|
(org-show-entry)
|
(org-show-children)
|
(org-cycle-hide-drawers 'children))
|
(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.
|
This is actually only a copy of the kill, because we use the normal kill
|
ring. We need it to check if the kill was created by `org-copy-subtree'.")
|
|
(defvar org-subtree-clip-folded nil
|
"Was the last copied subtree folded?
|
This is used to fold the tree back after pasting.")
|
|
(defun org-cut-subtree (&optional n)
|
"Cut the current subtree into the clipboard.
|
With prefix arg N, cut this many sequential subtrees.
|
This is a short-hand for marking the subtree and then cutting it."
|
(interactive "p")
|
(org-copy-subtree n 'cut))
|
|
(defun org-copy-subtree (&optional n cut force-store-markers nosubtrees)
|
"Copy the current subtree into the clipboard.
|
With prefix arg N, copy this many sequential subtrees.
|
This is a short-hand for marking the subtree and then copying it.
|
If CUT is non-nil, actually cut the subtree.
|
If FORCE-STORE-MARKERS is non-nil, store the relative locations
|
of some markers in the region, even if CUT is non-nil. This is
|
useful if the caller implements cut-and-paste as copy-then-paste-then-cut."
|
(interactive "p")
|
(let (beg end folded (beg0 (point)))
|
(if (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
|
(setq beg (point))
|
(skip-chars-forward " \t\r\n")
|
(save-match-data
|
(if nosubtrees
|
(outline-next-heading)
|
(save-excursion (outline-end-of-heading)
|
(setq folded (org-invisible-p)))
|
(ignore-errors (org-forward-heading-same-level (1- n) t))
|
(org-end-of-subtree t t)))
|
;; Include the end of an inlinetask
|
(when (and (featurep 'org-inlinetask)
|
(looking-at-p (concat (org-inlinetask-outline-regexp)
|
"END[ \t]*$")))
|
(end-of-line))
|
(setq end (point))
|
(goto-char beg0)
|
(when (> end beg)
|
(setq org-subtree-clip-folded folded)
|
(when (or cut force-store-markers)
|
(org-save-markers-in-region beg end))
|
(if cut (kill-region beg end) (copy-region-as-kill beg end))
|
(setq org-subtree-clip (current-kill 0))
|
(message "%s: Subtree(s) with %d characters"
|
(if cut "Cut" "Copied")
|
(length org-subtree-clip)))))
|
|
(defun org-paste-subtree (&optional level tree for-yank remove)
|
"Paste the clipboard as a subtree, with modification of headline level.
|
The entire subtree is promoted or demoted in order to match a new headline
|
level.
|
|
If the cursor is at the beginning of a headline, the same level as
|
that headline is used to paste the tree.
|
|
If not, the new level is derived from the *visible* headings
|
before and after the insertion point, and taken to be the inferior headline
|
level of the two. So if the previous visible heading is level 3 and the
|
next is level 4 (or vice versa), level 4 will be used for insertion.
|
This makes sure that the subtree remains an independent subtree and does
|
not swallow low level entries.
|
|
You can also force a different level, either by using a numeric prefix
|
argument, or by inserting the heading marker by hand. For example, if the
|
cursor is after \"*****\", then the tree will be shifted to level 5.
|
|
If optional TREE is given, use this text instead of the kill ring.
|
|
When FOR-YANK is set, this is called by `org-yank'. In this case, do not
|
move back over whitespace before inserting, and move point to the end of
|
the inserted text when done.
|
|
When REMOVE is non-nil, remove the subtree from the clipboard."
|
(interactive "P")
|
(setq tree (or tree (and kill-ring (current-kill 0))))
|
(unless (org-kill-is-subtree-p tree)
|
(user-error "%s"
|
(substitute-command-keys
|
"The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway")))
|
(org-with-limited-levels
|
(let* ((visp (not (org-invisible-p)))
|
(txt tree)
|
(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 0) (match-beginning 0)))
|
((and (bolp)
|
(looking-at org-outline-regexp))
|
(- (match-end 0) (point) 1))))
|
(previous-level (save-excursion
|
(condition-case nil
|
(progn
|
(outline-previous-visible-heading 1)
|
(if (looking-at org-outline-regexp-bol)
|
(- (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 org-outline-regexp-bol)
|
(- (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
|
(when force-level
|
(delete-region (point-at-bol) (point)))
|
;; Paste
|
(beginning-of-line (if (bolp) 1 2))
|
(setq beg (point))
|
(and (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt))
|
(insert-before-markers txt)
|
(unless (string-suffix-p "\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))
|
(when (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 (called-interactively-p 'interactive) for-yank)
|
(message "Clipboard pasted as level %d subtree" new-level))
|
(when (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
|
(outline-hide-subtree))
|
(and for-yank (goto-char newend))
|
(and remove (setq kill-ring (cdr kill-ring))))))
|
|
(defun org-kill-is-subtree-p (&optional txt)
|
"Check if the current kill is an outline subtree, or a set of trees.
|
Returns nil if kill does not start with a headline, or if the first
|
headline level is not the largest headline level in the tree.
|
So this will actually accept several entries of equal levels as well,
|
which is OK for `org-paste-subtree'.
|
If optional TXT is given, check this string instead of the current kill."
|
(let* ((kill (or txt (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\\)?\\(" re "\\)")
|
kill)
|
(- (match-end 2) (match-beginning 2) 1)))
|
(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)))
|
(when (< (- (match-end 0) (match-beginning 0) 1) start-level)
|
(throw 'exit nil)))
|
t))))
|
|
(defvar org-markers-to-move nil
|
"Markers that should be moved with a cut-and-paste operation.
|
Those markers are stored together with their positions relative to
|
the start of the region.")
|
|
(defun org-save-markers-in-region (beg end)
|
"Check markers in region.
|
If these markers are between BEG and END, record their position relative
|
to BEG, so that after moving the block of text, we can put the markers back
|
into place.
|
This function gets called just before an entry or tree gets cut from the
|
buffer. After re-insertion, `org-reinstall-markers-in-region' must be
|
called immediately, to move the markers with the entries."
|
(setq org-markers-to-move nil)
|
(when (featurep 'org-clock)
|
(org-clock-save-markers-for-cut-and-paste beg end))
|
(when (featurep 'org-agenda)
|
(org-agenda-save-markers-for-cut-and-paste beg end)))
|
|
(defun org-check-and-save-marker (marker beg end)
|
"Check if MARKER is between BEG and END.
|
If yes, remember the marker and the distance to BEG."
|
(when (and (marker-buffer marker)
|
(equal (marker-buffer marker) (current-buffer))
|
(>= marker beg) (< marker end))
|
(push (cons marker (- marker beg)) org-markers-to-move)))
|
|
(defun org-reinstall-markers-in-region (beg)
|
"Move all remembered markers to their position relative to BEG."
|
(dolist (x org-markers-to-move)
|
(move-marker (car x) (+ beg (cdr x))))
|
(setq org-markers-to-move nil))
|
|
(defun org-narrow-to-subtree ()
|
"Narrow buffer to the current subtree."
|
(interactive)
|
(save-excursion
|
(save-match-data
|
(org-with-limited-levels
|
(narrow-to-region
|
(progn (org-back-to-heading t) (point))
|
(progn (org-end-of-subtree t t)
|
(when (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))
|
(user-error "Not in a block"))))
|
|
(defun org-clone-subtree-with-time-shift (n &optional shift)
|
"Clone the task (subtree) at point N times.
|
The clones will be inserted as siblings.
|
|
In interactive use, the user will be prompted for the number of
|
clones to be produced. If the entry has a timestamp, the user
|
will also be prompted for a time shift, which may be a repeater
|
as used in time stamps, for example `+3d'. To disable this,
|
you can call the function with a universal prefix argument.
|
|
When a valid repeater is given and the entry contains any time
|
stamps, the clones will become a sequence in time, with time
|
stamps in the subtree shifted for each clone produced. If SHIFT
|
is nil or the empty string, time stamps will be left alone. The
|
ID property of the original subtree is removed.
|
|
In each clone, all the CLOCK entries will be removed. This
|
prevents Org from considering that the clocked times overlap.
|
|
If the original subtree did contain time stamps with a repeater,
|
the following will happen:
|
- the repeater will be removed in each clone
|
- an additional clone will be produced, with the current, unshifted
|
date(s) in the entry.
|
- the original entry will be placed *after* all the clones, with
|
repeater intact.
|
- the start days in the repeater in the original entry will be shifted
|
to past the last clone.
|
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.
|
|
As described above, N+1 clones are produced when the original
|
subtree has a repeater. Setting N to 0, then, can be used to
|
remove the repeater from a subtree and create a shifted clone
|
with the original repeater."
|
(interactive "nNumber of clones to produce: ")
|
(unless (wholenump n) (user-error "Invalid number of replications %s" n))
|
(when (org-before-first-heading-p) (user-error "No subtree to clone"))
|
(let* ((beg (save-excursion (org-back-to-heading t) (point)))
|
(end-of-tree (save-excursion (org-end-of-subtree t t) (point)))
|
(shift
|
(or shift
|
(if (and (not (equal current-prefix-arg '(4)))
|
(save-excursion
|
(goto-char beg)
|
(re-search-forward org-ts-regexp-both end-of-tree t)))
|
(read-from-minibuffer
|
"Date shift per clone (e.g. +1w, empty to copy unchanged): ")
|
""))) ;No time shift
|
(doshift
|
(and (org-string-nw-p shift)
|
(or (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([dwmy]\\)[ \t]*\\'"
|
shift)
|
(user-error "Invalid shift specification %s" shift)))))
|
(goto-char end-of-tree)
|
(unless (bolp) (insert "\n"))
|
(let* ((end (point))
|
(template (buffer-substring beg end))
|
(shift-n (and doshift (string-to-number (match-string 1 shift))))
|
(shift-what (pcase (and doshift (match-string 2 shift))
|
(`nil nil)
|
("d" 'day)
|
("w" (setq shift-n (* 7 shift-n)) 'day)
|
("m" 'month)
|
("y" 'year)
|
(_ (error "Unsupported time unit"))))
|
(nmin 1)
|
(nmax n)
|
(n-no-remove -1)
|
(idprop (org-entry-get nil "ID")))
|
(when (and doshift
|
(string-match-p "<[^<>\n]+ [.+]?\\+[0-9]+[hdwmy][^<>\n]*>"
|
template))
|
(delete-region beg end)
|
(setq end beg)
|
(setq nmin 0)
|
(setq nmax (1+ nmax))
|
(setq n-no-remove nmax))
|
(goto-char end)
|
(cl-loop for n from nmin to nmax do
|
(insert
|
;; Prepare clone.
|
(with-temp-buffer
|
(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)))
|
(unless (= n 0)
|
(while (re-search-forward org-clock-line-re nil t)
|
(delete-region (line-beginning-position)
|
(line-beginning-position 2)))
|
(goto-char (point-min))
|
(while (re-search-forward org-drawer-regexp nil t)
|
(org-remove-empty-drawer-at (point))))
|
(goto-char (point-min))
|
(when doshift
|
(while (re-search-forward org-ts-regexp-both nil t)
|
(org-timestamp-change (* n shift-n) shift-what))
|
(unless (= n n-no-remove)
|
(goto-char (point-min))
|
(while (re-search-forward org-ts-regexp nil t)
|
(save-excursion
|
(goto-char (match-beginning 0))
|
(when (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[hdwmy]\\)")
|
(delete-region (match-beginning 1) (match-end 1)))))))
|
(buffer-string)))))
|
(goto-char beg)))
|
|
;;; Outline Sorting
|
|
(defun org-sort (&optional with-case)
|
"Call `org-sort-entries', `org-table-sort-lines' or `org-sort-list'.
|
Optional argument WITH-CASE means sort case-sensitively."
|
(interactive "P")
|
(org-call-with-arg
|
(cond ((org-at-table-p) #'org-table-sort-lines)
|
((org-at-item-p) #'org-sort-list)
|
(t #'org-sort-entries))
|
with-case))
|
|
(defun org-sort-remove-invisible (s)
|
"Remove invisible part of links and emphasis markers from string S."
|
(remove-text-properties 0 (length s) org-rm-props s)
|
(replace-regexp-in-string
|
org-verbatim-re (lambda (m) (format "%s " (match-string 4 m)))
|
(replace-regexp-in-string
|
org-emph-re (lambda (m) (format " %s " (match-string 4 m)))
|
(org-link-display-format s)
|
t t) t t))
|
|
(defvar org-priority-regexp) ; defined later in the file
|
|
(defvar org-after-sorting-entries-or-items-hook nil
|
"Hook that is run after a bunch of entries or items have been sorted.
|
When children are sorted, the cursor is in the parent line when this
|
hook gets called. When a region or a plain list is sorted, the cursor
|
will be in the first entry of the sorted region/list.")
|
|
(defun org-sort-entries
|
(&optional with-case sorting-type getkey-func compare-func property
|
interactive?)
|
"Sort entries on a certain level of an outline tree.
|
If there is an active region, the entries in the region are sorted.
|
Else, if the cursor is before the first entry, sort the top-level items.
|
Else, the children of the entry at point are sorted.
|
|
Sorting can be alphabetically, numerically, by date/time as given by
|
a time stamp, by a property, by priority order, or by a custom function.
|
|
The command prompts for the sorting type unless it has been given to the
|
function through the SORTING-TYPE argument, which needs to be a character,
|
\(?n ?N ?a ?A ?t ?T ?s ?S ?d ?D ?p ?P ?o ?O ?r ?R ?f ?F ?k ?K). Here is
|
the precise meaning of each character:
|
|
a Alphabetically, ignoring the TODO keyword and the priority, if any.
|
c By creation time, which is assumed to be the first inactive time stamp
|
at the beginning of a line.
|
d By deadline date/time.
|
k By clocking time.
|
n Numerically, by converting the beginning of the entry/item to a number.
|
o By order of TODO keywords.
|
p By priority according to the cookie.
|
r By the value of a property.
|
s By scheduled date/time.
|
t By date/time, either the first active time stamp in the entry, or, if
|
none exist, by the first inactive one.
|
|
Capital letters will reverse the sort order.
|
|
If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be
|
called with point at the beginning of the record. It must return a
|
value that is compatible with COMPARE-FUNC, the function used to
|
compare entries.
|
|
Comparing entries ignores case by default. However, with an optional argument
|
WITH-CASE, the sorting considers case as well.
|
|
Sorting is done against the visible part of the headlines, it ignores hidden
|
links.
|
|
When sorting is done, call `org-after-sorting-entries-or-items-hook'.
|
|
A non-nil value for INTERACTIVE? is used to signal that this
|
function is being called interactively."
|
(interactive (list current-prefix-arg nil nil nil nil t))
|
(let ((case-func (if with-case 'identity 'downcase))
|
start beg end stars re re2
|
txt what tmp)
|
;; Find beginning and end of region to sort
|
(cond
|
((org-region-active-p)
|
;; we will sort the region
|
(setq end (region-end)
|
what "region")
|
(goto-char (region-beginning))
|
(unless (org-at-heading-p) (outline-next-heading))
|
(setq start (point)))
|
((or (org-at-heading-p)
|
(ignore-errors (progn (org-back-to-heading) t)))
|
;; we will sort the children of the current headline
|
(org-back-to-heading)
|
(setq start (point)
|
end (progn (org-end-of-subtree t t)
|
(or (bolp) (insert "\n"))
|
(when (>= (org-back-over-empty-lines) 1)
|
(forward-line 1))
|
(point))
|
what "children")
|
(goto-char start)
|
(outline-show-subtree)
|
(outline-next-heading))
|
(t
|
;; we will sort the top-level entries in this file
|
(goto-char (point-min))
|
(or (org-at-heading-p) (outline-next-heading))
|
(setq start (point))
|
(goto-char (point-max))
|
(beginning-of-line 1)
|
(when (looking-at ".*?\\S-")
|
;; File ends in a non-white line
|
(end-of-line 1)
|
(insert "\n"))
|
(setq end (point-max))
|
(setq what "top-level")
|
(goto-char start)
|
(outline-show-all)))
|
|
(setq beg (point))
|
(when (>= beg end) (goto-char start) (user-error "Nothing to sort"))
|
|
(looking-at "\\(\\*+\\)")
|
(setq stars (match-string 1)
|
re (concat "^" (regexp-quote stars) " +")
|
re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[ \t\n]")
|
txt (buffer-substring beg end))
|
(unless (equal (substring txt -1) "\n") (setq txt (concat txt "\n")))
|
(when (and (not (equal stars "*")) (string-match re2 txt))
|
(user-error "Region to sort contains a level above the first entry"))
|
|
(unless sorting-type
|
(message
|
"Sort %s: [a]lpha [n]umeric [p]riority p[r]operty todo[o]rder [f]unc
|
[t]ime [s]cheduled [d]eadline [c]reated cloc[k]ing
|
A/N/P/R/O/F/T/S/D/C/K means reversed:"
|
what)
|
(setq sorting-type (read-char-exclusive)))
|
|
(unless getkey-func
|
(and (= (downcase sorting-type) ?f)
|
(setq getkey-func
|
(or (and interactive?
|
(org-read-function
|
"Function for extracting keys: "))
|
(error "Missing key extractor")))))
|
|
(and (= (downcase sorting-type) ?r)
|
(not property)
|
(setq property
|
(completing-read "Property: "
|
(mapcar #'list (org-buffer-property-keys t))
|
nil t)))
|
|
(when (member sorting-type '(?k ?K)) (org-clock-sum))
|
(message "Sorting entries...")
|
|
(save-restriction
|
(narrow-to-region start end)
|
(let ((restore-clock?
|
;; The clock marker is lost when using `sort-subr'; mark
|
;; the clock with temporary `:org-clock-marker-backup'
|
;; text property.
|
(when (and (eq (org-clock-is-active) (current-buffer))
|
(<= start (marker-position org-clock-marker))
|
(>= end (marker-position org-clock-marker)))
|
(org-with-silent-modifications
|
(put-text-property (1- org-clock-marker) org-clock-marker
|
:org-clock-marker-backup t))
|
t))
|
(dcst (downcase sorting-type))
|
(case-fold-search nil)
|
(now (current-time)))
|
(sort-subr
|
(/= dcst sorting-type)
|
;; This function moves to the beginning character of the "record" to
|
;; be sorted.
|
(lambda nil
|
(if (re-search-forward re nil t)
|
(goto-char (match-beginning 0))
|
(goto-char (point-max))))
|
;; This function moves to the last character of the "record" being
|
;; sorted.
|
(lambda nil
|
(save-match-data
|
(condition-case nil
|
(outline-forward-same-level 1)
|
(error
|
(goto-char (point-max))))))
|
;; This function returns the value that gets sorted against.
|
(lambda nil
|
(cond
|
((= dcst ?n)
|
(if (looking-at org-complex-heading-regexp)
|
(string-to-number (org-sort-remove-invisible (match-string 4)))
|
nil))
|
((= dcst ?a)
|
(if (looking-at org-complex-heading-regexp)
|
(funcall case-func (org-sort-remove-invisible (match-string 4)))
|
nil))
|
((= dcst ?k)
|
(or (get-text-property (point) :org-clock-minutes) 0))
|
((= dcst ?t)
|
(let ((end (save-excursion (outline-next-heading) (point))))
|
(if (or (re-search-forward org-ts-regexp end t)
|
(re-search-forward org-ts-regexp-both end t))
|
(org-time-string-to-seconds (match-string 0))
|
(float-time now))))
|
((= dcst ?c)
|
(let ((end (save-excursion (outline-next-heading) (point))))
|
(if (re-search-forward
|
(concat "^[ \t]*\\[" org-ts-regexp1 "\\]")
|
end t)
|
(org-time-string-to-seconds (match-string 0))
|
(float-time now))))
|
((= dcst ?s)
|
(let ((end (save-excursion (outline-next-heading) (point))))
|
(if (re-search-forward org-scheduled-time-regexp end t)
|
(org-time-string-to-seconds (match-string 1))
|
(float-time now))))
|
((= dcst ?d)
|
(let ((end (save-excursion (outline-next-heading) (point))))
|
(if (re-search-forward org-deadline-time-regexp end t)
|
(org-time-string-to-seconds (match-string 1))
|
(float-time now))))
|
((= dcst ?p)
|
(if (re-search-forward org-priority-regexp (point-at-eol) t)
|
(string-to-char (match-string 2))
|
org-default-priority))
|
((= dcst ?r)
|
(or (org-entry-get nil property) ""))
|
((= dcst ?o)
|
(when (looking-at org-complex-heading-regexp)
|
(let* ((m (match-string 2))
|
(s (if (member m org-done-keywords) '- '+)))
|
(- 99 (funcall s (length (member m org-todo-keywords-1)))))))
|
((= dcst ?f)
|
(if getkey-func
|
(progn
|
(setq tmp (funcall getkey-func))
|
(when (stringp tmp) (setq tmp (funcall case-func tmp)))
|
tmp)
|
(error "Invalid key function `%s'" getkey-func)))
|
(t (error "Invalid sorting type `%c'" sorting-type))))
|
nil
|
(cond
|
((= dcst ?a) 'string<)
|
((= dcst ?f)
|
(or compare-func
|
(and interactive?
|
(org-read-function
|
(concat "Function for comparing keys "
|
"(empty for default `sort-subr' predicate): ")
|
'allow-empty))))
|
((member dcst '(?p ?t ?s ?d ?c ?k)) '<)))
|
(when restore-clock?
|
(move-marker org-clock-marker
|
(1+ (next-single-property-change
|
start :org-clock-marker-backup)))
|
(remove-text-properties (1- org-clock-marker) org-clock-marker
|
'(:org-clock-marker-backup t)))))
|
(run-hooks 'org-after-sorting-entries-or-items-hook)
|
(message "Sorting entries...done")))
|
|
;;; The orgstruct minor mode
|
|
;; Define a minor mode which can be used in other modes in order to
|
;; integrate the Org mode structure editing commands.
|
|
;; This is really a hack, because the Org mode structure commands use
|
;; keys which normally belong to the major mode. Here is how it
|
;; works: The minor mode defines all the keys necessary to operate the
|
;; structure commands, but wraps the commands into a function which
|
;; tests if the cursor is currently at a headline or a plain list
|
;; item. If that is the case, the structure command is used,
|
;; temporarily setting many Org mode variables like regular
|
;; expressions for filling etc. However, when any of those keys is
|
;; used at a different location, function uses `key-binding' to look
|
;; up if the key has an associated command in another currently active
|
;; keymap (minor modes, major mode, global), and executes that
|
;; command. There might be problems if any of the keys is otherwise
|
;; used as a prefix key.
|
|
(defcustom orgstruct-heading-prefix-regexp ""
|
"Regexp that matches the custom prefix of Org headlines in
|
orgstruct(++)-mode."
|
:group 'org
|
:version "26.1"
|
:package-version '(Org . "8.3")
|
:type 'regexp)
|
;;;###autoload(put 'orgstruct-heading-prefix-regexp 'safe-local-variable 'stringp)
|
|
(defcustom orgstruct-setup-hook nil
|
"Hook run after orgstruct-mode-map is filled."
|
:group 'org
|
:version "24.4"
|
:package-version '(Org . "8.0")
|
:type 'hook)
|
|
(defvar orgstruct-initialized nil)
|
|
(defvar org-local-vars nil
|
"List of local variables, for use by `orgstruct-mode'.")
|
|
;;;###autoload
|
(define-minor-mode orgstruct-mode
|
"Toggle the minor mode `orgstruct-mode'.
|
This mode is for using Org mode structure commands in other
|
modes. The following keys behave as if Org mode were active, if
|
the cursor is on a headline, or on a plain list item (both as
|
defined by Org mode)."
|
nil " OrgStruct" (make-sparse-keymap)
|
(funcall (if orgstruct-mode
|
'add-to-invisibility-spec
|
'remove-from-invisibility-spec)
|
'(outline . t))
|
(when orgstruct-mode
|
(org-load-modules-maybe)
|
(unless orgstruct-initialized
|
(orgstruct-setup)
|
(setq orgstruct-initialized t))))
|
|
;;;###autoload
|
(defun turn-on-orgstruct ()
|
"Unconditionally turn on `orgstruct-mode'."
|
(orgstruct-mode 1))
|
|
(defvar-local orgstruct-is-++ nil
|
"Is `orgstruct-mode' in ++ version in the current-buffer?")
|
(defvar-local org-fb-vars nil)
|
(defun orgstruct++-mode (&optional arg)
|
"Toggle `orgstruct-mode', the enhanced version of it.
|
In addition to setting orgstruct-mode, this also exports all
|
indentation and autofilling variables from Org mode into the
|
buffer. It will also recognize item context in multiline items."
|
(interactive "P")
|
(setq arg (prefix-numeric-value (or arg (if orgstruct-mode -1 1))))
|
(if (< arg 1)
|
(progn (orgstruct-mode -1)
|
(dolist (v org-fb-vars)
|
(set (make-local-variable (car v))
|
(if (eq (car-safe (cadr v)) 'quote)
|
(cl-cadadr v)
|
(nth 1 v)))))
|
(orgstruct-mode 1)
|
(setq org-fb-vars nil)
|
(unless org-local-vars
|
(setq org-local-vars (org-get-local-variables)))
|
(let (var val)
|
(dolist (x org-local-vars)
|
(when (string-match
|
"^\\(paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\
|
\\|fill-prefix\\|indent-\\)"
|
(symbol-name (car x)))
|
(setq var (car x) val (nth 1 x))
|
(push (list var `(quote ,(eval var))) org-fb-vars)
|
(set (make-local-variable var)
|
(if (eq (car-safe val) 'quote) (nth 1 val) val))))
|
(setq-local orgstruct-is-++ t))))
|
|
;;;###autoload
|
(defun turn-on-orgstruct++ ()
|
"Unconditionally turn on `orgstruct++-mode'."
|
(orgstruct++-mode 1))
|
|
(defun orgstruct-error ()
|
"Error when there is no default binding for a structure key."
|
(interactive)
|
(funcall (if (fboundp 'user-error)
|
'user-error
|
'error)
|
"This key has no function outside structure elements"))
|
|
(defun orgstruct-setup ()
|
"Setup orgstruct keymap."
|
(dolist (cell '((org-demote . t)
|
(org-metaleft . t)
|
(org-metaright . t)
|
(org-promote . t)
|
(org-shiftmetaleft . t)
|
(org-shiftmetaright . t)
|
org-backward-element
|
org-backward-heading-same-level
|
org-ctrl-c-ret
|
org-ctrl-c-minus
|
org-ctrl-c-star
|
org-cycle
|
org-force-cycle-archived
|
org-forward-heading-same-level
|
org-insert-heading
|
org-insert-heading-respect-content
|
org-kill-note-or-show-branches
|
org-mark-subtree
|
org-meta-return
|
org-metadown
|
org-metaup
|
org-narrow-to-subtree
|
org-promote-subtree
|
org-reveal
|
org-shiftdown
|
org-shiftleft
|
org-shiftmetadown
|
org-shiftmetaup
|
org-shiftright
|
org-shifttab
|
org-shifttab
|
org-shiftup
|
org-show-children
|
org-show-subtree
|
org-sort
|
org-up-element
|
outline-demote
|
outline-next-visible-heading
|
outline-previous-visible-heading
|
outline-promote
|
outline-up-heading))
|
(let ((f (or (car-safe cell) cell))
|
(disable-when-heading-prefix (cdr-safe cell)))
|
(when (fboundp f)
|
(let ((new-bindings))
|
(dolist (binding (nconc (where-is-internal f org-mode-map)
|
(where-is-internal f outline-mode-map)))
|
(push binding new-bindings)
|
;; TODO use local-function-key-map
|
(dolist (rep '(("<tab>" . "TAB")
|
("<return>" . "RET")
|
("<escape>" . "ESC")
|
("<delete>" . "DEL")))
|
(setq binding (read-kbd-macro
|
(let ((case-fold-search))
|
(replace-regexp-in-string
|
(regexp-quote (cdr rep))
|
(car rep)
|
(key-description binding)))))
|
(cl-pushnew binding new-bindings :test 'equal)))
|
(dolist (binding new-bindings)
|
(let ((key (lookup-key orgstruct-mode-map binding)))
|
(when (or (not key) (numberp key))
|
(ignore-errors
|
(org-defkey orgstruct-mode-map
|
binding
|
(orgstruct-make-binding
|
f binding disable-when-heading-prefix))))))))))
|
(run-hooks 'orgstruct-setup-hook))
|
|
(defun orgstruct-make-binding (fun key disable-when-heading-prefix)
|
"Create a function for binding in the structure minor mode.
|
FUN is the command to call inside a table. KEY is the key that
|
should be checked in for a command to execute outside of tables.
|
Non-nil `disable-when-heading-prefix' means to disable the command
|
if `orgstruct-heading-prefix-regexp' is not empty."
|
(let ((name (concat "orgstruct-hijacker-" (symbol-name fun))))
|
(let ((nname name)
|
(i 0))
|
(while (fboundp (intern nname))
|
(setq nname (format "%s-%d" name (setq i (1+ i)))))
|
(setq name (intern nname)))
|
(eval
|
(let ((bindings '((org-heading-regexp
|
(concat "^"
|
orgstruct-heading-prefix-regexp
|
"\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ ]*$"))
|
(org-outline-regexp
|
(concat orgstruct-heading-prefix-regexp "\\*+ "))
|
(org-outline-regexp-bol
|
(concat "^" org-outline-regexp))
|
(outline-regexp org-outline-regexp)
|
(outline-heading-end-regexp "\n")
|
(outline-level 'org-outline-level)
|
(outline-heading-alist))))
|
`(defun ,name (arg)
|
,(concat "In Structure, run `" (symbol-name fun) "'.\n"
|
"Outside of structure, run the binding of `"
|
(key-description key) "'."
|
(when disable-when-heading-prefix
|
(concat
|
"\nIf `orgstruct-heading-prefix-regexp' is not empty, this command will always fall\n"
|
"back to the default binding due to limitations of Org's implementation of\n"
|
"`" (symbol-name fun) "'.")))
|
(interactive "p")
|
(let* ((disable
|
,(and disable-when-heading-prefix
|
'(not (string= orgstruct-heading-prefix-regexp ""))))
|
(fallback
|
(or disable
|
(not
|
(let* ,bindings
|
(org-context-p 'headline 'item
|
,(when (memq fun
|
'(org-insert-heading
|
org-insert-heading-respect-content
|
org-meta-return))
|
'(when orgstruct-is-++
|
'item-body))))))))
|
(if fallback
|
(let* ((orgstruct-mode)
|
(binding
|
(let ((key ,key))
|
(catch 'exit
|
(dolist
|
(rep
|
'(nil
|
("<\\([^>]*\\)tab>" . "\\1TAB")
|
("<\\([^>]*\\)return>" . "\\1RET")
|
("<\\([^>]*\\)escape>" . "\\1ESC")
|
("<\\([^>]*\\)delete>" . "\\1DEL"))
|
nil)
|
(when rep
|
(setq key (read-kbd-macro
|
(let ((case-fold-search))
|
(replace-regexp-in-string
|
(car rep)
|
(cdr rep)
|
(key-description key))))))
|
(when (key-binding key)
|
(throw 'exit (key-binding key))))))))
|
(if (keymapp binding)
|
(org-set-transient-map binding)
|
(let ((func (or binding
|
(unless disable
|
'orgstruct-error))))
|
(when func
|
(call-interactively func)))))
|
(org-run-like-in-org-mode
|
(lambda ()
|
(interactive)
|
(let* ,bindings
|
(call-interactively ',fun)))))))))
|
name))
|
|
(defun org-contextualize-keys (alist contexts)
|
"Return valid elements in ALIST depending on CONTEXTS.
|
|
`org-agenda-custom-commands' or `org-capture-templates' are the
|
values used for ALIST, and `org-agenda-custom-commands-contexts'
|
or `org-capture-templates-contexts' are the associated contexts
|
definitions."
|
(let ((contexts
|
;; normalize contexts
|
(mapcar
|
(lambda(c) (cond ((listp (cadr c))
|
(list (car c) (car c) (nth 1 c)))
|
((string= "" (cadr c))
|
(list (car c) (car c) (nth 2 c)))
|
(t c)))
|
contexts))
|
(a alist) r s)
|
;; loop over all commands or templates
|
(dolist (c a)
|
(let (vrules repl)
|
(cond
|
((not (assoc (car c) contexts))
|
(push c r))
|
((and (assoc (car c) contexts)
|
(setq vrules (org-contextualize-validate-key
|
(car c) contexts)))
|
(mapc (lambda (vr)
|
(unless (equal (car vr) (cadr vr))
|
(setq repl vr)))
|
vrules)
|
(if (not repl) (push c r)
|
(push (cadr repl) s)
|
(push
|
(cons (car c)
|
(cdr (or (assoc (cadr repl) alist)
|
(error "Undefined key `%s' as contextual replacement for `%s'"
|
(cadr repl) (car c)))))
|
r))))))
|
;; Return limited ALIST, possibly with keys modified, and deduplicated
|
(delq
|
nil
|
(delete-dups
|
(mapcar (lambda (x)
|
(let ((tpl (car x)))
|
(unless (delq
|
nil
|
(mapcar (lambda (y)
|
(equal y tpl))
|
s))
|
x)))
|
(reverse r))))))
|
|
(defun org-contextualize-validate-key (key contexts)
|
"Check CONTEXTS for agenda or capture KEY."
|
(let (res)
|
(dolist (r contexts)
|
(dolist (rr (car (last r)))
|
(when
|
(and (equal key (car r))
|
(if (functionp rr) (funcall rr)
|
(or (and (eq (car rr) 'in-file)
|
(buffer-file-name)
|
(string-match (cdr rr) (buffer-file-name)))
|
(and (eq (car rr) 'in-mode)
|
(string-match (cdr rr) (symbol-name major-mode)))
|
(and (eq (car rr) 'in-buffer)
|
(string-match (cdr rr) (buffer-name)))
|
(when (and (eq (car rr) 'not-in-file)
|
(buffer-file-name))
|
(not (string-match (cdr rr) (buffer-file-name))))
|
(when (eq (car rr) 'not-in-mode)
|
(not (string-match (cdr rr) (symbol-name major-mode))))
|
(when (eq (car rr) 'not-in-buffer)
|
(not (string-match (cdr rr) (buffer-name)))))))
|
(push r res))))
|
(delete-dups (delq nil res))))
|
|
(defun org-context-p (&rest contexts)
|
"Check if local context is any of CONTEXTS.
|
Possible values in the list of contexts are `table', `headline', and `item'."
|
(let ((pos (point)))
|
(goto-char (point-at-bol))
|
(prog1 (or (and (memq 'table contexts)
|
(looking-at "[ \t]*|"))
|
(and (memq 'headline contexts)
|
(looking-at org-outline-regexp))
|
(and (memq 'item contexts)
|
(looking-at "[ \t]*\\([-+*] \\|[0-9]+[.)] \\)"))
|
(and (memq 'item-body contexts)
|
(org-in-item-p)))
|
(goto-char pos))))
|
|
;;;###autoload
|
(defun org-run-like-in-org-mode (cmd)
|
"Run a command, pretending that the current buffer is in Org mode.
|
This will temporarily bind local variables that are typically bound in
|
Org mode to the values they have in Org mode, and then interactively
|
call CMD."
|
(org-load-modules-maybe)
|
(unless org-local-vars
|
(setq org-local-vars (org-get-local-variables)))
|
(let (binds)
|
(dolist (var org-local-vars)
|
(when (or (not (boundp (car var)))
|
(eq (symbol-value (car var))
|
(default-value (car var))))
|
(push (list (car var) `(quote ,(cadr var))) binds)))
|
(eval `(let ,binds
|
(call-interactively (quote ,cmd))))))
|
|
(defun org-get-category (&optional pos force-refresh)
|
"Get the category applying to position POS."
|
(save-match-data
|
(when 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))))))
|
|
;;; Refresh properties
|
|
(defun org-refresh-properties (dprop tprop)
|
"Refresh buffer text properties.
|
DPROP is the drawer property and TPROP is either the
|
corresponding text property to set, or an alist with each element
|
being a text property (as a symbol) and a function to apply to
|
the value of the drawer property."
|
(let* ((case-fold-search t)
|
(inhibit-read-only t)
|
(inherit? (org-property-inherit-p dprop))
|
(property-re (org-re-property (concat (regexp-quote dprop) "\\+?") t))
|
(global (and inherit? (org--property-global-value dprop nil))))
|
(org-with-silent-modifications
|
(org-with-point-at 1
|
;; Set global values (e.g., values defined through
|
;; "#+PROPERTY:" keywords) to the whole buffer.
|
(when global (put-text-property (point-min) (point-max) tprop global))
|
;; Set local values.
|
(while (re-search-forward property-re nil t)
|
(when (org-at-property-p)
|
(org-refresh-property tprop (org-entry-get (point) dprop) inherit?))
|
(outline-next-heading))))))
|
|
(defun org-refresh-property (tprop p &optional inherit)
|
"Refresh the buffer text property TPROP from the drawer property P.
|
The refresh happens only for the current headline, or the whole
|
sub-tree if optional argument INHERIT is non-nil."
|
(unless (org-before-first-heading-p)
|
(save-excursion
|
(org-back-to-heading t)
|
(let ((start (point))
|
(end (save-excursion
|
(if inherit (org-end-of-subtree t t)
|
(or (outline-next-heading) (point-max))))))
|
(if (symbolp tprop)
|
;; TPROP is a text property symbol.
|
(put-text-property start end tprop p)
|
;; TPROP is an alist with (property . function) elements.
|
(pcase-dolist (`(,prop . ,f) tprop)
|
(put-text-property start end prop (funcall f p))))))))
|
|
(defun org-refresh-category-properties ()
|
"Refresh category text properties in the buffer."
|
(let ((case-fold-search t)
|
(inhibit-read-only t)
|
(default-category
|
(cond ((null org-category)
|
(if buffer-file-name
|
(file-name-sans-extension
|
(file-name-nondirectory buffer-file-name))
|
"???"))
|
((symbolp org-category) (symbol-name org-category))
|
(t org-category))))
|
(org-with-silent-modifications
|
(org-with-wide-buffer
|
;; Set buffer-wide category. Search last #+CATEGORY keyword.
|
;; This is the default category for the buffer. If none is
|
;; found, fall-back to `org-category' or buffer file name.
|
(put-text-property
|
(point-min) (point-max)
|
'org-category
|
(catch 'buffer-category
|
(goto-char (point-max))
|
(while (re-search-backward "^[ \t]*#\\+CATEGORY:" (point-min) t)
|
(let ((element (org-element-at-point)))
|
(when (eq (org-element-type element) 'keyword)
|
(throw 'buffer-category
|
(org-element-property :value element)))))
|
default-category))
|
;; Set sub-tree specific categories.
|
(goto-char (point-min))
|
(let ((regexp (org-re-property "CATEGORY")))
|
(while (re-search-forward regexp nil t)
|
(let ((value (match-string-no-properties 3)))
|
(when (org-at-property-p)
|
(put-text-property
|
(save-excursion (org-back-to-heading t) (point))
|
(save-excursion (org-end-of-subtree t t) (point))
|
'org-category
|
value)))))))))
|
|
(defun org-refresh-stats-properties ()
|
"Refresh stats text properties in the buffer."
|
(org-with-silent-modifications
|
(org-with-point-at 1
|
(let ((regexp (concat org-outline-regexp-bol
|
".*\\[\\([0-9]*\\)\\(?:%\\|/\\([0-9]*\\)\\)\\]")))
|
(while (re-search-forward regexp nil t)
|
(let* ((numerator (string-to-number (match-string 1)))
|
(denominator (and (match-end 2)
|
(string-to-number (match-string 2))))
|
(stats (cond ((not denominator) numerator) ;percent
|
((= denominator 0) 0)
|
(t (/ (* numerator 100) denominator)))))
|
(put-text-property (point) (progn (org-end-of-subtree t t) (point))
|
'org-stats stats)))))))
|
|
(defun org-refresh-effort-properties ()
|
"Refresh effort properties"
|
(org-refresh-properties
|
org-effort-property
|
'((effort . identity)
|
(effort-minutes . org-duration-to-minutes))))
|
|
;;;; Link Stuff
|
|
;;; Link abbreviations
|
|
(defun org-link-expand-abbrev (link)
|
"Apply replacements as defined in `org-link-abbrev-alist'."
|
(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)))
|
(tag (and (match-end 2) (match-string 3 link)))
|
rpl)
|
(if (not as)
|
link
|
(setq rpl (cdr as))
|
(cond
|
((symbolp rpl) (funcall rpl tag))
|
((string-match "%(\\([^)]+\\))" rpl)
|
(replace-match
|
(save-match-data
|
(funcall (intern-soft (match-string 1 rpl)) tag)) t t rpl))
|
((string-match "%s" rpl) (replace-match (or tag "") t t rpl))
|
((string-match "%h" rpl)
|
(replace-match (url-hexify-string (or tag "")) t t rpl))
|
(t (concat rpl tag)))))
|
link))
|
|
;;; Storing and inserting links
|
|
(defvar org-insert-link-history nil
|
"Minibuffer history for links inserted with `org-insert-link'.")
|
|
(defvar org-stored-links nil
|
"Contains the links stored with `org-store-link'.")
|
|
(defvar org-store-link-plist nil
|
"Plist with info about the most recently link created with `org-store-link'.")
|
|
(defun org-store-link-functions ()
|
"Return a list of functions that are called to create and store a link.
|
The functions defined in the :store property of
|
`org-link-parameters'.
|
|
Each function will be called in turn until one returns a non-nil
|
value. Each function should check if it is responsible for
|
creating this link (for example by looking at the major mode).
|
If not, it must exit and return nil. If yes, it should return
|
a non-nil value after calling `org-store-link-props' with a list
|
of properties and values. Special properties are:
|
|
:type The link prefix, like \"http\". This must be given.
|
:link The link, like \"http://www.astro.uva.nl/~dominik\".
|
This is obligatory as well.
|
:description Optional default description for the second pair
|
of brackets in an Org mode link. The user can still change
|
this when inserting this link into an Org mode buffer.
|
|
In addition to these, any additional properties can be specified
|
and then used in capture templates."
|
(cl-loop for link in org-link-parameters
|
with store-func
|
do (setq store-func (org-link-get-parameter (car link) :store))
|
if store-func
|
collect store-func))
|
|
(defvar org-agenda-buffer-name) ; Defined in org-agenda.el
|
(defvar org-id-link-to-org-use-id) ; Defined in org-id.el
|
|
;;;###autoload
|
(defun org-store-link (arg)
|
"Store an org-link to the current location.
|
\\<org-mode-map>
|
This link is added to `org-stored-links' and can later be inserted
|
into an Org buffer with `org-insert-link' (`\\[org-insert-link]').
|
|
For some link types, a `\\[universal-argument]' prefix ARG is interpreted. \
|
A single
|
`\\[universal-argument]' negates `org-context-in-file-links' for file links or
|
`org-gnus-prefer-web-links' for links to Usenet articles.
|
|
A `\\[universal-argument] \\[universal-argument]' prefix ARG forces \
|
skipping storing functions that are not
|
part of Org core.
|
|
A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \
|
prefix ARG forces storing a link for each line in the
|
active region."
|
(interactive "P")
|
(org-load-modules-maybe)
|
(if (and (equal arg '(64)) (org-region-active-p))
|
(save-excursion
|
(let ((end (region-end)))
|
(goto-char (region-beginning))
|
(set-mark (point))
|
(while (< (point-at-eol) end)
|
(move-end-of-line 1) (activate-mark)
|
(let (current-prefix-arg)
|
(call-interactively 'org-store-link))
|
(move-beginning-of-line 2)
|
(set-mark (point)))))
|
(setq org-store-link-plist nil)
|
(let (link cpltxt desc description search txt custom-id agenda-link)
|
(cond
|
;; Store a link using an external link type, if any function is
|
;; available. If more than one can generate a link from current
|
;; location, ask which one to use.
|
((and (not (equal arg '(16)))
|
(let ((results-alist nil))
|
(dolist (f (org-store-link-functions))
|
(when (funcall f)
|
;; XXX: return value is not link's plist, so we
|
;; store the new value before it is modified. It
|
;; would be cleaner to ask store link functions to
|
;; return the plist instead.
|
(push (cons f (copy-sequence org-store-link-plist))
|
results-alist)))
|
(pcase results-alist
|
(`nil nil)
|
(`((,_ . ,_)) t) ;single choice: nothing to do
|
(`((,name . ,_) . ,_)
|
;; Reinstate link plist associated to the chosen
|
;; function.
|
(apply #'org-store-link-props
|
(cdr (assoc-string
|
(completing-read
|
"Which function for creating the link? "
|
(mapcar #'car results-alist)
|
nil t (symbol-name name))
|
results-alist)))
|
t))))
|
(setq link (plist-get org-store-link-plist :link))
|
(setq desc (or (plist-get org-store-link-plist :description)
|
link)))
|
|
;; Store a link from a source code buffer.
|
((org-src-edit-buffer-p)
|
(let ((coderef-format (org-src-coderef-format)))
|
(cond ((save-excursion
|
(beginning-of-line)
|
(looking-at (org-src-coderef-regexp coderef-format)))
|
(setq link (format "(%s)" (match-string-no-properties 3))))
|
((called-interactively-p 'any)
|
(let ((label (read-string "Code line label: ")))
|
(end-of-line)
|
(setq link (format coderef-format label))
|
(let ((gc (- 79 (length link))))
|
(if (< (current-column) gc)
|
(org-move-to-column gc t)
|
(insert " ")))
|
(insert link)
|
(setq link (concat "(" label ")"))
|
(setq desc nil)))
|
(t (setq link nil)))))
|
|
;; We are in the agenda, link to referenced location
|
((equal (bound-and-true-p org-agenda-buffer-name) (buffer-name))
|
(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 (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 'help-mode)
|
(setq link (concat "help:" (save-excursion
|
(goto-char (point-min))
|
(looking-at "^[^ ]+")
|
(match-string 0))))
|
(org-store-link-props :type "help"))
|
|
((eq major-mode 'w3-mode)
|
(setq cpltxt (if (and (buffer-name)
|
(not (string-match "Untitled" (buffer-name))))
|
(buffer-name)
|
(url-view-url t))
|
link (url-view-url t))
|
(org-store-link-props :type "w3" :url (url-view-url t)))
|
|
((eq major-mode 'image-mode)
|
(setq cpltxt (concat "file:"
|
(abbreviate-file-name buffer-file-name))
|
link cpltxt)
|
(org-store-link-props :type "image" :file buffer-file-name))
|
|
;; In dired, store a link to the file of the current line
|
((derived-mode-p 'dired-mode)
|
(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 cpltxt)))
|
|
((setq search (run-hook-with-args-until-success
|
'org-create-file-search-functions))
|
(setq link (concat "file:" (abbreviate-file-name buffer-file-name)
|
"::" search))
|
(setq cpltxt (or description link)))
|
|
((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
|
(org-with-limited-levels
|
(setq custom-id (org-entry-get nil "CUSTOM_ID"))
|
(cond
|
;; Store a link using the target at point
|
((org-in-regexp "[^<]<<\\([^<>]+\\)>>[^>]" 1)
|
(setq cpltxt
|
(concat "file:"
|
(abbreviate-file-name
|
(buffer-file-name (buffer-base-buffer)))
|
"::" (match-string 1))
|
link cpltxt))
|
((and (featurep 'org-id)
|
(or (eq org-id-link-to-org-use-id t)
|
(and (called-interactively-p 'any)
|
(or (eq org-id-link-to-org-use-id 'create-if-interactive)
|
(and (eq org-id-link-to-org-use-id
|
'create-if-interactive-and-no-custom-id)
|
(not custom-id))))
|
(and org-id-link-to-org-use-id (org-entry-get nil "ID"))))
|
;; Store a link using the ID at point
|
(setq link (condition-case nil
|
(prog1 (org-id-store-link)
|
(setq desc (or (plist-get org-store-link-plist
|
:description)
|
"")))
|
(error
|
;; Probably before first headline, link only to file
|
(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
|
(equal arg '(4)))
|
(let* ((element (org-element-at-point))
|
(name (org-element-property :name element)))
|
(setq txt (cond
|
((org-at-heading-p) nil)
|
(name)
|
((org-region-active-p)
|
(buffer-substring (region-beginning) (region-end)))))
|
(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 name
|
(nth 4 (ignore-errors (org-heading-components)))
|
"NONE")))))
|
(when (string-match "::\\'" cpltxt)
|
(setq cpltxt (substring cpltxt 0 -2)))
|
(setq 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
|
(equal arg '(4)))
|
(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 cpltxt))
|
|
((called-interactively-p 'interactive)
|
(user-error "No method for storing a link from this buffer"))
|
|
(t (setq link nil)))
|
|
;; We're done setting link and desc, clean up
|
(when (consp link) (setq cpltxt (car link) link (cdr link)))
|
(setq link (or link cpltxt)
|
desc (or desc cpltxt))
|
(cond ((not desc))
|
((equal desc "NONE") (setq desc nil))
|
(t (setq desc
|
(replace-regexp-in-string
|
org-bracket-link-analytic-regexp
|
(lambda (m) (or (match-string 5 m) (match-string 3 m)))
|
desc))))
|
;; Return the link
|
(if (not (and (or (called-interactively-p 'any)
|
executing-kbd-macro)
|
link))
|
(or agenda-link (and link (org-make-link-string link desc)))
|
(push (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))
|
(push (list link desc) org-stored-links))
|
(car org-stored-links)))))
|
|
(defun org-store-link-props (&rest plist)
|
"Store link properties.
|
The properties are pre-processed by extracting names, addresses
|
and dates."
|
(let ((x (plist-get plist :from)))
|
(when x
|
(let ((adr (mail-extract-address-components x)))
|
(setq plist (plist-put plist :fromname (car adr)))
|
(setq plist (plist-put plist :fromaddress (nth 1 adr))))))
|
(let ((x (plist-get plist :to)))
|
(when x
|
(let ((adr (mail-extract-address-components x)))
|
(setq plist (plist-put plist :toname (car adr)))
|
(setq plist (plist-put plist :toaddress (nth 1 adr))))))
|
(let ((x (ignore-errors (date-to-time (plist-get plist :date)))))
|
(when x
|
(setq plist (plist-put plist :date-timestamp
|
(format-time-string
|
(org-time-stamp-format t) x)))
|
(setq plist (plist-put plist :date-timestamp-inactive
|
(format-time-string
|
(org-time-stamp-format t t) x)))))
|
(let ((from (plist-get plist :from))
|
(to (plist-get plist :to)))
|
(when (and from to org-from-is-user-regexp)
|
(setq plist
|
(plist-put plist :fromto
|
(if (string-match org-from-is-user-regexp from)
|
(concat "to %t")
|
(concat "from %f"))))))
|
(setq org-store-link-plist plist))
|
|
(defun org-add-link-props (&rest plist)
|
"Add these properties to the link property list."
|
(let (key value)
|
(while plist
|
(setq key (pop plist) value (pop plist))
|
(setq org-store-link-plist
|
(plist-put org-store-link-plist key value)))))
|
|
(defun org-email-link-description (&optional fmt)
|
"Return the description part of an email link.
|
This takes information from `org-store-link-plist' and formats it
|
according to FMT (default from `org-email-link-description-format')."
|
(setq fmt (or fmt org-email-link-description-format))
|
(let* ((p org-store-link-plist)
|
(to (plist-get p :toaddress))
|
(from (plist-get p :fromaddress))
|
(table
|
(list
|
(cons "%c" (plist-get p :fromto))
|
(cons "%F" (plist-get p :from))
|
(cons "%f" (or (plist-get p :fromname) (plist-get p :fromaddress) "?"))
|
(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
|
(if (and org-from-is-user-regexp from to
|
(save-match-data (string-match org-from-is-user-regexp from)))
|
(setq fmt (replace-match "to %t" t t fmt))
|
(setq fmt (replace-match "from %f" t t fmt))))
|
(org-replace-escapes fmt table)))
|
|
(defun org-make-org-heading-search-string (&optional string)
|
"Make search string for the current headline or STRING."
|
(let ((s (or string
|
(and (derived-mode-p 'org-mode)
|
(save-excursion
|
(org-back-to-heading t)
|
(org-element-property :raw-value (org-element-at-point))))))
|
(lines org-context-in-file-links))
|
(unless string (setq s (concat "*" s))) ;Add * for headlines
|
(setq s (replace-regexp-in-string "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" s))
|
(when (and string (integerp lines) (> lines 0))
|
(let ((slines (org-split-string s "\n")))
|
(when (< lines (length slines))
|
(setq s (mapconcat
|
'identity
|
(reverse (nthcdr (- (length slines) lines)
|
(reverse slines))) "\n")))))
|
(mapconcat #'identity (split-string s) " ")))
|
|
(defconst org-link-escape-chars
|
;;%20 %5B %5D %25
|
'(?\s ?\[ ?\] ?%)
|
"List of characters that should be escaped in a link when stored to Org.
|
This is the list that is used for internal purposes.")
|
|
(defun org-make-link-string (link &optional description)
|
"Make a link with brackets, consisting of LINK and DESCRIPTION."
|
(unless (org-string-nw-p link) (error "Empty link"))
|
(let ((uri (cond ((string-match org-link-types-re link)
|
(concat (match-string 1 link)
|
(org-link-escape (substring link (match-end 1)))))
|
((or (file-name-absolute-p link)
|
(string-match-p "\\`\\.\\.?/" link))
|
(org-link-escape link))
|
;; For readability, do not encode space characters
|
;; in fuzzy links.
|
(t (org-link-escape link (remq ?\s org-link-escape-chars)))))
|
(description
|
(and (org-string-nw-p description)
|
;; Remove brackets from description, as they are fatal.
|
(replace-regexp-in-string
|
"[][]" (lambda (m) (if (equal "[" m) "{" "}"))
|
(org-trim description)))))
|
(format "[[%s]%s]"
|
uri
|
(if description (format "[%s]" description) ""))))
|
|
(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'."
|
(let ((characters-to-encode
|
(cond ((null table) org-link-escape-chars)
|
(merge (append org-link-escape-chars table))
|
(t table))))
|
(mapconcat
|
(lambda (c)
|
(if (or (memq c characters-to-encode)
|
(and org-url-hexify-p (or (< c 32) (> c 126))))
|
(mapconcat (lambda (e) (format "%%%.2X" e))
|
(or (encode-coding-char c 'utf-8)
|
(error "Unable to percent escape character: %c" c))
|
"")
|
(char-to-string c)))
|
text "")))
|
|
(defun org-link-unescape (str)
|
"Unhex hexified Unicode parts in string STR.
|
E.g. `%C3%B6' becomes the german o-Umlaut. This is the
|
reciprocal of `org-link-escape', which see."
|
(if (org-string-nw-p str)
|
(replace-regexp-in-string
|
"\\(%[0-9A-Za-z]\\{2\\}\\)+" #'org-link-unescape-compound str t t)
|
str))
|
|
(defun org-link-unescape-compound (hex)
|
"Unhexify Unicode hex-chars. E.g. `%C3%B6' is the German o-Umlaut.
|
Note: this function also decodes single byte encodings like
|
`%E1' (a-acute) 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))))
|
(when (>= val 192) (setq eat (car shift-xor)))
|
(setq val (logxor val (cdr shift-xor)))
|
(setq sum (+ (lsh sum (car shift-xor)) val))
|
(when (> eat 0) (setq eat (- eat 1)))
|
(cond
|
((= 0 eat) ;multi byte
|
(setq ret (concat ret (char-to-string sum)))
|
(setq sum 0))
|
((not bytes) ; single byte(s)
|
(setq ret (org-link-unescape-single-byte-sequence hex))))))
|
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."
|
(if a (not b) b))
|
|
(defun org-fixup-message-id-for-http (s)
|
"Replace special characters in a message id, so it can be used in an http query."
|
(when (string-match "%" s)
|
(setq s (mapconcat (lambda (c)
|
(if (eq c ?%)
|
"%25"
|
(char-to-string c)))
|
s "")))
|
(while (string-match "<" s)
|
(setq s (replace-match "%3C" t t s)))
|
(while (string-match ">" s)
|
(setq s (replace-match "%3E" t t s)))
|
(while (string-match "@" s)
|
(setq s (replace-match "%40" t t s)))
|
s)
|
|
(defun org-link-prettify (link)
|
"Return a human-readable representation of LINK.
|
The car of LINK must be a raw link.
|
The cdr of LINK must be either a link description or nil."
|
(let ((desc (or (cadr link) "<no description>")))
|
(concat (format "%-45s" (substring desc 0 (min (length desc) 40)))
|
"<" (car link) ">")))
|
|
;;;###autoload
|
(defun org-insert-link-global ()
|
"Insert a link like Org mode does.
|
This command can be called in any mode to insert a link in Org syntax."
|
(interactive)
|
(org-load-modules-maybe)
|
(org-run-like-in-org-mode 'org-insert-link))
|
|
(defun org-insert-all-links (arg &optional pre post)
|
"Insert all links in `org-stored-links'.
|
When a universal prefix, do not delete the links from `org-stored-links'.
|
When `ARG' is a number, insert the last N link(s).
|
`PRE' and `POST' are optional arguments to define a string to
|
prepend or to append."
|
(interactive "P")
|
(let ((org-keep-stored-link-after-insertion (equal arg '(4)))
|
(links (copy-sequence org-stored-links))
|
(pr (or pre "- "))
|
(po (or post "\n"))
|
(cnt 1) l)
|
(if (null org-stored-links)
|
(message "No link to insert")
|
(while (and (or (listp arg) (>= arg cnt))
|
(setq l (if (listp arg)
|
(pop links)
|
(pop org-stored-links))))
|
(setq cnt (1+ cnt))
|
(insert pr)
|
(org-insert-link nil (car l) (or (cadr l) "<no description>"))
|
(insert po)))))
|
|
(defun org-insert-last-stored-link (arg)
|
"Insert the last link stored in `org-stored-links'."
|
(interactive "p")
|
(org-insert-all-links arg "" "\n"))
|
|
(defun org-link-fontify-links-to-this-file ()
|
"Fontify links to the current file in `org-stored-links'."
|
(let ((f (buffer-file-name)) a b)
|
(setq a (mapcar (lambda(l)
|
(let ((ll (car l)))
|
(when (and (string-match "^file:\\(.+\\)::" ll)
|
(equal f (expand-file-name (match-string 1 ll))))
|
ll)))
|
org-stored-links))
|
(when (featurep 'org-id)
|
(setq b (mapcar (lambda(l)
|
(let ((ll (car l)))
|
(when (and (string-match "^id:\\(.+\\)$" ll)
|
(equal f (expand-file-name
|
(or (org-id-find-id-file
|
(match-string 1 ll)) ""))))
|
ll)))
|
org-stored-links)))
|
(mapcar (lambda(l)
|
(put-text-property 0 (length l) 'face 'font-lock-comment-face l))
|
(delq nil (append a b)))))
|
|
(defvar org--links-history nil)
|
(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 in use.
|
|
The history can be used to select a link previously stored with
|
`org-store-link'. When the empty string is entered (i.e. if you just
|
press `RET' at the prompt), the link defaults to the most recently
|
stored link. As `SPC' triggers completion in the minibuffer, you need to
|
use `M-SPC' or `C-q SPC' to force the insertion of a space character.
|
|
You will also be prompted for a description, and if one is given, it will
|
be displayed in the buffer instead of the link.
|
|
If there is already a link at point, this command will allow you to edit
|
link and description parts.
|
|
With a `\\[universal-argument]' prefix, prompts for a file to link to. The \
|
file name can be
|
selected using completion. The path to the file will be relative to the
|
current directory if the file is in the current directory or a subdirectory.
|
Otherwise, the link will be the absolute path as completed in the minibuffer
|
\(i.e. normally ~/path/to/file). You can configure this behavior using the
|
option `org-link-file-path-type'.
|
|
With a `\\[universal-argument] \\[universal-argument]' prefix, enforce an \
|
absolute path even if the file is in
|
the current directory or below.
|
|
A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \
|
prefix negates `org-keep-stored-link-after-insertion'.
|
|
If the LINK-LOCATION parameter is non-nil, this value will be 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. Otherwise, if
|
`org-make-link-description-function' is non-nil, this function
|
will be called with the link target, and the result will be the
|
default link description."
|
(interactive "P")
|
(let* ((wcf (current-window-configuration))
|
(origbuf (current-buffer))
|
(region (when (org-region-active-p)
|
(buffer-substring (region-beginning) (region-end))))
|
(remove (and region (list (region-beginning) (region-end))))
|
(desc region)
|
(link link-location)
|
(abbrevs org-link-abbrev-alist-local)
|
entry all-prefixes auto-desc)
|
(cond
|
(link-location) ; specified by arg, just use it.
|
((org-in-regexp org-bracket-link-regexp 1)
|
;; We do have a link at point, and we are going to edit it.
|
(setq remove (list (match-beginning 0) (match-end 0)))
|
(setq desc (when (match-end 3) (match-string-no-properties 3)))
|
(setq link (read-string "Link: "
|
(org-link-unescape
|
(match-string-no-properties 1)))))
|
((or (org-in-regexp org-angle-link-re)
|
(org-in-regexp org-plain-link-re))
|
;; Convert to bracket link
|
(setq remove (list (match-beginning 0) (match-end 0))
|
link (read-string "Link: "
|
(org-unbracket-string "<" ">" (match-string 0)))))
|
((member complete-file '((4) (16)))
|
;; Completing read for file names.
|
(setq link (org-file-complete-link complete-file)))
|
(t
|
;; Read link, with completion for stored links.
|
(org-link-fontify-links-to-this-file)
|
(org-switch-to-buffer-other-window "*Org Links*")
|
(with-current-buffer "*Org Links*"
|
(erase-buffer)
|
(insert "Insert a link.
|
Use TAB to complete link prefixes, then RET for type-specific completion support\n")
|
(when org-stored-links
|
(insert "\nStored links are available with <up>/<down> or M-p/n (most recent with RET):\n\n")
|
(insert (mapconcat 'org-link-prettify
|
(reverse org-stored-links) "\n")))
|
(goto-char (point-min)))
|
(let ((cw (selected-window)))
|
(select-window (get-buffer-window "*Org Links*" 'visible))
|
(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 all-prefixes (append (mapcar 'car abbrevs)
|
(mapcar 'car org-link-abbrev-alist)
|
(org-link-types)))
|
(unwind-protect
|
;; Fake a link history, containing the stored links.
|
(let ((org--links-history
|
(append (mapcar #'car org-stored-links)
|
org-insert-link-history)))
|
(setq link
|
(org-completing-read
|
"Link: "
|
(append
|
(mapcar (lambda (x) (concat x ":")) all-prefixes)
|
(mapcar #'car org-stored-links))
|
nil nil nil
|
'org--links-history
|
(caar org-stored-links)))
|
(unless (org-string-nw-p link) (user-error "No link selected"))
|
(dolist (l org-stored-links)
|
(when (equal link (cadr l))
|
(setq link (car l))
|
(setq auto-desc t)))
|
(when (or (member link all-prefixes)
|
(and (equal ":" (substring link -1))
|
(member (substring link 0 -1) all-prefixes)
|
(setq link (substring link 0 -1))))
|
(setq link (with-current-buffer origbuf
|
(org-link-try-special-completion link)))))
|
(set-window-configuration wcf)
|
(kill-buffer "*Org Links*"))
|
(setq entry (assoc link org-stored-links))
|
(or entry (push link org-insert-link-history))
|
(setq desc (or desc (nth 1 entry)))))
|
|
(when (funcall (if (equal complete-file '(64)) 'not 'identity)
|
(not org-keep-stored-link-after-insertion))
|
(setq org-stored-links (delq (assoc link org-stored-links)
|
org-stored-links)))
|
|
(when (and (string-match org-plain-link-re link)
|
(not (string-match org-ts-regexp link)))
|
;; URL-like link, normalize the use of angular brackets.
|
(setq link (org-unbracket-string "<" ">" link)))
|
|
;; Check if we are linking to the current file with a search
|
;; option If yes, simplify the link by using only the search
|
;; option.
|
(when (and buffer-file-name
|
(let ((case-fold-search nil))
|
(string-match "\\`file:\\(.+?\\)::" link)))
|
(let ((path (match-string-no-properties 1 link))
|
(search (substring-no-properties link (match-end 0))))
|
(save-match-data
|
(when (equal (file-truename buffer-file-name) (file-truename path))
|
;; We are linking to this same file, with a search option
|
(setq link search)))))
|
|
;; Check if we can/should use a relative path. If yes, simplify
|
;; the link.
|
(let ((case-fold-search nil))
|
(when (string-match "\\`\\(file\\|docview\\):" link)
|
(let* ((type (match-string-no-properties 0 link))
|
(path-start (match-end 0))
|
(search (and (string-match "::\\(.*\\)\\'" link)
|
(match-string 1 link)))
|
(path
|
(if search
|
(substring-no-properties
|
link path-start (match-beginning 0))
|
(substring-no-properties link (match-end 0))))
|
(origpath path))
|
(cond
|
((or (eq org-link-file-path-type 'absolute)
|
(equal complete-file '(16)))
|
(setq path (abbreviate-file-name (expand-file-name path))))
|
((eq org-link-file-path-type 'noabbrev)
|
(setq path (expand-file-name path)))
|
((eq org-link-file-path-type 'relative)
|
(setq path (file-relative-name path)))
|
(t
|
(save-match-data
|
(if (string-match (concat "^" (regexp-quote
|
(expand-file-name
|
(file-name-as-directory
|
default-directory))))
|
(expand-file-name path))
|
;; We are linking a file with relative path name.
|
(setq path (substring (expand-file-name path)
|
(match-end 0)))
|
(setq path (abbreviate-file-name (expand-file-name path)))))))
|
(setq link (concat type path (and search (concat "::" search))))
|
(when (equal desc origpath)
|
(setq desc path)))))
|
|
(unless auto-desc
|
(let ((initial-input
|
(cond
|
(default-description)
|
((not org-make-link-description-function) desc)
|
(t (condition-case nil
|
(funcall org-make-link-description-function link desc)
|
(error
|
(message "Can't get link description from `%s'"
|
(symbol-name org-make-link-description-function))
|
(sit-for 2)
|
nil))))))
|
(setq desc (read-string "Description: " initial-input))))
|
|
(unless (string-match "\\S-" desc) (setq desc nil))
|
(when remove (apply 'delete-region remove))
|
(insert (org-make-link-string link desc))
|
;; Redisplay so as the new link has proper invisible characters.
|
(sit-for 0)))
|
|
(defun org-link-try-special-completion (type)
|
"If there is completion support for link type TYPE, offer it."
|
(let ((fun (org-link-get-parameter type :complete)))
|
(if (functionp fun)
|
(funcall fun)
|
(read-string "Link (no completion support): " (concat type ":")))))
|
|
(defun org-file-complete-link (&optional arg)
|
"Create a file link using completion."
|
(let ((file (read-file-name "File: "))
|
(pwd (file-name-as-directory (expand-file-name ".")))
|
(pwd1 (file-name-as-directory (abbreviate-file-name
|
(expand-file-name ".")))))
|
(cond ((equal arg '(16))
|
(concat "file:"
|
(abbreviate-file-name (expand-file-name file))))
|
((string-match
|
(concat "^" (regexp-quote pwd1) "\\(.+\\)") file)
|
(concat "file:" (match-string 1 file)))
|
((string-match
|
(concat "^" (regexp-quote pwd) "\\(.+\\)")
|
(expand-file-name file))
|
(concat "file:"
|
(match-string 1 (expand-file-name file))))
|
(t (concat "file:" file)))))
|
|
(defun org-completing-read (&rest args)
|
"Completing-read with SPACE being a normal character."
|
(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 #'completing-read args)))
|
|
;;; Opening/following a link
|
|
(defvar org-link-search-failed nil)
|
|
(defvar org-open-link-functions nil
|
"Hook for functions finding a plain text link.
|
These functions must take a single argument, the link content.
|
They will be called for links that look like [[link text][description]]
|
when LINK TEXT does not have a protocol like \"http:\" and does not look
|
like a filename (e.g. \"./blue.png\").
|
|
These functions will be called *before* Org attempts to resolve the
|
link by doing text searches in the current buffer - so if you want a
|
link \"[[target]]\" to still find \"<<target>>\", your function should
|
handle this as a special case.
|
|
When the function does handle the link, it must return a non-nil value.
|
If it decides that it is not responsible for this link, it must return
|
nil to indicate that that Org can continue with other options like
|
exact and fuzzy text search.")
|
|
(defun org-next-link (&optional search-backward)
|
"Move forward to the next link.
|
If the link is in hidden text, expose it."
|
(interactive "P")
|
(when (and org-link-search-failed (eq this-command last-command))
|
(goto-char (point-min))
|
(message "Link search wrapped back to beginning of buffer"))
|
(setq org-link-search-failed nil)
|
(let* ((pos (point))
|
(ct (org-context))
|
(a (assq :link ct))
|
(srch-fun (if search-backward 're-search-backward 're-search-forward)))
|
(cond (a (goto-char (nth (if search-backward 1 2) a)))
|
((looking-at org-any-link-re)
|
;; Don't stay stuck at link without an org-link face
|
(forward-char (if search-backward -1 1))))
|
(if (funcall srch-fun org-any-link-re nil t)
|
(progn
|
(goto-char (match-beginning 0))
|
(when (org-invisible-p) (org-show-context)))
|
(goto-char pos)
|
(setq org-link-search-failed t)
|
(message "No further link found"))))
|
|
(defun org-previous-link ()
|
"Move backward to the previous link.
|
If the link is in hidden text, expose it."
|
(interactive)
|
(funcall 'org-next-link t))
|
|
(defun org-translate-link (s)
|
"Translate a link string if a translation function has been defined."
|
(with-temp-buffer
|
(insert (org-trim s))
|
(org-trim (org-element-interpret-data (org-element-context)))))
|
|
(defun org-translate-link-from-planner (type path)
|
"Translate a link from Emacs Planner syntax so that Org can follow it.
|
This is still an experimental function, your mileage may vary."
|
(cond
|
((member type '("http" "https" "news" "ftp"))
|
;; standard Internet links are the same.
|
nil)
|
((and (equal type "irc") (string-match "^//" path))
|
;; Planner has two / at the beginning of an irc link, we have 1.
|
;; We should have zero, actually....
|
(setq path (substring path 1)))
|
((and (equal type "lisp") (string-match "^/" path))
|
;; Planner has a slash, we do not.
|
(setq type "elisp" path (substring path 1)))
|
((string-match "^//\\(.?*\\)/\\(<.*>\\)$" path)
|
;; A typical message link. Planner has the id after the final slash,
|
;; we separate it with a hash mark
|
(setq path (concat (match-string 1 path) "#"
|
(org-unbracket-string "<" ">" (match-string 2 path))))))
|
(cons type path))
|
|
(defun org-find-file-at-mouse (ev)
|
"Open file link or URL at mouse."
|
(interactive "e")
|
(mouse-set-point ev)
|
(org-open-at-point 'in-emacs))
|
|
(defun org-open-at-mouse (ev)
|
"Open file link or URL at mouse.
|
See the docstring of `org-open-file' for details."
|
(interactive "e")
|
(mouse-set-point ev)
|
(when (eq major-mode 'org-agenda-mode)
|
(org-agenda-copy-local-variable 'org-link-abbrev-alist-local))
|
(org-open-at-point))
|
|
(defvar org-window-config-before-follow-link nil
|
"The window configuration before following a link.
|
This is saved in case the need arises to restore it.")
|
|
;;;###autoload
|
(defun org-open-at-point-global ()
|
"Follow a link or time-stamp like Org mode does.
|
This command can be called in any mode to follow an external link
|
or a time-stamp that has Org mode syntax. Its behavior is
|
undefined when called on internal links (e.g., fuzzy links).
|
Raise an error when there is nothing to follow. "
|
(interactive)
|
(cond ((org-in-regexp org-any-link-re)
|
(org-open-link-from-string (match-string-no-properties 0)))
|
((or (org-in-regexp org-ts-regexp-both nil t)
|
(org-in-regexp org-tsr-regexp-both nil t))
|
(org-follow-timestamp-link))
|
(t (user-error "No link found"))))
|
|
;;;###autoload
|
(defun org-open-link-from-string (s &optional arg reference-buffer)
|
"Open a link in the string S, as if it was in Org mode."
|
(interactive "sLink: \nP")
|
(let ((reference-buffer (or reference-buffer (current-buffer))))
|
(with-temp-buffer
|
(let ((org-inhibit-startup (not reference-buffer)))
|
(org-mode)
|
(insert s)
|
(goto-char (point-min))
|
(when reference-buffer
|
(setq org-link-abbrev-alist-local
|
(with-current-buffer reference-buffer
|
org-link-abbrev-alist-local)))
|
(org-open-at-point arg reference-buffer)))))
|
|
(defvar org-open-at-point-functions nil
|
"Hook that is run when following a link at point.
|
|
Functions in this hook must return t if they identify and follow
|
a link at point. If they don't find anything interesting at point,
|
they must return nil.")
|
|
(defvar org-link-search-inhibit-query nil)
|
(defvar clean-buffer-list-kill-buffer-names) ;Defined in midnight.el
|
(defun org--open-doi-link (path)
|
"Open a \"doi\" type link.
|
PATH is a the path to search for, as a string."
|
(browse-url (url-encode-url (concat org-doi-server-url path))))
|
|
(defun org--open-elisp-link (path)
|
"Open a \"elisp\" type link.
|
PATH is the sexp to evaluate, as a string."
|
(let ((cmd path))
|
(if (or (and (org-string-nw-p
|
org-confirm-elisp-link-not-regexp)
|
(string-match-p 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 'face 'org-warning))))
|
(message "%s => %s" cmd
|
(if (eq (string-to-char cmd) ?\()
|
(eval (read cmd))
|
(call-interactively (read cmd))))
|
(user-error "Abort"))))
|
|
(defun org--open-help-link (path)
|
"Open a \"help\" type link.
|
PATH is a symbol name, as a string."
|
(pcase (intern path)
|
((and (pred fboundp) variable) (describe-function variable))
|
((and (pred boundp) function) (describe-variable function))
|
(name (user-error "Unknown function or variable: %s" name))))
|
|
(defun org--open-shell-link (path)
|
"Open a \"shell\" type link.
|
PATH is the command to execute, as a string."
|
(let ((buf (generate-new-buffer "*Org Shell Output*"))
|
(cmd path))
|
(if (or (and (org-string-nw-p
|
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
|
'face 'org-warning))))
|
(progn
|
(message "Executing %s" cmd)
|
(shell-command cmd buf)
|
(when (featurep 'midnight)
|
(setq clean-buffer-list-kill-buffer-names
|
(cons (buffer-name buf)
|
clean-buffer-list-kill-buffer-names))))
|
(user-error "Abort"))))
|
|
(defun org-open-at-point (&optional arg reference-buffer)
|
"Open link, timestamp, footnote or tags at point.
|
|
When point is on a link, follow it. Normally, files will be
|
opened by an appropriate application. If the 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.
|
|
When point is on a timestamp, open the agenda at the day
|
specified.
|
|
When point is a footnote definition, move to the first reference
|
found. If it is on a reference, move to the associated
|
definition.
|
|
When point is on a headline, display a list of every link in the
|
entry, so it is possible to pick one, or all, of them. If point
|
is on a tag, call `org-tags-view' instead.
|
|
When optional argument REFERENCE-BUFFER is non-nil, it should
|
specify a buffer from where the link search should happen. This
|
is used internally by `org-open-link-from-string'.
|
|
On top of syntactically correct links, this function will also
|
try to open links and time-stamps in comments, example
|
blocks... i.e., whenever point is on something looking like
|
a timestamp or a link."
|
(interactive "P")
|
;; On a code block, open block's results.
|
(unless (call-interactively 'org-babel-open-src-block-result)
|
(org-load-modules-maybe)
|
(setq org-window-config-before-follow-link (current-window-configuration))
|
(org-remove-occur-highlights nil nil t)
|
(unless (run-hook-with-args-until-success 'org-open-at-point-functions)
|
(let* ((context
|
;; Only consider supported types, even if they are not
|
;; the closest one.
|
(org-element-lineage
|
(org-element-context)
|
'(clock footnote-definition footnote-reference headline
|
inlinetask link timestamp)
|
t))
|
(type (org-element-type context))
|
(value (org-element-property :value context)))
|
(cond
|
;; On a headline or an inlinetask, but not on a timestamp,
|
;; a link, a footnote reference.
|
((memq type '(headline inlinetask))
|
(org-match-line org-complex-heading-regexp)
|
(if (and (match-beginning 5)
|
(>= (point) (match-beginning 5))
|
(< (point) (match-end 5)))
|
;; On tags.
|
(org-tags-view arg (substring (match-string 5) 0 -1))
|
;; Not on tags.
|
(pcase (org-offer-links-in-entry (current-buffer) (point) arg)
|
(`(nil . ,_)
|
(require 'org-attach)
|
(org-attach-reveal 'if-exists))
|
(`(,links . ,links-end)
|
(dolist (link (if (stringp links) (list links) links))
|
(search-forward link nil links-end)
|
(goto-char (match-beginning 0))
|
(org-open-at-point))))))
|
;; On a footnote reference or at definition's label.
|
((or (eq type 'footnote-reference)
|
(and (eq type 'footnote-definition)
|
(save-excursion
|
;; Do not validate action when point is on the
|
;; spaces right after the footnote label, in
|
;; order to be on par with behavior on links.
|
(skip-chars-forward " \t")
|
(let ((begin
|
(org-element-property :contents-begin context)))
|
(if begin (< (point) begin)
|
(= (org-element-property :post-affiliated context)
|
(line-beginning-position)))))))
|
(org-footnote-action))
|
;; No valid context. Ignore catch-all types like `headline'.
|
;; If point is on something looking like a link or
|
;; a time-stamp, try opening it. It may be useful in
|
;; comments, example blocks...
|
((memq type '(footnote-definition headline inlinetask nil))
|
(call-interactively #'org-open-at-point-global))
|
;; On a clock line, make sure point is on the timestamp
|
;; before opening it.
|
((and (eq type 'clock)
|
value
|
(>= (point) (org-element-property :begin value))
|
(<= (point) (org-element-property :end value)))
|
(org-follow-timestamp-link))
|
;; Do nothing on white spaces after an object.
|
((>= (point)
|
(save-excursion
|
(goto-char (org-element-property :end context))
|
(skip-chars-backward " \t")
|
(point)))
|
(user-error "No link found"))
|
((eq type 'timestamp) (org-follow-timestamp-link))
|
((eq type 'link)
|
(let ((type (org-element-property :type context))
|
(path (org-link-unescape (org-element-property :path context))))
|
;; Switch back to REFERENCE-BUFFER needed when called in
|
;; a temporary buffer through `org-open-link-from-string'.
|
(with-current-buffer (or reference-buffer (current-buffer))
|
(cond
|
((equal type "file")
|
(if (string-match "[*?{]" (file-name-nondirectory path))
|
(dired path)
|
;; Look into `org-link-parameters' in order to find
|
;; a DEDICATED-FUNCTION to open file. The function
|
;; will be applied on raw link instead of parsed
|
;; link due to the limitation in `org-add-link-type'
|
;; ("open" function called with a single argument).
|
;; If no such function is found, fallback to
|
;; `org-open-file'.
|
(let* ((option (org-element-property :search-option context))
|
(app (org-element-property :application context))
|
(dedicated-function
|
(org-link-get-parameter
|
(if app (concat type "+" app) type)
|
:follow)))
|
(if dedicated-function
|
(funcall dedicated-function
|
(concat path
|
(and option (concat "::" option))))
|
(apply #'org-open-file
|
path
|
(cond (arg)
|
((equal app "emacs") 'emacs)
|
((equal app "sys") 'system))
|
(cond ((not option) nil)
|
((string-match-p "\\`[0-9]+\\'" option)
|
(list (string-to-number option)))
|
(t (list nil
|
(org-link-unescape option)))))))))
|
((functionp (org-link-get-parameter type :follow))
|
(funcall (org-link-get-parameter type :follow) path))
|
((member type '("coderef" "custom-id" "fuzzy" "radio"))
|
(unless (run-hook-with-args-until-success
|
'org-open-link-functions path)
|
(if (not arg) (org-mark-ring-push)
|
(switch-to-buffer-other-window
|
(org-get-buffer-for-internal-link (current-buffer))))
|
(let ((destination
|
(org-with-wide-buffer
|
(if (equal type "radio")
|
(org-search-radio-target
|
(org-element-property :path context))
|
(org-link-search
|
(if (member type '("custom-id" "coderef"))
|
(org-element-property :raw-link context)
|
path)
|
;; Prevent fuzzy links from matching
|
;; themselves.
|
(and (equal type "fuzzy")
|
(+ 2 (org-element-property :begin context)))))
|
(point))))
|
(unless (and (<= (point-min) destination)
|
(>= (point-max) destination))
|
(widen))
|
(goto-char destination))))
|
(t (browse-url-at-point))))))
|
(t (user-error "No link found")))))
|
(run-hook-with-args 'org-follow-link-hook)))
|
|
(defun org-offer-links-in-entry (buffer marker &optional nth zero)
|
"Offer links in the current entry and return the selected link.
|
If there is only one link, return it.
|
If NTH is an integer, return the NTH link found.
|
If ZERO is a string, check also this string for a link, and if
|
there is one, return it."
|
(with-current-buffer buffer
|
(org-with-wide-buffer
|
(goto-char marker)
|
(let ((cnt ?0)
|
have-zero end links link c)
|
(when (and (stringp zero) (string-match org-bracket-link-regexp zero))
|
(push (match-string 0 zero) links)
|
(setq cnt (1- cnt) have-zero t))
|
(save-excursion
|
(org-back-to-heading t)
|
(setq end (save-excursion (outline-next-heading) (point)))
|
(while (re-search-forward org-any-link-re end t)
|
(push (match-string 0) links))
|
(setq links (org-uniquify (reverse links))))
|
(cond
|
((null links)
|
(message "No links"))
|
((equal (length links) 1)
|
(setq link (car links)))
|
((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth)))
|
(setq link (nth (if have-zero nth (1- nth)) links)))
|
(t ; we have to select a link
|
(save-excursion
|
(save-window-excursion
|
(delete-other-windows)
|
(with-output-to-temp-buffer "*Select Link*"
|
(dolist (l links)
|
(cond
|
((not (string-match org-bracket-link-regexp l))
|
(princ (format "[%c] %s\n" (cl-incf cnt)
|
(org-unbracket-string "<" ">" l))))
|
((match-end 3)
|
(princ (format "[%c] %s (%s)\n" (cl-incf cnt)
|
(match-string 3 l) (match-string 1 l))))
|
(t (princ (format "[%c] %s\n" (cl-incf cnt)
|
(match-string 1 l)))))))
|
(org-fit-window-to-buffer (get-buffer-window "*Select Link*"))
|
(message "Select link to open, RET to open all:")
|
(setq c (read-char-exclusive))
|
(and (get-buffer "*Select Link*") (kill-buffer "*Select Link*"))))
|
(when (equal c ?q) (user-error "Abort"))
|
(if (equal c ?\C-m)
|
(setq link links)
|
(setq nth (- c ?0))
|
(when have-zero (setq nth (1+ nth)))
|
(unless (and (integerp nth) (>= (length links) nth))
|
(user-error "Invalid link selection"))
|
(setq link (nth (1- nth) links)))))
|
(cons link end)))))
|
|
;; TODO: These functions are deprecated since `org-open-at-point'
|
;; hard-codes behavior for "file+emacs" and "file+sys" types.
|
(defun org-open-file-with-system (path)
|
"Open file at PATH using the system way of opening it."
|
(org-open-file path 'system))
|
(defun org-open-file-with-emacs (path)
|
"Open file at PATH in Emacs."
|
(org-open-file path 'emacs))
|
|
|
;;; File search
|
|
(defvar org-create-file-search-functions nil
|
"List of functions to construct the right search string for a file link.
|
These functions are called in turn with point at the location to
|
which the link should point.
|
|
A function in the hook should first test if it would like to
|
handle this file type, for example by checking the `major-mode'
|
or the file extension. If it decides not to handle this file, it
|
should just return nil to give other functions a chance. If it
|
does handle the file, it must return the search string to be used
|
when following the link. The search string will be part of the
|
file link, given after a double colon, and `org-open-at-point'
|
will automatically search for it. If special measures must be
|
taken to make the search successful, another function should be
|
added to the companion hook `org-execute-file-search-functions',
|
which see.
|
|
A function in this hook may also use `setq' to set the variable
|
`description' to provide a suggestion for the descriptive text to
|
be used for this link when it gets inserted into an Org buffer
|
with \\[org-insert-link].")
|
|
(defvar org-execute-file-search-functions nil
|
"List of functions to execute a file search triggered by a link.
|
|
Functions added to this hook must accept a single argument, the
|
search string that was part of the file link, the part after the
|
double colon. The function must first check if it would like to
|
handle this search, for example by checking the `major-mode' or
|
the file extension. If it decides not to handle this search, it
|
should just return nil to give other functions a chance. If it
|
does handle the search, it must return a non-nil value to keep
|
other functions from trying.
|
|
Each function can access the current prefix argument through the
|
variable `current-prefix-arg'. Note that a single prefix is used
|
to force opening a link in Emacs, so it may be good to only use a
|
numeric or double prefix to guide the search function.
|
|
In case this is needed, a function in this hook can also restore
|
the window configuration before `org-open-at-point' was called using:
|
|
(set-window-configuration org-window-config-before-follow-link)")
|
|
(defun org-search-radio-target (target)
|
"Search a radio target matching TARGET in current buffer.
|
White spaces are not significant."
|
(let ((re (format "<<<%s>>>"
|
(mapconcat #'regexp-quote
|
(split-string target)
|
"[ \t]+\\(?:\n[ \t]*\\)?")))
|
(origin (point)))
|
(goto-char (point-min))
|
(catch :radio-match
|
(while (re-search-forward re nil t)
|
(backward-char)
|
(let ((object (org-element-context)))
|
(when (eq (org-element-type object) 'radio-target)
|
(goto-char (org-element-property :begin object))
|
(org-show-context 'link-search)
|
(throw :radio-match nil))))
|
(goto-char origin)
|
(user-error "No match for radio target: %s" target))))
|
|
(defun org-link-search (s &optional avoid-pos stealth)
|
"Search for a search string S.
|
|
If S starts with \"#\", it triggers a custom ID search.
|
|
If S is enclosed within parenthesis, it initiates a coderef
|
search.
|
|
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.
|
|
When 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-context-detail'
|
variable.
|
|
Search is case-insensitive and ignores white spaces. Return type
|
of matched result, which is either `dedicated' or `fuzzy'."
|
(unless (org-string-nw-p s) (error "Invalid search string \"%s\"" s))
|
(let* ((case-fold-search t)
|
(origin (point))
|
(normalized (replace-regexp-in-string "\n[ \t]*" " " s))
|
(starred (eq (string-to-char normalized) ?*))
|
(words (split-string (if starred (substring s 1) s)))
|
(s-multi-re (mapconcat #'regexp-quote words "\\(?:[ \t\n]+\\)"))
|
(s-single-re (mapconcat #'regexp-quote words "[ \t]+"))
|
type)
|
(cond
|
;; Check if there are any special search functions.
|
((run-hook-with-args-until-success 'org-execute-file-search-functions s))
|
((eq (string-to-char s) ?#)
|
;; Look for a custom ID S if S starts with "#".
|
(let* ((id (substring normalized 1))
|
(match (org-find-property "CUSTOM_ID" id)))
|
(if match (progn (goto-char match) (setf type 'dedicated))
|
(error "No match for custom ID: %s" id))))
|
((string-match "\\`(\\(.*\\))\\'" normalized)
|
;; Look for coderef targets if S is enclosed within parenthesis.
|
(let ((coderef (match-string-no-properties 1 normalized))
|
(re (substring s-single-re 1 -1)))
|
(goto-char (point-min))
|
(catch :coderef-match
|
(while (re-search-forward re nil t)
|
(let ((element (org-element-at-point)))
|
(when (and (memq (org-element-type element)
|
'(example-block src-block))
|
;; Build proper regexp according to current
|
;; block's label format.
|
(let ((label-fmt
|
(regexp-quote
|
(or (org-element-property :label-fmt element)
|
org-coderef-label-format))))
|
(save-excursion
|
(beginning-of-line)
|
(looking-at (format ".*?\\(%s\\)[ \t]*$"
|
(format label-fmt coderef))))))
|
(setq type 'dedicated)
|
(goto-char (match-beginning 1))
|
(throw :coderef-match nil))))
|
(goto-char origin)
|
(error "No match for coderef: %s" coderef))))
|
((string-match "\\`/\\(.*\\)/\\'" normalized)
|
;; Look for a regular expression.
|
(funcall (if (derived-mode-p 'org-mode) #'org-occur #'org-do-occur)
|
(match-string 1 s)))
|
;; From here, we handle fuzzy links.
|
;;
|
;; Look for targets, only if not in a headline search.
|
((and (not starred)
|
(let ((target (format "<<%s>>" s-multi-re)))
|
(catch :target-match
|
(goto-char (point-min))
|
(while (re-search-forward target nil t)
|
(backward-char)
|
(let ((context (org-element-context)))
|
(when (eq (org-element-type context) 'target)
|
(setq type 'dedicated)
|
(goto-char (org-element-property :begin context))
|
(throw :target-match t))))
|
nil))))
|
;; Look for elements named after S, only if not in a headline
|
;; search.
|
((and (not starred)
|
(let ((name (format "^[ \t]*#\\+NAME: +%s[ \t]*$" s-single-re)))
|
(catch :name-match
|
(goto-char (point-min))
|
(while (re-search-forward name nil t)
|
(let ((element (org-element-at-point)))
|
(when (equal words
|
(split-string
|
(org-element-property :name element)))
|
(setq type 'dedicated)
|
(beginning-of-line)
|
(throw :name-match t))))
|
nil))))
|
;; Regular text search. Prefer headlines in Org mode buffers.
|
;; Ignore COMMENT keyword, TODO keywords, priority cookies,
|
;; statistics cookies and tags.
|
((and (derived-mode-p 'org-mode)
|
(let ((title-re
|
(format "%s.*\\(?:%s[ \t]\\)?.*%s"
|
org-outline-regexp-bol
|
org-comment-string
|
(mapconcat #'regexp-quote words ".+")))
|
(cookie-re "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]")
|
(comment-re (eval-when-compile
|
(format "\\`%s[ \t]+" org-comment-string))))
|
(goto-char (point-min))
|
(catch :found
|
(while (re-search-forward title-re nil t)
|
(when (equal words
|
(split-string
|
(replace-regexp-in-string
|
cookie-re ""
|
(replace-regexp-in-string
|
comment-re "" (org-get-heading t t t)))))
|
(throw :found t)))
|
nil)))
|
(beginning-of-line)
|
(setq type 'dedicated))
|
;; Offer to create non-existent headline depending on
|
;; `org-link-search-must-match-exact-headline'.
|
((and (derived-mode-p 'org-mode)
|
(not org-link-search-inhibit-query)
|
(eq org-link-search-must-match-exact-headline 'query-to-create)
|
(yes-or-no-p "No match - create this as a new heading? "))
|
(goto-char (point-max))
|
(unless (bolp) (newline))
|
(org-insert-heading nil t t)
|
(insert s "\n")
|
(beginning-of-line 0))
|
;; Only headlines are looked after. No need to process
|
;; further: throw an error.
|
((and (derived-mode-p 'org-mode)
|
(or starred org-link-search-must-match-exact-headline))
|
(goto-char origin)
|
(error "No match for fuzzy expression: %s" normalized))
|
;; Regular text search.
|
((catch :fuzzy-match
|
(goto-char (point-min))
|
(while (re-search-forward s-multi-re nil t)
|
;; Skip match if it contains AVOID-POS or it is included in
|
;; a link with a description but outside the description.
|
(unless (or (and avoid-pos
|
(<= (match-beginning 0) avoid-pos)
|
(> (match-end 0) avoid-pos))
|
(and (save-match-data
|
(org-in-regexp org-bracket-link-regexp))
|
(match-beginning 3)
|
(or (> (match-beginning 3) (point))
|
(<= (match-end 3) (point)))
|
(org-element-lineage
|
(save-match-data (org-element-context))
|
'(link) t)))
|
(goto-char (match-beginning 0))
|
(setq type 'fuzzy)
|
(throw :fuzzy-match t)))
|
nil))
|
;; All failed. Throw an error.
|
(t (goto-char origin)
|
(error "No match for fuzzy expression: %s" normalized)))
|
;; Disclose surroundings of match, if appropriate.
|
(when (and (derived-mode-p 'org-mode) (not stealth))
|
(org-show-context 'link-search))
|
type))
|
|
(defun org-get-buffer-for-internal-link (buffer)
|
"Return a buffer to be used for displaying the link target of internal links."
|
(cond
|
((not org-display-internal-link-with-indirect-buffer)
|
buffer)
|
((string-suffix-p "(Clone)" (buffer-name buffer))
|
(message "Buffer is already a clone, not making another one")
|
;; we also do not modify visibility in this case
|
buffer)
|
(t ; make a new indirect buffer for displaying the link
|
(let* ((bn (buffer-name buffer))
|
(ibn (concat bn "(Clone)"))
|
(ib (or (get-buffer ibn) (make-indirect-buffer buffer ibn 'clone))))
|
(with-current-buffer ib (org-overview))
|
ib))))
|
|
(defun org-do-occur (regexp &optional cleanup)
|
"Call the Emacs command `occur'.
|
If CLEANUP is non-nil, remove the printout of the regular expression
|
in the *Occur* buffer. This is useful if the regex is long and not useful
|
to read."
|
(occur regexp)
|
(when cleanup
|
(let ((cwin (selected-window)) win beg end)
|
(when (setq win (get-buffer-window "*Occur*"))
|
(select-window win))
|
(goto-char (point-min))
|
(when (re-search-forward "match[a-z]+" nil t)
|
(setq beg (match-end 0))
|
(when (re-search-forward "^[ \t]*[0-9]+" nil t)
|
(setq end (1- (match-beginning 0)))))
|
(and beg end (let ((inhibit-read-only t)) (delete-region beg end)))
|
(goto-char (point-min))
|
(select-window cwin))))
|
|
;;; The mark ring for links jumps
|
|
(defvar org-mark-ring nil
|
"Mark ring for positions before jumps in Org mode.")
|
(defvar org-mark-ring-last-goto nil
|
"Last position in the mark ring used to go back.")
|
;; Fill and close the ring
|
(setq org-mark-ring nil org-mark-ring-last-goto nil) ;; in case file is reloaded
|
(dotimes (_ org-mark-ring-length)
|
(push (make-marker) org-mark-ring))
|
(setcdr (nthcdr (1- org-mark-ring-length) org-mark-ring)
|
org-mark-ring)
|
|
(defun org-mark-ring-push (&optional pos buffer)
|
"Put the current position or POS into the mark ring and rotate it."
|
(interactive)
|
(setq pos (or pos (point)))
|
(setq org-mark-ring (nthcdr (1- org-mark-ring-length) org-mark-ring))
|
(move-marker (car org-mark-ring)
|
(or pos (point))
|
(or buffer (current-buffer)))
|
(message "%s"
|
(substitute-command-keys
|
"Position saved to mark ring, go back with \
|
`\\[org-mark-ring-goto]'.")))
|
|
(defun org-mark-ring-goto (&optional n)
|
"Jump to the previous position in the mark ring.
|
With prefix arg N, jump back that many stored positions. When
|
called several times in succession, walk through the entire ring.
|
Org mode commands jumping to a different position in the current file,
|
or to another Org file, automatically push the old position onto the ring."
|
(interactive "p")
|
(let (p m)
|
(if (eq last-command this-command)
|
(setq p (nthcdr n (or org-mark-ring-last-goto org-mark-ring)))
|
(setq p org-mark-ring))
|
(setq org-mark-ring-last-goto p)
|
(setq m (car p))
|
(pop-to-buffer-same-window (marker-buffer m))
|
(goto-char m)
|
(when (or (org-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto))))
|
|
(defun org-add-angle-brackets (s)
|
(unless (equal (substring s 0 1) "<") (setq s (concat "<" s)))
|
(unless (equal (substring s -1) ">") (setq s (concat s ">")))
|
s)
|
|
;;; Following specific links
|
|
(defvar org-agenda-buffer-tmp-name)
|
(defvar org-agenda-start-on-weekday)
|
(defun org-follow-timestamp-link ()
|
"Open an agenda view for the time-stamp date/range at point."
|
(cond
|
((org-at-date-range-p t)
|
(let ((org-agenda-start-on-weekday)
|
(t1 (match-string 1))
|
(t2 (match-string 2)) tt1 tt2)
|
(setq tt1 (time-to-days (org-time-string-to-time t1))
|
tt2 (time-to-days (org-time-string-to-time t2)))
|
(let ((org-agenda-buffer-tmp-name
|
(format "*Org Agenda(a:%s)"
|
(concat (substring t1 0 10) "--" (substring t2 0 10)))))
|
(org-agenda-list nil tt1 (1+ (- tt2 tt1))))))
|
((org-at-timestamp-p 'lax)
|
(let ((org-agenda-buffer-tmp-name
|
(format "*Org Agenda(a:%s)" (substring (match-string 1) 0 10))))
|
(org-agenda-list nil (time-to-days (org-time-string-to-time
|
(substring (match-string 1) 0 10)))
|
1)))
|
(t (error "This should not happen"))))
|
|
|
;;; 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.
|
First, this expands any special file name abbreviations. Then the
|
configuration variable `org-file-apps' is checked if it contains an
|
entry for this file type, and if yes, the corresponding command is launched.
|
|
If no application is found, Emacs simply visits the file.
|
|
With optional prefix argument IN-EMACS, Emacs will visit the file.
|
With a double \\[universal-argument] \\[universal-argument] \
|
prefix arg, Org tries to avoid opening in Emacs
|
and to use an external application to visit the file.
|
|
Optional LINE specifies a line to go to, optional SEARCH a string
|
to search for. If LINE or SEARCH is given, the file will 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
|
(substitute-in-file-name (expand-file-name path))))
|
(file-apps (append org-file-apps (org-default-apps)))
|
(apps (cl-remove-if
|
'org-file-apps-entry-match-against-dlink-p file-apps))
|
(apps-dlink (cl-remove-if-not
|
'org-file-apps-entry-match-against-dlink-p file-apps))
|
(remp (and (assq 'remote apps) (org-file-remote-p file)))
|
(dirp (unless remp (file-directory-p file)))
|
(file (if (and dirp org-open-directory-means-index-dot-org)
|
(concat (file-name-as-directory file) "index.org")
|
file))
|
(a-m-a-p (assq 'auto-mode apps))
|
(dfile (downcase file))
|
;; Reconstruct the original link from the PATH, LINE and
|
;; SEARCH args.
|
(link (cond (line (concat file "::" (number-to-string line)))
|
(search (concat file "::" search))
|
(t file)))
|
(dlink (downcase link))
|
(ext
|
(and (string-match "\\`.*?\\.\\([a-zA-Z0-9]+\\(\\.gz\\)?\\)\\'" dfile)
|
(match-string 1 dfile)))
|
(save-position-maybe
|
(let ((old-buffer (current-buffer))
|
(old-pos (point))
|
(old-mode major-mode))
|
(lambda ()
|
(and (derived-mode-p 'org-mode)
|
(eq old-mode 'org-mode)
|
(or (not (eq old-buffer (current-buffer)))
|
(not (eq old-pos (point))))
|
(org-mark-ring-push old-pos old-buffer)))))
|
cmd link-match-data)
|
(cond
|
((member in-emacs '((16) system))
|
(setq cmd (cdr (assq 'system apps))))
|
(in-emacs (setq cmd 'emacs))
|
(t
|
(setq cmd (or (and remp (cdr (assq 'remote apps)))
|
(and dirp (cdr (assq 'directory apps)))
|
;; First, try matching against apps-dlink if we
|
;; get a match here, store the match data for
|
;; later.
|
(let ((match (assoc-default dlink apps-dlink
|
'string-match)))
|
(if match
|
(progn (setq link-match-data (match-data))
|
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)
|
(assoc-default dfile (org-apps-regexp-alist apps a-m-a-p)
|
'string-match)
|
(cdr (assoc ext apps))
|
(cdr (assq t apps))))))
|
(when (eq cmd 'system)
|
(setq cmd (cdr (assq 'system apps))))
|
(when (eq cmd 'default)
|
(setq cmd (cdr (assoc t apps))))
|
(when (eq cmd 'mailcap)
|
(require 'mailcap)
|
(mailcap-parse-mailcaps)
|
(let* ((mime-type (mailcap-extension-to-mime (or ext "")))
|
(command (mailcap-mime-info mime-type)))
|
(if (stringp command)
|
(setq cmd command)
|
(setq cmd 'emacs))))
|
(when (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files
|
(not (file-exists-p file))
|
(not org-open-non-existing-files))
|
(user-error "No such file: %s" file))
|
(cond
|
((and (stringp cmd) (not (string-match "^\\s-*$" cmd)))
|
;; Remove quotes around the file name - we'll use shell-quote-argument.
|
(while (string-match "['\"]%s['\"]" cmd)
|
(setq cmd (replace-match "%s" t t cmd)))
|
(setq cmd (replace-regexp-in-string
|
"%s"
|
(shell-quote-argument (convert-standard-filename file))
|
cmd
|
nil t))
|
|
;; Replace "%1", "%2" etc. in command with group matches from regex
|
(save-match-data
|
(let ((match-index 1)
|
(number-of-groups (- (/ (length link-match-data) 2) 1)))
|
(set-match-data link-match-data)
|
(while (<= match-index number-of-groups)
|
(let ((regex (concat "%" (number-to-string match-index)))
|
(replace-with (match-string match-index dlink)))
|
(while (string-match regex cmd)
|
(setq cmd (replace-match replace-with t t cmd))))
|
(setq match-index (+ match-index 1)))))
|
|
(save-window-excursion
|
(message "Running %s...done" cmd)
|
(start-process-shell-command cmd nil cmd)
|
(and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))))
|
((or (stringp cmd)
|
(eq cmd 'emacs))
|
(funcall (cdr (assq 'file org-link-frame-setup)) file)
|
(widen)
|
(cond (line (org-goto-line line)
|
(when (derived-mode-p 'org-mode) (org-reveal)))
|
(search (condition-case err
|
(org-link-search search)
|
;; Save position before error-ing out so user
|
;; can easily move back to the original buffer.
|
(error (funcall save-position-maybe)
|
(error (nth 1 err)))))))
|
((functionp cmd)
|
(save-match-data
|
(set-match-data link-match-data)
|
(condition-case nil
|
(funcall cmd file link)
|
;; FIXME: Remove this check when most default installations
|
;; of Emacs have at least Org 9.0.
|
((debug wrong-number-of-arguments wrong-type-argument
|
invalid-function)
|
(user-error "Please see Org News for version 9.0 about \
|
`org-file-apps'--Lisp error: %S" cmd)))))
|
((consp cmd)
|
;; FIXME: Remove this check when most default installations of
|
;; Emacs have at least Org 9.0. Heads-up instead of silently
|
;; fall back to `org-link-frame-setup' for an old usage of
|
;; `org-file-apps' with sexp instead of a function for `cmd'.
|
(user-error "Please see Org News for version 9.0 about \
|
`org-file-apps'--Error: Deprecated usage of %S" cmd))
|
(t (funcall (cdr (assq 'file org-link-frame-setup)) file)))
|
(funcall save-position-maybe)))
|
|
(defun org-file-apps-entry-match-against-dlink-p (entry)
|
"This function returns non-nil if `entry' uses a regular
|
expression which should be matched against the whole link by
|
org-open-file.
|
|
It assumes that is the case when the entry uses a regular
|
expression which has at least one grouping construct and the
|
action is either a lisp form or a command string containing
|
`%1', i.e. using at least one subexpression match as a
|
parameter."
|
(let ((selector (car entry))
|
(action (cdr entry)))
|
(if (stringp selector)
|
(and (> (regexp-opt-depth selector) 0)
|
(or (and (stringp action)
|
(string-match "%[0-9]" action))
|
(consp action)))
|
nil)))
|
|
(defun org-default-apps ()
|
"Return the default applications for this operating system."
|
(cond
|
((eq system-type 'darwin)
|
org-file-apps-defaults-macosx)
|
((eq system-type 'windows-nt)
|
org-file-apps-defaults-windowsnt)
|
(t org-file-apps-defaults-gnu)))
|
|
(defun org-apps-regexp-alist (list &optional add-auto-mode)
|
"Convert extensions to regular expressions in the cars of LIST.
|
Also, weed out any non-string entries, because the return value is used
|
only for regexp matching.
|
When ADD-AUTO-MODE is set, make all matches in `auto-mode-alist'
|
point to the symbol `emacs', indicating that the file should
|
be opened in Emacs."
|
(append
|
(delq nil
|
(mapcar (lambda (x)
|
(unless (not (stringp (car x)))
|
(if (string-match "\\W" (car x))
|
x
|
(cons (concat "\\." (car x) "\\'") (cdr x)))))
|
list))
|
(when add-auto-mode
|
(mapcar (lambda (x) (cons (car x) 'emacs)) auto-mode-alist))))
|
|
(defvar ange-ftp-name-format)
|
(defun org-file-remote-p (file)
|
"Test whether FILE specifies a location on a remote system.
|
Return non-nil if the location is indeed remote.
|
|
For example, the filename \"/user@host:/foo\" specifies a location
|
on the system \"/user@host:\"."
|
(cond ((fboundp 'file-remote-p)
|
(file-remote-p file))
|
((fboundp 'tramp-handle-file-remote-p)
|
(tramp-handle-file-remote-p file))
|
((and (boundp 'ange-ftp-name-format)
|
(string-match (car ange-ftp-name-format) file))
|
t)))
|
|
|
;;;; Refiling
|
|
(defun org-get-org-file ()
|
"Read a filename, with default directory `org-directory'."
|
(let ((default (or org-default-notes-file remember-data-file)))
|
(read-file-name (format "File name [%s]: " default)
|
(file-name-as-directory org-directory)
|
default)))
|
|
(defun org-notes-order-reversed-p ()
|
"Check if the current file should receive notes in reversed order."
|
(cond
|
((not org-reverse-note-order) nil)
|
((eq t org-reverse-note-order) t)
|
((not (listp org-reverse-note-order)) nil)
|
(t (catch 'exit
|
(dolist (entry org-reverse-note-order)
|
(when (string-match (car entry) buffer-file-name)
|
(throw 'exit (cdr entry))))))))
|
|
(defvar org-refile-target-table nil
|
"The list of refile targets, created by `org-refile'.")
|
|
(defvar org-agenda-new-buffers nil
|
"Buffers created to visit agenda files.")
|
|
(defvar org-refile-cache nil
|
"Cache for refile targets.")
|
|
(defvar org-refile-markers nil
|
"All the markers used for caching refile locations.")
|
|
(defun org-refile-marker (pos)
|
"Get a new refile marker, but only if caching is in use."
|
(if (not org-refile-use-cache)
|
pos
|
(let ((m (make-marker)))
|
(move-marker m pos)
|
(push m org-refile-markers)
|
m)))
|
|
(defun org-refile-cache-clear ()
|
"Clear the refile cache and disable all the markers."
|
(dolist (m org-refile-markers) (move-marker m nil))
|
(setq org-refile-markers nil)
|
(setq org-refile-cache nil)
|
(message "Refile cache has been cleared"))
|
|
(defun org-refile-cache-check-set (set)
|
"Check if all the markers in the cache still have live buffers."
|
(let (marker)
|
(catch 'exit
|
(while (and set (setq marker (nth 3 (pop set))))
|
;; If `org-refile-use-outline-path' is 'file, marker may be nil
|
(when (and marker (null (marker-buffer marker)))
|
(message "Please regenerate the refile cache with `C-0 C-c C-w'")
|
(sit-for 3)
|
(throw 'exit nil)))
|
t)))
|
|
(defun org-refile-cache-put (set &rest identifiers)
|
"Push the refile targets SET into the cache, under IDENTIFIERS."
|
(let* ((key (sha1 (prin1-to-string identifiers)))
|
(entry (assoc key org-refile-cache)))
|
(if entry
|
(setcdr entry set)
|
(push (cons key set) org-refile-cache))))
|
|
(defun org-refile-cache-get (&rest identifiers)
|
"Retrieve the cached value for refile targets given by IDENTIFIERS."
|
(cond
|
((not org-refile-cache) nil)
|
((not org-refile-use-cache) (org-refile-cache-clear) nil)
|
(t
|
(let ((set (cdr (assoc (sha1 (prin1-to-string identifiers))
|
org-refile-cache))))
|
(and set (org-refile-cache-check-set set) set)))))
|
|
(defvar org-outline-path-cache nil
|
"Alist between buffer positions and outline paths.
|
It value is an alist (POSITION . PATH) where POSITION is the
|
buffer position at the beginning of an entry and PATH is a list
|
of strings describing the outline path for that entry, in reverse
|
order.")
|
|
(defun org-refile-get-targets (&optional default-buffer)
|
"Produce a table with refile targets."
|
(let ((case-fold-search nil)
|
;; otherwise org confuses "TODO" as a kw and "Todo" as a word
|
(entries (or org-refile-targets '((nil . (:level . 1)))))
|
targets tgs files desc descre)
|
(message "Getting targets...")
|
(with-current-buffer (or default-buffer (current-buffer))
|
(dolist (entry entries)
|
(setq files (car entry) desc (cdr entry))
|
(cond
|
((null files) (setq files (list (current-buffer))))
|
((eq files 'org-agenda-files)
|
(setq files (org-agenda-files 'unrestricted)))
|
((and (symbolp files) (fboundp files))
|
(setq files (funcall files)))
|
((and (symbolp files) (boundp files))
|
(setq files (symbol-value files))))
|
(when (stringp files) (setq files (list files)))
|
(cond
|
((eq (car desc) :tag)
|
(setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":")))
|
((eq (car desc) :todo)
|
(setq descre (concat "^\\*+[ \t]+" (regexp-quote (cdr desc)) "[ \t]")))
|
((eq (car desc) :regexp)
|
(setq descre (cdr desc)))
|
((eq (car desc) :level)
|
(setq descre (concat "^\\*\\{" (number-to-string
|
(if org-odd-levels-only
|
(1- (* 2 (cdr desc)))
|
(cdr desc)))
|
"\\}[ \t]")))
|
((eq (car desc) :maxlevel)
|
(setq descre (concat "^\\*\\{1," (number-to-string
|
(if org-odd-levels-only
|
(1- (* 2 (cdr desc)))
|
(cdr desc)))
|
"\\}[ \t]")))
|
(t (error "Bad refiling target description %s" desc)))
|
(dolist (f files)
|
(with-current-buffer (if (bufferp f) f (org-get-agenda-file-buffer f))
|
(or
|
(setq tgs (org-refile-cache-get (buffer-file-name) descre))
|
(progn
|
(when (bufferp f)
|
(setq f (buffer-file-name (buffer-base-buffer f))))
|
(setq f (and f (expand-file-name f)))
|
(when (eq org-refile-use-outline-path 'file)
|
(push (list (file-name-nondirectory f) f nil nil) tgs))
|
(when (eq org-refile-use-outline-path 'buffer-name)
|
(push (list (buffer-name (buffer-base-buffer)) f nil nil) tgs))
|
(when (eq org-refile-use-outline-path 'full-file-path)
|
(push (list (file-truename (buffer-file-name (buffer-base-buffer))) f nil nil) tgs))
|
(org-with-wide-buffer
|
(goto-char (point-min))
|
(setq org-outline-path-cache nil)
|
(while (re-search-forward descre nil t)
|
(beginning-of-line)
|
(let ((case-fold-search nil))
|
(looking-at org-complex-heading-regexp))
|
(let ((begin (point))
|
(heading (match-string-no-properties 4)))
|
(unless (or (and
|
org-refile-target-verify-function
|
(not
|
(funcall org-refile-target-verify-function)))
|
(not heading))
|
(let ((re (format org-complex-heading-regexp-format
|
(regexp-quote heading)))
|
(target
|
(if (not org-refile-use-outline-path) heading
|
(mapconcat
|
#'identity
|
(append
|
(pcase org-refile-use-outline-path
|
(`file (list (file-name-nondirectory
|
(buffer-file-name
|
(buffer-base-buffer)))))
|
(`full-file-path
|
(list (buffer-file-name
|
(buffer-base-buffer))))
|
(`buffer-name
|
(list (buffer-name
|
(buffer-base-buffer))))
|
(_ nil))
|
(mapcar (lambda (s) (replace-regexp-in-string
|
"/" "\\/" s nil t))
|
(org-get-outline-path t t)))
|
"/"))))
|
(push (list target f re (org-refile-marker (point)))
|
tgs)))
|
(when (= (point) begin)
|
;; Verification function has not moved point.
|
(end-of-line)))))))
|
(when org-refile-use-cache
|
(org-refile-cache-put tgs (buffer-file-name) descre))
|
(setq targets (append tgs targets))))))
|
(message "Getting targets...done")
|
(delete-dups (nreverse targets))))
|
|
(defun org--get-outline-path-1 (&optional use-cache)
|
"Return outline path to current headline.
|
|
Outline path is a list of strings, in reverse order. When
|
optional argument USE-CACHE is non-nil, make use of a cache. See
|
`org-get-outline-path' for details.
|
|
Assume buffer is widened and point is on a headline."
|
(or (and use-cache (cdr (assq (point) org-outline-path-cache)))
|
(let ((p (point))
|
(heading (let ((case-fold-search nil))
|
(looking-at org-complex-heading-regexp)
|
(if (not (match-end 4)) ""
|
;; Remove statistics cookies.
|
(org-trim
|
(org-link-display-format
|
(replace-regexp-in-string
|
"\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
|
(match-string-no-properties 4))))))))
|
(if (org-up-heading-safe)
|
(let ((path (cons heading (org--get-outline-path-1 use-cache))))
|
(when use-cache
|
(push (cons p path) org-outline-path-cache))
|
path)
|
;; This is a new root node. Since we assume we are moving
|
;; forward, we can drop previous cache so as to limit number
|
;; of associations there.
|
(let ((path (list heading)))
|
(when use-cache (setq org-outline-path-cache (list (cons p path))))
|
path)))))
|
|
(defun org-get-outline-path (&optional with-self use-cache)
|
"Return the outline path to the current entry.
|
|
An outline path is a list of ancestors for current headline, as
|
a list of strings. Statistics cookies are removed and links are
|
replaced with their description, if any, or their path otherwise.
|
|
When optional argument WITH-SELF is non-nil, the path also
|
includes the current headline.
|
|
When optional argument USE-CACHE is non-nil, cache outline paths
|
between calls to this function so as to avoid backtracking. This
|
argument is useful when planning to find more than one outline
|
path in the same document. In that case, there are two
|
conditions to satisfy:
|
- `org-outline-path-cache' is set to nil before starting the
|
process;
|
- outline paths are computed by increasing buffer positions."
|
(org-with-wide-buffer
|
(and (or (and with-self (org-back-to-heading t))
|
(org-up-heading-safe))
|
(reverse (org--get-outline-path-1 use-cache)))))
|
|
(defun org-format-outline-path (path &optional width prefix separator)
|
"Format the outline path PATH for display.
|
WIDTH is the maximum number of characters that is available.
|
PREFIX is a prefix to be included in the returned string,
|
such as the file name.
|
SEPARATOR is inserted between the different parts of the path,
|
the default is \"/\"."
|
(setq width (or width 79))
|
(setq path (delq nil path))
|
(unless (> width 0)
|
(user-error "Argument `width' must be positive"))
|
(setq separator (or separator "/"))
|
(let* ((org-odd-levels-only nil)
|
(fpath (concat
|
prefix (and prefix path separator)
|
(mapconcat
|
(lambda (s) (replace-regexp-in-string "[ \t]+\\'" "" s))
|
(cl-loop for head in path
|
for n from 0
|
collect (org-add-props
|
head nil 'face
|
(nth (% n org-n-level-faces) org-level-faces)))
|
separator))))
|
(when (> (length fpath) width)
|
(if (< width 7)
|
;; It's unlikely that `width' will be this small, but don't
|
;; waste characters by adding ".." if it is.
|
(setq fpath (substring fpath 0 width))
|
(setf (substring fpath (- width 2)) "..")))
|
fpath))
|
|
(defun org-display-outline-path (&optional file current separator just-return-string)
|
"Display the current outline path in the echo area.
|
|
If FILE is non-nil, prepend the output with the file name.
|
If CURRENT is non-nil, append the current heading to the output.
|
SEPARATOR is passed through to `org-format-outline-path'. It separates
|
the different parts of the path and defaults to \"/\".
|
If JUST-RETURN-STRING is non-nil, return a string, don't display a message."
|
(interactive "P")
|
(let* (case-fold-search
|
(bfn (buffer-file-name (buffer-base-buffer)))
|
(path (and (derived-mode-p 'org-mode) (org-get-outline-path)))
|
res)
|
(when current (setq path (append path
|
(save-excursion
|
(org-back-to-heading t)
|
(when (looking-at org-complex-heading-regexp)
|
(list (match-string 4)))))))
|
(setq res
|
(org-format-outline-path
|
path
|
(1- (frame-width))
|
(and file bfn (concat (file-name-nondirectory bfn) separator))
|
separator))
|
(if just-return-string
|
(org-no-properties res)
|
(org-unlogged-message "%s" res))))
|
|
(defvar org-refile-history nil
|
"History for refiling operations.")
|
|
(defvar org-after-refile-insert-hook nil
|
"Hook run after `org-refile' has inserted its stuff at the new location.
|
Note that this is still *before* the stuff will be removed from
|
the *old* location.")
|
|
(defvar org-capture-last-stored-marker)
|
(defvar org-refile-keep nil
|
"Non-nil means `org-refile' will copy instead of refile.")
|
|
(defun org-copy ()
|
"Like `org-refile', but copy."
|
(interactive)
|
(let ((org-refile-keep t))
|
(funcall 'org-refile nil nil nil "Copy")))
|
|
(defun org-refile (&optional arg default-buffer rfloc msg)
|
"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.
|
|
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
|
refiled. However, the region must fulfill the requirement that
|
the first heading sets the top-level of the moved text.
|
|
With a `\\[universal-argument]' ARG, the command will only visit the target \
|
location
|
and not actually move anything.
|
|
With a prefix `\\[universal-argument] \\[universal-argument]', go to the \
|
location where the last
|
refiling operation has put the subtree.
|
|
With a numeric prefix argument of `2', refile to the running clock.
|
|
With a numeric prefix argument of `3', emulate `org-refile-keep'
|
being set to t and copy to the target location, don't move it.
|
Beware that keeping refiled entries may result in duplicated ID
|
properties.
|
|
RFLOC can be a refile location obtained in a different way.
|
|
MSG is a string to replace \"Refile\" in the default prompt with
|
another verb. E.g. `org-copy' sets this parameter to \"Copy\".
|
|
See also `org-refile-use-outline-path'.
|
|
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') or a triple
|
prefix argument (`C-u C-u C-u C-c C-w')."
|
(interactive "P")
|
(if (member arg '(0 (64)))
|
(org-refile-cache-clear)
|
(let* ((actionmsg (cond (msg msg)
|
((equal arg 3) "Refile (and keep)")
|
(t "Refile")))
|
(regionp (org-region-active-p))
|
(region-start (and regionp (region-beginning)))
|
(region-end (and regionp (region-end)))
|
(org-refile-keep (if (equal arg 3) t org-refile-keep))
|
pos it nbuf file level reversed)
|
(setq last-command nil)
|
(when regionp
|
(goto-char region-start)
|
(or (bolp) (goto-char (point-at-bol)))
|
(setq region-start (point))
|
(unless (or (org-kill-is-subtree-p
|
(buffer-substring region-start region-end))
|
(prog1 org-refile-active-region-within-subtree
|
(let ((s (point-at-eol)))
|
(org-toggle-heading)
|
(setq region-end (+ (- (point-at-eol) s) region-end)))))
|
(user-error "The region is not a (sequence of) subtree(s)")))
|
(if (equal arg '(16))
|
(org-refile-goto-last-stored)
|
(when (or
|
(and (equal arg 2)
|
org-clock-hd-marker (marker-buffer org-clock-hd-marker)
|
(prog1
|
(setq it (list (or org-clock-heading "running clock")
|
(buffer-file-name
|
(marker-buffer org-clock-hd-marker))
|
""
|
(marker-position org-clock-hd-marker)))
|
(setq arg nil)))
|
(setq it
|
(or rfloc
|
(let (heading-text)
|
(save-excursion
|
(unless (and arg (listp arg))
|
(org-back-to-heading t)
|
(setq heading-text
|
(replace-regexp-in-string
|
org-bracket-link-regexp
|
"\\3"
|
(or (nth 4 (org-heading-components))
|
""))))
|
(org-refile-get-location
|
(cond ((and arg (listp arg)) "Goto")
|
(regionp (concat actionmsg " region to"))
|
(t (concat actionmsg " subtree \""
|
heading-text "\" to")))
|
default-buffer
|
(and (not (equal '(4) arg))
|
org-refile-allow-creating-parent-nodes)))))))
|
(setq file (nth 1 it)
|
pos (nth 3 it))
|
(when (and (not arg)
|
pos
|
(equal (buffer-file-name) file)
|
(if regionp
|
(and (>= pos region-start)
|
(<= pos region-end))
|
(and (>= pos (point))
|
(< pos (save-excursion
|
(org-end-of-subtree t t))))))
|
(error "Cannot refile to position inside the tree or region"))
|
(setq nbuf (or (find-buffer-visiting file)
|
(find-file-noselect file)))
|
(if (and arg (not (equal arg 3)))
|
(progn
|
(pop-to-buffer-same-window nbuf)
|
(goto-char (cond (pos)
|
((org-notes-order-reversed-p) (point-min))
|
(t (point-max))))
|
(org-show-context 'org-goto))
|
(if regionp
|
(progn
|
(org-kill-new (buffer-substring region-start region-end))
|
(org-save-markers-in-region region-start region-end))
|
(org-copy-subtree 1 nil t))
|
(with-current-buffer (setq nbuf (or (find-buffer-visiting file)
|
(find-file-noselect file)))
|
(setq reversed (org-notes-order-reversed-p))
|
(org-with-wide-buffer
|
(if pos
|
(progn
|
(goto-char pos)
|
(setq level (org-get-valid-level (funcall outline-level) 1))
|
(goto-char
|
(if reversed
|
(or (outline-next-heading) (point-max))
|
(or (save-excursion (org-get-next-sibling))
|
(org-end-of-subtree t t)
|
(point-max)))))
|
(setq level 1)
|
(if (not reversed)
|
(goto-char (point-max))
|
(goto-char (point-min))
|
(or (outline-next-heading) (goto-char (point-max)))))
|
(unless (bolp) (newline))
|
(org-paste-subtree level nil nil t)
|
(when org-log-refile
|
(org-add-log-setup 'refile nil nil org-log-refile)
|
(unless (eq org-log-refile 'note)
|
(save-excursion (org-add-log-note))))
|
(and org-auto-align-tags
|
(let ((org-loop-over-headlines-in-active-region nil))
|
(org-set-tags nil t)))
|
(let ((bookmark-name (plist-get org-bookmark-names-plist
|
:last-refile)))
|
(when bookmark-name
|
(with-demoted-errors
|
(bookmark-set bookmark-name))))
|
;; If we are refiling for capture, make sure that the
|
;; last-capture pointers point here
|
(when (bound-and-true-p org-capture-is-refiling)
|
(let ((bookmark-name (plist-get org-bookmark-names-plist
|
:last-capture-marker)))
|
(when bookmark-name
|
(with-demoted-errors
|
(bookmark-set bookmark-name))))
|
(move-marker org-capture-last-stored-marker (point)))
|
(when (fboundp 'deactivate-mark) (deactivate-mark))
|
(run-hooks 'org-after-refile-insert-hook)))
|
(unless org-refile-keep
|
(if regionp
|
(delete-region (point) (+ (point) (- region-end region-start)))
|
(delete-region
|
(and (org-back-to-heading t) (point))
|
(min (1+ (buffer-size)) (org-end-of-subtree t t) (point)))))
|
(when (featurep 'org-inlinetask)
|
(org-inlinetask-remove-END-maybe))
|
(setq org-markers-to-move nil)
|
(message (concat actionmsg " to \"%s\" in file %s: done") (car it) file)))))))
|
|
(defun org-refile-goto-last-stored ()
|
"Go to the location where the last refile was stored."
|
(interactive)
|
(bookmark-jump (plist-get org-bookmark-names-plist :last-refile))
|
(message "This is the location of the last refile"))
|
|
(defun org-refile--get-location (refloc tbl)
|
"When user refile to REFLOC, find the associated target in TBL.
|
Also check `org-refile-target-table'."
|
(car (delq
|
nil
|
(mapcar
|
(lambda (r) (or (assoc r tbl)
|
(assoc r org-refile-target-table)))
|
(list (replace-regexp-in-string "/$" "" refloc)
|
(replace-regexp-in-string "\\([^/]\\)$" "\\1/" refloc))))))
|
|
(defun org-refile-get-location (&optional prompt default-buffer new-nodes)
|
"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."
|
(let ((org-refile-targets org-refile-targets)
|
(org-refile-use-outline-path org-refile-use-outline-path))
|
(setq org-refile-target-table (org-refile-get-targets default-buffer)))
|
(unless org-refile-target-table
|
(user-error "No refile targets"))
|
(let* ((cbuf (current-buffer))
|
(cfn (buffer-file-name (buffer-base-buffer cbuf)))
|
(cfunc (if (and org-refile-use-outline-path
|
org-outline-path-complete-in-steps)
|
#'org-olpath-completing-read
|
#'completing-read))
|
(extra (if org-refile-use-outline-path "/" ""))
|
(cbnex (concat (buffer-name) extra))
|
(filename (and cfn (expand-file-name cfn)))
|
(tbl (mapcar
|
(lambda (x)
|
(if (and (not (member org-refile-use-outline-path
|
'(file full-file-path)))
|
(not (equal filename (nth 1 x))))
|
(cons (concat (car x) extra " ("
|
(file-name-nondirectory (nth 1 x)) ")")
|
(cdr x))
|
(cons (concat (car x) extra) (cdr x))))
|
org-refile-target-table))
|
(completion-ignore-case t)
|
cdef
|
(prompt (concat prompt
|
(or (and (car org-refile-history)
|
(concat " (default " (car org-refile-history) ")"))
|
(and (assoc cbnex tbl) (setq cdef cbnex)
|
(concat " (default " cbnex ")"))) ": "))
|
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 (or cdef (car org-refile-history))))
|
(if (setq pa (org-refile--get-location answ tbl))
|
(progn
|
(org-refile-check-position pa)
|
(when (or (not org-refile-history)
|
(not (eq old-hist org-refile-history))
|
(not (equal (car pa) (car org-refile-history))))
|
(setq org-refile-history
|
(cons (car pa) (if (assoc (car org-refile-history) tbl)
|
org-refile-history
|
(cdr org-refile-history))))
|
(when (equal (car org-refile-history) (nth 1 org-refile-history))
|
(pop org-refile-history)))
|
pa)
|
(if (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ)
|
(progn
|
(setq parent (match-string 1 answ)
|
child (match-string 2 answ))
|
(setq parent-target (org-refile--get-location parent tbl))
|
(when (and parent-target
|
(or (eq new-nodes t)
|
(and (eq new-nodes 'confirm)
|
(y-or-n-p (format "Create new node \"%s\"? "
|
child)))))
|
(org-refile-new-child parent-target child)))
|
(user-error "Invalid target location")))))
|
|
(declare-function org-string-nw-p "org-macs" (s))
|
(defun org-refile-check-position (refile-pointer)
|
"Check if the refile pointer matches the headline to which it points."
|
(let* ((file (nth 1 refile-pointer))
|
(re (nth 2 refile-pointer))
|
(pos (nth 3 refile-pointer))
|
buffer)
|
(if (and (not (markerp pos)) (not file))
|
(user-error "Please indicate a target file in the refile path")
|
(when (org-string-nw-p re)
|
(setq buffer (if (markerp pos)
|
(marker-buffer pos)
|
(or (find-buffer-visiting file)
|
(find-file-noselect file))))
|
(with-current-buffer buffer
|
(org-with-wide-buffer
|
(goto-char pos)
|
(beginning-of-line 1)
|
(unless (looking-at-p re)
|
(user-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."
|
(unless parent-target
|
(error "Cannot find parent for new node"))
|
(let ((file (nth 1 parent-target))
|
(pos (nth 3 parent-target))
|
level)
|
(with-current-buffer (or (find-buffer-visiting file)
|
(find-file-noselect file))
|
(org-with-wide-buffer
|
(if pos
|
(goto-char pos)
|
(goto-char (point-max))
|
(unless (bolp) (newline)))
|
(when (looking-at org-outline-regexp)
|
(setq level (funcall outline-level))
|
(org-end-of-subtree t t))
|
(org-back-over-empty-lines)
|
(insert "\n" (make-string
|
(if pos (org-get-valid-level level 1) 1) ?*)
|
" " child "\n")
|
(beginning-of-line 0)
|
(list (concat (car parent-target) "/" child) file "" (point))))))
|
|
(defun org-olpath-completing-read (prompt collection &rest args)
|
"Read an outline path like a file name."
|
(let ((thetable collection))
|
(apply #'completing-read
|
prompt
|
(lambda (string predicate &optional flag)
|
(cond
|
((eq flag nil) (try-completion string thetable))
|
((eq flag t)
|
(let ((l (length string)))
|
(mapcar (lambda (x)
|
(let ((r (substring x l))
|
(f (if (string-match " ([^)]*)$" x)
|
(match-string 0 x)
|
"")))
|
(if (string-match "/" r)
|
(concat string (substring r 0 (match-end 0)) f)
|
x)))
|
(all-completions string thetable predicate))))
|
;; Exact match?
|
((eq flag 'lambda) (assoc string thetable))))
|
args)))
|
|
;;;; Dynamic blocks
|
|
(defun org-find-dblock (name)
|
"Find the first dynamic block with name NAME in the buffer.
|
If not found, stay at current position and return nil."
|
(let ((case-fold-search t) pos)
|
(save-excursion
|
(goto-char (point-min))
|
(setq pos (and (re-search-forward
|
(concat "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+" name "\\>") nil t)
|
(match-beginning 0))))
|
(when pos (goto-char pos))
|
pos))
|
|
(defun org-create-dblock (plist)
|
"Create a dynamic block section, with parameters taken from PLIST.
|
PLIST must contain a :name entry which is used as the name of the block."
|
(when (string-match "\\S-" (buffer-substring (point-at-bol) (point-at-eol)))
|
(end-of-line 1)
|
(newline))
|
(let ((col (current-column))
|
(name (plist-get plist :name)))
|
(insert "#+BEGIN: " name)
|
(while plist
|
(if (eq (car plist) :name)
|
(setq plist (cddr plist))
|
(insert " " (prin1-to-string (pop plist)))))
|
(insert "\n\n" (make-string col ?\ ) "#+END:\n")
|
(beginning-of-line -2)))
|
|
(defun org-prepare-dblock ()
|
"Prepare dynamic block for refresh.
|
This empties the block, puts the cursor at the insert position and returns
|
the property list including an extra property :name with the block name."
|
(unless (looking-at org-dblock-start-re)
|
(user-error "Not at a dynamic block"))
|
(let* ((begdel (1+ (match-end 0)))
|
(name (org-no-properties (match-string 1)))
|
(params (append (list :name name)
|
(read (concat "(" (match-string 3) ")")))))
|
(save-excursion
|
(beginning-of-line 1)
|
(skip-chars-forward " \t")
|
(setq params (plist-put params :indentation-column (current-column))))
|
(unless (re-search-forward org-dblock-end-re nil t)
|
(error "Dynamic block not terminated"))
|
(setq params
|
(append params
|
(list :content (buffer-substring
|
begdel (match-beginning 0)))))
|
(delete-region begdel (match-beginning 0))
|
(goto-char begdel)
|
(open-line 1)
|
params))
|
|
(defun org-map-dblocks (&optional command)
|
"Apply COMMAND to all dynamic blocks in the current buffer.
|
If COMMAND is not given, use `org-update-dblock'."
|
(let ((cmd (or command 'org-update-dblock)))
|
(save-excursion
|
(goto-char (point-min))
|
(while (re-search-forward org-dblock-start-re nil t)
|
(goto-char (match-beginning 0))
|
(save-excursion
|
(condition-case nil
|
(funcall cmd)
|
(error (message "Error during update of dynamic block"))))
|
(unless (re-search-forward org-dblock-end-re nil t)
|
(error "Dynamic block not terminated"))))))
|
|
(defun org-dblock-update (&optional arg)
|
"User command for updating dynamic blocks.
|
Update the dynamic block at point. With prefix ARG, update all dynamic
|
blocks in the buffer."
|
(interactive "P")
|
(if arg
|
(org-update-all-dblocks)
|
(or (looking-at org-dblock-start-re)
|
(org-beginning-of-dblock))
|
(org-update-dblock)))
|
|
(defun org-update-dblock ()
|
"Update the dynamic block at point.
|
This means to empty the block, parse for parameters and then call
|
the correct writing function."
|
(interactive)
|
(save-excursion
|
(let* ((win (selected-window))
|
(pos (point))
|
(line (org-current-line))
|
(params (org-prepare-dblock))
|
(name (plist-get params :name))
|
(indent (plist-get params :indentation-column))
|
(cmd (intern (concat "org-dblock-write:" name))))
|
(message "Updating dynamic block `%s' at line %d..." name line)
|
(funcall cmd params)
|
(message "Updating dynamic block `%s' at line %d...done" name line)
|
(goto-char pos)
|
(when (and indent (> indent 0))
|
(setq indent (make-string indent ?\ ))
|
(save-excursion
|
(select-window win)
|
(org-beginning-of-dblock)
|
(forward-line 1)
|
(while (not (looking-at org-dblock-end-re))
|
(insert indent)
|
(beginning-of-line 2))
|
(when (looking-at org-dblock-end-re)
|
(and (looking-at "[ \t]+")
|
(replace-match ""))
|
(insert indent)))))))
|
|
(defun org-beginning-of-dblock ()
|
"Find the beginning of the dynamic block at point.
|
Error if there is no such block at point."
|
(let ((pos (point))
|
beg)
|
(end-of-line 1)
|
(if (and (re-search-backward org-dblock-start-re nil t)
|
(setq beg (match-beginning 0))
|
(re-search-forward org-dblock-end-re nil t)
|
(> (match-end 0) pos))
|
(goto-char beg)
|
(goto-char pos)
|
(error "Not in a dynamic block"))))
|
|
(defun org-update-all-dblocks ()
|
"Update all dynamic blocks in the buffer.
|
This function can be used in a hook."
|
(interactive)
|
(when (derived-mode-p 'org-mode)
|
(org-map-dblocks 'org-update-dblock)))
|
|
|
;;;; Completion
|
|
(declare-function org-export-backend-options "ox" (cl-x) t)
|
(defun org-get-export-keywords ()
|
"Return a list of all currently understood export keywords.
|
Export keywords include options, block names, attributes and
|
keywords relative to each registered export back-end."
|
(let (keywords)
|
(dolist (backend
|
(bound-and-true-p org-export-registered-backends)
|
(delq nil keywords))
|
;; Back-end name (for keywords, like #+LATEX:)
|
(push (upcase (symbol-name (org-export-backend-name backend))) keywords)
|
(dolist (option-entry (org-export-backend-options backend))
|
;; Back-end options.
|
(push (nth 1 option-entry) keywords)))))
|
|
(defconst org-options-keywords
|
'("ARCHIVE:" "AUTHOR:" "BIND:" "CATEGORY:" "COLUMNS:" "CREATOR:" "DATE:"
|
"DESCRIPTION:" "DRAWERS:" "EMAIL:" "EXCLUDE_TAGS:" "FILETAGS:" "INCLUDE:"
|
"INDEX:" "KEYWORDS:" "LANGUAGE:" "MACRO:" "OPTIONS:" "PROPERTY:"
|
"PRIORITIES:" "SELECT_TAGS:" "SEQ_TODO:" "SETUPFILE:" "STARTUP:" "TAGS:"
|
"TITLE:" "TODO:" "TYP_TODO:" "SELECT_TAGS:" "EXCLUDE_TAGS:"))
|
|
(defcustom org-structure-template-alist
|
'(("s" "#+BEGIN_SRC ?\n\n#+END_SRC")
|
("e" "#+BEGIN_EXAMPLE\n?\n#+END_EXAMPLE")
|
("q" "#+BEGIN_QUOTE\n?\n#+END_QUOTE")
|
("v" "#+BEGIN_VERSE\n?\n#+END_VERSE")
|
("V" "#+BEGIN_VERBATIM\n?\n#+END_VERBATIM")
|
("c" "#+BEGIN_CENTER\n?\n#+END_CENTER")
|
("C" "#+BEGIN_COMMENT\n?\n#+END_COMMENT")
|
("l" "#+BEGIN_EXPORT latex\n?\n#+END_EXPORT")
|
("L" "#+LaTeX: ")
|
("h" "#+BEGIN_EXPORT html\n?\n#+END_EXPORT")
|
("H" "#+HTML: ")
|
("a" "#+BEGIN_EXPORT ascii\n?\n#+END_EXPORT")
|
("A" "#+ASCII: ")
|
("i" "#+INDEX: ?")
|
("I" "#+INCLUDE: %file ?"))
|
"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 `TAB'. %file will be replaced by a file name after prompting
|
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
|
variable `org-mtags-prefer-muse-templates'."
|
:group 'org-edit-structure
|
:type '(repeat
|
(list
|
(string :tag "Key")
|
(string :tag "Template")))
|
:version "26.1"
|
:package-version '(Org . "8.3"))
|
|
(defun org-try-structure-completion ()
|
"Try to complete a structure template before point.
|
This looks for strings like \"<e\" on an otherwise empty line and
|
expands them."
|
(let ((l (buffer-substring (point-at-bol) (point)))
|
a)
|
(when (and (looking-at "[ \t]*$")
|
(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)
|
t)))
|
|
(defun org-complete-expand-structure-template (start cell)
|
"Expand a structure template."
|
(let ((rpl (nth 1 cell))
|
(ind ""))
|
(delete-region start (point))
|
(when (string-match "\\`[ \t]*#\\+" rpl)
|
(cond
|
((bolp))
|
((not (string-match "\\S-" (buffer-substring (point-at-bol) (point))))
|
(setq ind (buffer-substring (point-at-bol) (point))))
|
(t (newline))))
|
(setq start (point))
|
(when (string-match "%file" rpl)
|
(setq rpl (replace-match
|
(concat
|
"\""
|
(save-match-data
|
(abbreviate-file-name (read-file-name "Include file: ")))
|
"\"")
|
t t rpl)))
|
(setq rpl (mapconcat 'identity (split-string rpl "\n")
|
(concat "\n" ind)))
|
(insert rpl)
|
(when (re-search-backward "\\?" start t) (delete-char 1))))
|
|
;;;; TODO, DEADLINE, Comments
|
|
(defun org-toggle-comment ()
|
"Change the COMMENT state of an entry."
|
(interactive)
|
(save-excursion
|
(org-back-to-heading)
|
(let ((case-fold-search nil))
|
(looking-at org-complex-heading-regexp))
|
(goto-char (or (match-end 3) (match-end 2) (match-end 1)))
|
(skip-chars-forward " \t")
|
(unless (memq (char-before) '(?\s ?\t)) (insert " "))
|
(if (org-in-commented-heading-p t)
|
(delete-region (point)
|
(progn (search-forward " " (line-end-position) 'move)
|
(skip-chars-forward " \t")
|
(point)))
|
(insert org-comment-string)
|
(unless (eolp) (insert " ")))))
|
|
(defvar org-last-todo-state-is-todo nil
|
"This is non-nil when the last TODO state change led to a TODO state.
|
If the last change removed the TODO tag or switched to DONE, then
|
this is nil.")
|
|
(defvar org-setting-tags nil) ; dynamically skipped
|
|
(defvar org-todo-setup-filter-hook nil
|
"Hook for functions that pre-filter todo specs.
|
Each function takes a todo spec and returns either nil or the spec
|
transformed into canonical form." )
|
|
(defvar org-todo-get-default-hook nil
|
"Hook for functions that get a default item for todo.
|
Each function takes arguments (NEW-MARK OLD-MARK) and returns either
|
nil or a string to be used for the todo mark." )
|
|
(defvar org-agenda-headline-snapshot-before-repeat)
|
|
(defun org-current-effective-time ()
|
"Return current time adjusted for `org-extend-today-until' variable."
|
(let* ((ct (org-current-time))
|
(dct (decode-time ct))
|
(ct1
|
(cond
|
(org-use-last-clock-out-time-as-effective-time
|
(or (org-clock-get-last-clock-out-time) ct))
|
((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)))
|
(t 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* ((org-use-effective-time t)
|
(hour (nth 2 (decode-time (org-current-time))))
|
(org-extend-today-until (1+ hour)))
|
(org-todo arg))))
|
|
(defvar org-block-entry-blocking ""
|
"First entry preventing the TODO state change.")
|
|
(defun org-cancel-repeater ()
|
"Cancel a repeater by setting its numeric value to zero."
|
(interactive)
|
(save-excursion
|
(org-back-to-heading t)
|
(let ((bound1 (point))
|
(bound0 (save-excursion (outline-next-heading) (point))))
|
(when (and (re-search-forward
|
(concat "\\(" org-scheduled-time-regexp "\\)\\|\\("
|
org-deadline-time-regexp "\\)\\|\\("
|
org-ts-regexp "\\)")
|
bound0 t)
|
(re-search-backward "[ \t]+\\(?:[.+]\\)?\\+\\([0-9]+\\)[hdwmy]"
|
bound1 t))
|
(replace-match "0" t nil nil 1)))))
|
|
(defvar org-state)
|
(defvar org-blocked-by-checkboxes)
|
(defun org-todo (&optional arg)
|
"Change the TODO state of an item.
|
|
The state of an item is given by a keyword at the start of the heading,
|
like
|
*** TODO Write paper
|
*** DONE Call mom
|
|
The different keywords are specified in the variable `org-todo-keywords'.
|
By default the available states are \"TODO\" and \"DONE\". So, for this
|
example: when the item starts with TODO, it is changed to DONE.
|
When it starts with DONE, the DONE is removed. And when neither TODO nor
|
DONE are present, add TODO at the beginning of the heading.
|
|
With `\\[universal-argument]' prefix ARG, use completion to determine the new \
|
state.
|
With numeric prefix ARG, switch to that state.
|
With a `\\[universal-argument] \\[universal-argument]' prefix, switch to the \
|
next set of TODO \
|
keywords (nextset).
|
With a `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \
|
prefix, circumvent any state blocking.
|
With a numeric prefix arg of 0, inhibit note taking for the change.
|
With a numeric prefix arg of -1, cancel repeater to allow marking as DONE.
|
|
When called through ELisp, arg is also interpreted in the following way:
|
`none' -> empty state
|
\"\" -> switch to empty state
|
`done' -> switch to DONE
|
`nextset' -> switch to the next set of keywords
|
`previousset' -> switch to the previous set of keywords
|
\"WAITING\" -> switch to the specified keyword, but only if it
|
really is a member of `org-todo-keywords'."
|
(interactive "P")
|
(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 (when (org-invisible-p) (org-end-of-subtree nil t))))
|
(when (equal arg '(16)) (setq arg 'nextset))
|
(when (equal arg -1) (org-cancel-repeater) (setq arg nil))
|
(let ((org-blocker-hook org-blocker-hook)
|
commentp
|
case-fold-search)
|
(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)
|
(when (org-in-commented-heading-p t)
|
(org-toggle-comment)
|
(setq commentp t))
|
(when (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 (copy-marker (line-beginning-position)))
|
(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.
|
(completing-read
|
"State: " (mapcar #'list org-todo-keywords-1)
|
nil t))
|
((eq arg 'right)
|
(if this
|
(if tail (car tail) nil)
|
(car org-todo-keywords-1)))
|
((eq arg 'left)
|
(unless (equal member org-todo-keywords-1)
|
(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)))
|
(or (car (cdr (member head org-todo-heads)))
|
(car org-todo-heads))))
|
((car (member arg org-todo-keywords-1)))
|
((stringp arg)
|
(user-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
|
(let (org-blocked-by-checkboxes block-reason)
|
(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))))
|
(setq block-reason (if org-blocked-by-checkboxes
|
"contained checkboxes"
|
(format "\"%s\"" org-block-entry-blocking)))
|
(if (called-interactively-p 'interactive)
|
(user-error "TODO state change from %s to %s blocked (by %s)"
|
this org-state block-reason)
|
;; Fail silently.
|
(message "TODO state change from %s to %s blocked (by %s)"
|
this org-state block-reason)
|
(throw 'exit nil)))))
|
(store-match-data match-data)
|
(replace-match next t t)
|
(cond ((equal this org-state)
|
(message "TODO state was already %s" (org-trim next)))
|
((not (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 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))))
|
(when (and (eq dolog 'note) (eq org-inhibit-logging 'note))
|
(setq dolog 'time))
|
(when (or (and (not org-state) (not org-closed-keep-when-no-todo))
|
(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))
|
(when (and (not dolog) (eq 'note org-log-done))
|
(org-add-log-setup 'done org-state this '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 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)
|
(when (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.
|
(when (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)))))
|
(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)))
|
(when commentp (org-toggle-comment))))))))
|
|
(defun org-block-todo-from-children-or-siblings-or-parent (change-plist)
|
"Block turning an entry into a TODO, using the hierarchy.
|
This checks whether the current task should be blocked from state
|
changes. Such blocking occurs when:
|
|
1. The task has children which are not all in a completed state.
|
|
2. A task has a parent with the property :ORDERED:, and there
|
are siblings prior to the current task with incomplete
|
status.
|
|
3. The parent of the task is blocked because it has siblings that should
|
be done first, or is child of a block grandparent TODO entry."
|
|
(if (not org-enforce-todo-dependencies)
|
t ; if locally turned off don't block
|
(catch 'dont-block
|
;; If this is not a todo state change, or if this entry is already DONE,
|
;; do not block
|
(when (or (not (eq (plist-get change-plist :type) 'todo-state-change))
|
(member (plist-get change-plist :from)
|
(cons 'done org-done-keywords))
|
(member (plist-get change-plist :to)
|
(cons 'todo org-not-done-keywords))
|
(not (plist-get change-plist :to)))
|
(throw 'dont-block t))
|
;; If this task has children, and any are undone, it's blocked
|
(save-excursion
|
(org-back-to-heading t)
|
(let ((this-level (funcall outline-level)))
|
(outline-next-heading)
|
(let ((child-level (funcall outline-level)))
|
(while (and (not (eobp))
|
(> child-level this-level))
|
;; this todo has children, check whether they are all
|
;; completed
|
(when (and (not (org-entry-is-done-p))
|
(org-entry-is-todo-p))
|
(setq org-block-entry-blocking (org-get-heading))
|
(throw 'dont-block nil))
|
(outline-next-heading)
|
(setq child-level (funcall outline-level))))))
|
;; Otherwise, if the task's parent has the :ORDERED: property, and
|
;; any previous siblings are undone, it's blocked
|
(save-excursion
|
(org-back-to-heading t)
|
(let* ((pos (point))
|
(parent-pos (and (org-up-heading-safe) (point)))
|
(case-fold-search nil))
|
(unless parent-pos (throw 'dont-block t)) ; no parent
|
(when (and (org-not-nil (org-entry-get (point) "ORDERED"))
|
(forward-line 1)
|
(re-search-forward org-not-done-heading-regexp pos t))
|
(setq org-block-entry-blocking (match-string 0))
|
(throw 'dont-block nil)) ; block, there is an older sibling not done.
|
;; Search further up the hierarchy, to see if an ancestor is blocked
|
(while t
|
(goto-char parent-pos)
|
(unless (looking-at org-not-done-heading-regexp)
|
(throw 'dont-block t)) ; do not block, parent is not a TODO
|
(setq pos (point))
|
(setq parent-pos (and (org-up-heading-safe) (point)))
|
(unless parent-pos (throw 'dont-block t)) ; no parent
|
(when (and (org-not-nil (org-entry-get (point) "ORDERED"))
|
(forward-line 1)
|
(re-search-forward org-not-done-heading-regexp pos t)
|
(setq org-block-entry-blocking (org-get-heading)))
|
(throw 'dont-block nil)))))))) ; block, older sibling not done.
|
|
(defcustom org-track-ordered-property-with-tag nil
|
"Should the ORDERED property also be shown as a tag?
|
The ORDERED property decides if an entry should require subtasks to be
|
completed in sequence. Since a property is not very visible, setting
|
this option means that toggling the ORDERED property with the command
|
`org-toggle-ordered-property' will also toggle a tag ORDERED. That tag is
|
not relevant for the behavior, but it makes things more visible.
|
|
Note that toggling the tag with tags commands will not change the property
|
and therefore not influence behavior!
|
|
This can be t, meaning the tag ORDERED should be used, It can also be a
|
string to select a different tag for this task."
|
:group 'org-todo
|
:type '(choice
|
(const :tag "No tracking" nil)
|
(const :tag "Track with ORDERED tag" t)
|
(string :tag "Use other tag")))
|
|
(defun org-toggle-ordered-property ()
|
"Toggle the ORDERED property of the current entry.
|
For better visibility, you can track the value of this property with a tag.
|
See variable `org-track-ordered-property-with-tag'."
|
(interactive)
|
(let* ((t1 org-track-ordered-property-with-tag)
|
(tag (and t1 (if (stringp t1) t1 "ORDERED"))))
|
(save-excursion
|
(org-back-to-heading)
|
(if (org-entry-get nil "ORDERED")
|
(progn
|
(org-delete-property "ORDERED")
|
(and tag (org-toggle-tag tag 'off))
|
(message "Subtasks can be completed in arbitrary order"))
|
(org-entry-put nil "ORDERED" "t")
|
(and tag (org-toggle-tag tag 'on))
|
(message "Subtasks must be completed in sequence")))))
|
|
(defun org-block-todo-from-checkboxes (change-plist)
|
"Block turning an entry into a TODO, using checkboxes.
|
This checks whether the current task should be blocked from state
|
changes because there are unchecked boxes in this entry."
|
(if (not org-enforce-todo-checkbox-dependencies)
|
t ; if locally turned off don't block
|
(catch 'dont-block
|
;; If this is not a todo state change, or if this entry is already DONE,
|
;; do not block
|
(when (or (not (eq (plist-get change-plist :type) 'todo-state-change))
|
(member (plist-get change-plist :from)
|
(cons 'done org-done-keywords))
|
(member (plist-get change-plist :to)
|
(cons 'todo org-not-done-keywords))
|
(not (plist-get change-plist :to)))
|
(throw 'dont-block t))
|
;; If this task has checkboxes that are not checked, it's blocked
|
(save-excursion
|
(org-back-to-heading t)
|
(let ((beg (point)) end)
|
(outline-next-heading)
|
(setq end (point))
|
(goto-char beg)
|
(when (org-list-search-forward
|
(concat (org-item-beginning-re)
|
"\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?"
|
"\\[[- ]\\]")
|
end t)
|
(when (boundp 'org-blocked-by-checkboxes)
|
(setq org-blocked-by-checkboxes t))
|
(throw 'dont-block nil))))
|
t))) ; do not block
|
|
(defun org-entry-blocked-p ()
|
"Non-nil if entry at point is blocked."
|
(and (not (org-entry-get nil "NOBLOCKING"))
|
(member (org-entry-get nil "TODO") org-not-done-keywords)
|
(not (run-hook-with-args-until-failure
|
'org-blocker-hook
|
(list :type 'todo-state-change
|
:position (point)
|
:from 'todo
|
:to 'done)))))
|
|
(defun org-update-statistics-cookies (all)
|
"Update the statistics cookie, either from TODO or from checkboxes.
|
This should be called with the cursor in a line with a statistics
|
cookie. When called with a \\[universal-argument] prefix, update
|
all statistics cookies in the buffer."
|
(interactive "P")
|
(if all
|
(progn
|
(org-update-checkbox-count 'all)
|
(org-map-entries 'org-update-parent-todo-statistics))
|
(if (not (org-at-heading-p))
|
(org-update-checkbox-count)
|
(let ((pos (point-marker))
|
end l1 l2)
|
(ignore-errors (org-back-to-heading t))
|
(if (not (org-at-heading-p))
|
(org-update-checkbox-count)
|
(setq l1 (org-outline-level))
|
(setq end (save-excursion
|
(outline-next-heading)
|
(when (org-at-heading-p) (setq l2 (org-outline-level)))
|
(point)))
|
(if (and (save-excursion
|
(re-search-forward
|
"^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) \\[[- X]\\]" end t))
|
(not (save-excursion (re-search-forward
|
":COOKIE_DATA:.*\\<todo\\>" end t))))
|
(org-update-checkbox-count)
|
(if (and l2 (> l2 l1))
|
(progn
|
(goto-char end)
|
(org-update-parent-todo-statistics))
|
(goto-char pos)
|
(beginning-of-line 1)
|
(while (re-search-forward
|
"\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)"
|
(point-at-eol) t)
|
(replace-match (if (match-end 2) "[100%]" "[0/0]") t t)))))
|
(goto-char pos)
|
(move-marker pos nil)))))
|
|
(defvar org-entry-property-inherited-from) ;; defined below
|
(defun org-update-parent-todo-statistics ()
|
"Update any statistics cookie in the parent of the current headline.
|
When `org-hierarchical-todo-statistics' is nil, statistics will cover
|
the entire subtree and this will travel up the hierarchy and update
|
statistics everywhere."
|
(let* ((prop (save-excursion (org-up-heading-safe)
|
(org-entry-get nil "COOKIE_DATA" 'inherit)))
|
(recursive (or (not org-hierarchical-todo-statistics)
|
(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
|
checkbox-beg cookie-present)
|
(catch 'exit
|
(save-excursion
|
(beginning-of-line 1)
|
(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))
|
(setq first nil cookie-present nil)
|
(unless (and level
|
(not (string-match
|
"\\<checkbox\\>"
|
(downcase (or (org-entry-get nil "COOKIE_DATA")
|
"")))))
|
(throw 'exit nil))
|
(while (re-search-forward box-re (point-at-eol) t)
|
(setq cnt-all 0 cnt-done 0 cookie-present t)
|
(setq is-percent (match-end 2) 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 (eq org-provide-todo-statistics t)
|
(or (member kwd org-done-keywords)))
|
(and (listp org-provide-todo-statistics)
|
(stringp (car org-provide-todo-statistics))
|
(or (member kwd org-provide-todo-statistics)
|
(member kwd org-done-keywords)))
|
(and (listp org-provide-todo-statistics)
|
(listp (car org-provide-todo-statistics))
|
(or (member kwd (car org-provide-todo-statistics))
|
(and (member kwd org-done-keywords)
|
(member kwd (cadr org-provide-todo-statistics))))))
|
(setq cnt-all (1+ cnt-all))
|
(and (eq org-provide-todo-statistics t)
|
kwd
|
(setq cnt-all (1+ cnt-all))))
|
(when (or (and (member org-provide-todo-statistics '(t all-headlines))
|
(member kwd org-done-keywords))
|
(and (listp org-provide-todo-statistics)
|
(listp (car org-provide-todo-statistics))
|
(member kwd org-done-keywords)
|
(member kwd (cadr org-provide-todo-statistics)))
|
(and (listp org-provide-todo-statistics)
|
(stringp (car org-provide-todo-statistics))
|
(member kwd org-done-keywords)))
|
(setq cnt-done (1+ cnt-done)))
|
(outline-next-heading)))
|
(setq new
|
(if is-percent
|
(format "[%d%%]" (floor (* 100.0 cnt-done)
|
(max 1 cnt-all)))
|
(format "[%d/%d]" cnt-done cnt-all))
|
ndel (- (match-end 0) checkbox-beg))
|
(goto-char checkbox-beg)
|
(insert new)
|
(delete-region (point) (+ (point) ndel))
|
(when org-auto-align-tags (org-fix-tags-on-the-fly)))
|
(when cookie-present
|
(run-hook-with-args 'org-after-todo-statistics-hook
|
cnt-done (- cnt-all cnt-done))))))
|
(run-hooks 'org-todo-statistics-hook)))
|
|
(defvar org-after-todo-statistics-hook nil
|
"Hook that is called after a TODO statistics cookie has been updated.
|
Each function is called with two arguments: the number of not-done entries
|
and the number of done entries.
|
|
For example, the following function, when added to this hook, will switch
|
an entry to DONE when all children are done, and back to TODO when new
|
entries are set to a TODO status. Note that this hook is only called
|
when there is a statistics cookie in the headline!
|
|
(defun org-summary-todo (n-done n-not-done)
|
\"Switch entry to DONE when all subentries are done, to TODO otherwise.\"
|
(let (org-log-done org-log-states) ; turn off logging
|
(org-todo (if (= n-not-done 0) \"DONE\" \"TODO\"))))
|
")
|
|
(defvar org-todo-statistics-hook nil
|
"Hook that is run whenever Org thinks TODO statistics should be updated.
|
This hook runs even if there is no statistics cookie present, in which case
|
`org-after-todo-statistics-hook' would not run.")
|
|
(defun org-todo-trigger-tag-changes (state)
|
"Apply the changes defined in `org-todo-state-tags-triggers'."
|
(let ((l org-todo-state-tags-triggers)
|
changes)
|
(when (or (not state) (equal state ""))
|
(setq changes (append changes (cdr (assoc "" l)))))
|
(when (and (stringp state) (> (length state) 0))
|
(setq changes (append changes (cdr (assoc state l)))))
|
(when (member state org-not-done-keywords)
|
(setq changes (append changes (cdr (assq 'todo l)))))
|
(when (member state org-done-keywords)
|
(setq changes (append changes (cdr (assq 'done l)))))
|
(dolist (c changes)
|
(org-toggle-tag (car c) (if (cdr c) 'on 'off)))))
|
|
(defun org-local-logging (value)
|
"Get logging settings from a property VALUE."
|
;; Directly set the variables, they are already local.
|
(setq org-log-done nil
|
org-log-repeat nil
|
org-todo-log-states nil)
|
(dolist (w (split-string value))
|
(let (a)
|
(cond
|
((setq a (assoc w org-startup-options))
|
(and (member (nth 1 a) '(org-log-done org-log-repeat))
|
(set (nth 1 a) (nth 2 a))))
|
((setq a (org-extract-log-state-settings w))
|
(and (member (car a) org-todo-keywords-1)
|
(push a org-todo-log-states)))))))
|
|
(defun org-get-todo-sequence-head (kwd)
|
"Return the head of the TODO sequence to which KWD belongs.
|
If KWD is not set, check if there is a text property remembering the
|
right sequence."
|
(let (p)
|
(cond
|
((not kwd)
|
(or (get-text-property (point-at-bol) 'org-todo-head)
|
(progn
|
(setq p (next-single-property-change (point-at-bol) 'org-todo-head
|
nil (point-at-eol)))
|
(get-text-property p 'org-todo-head))))
|
((not (member kwd org-todo-keywords-1))
|
(car org-todo-keywords-1))
|
(t (nth 2 (assoc kwd org-todo-kwd-alist))))))
|
|
(defun org-fast-todo-selection ()
|
"Fast TODO keyword selection with single keys.
|
Returns the new TODO keyword, or nil if no state change should occur."
|
(let* ((fulltable org-todo-key-alist)
|
(done-keywords org-done-keywords) ;; needed for the faces.
|
(maxlen (apply 'max (mapcar
|
(lambda (x)
|
(if (stringp (car x)) (string-width (car x)) 0))
|
fulltable)))
|
(expert nil)
|
(fwidth (+ maxlen 3 1 3))
|
(ncol (/ (- (window-width) 4) fwidth))
|
tg cnt e c tbl
|
groups ingroup)
|
(save-excursion
|
(save-window-excursion
|
(if expert
|
(set-buffer (get-buffer-create " *Org todo*"))
|
(org-switch-to-buffer-other-window (get-buffer-create " *Org todo*")))
|
(erase-buffer)
|
(setq-local org-done-keywords done-keywords)
|
(setq tbl fulltable cnt 0)
|
(while (setq e (pop tbl))
|
(cond
|
((equal e '(:startgroup))
|
(push '() groups) (setq ingroup t)
|
(unless (= cnt 0)
|
(setq cnt 0)
|
(insert "\n"))
|
(insert "{ "))
|
((equal e '(:endgroup))
|
(setq ingroup nil cnt 0)
|
(insert "}\n"))
|
((equal e '(:newline))
|
(unless (= cnt 0)
|
(setq cnt 0)
|
(insert "\n")
|
(setq e (car tbl))
|
(while (equal (car tbl) '(:newline))
|
(insert "\n")
|
(setq tbl (cdr tbl)))))
|
(t
|
(setq tg (car e) c (cdr e))
|
(when ingroup (push tg (car groups)))
|
(setq tg (org-add-props tg nil 'face
|
(org-get-todo-face tg)))
|
(when (and (= cnt 0) (not ingroup)) (insert " "))
|
(insert "[" c "] " tg (make-string
|
(- fwidth 4 (length tg)) ?\ ))
|
(when (= (setq cnt (1+ cnt)) ncol)
|
(insert "\n")
|
(when ingroup (insert " "))
|
(setq cnt 0)))))
|
(insert "\n")
|
(goto-char (point-min))
|
(unless expert (org-fit-window-to-buffer))
|
(message "[a-z..]:Set [SPC]:clear")
|
(setq c (let ((inhibit-quit t)) (read-char-exclusive)))
|
(cond
|
((or (= c ?\C-g)
|
(and (= c ?q) (not (rassoc c fulltable))))
|
(setq quit-flag t))
|
((= c ?\ ) nil)
|
((setq e (rassoc c fulltable) tg (car e))
|
tg)
|
(t (setq quit-flag t)))))))
|
|
(defun org-entry-is-todo-p ()
|
(member (org-get-todo-state) org-not-done-keywords))
|
|
(defun org-entry-is-done-p ()
|
(member (org-get-todo-state) org-done-keywords))
|
|
(defun org-get-todo-state ()
|
"Return the TODO keyword of the current subtree."
|
(save-excursion
|
(org-back-to-heading t)
|
(and (let ((case-fold-search nil)) (looking-at org-todo-line-regexp))
|
(match-end 2)
|
(match-string 2))))
|
|
(defun org-at-date-range-p (&optional inactive-ok)
|
"Non-nil if point is inside a date range.
|
|
When optional argument INACTIVE-OK is non-nil, also consider
|
inactive time ranges.
|
|
When this function returns a non-nil value, match data is set
|
according to `org-tr-regexp-both' or `org-tr-regexp', depending
|
on INACTIVE-OK."
|
(interactive)
|
(save-excursion
|
(catch 'exit
|
(let ((pos (point)))
|
(skip-chars-backward "^[<\r\n")
|
(skip-chars-backward "<[")
|
(and (looking-at (if inactive-ok org-tr-regexp-both org-tr-regexp))
|
(>= (match-end 0) pos)
|
(throw 'exit t))
|
(skip-chars-backward "^<[\r\n")
|
(skip-chars-backward "<[")
|
(and (looking-at (if inactive-ok org-tr-regexp-both org-tr-regexp))
|
(>= (match-end 0) pos)
|
(throw 'exit t)))
|
nil)))
|
|
(defun org-get-repeat (&optional timestamp)
|
"Check if there is a time-stamp with repeater in this entry.
|
|
Return the repeater, as a string, or nil. Also return nil when
|
this function is called before first heading.
|
|
When optional argument TIMESTAMP is a string, extract the
|
repeater from there instead."
|
(save-match-data
|
(cond (timestamp
|
(and (string-match org-repeat-re timestamp)
|
(match-string-no-properties 1 timestamp)))
|
((org-before-first-heading-p) nil)
|
(t
|
(save-excursion
|
(org-back-to-heading t)
|
(let ((end (org-entry-end-position)))
|
(catch :repeat
|
(while (re-search-forward org-repeat-re end t)
|
(when (save-match-data (org-at-timestamp-p 'agenda))
|
(throw :repeat (match-string-no-properties 1)))))))))))
|
|
(defvar org-last-changed-timestamp)
|
(defvar org-last-inserted-timestamp)
|
(defvar org-log-post-message)
|
(defvar org-log-note-purpose)
|
(defvar org-log-note-how nil)
|
(defvar org-log-note-extra)
|
(defun org-auto-repeat-maybe (done-word)
|
"Check if the current headline contains a repeated time-stamp.
|
|
If yes, set TODO state back to what it was and change the base date
|
of repeating deadline/scheduled time stamps to new date.
|
|
This function is run automatically after each state change to a DONE state."
|
(let* ((repeat (org-get-repeat))
|
(aa (assoc org-last-state org-todo-kwd-alist))
|
(interpret (nth 1 aa))
|
(head (nth 2 aa))
|
(whata '(("h" . hour) ("d" . day) ("m" . month) ("y" . year)))
|
(msg "Entry repeats: ")
|
(org-log-done nil)
|
(org-todo-log-states nil)
|
(end (copy-marker (org-entry-end-position))))
|
(unwind-protect
|
(when (and repeat (not (zerop (string-to-number (substring repeat 1)))))
|
(when (eq org-log-repeat t) (setq org-log-repeat 'state))
|
(let ((to-state (or (org-entry-get nil "REPEAT_TO_STATE" 'selective)
|
org-todo-repeat-to-state)))
|
(org-todo (cond
|
((and to-state (member to-state org-todo-keywords-1))
|
to-state)
|
((eq interpret 'type) org-last-state)
|
(head)
|
(t 'none))))
|
(org-back-to-heading t)
|
(org-add-planning-info nil nil 'closed)
|
;; When `org-log-repeat' is non-nil or entry contains
|
;; a clock, set LAST_REPEAT property.
|
(when (or org-log-repeat
|
(catch :clock
|
(save-excursion
|
(while (re-search-forward org-clock-line-re end t)
|
(when (org-at-clock-log-p) (throw :clock t))))))
|
(org-entry-put nil "LAST_REPEAT" (format-time-string
|
(org-time-stamp-format t t)
|
(current-time))))
|
(when org-log-repeat
|
(if (or (memq 'org-add-log-note (default-value 'post-command-hook))
|
(memq 'org-add-log-note post-command-hook))
|
;; We are already setup for some record.
|
(when (eq org-log-repeat 'note)
|
;; Make sure we take a note, not only a time stamp.
|
(setq org-log-note-how 'note))
|
;; Set up for taking a record.
|
(org-add-log-setup 'state
|
(or done-word (car org-done-keywords))
|
org-last-state
|
org-log-repeat)))
|
(let ((planning-re (regexp-opt
|
(list org-scheduled-string org-deadline-string))))
|
(while (re-search-forward org-ts-regexp end t)
|
(let* ((ts (match-string 0))
|
(planning? (org-at-planning-p))
|
(type (if (not planning?) "Plain:"
|
(save-excursion
|
(re-search-backward
|
planning-re (line-beginning-position) t)
|
(match-string 0)))))
|
(cond
|
;; Ignore fake time-stamps (e.g., within comments).
|
((not (org-at-timestamp-p 'agenda)))
|
;; Time-stamps without a repeater are usually
|
;; skipped. However, a SCHEDULED time-stamp without
|
;; one is removed, as they are no longer relevant.
|
((not (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)"
|
ts))
|
(when (equal type org-scheduled-string)
|
(org-remove-timestamp-with-keyword type)))
|
(t
|
(let ((n (string-to-number (match-string 2 ts)))
|
(what (match-string 3 ts)))
|
(when (equal what "w") (setq n (* n 7) what "d"))
|
(when (and (equal what "h")
|
(not (string-match-p "[0-9]\\{1,2\\}:[0-9]\\{2\\}"
|
ts)))
|
(user-error
|
"Cannot repeat in Repeat in %d hour(s) because no hour \
|
has been set"
|
n))
|
;; Preparation, see if we need to modify the start
|
;; date for the change.
|
(when (match-end 1)
|
(let ((time (save-match-data
|
(org-time-string-to-time ts))))
|
(cond
|
((equal (match-string 1 ts) ".")
|
;; Shift starting date to today
|
(org-timestamp-change
|
(- (org-today) (time-to-days time))
|
'day))
|
((equal (match-string 1 ts) "+")
|
(let ((nshiftmax 10)
|
(nshift 0))
|
(while (or (= nshift 0)
|
(not (time-less-p (current-time) time)))
|
(when (= (cl-incf nshift) nshiftmax)
|
(or (y-or-n-p
|
(format "%d repeater intervals were not \
|
enough to shift date past today. Continue? "
|
nshift))
|
(user-error "Abort")))
|
(org-timestamp-change n (cdr (assoc what whata)))
|
(org-in-regexp org-ts-regexp3)
|
(setq ts (match-string 1))
|
(setq time
|
(save-match-data
|
(org-time-string-to-time ts)))))
|
(org-timestamp-change (- n) (cdr (assoc what whata)))
|
;; Rematch, so that we have everything in place
|
;; for the real shift.
|
(org-in-regexp org-ts-regexp3)
|
(setq ts (match-string 1))
|
(string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)"
|
ts)))))
|
(save-excursion
|
(org-timestamp-change n (cdr (assoc what whata)) nil t))
|
(setq msg
|
(concat
|
msg type " " org-last-changed-timestamp " "))))))))
|
(setq org-log-post-message msg)
|
(message "%s" msg))
|
(set-marker end nil))))
|
|
(defun org-show-todo-tree (arg)
|
"Make a compact tree which shows all headlines marked with TODO.
|
The tree will show the lines where the regexp matches, and all higher
|
headlines above the match.
|
With a `\\[universal-argument]' prefix, prompt for a regexp to match.
|
With a numeric prefix N, construct a sparse tree for the Nth element
|
of `org-todo-keywords-1'."
|
(interactive "P")
|
(let ((case-fold-search nil)
|
(kwd-re
|
(cond ((null arg) org-not-done-regexp)
|
((equal arg '(4))
|
(let ((kwd
|
(completing-read "Keyword (or KWD1|KWD2|...): "
|
(mapcar #'list org-todo-keywords-1))))
|
(concat "\\("
|
(mapconcat 'identity (org-split-string kwd "|") "\\|")
|
"\\)\\>")))
|
((<= (prefix-numeric-value arg) (length org-todo-keywords-1))
|
(regexp-quote (nth (1- (prefix-numeric-value arg))
|
org-todo-keywords-1)))
|
(t (user-error "Invalid prefix argument: %s" arg)))))
|
(message "%d TODO entries found"
|
(org-occur (concat "^" org-outline-regexp " *" kwd-re )))))
|
|
(defun org--deadline-or-schedule (arg type time)
|
"Insert DEADLINE or SCHEDULE information in current entry.
|
TYPE is either `deadline' or `scheduled'. See `org-deadline' or
|
`org-schedule' for information about ARG and TIME arguments."
|
(let* ((deadline? (eq type 'deadline))
|
(keyword (if deadline? org-deadline-string org-scheduled-string))
|
(log (if deadline? org-log-redeadline org-log-reschedule))
|
(old-date (org-entry-get nil (if deadline? "DEADLINE" "SCHEDULED")))
|
(old-date-time (and old-date (org-time-string-to-time old-date)))
|
;; Save repeater cookie from either TIME or current scheduled
|
;; time stamp. We are going to insert it back at the end of
|
;; the process.
|
(repeater (or (and (org-string-nw-p time)
|
;; We use `org-repeat-re' because we need
|
;; to tell the difference between a real
|
;; repeater and a time delta, e.g. "+2d".
|
(string-match org-repeat-re time)
|
(match-string 1 time))
|
(and (org-string-nw-p old-date)
|
(string-match "\\([.+-]+[0-9]+[hdwmy]\
|
\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\)"
|
old-date)
|
(match-string 1 old-date)))))
|
(pcase arg
|
(`(4)
|
(when (and old-date log)
|
(org-add-log-setup (if deadline? 'deldeadline 'delschedule)
|
nil old-date log))
|
(org-remove-timestamp-with-keyword keyword)
|
(message (if deadline? "Item no longer has a deadline."
|
"Item is no longer scheduled.")))
|
(`(16)
|
(save-excursion
|
(org-back-to-heading t)
|
(let ((regexp (if deadline? org-deadline-time-regexp
|
org-scheduled-time-regexp)))
|
(if (not (re-search-forward regexp (line-end-position 2) t))
|
(user-error (if deadline? "No deadline information to update"
|
"No scheduled information to update"))
|
(let* ((rpl0 (match-string 1))
|
(rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0))
|
(msg (if deadline? "Warn starting from" "Delay until")))
|
(replace-match
|
(concat keyword
|
" <" rpl
|
(format " -%dd"
|
(abs (- (time-to-days
|
(save-match-data
|
(org-read-date
|
nil t nil msg old-date-time)))
|
(time-to-days old-date-time))))
|
">") t t))))))
|
(_
|
(org-add-planning-info type time 'closed)
|
(when (and old-date
|
log
|
(not (equal old-date org-last-inserted-timestamp)))
|
(org-add-log-setup (if deadline? 'redeadline 'reschedule)
|
org-last-inserted-timestamp
|
old-date
|
log))
|
(when repeater
|
(save-excursion
|
(org-back-to-heading t)
|
(when (re-search-forward
|
(concat keyword " " org-last-inserted-timestamp)
|
(line-end-position 2)
|
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 (if deadline? "Deadline on %s" "Scheduled to %s")
|
org-last-inserted-timestamp)))))
|
|
(defun org-deadline (arg &optional time)
|
"Insert the \"DEADLINE:\" string with a timestamp to make a deadline.
|
With one universal prefix argument, remove any deadline from the item.
|
With two universal prefix arguments, prompt for a warning delay.
|
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")
|
(if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
|
(org-map-entries
|
(lambda () (org--deadline-or-schedule arg 'deadline time))
|
nil
|
(if (eq org-loop-over-headlines-in-active-region 'start-level)
|
'region-start-level
|
'region)
|
(lambda () (when (org-invisible-p) (org-end-of-subtree nil t))))
|
(org--deadline-or-schedule arg 'deadline time)))
|
|
(defun org-schedule (arg &optional time)
|
"Insert the SCHEDULED: string with a timestamp to schedule a TODO item.
|
With one universal prefix argument, remove any scheduling date from the item.
|
With two universal prefix arguments, prompt for a delay cookie.
|
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")
|
(if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
|
(org-map-entries
|
(lambda () (org--deadline-or-schedule arg 'scheduled time))
|
nil
|
(if (eq org-loop-over-headlines-in-active-region 'start-level)
|
'region-start-level
|
'region)
|
(lambda () (when (org-invisible-p) (org-end-of-subtree nil t))))
|
(org--deadline-or-schedule arg 'scheduled time)))
|
|
(defun org-get-scheduled-time (pom &optional inherit)
|
"Get the scheduled time as a time tuple, of a format suitable
|
for calling org-schedule with, or if there is no scheduling,
|
returns nil."
|
(let ((time (org-entry-get pom "SCHEDULED" inherit)))
|
(when time
|
(apply 'encode-time (org-parse-time-string time)))))
|
|
(defun org-get-deadline-time (pom &optional inherit)
|
"Get the deadline as a time tuple, of a format suitable for
|
calling org-deadline with, or if there is no scheduling, returns
|
nil."
|
(let ((time (org-entry-get pom "DEADLINE" inherit)))
|
(when time
|
(apply 'encode-time (org-parse-time-string time)))))
|
|
(defun org-remove-timestamp-with-keyword (keyword)
|
"Remove all time stamps with KEYWORD in the current entry."
|
(let ((re (concat "\\<" (regexp-quote keyword) " +<[^>\n]+>[ \t]*"))
|
beg)
|
(save-excursion
|
(org-back-to-heading t)
|
(setq beg (point))
|
(outline-next-heading)
|
(while (re-search-backward re beg t)
|
(replace-match "")
|
(if (and (string-match "\\S-" (buffer-substring (point-at-bol) (point)))
|
(equal (char-before) ?\ ))
|
(backward-delete-char 1)
|
(when (string-match "^[ \t]*$" (buffer-substring
|
(point-at-bol) (point-at-eol)))
|
(delete-region (point-at-bol)
|
(min (point-max) (1+ (point-at-eol))))))))))
|
|
(defvar org-time-was-given) ; dynamically scoped parameter
|
(defvar org-end-time-was-given) ; dynamically scoped parameter
|
|
(defun org-at-planning-p ()
|
"Non-nil when point is on a planning info line."
|
;; This is as accurate and faster than `org-element-at-point' since
|
;; planning info location is fixed in the section.
|
(org-with-wide-buffer
|
(beginning-of-line)
|
(and (looking-at-p org-planning-line-re)
|
(eq (point)
|
(ignore-errors
|
(if (and (featurep 'org-inlinetask) (org-inlinetask-in-task-p))
|
(org-back-to-heading t)
|
(org-with-limited-levels (org-back-to-heading t)))
|
(line-beginning-position 2))))))
|
|
(defun org-add-planning-info (what &optional time &rest remove)
|
"Insert new timestamp with keyword in the planning line.
|
WHAT indicates what kind of time stamp to add. It is a symbol
|
among `closed', `deadline', `scheduled' and nil. TIME indicates
|
the time to use. If none 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."
|
(let (org-time-was-given org-end-time-was-given default-time default-input)
|
(catch 'exit
|
(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)
|
(let ((end (save-excursion (outline-next-heading) (point))) ts)
|
(when (re-search-forward (if (eq what 'scheduled)
|
org-scheduled-time-regexp
|
org-deadline-time-regexp)
|
end t)
|
(setq ts (match-string 1)
|
default-time (apply 'encode-time (org-parse-time-string ts))
|
default-input (and ts (org-get-compact-tod ts)))))))
|
(when what
|
(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)))))
|
|
(org-with-wide-buffer
|
(org-back-to-heading t)
|
(forward-line)
|
(unless (bolp) (insert "\n"))
|
(cond ((looking-at-p org-planning-line-re)
|
;; Move to current indentation.
|
(skip-chars-forward " \t")
|
;; Check if we have to remove something.
|
(dolist (type (if what (cons what remove) remove))
|
(save-excursion
|
(when (re-search-forward
|
(cl-case type
|
(closed org-closed-time-regexp)
|
(deadline org-deadline-time-regexp)
|
(scheduled org-scheduled-time-regexp)
|
(otherwise
|
(error "Invalid planning type: %s" type)))
|
(line-end-position) t)
|
;; Delete until next keyword or end of line.
|
(delete-region
|
(match-beginning 0)
|
(if (re-search-forward org-keyword-time-not-clock-regexp
|
(line-end-position)
|
t)
|
(match-beginning 0)
|
(line-end-position))))))
|
;; If there is nothing more to add and no more keyword
|
;; is left, remove the line completely.
|
(if (and (looking-at-p "[ \t]*$") (not what))
|
(delete-region (line-beginning-position)
|
(line-beginning-position 2))
|
;; If we removed last keyword, do not leave trailing
|
;; white space at the end of line.
|
(let ((p (point)))
|
(save-excursion
|
(end-of-line)
|
(unless (= (skip-chars-backward " \t" p) 0)
|
(delete-region (point) (line-end-position)))))))
|
((not what) (throw 'exit nil)) ; Nothing to do.
|
(t (insert-before-markers "\n")
|
(backward-char 1)
|
(when org-adapt-indentation
|
(indent-to-column (1+ (org-outline-level))))))
|
(when what
|
;; Insert planning keyword.
|
(insert (cl-case what
|
(closed org-closed-string)
|
(deadline org-deadline-string)
|
(scheduled org-scheduled-string)
|
(otherwise (error "Invalid planning type: %s" what)))
|
" ")
|
;; Insert associated timestamp.
|
(let ((ts (org-insert-time-stamp
|
time
|
(or org-time-was-given
|
(and (eq what 'closed) org-log-done-with-time))
|
(eq what 'closed)
|
nil nil (list org-end-time-was-given))))
|
(unless (eolp) (insert " "))
|
ts))))))
|
|
(defvar org-log-note-marker (make-marker)
|
"Marker pointing at the entry where the note is to be inserted.")
|
(defvar org-log-note-purpose nil)
|
(defvar org-log-note-state nil)
|
(defvar org-log-note-previous-state nil)
|
(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 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.")
|
|
(defun org-add-note ()
|
"Add a note to the current entry.
|
This is done in the same way as adding a state change note."
|
(interactive)
|
(org-add-log-setup 'note))
|
|
(defun org-log-beginning (&optional create)
|
"Return expected start of log notes in current entry.
|
When optional argument CREATE is non-nil, the function creates
|
a drawer to store notes, if necessary. Returned position ignores
|
narrowing."
|
(org-with-wide-buffer
|
(let ((drawer (org-log-into-drawer)))
|
(cond
|
(drawer
|
(org-end-of-meta-data)
|
(let ((regexp (concat "^[ \t]*:" (regexp-quote drawer) ":[ \t]*$"))
|
(end (if (org-at-heading-p) (point)
|
(save-excursion (outline-next-heading) (point))))
|
(case-fold-search t))
|
(catch 'exit
|
;; Try to find existing drawer.
|
(while (re-search-forward regexp end t)
|
(let ((element (org-element-at-point)))
|
(when (eq (org-element-type element) 'drawer)
|
(let ((cend (org-element-property :contents-end element)))
|
(when (and (not org-log-states-order-reversed) cend)
|
(goto-char cend)))
|
(throw 'exit nil))))
|
;; No drawer found. Create one, if permitted.
|
(when create
|
(unless (bolp) (insert "\n"))
|
(let ((beg (point)))
|
(insert ":" drawer ":\n:END:\n")
|
(org-indent-region beg (point)))
|
(end-of-line -1)))))
|
(t
|
(org-end-of-meta-data org-log-state-notes-insert-after-drawers)
|
(skip-chars-forward " \t\n")
|
(beginning-of-line)
|
(unless org-log-states-order-reversed
|
(org-skip-over-state-notes)
|
(skip-chars-backward " \t\n")
|
(forward-line)))))
|
(if (bolp) (point) (line-beginning-position 2))))
|
|
(defun org-add-log-setup (&optional purpose state prev-state how extra)
|
"Set up the post command hook to take a note.
|
If this is about to TODO state change, the new state is expected in STATE.
|
HOW is an indicator what kind of note should be created.
|
EXTRA is additional text that will be inserted into the notes buffer."
|
(move-marker org-log-note-marker (point))
|
(setq org-log-note-purpose purpose
|
org-log-note-state state
|
org-log-note-previous-state prev-state
|
org-log-note-how how
|
org-log-note-extra extra
|
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."
|
(when (ignore-errors (goto-char (org-in-item-p)))
|
(let* ((struct (org-list-struct))
|
(prevs (org-list-prevs-alist struct))
|
(regexp
|
(concat "[ \t]*- +"
|
(replace-regexp-in-string
|
" +" " +"
|
(org-replace-escapes
|
(regexp-quote (cdr (assq 'state org-log-note-headings)))
|
`(("%d" . ,org-ts-regexp-inactive)
|
("%D" . ,org-ts-regexp)
|
("%s" . "\\(?:\"\\S-+\"\\)?")
|
("%S" . "\\(?:\"\\S-+\"\\)?")
|
("%t" . ,org-ts-regexp-inactive)
|
("%T" . ,org-ts-regexp)
|
("%u" . ".*?")
|
("%U" . ".*?")))))))
|
(while (looking-at-p regexp)
|
(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."
|
(remove-hook 'post-command-hook 'org-add-log-note)
|
(setq org-log-note-window-configuration (current-window-configuration))
|
(delete-other-windows)
|
(move-marker org-log-note-return-to (point))
|
(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)
|
(if (memq org-log-note-how '(time state))
|
(org-store-log-note)
|
(let ((org-inhibit-startup t)) (org-mode))
|
(insert (format "# Insert note for %s.
|
# Finish with C-c C-c, or cancel with C-c C-k.\n\n"
|
(cond
|
((eq org-log-note-purpose 'clock-out) "stopped clock")
|
((eq org-log-note-purpose 'done) "closed todo item")
|
((eq org-log-note-purpose 'state)
|
(format "state change from \"%s\" to \"%s\""
|
(or org-log-note-previous-state "")
|
(or org-log-note-state "")))
|
((eq org-log-note-purpose 'reschedule)
|
"rescheduling")
|
((eq org-log-note-purpose 'delschedule)
|
"no longer scheduled")
|
((eq org-log-note-purpose 'redeadline)
|
"changing deadline")
|
((eq org-log-note-purpose 'deldeadline)
|
"removing deadline")
|
((eq org-log-note-purpose 'refile)
|
"refiling")
|
((eq org-log-note-purpose 'note)
|
"this entry")
|
(t (error "This should not happen")))))
|
(when org-log-note-extra (insert org-log-note-extra))
|
(setq-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 ()
|
"Finish taking a log note, and insert it to where it belongs."
|
(let ((txt (prog1 (buffer-string)
|
(kill-buffer)))
|
(note (cdr (assq org-log-note-purpose org-log-note-headings)))
|
lines)
|
(while (string-match "\\`# .*\n[ \t\n]*" txt)
|
(setq txt (replace-match "" t t txt)))
|
(when (string-match "\\s-+\\'" txt)
|
(setq txt (replace-match "" t t txt)))
|
(setq lines (and (not (equal "" txt)) (org-split-string txt "\n")))
|
(when (org-string-nw-p note)
|
(setq note
|
(org-replace-escapes
|
note
|
(list (cons "%u" (user-login-name))
|
(cons "%U" user-full-name)
|
(cons "%t" (format-time-string
|
(org-time-stamp-format 'long 'inactive)
|
org-log-note-effective-time))
|
(cons "%T" (format-time-string
|
(org-time-stamp-format 'long nil)
|
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" (cond
|
((not org-log-note-state) "")
|
((string-match-p org-ts-regexp
|
org-log-note-state)
|
(format "\"[%s]\""
|
(substring org-log-note-state 1 -1)))
|
(t (format "\"%s\"" org-log-note-state))))
|
(cons "%S"
|
(cond
|
((not org-log-note-previous-state) "")
|
((string-match-p org-ts-regexp
|
org-log-note-previous-state)
|
(format "\"[%s]\""
|
(substring
|
org-log-note-previous-state 1 -1)))
|
(t (format "\"%s\""
|
org-log-note-previous-state)))))))
|
(when lines (setq note (concat note " \\\\")))
|
(push note lines))
|
(when (and lines (not org-note-abort))
|
(with-current-buffer (marker-buffer org-log-note-marker)
|
(org-with-wide-buffer
|
;; Find location for the new note.
|
(goto-char org-log-note-marker)
|
(set-marker org-log-note-marker nil)
|
;; Note associated to a clock is to be located right after
|
;; the clock. Do not move point.
|
(unless (eq org-log-note-purpose 'clock-out)
|
(goto-char (org-log-beginning t)))
|
;; Make sure point is at the beginning of an empty line.
|
(cond ((not (bolp)) (let ((inhibit-read-only t)) (insert "\n")))
|
((looking-at "[ \t]*\\S-") (save-excursion (insert "\n"))))
|
;; In an existing list, add a new item at the top level.
|
;; Otherwise, indent line like a regular one.
|
(let ((itemp (org-in-item-p)))
|
(if itemp
|
(indent-line-to
|
(let ((struct (save-excursion
|
(goto-char itemp) (org-list-struct))))
|
(org-list-get-ind (org-list-get-top-point struct) struct)))
|
(org-indent-line)))
|
(insert (org-list-bullet-string "-") (pop lines))
|
(let ((ind (org-list-item-body-column (line-beginning-position))))
|
(dolist (line lines)
|
(insert "\n")
|
(indent-line-to ind)
|
(insert line)))
|
(message "Note stored")
|
(org-back-to-heading t)
|
(org-cycle-hide-drawers 'children))
|
;; Fix `buffer-undo-list' when `org-store-log-note' is called
|
;; from within `org-add-log-note' because `buffer-undo-list'
|
;; is then modified outside of `org-with-remote-undo'.
|
(when (eq this-command 'org-agenda-todo)
|
(setcdr buffer-undo-list (cddr buffer-undo-list))))))
|
;; Don't add undo information when called from `org-agenda-todo'.
|
(let ((buffer-undo-list (eq this-command 'org-agenda-todo)))
|
(set-window-configuration org-log-note-window-configuration)
|
(with-current-buffer (marker-buffer org-log-note-return-to)
|
(goto-char org-log-note-return-to))
|
(move-marker org-log-note-return-to nil)
|
(when org-log-post-message (message "%s" org-log-post-message))))
|
|
(defun org-remove-empty-drawer-at (pos)
|
"Remove an empty drawer at position POS.
|
POS may also be a marker."
|
(with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer))
|
(org-with-wide-buffer
|
(goto-char pos)
|
(let ((drawer (org-element-at-point)))
|
(when (and (memq (org-element-type drawer) '(drawer property-drawer))
|
(not (org-element-property :contents-begin drawer)))
|
(delete-region (org-element-property :begin drawer)
|
(progn (goto-char (org-element-property :end drawer))
|
(skip-chars-backward " \r\t\n")
|
(forward-line)
|
(point))))))))
|
|
(defvar org-ts-type nil)
|
(defun org-sparse-tree (&optional arg type)
|
"Create a sparse tree, prompt for the details.
|
This command can create sparse trees. You first need to select the type
|
of match used to create the tree:
|
|
t Show all TODO entries.
|
T Show entries with a specific TODO keyword.
|
m Show entries selected by a tags/property match.
|
p Enter a property name and its value (both with completion on existing
|
names/values) and show entries with that property.
|
r Show entries matching a regular expression (`/' can be used as well).
|
b Show deadlines and scheduled items before a date.
|
a Show deadlines and scheduled items after a date.
|
d Show deadlines due within `org-deadline-warning-days'.
|
D Show deadlines and scheduled items between a date range."
|
(interactive "P")
|
(setq type (or type org-sparse-tree-default-date-type))
|
(setq org-ts-type type)
|
(message "Sparse tree: [r]egexp [t]odo [T]odo-kwd [m]atch [p]roperty
|
\[d]eadlines [b]efore-date [a]fter-date [D]ates range
|
\[c]ycle through date types: %s"
|
(cl-case type
|
(all "all timestamps")
|
(scheduled "only scheduled")
|
(deadline "only deadline")
|
(active "only active timestamps")
|
(inactive "only inactive timestamps")
|
(closed "with a closed time-stamp")
|
(otherwise "scheduled/deadline")))
|
(let ((answer (read-char-exclusive)))
|
(cl-case answer
|
(?c
|
(org-sparse-tree
|
arg
|
(cadr
|
(memq type '(nil all scheduled deadline active inactive closed)))))
|
(?d (call-interactively 'org-check-deadlines))
|
(?b (call-interactively 'org-check-before-date))
|
(?a (call-interactively 'org-check-after-date))
|
(?D (call-interactively 'org-check-dates-range))
|
(?t (call-interactively 'org-show-todo-tree))
|
(?T (org-show-todo-tree '(4)))
|
(?m (call-interactively 'org-match-sparse-tree))
|
((?p ?P)
|
(let* ((kwd (completing-read
|
"Property: " (mapcar #'list (org-buffer-property-keys))))
|
(value (completing-read
|
"Value: " (mapcar #'list (org-property-values kwd)))))
|
(unless (string-match "\\`{.*}\\'" value)
|
(setq value (concat "\"" value "\"")))
|
(org-match-sparse-tree arg (concat kwd "=" value))))
|
((?r ?R ?/) (call-interactively 'org-occur))
|
(otherwise (user-error "No such sparse tree command \"%c\"" answer)))))
|
|
(defvar-local org-occur-highlights nil
|
"List of overlays used for occur matches.")
|
(defvar-local org-occur-parameters nil
|
"Parameters of the active org-occur calls.
|
This is a list, each call to org-occur pushes as cons cell,
|
containing the regular expression and the callback, onto the list.
|
The list can contain several entries if `org-occur' has been called
|
several time with the KEEP-PREVIOUS argument. Otherwise, this list
|
will only contain one set of parameters. When the highlights are
|
removed (for example with `C-c C-c', or with the next edit (depending
|
on `org-remove-highlights-with-change'), this variable is emptied
|
as well.")
|
|
(defun org-occur (regexp &optional keep-previous callback)
|
"Make a compact tree which shows all matches of REGEXP.
|
|
The tree will show the lines where the regexp matches, and any other context
|
defined in `org-show-context-detail', which see.
|
|
When optional argument KEEP-PREVIOUS is non-nil, highlighting and exposing
|
done by a previous call to `org-occur' will be kept, to allow stacking of
|
calls to this command.
|
|
Optional argument CALLBACK can be a function of no argument. In this case,
|
it is called with point at the end of the match, match data being set
|
accordingly. Current match is shown only if the return value is non-nil.
|
The function must neither move point nor alter narrowing."
|
(interactive "sRegexp: \nP")
|
(when (equal regexp "")
|
(user-error "Regexp cannot be empty"))
|
(unless keep-previous
|
(org-remove-occur-highlights nil nil t))
|
(push (cons regexp callback) org-occur-parameters)
|
(let ((cnt 0))
|
(save-excursion
|
(goto-char (point-min))
|
(when (or (not keep-previous) ; do not want to keep
|
(not org-occur-highlights)) ; no previous matches
|
;; hide everything
|
(org-overview))
|
(let ((case-fold-search (if (eq org-occur-case-fold-search 'smart)
|
(isearch-no-upper-case-p regexp t)
|
org-occur-case-fold-search)))
|
(while (re-search-forward regexp nil t)
|
(when (or (not callback)
|
(save-match-data (funcall callback)))
|
(setq cnt (1+ cnt))
|
(when org-highlight-sparse-tree-matches
|
(org-highlight-new-match (match-beginning 0) (match-end 0)))
|
(org-show-context 'occur-tree)))))
|
(when org-remove-highlights-with-change
|
(add-hook 'before-change-functions 'org-remove-occur-highlights
|
nil 'local))
|
(unless org-sparse-tree-open-archived-trees
|
(org-hide-archived-subtrees (point-min) (point-max)))
|
(run-hooks 'org-occur-hook)
|
(when (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.
|
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)
|
(user-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)
|
(user-error "No more matches"))))
|
|
(defun org-show-context (&optional key)
|
"Make sure point and context are visible.
|
Optional argument KEY, when non-nil, is a symbol. See
|
`org-show-context-detail' for allowed values and how much is to
|
be shown."
|
(org-show-set-visibility
|
(cond ((symbolp org-show-context-detail) org-show-context-detail)
|
((cdr (assq key org-show-context-detail)))
|
(t (cdr (assq 'default org-show-context-detail))))))
|
|
(defun org-show-set-visibility (detail)
|
"Set visibility around point according to DETAIL.
|
DETAIL is either nil, `minimal', `local', `ancestors', `lineage',
|
`tree', `canonical' or t. See `org-show-context-detail' for more
|
information."
|
;; Show current heading and possibly its entry, following headline
|
;; or all children.
|
(if (and (org-at-heading-p) (not (eq detail 'local)))
|
(org-flag-heading nil)
|
(org-show-entry)
|
;; If point is hidden within a drawer or a block, make sure to
|
;; expose it.
|
(dolist (o (overlays-at (point)))
|
(when (memq (overlay-get o 'invisible) '(org-hide-block outline))
|
(delete-overlay o)))
|
(unless (org-before-first-heading-p)
|
(org-with-limited-levels
|
(cl-case detail
|
((tree canonical t) (org-show-children))
|
((nil minimal ancestors))
|
(t (save-excursion
|
(outline-next-heading)
|
(org-flag-heading nil)))))))
|
;; Show all siblings.
|
(when (eq detail 'lineage) (org-show-siblings))
|
;; Show ancestors, possibly with their children.
|
(when (memq detail '(ancestors lineage tree canonical t))
|
(save-excursion
|
(while (org-up-heading-safe)
|
(org-flag-heading nil)
|
(when (memq detail '(canonical t)) (org-show-entry))
|
(when (memq detail '(tree canonical t)) (org-show-children))))))
|
|
(defvar org-reveal-start-hook nil
|
"Hook run before revealing a location.")
|
|
(defun org-reveal (&optional siblings)
|
"Show current entry, hierarchy above it, and the following headline.
|
|
This can be used to show a consistent set of context around
|
locations exposed with `org-show-context'.
|
|
With optional argument SIBLINGS, on each level of the hierarchy all
|
siblings are shown. This repairs the tree structure to what it would
|
look like when opened with hierarchical calls to `org-cycle'.
|
|
With a \\[universal-argument] \\[universal-argument] prefix, \
|
go to the parent and show the entire tree."
|
(interactive "P")
|
(run-hooks 'org-reveal-start-hook)
|
(cond ((equal siblings '(4)) (org-show-set-visibility 'canonical))
|
((equal siblings '(16))
|
(save-excursion
|
(when (org-up-heading-safe)
|
(org-show-subtree)
|
(run-hook-with-args 'org-cycle-hook 'subtree))))
|
(t (org-show-set-visibility 'lineage))))
|
|
(defun org-highlight-new-match (beg end)
|
"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)
|
"Remove the occur highlights from the buffer.
|
BEG and END are ignored. If NOREMOVE is nil, remove this function
|
from the `before-change-functions' in the current buffer."
|
(interactive)
|
(unless org-inhibit-highlight-removal
|
(mapc #'delete-overlay org-occur-highlights)
|
(setq org-occur-highlights nil)
|
(setq org-occur-parameters nil)
|
(unless noremove
|
(remove-hook 'before-change-functions
|
'org-remove-occur-highlights 'local))))
|
|
;;;; Priorities
|
|
(defvar org-priority-regexp ".*?\\(\\[#\\([A-Z0-9]\\)\\] ?\\)"
|
"Regular expression matching the priority indicator.")
|
|
(defvar org-remove-priority-next-time nil)
|
|
(defun org-priority-up ()
|
"Increase the priority of the current item."
|
(interactive)
|
(org-priority 'up))
|
|
(defun org-priority-down ()
|
"Decrease the priority of the current item."
|
(interactive)
|
(org-priority 'down))
|
|
(defun org-priority (&optional action _show)
|
"Change the priority of an item.
|
ACTION can be `set', `up', `down', or a character."
|
(interactive "P")
|
(if (equal action '(4))
|
(org-show-priority)
|
(unless org-enable-priority-commands
|
(user-error "Priority commands are disabled"))
|
(setq action (or action 'set))
|
(let (current new news have remove)
|
(save-excursion
|
(org-back-to-heading t)
|
(when (looking-at org-priority-regexp)
|
(setq current (string-to-char (match-string 2))
|
have t))
|
(cond
|
((eq action 'remove)
|
(setq remove t new ?\ ))
|
((or (eq action 'set)
|
(integerp action))
|
(if (not (eq action 'set))
|
(setq new action)
|
(message "Priority %c-%c, SPC to remove: "
|
org-highest-priority org-lowest-priority)
|
(save-match-data
|
(setq new (read-char-exclusive))))
|
(when (and (= (upcase org-highest-priority) org-highest-priority)
|
(= (upcase org-lowest-priority) org-lowest-priority))
|
(setq new (upcase new)))
|
(cond ((equal new ?\ ) (setq remove t))
|
((or (< (upcase new) org-highest-priority) (> (upcase new) org-lowest-priority))
|
(user-error "Priority must be between `%c' and `%c'"
|
org-highest-priority org-lowest-priority))))
|
((eq action 'up)
|
(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)
|
(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 (user-error "Invalid action")))
|
(when (or (< (upcase new) org-highest-priority)
|
(> (upcase new) org-lowest-priority))
|
(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
|
(replace-match "" t t nil 1)
|
(replace-match news t t nil 2))
|
(if remove
|
(user-error "No priority cookie found in line")
|
(let ((case-fold-search nil)) (looking-at org-todo-line-regexp))
|
(if (match-end 2)
|
(progn
|
(goto-char (match-end 2))
|
(insert " [#" news "]"))
|
(goto-char (match-beginning 3))
|
(insert "[#" news "] "))))
|
(org-set-tags nil 'align))
|
(if remove
|
(message "Priority removed")
|
(message "Priority of current item set to %s" news)))))
|
|
(defun org-show-priority ()
|
"Show the priority of the current item.
|
This priority is composed of the main priority given with the [#A] cookies,
|
and by additional input from the age of a schedules or deadline entry."
|
(interactive)
|
(let ((pri (if (eq major-mode 'org-agenda-mode)
|
(org-get-at-bol 'priority)
|
(save-excursion
|
(save-match-data
|
(beginning-of-line)
|
(and (looking-at org-heading-regexp)
|
(org-get-priority (match-string 0))))))))
|
(message "Priority is %d" (if pri pri -1000))))
|
|
(defun org-get-priority (s)
|
"Find priority cookie and return priority."
|
(save-match-data
|
(if (functionp org-get-priority-function)
|
(funcall org-get-priority-function)
|
(if (not (string-match org-priority-regexp s))
|
(* 1000 (- org-lowest-priority org-default-priority))
|
(* 1000 (- org-lowest-priority
|
(string-to-char (match-string 2 s))))))))
|
|
;;;; Tags
|
|
(defvar org-agenda-archives-mode)
|
(defvar org-map-continue-from nil
|
"Position from where mapping should continue.
|
Can be set by the action argument to `org-scan-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 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
|
can lead to large speed-ups when the tags scanner is used in a file with
|
many entries, and when the list of tags is retrieved, for example to
|
obtain a list of properties. Building the tags list for each entry in such
|
a file becomes an N^2 operation - but with this variable set, it scales
|
as N.")
|
|
(defvar org--matcher-tags-todo-only nil)
|
|
(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,
|
or `agenda' to produce an entry list for an agenda view. It can also be
|
a Lisp form or a function that should be called at each matched headline, in
|
this case the return value is a list of all return values from these calls.
|
|
MATCHER is a function accepting three arguments, returning
|
a non-nil value whenever a given set of tags qualifies a headline
|
for inclusion. See `org-make-tags-matcher' for more information.
|
As a special case, it can also be set to t (respectively nil) in
|
order to match all (respectively none) headline.
|
|
When TODO-ONLY is non-nil, only lines with a TODO keyword are
|
included in the output.
|
|
START-LEVEL can be a string with asterisks, reducing the scope to
|
headlines matching this string."
|
(require 'org-agenda)
|
(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 "\\|")
|
"\\)\\>\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$"))
|
(props (list 'face 'default
|
'done-face 'org-agenda-done
|
'undone-face 'default
|
'mouse-face 'highlight
|
'org-not-done-regexp org-not-done-regexp
|
'org-todo-regexp org-todo-regexp
|
'org-complex-heading-regexp org-complex-heading-regexp
|
'help-echo
|
(format "mouse-2 or RET jump to Org file %S"
|
(abbreviate-file-name
|
(or (buffer-file-name (buffer-base-buffer))
|
(buffer-name (buffer-base-buffer)))))))
|
(org-map-continue-from nil)
|
lspos tags tags-list
|
(tags-alist (list (cons 0 org-file-tags)))
|
(llast 0) rtn rtn1 level category i txt
|
todo marker entry priority
|
ts-date ts-date-type ts-date-pair)
|
(unless (or (member action '(agenda sparse-tree)) (functionp action))
|
(setq action (list 'lambda nil action)))
|
(save-excursion
|
(goto-char (point-min))
|
(when (eq action 'sparse-tree)
|
(org-overview)
|
(org-remove-occur-highlights))
|
(while (let (case-fold-search)
|
(re-search-forward re nil t))
|
(setq org-map-continue-from nil)
|
(catch :skip
|
;; Ignore closing parts of inline tasks.
|
(when (and (fboundp 'org-inlinetask-end-p) (org-inlinetask-end-p))
|
(throw :skip t))
|
(setq todo
|
;; TODO: is the 1-2 difference a bug?
|
(when (match-end 1) (match-string-no-properties 2))
|
tags (when (match-end 4) (match-string-no-properties 4)))
|
(goto-char (setq lspos (match-beginning 0)))
|
(setq level (org-reduced-level (org-outline-level))
|
category (org-get-category))
|
(when (eq action 'agenda)
|
(setq ts-date-pair (org-agenda-entry-get-agenda-timestamp (point))
|
ts-date (car ts-date-pair)
|
ts-date-type (cdr ts-date-pair)))
|
(setq i llast llast level)
|
;; remove tag lists from same and sublevels
|
(while (>= i level)
|
(when (setq entry (assoc i tags-alist))
|
(setq tags-alist (delete entry tags-alist)))
|
(setq i (1- i)))
|
;; add the next tags
|
(when tags
|
(setq tags (org-split-string tags ":")
|
tags-alist
|
(cons (cons level tags) tags-alist)))
|
;; compile tags for current headline
|
(setq tags-list
|
(if org-use-tag-inheritance
|
(apply 'append (mapcar 'cdr (reverse tags-alist)))
|
tags)
|
org-scanner-tags tags-list)
|
(when org-use-tag-inheritance
|
(setcdr (car tags-alist)
|
(mapcar (lambda (x)
|
(setq x (copy-sequence x))
|
(org-add-prop-inherited x))
|
(cdar tags-alist))))
|
(when (and tags org-use-tag-inheritance
|
(or (not (eq t org-use-tag-inheritance))
|
org-tags-exclude-from-inheritance))
|
;; Selective inheritance, remove uninherited ones.
|
(setcdr (car tags-alist)
|
(org-remove-uninherited-tags (cdar tags-alist))))
|
(when (and
|
|
;; eval matcher only when the todo condition is OK
|
(and (or (not todo-only) (member todo org-todo-keywords-1))
|
(if (functionp matcher)
|
(let ((case-fold-search t) (org-trust-scanner-tags t))
|
(funcall matcher todo tags-list level))
|
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-todo-keywords-1)
|
(or (not org-agenda-tags-todo-honor-ignore-options)
|
(not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item))))))
|
|
;; select this headline
|
(cond
|
((eq action 'sparse-tree)
|
(and org-highlight-sparse-tree-matches
|
(org-get-heading) (match-end 0)
|
(org-highlight-new-match
|
(match-beginning 1) (match-end 1)))
|
(org-show-context 'tags-tree))
|
((eq action 'agenda)
|
(setq txt (org-agenda-format-item
|
""
|
(concat
|
(if (eq org-tags-match-list-sublevels 'indented)
|
(make-string (1- level) ?.) "")
|
(org-get-heading))
|
(make-string level ?\s)
|
category
|
tags-list)
|
priority (org-get-priority txt))
|
(goto-char lspos)
|
(setq marker (org-agenda-new-marker))
|
(org-add-props txt props
|
'org-marker marker 'org-hd-marker marker 'org-category category
|
'todo-state todo
|
'ts-date ts-date
|
'priority priority
|
'type (concat "tagsmatch" ts-date-type))
|
(push txt rtn))
|
((functionp action)
|
(setq org-map-continue-from nil)
|
(save-excursion
|
(setq rtn1 (funcall action))
|
(push rtn1 rtn)))
|
(t (user-error "Invalid action")))
|
|
;; if we are to skip sublevels, jump to end of subtree
|
(unless org-tags-match-list-sublevels
|
(org-end-of-subtree t)
|
(backward-char 1))))
|
;; Get the correct position from where to continue
|
(if org-map-continue-from
|
(goto-char org-map-continue-from)
|
(and (= (point) lspos) (end-of-line 1)))))
|
(when (and (eq action 'sparse-tree)
|
(not org-sparse-tree-open-archived-trees))
|
(org-hide-archived-subtrees (point-min) (point-max)))
|
(nreverse rtn)))
|
|
(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 org-tags-exclude-from-inheritance
|
(org-delete-all org-tags-exclude-from-inheritance tags)
|
tags))
|
((not org-use-tag-inheritance) nil)
|
((stringp org-use-tag-inheritance)
|
(delq nil (mapcar
|
(lambda (x)
|
(if (and (string-match org-use-tag-inheritance x)
|
(not (member x org-tags-exclude-from-inheritance)))
|
x nil))
|
tags)))
|
((listp org-use-tag-inheritance)
|
(delq nil (mapcar
|
(lambda (x)
|
(if (member x org-use-tag-inheritance) x nil))
|
tags)))))
|
|
(defun org-match-sparse-tree (&optional todo-only match)
|
"Create a sparse tree according to tags string MATCH.
|
|
MATCH is a string with match syntax. It can contain a selection
|
of tags (\"+work+urgent-boss\"), properties (\"LEVEL>3\"), and
|
TODO keywords (\"TODO=\\\"WAITING\\\"\") or a combination of
|
those. See the manual for details.
|
|
If optional argument TODO-ONLY is non-nil, only select lines that
|
are also TODO tasks."
|
(interactive "P")
|
(org-agenda-prepare-buffers (list (current-buffer)))
|
(let ((org--matcher-tags-todo-only todo-only))
|
(org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match))
|
org--matcher-tags-todo-only)))
|
|
(defalias 'org-tags-sparse-tree 'org-match-sparse-tree)
|
|
(defvar org-cached-props nil)
|
(defun org-cached-entry-get (pom property)
|
(if (or (eq t org-use-property-inheritance)
|
(and (stringp org-use-property-inheritance)
|
(let ((case-fold-search t))
|
(string-match-p org-use-property-inheritance property)))
|
(and (listp org-use-property-inheritance)
|
(member-ignore-case property org-use-property-inheritance)))
|
;; Caching is not possible, check it directly.
|
(org-entry-get pom property 'inherit)
|
;; Get all properties, so we can do complicated checks easily.
|
(cdr (assoc-string property
|
(or org-cached-props
|
(setq org-cached-props (org-entry-properties pom)))
|
t))))
|
|
(defun org-global-tags-completion-table (&optional files)
|
"Return the list of all tags in all agenda buffer/files.
|
Optional FILES argument is a list of files which can be used
|
instead of the agenda files."
|
(save-excursion
|
(org-uniquify
|
(delq nil
|
(apply #'append
|
(mapcar
|
(lambda (file)
|
(set-buffer (find-file-noselect file))
|
(org--tag-add-to-alist
|
(org-get-buffer-tags)
|
(mapcar (lambda (x)
|
(and (stringp (car-safe x))
|
(list (car-safe x))))
|
org-current-tag-alist)))
|
(if (car-safe files) files
|
(org-agenda-files))))))))
|
|
(defun org-make-tags-matcher (match)
|
"Create the TAGS/TODO matcher form for the selection string MATCH.
|
|
Returns a cons of the selection string MATCH and a function
|
implementing the matcher.
|
|
The matcher is to be called at an Org entry, with point on the
|
headline, and returns non-nil if the entry matches the selection
|
string MATCH. It must be called with three arguments: the TODO
|
keyword at the entry (or nil if none), the list of all tags at
|
the entry including inherited ones and the reduced level of the
|
headline. Additionally, the category of the entry, if any, must
|
be specified as the text property `org-category' on the headline.
|
|
This function sets the variable `org--matcher-tags-todo-only' to
|
a non-nil value if the matcher restricts matching to TODO
|
entries, otherwise it is not touched.
|
|
See also `org-scan-tags'."
|
(unless match
|
;; Get a new match request, with completion against the global
|
;; tags table and the local tags in current buffer.
|
(let ((org-last-tags-completion-table
|
(org--tag-add-to-alist
|
(org-get-buffer-tags)
|
(org-global-tags-completion-table))))
|
(setq match
|
(completing-read
|
"Match: "
|
'org-tags-completion-function nil nil nil 'org-tags-history))))
|
|
(let ((match0 match)
|
(re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)")
|
(start 0)
|
tagsmatch todomatch tagsmatcher todomatcher)
|
|
;; Expand group tags.
|
(setq match (org-tags-expand match))
|
|
;; Check if there is a TODO part of this match, which would be the
|
;; part after a "/". To make sure that this slash is not part of
|
;; a property value to be matched against, we also check that
|
;; there is no / after that slash. First, find the last slash.
|
(let ((s 0))
|
(while (string-match "/+" match s)
|
(setq start (match-beginning 0))
|
(setq s (match-end 0))))
|
(if (and (string-match "/+" match start)
|
(not (string-match-p "\"" match start)))
|
;; Match contains also a TODO-matching request.
|
(progn
|
(setq tagsmatch (substring match 0 (match-beginning 0)))
|
(setq todomatch (substring match (match-end 0)))
|
(when (string-prefix-p "!" todomatch)
|
(setq org--matcher-tags-todo-only t)
|
(setq todomatch (substring todomatch 1)))
|
(when (string-match "\\`\\s-*\\'" todomatch)
|
(setq todomatch nil)))
|
;; Only matching tags.
|
(setq tagsmatch match)
|
(setq todomatch nil))
|
|
;; Make the tags matcher.
|
(when (org-string-nw-p tagsmatch)
|
(let ((orlist nil)
|
(orterms (org-split-string tagsmatch "|"))
|
term)
|
(while (setq term (pop orterms))
|
(while (and (equal (substring term -1) "\\") orterms)
|
(setq term (concat term "|" (pop orterms)))) ;repair bad split.
|
(while (string-match re term)
|
(let* ((rest (substring term (match-end 0)))
|
(minus (and (match-end 1)
|
(equal (match-string 1 term) "-")))
|
(tag (save-match-data
|
(replace-regexp-in-string
|
"\\\\-" "-" (match-string 2 term))))
|
(regexp (eq (string-to-char tag) ?{))
|
(levelp (match-end 4))
|
(propp (match-end 5))
|
(mm
|
(cond
|
(regexp `(org-match-any-p ,(substring tag 1 -1) tags-list))
|
(levelp
|
`(,(org-op-to-function (match-string 3 term))
|
level
|
,(string-to-number (match-string 4 term))))
|
(propp
|
(let* ((gv (pcase (upcase (match-string 5 term))
|
("CATEGORY"
|
'(get-text-property (point) 'org-category))
|
("TODO" 'todo)
|
(p `(org-cached-entry-get nil ,p))))
|
(pv (match-string 7 term))
|
(regexp (eq (string-to-char pv) ?{))
|
(strp (eq (string-to-char pv) ?\"))
|
(timep (string-match-p "^\"[[<].*[]>]\"$" pv))
|
(po (org-op-to-function (match-string 6 term)
|
(if timep 'time strp))))
|
(setq pv (if (or regexp strp) (substring pv 1 -1) pv))
|
(when timep (setq pv (org-matcher-time pv)))
|
(cond ((and regexp (eq po 'org<>))
|
`(not (string-match ,pv (or ,gv ""))))
|
(regexp `(string-match ,pv (or ,gv "")))
|
(strp `(,po (or ,gv "") ,pv))
|
(t
|
`(,po
|
(string-to-number (or ,gv ""))
|
,(string-to-number pv))))))
|
(t `(member ,tag tags-list)))))
|
(push (if minus `(not ,mm) mm) tagsmatcher)
|
(setq term rest)))
|
(push `(and ,@tagsmatcher) orlist)
|
(setq tagsmatcher nil))
|
(setq tagsmatcher `(progn (setq org-cached-props nil) (or ,@orlist)))))
|
|
;; Make the TODO matcher.
|
(when (org-string-nw-p todomatch)
|
(let ((orlist nil))
|
(dolist (term (org-split-string todomatch "|"))
|
(while (string-match re term)
|
(let* ((minus (and (match-end 1)
|
(equal (match-string 1 term) "-")))
|
(kwd (match-string 2 term))
|
(regexp (eq (string-to-char kwd) ?{))
|
(mm (if regexp `(string-match ,(substring kwd 1 -1) todo)
|
`(equal todo ,kwd))))
|
(push (if minus `(not ,mm) mm) todomatcher))
|
(setq term (substring term (match-end 0))))
|
(push (if (> (length todomatcher) 1)
|
(cons 'and todomatcher)
|
(car todomatcher))
|
orlist)
|
(setq todomatcher nil))
|
(setq todomatcher (cons 'or orlist))))
|
|
;; Return the string and function of the matcher. If no
|
;; tags-specific or todo-specific matcher exists, match
|
;; everything.
|
(let ((matcher (if (and tagsmatcher todomatcher)
|
`(and ,tagsmatcher ,todomatcher)
|
(or tagsmatcher todomatcher t))))
|
(when org--matcher-tags-todo-only
|
(setq matcher `(and (member todo org-not-done-keywords) ,matcher)))
|
(cons match0 `(lambda (todo tags-list level) ,matcher)))))
|
|
(defun org-tags-expand (match &optional single-as-list downcased tags-already-expanded)
|
"Expand group tags in MATCH.
|
|
This replaces every group tag in MATCH with a regexp tag search.
|
For example, a group tag \"Work\" defined as { Work : Lab Conf }
|
will be replaced like this:
|
|
Work => {\\<\\(?:Work\\|Lab\\|Conf\\)\\>}
|
+Work => +{\\<\\(?:Work\\|Lab\\|Conf\\)\\>}
|
-Work => -{\\<\\(?:Work\\|Lab\\|Conf\\)\\>}
|
|
Replacing by a regexp preserves the structure of the match.
|
E.g., this expansion
|
|
Work|Home => {\\(?:Work\\|Lab\\|Conf\\}|Home
|
|
will match anything tagged with \"Lab\" and \"Home\", or tagged
|
with \"Conf\" and \"Home\" or tagged with \"Work\" and \"home\".
|
|
A group tag in MATCH can contain regular expressions of its own.
|
For example, a group tag \"Proj\" defined as { Proj : {P@.+} }
|
will be replaced like this:
|
|
Proj => {\\<\\(?:Proj\\)\\>\\|P@.+}
|
|
When the optional argument SINGLE-AS-LIST is non-nil, MATCH is
|
assumed to be a single group tag, and the function will return
|
the list of tags in this group.
|
|
When DOWNCASE is non-nil, expand downcased TAGS."
|
(if org-group-tags
|
(let* ((case-fold-search t)
|
(stable org-mode-syntax-table)
|
(taggroups (or org-tag-groups-alist-for-agenda org-tag-groups-alist))
|
(taggroups (if downcased
|
(mapcar (lambda (tg) (mapcar #'downcase tg))
|
taggroups)
|
taggroups))
|
(taggroups-keys (mapcar #'car taggroups))
|
(return-match (if downcased (downcase match) match))
|
(count 0)
|
(work-already-expanded tags-already-expanded)
|
regexps-in-match tags-in-group regexp-in-group regexp-in-group-escaped)
|
;; @ and _ are allowed as word-components in tags.
|
(modify-syntax-entry ?@ "w" stable)
|
(modify-syntax-entry ?_ "w" stable)
|
;; Temporarily replace regexp-expressions in the match-expression.
|
(while (string-match "{.+?}" return-match)
|
(cl-incf count)
|
(push (match-string 0 return-match) regexps-in-match)
|
(setq return-match (replace-match (format "<%d>" count) t nil return-match)))
|
(while (and taggroups-keys
|
(with-syntax-table stable
|
(string-match
|
(concat "\\(?1:[+-]?\\)\\(?2:\\<"
|
(regexp-opt taggroups-keys) "\\>\\)")
|
return-match)))
|
(let* ((dir (match-string 1 return-match))
|
(tag (match-string 2 return-match))
|
(tag (if downcased (downcase tag) tag)))
|
(unless (or (get-text-property 0 'grouptag (match-string 2 return-match))
|
(member tag tags-already-expanded))
|
(setq tags-in-group (assoc tag taggroups))
|
(push tag work-already-expanded)
|
;; Recursively expand each tag in the group, if the tag hasn't
|
;; already been expanded. Restore the match-data after all recursive calls.
|
(save-match-data
|
(let (tags-expanded)
|
(dolist (x (cdr tags-in-group))
|
(if (and (member x taggroups-keys)
|
(not (member x work-already-expanded)))
|
(setq tags-expanded
|
(delete-dups
|
(append
|
(org-tags-expand x t downcased
|
work-already-expanded)
|
tags-expanded)))
|
(setq tags-expanded
|
(append (list x) tags-expanded)))
|
(setq work-already-expanded
|
(delete-dups
|
(append tags-expanded
|
work-already-expanded))))
|
(setq tags-in-group
|
(delete-dups (cons (car tags-in-group)
|
tags-expanded)))))
|
;; Filter tag-regexps from tags.
|
(setq regexp-in-group-escaped
|
(delq nil (mapcar (lambda (x)
|
(if (stringp x)
|
(and (equal "{" (substring x 0 1))
|
(equal "}" (substring x -1))
|
x)
|
x))
|
tags-in-group))
|
regexp-in-group
|
(mapcar (lambda (x)
|
(substring x 1 -1))
|
regexp-in-group-escaped)
|
tags-in-group
|
(delq nil (mapcar (lambda (x)
|
(if (stringp x)
|
(and (not (equal "{" (substring x 0 1)))
|
(not (equal "}" (substring x -1)))
|
x)
|
x))
|
tags-in-group)))
|
;; If single-as-list, do no more in the while-loop.
|
(if (not single-as-list)
|
(progn
|
(when regexp-in-group
|
(setq regexp-in-group
|
(concat "\\|"
|
(mapconcat 'identity regexp-in-group
|
"\\|"))))
|
(setq tags-in-group
|
(concat dir
|
"{\\<"
|
(regexp-opt tags-in-group)
|
"\\>"
|
regexp-in-group
|
"}"))
|
(when (stringp tags-in-group)
|
(org-add-props tags-in-group '(grouptag t)))
|
(setq return-match
|
(replace-match tags-in-group t t return-match)))
|
(setq tags-in-group
|
(append regexp-in-group-escaped tags-in-group))))
|
(setq taggroups-keys (delete tag taggroups-keys))))
|
;; Add the regular expressions back into the match-expression again.
|
(while regexps-in-match
|
(setq return-match (replace-regexp-in-string (format "<%d>" count)
|
(pop regexps-in-match)
|
return-match t t))
|
(cl-decf count))
|
(if single-as-list
|
(if tags-in-group tags-in-group (list return-match))
|
return-match))
|
(if single-as-list
|
(list (if downcased (downcase match) match))
|
match)))
|
|
(defun org-op-to-function (op &optional stringp)
|
"Turn an operator into the appropriate function."
|
(setq op
|
(cond
|
((equal op "<" ) '(< string< org-time<))
|
((equal op ">" ) '(> org-string> org-time>))
|
((member op '("<=" "=<")) '(<= org-string<= org-time<=))
|
((member op '(">=" "=>")) '(>= org-string>= org-time>=))
|
((member op '("=" "==")) '(= string= org-time=))
|
((member op '("<>" "!=")) '(org<> org-string<> org-time<>))))
|
(nth (if (eq stringp 'time) 2 (if stringp 1 0)) op))
|
|
(defun org<> (a b) (not (= a b)))
|
(defun org-string<= (a b) (or (string= a b) (string< a b)))
|
(defun org-string>= (a b) (not (string< a b)))
|
(defun org-string> (a b) (and (not (string= a b)) (not (string< a b))))
|
(defun org-string<> (a b) (not (string= a b)))
|
(defun org-time= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (= a b)))
|
(defun org-time< (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (< a b)))
|
(defun org-time<= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (<= a b)))
|
(defun org-time> (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (> a b)))
|
(defun org-time>= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (>= a b)))
|
(defun org-time<> (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (org<> a b)))
|
(defun org-2ft (s)
|
"Convert S to a floating point time.
|
If S is already a number, just return it. If it is a string, parse
|
it as a time string and apply `float-time' to it. If S is nil, just return 0."
|
(cond
|
((numberp s) s)
|
((stringp s)
|
(condition-case nil
|
(float-time (apply #'encode-time (org-parse-time-string s)))
|
(error 0.)))
|
(t 0.)))
|
|
(defun org-time-today ()
|
"Time in seconds today at 0:00.
|
Returns the float number of seconds since the beginning of the
|
epoch to the beginning of today (00:00)."
|
(float-time (apply 'encode-time
|
(append '(0 0 0) (nthcdr 3 (decode-time))))))
|
|
(defun org-matcher-time (s)
|
"Interpret a time comparison value."
|
(save-match-data
|
(cond
|
((string= s "<now>") (float-time))
|
((string= s "<today>") (org-time-today))
|
((string= s "<tomorrow>") (+ 86400.0 (org-time-today)))
|
((string= s "<yesterday>") (- (org-time-today) 86400.0))
|
((string-match "^<\\([-+][0-9]+\\)\\([hdwmy]\\)>$" s)
|
(+ (org-time-today)
|
(* (string-to-number (match-string 1 s))
|
(cdr (assoc (match-string 2 s)
|
'(("d" . 86400.0) ("w" . 604800.0)
|
("m" . 2678400.0) ("y" . 31557600.0)))))))
|
(t (org-2ft s)))))
|
|
(defun org-match-any-p (re list)
|
"Does re match any element of list?"
|
(setq list (mapcar (lambda (x) (string-match re x)) list))
|
(delq nil list))
|
|
(defvar org-add-colon-after-tag-completion nil) ;; dynamically scoped param
|
(defvar org-tags-overlay (make-overlay 1 1))
|
(delete-overlay org-tags-overlay)
|
|
(defun org-get-local-tags-at (&optional pos)
|
"Get a list of tags defined in the current headline."
|
(org-get-tags-at pos 'local))
|
|
(defun org-get-local-tags ()
|
"Get a list of tags defined in the current headline."
|
(org-get-tags-at nil 'local))
|
|
(defun org-get-tags-at (&optional pos local)
|
"Get a list of all headline tags applicable at POS.
|
POS defaults to point. If tags are inherited, the list contains
|
the targets in the same sequence as the headlines appear, i.e.
|
the tags of the current headline come last.
|
When LOCAL is non-nil, only return tags from the current headline,
|
ignore inherited ones."
|
(interactive)
|
(if (and org-trust-scanner-tags
|
(or (not pos) (equal pos (point)))
|
(not local))
|
org-scanner-tags
|
(let (tags ltags lastpos parent)
|
(save-excursion
|
(save-restriction
|
(widen)
|
(goto-char (or pos (point)))
|
(save-match-data
|
(catch 'done
|
(condition-case nil
|
(progn
|
(org-back-to-heading t)
|
(while (not (equal lastpos (point)))
|
(setq lastpos (point))
|
(when (looking-at ".+?:\\([[:alnum:]_@#%:]+\\):[ \t]*$")
|
(setq ltags (org-split-string
|
(match-string-no-properties 1) ":"))
|
(when parent
|
(setq ltags (mapcar 'org-add-prop-inherited ltags)))
|
(setq tags (append
|
(if parent
|
(org-remove-uninherited-tags ltags)
|
ltags)
|
tags)))
|
(or org-use-tag-inheritance (throw 'done t))
|
(when local (throw 'done t))
|
(or (org-up-heading-safe) (error nil))
|
(setq parent t)))
|
(error nil)))))
|
(if local
|
tags
|
(reverse (delete-dups
|
(reverse (append
|
(org-remove-uninherited-tags
|
org-file-tags)
|
tags)))))))))
|
|
(defun org-add-prop-inherited (s)
|
(add-text-properties 0 (length s) '(inherited t) s)
|
s)
|
|
(defun org-toggle-tag (tag &optional onoff)
|
"Toggle the tag TAG for the current line.
|
If ONOFF is `on' or `off', don't toggle but set to this state."
|
(save-excursion
|
(org-back-to-heading t)
|
(let ((current
|
(when (re-search-forward "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t]*$"
|
(line-end-position) t)
|
(let ((tags (match-string 1)))
|
;; Clear current tags.
|
(replace-match "")
|
;; Reverse the tags list so any new tag is appended to
|
;; the current list of tags.
|
(nreverse (org-split-string tags ":")))))
|
res)
|
(pcase onoff
|
(`off (setq current (delete tag current)))
|
((or `on (guard (not (member tag current))))
|
(setq res t)
|
(cl-pushnew tag current :test #'equal))
|
(_ (setq current (delete tag current))))
|
(end-of-line)
|
(if current
|
(progn
|
(insert " :" (mapconcat #'identity (nreverse current) ":") ":")
|
(org-set-tags nil t))
|
(delete-horizontal-space))
|
(run-hooks 'org-after-tags-change-hook)
|
res)))
|
|
(defun org--align-tags-here (to-col)
|
"Align tags on the current headline to TO-COL.
|
Assume point is on a headline."
|
(let ((pos (point)))
|
(beginning-of-line)
|
(if (or (not (looking-at ".*?\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))
|
(>= pos (match-beginning 2)))
|
;; No tags or point within tags: do not align.
|
(goto-char pos)
|
(goto-char (match-beginning 1))
|
(let ((shift (max (- (if (>= to-col 0) to-col
|
(- (abs to-col) (string-width (match-string 2))))
|
(current-column))
|
1)))
|
(replace-match (make-string shift ?\s) nil nil nil 1)
|
;; Preserve initial position, if possible. In any case, stop
|
;; before tags.
|
(when (< pos (point)) (goto-char pos))))))
|
|
(defun org-set-tags-command (&optional arg just-align)
|
"Call the set-tags command for the current entry."
|
(interactive "P")
|
(if (or (org-at-heading-p) (and arg (org-before-first-heading-p)))
|
(org-set-tags arg just-align)
|
(save-excursion
|
(unless (and (org-region-active-p)
|
org-loop-over-headlines-in-active-region)
|
(org-back-to-heading t))
|
(org-set-tags arg just-align))))
|
|
(defun org-set-tags-to (data)
|
"Set the tags of the current entry to DATA, replacing current tags.
|
DATA may be a tags string like \":aa:bb:cc:\", or a list of tags.
|
If DATA is nil or the empty string, all tags are removed."
|
(interactive "sTags: ")
|
(let ((data
|
(pcase (if (stringp data) (org-trim data) data)
|
((or `nil "") nil)
|
((pred listp) (format ":%s:" (mapconcat #'identity data ":")))
|
((pred stringp)
|
(format ":%s:"
|
(mapconcat #'identity (org-split-string data ":+") ":")))
|
(_ (error "Invalid tag specification: %S" data)))))
|
(org-with-wide-buffer
|
(org-back-to-heading t)
|
(let ((case-fold-search nil)) (looking-at org-complex-heading-regexp))
|
(when (or (match-end 5) data)
|
(goto-char (or (match-beginning 5) (line-end-position)))
|
(skip-chars-backward " \t")
|
(delete-region (point) (line-end-position))
|
(when data
|
(insert " " data)
|
(org-set-tags nil 'align))))))
|
|
(defun org-align-all-tags ()
|
"Align the tags in all headings."
|
(interactive)
|
(save-excursion
|
(or (ignore-errors (org-back-to-heading t))
|
(outline-next-heading))
|
(if (org-at-heading-p)
|
(org-set-tags t)
|
(message "No headings"))))
|
|
(defvar org-indent-indentation-per-level)
|
(defun org-set-tags (&optional arg just-align)
|
"Set the tags for the current headline.
|
With prefix ARG, realign all tags in headings in the current buffer.
|
When JUST-ALIGN is non-nil, only align tags."
|
(interactive "P")
|
(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
|
;; We don't use ARG and JUST-ALIGN here because these args
|
;; are not useful when looping over headlines.
|
#'org-set-tags
|
org-loop-over-headlines-in-active-region
|
cl
|
'(when (org-invisible-p) (org-end-of-subtree nil t))))
|
(let ((org-setting-tags t))
|
(if arg
|
(save-excursion
|
(goto-char (point-min))
|
(while (re-search-forward org-outline-regexp-bol nil t)
|
(org-set-tags nil t)
|
(end-of-line))
|
(message "All tags realigned to column %d" org-tags-column))
|
(let* ((current (org-get-tags-string))
|
(tags
|
(if just-align current
|
;; Get a new set of tags from the user.
|
(save-excursion
|
(let* ((table
|
(setq
|
org-last-tags-completion-table
|
(org--tag-add-to-alist
|
(and
|
org-complete-tags-always-offer-all-agenda-tags
|
(org-global-tags-completion-table
|
(org-agenda-files)))
|
(or org-current-tag-alist
|
(org-get-buffer-tags)))))
|
(current-tags (org-split-string current ":"))
|
(inherited-tags
|
(nreverse (nthcdr (length current-tags)
|
(nreverse (org-get-tags-at))))))
|
(replace-regexp-in-string
|
"\\([-+&]+\\|,\\)"
|
":"
|
(if (or (eq t org-use-fast-tag-selection)
|
(and org-use-fast-tag-selection
|
(delq nil (mapcar #'cdr table))))
|
(org-fast-tag-selection
|
current-tags inherited-tags table
|
(and org-fast-tag-selection-include-todo
|
org-todo-key-alist))
|
(let ((org-add-colon-after-tag-completion
|
(< 1 (length table))))
|
(org-trim
|
(completing-read
|
"Tags: "
|
#'org-tags-completion-function
|
nil nil current 'org-tags-history))))))))))
|
|
(when org-tags-sort-function
|
(setq tags
|
(mapconcat
|
#'identity
|
(sort (org-split-string tags "[^[:alnum:]_@#%]+")
|
org-tags-sort-function)
|
":")))
|
|
(if (or (string= ":" tags)
|
(string= "::" tags))
|
(setq tags ""))
|
(if (not (org-string-nw-p tags)) (setq tags "")
|
(unless (string-suffix-p ":" tags) (setq tags (concat tags ":")))
|
(unless (string-prefix-p ":" tags) (setq tags (concat ":" tags))))
|
|
;; Insert new tags at the correct column.
|
(unless (equal current tags)
|
(save-excursion
|
(beginning-of-line)
|
(let ((case-fold-search nil))
|
(looking-at org-complex-heading-regexp))
|
;; Remove current tags, if any.
|
(when (match-end 5) (replace-match "" nil nil nil 5))
|
;; Insert new tags, if any. Otherwise, remove trailing
|
;; white spaces.
|
(end-of-line)
|
(if (not (equal tags ""))
|
;; When text is being inserted on an invisible
|
;; region boundary, it can be inadvertently sucked
|
;; into invisibility.
|
(outline-flag-region (point) (progn (insert " " tags) (point)) nil)
|
(skip-chars-backward " \t")
|
(delete-region (point) (line-end-position)))))
|
;; Align tags, if any. Fix tags column if `org-indent-mode'
|
;; is on.
|
(unless (equal tags "")
|
(let* ((level (save-excursion
|
(beginning-of-line)
|
(skip-chars-forward "\\*")))
|
(offset (if (bound-and-true-p org-indent-mode)
|
(* (1- org-indent-indentation-per-level)
|
(1- level))
|
0))
|
(tags-column
|
(+ org-tags-column
|
(if (> org-tags-column 0) (- offset) offset))))
|
(org--align-tags-here tags-column))))
|
(unless just-align (run-hooks 'org-after-tags-change-hook))))))
|
|
(defun org-change-tag-in-region (beg end tag off)
|
"Add or remove TAG for each entry in the region.
|
This works in the agenda, and also in an Org buffer."
|
(interactive
|
(list (region-beginning) (region-end)
|
(let ((org-last-tags-completion-table
|
(if (derived-mode-p 'org-mode)
|
(org--tag-add-to-alist
|
(org-get-buffer-tags)
|
(org-global-tags-completion-table))
|
(org-global-tags-completion-table))))
|
(completing-read
|
"Tag: " 'org-tags-completion-function nil nil nil
|
'org-tags-history))
|
(progn
|
(message "[s]et or [r]emove? ")
|
(equal (read-char-exclusive) ?r))))
|
(when (fboundp 'deactivate-mark) (deactivate-mark))
|
(let ((agendap (equal major-mode 'org-agenda-mode))
|
l1 l2 m buf pos newhead (cnt 0))
|
(goto-char end)
|
(setq l2 (1- (org-current-line)))
|
(goto-char beg)
|
(setq l1 (org-current-line))
|
(cl-loop for l from l1 to l2 do
|
(org-goto-line l)
|
(setq m (get-text-property (point) 'org-hd-marker))
|
(when (or (and (derived-mode-p 'org-mode) (org-at-heading-p))
|
(and agendap m))
|
(setq buf (if agendap (marker-buffer m) (current-buffer))
|
pos (if agendap m (point)))
|
(with-current-buffer buf
|
(save-excursion
|
(save-restriction
|
(goto-char pos)
|
(setq cnt (1+ cnt))
|
(org-toggle-tag tag (if off 'off 'on))
|
(setq newhead (org-get-heading)))))
|
(and agendap (org-agenda-change-all-lines newhead m))))
|
(message "Tag :%s: %s in %d headings" tag (if off "removed" "set") cnt)))
|
|
(defun org-tags-completion-function (string _predicate &optional flag)
|
(let (s1 s2 rtn (ctable org-last-tags-completion-table)
|
(confirm (lambda (x) (stringp (car x)))))
|
(if (string-match "^\\(.*[-+:&,|]\\)\\([^-+:&,|]*\\)$" string)
|
(setq s1 (match-string 1 string)
|
s2 (match-string 2 string))
|
(setq s1 "" s2 string))
|
(cond
|
((eq flag nil)
|
;; try completion
|
(setq rtn (try-completion s2 ctable confirm))
|
(when (stringp rtn)
|
(setq rtn
|
(concat s1 s2 (substring rtn (length s2))
|
(if (and org-add-colon-after-tag-completion
|
(assoc rtn ctable))
|
":" ""))))
|
rtn)
|
((eq flag t)
|
;; all-completions
|
(all-completions s2 ctable confirm))
|
((eq flag 'lambda)
|
;; exact match?
|
(assoc s2 ctable)))))
|
|
(defun org-fast-tag-insert (kwd tags face &optional end)
|
"Insert KDW, and the TAGS, the latter with face FACE.
|
Also insert END."
|
(insert (format "%-12s" (concat kwd ":"))
|
(org-add-props (mapconcat 'identity tags " ") nil 'face face)
|
(or end "")))
|
|
(defun org-fast-tag-show-exit (flag)
|
(save-excursion
|
(org-goto-line 3)
|
(when (re-search-forward "[ \t]+Next change exits" (point-at-eol) t)
|
(replace-match ""))
|
(when flag
|
(end-of-line 1)
|
(org-move-to-column (- (window-width) 19) t)
|
(insert (org-add-props " Next change exits" nil 'face 'org-warning)))))
|
|
(defun org-set-current-tags-overlay (current prefix)
|
"Add an overlay to CURRENT tag with PREFIX."
|
(let ((s (concat ":" (mapconcat 'identity current ":") ":")))
|
(put-text-property 0 (length s) 'face '(secondary-selection org-tag) s)
|
(org-overlay-display org-tags-overlay (concat prefix s))))
|
|
(defvar org-last-tag-selection-key nil)
|
(defun org-fast-tag-selection (current inherited table &optional todo-table)
|
"Fast tag selection with single keys.
|
CURRENT is the current list of tags in the headline, INHERITED is the
|
list of inherited tags, and TABLE is an alist of tags and corresponding keys,
|
possibly with grouping information. TODO-TABLE is a similar table with
|
TODO keywords, should these have keys assigned to them.
|
If the keys are nil, a-z are automatically assigned.
|
Returns the new tags string, or nil to not change the current settings."
|
(let* ((fulltable (append table todo-table))
|
(maxlen (if (null fulltable) 0
|
(apply #'max
|
(mapcar (lambda (x)
|
(if (stringp (car x)) (string-width (car x))
|
0))
|
fulltable))))
|
(buf (current-buffer))
|
(expert (eq org-fast-tag-selection-single-key 'expert))
|
(buffer-tags nil)
|
(fwidth (+ maxlen 3 1 3))
|
(ncol (/ (- (window-width) 4) fwidth))
|
(i-face 'org-done)
|
(c-face 'org-todo)
|
tg cnt e c char c1 c2 ntable tbl rtn
|
ov-start ov-end ov-prefix
|
(exit-after-next org-fast-tag-selection-single-key)
|
(done-keywords org-done-keywords)
|
groups ingroup intaggroup)
|
(save-excursion
|
(beginning-of-line 1)
|
(if (looking-at ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
|
(setq ov-start (match-beginning 1)
|
ov-end (match-end 1)
|
ov-prefix "")
|
(setq ov-start (1- (point-at-eol))
|
ov-end (1+ ov-start))
|
(skip-chars-forward "^\n\r")
|
(setq ov-prefix
|
(concat
|
(buffer-substring (1- (point)) (point))
|
(if (> (current-column) org-tags-column)
|
" "
|
(make-string (- org-tags-column (current-column)) ?\ ))))))
|
(move-overlay org-tags-overlay ov-start ov-end)
|
(save-window-excursion
|
(if expert
|
(set-buffer (get-buffer-create " *Org tags*"))
|
(delete-other-windows)
|
(set-window-buffer (split-window-vertically) (get-buffer-create " *Org tags*"))
|
(org-switch-to-buffer-other-window " *Org tags*"))
|
(erase-buffer)
|
(setq-local org-done-keywords done-keywords)
|
(org-fast-tag-insert "Inherited" inherited i-face "\n")
|
(org-fast-tag-insert "Current" current c-face "\n\n")
|
(org-fast-tag-show-exit exit-after-next)
|
(org-set-current-tags-overlay current ov-prefix)
|
(setq tbl fulltable char ?a cnt 0)
|
(while (setq e (pop tbl))
|
(cond
|
((eq (car e) :startgroup)
|
(push '() groups) (setq ingroup t)
|
(unless (zerop cnt)
|
(setq cnt 0)
|
(insert "\n"))
|
(insert (if (cdr e) (format "%s: " (cdr e)) "") "{ "))
|
((eq (car e) :endgroup)
|
(setq ingroup nil cnt 0)
|
(insert "}" (if (cdr e) (format " (%s) " (cdr e)) "") "\n"))
|
((eq (car e) :startgrouptag)
|
(setq intaggroup t)
|
(unless (zerop cnt)
|
(setq cnt 0)
|
(insert "\n"))
|
(insert "[ "))
|
((eq (car e) :endgrouptag)
|
(setq intaggroup nil cnt 0)
|
(insert "]\n"))
|
((equal e '(:newline))
|
(unless (zerop cnt)
|
(setq cnt 0)
|
(insert "\n")
|
(setq e (car tbl))
|
(while (equal (car tbl) '(:newline))
|
(insert "\n")
|
(setq tbl (cdr tbl)))))
|
((equal e '(:grouptags)) (insert " : "))
|
(t
|
(setq tg (copy-sequence (car e)) c2 nil)
|
(if (cdr e)
|
(setq c (cdr e))
|
;; automatically assign a character.
|
(setq c1 (string-to-char
|
(downcase (substring
|
tg (if (= (string-to-char tg) ?@) 1 0)))))
|
(if (or (rassoc c1 ntable) (rassoc c1 table))
|
(while (or (rassoc char ntable) (rassoc char table))
|
(setq char (1+ char)))
|
(setq c2 c1))
|
(setq c (or c2 char)))
|
(when ingroup (push tg (car groups)))
|
(setq tg (org-add-props tg nil 'face
|
(cond
|
((not (assoc tg table))
|
(org-get-todo-face tg))
|
((member tg current) c-face)
|
((member tg inherited) i-face))))
|
(when (equal (caar tbl) :grouptags)
|
(org-add-props tg nil 'face 'org-tag-group))
|
(when (and (zerop cnt) (not ingroup) (not intaggroup)) (insert " "))
|
(insert "[" c "] " tg (make-string
|
(- fwidth 4 (length tg)) ?\ ))
|
(push (cons tg c) ntable)
|
(when (= (cl-incf cnt) ncol)
|
(insert "\n")
|
(when (or ingroup intaggroup) (insert " "))
|
(setq cnt 0)))))
|
(setq ntable (nreverse ntable))
|
(insert "\n")
|
(goto-char (point-min))
|
(unless expert (org-fit-window-to-buffer))
|
(setq rtn
|
(catch 'exit
|
(while t
|
(message "[a-z..]:toggle [SPC]:clear [RET]:accept [TAB]:edit [!] %sgroups%s"
|
(if (not groups) "no " "")
|
(if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi")))
|
(setq c (let ((inhibit-quit t)) (read-char-exclusive)))
|
(setq org-last-tag-selection-key c)
|
(cond
|
((= c ?\r) (throw 'exit t))
|
((= c ?!)
|
(setq groups (not groups))
|
(goto-char (point-min))
|
(while (re-search-forward "[{}]" nil t) (replace-match " ")))
|
((= c ?\C-c)
|
(if (not expert)
|
(org-fast-tag-show-exit
|
(setq exit-after-next (not exit-after-next)))
|
(setq expert nil)
|
(delete-other-windows)
|
(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)
|
(and (= c ?q) (not (rassoc c ntable))))
|
(delete-overlay org-tags-overlay)
|
(setq quit-flag t))
|
((= c ?\ )
|
(setq current nil)
|
(when exit-after-next (setq exit-after-next 'now)))
|
((= c ?\t)
|
(condition-case nil
|
(setq tg (completing-read
|
"Tag: "
|
(or buffer-tags
|
(with-current-buffer buf
|
(setq buffer-tags
|
(org-get-buffer-tags))))))
|
(quit (setq tg "")))
|
(when (string-match "\\S-" tg)
|
(cl-pushnew (list tg) buffer-tags :test #'equal)
|
(if (member tg current)
|
(setq current (delete tg current))
|
(push tg current)))
|
(when exit-after-next (setq exit-after-next 'now)))
|
((setq e (rassoc c todo-table) tg (car e))
|
(with-current-buffer buf
|
(save-excursion (org-todo tg)))
|
(when exit-after-next (setq exit-after-next 'now)))
|
((setq e (rassoc c ntable) tg (car e))
|
(if (member tg current)
|
(setq current (delete tg current))
|
(cl-loop for g in groups do
|
(when (member tg g)
|
(dolist (x g) (setq current (delete x current)))))
|
(push tg current))
|
(when exit-after-next (setq exit-after-next 'now))))
|
|
;; Create a sorted list
|
(setq current
|
(sort current
|
(lambda (a b)
|
(assoc b (cdr (memq (assoc a ntable) ntable))))))
|
(when (eq exit-after-next 'now) (throw 'exit t))
|
(goto-char (point-min))
|
(beginning-of-line 2)
|
(delete-region (point) (point-at-eol))
|
(org-fast-tag-insert "Current" current c-face)
|
(org-set-current-tags-overlay current ov-prefix)
|
(while (re-search-forward "\\[.\\] \\([[:alnum:]_@#%]+\\)" nil t)
|
(setq tg (match-string 1))
|
(add-text-properties
|
(match-beginning 1) (match-end 1)
|
(list 'face
|
(cond
|
((member tg current) c-face)
|
((member tg inherited) i-face)
|
(t (get-text-property (match-beginning 1) 'face))))))
|
(goto-char (point-min)))))
|
(delete-overlay org-tags-overlay)
|
(if rtn
|
(mapconcat 'identity current ":")
|
nil))))
|
|
(defun org-get-tags-string ()
|
"Get the TAGS string in the current headline."
|
(unless (org-at-heading-p t)
|
(user-error "Not on a heading"))
|
(save-excursion
|
(beginning-of-line 1)
|
(if (looking-at ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
|
(match-string-no-properties 1)
|
"")))
|
|
(defun org-get-tags ()
|
"Get the list of tags specified in the current headline."
|
(org-split-string (org-get-tags-string) ":"))
|
|
(defun org-get-buffer-tags ()
|
"Get a table of all tags used in the buffer, for completion."
|
(org-with-wide-buffer
|
(goto-char (point-min))
|
(let ((tag-re (concat org-outline-regexp-bol
|
"\\(?:.*?[ \t]\\)?:\\([[:alnum:]_@#%:]+\\):[ \t]*$"))
|
tags)
|
(while (re-search-forward tag-re nil t)
|
(dolist (tag (org-split-string (match-string-no-properties 1) ":"))
|
(push tag tags)))
|
(mapcar #'list (append org-file-tags (org-uniquify tags))))))
|
|
;;;; The mapping API
|
|
(defvar org-agenda-skip-comment-trees)
|
(defvar org-agenda-skip-function)
|
(defun org-map-entries (func &optional match scope &rest skip)
|
"Call FUNC at each headline selected by MATCH in SCOPE.
|
|
FUNC is a function or a lisp form. The function will be called without
|
arguments, with the cursor positioned at the beginning of the headline.
|
The return values of all calls to the function will be collected and
|
returned as a list.
|
|
The call to FUNC will be wrapped into a save-excursion form, so FUNC
|
does not need to preserve point. After evaluation, the cursor will be
|
moved to the end of the line (presumably of the headline of the
|
processed entry) and search continues from there. Under some
|
circumstances, this may not produce the wanted results. For example,
|
if you have removed (e.g. archived) the current (sub)tree it could
|
mean that the next entry will be skipped entirely. In such cases, you
|
can specify the position from where search should continue by making
|
FUNC set the variable `org-map-continue-from' to the desired buffer
|
position.
|
|
MATCH is a tags/property/todo match as it is used in the agenda tags view.
|
Only headlines that are matched by this query will be considered during
|
the iteration. When MATCH is nil or t, all headlines will be
|
visited by the iteration.
|
|
SCOPE determines the scope of this command. It can be any of:
|
|
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
|
agenda All agenda files
|
agenda-with-archives
|
All agenda files with any archive files associated with them
|
\(file1 file2 ...)
|
If this is a list, all files in the list will be scanned
|
|
The remaining args are treated as settings for the skipping facilities of
|
the scanner. The following items can be given here:
|
|
archive skip trees with the archive tag
|
comment skip trees with the COMMENT keyword
|
function or Emacs Lisp form:
|
will be used as value for `org-agenda-skip-function', so
|
whenever the function returns a position, FUNC will not be
|
called for that entry and search will continue from the
|
position returned
|
|
If your function needs to retrieve the tags including inherited tags
|
at the *current* entry, you can use the value of the variable
|
`org-scanner-tags' which will be much faster than getting the value
|
with `org-get-tags-at'. If your function gets properties with
|
`org-entry-properties' at the *current* entry, bind `org-trust-scanner-tags'
|
to t around the call to `org-entry-properties' to get the same speedup.
|
Note that if your function moves around to retrieve tags and properties at
|
a *different* entry, you cannot use these techniques."
|
(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 res
|
org-todo-keywords-for-agenda
|
org-done-keywords-for-agenda
|
org-todo-keyword-alist-for-agenda
|
org-tag-alist-for-agenda
|
org--matcher-tags-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))))
|
|
(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-agenda-prepare-buffers
|
(and buffer-file-name (list buffer-file-name)))
|
(setq res
|
(org-scan-tags
|
func matcher org--matcher-tags-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 (and buffer-file-name (list buffer-file-name))))
|
((eq scope 'file-with-archives)
|
(setq scope (org-add-archive-files (list (buffer-file-name))))))
|
(org-agenda-prepare-buffers scope)
|
(dolist (file scope)
|
(with-current-buffer (org-find-base-buffer-visiting file)
|
(org-with-wide-buffer
|
(goto-char (point-min))
|
(setq res
|
(append
|
res
|
(org-scan-tags
|
func matcher org--matcher-tags-todo-only)))))))))
|
res)))
|
|
;;; Properties API
|
|
(defconst org-special-properties
|
'("ALLTAGS" "BLOCKED" "CLOCKSUM" "CLOCKSUM_T" "CLOSED" "DEADLINE" "FILE"
|
"ITEM" "PRIORITY" "SCHEDULED" "TAGS" "TIMESTAMP" "TIMESTAMP_IA" "TODO")
|
"The special properties valid in Org mode.
|
These are properties that are not defined in the property drawer,
|
but in some other way.")
|
|
(defconst org-default-properties
|
'("ARCHIVE" "CATEGORY" "SUMMARY" "DESCRIPTION" "CUSTOM_ID"
|
"LOCATION" "LOGGING" "COLUMNS" "VISIBILITY"
|
"TABLE_EXPORT_FORMAT" "TABLE_EXPORT_FILE"
|
"EXPORT_OPTIONS" "EXPORT_TEXT" "EXPORT_FILE_NAME"
|
"EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE" "UNNUMBERED"
|
"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.
|
Being in this list makes sure that they are offered for completion.")
|
|
(defun org--valid-property-p (property)
|
"Non nil when string PROPERTY is a valid property name."
|
(not
|
(or (equal property "")
|
(string-match-p "\\s-" property))))
|
|
(defun org--update-property-plist (key val props)
|
"Associate KEY to VAL in alist PROPS.
|
Modifications are made by side-effect. Return new alist."
|
(let* ((appending (string= (substring key -1) "+"))
|
(key (if appending (substring key 0 -1) key))
|
(old (assoc-string key props t)))
|
(if (not old) (cons (cons key val) props)
|
(setcdr old (if appending (concat (cdr old) " " val) val))
|
props)))
|
|
(defun org-get-property-block (&optional beg force)
|
"Return the (beg . end) range of the body of the property drawer.
|
BEG is the beginning of the current subtree, or of the part
|
before the first headline. If it is not given, it will be found.
|
If the drawer does not exist, create it if FORCE is non-nil, or
|
return nil."
|
(org-with-wide-buffer
|
(when beg (goto-char beg))
|
(unless (org-before-first-heading-p)
|
(let ((beg (cond (beg)
|
((or (not (featurep 'org-inlinetask))
|
(org-inlinetask-in-task-p))
|
(org-back-to-heading t))
|
(t (org-with-limited-levels (org-back-to-heading t))))))
|
(forward-line)
|
(when (looking-at-p org-planning-line-re) (forward-line))
|
(cond ((looking-at org-property-drawer-re)
|
(forward-line)
|
(cons (point) (progn (goto-char (match-end 0))
|
(line-beginning-position))))
|
(force
|
(goto-char beg)
|
(org-insert-property-drawer)
|
(let ((pos (save-excursion (search-forward ":END:")
|
(line-beginning-position))))
|
(cons pos pos))))))))
|
|
(defun org-at-property-p ()
|
"Non-nil when point is inside a property drawer.
|
See `org-property-re' for match data, if applicable."
|
(save-excursion
|
(beginning-of-line)
|
(and (looking-at org-property-re)
|
(let ((property-drawer (save-match-data (org-get-property-block))))
|
(and property-drawer
|
(>= (point) (car property-drawer))
|
(< (point) (cdr property-drawer)))))))
|
|
(defun org-property-action ()
|
"Do an action on properties."
|
(interactive)
|
(message "Property Action: [s]et [d]elete [D]elete globally [c]ompute")
|
(let ((c (read-char-exclusive)))
|
(cl-case c
|
(?s (call-interactively #'org-set-property))
|
(?d (call-interactively #'org-delete-property))
|
(?D (call-interactively #'org-delete-property-globally))
|
(?c (call-interactively #'org-compute-property-at-point))
|
(otherwise (user-error "No such property action %c" c)))))
|
|
(defun org-inc-effort ()
|
"Increment the value of the effort property in the current entry."
|
(interactive)
|
(org-set-effort nil t))
|
|
(defvar org-clock-effort) ; Defined in org-clock.el.
|
(defvar org-clock-current-task) ; Defined in org-clock.el.
|
(defun org-set-effort (&optional value increment)
|
"Set the effort property of the current entry.
|
With numerical prefix arg, use the nth allowed value, 0 stands for the
|
10th allowed value.
|
|
When INCREMENT is non-nil, set the property to the next allowed value."
|
(interactive "P")
|
(when (equal value 0) (setq value 10))
|
(let* ((completion-ignore-case t)
|
(prop org-effort-property)
|
(cur (org-entry-get nil prop))
|
(allowed (org-property-get-allowed-values nil prop 'table))
|
(existing (mapcar 'list (org-property-values prop)))
|
(heading (nth 4 (org-heading-components)))
|
rpl
|
(val (cond
|
((stringp value) value)
|
((and allowed (integerp value))
|
(or (car (nth (1- value) allowed))
|
(car (org-last allowed))))
|
((and allowed increment)
|
(or (cl-caadr (member (list cur) allowed))
|
(user-error "Allowed effort values are not set")))
|
(allowed
|
(message "Select 1-9,0, [RET%s]: %s"
|
(if cur (concat "=" cur) "")
|
(mapconcat 'car allowed " "))
|
(setq rpl (read-char-exclusive))
|
(if (equal rpl ?\r)
|
cur
|
(setq rpl (- rpl ?0))
|
(when (equal rpl 0) (setq rpl 10))
|
(if (and (> rpl 0) (<= rpl (length allowed)))
|
(car (nth (1- rpl) allowed))
|
(org-completing-read "Effort: " allowed nil))))
|
(t
|
(org-completing-read
|
(concat "Effort" (and cur (string-match "\\S-" cur)
|
(concat " [" cur "]"))
|
": ")
|
existing nil nil "" nil cur)))))
|
(unless (equal (org-entry-get nil prop) val)
|
(org-entry-put nil prop val))
|
(org-refresh-property
|
'((effort . identity)
|
(effort-minutes . org-duration-to-minutes))
|
val)
|
(when (equal heading (bound-and-true-p org-clock-current-task))
|
(setq org-clock-effort (get-text-property (point-at-bol) 'effort))
|
(org-clock-update-mode-line))
|
(message "%s is now %s" prop val)))
|
|
(defun org-entry-properties (&optional pom which)
|
"Get all properties of the current entry.
|
|
When POM is a buffer position, get all properties from the entry
|
there instead.
|
|
This includes the TODO keyword, the tags, time strings for
|
deadline, scheduled, and clocking, and any additional properties
|
defined in the entry.
|
|
If WHICH is nil or `all', get all properties. If WHICH is
|
`special' or `standard', only get that subclass. If WHICH is
|
a string, only get that property.
|
|
Return value is an alist. Keys are properties, as upcased
|
strings."
|
(org-with-point-at pom
|
(when (and (derived-mode-p 'org-mode)
|
(ignore-errors (org-back-to-heading t)))
|
(catch 'exit
|
(let* ((beg (point))
|
(specific (and (stringp which) (upcase which)))
|
(which (cond ((not specific) which)
|
((member specific org-special-properties) 'special)
|
(t 'standard)))
|
props)
|
;; Get the special properties, like TODO and TAGS.
|
(when (memq which '(nil all special))
|
(when (or (not specific) (string= specific "CLOCKSUM"))
|
(let ((clocksum (get-text-property (point) :org-clock-minutes)))
|
(when clocksum
|
(push (cons "CLOCKSUM" (org-duration-from-minutes clocksum))
|
props)))
|
(when specific (throw 'exit props)))
|
(when (or (not specific) (string= specific "CLOCKSUM_T"))
|
(let ((clocksumt (get-text-property (point)
|
:org-clock-minutes-today)))
|
(when clocksumt
|
(push (cons "CLOCKSUM_T"
|
(org-duration-from-minutes clocksumt))
|
props)))
|
(when specific (throw 'exit props)))
|
(when (or (not specific) (string= specific "ITEM"))
|
(let ((case-fold-search nil))
|
(when (looking-at org-complex-heading-regexp)
|
(push (cons "ITEM"
|
(let ((title (match-string-no-properties 4)))
|
(if (org-string-nw-p title)
|
(org-remove-tabs title)
|
"")))
|
props)))
|
(when specific (throw 'exit props)))
|
(when (or (not specific) (string= specific "TODO"))
|
(let ((case-fold-search nil))
|
(when (and (looking-at org-todo-line-regexp) (match-end 2))
|
(push (cons "TODO" (match-string-no-properties 2)) props)))
|
(when specific (throw 'exit props)))
|
(when (or (not specific) (string= specific "PRIORITY"))
|
(push (cons "PRIORITY"
|
(if (looking-at org-priority-regexp)
|
(match-string-no-properties 2)
|
(char-to-string org-default-priority)))
|
props)
|
(when specific (throw 'exit props)))
|
(when (or (not specific) (string= specific "FILE"))
|
(push (cons "FILE" (buffer-file-name (buffer-base-buffer)))
|
props)
|
(when specific (throw 'exit props)))
|
(when (or (not specific) (string= specific "TAGS"))
|
(let ((value (org-string-nw-p (org-get-tags-string))))
|
(when value (push (cons "TAGS" value) props)))
|
(when specific (throw 'exit props)))
|
(when (or (not specific) (string= specific "ALLTAGS"))
|
(let ((value (org-get-tags-at)))
|
(when value
|
(push (cons "ALLTAGS"
|
(format ":%s:" (mapconcat #'identity value ":")))
|
props)))
|
(when specific (throw 'exit props)))
|
(when (or (not specific) (string= specific "BLOCKED"))
|
(push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props)
|
(when specific (throw 'exit props)))
|
(when (or (not specific)
|
(member specific '("CLOSED" "DEADLINE" "SCHEDULED")))
|
(forward-line)
|
(when (looking-at-p org-planning-line-re)
|
(end-of-line)
|
(let ((bol (line-beginning-position))
|
;; Backward compatibility: time keywords used to
|
;; be configurable (before 8.3). Make sure we
|
;; get the correct keyword.
|
(key-assoc `(("CLOSED" . ,org-closed-string)
|
("DEADLINE" . ,org-deadline-string)
|
("SCHEDULED" . ,org-scheduled-string))))
|
(dolist (pair (if specific (list (assoc specific key-assoc))
|
key-assoc))
|
(save-excursion
|
(when (search-backward (cdr pair) bol t)
|
(goto-char (match-end 0))
|
(skip-chars-forward " \t")
|
(and (looking-at org-ts-regexp-both)
|
(push (cons (car pair)
|
(match-string-no-properties 0))
|
props)))))))
|
(when specific (throw 'exit props)))
|
(when (or (not specific)
|
(member specific '("TIMESTAMP" "TIMESTAMP_IA")))
|
(let ((find-ts
|
(lambda (end ts)
|
;; Fix next time-stamp before END. TS is the
|
;; list of time-stamps found so far.
|
(let ((ts ts)
|
(regexp (cond
|
((string= specific "TIMESTAMP")
|
org-ts-regexp)
|
((string= specific "TIMESTAMP_IA")
|
org-ts-regexp-inactive)
|
((assoc "TIMESTAMP_IA" ts)
|
org-ts-regexp)
|
((assoc "TIMESTAMP" ts)
|
org-ts-regexp-inactive)
|
(t org-ts-regexp-both))))
|
(catch 'next
|
(while (re-search-forward regexp end t)
|
(backward-char)
|
(let ((object (org-element-context)))
|
;; Accept to match timestamps in node
|
;; properties, too.
|
(when (memq (org-element-type object)
|
'(node-property timestamp))
|
(let ((type
|
(org-element-property :type object)))
|
(cond
|
((and (memq type '(active active-range))
|
(not (equal specific "TIMESTAMP_IA")))
|
(unless (assoc "TIMESTAMP" ts)
|
(push (cons "TIMESTAMP"
|
(org-element-property
|
:raw-value object))
|
ts)
|
(when specific (throw 'exit ts))))
|
((and (memq type '(inactive inactive-range))
|
(not (string= specific "TIMESTAMP")))
|
(unless (assoc "TIMESTAMP_IA" ts)
|
(push (cons "TIMESTAMP_IA"
|
(org-element-property
|
:raw-value object))
|
ts)
|
(when specific (throw 'exit ts))))))
|
;; Both timestamp types are found,
|
;; move to next part.
|
(when (= (length ts) 2) (throw 'next ts)))))
|
ts)))))
|
(goto-char beg)
|
;; First look for timestamps within headline.
|
(let ((ts (funcall find-ts (line-end-position) nil)))
|
(if (= (length ts) 2) (setq props (nconc ts props))
|
;; Then find timestamps in the section, skipping
|
;; planning line.
|
(let ((end (save-excursion (outline-next-heading))))
|
(forward-line)
|
(when (looking-at-p org-planning-line-re) (forward-line))
|
(setq props (nconc (funcall find-ts end ts) props))))))))
|
;; Get the standard properties, like :PROP:.
|
(when (memq which '(nil all standard))
|
;; If we are looking after a specific property, delegate
|
;; to `org-entry-get', which is faster. However, make an
|
;; exception for "CATEGORY", since it can be also set
|
;; through keywords (i.e. #+CATEGORY).
|
(if (and specific (not (equal specific "CATEGORY")))
|
(let ((value (org-entry-get beg specific nil t)))
|
(throw 'exit (and value (list (cons specific value)))))
|
(let ((range (org-get-property-block beg)))
|
(when range
|
(let ((end (cdr range)) seen-base)
|
(goto-char (car range))
|
;; Unlike to `org--update-property-plist', we
|
;; handle the case where base values is found
|
;; after its extension. We also forbid standard
|
;; properties to be named as special properties.
|
(while (re-search-forward org-property-re end t)
|
(let* ((key (upcase (match-string-no-properties 2)))
|
(extendp (string-match-p "\\+\\'" key))
|
(key-base (if extendp (substring key 0 -1) key))
|
(value (match-string-no-properties 3)))
|
(cond
|
((member-ignore-case key-base org-special-properties))
|
(extendp
|
(setq props
|
(org--update-property-plist key value props)))
|
((member key seen-base))
|
(t (push key seen-base)
|
(let ((p (assoc-string key props t)))
|
(if p (setcdr p (concat value " " (cdr p)))
|
(push (cons key value) props))))))))))))
|
(unless (assoc "CATEGORY" props)
|
(push (cons "CATEGORY" (org-get-category beg)) props)
|
(when (string= specific "CATEGORY") (throw 'exit props)))
|
;; Return value.
|
props)))))
|
|
(defun org--property-local-values (property literal-nil)
|
"Return value for PROPERTY in current entry.
|
Value is a list whose car is the base value for PROPERTY and cdr
|
a list of accumulated values. Return nil if neither is found in
|
the entry. Also return nil when PROPERTY is set to \"nil\",
|
unless LITERAL-NIL is non-nil."
|
(let ((range (org-get-property-block)))
|
(when range
|
(goto-char (car range))
|
(let* ((case-fold-search t)
|
(end (cdr range))
|
(value
|
;; Base value.
|
(save-excursion
|
(let ((v (and (re-search-forward
|
(org-re-property property nil t) end t)
|
(match-string-no-properties 3))))
|
(list (if literal-nil v (org-not-nil v)))))))
|
;; Find additional values.
|
(let* ((property+ (org-re-property (concat property "+") nil t)))
|
(while (re-search-forward property+ end t)
|
(push (match-string-no-properties 3) value)))
|
;; Return final values.
|
(and (not (equal value '(nil))) (nreverse value))))))
|
|
(defun org--property-global-value (property literal-nil)
|
"Return value for PROPERTY in current buffer.
|
Return value is a string. Return nil if property is not set
|
globally. Also return nil when PROPERTY is set to \"nil\",
|
unless LITERAL-NIL is non-nil."
|
(let ((global
|
(cdr (or (assoc-string property org-file-properties t)
|
(assoc-string property org-global-properties t)
|
(assoc-string property org-global-properties-fixed t)))))
|
(if literal-nil global (org-not-nil global))))
|
|
(defun org-entry-get (pom property &optional inherit literal-nil)
|
"Get value of PROPERTY for entry or content at point-or-marker POM.
|
|
If INHERIT is non-nil and the entry does not have the property,
|
then also check higher levels of the hierarchy. If INHERIT is
|
the symbol `selective', use inheritance only if the setting in
|
`org-use-property-inheritance' selects PROPERTY for inheritance.
|
|
If the property is present but empty, the return value is the
|
empty string. If the property is not present at all, nil is
|
returned. In any other case, return the value as a string.
|
Search is case-insensitive.
|
|
If LITERAL-NIL is set, return the string value \"nil\" as
|
a string, do not interpret it as the list atom nil. This is used
|
for inheritance when a \"nil\" value can supersede a non-nil
|
value higher up the hierarchy."
|
(org-with-point-at pom
|
(cond
|
((member-ignore-case property (cons "CATEGORY" org-special-properties))
|
;; We need a special property. Use `org-entry-properties' to
|
;; retrieve it, but specify the wanted property.
|
(cdr (assoc-string property (org-entry-properties nil property))))
|
((and inherit
|
(or (not (eq inherit 'selective)) (org-property-inherit-p property)))
|
(org-entry-get-with-inheritance property literal-nil))
|
(t
|
(let* ((local (org--property-local-values property literal-nil))
|
(value (and local (mapconcat #'identity (delq nil local) " "))))
|
(if literal-nil value (org-not-nil value)))))))
|
|
(defun org-property-or-variable-value (var &optional inherit)
|
"Check if there is a property fixing the value of VAR.
|
If yes, return this value. If not, return the current value of the variable."
|
(let ((prop (org-entry-get nil (symbol-name var) inherit)))
|
(if (and prop (stringp prop) (string-match "\\S-" prop))
|
(read prop)
|
(symbol-value var))))
|
|
(defun org-entry-delete (pom property)
|
"Delete PROPERTY from entry at point-or-marker POM.
|
Accumulated properties, i.e. PROPERTY+, are also removed. Return
|
non-nil when a property was removed."
|
(org-with-point-at pom
|
(pcase (org-get-property-block)
|
(`(,begin . ,origin)
|
(let* ((end (copy-marker origin))
|
(re (org-re-property
|
(concat (regexp-quote property) "\\+?") t t)))
|
(goto-char begin)
|
(while (re-search-forward re end t)
|
(delete-region (match-beginning 0) (line-beginning-position 2)))
|
;; If drawer is empty, remove it altogether.
|
(when (= begin end)
|
(delete-region (line-beginning-position 0)
|
(line-beginning-position 2)))
|
;; Return non-nil if some property was removed.
|
(prog1 (/= end origin) (set-marker end nil))))
|
(_ nil))))
|
|
;; Multi-values properties are properties that contain multiple values
|
;; These values are assumed to be single words, separated by whitespace.
|
(defun org-entry-add-to-multivalued-property (pom property value)
|
"Add VALUE to the words in the PROPERTY in entry at point-or-marker POM."
|
(let* ((old (org-entry-get pom property))
|
(values (and old (split-string old))))
|
(setq value (org-entry-protect-space value))
|
(unless (member value values)
|
(setq values (append values (list value)))
|
(org-entry-put pom property (mapconcat #'identity values " ")))))
|
|
(defun org-entry-remove-from-multivalued-property (pom property value)
|
"Remove VALUE from words in the PROPERTY in entry at point-or-marker POM."
|
(let* ((old (org-entry-get pom property))
|
(values (and old (split-string old))))
|
(setq value (org-entry-protect-space value))
|
(when (member value values)
|
(setq values (delete value values))
|
(org-entry-put pom property (mapconcat #'identity values " ")))))
|
|
(defun org-entry-member-in-multivalued-property (pom property value)
|
"Is VALUE one of the words in the PROPERTY in entry at point-or-marker POM?"
|
(let* ((old (org-entry-get pom property))
|
(values (and old (split-string old))))
|
(setq value (org-entry-protect-space value))
|
(member value values)))
|
|
(defun org-entry-get-multivalued-property (pom property)
|
"Return a list of values in a multivalued property."
|
(let* ((value (org-entry-get pom property))
|
(values (and value (split-string value))))
|
(mapcar #'org-entry-restore-space values)))
|
|
(defun org-entry-put-multivalued-property (pom property &rest values)
|
"Set multivalued PROPERTY at point-or-marker POM to VALUES.
|
VALUES should be a list of strings. Spaces will be protected."
|
(org-entry-put pom property (mapconcat #'org-entry-protect-space values " "))
|
(let* ((value (org-entry-get pom property))
|
(values (and value (split-string value))))
|
(mapcar #'org-entry-restore-space values)))
|
|
(defun org-entry-protect-space (s)
|
"Protect spaces and newline in string S."
|
(while (string-match " " s)
|
(setq s (replace-match "%20" t t s)))
|
(while (string-match "\n" s)
|
(setq s (replace-match "%0A" t t s)))
|
s)
|
|
(defun org-entry-restore-space (s)
|
"Restore spaces and newline in string S."
|
(while (string-match "%20" s)
|
(setq s (replace-match " " t t s)))
|
(while (string-match "%0A" s)
|
(setq s (replace-match "\n" t t s)))
|
s)
|
|
(defvar org-entry-property-inherited-from (make-marker)
|
"Marker pointing to the entry from where a property was inherited.
|
Each call to `org-entry-get-with-inheritance' will set this marker to the
|
location of the entry where the inheritance search matched. If there was
|
no match, the marker will point nowhere.
|
Note that also `org-entry-get' calls this function, if the INHERIT flag
|
is set.")
|
|
(defun org-entry-get-with-inheritance (property &optional literal-nil)
|
"Get PROPERTY of entry or content at point, search higher levels if needed.
|
The search will stop at the first ancestor which has the property defined.
|
If the value found is \"nil\", return nil to show that the property
|
should be considered as undefined (this is the meaning of nil here).
|
However, if LITERAL-NIL is set, return the string value \"nil\" instead."
|
(move-marker org-entry-property-inherited-from nil)
|
(org-with-wide-buffer
|
(let (value)
|
(catch 'exit
|
(while t
|
(let ((v (org--property-local-values property literal-nil)))
|
(when v
|
(setq value
|
(concat (mapconcat #'identity (delq nil v) " ")
|
(and value " ")
|
value)))
|
(cond
|
((car v)
|
(org-back-to-heading t)
|
(move-marker org-entry-property-inherited-from (point))
|
(throw 'exit nil))
|
((org-up-heading-safe))
|
(t
|
(let ((global (org--property-global-value property literal-nil)))
|
(cond ((not global))
|
(value (setq value (concat global " " value)))
|
(t (setq value global))))
|
(throw 'exit nil))))))
|
(if literal-nil value (org-not-nil value)))))
|
|
(defvar org-property-changed-functions nil
|
"Hook called when the value of a property has changed.
|
Each hook function should accept two arguments, the name of the property
|
and the new value.")
|
|
(defun org-entry-put (pom property value)
|
"Set PROPERTY to VALUE for entry at point-or-marker POM.
|
|
If the value is nil, it is converted to the empty string. If it
|
is not a string, an error is raised. Also raise an error on
|
invalid property names.
|
|
PROPERTY can be any regular property (see
|
`org-special-properties'). It can also be \"TODO\",
|
\"PRIORITY\", \"SCHEDULED\" and \"DEADLINE\".
|
|
For the last two properties, VALUE may have any of the special
|
values \"earlier\" and \"later\". The function then increases or
|
decreases scheduled or deadline date by one day."
|
(cond ((null value) (setq value ""))
|
((not (stringp value)) (error "Properties values should be strings"))
|
((not (org--valid-property-p property))
|
(user-error "Invalid property name: \"%s\"" property)))
|
(org-with-point-at pom
|
(if (or (not (featurep 'org-inlinetask)) (org-inlinetask-in-task-p))
|
(org-back-to-heading t)
|
(org-with-limited-levels (org-back-to-heading t)))
|
(let ((beg (point)))
|
(cond
|
((equal property "TODO")
|
(cond ((not (org-string-nw-p value)) (setq value 'none))
|
((not (member value org-todo-keywords-1))
|
(user-error "\"%s\" is not a valid TODO state" value)))
|
(org-todo value)
|
(org-set-tags nil 'align))
|
((equal property "PRIORITY")
|
(org-priority (if (org-string-nw-p value) (string-to-char value) ?\s))
|
(org-set-tags nil 'align))
|
((equal property "SCHEDULED")
|
(forward-line)
|
(if (and (looking-at-p org-planning-line-re)
|
(re-search-forward
|
org-scheduled-time-regexp (line-end-position) t))
|
(cond ((string= value "earlier") (org-timestamp-change -1 'day))
|
((string= value "later") (org-timestamp-change 1 'day))
|
((string= value "") (org-schedule '(4)))
|
(t (org-schedule nil value)))
|
(if (member value '("earlier" "later" ""))
|
(call-interactively #'org-schedule)
|
(org-schedule nil value))))
|
((equal property "DEADLINE")
|
(forward-line)
|
(if (and (looking-at-p org-planning-line-re)
|
(re-search-forward
|
org-deadline-time-regexp (line-end-position) t))
|
(cond ((string= value "earlier") (org-timestamp-change -1 'day))
|
((string= value "later") (org-timestamp-change 1 'day))
|
((string= value "") (org-deadline '(4)))
|
(t (org-deadline nil value)))
|
(if (member value '("earlier" "later" ""))
|
(call-interactively #'org-deadline)
|
(org-deadline nil value))))
|
((member property org-special-properties)
|
(error "The %s property cannot be set with `org-entry-put'" property))
|
(t
|
(let* ((range (org-get-property-block beg 'force))
|
(end (cdr range))
|
(case-fold-search t))
|
(goto-char (car range))
|
(if (re-search-forward (org-re-property property nil t) end t)
|
(progn (delete-region (match-beginning 0) (match-end 0))
|
(goto-char (match-beginning 0)))
|
(goto-char end)
|
(insert "\n")
|
(backward-char))
|
(insert ":" property ":")
|
(when value (insert " " value))
|
(org-indent-line)))))
|
(run-hook-with-args 'org-property-changed-functions property value)))
|
|
(defun org-buffer-property-keys
|
(&optional specials defaults columns ignore-malformed)
|
"Get all property keys in the current buffer.
|
|
When SPECIALS is non-nil, also list the special properties that
|
reflect things like tags and TODO state.
|
|
When DEFAULTS is non-nil, also include properties that has
|
special meaning internally: ARCHIVE, CATEGORY, SUMMARY,
|
DESCRIPTION, LOCATION, and LOGGING and others.
|
|
When COLUMNS in non-nil, also include property names given in
|
COLUMN formats in the current buffer.
|
|
When IGNORE-MALFORMED is non-nil, malformed drawer repair will not be
|
automatically performed, such drawers will be silently ignored."
|
(let ((case-fold-search t)
|
(props (append
|
(and specials org-special-properties)
|
(and defaults (cons org-effort-property org-default-properties))
|
nil)))
|
(org-with-wide-buffer
|
(goto-char (point-min))
|
(while (re-search-forward org-property-start-re nil t)
|
(let ((range (org-get-property-block)))
|
(catch 'skip
|
(unless range
|
(when (and (not ignore-malformed)
|
(not (org-before-first-heading-p))
|
(y-or-n-p (format "Malformed drawer at %d, repair?"
|
(line-beginning-position))))
|
(org-get-property-block nil t))
|
(throw 'skip nil))
|
(goto-char (car range))
|
(let ((begin (car range))
|
(end (cdr range)))
|
;; Make sure that found property block is not located
|
;; before current point, as it would generate an infloop.
|
;; It can happen, for example, in the following
|
;; situation:
|
;;
|
;; * Headline
|
;; :PROPERTIES:
|
;; ...
|
;; :END:
|
;; *************** Inlinetask
|
;; #+BEGIN_EXAMPLE
|
;; :PROPERTIES:
|
;; #+END_EXAMPLE
|
;;
|
(if (< begin (point)) (throw 'skip nil) (goto-char begin))
|
(while (< (point) end)
|
(let ((p (progn (looking-at org-property-re)
|
(match-string-no-properties 2))))
|
;; Only add true property name, not extension symbol.
|
(push (if (not (string-match-p "\\+\\'" p)) p
|
(substring p 0 -1))
|
props))
|
(forward-line))))
|
(outline-next-heading)))
|
(when columns
|
(goto-char (point-min))
|
(while (re-search-forward "^[ \t]*\\(?:#\\+\\|:\\)COLUMNS:" nil t)
|
(let ((element (org-element-at-point)))
|
(when (memq (org-element-type element) '(keyword node-property))
|
(let ((value (org-element-property :value element))
|
(start 0))
|
(while (string-match "%[0-9]*\\([[:alnum:]_-]+\\)\\(([^)]+)\\)?\
|
\\(?:{[^}]+}\\)?"
|
value start)
|
(setq start (match-end 0))
|
(let ((p (match-string-no-properties 1 value)))
|
(unless (member-ignore-case p org-special-properties)
|
(push p props))))))))))
|
(sort (delete-dups props) (lambda (a b) (string< (upcase a) (upcase b))))))
|
|
(defun org-property-values (key)
|
"List all non-nil values of property KEY in current buffer."
|
(org-with-wide-buffer
|
(goto-char (point-min))
|
(let ((case-fold-search t)
|
(re (org-re-property key))
|
values)
|
(while (re-search-forward re nil t)
|
(push (org-entry-get (point) key) values))
|
(delete-dups values))))
|
|
(defun org-insert-property-drawer ()
|
"Insert a property drawer into the current entry."
|
(org-with-wide-buffer
|
(if (or (not (featurep 'org-inlinetask)) (org-inlinetask-in-task-p))
|
(org-back-to-heading t)
|
(org-with-limited-levels (org-back-to-heading t)))
|
(forward-line)
|
(when (looking-at-p org-planning-line-re) (forward-line))
|
(unless (looking-at-p org-property-drawer-re)
|
;; Make sure we start editing a line from current entry, not from
|
;; next one. It prevents extending text properties or overlays
|
;; belonging to the latter.
|
(when (bolp) (backward-char))
|
(let ((begin (1+ (point)))
|
(inhibit-read-only t))
|
(insert "\n:PROPERTIES:\n:END:")
|
(when (eobp) (insert "\n"))
|
(org-indent-region begin (point))))))
|
|
(defun org-insert-drawer (&optional arg drawer)
|
"Insert a drawer at point.
|
|
When optional argument ARG is non-nil, insert a property drawer.
|
|
Optional argument DRAWER, when non-nil, is a string representing
|
drawer's name. Otherwise, the user is prompted for a name.
|
|
If a region is active, insert the drawer around that region
|
instead.
|
|
Point is left between drawer's boundaries."
|
(interactive "P")
|
(let* ((drawer (if arg "PROPERTIES"
|
(or drawer (read-from-minibuffer "Drawer: ")))))
|
(cond
|
;; With C-u, fall back on `org-insert-property-drawer'
|
(arg (org-insert-property-drawer))
|
;; Check validity of suggested drawer's name.
|
((not (string-match-p org-drawer-regexp (format ":%s:" drawer)))
|
(user-error "Invalid drawer name"))
|
;; With an active region, insert a drawer at point.
|
((not (org-region-active-p))
|
(progn
|
(unless (bolp) (insert "\n"))
|
(insert (format ":%s:\n\n:END:\n" drawer))
|
(forward-line -2)))
|
;; Otherwise, insert the drawer at point
|
(t
|
(let ((rbeg (region-beginning))
|
(rend (copy-marker (region-end))))
|
(unwind-protect
|
(progn
|
(goto-char rbeg)
|
(beginning-of-line)
|
(when (save-excursion
|
(re-search-forward org-outline-regexp-bol rend t))
|
(user-error "Drawers cannot contain headlines"))
|
;; Position point at the beginning of the first
|
;; non-blank line in region. Insert drawer's opening
|
;; there, then indent it.
|
(org-skip-whitespace)
|
(beginning-of-line)
|
(insert ":" drawer ":\n")
|
(forward-line -1)
|
(indent-for-tab-command)
|
;; Move point to the beginning of the first blank line
|
;; after the last non-blank line in region. Insert
|
;; drawer's closing, then indent it.
|
(goto-char rend)
|
(skip-chars-backward " \r\t\n")
|
(insert "\n:END:")
|
(deactivate-mark t)
|
(indent-for-tab-command)
|
(unless (eolp) (insert "\n")))
|
;; Clear marker, whatever the outcome of insertion is.
|
(set-marker rend nil)))))))
|
|
(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))))
|
(funcall set-function prompt
|
(mapcar 'list (org-property-values property))
|
nil nil "" nil cur))))
|
(org-trim val)))
|
|
(defvar org-last-set-property nil)
|
(defvar org-last-set-property-value nil)
|
(defun org-read-property-name ()
|
"Read a property name."
|
(let ((completion-ignore-case t)
|
(default-prop (or (and (org-at-property-p)
|
(match-string-no-properties 2))
|
org-last-set-property)))
|
(org-completing-read
|
(concat "Property"
|
(if default-prop (concat " [" default-prop "]") "")
|
": ")
|
(mapcar #'list (org-buffer-property-keys nil t t))
|
nil nil nil nil default-prop)))
|
|
(defun org-set-property-and-value (use-last)
|
"Allow to set [PROPERTY]: [value] direction from prompt.
|
When use-default, don't even ask, just use the last
|
\"[PROPERTY]: [value]\" string from the history."
|
(interactive "P")
|
(let* ((completion-ignore-case t)
|
(pv (or (and use-last org-last-set-property-value)
|
(org-completing-read
|
"Enter a \"[Property]: [value]\" pair: "
|
nil nil nil nil nil
|
org-last-set-property-value)))
|
prop val)
|
(when (string-match "^[ \t]*\\([^:]+\\):[ \t]*\\(.*\\)[ \t]*$" pv)
|
(setq prop (match-string 1 pv)
|
val (match-string 2 pv))
|
(org-set-property prop val))))
|
|
(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
|
completion on existing and default properties. And then it will prompt
|
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.
|
|
Throw an error when trying to set a property with an invalid name."
|
(interactive (list nil nil))
|
(let ((property (or property (org-read-property-name))))
|
;; `org-entry-put' also makes the following check, but this one
|
;; avoids polluting `org-last-set-property' and
|
;; `org-last-set-property-value' needlessly.
|
(unless (org--valid-property-p property)
|
(user-error "Invalid property name: \"%s\"" property))
|
(let ((value (or value (org-read-property-value property)))
|
(fn (cdr (assoc-string property org-properties-postprocess-alist t))))
|
(setq org-last-set-property property)
|
(setq org-last-set-property-value (concat property ": " value))
|
;; Possibly postprocess the inserted value:
|
(when fn (setq value (funcall fn value)))
|
(unless (equal (org-entry-get nil property) value)
|
(org-entry-put nil property value)))))
|
|
(defun org-find-property (property &optional value)
|
"Find first entry in buffer that sets PROPERTY.
|
|
When optional argument VALUE is non-nil, only consider an entry
|
if it contains PROPERTY set to this value. If PROPERTY should be
|
explicitly set to nil, use string \"nil\" for VALUE.
|
|
Return position where the entry begins, or nil if there is no
|
such entry. If narrowing is in effect, only search the visible
|
part of the buffer."
|
(save-excursion
|
(goto-char (point-min))
|
(let ((case-fold-search t)
|
(re (org-re-property property nil (not value) value)))
|
(catch 'exit
|
(while (re-search-forward re nil t)
|
(when (if value (org-at-property-p)
|
(org-entry-get (point) property nil t))
|
(throw 'exit (progn (org-back-to-heading t) (point)))))))))
|
|
(defun org-delete-property (property)
|
"In the current entry, delete PROPERTY."
|
(interactive
|
(let* ((completion-ignore-case t)
|
(cat (org-entry-get (point) "CATEGORY"))
|
(props0 (org-entry-properties nil 'standard))
|
(props (if cat props0
|
(delete `("CATEGORY" . ,(org-get-category)) props0)))
|
(prop (if (< 1 (length props))
|
(completing-read "Property: " props nil t)
|
(caar props))))
|
(list prop)))
|
(if (not property)
|
(message "No property to delete in this entry")
|
(org-entry-delete nil property)
|
(message "Property \"%s\" deleted" property)))
|
|
(defun org-delete-property-globally (property)
|
"Remove PROPERTY globally, from all entries.
|
This function ignores narrowing, if any."
|
(interactive
|
(let* ((completion-ignore-case t)
|
(prop (completing-read
|
"Globally remove property: "
|
(mapcar #'list (org-buffer-property-keys)))))
|
(list prop)))
|
(org-with-wide-buffer
|
(goto-char (point-min))
|
(let ((count 0)
|
(re (org-re-property (concat (regexp-quote property) "\\+?") t t)))
|
(while (re-search-forward re nil t)
|
(when (org-entry-delete (point) property) (cl-incf count)))
|
(message "Property \"%s\" removed from %d entries" property count))))
|
|
(defvar org-columns-current-fmt-compiled) ; defined in org-colview.el
|
|
(defun org-compute-property-at-point ()
|
"Compute the property at point.
|
This looks for an enclosing column format, extracts the operator and
|
then applies it to the property in the column format's scope."
|
(interactive)
|
(unless (org-at-property-p)
|
(user-error "Not at a property"))
|
(let ((prop (match-string-no-properties 2)))
|
(org-columns-get-format-and-top-level)
|
(unless (nth 3 (assoc-string prop org-columns-current-fmt-compiled t))
|
(user-error "No operator defined for property %s" prop))
|
(org-columns-compute prop)))
|
|
(defvar org-property-allowed-value-functions nil
|
"Hook for functions supplying allowed values for a specific property.
|
The functions must take a single argument, the name of the property, and
|
return a flat list of allowed values. If \":ETC\" is one of
|
the values, this means that these values are intended as defaults for
|
completion, but that other values should be allowed too.
|
The functions must return nil if they are not responsible for this
|
property.")
|
|
(defun org-property-get-allowed-values (pom property &optional table)
|
"Get allowed values for the property PROPERTY.
|
When TABLE is non-nil, return an alist that can directly be used for
|
completion."
|
(let (vals)
|
(cond
|
((equal property "TODO")
|
(setq vals (org-with-point-at pom
|
(append org-todo-keywords-1 '("")))))
|
((equal property "PRIORITY")
|
(let ((n org-lowest-priority))
|
(while (>= n org-highest-priority)
|
(push (char-to-string n) vals)
|
(setq n (1- n)))))
|
((equal property "CATEGORY"))
|
((member property org-special-properties))
|
((setq vals (run-hook-with-args-until-success
|
'org-property-allowed-value-functions property)))
|
(t
|
(setq vals (org-entry-get pom (concat property "_ALL") 'inherit))
|
(when (and vals (string-match "\\S-" vals))
|
(setq vals (car (read-from-string (concat "(" vals ")"))))
|
(setq vals (mapcar (lambda (x)
|
(cond ((stringp x) x)
|
((numberp x) (number-to-string x))
|
((symbolp x) (symbol-name x))
|
(t "???")))
|
vals)))))
|
(when (member ":ETC" vals)
|
(setq vals (remove ":ETC" vals))
|
(org-add-props (car vals) '(org-unrestricted t)))
|
(if table (mapcar 'list vals) vals)))
|
|
(defun org-property-previous-allowed-value (&optional _previous)
|
"Switch to the next allowed value for this property."
|
(interactive)
|
(org-property-next-allowed-value t))
|
|
(defun org-property-next-allowed-value (&optional previous)
|
"Switch to the next allowed value for this property."
|
(interactive)
|
(unless (org-at-property-p)
|
(user-error "Not at a property"))
|
(let* ((prop (car (save-match-data (org-split-string (match-string 1) ":"))))
|
(key (match-string 2))
|
(value (match-string 3))
|
(allowed (or (org-property-get-allowed-values (point) key)
|
(and (member value '("[ ]" "[-]" "[X]"))
|
'("[ ]" "[X]"))))
|
(heading (save-match-data (nth 4 (org-heading-components))))
|
nval)
|
(unless allowed
|
(user-error "Allowed values for this property have not been defined"))
|
(when previous (setq allowed (reverse allowed)))
|
(when (member value allowed)
|
(setq nval (car (cdr (member value allowed)))))
|
(setq nval (or nval (car allowed)))
|
(when (equal nval value)
|
(user-error "Only one allowed value for this property"))
|
(org-at-property-p)
|
(replace-match (concat " :" key ": " nval) t t)
|
(org-indent-line)
|
(beginning-of-line 1)
|
(skip-chars-forward " \t")
|
(when (equal prop org-effort-property)
|
(org-refresh-property
|
'((effort . identity)
|
(effort-minutes . org-duration-to-minutes))
|
nval)
|
(when (string= org-clock-current-task heading)
|
(setq org-clock-effort nval)
|
(org-clock-update-mode-line)))
|
(run-hook-with-args 'org-property-changed-functions key nval)))
|
|
(defun org-find-olp (path &optional this-buffer)
|
"Return a marker pointing to the entry at outline path OLP.
|
If anything goes wrong, throw an error.
|
You can wrap this call to catch the error like this:
|
|
(condition-case msg
|
(org-mobile-locate-entry (match-string 4))
|
(error (nth 1 msg)))
|
|
The return value will then be either a string with the error message,
|
or a marker if everything is OK.
|
|
If THIS-BUFFER is set, the outline path does not contain a file,
|
only headings."
|
(let* ((file (if this-buffer buffer-file-name (pop path)))
|
(buffer (if this-buffer (current-buffer) (find-file-noselect file)))
|
(level 1)
|
(lmin 1)
|
(lmax 1)
|
end found flevel)
|
(unless buffer (error "File not found :%s" file))
|
(with-current-buffer buffer
|
(unless (derived-mode-p 'org-mode)
|
(error "Buffer %s needs to be in Org mode" buffer))
|
(org-with-wide-buffer
|
(goto-char (point-min))
|
(dolist (heading path)
|
(let ((re (format org-complex-heading-regexp-format
|
(regexp-quote heading)))
|
(cnt 0))
|
(while (re-search-forward re end t)
|
(setq level (- (match-end 1) (match-beginning 1)))
|
(when (and (>= level lmin) (<= level lmax))
|
(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+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0)))
|
(setq end (save-excursion (org-end-of-subtree t t)))))
|
(when (org-at-heading-p)
|
(point-marker))))))
|
|
(defun org-find-exact-headline-in-buffer (heading &optional buffer pos-only)
|
"Find node HEADING in BUFFER.
|
Return a marker to the heading if it was found, or nil if not.
|
If POS-ONLY is set, return just the position instead of a marker.
|
|
The heading text must match exact, but it may have a TODO keyword,
|
a priority cookie and tags in the standard locations."
|
(with-current-buffer (or buffer (current-buffer))
|
(org-with-wide-buffer
|
(goto-char (point-min))
|
(let (case-fold-search)
|
(when (re-search-forward
|
(format org-complex-heading-regexp-format
|
(regexp-quote heading)) nil t)
|
(if pos-only
|
(match-beginning 0)
|
(move-marker (make-marker) (match-beginning 0))))))))
|
|
(defun org-find-exact-heading-in-directory (heading &optional dir)
|
"Find Org node headline HEADING in all \".org\" files in directory DIR.
|
When the target headline is found, return a marker to this location."
|
(let ((files (directory-files (or dir default-directory)
|
t "\\`[^.#].*\\.org\\'"))
|
visiting m buffer)
|
(catch 'found
|
(dolist (file files)
|
(message "trying %s" file)
|
(setq visiting (org-find-base-buffer-visiting file))
|
(setq buffer (or visiting (find-file-noselect file)))
|
(setq m (org-find-exact-headline-in-buffer
|
heading buffer))
|
(when (and (not m) (not visiting)) (kill-buffer buffer))
|
(and m (throw 'found m))))))
|
|
(defun org-find-entry-with-id (ident)
|
"Locate the entry that contains the ID property with exact value IDENT.
|
IDENT can be a string, a symbol or a number, this function will search for
|
the string representation of it.
|
Return the position where this entry starts, or nil if there is no such entry."
|
(interactive "sID: ")
|
(let ((id (cond
|
((stringp ident) ident)
|
((symbolp ident) (symbol-name ident))
|
((numberp ident) (number-to-string ident))
|
(t (error "IDENT %s must be a string, symbol or number" ident)))))
|
(org-with-wide-buffer (org-find-property "ID" id))))
|
|
;;;; Timestamps
|
|
(defvar org-last-changed-timestamp nil)
|
(defvar org-last-inserted-timestamp nil
|
"The last time stamp inserted with `org-insert-time-stamp'.")
|
|
(defun org-time-stamp (arg &optional inactive)
|
"Prompt for a date/time and insert a time stamp.
|
|
If the user specifies a time like HH:MM or if this command is
|
called with at least one prefix argument, the time stamp contains
|
the date and the time. Otherwise, only the date is included.
|
|
All parts of a date not specified by the user are filled in from
|
the timestamp at point, if any, or the current date/time
|
otherwise.
|
|
If there is already a timestamp at the cursor, it is replaced.
|
|
With two universal prefix arguments, insert an active timestamp
|
with the current time without prompting the user.
|
|
When called from lisp, the timestamp is inactive if INACTIVE is
|
non-nil."
|
(interactive "P")
|
(let* ((ts (cond
|
((org-at-date-range-p t)
|
(match-string (if (< (point) (- (match-beginning 2) 2)) 1 2)))
|
((org-at-timestamp-p 'lax) (match-string 0))))
|
;; Default time is either the timestamp at point or today.
|
;; When entering a range, only the range start is considered.
|
(default-time (if (not ts) (current-time)
|
(apply #'encode-time (org-parse-time-string ts))))
|
(default-input (and ts (org-get-compact-tod ts)))
|
(repeater (and ts
|
(string-match "\\([.+-]+[0-9]+[hdwmy] ?\\)+" ts)
|
(match-string 0 ts)))
|
org-time-was-given
|
org-end-time-was-given
|
(time
|
(and (if (equal arg '(16)) (current-time)
|
;; Preserve `this-command' and `last-command'.
|
(let ((this-command this-command)
|
(last-command last-command))
|
(org-read-date
|
arg 'totime nil nil default-time default-input
|
inactive))))))
|
(cond
|
((and ts
|
(memq last-command '(org-time-stamp org-time-stamp-inactive))
|
(memq this-command '(org-time-stamp org-time-stamp-inactive)))
|
(insert "--")
|
(org-insert-time-stamp time (or org-time-was-given arg) inactive))
|
(ts
|
;; Make sure we're on a timestamp. When in the middle of a date
|
;; range, move arbitrarily to range end.
|
(unless (org-at-timestamp-p 'lax)
|
(skip-chars-forward "-")
|
(org-at-timestamp-p 'lax))
|
(replace-match "")
|
(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)))
|
(when repeater
|
(backward-char)
|
(insert " " repeater)
|
(setq org-last-changed-timestamp
|
(concat (substring org-last-inserted-timestamp 0 -1)
|
" " repeater ">")))
|
(message "Timestamp updated"))
|
((equal arg '(16)) (org-insert-time-stamp time t inactive))
|
(t (org-insert-time-stamp
|
time (or org-time-was-given arg) inactive nil nil
|
(list org-end-time-was-given))))))
|
|
;; FIXME: can we use this for something else, like computing time differences?
|
(defun org-get-compact-tod (s)
|
(when (string-match "\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\(-\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\)?" s)
|
(let* ((t1 (match-string 1 s))
|
(h1 (string-to-number (match-string 2 s)))
|
(m1 (string-to-number (match-string 3 s)))
|
(t2 (and (match-end 4) (match-string 5 s)))
|
(h2 (and t2 (string-to-number (match-string 6 s))))
|
(m2 (and t2 (string-to-number (match-string 7 s))))
|
dh dm)
|
(if (not t2)
|
t1
|
(setq dh (- h2 h1) dm (- m2 m1))
|
(when (< dm 0) (setq dm (+ dm 60) dh (1- dh)))
|
(concat t1 "+" (number-to-string dh)
|
(and (/= 0 dm) (format ":%02d" dm)))))))
|
|
(defun org-time-stamp-inactive (&optional arg)
|
"Insert an inactive time stamp.
|
|
An inactive time stamp is enclosed in square brackets instead of angle
|
brackets. It is inactive in the sense that it does not trigger agenda entries,
|
does not link to the calendar and cannot be changed with the S-cursor keys.
|
So these are more for recording a certain time/date.
|
|
If the user specifies a time like HH:MM or if this command is called with
|
at least one prefix argument, the time stamp contains the date and the time.
|
Otherwise, only the date is included.
|
|
When called with two universal prefix arguments, insert an active time stamp
|
with the current time without prompting the user."
|
(interactive "P")
|
(org-time-stamp arg 'inactive))
|
|
(defvar org-date-ovl (make-overlay 1 1))
|
(overlay-put org-date-ovl 'face 'org-date-selected)
|
(delete-overlay org-date-ovl)
|
|
(defvar org-ans1) ; dynamically scoped parameter
|
(defvar org-ans2) ; dynamically scoped parameter
|
|
(defvar org-plain-time-of-day-regexp) ; defined below
|
|
(defvar org-overriding-default-time nil) ; dynamically scoped
|
(defvar org-read-date-overlay nil)
|
(defvar org-dcst nil) ; dynamically scoped
|
(defvar org-read-date-history nil)
|
(defvar org-read-date-final-answer nil)
|
(defvar org-read-date-analyze-futurep nil)
|
(defvar org-read-date-analyze-forced-year nil)
|
(defvar org-read-date-inactive)
|
|
(defvar org-read-date-minibuffer-local-map
|
(let* ((map (make-sparse-keymap)))
|
(set-keymap-parent map minibuffer-local-map)
|
(org-defkey map (kbd ".")
|
(lambda () (interactive)
|
;; Are we at the beginning of the prompt?
|
(if (looking-back "^[^:]+: "
|
(let ((inhibit-field-text-motion t))
|
(line-beginning-position)))
|
(org-eval-in-calendar '(calendar-goto-today))
|
(insert "."))))
|
(org-defkey map (kbd "C-.")
|
(lambda () (interactive)
|
(org-eval-in-calendar '(calendar-goto-today))))
|
(org-defkey map [(meta shift left)]
|
(lambda () (interactive)
|
(org-eval-in-calendar '(calendar-backward-month 1))))
|
(org-defkey map [(meta shift right)]
|
(lambda () (interactive)
|
(org-eval-in-calendar '(calendar-forward-month 1))))
|
(org-defkey map [(meta shift up)]
|
(lambda () (interactive)
|
(org-eval-in-calendar '(calendar-backward-year 1))))
|
(org-defkey map [(meta shift down)]
|
(lambda () (interactive)
|
(org-eval-in-calendar '(calendar-forward-year 1))))
|
(org-defkey map [?\e (shift left)]
|
(lambda () (interactive)
|
(org-eval-in-calendar '(calendar-backward-month 1))))
|
(org-defkey map [?\e (shift right)]
|
(lambda () (interactive)
|
(org-eval-in-calendar '(calendar-forward-month 1))))
|
(org-defkey map [?\e (shift up)]
|
(lambda () (interactive)
|
(org-eval-in-calendar '(calendar-backward-year 1))))
|
(org-defkey map [?\e (shift down)]
|
(lambda () (interactive)
|
(org-eval-in-calendar '(calendar-forward-year 1))))
|
(org-defkey map [(shift up)]
|
(lambda () (interactive)
|
(org-eval-in-calendar '(calendar-backward-week 1))))
|
(org-defkey map [(shift down)]
|
(lambda () (interactive)
|
(org-eval-in-calendar '(calendar-forward-week 1))))
|
(org-defkey map [(shift left)]
|
(lambda () (interactive)
|
(org-eval-in-calendar '(calendar-backward-day 1))))
|
(org-defkey map [(shift right)]
|
(lambda () (interactive)
|
(org-eval-in-calendar '(calendar-forward-day 1))))
|
(org-defkey map "!"
|
(lambda () (interactive)
|
(org-eval-in-calendar '(diary-view-entries))
|
(message "")))
|
(org-defkey map ">"
|
(lambda () (interactive)
|
(org-eval-in-calendar '(calendar-scroll-left 1))))
|
(org-defkey map "<"
|
(lambda () (interactive)
|
(org-eval-in-calendar '(calendar-scroll-right 1))))
|
(org-defkey map "\C-v"
|
(lambda () (interactive)
|
(org-eval-in-calendar
|
'(calendar-scroll-left-three-months 1))))
|
(org-defkey map "\M-v"
|
(lambda () (interactive)
|
(org-eval-in-calendar
|
'(calendar-scroll-right-three-months 1))))
|
map)
|
"Keymap for minibuffer commands when using `org-read-date'.")
|
|
(defvar org-def)
|
(defvar org-defdecode)
|
(defvar org-with-time)
|
|
(defvar calendar-setup) ; Dynamically scoped.
|
(defun org-read-date (&optional with-time to-time from-string prompt
|
default-time default-input inactive)
|
"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,
|
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
|
mean next year. For details, see the manual. A few examples:
|
|
3-2-5 --> 2003-02-05
|
feb 15 --> currentyear-02-15
|
2/15 --> currentyear-02-15
|
sep 12 9 --> 2009-09-12
|
12:45 --> today 12:45
|
22 sept 0:34 --> currentyear-09-22 0:34
|
12 --> currentyear-currentmonth-12
|
Fri --> nearest Friday after today
|
-Tue --> last Tuesday
|
etc.
|
|
Furthermore you can specify a relative date by giving, as the *first* thing
|
in the input: a plus/minus sign, a number and a letter [hdwmy] to indicate
|
change in days weeks, months, years.
|
With a single plus or minus, the date is relative to today. With a double
|
plus or minus, it is relative to the date in DEFAULT-TIME. E.g.
|
+4d --> four days from today
|
+4 --> same as above
|
+2w --> two weeks from today
|
++5 --> five days from default date
|
|
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
|
months. To scroll it to other months, use the keys `>' and `<'.
|
If you don't like the calendar, turn it off with
|
(setq org-read-date-popup-calendar nil)
|
|
With optional argument TO-TIME, the date will immediately be converted
|
to an internal time.
|
With an optional argument WITH-TIME, the prompt will suggest to
|
also insert a time. Note that when WITH-TIME is not set, you can
|
still enter a time, and this function will inform the calling routine
|
about this change. The calling routine may then choose to change the
|
format used to insert the time stamp into the buffer to include the time.
|
With optional argument FROM-STRING, read from this string instead from
|
the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is
|
the time/date that is used for everything that is not specified by the
|
user."
|
(require 'parse-time)
|
(let* ((org-with-time with-time)
|
(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))
|
(org-def (or org-overriding-default-time default-time ct))
|
(org-defdecode (decode-time org-def))
|
(cur-frame (selected-frame))
|
(mouse-autoselect-window nil) ; Don't let the mouse jump
|
(calendar-setup
|
(and (eq calendar-setup 'calendar-only) 'calendar-only))
|
(calendar-move-hook nil)
|
(calendar-view-diary-initially-flag nil)
|
(calendar-view-holidays-initially-flag nil)
|
ans (org-ans0 "") org-ans1 org-ans2 final cal-frame)
|
;; Rationalize `org-def' and `org-defdecode', if required.
|
(when (< (nth 2 org-defdecode) org-extend-today-until)
|
(setf (nth 2 org-defdecode) -1)
|
(setf (nth 1 org-defdecode) 59)
|
(setq org-def (apply #'encode-time org-defdecode))
|
(setq org-defdecode (decode-time org-def)))
|
(let* ((timestr (format-time-string
|
(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))))
|
(cond
|
(from-string (setq ans from-string))
|
(org-read-date-popup-calendar
|
(save-excursion
|
(save-window-excursion
|
(calendar)
|
(when (eq calendar-setup 'calendar-only)
|
(setq cal-frame
|
(window-frame (get-buffer-window "*Calendar*" 'visible)))
|
(select-frame cal-frame))
|
(org-eval-in-calendar '(setq cursor-type nil) t)
|
(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 org-read-date-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)
|
(unwind-protect
|
(progn
|
(use-local-map map)
|
(setq org-read-date-inactive inactive)
|
(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*")
|
(when cal-frame
|
(delete-frame cal-frame)
|
(select-frame-set-input-focus cur-frame))))))
|
|
(t ; Naked prompt only
|
(unwind-protect
|
(setq ans (read-string prompt default-input
|
'org-read-date-history timestr))
|
(when org-read-date-overlay
|
(delete-overlay org-read-date-overlay)
|
(setq org-read-date-overlay nil))))))
|
|
(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)))
|
|
(setq org-read-date-final-answer ans)
|
|
(if to-time
|
(apply 'encode-time final)
|
(if (and (boundp 'org-time-was-given) org-time-was-given)
|
(format "%04d-%02d-%02d %02d:%02d"
|
(nth 5 final) (nth 4 final) (nth 3 final)
|
(nth 2 final) (nth 1 final))
|
(format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final))))))
|
|
(defun org-read-date-display ()
|
"Display the current date prompt interpretation in the minibuffer."
|
(when org-read-date-display-live
|
(when org-read-date-overlay
|
(delete-overlay org-read-date-overlay))
|
(when (minibufferp (current-buffer))
|
(save-excursion
|
(end-of-line 1)
|
(while (not (equal (buffer-substring
|
(max (point-min) (- (point) 4)) (point))
|
" "))
|
(insert " ")))
|
(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 org-def org-defdecode))
|
(fmts (if org-dcst
|
org-time-stamp-custom-formats
|
org-time-stamp-formats))
|
(fmt (if (or org-with-time
|
(and (boundp 'org-time-was-given) org-time-was-given))
|
(cdr fmts)
|
(car fmts)))
|
(txt (format-time-string fmt (apply 'encode-time f)))
|
(txt (if org-read-date-inactive (concat "[" (substring txt 1 -1) "]") txt))
|
(txt (concat "=> " txt)))
|
(when (and org-end-time-was-given
|
(string-match org-plain-time-of-day-regexp txt))
|
(setq txt (concat (substring txt 0 (match-end 0)) "-"
|
org-end-time-was-given
|
(substring txt (match-end 0)))))
|
(when org-read-date-analyze-futurep
|
(setq txt (concat txt " (=>F)")))
|
(setq org-read-date-overlay
|
(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)
|
"Analyze the combined answer of the date prompt."
|
;; FIXME: cleanup and comment
|
;; Pass `current-time' result to `decode-time' (instead of calling
|
;; without arguments) so that only `current-time' has to be
|
;; overridden in tests.
|
(let ((org-def def)
|
(org-defdecode defdecode)
|
(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-date futurep kill-year)
|
(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) org-def))
|
(setq ans (replace-match "" t t ans)
|
deltan (car delta)
|
deltaw (nth 1 delta)
|
deltadef (nth 2 delta)))
|
|
;; Check if there is an iso week date in there. If yes, store the
|
;; info and postpone interpreting it until the rest of the parsing
|
;; is done.
|
(when (string-match "\\<\\(?:\\([0-9]+\\)-\\)?[wW]\\([0-9]\\{1,2\\}\\)\\(?:-\\([0-6]\\)\\)?\\([ \t]\\|$\\)" ans)
|
(setq iso-year (when (match-end 1)
|
(org-small-year-to-year
|
(string-to-number (match-string 1 ans))))
|
iso-weekday (when (match-end 3)
|
(string-to-number (match-string 3 ans)))
|
iso-week (string-to-number (match-string 2 ans)))
|
(setq ans (replace-match "" t t ans)))
|
|
;; Help matching ISO dates with single digit month or day, like 2006-8-11.
|
(when (string-match
|
"^ *\\(\\([0-9]+\\)-\\)?\\([0-1]?[0-9]\\)-\\([0-3]?[0-9]\\)\\([^-0-9]\\|$\\)" ans)
|
(setq year (if (match-end 2)
|
(string-to-number (match-string 2 ans))
|
(progn (setq kill-year t)
|
(string-to-number (format-time-string "%Y"))))
|
month (string-to-number (match-string 3 ans))
|
day (string-to-number (match-string 4 ans)))
|
(setq year (org-small-year-to-year 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]\\{3\\}\\)?" ans)
|
(setq year (if (match-end 3) (string-to-number (match-string 3 ans))
|
(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" 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)
|
(setq year (if (match-end 4)
|
(string-to-number (match-string 4 ans))
|
(progn (setq kill-year t)
|
(string-to-number (format-time-string "%Y"))))
|
month (string-to-number (match-string 1 ans))
|
day (string-to-number (match-string 2 ans)))
|
(setq year (org-small-year-to-year year))
|
(setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day)
|
t nil ans)))
|
;; Help matching am/pm times, because `parse-time-string' does not do that.
|
;; If there is a time with am/pm, and *no* time without it, we convert
|
;; so that matching will be successful.
|
(cl-loop for i from 1 to 2 do ; twice, for end time as well
|
(when (and (not (string-match "\\(\\`\\|[^+]\\)[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans))
|
(string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans))
|
(setq hour (string-to-number (match-string 1 ans))
|
minute (if (match-end 3)
|
(string-to-number (match-string 3 ans))
|
0)
|
pm (equal ?p
|
(string-to-char (downcase (match-string 4 ans)))))
|
(if (and (= hour 12) (not pm))
|
(setq hour 0)
|
(when (and pm (< hour 12)) (setq hour (+ 12 hour))))
|
(setq ans (replace-match (format "%02d:%02d" hour minute)
|
t t ans))))
|
|
;; Check if a time range is given as a duration
|
(when (string-match "\\([012]?[0-9]\\):\\([0-6][0-9]\\)\\+\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?" ans)
|
(setq hour (string-to-number (match-string 1 ans))
|
h2 (+ hour (string-to-number (match-string 3 ans)))
|
minute (string-to-number (match-string 2 ans))
|
m2 (+ minute (if (match-end 5) (string-to-number
|
(match-string 5 ans))0)))
|
(when (>= m2 60) (setq h2 (1+ h2) m2 (- m2 60)))
|
(setq ans (replace-match (format "%02d:%02d-%02d:%02d" hour minute h2 m2)
|
t t ans)))
|
|
;; Check if there is a time range
|
(when (boundp 'org-end-time-was-given)
|
(setq org-time-was-given nil)
|
(when (and (string-match org-plain-time-of-day-regexp ans)
|
(match-end 8))
|
(setq org-end-time-was-given (match-string 8 ans))
|
(setq ans (concat (substring ans 0 (match-beginning 7))
|
(substring ans (match-end 7))))))
|
|
(setq tl (parse-time-string ans)
|
day (or (nth 3 tl) (nth 3 org-defdecode))
|
month
|
(cond ((nth 4 tl))
|
((not org-read-date-prefer-future) (nth 4 org-defdecode))
|
;; Day was specified. Make sure DAY+MONTH
|
;; combination happens in the future.
|
((nth 3 tl)
|
(setq futurep t)
|
(if (< day (nth 3 nowdecode)) (1+ (nth 4 nowdecode))
|
(nth 4 nowdecode)))
|
(t (nth 4 org-defdecode)))
|
year
|
(cond ((and (not kill-year) (nth 5 tl)))
|
((not org-read-date-prefer-future) (nth 5 org-defdecode))
|
;; Month was guessed in the future and is at least
|
;; equal to NOWDECODE's. Fix year accordingly.
|
(futurep
|
(if (or (> month (nth 4 nowdecode))
|
(>= day (nth 3 nowdecode)))
|
(nth 5 nowdecode)
|
(1+ (nth 5 nowdecode))))
|
;; Month was specified. Make sure MONTH+YEAR
|
;; combination happens in the future.
|
((nth 4 tl)
|
(setq futurep t)
|
(cond ((> month (nth 4 nowdecode)) (nth 5 nowdecode))
|
((< month (nth 4 nowdecode)) (1+ (nth 5 nowdecode)))
|
((< day (nth 3 nowdecode)) (1+ (nth 5 nowdecode)))
|
(t (nth 5 nowdecode))))
|
(t (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))
|
|
(when (and (eq org-read-date-prefer-future 'time)
|
(not (nth 3 tl)) (not (nth 4 tl)) (not (nth 5 tl))
|
(equal day (nth 3 nowdecode))
|
(equal month (nth 4 nowdecode))
|
(equal year (nth 5 nowdecode))
|
(nth 2 tl)
|
(or (< (nth 2 tl) (nth 2 nowdecode))
|
(and (= (nth 2 tl) (nth 2 nowdecode))
|
(nth 1 tl)
|
(< (nth 1 tl) (nth 1 nowdecode)))))
|
(setq day (1+ day)
|
futurep t))
|
|
;; Special date definitions below
|
(cond
|
(iso-week
|
;; There was an iso week
|
(require 'cal-iso)
|
(setq futurep nil)
|
(setq year (or iso-year year)
|
day (or iso-weekday wday 1)
|
wday nil ; to make sure that the trigger below does not match
|
iso-date (calendar-gregorian-from-absolute
|
(calendar-iso-to-absolute
|
(list iso-week day year))))
|
; FIXME: Should we also push ISO weeks into the future?
|
; (when (and org-read-date-prefer-future
|
; (not iso-year)
|
; (< (calendar-absolute-from-gregorian iso-date)
|
; (time-to-days (current-time))))
|
; (setq year (1+ year)
|
; iso-date (calendar-gregorian-from-absolute
|
; (calendar-iso-to-absolute
|
; (list iso-week day year)))))
|
(setq month (car iso-date)
|
year (nth 2 iso-date)
|
day (nth 1 iso-date)))
|
(deltan
|
(setq futurep nil)
|
(unless deltadef
|
;; Pass `current-time' result to `decode-time' (instead of
|
;; calling without arguments) so that only `current-time' has
|
;; to be overridden in tests.
|
(let ((now (decode-time (current-time))))
|
(setq day (nth 3 now) month (nth 4 now) year (nth 5 now))))
|
(cond ((member deltaw '("d" "")) (setq day (+ day deltan)))
|
((equal deltaw "w") (setq day (+ day (* 7 deltan))))
|
((equal deltaw "m") (setq month (+ month deltan)))
|
((equal deltaw "y") (setq year (+ year deltan)))))
|
((and wday (not (nth 3 tl)))
|
;; Weekday was given, but no day, so pick that day in the week
|
;; on or after the derived date.
|
(setq wday1 (nth 6 (decode-time (encode-time 0 0 0 day month year))))
|
(unless (equal wday wday1)
|
(setq day (+ day (% (- wday wday1 -7) 7))))))
|
(when (and (boundp 'org-time-was-given)
|
(nth 2 tl))
|
(setq org-time-was-given t))
|
(when (< year 100) (setq year (+ 2000 year)))
|
;; Check of the date is representable
|
(if org-read-date-force-compatible-dates
|
(progn
|
(when (< year 1970)
|
(setq year 1970 org-read-date-analyze-forced-year t))
|
(when (> 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.
|
Return shift list (N what def-flag)
|
WHAT is \"d\", \"w\", \"m\", or \"y\" for day, week, month, year.
|
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
|
"\\`[ \t]*\\([-+]\\{0,2\\}\\)"
|
"\\([0-9]+\\)?"
|
"\\([hdwmy]\\|\\(" (mapconcat 'car parse-time-weekdays "\\|") "\\)\\)?"
|
"\\([ \t]\\|$\\)") s)
|
(or (> (match-end 1) (match-beginning 1)) (match-end 4)))
|
(let* ((dir (if (> (match-end 1) (match-beginning 1))
|
(string-to-char (substring (match-string 1 s) -1))
|
?+))
|
(rel (and (match-end 1) (= 2 (- (match-end 1) (match-beginning 1)))))
|
(n (if (match-end 2) (string-to-number (match-string 2 s)) 1))
|
(what (if (match-end 3) (match-string 3 s) "d"))
|
(wday1 (cdr (assoc (downcase what) parse-time-weekdays)))
|
(date (if rel default today))
|
(wday (nth 6 (decode-time date)))
|
delta)
|
(if wday1
|
(progn
|
(setq delta (mod (+ 7 (- wday1 wday)) 7))
|
(when (= delta 0) (setq delta 7))
|
(when (= dir ?-)
|
(setq delta (- delta 7))
|
(when (= delta 0) (setq delta -7)))
|
(when (> n 1) (setq delta (+ delta (* (1- n) (if (= dir ?-) -7 7)))))
|
(list delta "d" rel))
|
(list (* n (if (= dir ?-) -1 1)) what rel)))))
|
|
(defun org-order-calendar-date-args (arg1 arg2 arg3)
|
"Turn a user-specified date into the internal representation.
|
The internal representation needed by the calendar is (month day year).
|
This is a wrapper to handle the brain-dead convention in calendar that
|
user function argument order change dependent on argument order."
|
(pcase calendar-date-style
|
(`american (list arg1 arg2 arg3))
|
(`european (list arg2 arg1 arg3))
|
(`iso (list arg2 arg3 arg1))))
|
|
(defun org-eval-in-calendar (form &optional keepdate)
|
"Eval FORM in the calendar window and return to current window.
|
Unless KEEPDATE is non-nil, update `org-ans2' to the cursor date."
|
(let ((sf (selected-frame))
|
(sw (selected-window)))
|
(select-window (get-buffer-window "*Calendar*" t))
|
(eval form)
|
(when (and (not keepdate) (calendar-cursor-to-date))
|
(let* ((date (calendar-cursor-to-date))
|
(time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
|
(setq org-ans2 (format-time-string "%Y-%m-%d" time))))
|
(move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer))
|
(select-window sw)
|
(select-frame-set-input-focus sf)))
|
|
(defun org-calendar-select ()
|
"Return to `org-read-date' with the date currently selected.
|
This is used by `org-read-date' in a temporary keymap for the calendar buffer."
|
(interactive)
|
(when (calendar-cursor-to-date)
|
(let* ((date (calendar-cursor-to-date))
|
(time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
|
(setq org-ans1 (format-time-string "%Y-%m-%d" time)))
|
(when (active-minibuffer-window) (exit-minibuffer))))
|
|
(defun org-insert-time-stamp (time &optional with-hm inactive pre post extra)
|
"Insert a date stamp for the date given by the internal TIME.
|
See `format-time-string' for the format of TIME.
|
WITH-HM means use the stamp format that includes the time of the day.
|
INACTIVE means use square brackets instead of angular ones, so that the
|
stamp will not contribute to the agenda.
|
PRE and POST are optional strings to be inserted before and after the
|
stamp.
|
The command returns the inserted time stamp."
|
(let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats))
|
stamp)
|
(when inactive (setq fmt (concat "[" (substring fmt 1 -1) "]")))
|
(insert-before-markers (or pre ""))
|
(when (listp extra)
|
(setq extra (car extra))
|
(if (and (stringp extra)
|
(string-match "\\([0-9]+\\):\\([0-9]+\\)" extra))
|
(setq extra (format "-%02d:%02d"
|
(string-to-number (match-string 1 extra))
|
(string-to-number (match-string 2 extra))))
|
(setq extra nil)))
|
(when extra
|
(setq fmt (concat (substring fmt 0 -1) extra (substring fmt -1))))
|
(insert-before-markers (setq stamp (format-time-string fmt time)))
|
(insert-before-markers (or post ""))
|
(setq org-last-inserted-timestamp stamp)))
|
|
(defun org-toggle-time-stamp-overlays ()
|
"Toggle the use of custom time stamp formats."
|
(interactive)
|
(setq org-display-custom-times (not org-display-custom-times))
|
(unless org-display-custom-times
|
(let ((p (point-min)) (bmp (buffer-modified-p)))
|
(while (setq p (next-single-property-change p 'display))
|
(when (and (get-text-property p 'display)
|
(eq (get-text-property p 'face) 'org-date))
|
(remove-text-properties
|
p (setq p (next-single-property-change p 'display))
|
'(display t))))
|
(set-buffer-modified-p bmp)))
|
(org-restart-font-lock)
|
(setq org-table-may-need-update t)
|
(if org-display-custom-times
|
(message "Time stamps are overlaid with custom format")
|
(message "Time stamp overlays removed")))
|
|
(defun org-display-custom-time (beg end)
|
"Overlay modified time stamp format over timestamp between BEG and END."
|
(let* ((ts (buffer-substring beg end))
|
t1 with-hm tf time str (off 0))
|
(save-match-data
|
(setq t1 (org-parse-time-string ts t))
|
(when (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)?\\'" ts)
|
(setq off (- (match-end 0) (match-beginning 0)))))
|
(setq end (- end off))
|
(setq with-hm (and (nth 1 t1) (nth 2 t1))
|
tf (funcall (if with-hm 'cdr 'car) org-time-stamp-custom-formats)
|
time (org-fix-decoded-time t1)
|
str (org-add-props
|
(format-time-string
|
(substring tf 1 -1) (apply 'encode-time time))
|
nil 'mouse-face 'highlight))
|
(put-text-property beg end 'display str)))
|
|
(defun org-fix-decoded-time (time)
|
"Set 0 instead of nil for the first 6 elements of time.
|
Don't touch the rest."
|
(let ((n 0))
|
(mapcar (lambda (x) (if (< (setq n (1+ n)) 7) (or x 0) x)) time)))
|
|
(defun org-time-stamp-to-now (timestamp-string &optional seconds)
|
"Difference between TIMESTAMP-STRING and now in days.
|
If SECONDS is non-nil, return the difference in seconds."
|
(let ((fdiff (if seconds #'float-time #'time-to-days)))
|
(- (funcall fdiff (org-time-string-to-time timestamp-string))
|
(funcall fdiff (current-time)))))
|
|
(defun org-deadline-close-p (timestamp-string &optional ndays)
|
"Is the time in TIMESTAMP-STRING close to the current date?"
|
(setq ndays (or ndays (org-get-wdays timestamp-string)))
|
(and (<= (org-time-stamp-to-now timestamp-string) ndays)
|
(not (org-entry-is-done-p))))
|
|
(defun org-get-wdays (ts &optional delay zero-delay)
|
"Get the deadline lead time appropriate for timestring TS.
|
When DELAY is non-nil, get the delay time for scheduled items
|
instead of the deadline lead time. When ZERO-DELAY is non-nil
|
and `org-scheduled-delay-days' is 0, enforce 0 as the delay,
|
don't try to find the delay cookie in the scheduled timestamp."
|
(let ((tv (if delay org-scheduled-delay-days
|
org-deadline-warning-days)))
|
(cond
|
((or (and delay (< tv 0))
|
(and delay zero-delay (<= tv 0))
|
(and (not delay) (<= tv 0)))
|
;; Enforce this value no matter what
|
(- tv))
|
((string-match "-\\([0-9]+\\)\\([hdwmy]\\)\\(\\'\\|>\\| \\)" ts)
|
;; lead time is specified.
|
(floor (* (string-to-number (match-string 1 ts))
|
(cdr (assoc (match-string 2 ts)
|
'(("d" . 1) ("w" . 7)
|
("m" . 30.4) ("y" . 365.25)
|
("h" . 0.041667)))))))
|
;; go for the default.
|
(t tv))))
|
|
(defun org-calendar-select-mouse (ev)
|
"Return to `org-read-date' with the date currently selected.
|
This is used by `org-read-date' in a temporary keymap for the calendar buffer."
|
(interactive "e")
|
(mouse-set-point ev)
|
(when (calendar-cursor-to-date)
|
(let* ((date (calendar-cursor-to-date))
|
(time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
|
(setq org-ans1 (format-time-string "%Y-%m-%d" time)))
|
(when (active-minibuffer-window) (exit-minibuffer))))
|
|
(defun org-check-deadlines (ndays)
|
"Check if there are any deadlines due or past due.
|
A deadline is considered due if it happens within `org-deadline-warning-days'
|
days from today's date. If the deadline appears in an entry marked DONE,
|
it is not shown. A numeric prefix argument NDAYS can be used to test that
|
many days. If the prefix is a raw `\\[universal-argument]', all deadlines \
|
are shown."
|
(interactive "P")
|
(let* ((org-warn-days
|
(cond
|
((equal ndays '(4)) 100000)
|
(ndays (prefix-numeric-value ndays))
|
(t (abs org-deadline-warning-days))))
|
(case-fold-search nil)
|
(regexp (concat "\\<" org-deadline-string " *<\\([^>]+\\)>"))
|
(callback
|
(lambda () (org-deadline-close-p (match-string 1) org-warn-days))))
|
(message "%d deadlines past-due or due within %d days"
|
(org-occur regexp nil callback)
|
org-warn-days)))
|
|
(defsubst org-re-timestamp (type)
|
"Return a regexp for timestamp TYPE.
|
Allowed values for TYPE are:
|
|
all: all timestamps
|
active: only active timestamps (<...>)
|
inactive: only inactive timestamps ([...])
|
scheduled: only scheduled timestamps
|
deadline: only deadline timestamps
|
closed: only closed time-stamps
|
|
When TYPE is nil, fall back on returning a regexp that matches
|
both scheduled and deadline timestamps."
|
(cl-case type
|
(all org-ts-regexp-both)
|
(active org-ts-regexp)
|
(inactive org-ts-regexp-inactive)
|
(scheduled org-scheduled-time-regexp)
|
(deadline org-deadline-time-regexp)
|
(closed org-closed-time-regexp)
|
(otherwise
|
(concat "\\<"
|
(regexp-opt (list org-deadline-string org-scheduled-string))
|
" *<\\([^>]+\\)>"))))
|
|
(defun org-check-before-date (d)
|
"Check if there are deadlines or scheduled entries before date D."
|
(interactive (list (org-read-date)))
|
(let* ((case-fold-search nil)
|
(regexp (org-re-timestamp org-ts-type))
|
(ts-type org-ts-type)
|
(callback
|
(lambda ()
|
(let ((match (match-string 1)))
|
(and (if (memq ts-type '(active inactive all))
|
(eq (org-element-type (save-excursion
|
(backward-char)
|
(org-element-context)))
|
'timestamp)
|
(org-at-planning-p))
|
(time-less-p
|
(org-time-string-to-time match)
|
(org-time-string-to-time d)))))))
|
(message "%d entries before %s"
|
(org-occur regexp nil callback)
|
d)))
|
|
(defun org-check-after-date (d)
|
"Check if there are deadlines or scheduled entries after date D."
|
(interactive (list (org-read-date)))
|
(let* ((case-fold-search nil)
|
(regexp (org-re-timestamp org-ts-type))
|
(ts-type org-ts-type)
|
(callback
|
(lambda ()
|
(let ((match (match-string 1)))
|
(and (if (memq ts-type '(active inactive all))
|
(eq (org-element-type (save-excursion
|
(backward-char)
|
(org-element-context)))
|
'timestamp)
|
(org-at-planning-p))
|
(not (time-less-p
|
(org-time-string-to-time match)
|
(org-time-string-to-time d))))))))
|
(message "%d entries after %s"
|
(org-occur regexp nil callback)
|
d)))
|
|
(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 (org-re-timestamp org-ts-type))
|
(callback
|
(let ((type org-ts-type))
|
(lambda ()
|
(let ((match (match-string 1)))
|
(and
|
(if (memq type '(active inactive all))
|
(eq (org-element-type (save-excursion
|
(backward-char)
|
(org-element-context)))
|
'timestamp)
|
(org-at-planning-p))
|
(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
|
TO-BUFFER, the result is inserted just after the date stamp into the buffer.
|
If the time range is actually in a table, the result is inserted into the
|
next column.
|
For time difference computation, a year is assumed to be exactly 365
|
days in order to avoid rounding problems."
|
(interactive "P")
|
(or
|
(org-clock-update-time-maybe)
|
(save-excursion
|
(unless (org-at-date-range-p t)
|
(goto-char (point-at-bol))
|
(re-search-forward org-tr-regexp-both (point-at-eol) t))
|
(unless (org-at-date-range-p t)
|
(user-error "Not at a time-stamp range, and none found in current line")))
|
(let* ((ts1 (match-string 1))
|
(ts2 (match-string 2))
|
(havetime (or (> (length ts1) 15) (> (length ts2) 15)))
|
(match-end (match-end 0))
|
(time1 (org-time-string-to-time ts1))
|
(time2 (org-time-string-to-time ts2))
|
(t1 (float-time time1))
|
(t2 (float-time time2))
|
(diff (abs (- t2 t1)))
|
(negative (< (- t2 t1) 0))
|
;; (ys (floor (* 365 24 60 60)))
|
(ds (* 24 60 60))
|
(hs (* 60 60))
|
(fy "%dy %dd %02d:%02d")
|
(fy1 "%dy %dd")
|
(fd "%dd %02d:%02d")
|
(fd1 "%dd")
|
(fh "%02d:%02d")
|
y d h m align)
|
(if havetime
|
(setq ; y (floor (/ diff ys)) diff (mod diff ys)
|
y 0
|
d (floor (/ diff ds)) diff (mod diff ds)
|
h (floor (/ diff hs)) diff (mod diff hs)
|
m (floor (/ diff 60)))
|
(setq ; y (floor (/ diff ys)) diff (mod diff ys)
|
y 0
|
d (floor (+ (/ diff ds) 0.5))
|
h 0 m 0))
|
(if (not to-buffer)
|
(message "%s" (org-make-tdiff-string y d h m))
|
(if (org-at-table-p)
|
(progn
|
(goto-char match-end)
|
(setq align t)
|
(and (looking-at " *|") (goto-char (match-end 0))))
|
(goto-char match-end))
|
(when (looking-at
|
"\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]")
|
(replace-match ""))
|
(when negative (insert " -"))
|
(if (> y 0) (insert " " (format (if havetime fy fy1) y d h m))
|
(if (> d 0) (insert " " (format (if havetime fd fd1) d h m))
|
(insert " " (format fh h m))))
|
(when align (org-table-align))
|
(message "Time difference inserted")))))
|
|
(defun org-make-tdiff-string (y d h m)
|
(let ((fmt "")
|
(l nil))
|
(when (> y 0)
|
(setq fmt (concat fmt "%d year" (if (> y 1) "s" "") " "))
|
(push y l))
|
(when (> d 0)
|
(setq fmt (concat fmt "%d day" (if (> d 1) "s" "") " "))
|
(push d l))
|
(when (> h 0)
|
(setq fmt (concat fmt "%d hour" (if (> h 1) "s" "") " "))
|
(push h l))
|
(when (> m 0)
|
(setq fmt (concat fmt "%d minute" (if (> m 1) "s" "") " "))
|
(push m l))
|
(apply 'format fmt (nreverse l))))
|
|
(defun org-time-string-to-time (s)
|
"Convert timestamp string S into internal time."
|
(apply #'encode-time (org-parse-time-string s)))
|
|
(defun org-time-string-to-seconds (s)
|
"Convert a timestamp string S into a number of seconds."
|
(float-time (org-time-string-to-time s)))
|
|
(org-define-error 'org-diary-sexp-no-match "Unable to match diary sexp")
|
|
(defun org-time-string-to-absolute (s &optional daynr prefer buffer pos)
|
"Convert time stamp S to an absolute day number.
|
|
If DAYNR in non-nil, and there is a specifier for a cyclic time
|
stamp, get the closest date to DAYNR. If PREFER is
|
`past' (respectively `future') return a date past (respectively
|
after) or equal to DAYNR.
|
|
POS is the location of time stamp S, as a buffer position in
|
BUFFER.
|
|
Diary sexp timestamps are matched against DAYNR, when non-nil.
|
If matching fails or DAYNR is nil, `org-diary-sexp-no-match' is
|
signaled."
|
(cond
|
((string-match "\\`%%\\((.*)\\)" s)
|
;; Sexp timestamp: try to match DAYNR, if available, since we're
|
;; only able to match individual dates. If it fails, raise an
|
;; error.
|
(if (and daynr
|
(org-diary-sexp-entry
|
(match-string 1 s) "" (calendar-gregorian-from-absolute daynr)))
|
daynr
|
(signal 'org-diary-sexp-no-match (list s))))
|
(daynr (org-closest-date s daynr prefer))
|
(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-message " at %d in buffer `%s'" pos buffer))
|
(cdr errdata))))))))
|
|
(defun org-days-to-iso-week (days)
|
"Return the iso week number."
|
(require 'cal-iso)
|
(car (calendar-iso-from-absolute days)))
|
|
(defun org-small-year-to-year (year)
|
"Convert 2-digit years into 4-digit years.
|
YEAR is expanded into one of the 30 next years, if possible, or
|
into a past one. Any year larger than 99 is returned unchanged."
|
(if (>= year 100) year
|
(let* ((current (string-to-number (format-time-string "%Y" (current-time))))
|
(century (/ current 100))
|
(offset (- year (% current 100))))
|
(cond ((> offset 30) (+ (* (1- century) 100) year))
|
((> offset -70) (+ (* century 100) year))
|
(t (+ (* (1+ century) 100) year))))))
|
|
(defun org-time-from-absolute (d)
|
"Return the time corresponding to date D.
|
D may be an absolute day number, or a calendar-type list (month day year)."
|
(when (numberp d) (setq d (calendar-gregorian-from-absolute d)))
|
(encode-time 0 0 0 (nth 1 d) (car d) (nth 2 d)))
|
|
(defvar org-agenda-current-date)
|
(defun org-calendar-holiday ()
|
"List of holidays, for Diary display in Org mode."
|
(require 'holidays)
|
(let ((hl (calendar-check-holidays org-agenda-current-date)))
|
(and hl (mapconcat #'identity hl "; "))))
|
|
(defun org-diary-sexp-entry (sexp entry d)
|
"Process a SEXP diary ENTRY for date D."
|
(require 'diary-lib)
|
;; `org-anniversary' and alike expect ENTRY and DATE to be bound
|
;; dynamically.
|
(let* ((sexp `(let ((entry ,entry)
|
(date ',d))
|
,(car (read-from-string sexp))))
|
(result (if calendar-debug-sexp (eval sexp)
|
(condition-case nil
|
(eval sexp)
|
(error
|
(beep)
|
(message "Bad sexp at line %d in %s: %s"
|
(org-current-line)
|
(buffer-file-name) sexp)
|
(sleep-for 2))))))
|
(cond ((stringp result) (split-string result "; "))
|
((and (consp result)
|
(not (consp (cdr result)))
|
(stringp (cdr result))) (cdr result))
|
((and (consp result)
|
(stringp (car result))) result)
|
(result entry))))
|
|
(defun org-diary-to-ical-string (frombuf)
|
"Get iCalendar entries from diary entries in buffer FROMBUF.
|
This uses the icalendar.el library."
|
(let* ((tmpdir temporary-file-directory)
|
(tmpfile (make-temp-name
|
(expand-file-name "orgics" tmpdir)))
|
buf rtn b e)
|
(with-current-buffer frombuf
|
(icalendar-export-region (point-min) (point-max) tmpfile)
|
(setq buf (find-buffer-visiting tmpfile))
|
(set-buffer buf)
|
(goto-char (point-min))
|
(when (re-search-forward "^BEGIN:VEVENT" nil t)
|
(setq b (match-beginning 0)))
|
(goto-char (point-max))
|
(when (re-search-backward "^END:VEVENT" nil t)
|
(setq e (match-end 0)))
|
(setq rtn (if (and b e) (concat (buffer-substring b e) "\n") "")))
|
(kill-buffer buf)
|
(delete-file tmpfile)
|
rtn))
|
|
(defun org-closest-date (start current prefer)
|
"Return closest date to CURRENT starting from START.
|
|
CURRENT and START are both time stamps.
|
|
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.
|
|
Only time stamps with a repeater are modified. Any other time
|
stamp stay unchanged. In any case, return value is an absolute
|
day number."
|
(if (not (string-match "\\+\\([0-9]+\\)\\([hdwmy]\\)" start))
|
;; No repeater. Do not shift time stamp.
|
(time-to-days (apply #'encode-time (org-parse-time-string start)))
|
(let ((value (string-to-number (match-string 1 start)))
|
(type (match-string 2 start)))
|
(if (= 0 value)
|
;; Repeater with a 0-value is considered as void.
|
(time-to-days (apply #'encode-time (org-parse-time-string start)))
|
(let* ((base (org-date-to-gregorian start))
|
(target (org-date-to-gregorian current))
|
(sday (calendar-absolute-from-gregorian base))
|
(cday (calendar-absolute-from-gregorian target))
|
n1 n2)
|
;; If START is already past CURRENT, just return START.
|
(if (<= cday sday) sday
|
;; Compute closest date before (N1) and closest date past
|
;; (N2) CURRENT.
|
(pcase type
|
("h"
|
(let ((missing-hours
|
(mod (+ (- (* 24 (- cday sday))
|
(nth 2 (org-parse-time-string start)))
|
org-extend-today-until)
|
value)))
|
(setf n1 (if (= missing-hours 0) cday
|
(- cday (1+ (/ missing-hours 24)))))
|
(setf n2 (+ cday (/ (- value missing-hours) 24)))))
|
((or "d" "w")
|
(let ((value (if (equal type "w") (* 7 value) value)))
|
(setf n1 (+ sday (* value (/ (- cday sday) value))))
|
(setf n2 (+ n1 value))))
|
("m"
|
(let* ((add-months
|
(lambda (d n)
|
;; Add N months to gregorian date D, i.e.,
|
;; a list (MONTH DAY YEAR). Return a valid
|
;; gregorian date.
|
(let ((m (+ (nth 0 d) n)))
|
(list (mod m 12)
|
(nth 1 d)
|
(+ (/ m 12) (nth 2 d))))))
|
(months ; Complete months to TARGET.
|
(* (/ (+ (* 12 (- (nth 2 target) (nth 2 base)))
|
(- (nth 0 target) (nth 0 base))
|
;; If START's day is greater than
|
;; TARGET's, remove incomplete month.
|
(if (> (nth 1 target) (nth 1 base)) 0 -1))
|
value)
|
value))
|
(before (funcall add-months base months)))
|
(setf n1 (calendar-absolute-from-gregorian before))
|
(setf n2
|
(calendar-absolute-from-gregorian
|
(funcall add-months before value)))))
|
(_
|
(let* ((d (nth 1 base))
|
(m (nth 0 base))
|
(y (nth 2 base))
|
(years ; Complete years to TARGET.
|
(* (/ (- (nth 2 target)
|
y
|
;; If START's month and day are
|
;; greater than TARGET's, remove
|
;; incomplete year.
|
(if (or (> (nth 0 target) m)
|
(and (= (nth 0 target) m)
|
(> (nth 1 target) d)))
|
0
|
1))
|
value)
|
value))
|
(before (list m d (+ y years))))
|
(setf n1 (calendar-absolute-from-gregorian before))
|
(setf n2 (calendar-absolute-from-gregorian
|
(list m d (+ (nth 2 before) value)))))))
|
;; Handle PREFER parameter, if any.
|
(cond
|
((eq prefer 'past) (if (= cday n2) n2 n1))
|
((eq prefer 'future) (if (= cday n1) n1 n2))
|
(t (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1)))))))))
|
|
(defun org-date-to-gregorian (d)
|
"Turn any specification of date D into a Gregorian date for the calendar."
|
(cond ((integerp d) (calendar-gregorian-from-absolute d))
|
((and (listp d) (= (length d) 3)) d)
|
((stringp d)
|
(let ((d (org-parse-time-string d)))
|
(list (nth 4 d) (nth 3 d) (nth 5 d))))
|
((listp d) (list (nth 4 d) (nth 3 d) (nth 5 d)))))
|
|
(defun org-parse-time-string (s &optional nodefault)
|
"Parse the standard Org time string.
|
|
This should be a lot faster than the normal `parse-time-string'.
|
|
If time is not given, defaults to 0:00. However, with optional
|
NODEFAULT, hour and minute fields will be nil if not given."
|
(cond ((string-match org-ts-regexp0 s)
|
(list 0
|
(when (or (match-beginning 8) (not nodefault))
|
(string-to-number (or (match-string 8 s) "0")))
|
(when (or (match-beginning 7) (not nodefault))
|
(string-to-number (or (match-string 7 s) "0")))
|
(string-to-number (match-string 4 s))
|
(string-to-number (match-string 3 s))
|
(string-to-number (match-string 2 s))
|
nil nil nil))
|
((string-match "^<[^>]+>$" s)
|
;; FIXME: `decode-time' needs to be called with ZONE as its
|
;; second argument. However, this requires at least Emacs
|
;; 25.1. We can do it when we switch to this version as our
|
;; minimal requirement.
|
(decode-time (seconds-to-time (org-matcher-time s))))
|
(t (error "Not a standard Org time string: %s" s))))
|
|
(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,
|
the day or the time, change that. If the cursor is on the enclosing
|
bracket, change the timestamp type.
|
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,
|
the day or the time, change that. If the cursor is on the enclosing
|
bracket, change the timestamp type.
|
With prefix ARG, change by that many units."
|
(interactive "p")
|
(org-timestamp-change (- (prefix-numeric-value arg)) nil 'updown))
|
|
(defun org-timestamp-up-day (&optional arg)
|
"Increase the date in the time stamp by one day.
|
With prefix ARG, change that many days."
|
(interactive "p")
|
(if (and (not (org-at-timestamp-p 'lax))
|
(org-at-heading-p))
|
(org-todo 'up)
|
(org-timestamp-change (prefix-numeric-value arg) 'day 'updown)))
|
|
(defun org-timestamp-down-day (&optional arg)
|
"Decrease the date in the time stamp by one day.
|
With prefix ARG, change that many days."
|
(interactive "p")
|
(if (and (not (org-at-timestamp-p 'lax))
|
(org-at-heading-p))
|
(org-todo 'down)
|
(org-timestamp-change (- (prefix-numeric-value arg)) 'day) 'updown))
|
|
(defun org-at-timestamp-p (&optional extended)
|
"Non-nil if point is inside a timestamp.
|
|
By default, the function only consider syntactically valid active
|
timestamps. However, the caller may have a broader definition
|
for timestamps. As a consequence, optional argument EXTENDED can
|
be set to the following values
|
|
`inactive'
|
|
Include also syntactically valid inactive timestamps.
|
|
`agenda'
|
|
Include timestamps allowed in Agenda, i.e., those in
|
properties drawers, planning lines and clock lines.
|
|
`lax'
|
|
Ignore context. The function matches any part of the
|
document looking like a timestamp. This includes comments,
|
example blocks...
|
|
For backward-compatibility with Org 9.0, every other non-nil
|
value is equivalent to `inactive'.
|
|
When at a timestamp, return the position of the point as a symbol
|
among `bracket', `after', `year', `month', `hour', `minute',
|
`day' or a number of character from the last know part of the
|
time stamp.
|
|
When matching, the match groups are the following:
|
group 1: year
|
group 2: month
|
group 3: day number
|
group 4: day name
|
group 5: hours, if any
|
group 6: minutes, if any"
|
(let* ((regexp (if extended org-ts-regexp3 org-ts-regexp2))
|
(pos (point))
|
(match?
|
(let ((boundaries (org-in-regexp regexp)))
|
(save-match-data
|
(cond ((null boundaries) nil)
|
((eq extended 'lax) t)
|
(t
|
(or (and (eq extended 'agenda)
|
(or (org-at-planning-p)
|
(org-at-property-p)
|
(and (bound-and-true-p
|
org-agenda-include-inactive-timestamps)
|
(org-at-clock-log-p))))
|
(eq 'timestamp
|
(save-excursion
|
(when (= pos (cdr boundaries)) (forward-char -1))
|
(org-element-type (org-element-context)))))))))))
|
(cond
|
((not match?) nil)
|
((= pos (match-beginning 0)) 'bracket)
|
;; Distinguish location right before the closing bracket from
|
;; right after it.
|
((= pos (1- (match-end 0))) 'bracket)
|
((= pos (match-end 0)) 'after)
|
((org-pos-in-match-range pos 2) 'year)
|
((org-pos-in-match-range pos 3) 'month)
|
((org-pos-in-match-range pos 7) 'hour)
|
((org-pos-in-match-range pos 8) 'minute)
|
((or (org-pos-in-match-range pos 4)
|
(org-pos-in-match-range pos 5)) 'day)
|
((and (> pos (or (match-end 8) (match-end 5)))
|
(< pos (match-end 0)))
|
(- pos (or (match-end 8) (match-end 5))))
|
(t 'day))))
|
|
(defun org-toggle-timestamp-type ()
|
"Toggle the type (<active> or [inactive]) of a time stamp."
|
(interactive)
|
(when (org-at-timestamp-p 'lax)
|
(let ((beg (match-beginning 0)) (end (match-end 0))
|
(map '((?\[ . "<") (?\] . ">") (?< . "[") (?> . "]"))))
|
(save-excursion
|
(goto-char beg)
|
(while (re-search-forward "[][<>]" end t)
|
(replace-match (cdr (assoc (char-after (match-beginning 0)) map))
|
t t)))
|
(message "Timestamp is now %sactive"
|
(if (equal (char-after beg) ?<) "" "in")))))
|
|
(defun org-at-clock-log-p ()
|
"Non-nil if point is on a clock log line."
|
(and (org-match-line org-clock-line-re)
|
(eq (org-element-type (save-match-data (org-element-at-point))) 'clock)))
|
|
(defvar org-clock-history) ; defined in org-clock.el
|
(defvar org-clock-adjust-closest nil) ; defined in org-clock.el
|
(defun org-timestamp-change (n &optional what updown suppress-tmp-delay)
|
"Change the date in the time stamp at point.
|
The date will be changed by N times WHAT. WHAT can be `day', `month',
|
`year', `minute', `second'. If WHAT is not given, the cursor position
|
in the timestamp determines what will be changed.
|
When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
|
(let ((origin (point))
|
(timestamp? (org-at-timestamp-p 'lax))
|
origin-cat
|
with-hm inactive
|
(dm (max (nth 1 org-time-stamp-rounding-minutes) 1))
|
extra rem
|
ts time time0 fixnext clrgx)
|
(unless timestamp? (user-error "Not at a timestamp"))
|
(if (and (not what) (eq timestamp? '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 timestamp?)
|
(when (and (not what) (not (eq timestamp? 'day))
|
org-display-custom-times
|
(get-text-property (point) 'display)
|
(not (get-text-property (1- (point)) 'display)))
|
(setq timestamp? 'day))
|
(setq timestamp? (or what timestamp?)
|
inactive (= (char-after (match-beginning 0)) ?\[)
|
ts (match-string 0))
|
(replace-match "")
|
(when (string-match
|
"\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?-?[-+][0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)*\\)[]>]"
|
ts)
|
(setq extra (match-string 1 ts))
|
(when suppress-tmp-delay
|
(setq extra (replace-regexp-in-string " --[0-9]+[hdwmy]" "" extra))))
|
(when (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts)
|
(setq with-hm t))
|
(setq time0 (org-parse-time-string ts))
|
(when (and updown
|
(eq timestamp? 'minute)
|
(not current-prefix-arg))
|
;; This looks like s-up and s-down. Change by one rounding step.
|
(setq n (* dm (cond ((> n 0) 1) ((< n 0) -1) (t 0))))
|
(unless (= 0 (setq rem (% (nth 1 time0) dm)))
|
(setcar (cdr time0) (+ (nth 1 time0)
|
(if (> n 0) (- rem) (- dm rem))))))
|
(setq time
|
(apply #'encode-time
|
(or (car time0) 0)
|
(+ (if (eq timestamp? 'minute) n 0) (nth 1 time0))
|
(+ (if (eq timestamp? 'hour) n 0) (nth 2 time0))
|
(+ (if (eq timestamp? 'day) n 0) (nth 3 time0))
|
(+ (if (eq timestamp? 'month) n 0) (nth 4 time0))
|
(+ (if (eq timestamp? 'year) n 0) (nth 5 time0))
|
(nthcdr 6 time0)))
|
(when (and (memq timestamp? '(hour minute))
|
extra
|
(string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra))
|
(setq extra (org-modify-ts-extra
|
extra
|
(if (eq timestamp? 'hour) 2 5)
|
n dm)))
|
(when (integerp timestamp?)
|
(setq extra (org-modify-ts-extra extra timestamp? n dm)))
|
(when (eq what 'calendar)
|
(let ((cal-date (org-get-date-from-calendar)))
|
(setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month
|
(setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day
|
(setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year
|
(setcar time0 (or (car time0) 0))
|
(setcar (nthcdr 1 time0) (or (nth 1 time0) 0))
|
(setcar (nthcdr 2 time0) (or (nth 2 time0) 0))
|
(setq time (apply 'encode-time time0))))
|
;; 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
|
(pcase origin-cat
|
;; `day' category ends before `hour' if any, or at the end
|
;; of the day name.
|
(`day (min (or (match-beginning 7) (1- (match-end 5))) origin))
|
(`hour (min (match-end 7) origin))
|
(`minute (min (1- (match-end 8)) origin))
|
((pred integerp) (min (1- (match-end 0)) origin))
|
;; Point was right after the time-stamp. However, the
|
;; time-stamp length might have changed, so refer to
|
;; (match-end 0) instead.
|
(`after (match-end 0))
|
;; `year' and `month' have both fixed size: point couldn't
|
;; have moved into another part.
|
(_ origin))))
|
;; Update clock if on a CLOCK line.
|
(org-clock-update-time-maybe)
|
;; Maybe adjust the closest clock in `org-clock-history'
|
(when org-clock-adjust-closest
|
(if (not (and (org-at-clock-log-p)
|
(< 1 (length (delq nil (mapcar 'marker-position
|
org-clock-history))))))
|
(message "No clock to adjust")
|
(cond ((save-excursion ; fix previous clock?
|
(re-search-backward org-ts-regexp0 nil t)
|
(looking-back (concat org-clock-string " \\[")
|
(line-beginning-position)))
|
(setq fixnext 1 clrgx (concat org-ts-regexp0 "\\] =>.*$")))
|
((save-excursion ; fix next clock?
|
(re-search-backward org-ts-regexp0 nil t)
|
(looking-at (concat org-ts-regexp0 "\\] =>")))
|
(setq fixnext -1 clrgx (concat org-clock-string " \\[" org-ts-regexp0))))
|
(save-window-excursion
|
;; Find closest clock to point, adjust the previous/next one in history
|
(let* ((p (save-excursion (org-back-to-heading t)))
|
(cl (mapcar (lambda(c) (abs (- (marker-position c) p))) org-clock-history))
|
(clfixnth
|
(+ fixnext (- (length cl) (or (length (member (apply 'min cl) cl)) 100))))
|
(clfixpos (unless (> 0 clfixnth) (nth clfixnth org-clock-history))))
|
(if (not clfixpos)
|
(message "No clock to adjust")
|
(save-excursion
|
(org-goto-marker-or-bmk clfixpos)
|
(org-show-subtree)
|
(when (re-search-forward clrgx nil t)
|
(goto-char (match-beginning 1))
|
(let (org-clock-adjust-closest)
|
(org-timestamp-change n timestamp? updown))
|
(message "Clock adjusted in %s for heading: %s"
|
(file-name-nondirectory (buffer-file-name))
|
(org-get-heading t t)))))))))
|
;; Try to recenter the calendar window, if any.
|
(when (and org-calendar-follow-timestamp-change
|
(get-buffer-window "*Calendar*" t)
|
(memq timestamp? '(day month year)))
|
(org-recenter-calendar (time-to-days time))))))
|
|
(defun org-modify-ts-extra (s pos n dm)
|
"Change the different parts of the lead-time and repeat fields in timestamp."
|
(let ((idx '(("d" . 0) ("w" . 1) ("m" . 2) ("y" . 3) ("d" . -1) ("y" . 4)))
|
ng h m new rem)
|
(when (string-match "\\(-\\([012][0-9]\\):\\([0-5][0-9]\\)\\)?\\( +\\+\\([0-9]+\\)\\([dmwy]\\)\\)?\\( +-\\([0-9]+\\)\\([dmwy]\\)\\)?" s)
|
(cond
|
((or (org-pos-in-match-range pos 2)
|
(org-pos-in-match-range pos 3))
|
(setq m (string-to-number (match-string 3 s))
|
h (string-to-number (match-string 2 s)))
|
(if (org-pos-in-match-range pos 2)
|
(setq h (+ h n))
|
(setq n (* dm (with-no-warnings (signum n))))
|
(unless (= 0 (setq rem (% m dm)))
|
(setq m (+ m (if (> n 0) (- rem) (- dm rem)))))
|
(setq m (+ m n)))
|
(when (< m 0) (setq m (+ m 60) h (1- h)))
|
(when (> m 59) (setq m (- m 60) h (1+ h)))
|
(setq h (mod h 24))
|
(setq ng 1 new (format "-%02d:%02d" h m)))
|
((org-pos-in-match-range pos 6)
|
(setq ng 6 new (car (rassoc (+ n (cdr (assoc (match-string 6 s) idx))) idx))))
|
((org-pos-in-match-range pos 5)
|
(setq ng 5 new (format "%d" (max 1 (+ n (string-to-number (match-string 5 s)))))))
|
|
((org-pos-in-match-range pos 9)
|
(setq ng 9 new (car (rassoc (+ n (cdr (assoc (match-string 9 s) idx))) idx))))
|
((org-pos-in-match-range pos 8)
|
(setq ng 8 new (format "%d" (max 0 (+ n (string-to-number (match-string 8 s))))))))
|
|
(when ng
|
(setq s (concat
|
(substring s 0 (match-beginning ng))
|
new
|
(substring s (match-end ng))))))
|
s))
|
|
(defun org-recenter-calendar (d)
|
"If the calendar is visible, recenter it to date D."
|
(let ((cwin (get-buffer-window "*Calendar*" t)))
|
(when cwin
|
(let ((calendar-move-hook nil))
|
(with-selected-window cwin
|
(calendar-goto-date
|
(if (listp d) d (calendar-gregorian-from-absolute d))))))))
|
|
(defun org-goto-calendar (&optional arg)
|
"Go to the Emacs calendar at the current date.
|
If there is a time stamp in the current line, go to that date.
|
A prefix ARG can be used to force the current date."
|
(interactive "P")
|
(let ((calendar-move-hook nil)
|
(calendar-view-holidays-initially-flag nil)
|
(calendar-view-diary-initially-flag nil)
|
diff)
|
(when (or (org-at-timestamp-p 'lax)
|
(org-match-line (concat ".*" org-ts-regexp)))
|
(let ((d1 (time-to-days (current-time)))
|
(d2 (time-to-days (org-time-string-to-time (match-string 1)))))
|
(setq diff (- d2 d1))))
|
(calendar)
|
(calendar-goto-today)
|
(when (and diff (not arg)) (calendar-forward-day diff))))
|
|
(defun org-get-date-from-calendar ()
|
"Return a list (month day year) of date at point in calendar."
|
(with-current-buffer "*Calendar*"
|
(save-match-data
|
(calendar-cursor-to-date))))
|
|
(defun org-date-from-calendar ()
|
"Insert time stamp corresponding to cursor date in *Calendar* buffer.
|
If there is already a time stamp at the cursor position, update it."
|
(interactive)
|
(if (org-at-timestamp-p 'lax)
|
(org-timestamp-change 0 'calendar)
|
(let ((cal-date (org-get-date-from-calendar)))
|
(org-insert-time-stamp
|
(encode-time 0 0 0 (nth 1 cal-date) (car cal-date) (nth 2 cal-date))))))
|
|
(defcustom org-effort-durations
|
`(("min" . 1)
|
("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 "26.1"
|
:package-version '(Org . "8.3")
|
:type '(alist :key-type (string :tag "Modifier")
|
:value-type (number :tag "Minutes")))
|
|
(defcustom org-image-actual-width t
|
"Should we use the actual width of images when inlining them?
|
|
When set to t, always use the image width.
|
|
When set to a number, use imagemagick (when available) to set
|
the image's width to this value.
|
|
When set to a number in a list, try to get the width from any
|
#+ATTR.* keyword if it matches a width specification like
|
|
#+ATTR_HTML: :width 300px
|
|
and fall back on that number if none is found.
|
|
When set to nil, try to get the width from an #+ATTR.* keyword
|
and fall back on the original width if none is found.
|
|
This requires Emacs >= 24.1, build with imagemagick support."
|
:group 'org-appearance
|
:version "24.4"
|
:package-version '(Org . "8.0")
|
:type '(choice
|
(const :tag "Use the image width" t)
|
(integer :tag "Use a number of pixels")
|
(list :tag "Use #+ATTR* or a number of pixels" (integer))
|
(const :tag "Use #+ATTR* or don't resize" nil)))
|
|
(defcustom org-agenda-inhibit-startup nil
|
"Inhibit startup when preparing agenda buffers.
|
When this variable is t, the initialization of the Org agenda
|
buffers is inhibited: e.g. the visibility state is not set, the
|
tables are not re-aligned, etc."
|
:type 'boolean
|
:version "24.3"
|
:group 'org-agenda)
|
|
(defcustom org-agenda-ignore-properties nil
|
"Avoid updating text properties when building the agenda.
|
Properties are used to prepare buffers for effort estimates,
|
appointments, statistics and subtree-local categories.
|
If you don't use these in the agenda, you can add them to this
|
list and agenda building will be a bit faster.
|
The value is a list, with zero or more of the symbols `effort', `appt',
|
`stats' or `category'."
|
:type '(set :greedy t
|
(const effort)
|
(const appt)
|
(const stats)
|
(const category))
|
:version "26.1"
|
:package-version '(Org . "8.3")
|
:group 'org-agenda)
|
|
;;;; Files
|
|
(defun org-save-all-org-buffers ()
|
"Save all Org buffers without user confirmation."
|
(interactive)
|
(message "Saving all Org buffers...")
|
(save-some-buffers t (lambda () (derived-mode-p 'org-mode)))
|
(when (featurep 'org-id) (org-id-locations-save))
|
(message "Saving all Org buffers... done"))
|
|
(defun org-revert-all-org-buffers ()
|
"Revert all Org buffers.
|
Prompt for confirmation when there are unsaved changes.
|
Be sure you know what you are doing before letting this function
|
overwrite your changes.
|
|
This function is useful in a setup where one tracks Org files
|
with a version control system, to revert on one machine after pulling
|
changes from another. I believe the procedure must be like this:
|
|
1. M-x org-save-all-org-buffers
|
2. Pull changes from the other machine, resolve conflicts
|
3. M-x org-revert-all-org-buffers"
|
(interactive)
|
(unless (yes-or-no-p "Revert all Org buffers from their files? ")
|
(user-error "Abort"))
|
(save-excursion
|
(save-window-excursion
|
(dolist (b (buffer-list))
|
(when (and (with-current-buffer b (derived-mode-p 'org-mode))
|
(with-current-buffer b buffer-file-name))
|
(pop-to-buffer-same-window b)
|
(revert-buffer t 'no-confirm)))
|
(when (and (featurep 'org-id) org-id-track-globally)
|
(org-id-locations-load)))))
|
|
;;;; Agenda files
|
|
;;;###autoload
|
(defun org-switchb (&optional arg)
|
"Switch between Org buffers.
|
|
With `\\[universal-argument]' prefix, restrict available buffers to files.
|
|
With `\\[universal-argument] \\[universal-argument]' \
|
prefix, restrict available buffers to agenda files."
|
(interactive "P")
|
(let ((blist (org-buffer-list
|
(cond ((equal arg '(4)) 'files)
|
((equal arg '(16)) 'agenda)))))
|
(pop-to-buffer-same-window
|
(completing-read "Org buffer: "
|
(mapcar #'list (mapcar #'buffer-name blist))
|
nil t))))
|
|
(defun org-buffer-list (&optional predicate exclude-tmp)
|
"Return a list of Org buffers.
|
PREDICATE can be `export', `files' or `agenda'.
|
|
export restrict the list to Export buffers.
|
files restrict the list to buffers visiting Org files.
|
agenda restrict the list to buffers visiting agenda files.
|
|
If EXCLUDE-TMP is non-nil, ignore temporary buffers."
|
(let* ((bfn nil)
|
(agenda-files (and (eq predicate 'agenda)
|
(mapcar 'file-truename (org-agenda-files t))))
|
(filter
|
(cond
|
((eq predicate 'files)
|
(lambda (b) (with-current-buffer b (derived-mode-p 'org-mode))))
|
((eq predicate 'export)
|
(lambda (b) (string-match "\\*Org .*Export" (buffer-name b))))
|
((eq predicate 'agenda)
|
(lambda (b)
|
(with-current-buffer b
|
(and (derived-mode-p 'org-mode)
|
(setq bfn (buffer-file-name b))
|
(member (file-truename bfn) agenda-files)))))
|
(t (lambda (b) (with-current-buffer b
|
(or (derived-mode-p 'org-mode)
|
(string-match "\\*Org .*Export"
|
(buffer-name b)))))))))
|
(delq nil
|
(mapcar
|
(lambda(b)
|
(if (and (funcall filter b)
|
(or (not exclude-tmp)
|
(not (string-match "tmp" (buffer-name b)))))
|
b
|
nil))
|
(buffer-list)))))
|
|
(defun org-agenda-files (&optional unrestricted archives)
|
"Get the list of agenda files.
|
Optional UNRESTRICTED means return the full list even if a restriction
|
is currently in place.
|
When ARCHIVES is t, include all archive files that are really being
|
used by the agenda files. If ARCHIVE is `ifmode', do this only if
|
`org-agenda-archives-mode' is t."
|
(let ((files
|
(cond
|
((and (not unrestricted) (get 'org-agenda-files 'org-restrict)))
|
((stringp org-agenda-files) (org-read-agenda-file-list))
|
((listp org-agenda-files) org-agenda-files)
|
(t (error "Invalid value of `org-agenda-files'")))))
|
(setq files (apply 'append
|
(mapcar (lambda (f)
|
(if (file-directory-p f)
|
(directory-files
|
f t org-agenda-file-regexp)
|
(list f)))
|
files)))
|
(when org-agenda-skip-unavailable-files
|
(setq files (delq nil
|
(mapcar (function
|
(lambda (file)
|
(and (file-readable-p file) file)))
|
files))))
|
(when (or (eq archives t)
|
(and (eq archives 'ifmode) (eq org-agenda-archives-mode t)))
|
(setq files (org-add-archive-files files)))
|
files))
|
|
(defun org-agenda-file-p (&optional file)
|
"Return non-nil, if FILE is an agenda file.
|
If FILE is omitted, use the file associated with the current
|
buffer."
|
(let ((fname (or file (buffer-file-name))))
|
(and fname
|
(member (file-truename fname)
|
(mapcar #'file-truename (org-agenda-files t))))))
|
|
(defun org-edit-agenda-file-list ()
|
"Edit the list of agenda files.
|
Depending on setup, this either uses customize to edit the variable
|
`org-agenda-files', or it visits the file that is holding the list. In the
|
latter case, the buffer is set up in a way that saving it automatically kills
|
the buffer and restores the previous window configuration."
|
(interactive)
|
(if (stringp org-agenda-files)
|
(let ((cw (current-window-configuration)))
|
(find-file org-agenda-files)
|
(setq-local org-window-configuration cw)
|
(add-hook 'after-save-hook
|
(lambda ()
|
(set-window-configuration
|
(prog1 org-window-configuration
|
(kill-buffer (current-buffer))))
|
(org-install-agenda-files-menu)
|
(message "New agenda file list installed"))
|
nil 'local)
|
(message "%s" (substitute-command-keys
|
"Edit list and finish with \\[save-buffer]")))
|
(customize-variable 'org-agenda-files)))
|
|
(defun org-store-new-agenda-file-list (list)
|
"Set new value for the agenda file list and save it correctly."
|
(if (stringp org-agenda-files)
|
(let ((fe (org-read-agenda-file-list t)) b u)
|
(while (setq b (find-buffer-visiting org-agenda-files))
|
(kill-buffer b))
|
(with-temp-file org-agenda-files
|
(insert
|
(mapconcat
|
(lambda (f) ;; Keep un-expanded entries.
|
(if (setq u (assoc f fe))
|
(cdr u)
|
f))
|
list "\n")
|
"\n")))
|
(let ((org-mode-hook nil) (org-inhibit-startup t)
|
(org-insert-mode-line-in-empty-file nil))
|
(setq org-agenda-files list)
|
(customize-save-variable 'org-agenda-files org-agenda-files))))
|
|
(defun org-read-agenda-file-list (&optional pair-with-expansion)
|
"Read the list of agenda files from a file.
|
If PAIR-WITH-EXPANSION is t return pairs with un-expanded
|
filenames, used by `org-store-new-agenda-file-list' to write back
|
un-expanded file names."
|
(when (file-directory-p org-agenda-files)
|
(error "`org-agenda-files' cannot be a single directory"))
|
(when (stringp org-agenda-files)
|
(with-temp-buffer
|
(insert-file-contents org-agenda-files)
|
(mapcar
|
(lambda (f)
|
(let ((e (expand-file-name (substitute-in-file-name f)
|
org-directory)))
|
(if pair-with-expansion
|
(cons e f)
|
e)))
|
(org-split-string (buffer-string) "[ \t\r\n]*?[\r\n][ \t\r\n]*")))))
|
|
;;;###autoload
|
(defun org-cycle-agenda-files ()
|
"Cycle through the files in `org-agenda-files'.
|
If the current buffer visits an agenda file, find the next one in the list.
|
If the current buffer does not, find the first agenda file."
|
(interactive)
|
(let* ((fs (or (org-agenda-files t)
|
(user-error "No agenda files")))
|
(files (copy-sequence fs))
|
(tcf (and buffer-file-name (file-truename buffer-file-name)))
|
file)
|
(when tcf
|
(while (and (setq file (pop files))
|
(not (equal (file-truename file) tcf)))))
|
(find-file (car (or files fs)))
|
(when (buffer-base-buffer) (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.
|
If the file is not present in the list, it is added to the front. If it is
|
present, it is moved there. With optional argument TO-END, add/move to the
|
end of the list."
|
(interactive "P")
|
(let ((org-agenda-skip-unavailable-files nil)
|
(file-alist (mapcar (lambda (x)
|
(cons (file-truename x) x))
|
(org-agenda-files t)))
|
(ctf (file-truename
|
(or buffer-file-name
|
(user-error "Please save the current buffer to a file"))))
|
x had)
|
(setq x (assoc ctf file-alist) had x)
|
|
(unless x (setq x (cons ctf (abbreviate-file-name buffer-file-name))))
|
(if to-end
|
(setq file-alist (append (delq x file-alist) (list x)))
|
(setq file-alist (cons x (delq x file-alist))))
|
(org-store-new-agenda-file-list (mapcar 'cdr file-alist))
|
(org-install-agenda-files-menu)
|
(message "File %s to %s of agenda file list"
|
(if had "moved" "added") (if to-end "end" "front"))))
|
|
(defun org-remove-file (&optional file)
|
"Remove current file from the list of files in variable `org-agenda-files'.
|
These are the files which are being checked for agenda entries.
|
Optional argument FILE means use this file instead of the current."
|
(interactive)
|
(let* ((org-agenda-skip-unavailable-files nil)
|
(file (or file buffer-file-name
|
(user-error "Current buffer does not visit a file")))
|
(true-file (file-truename file))
|
(afile (abbreviate-file-name file))
|
(files (delq nil (mapcar
|
(lambda (x)
|
(unless (equal true-file
|
(file-truename x))
|
x))
|
(org-agenda-files t)))))
|
(if (not (= (length files) (length (org-agenda-files t))))
|
(progn
|
(org-store-new-agenda-file-list files)
|
(org-install-agenda-files-menu)
|
(message "Removed from Org Agenda list: %s" afile))
|
(message "File was not in list: %s (not removed)" afile))))
|
|
(defun org-file-menu-entry (file)
|
(vector file (list 'find-file file) t))
|
|
(defun org-check-agenda-file (file)
|
"Make sure FILE exists. If not, ask user what to do."
|
(unless (file-exists-p file)
|
(message "Non-existent agenda file %s. [R]emove from list or [A]bort?"
|
(abbreviate-file-name file))
|
(let ((r (downcase (read-char-exclusive))))
|
(cond
|
((equal r ?r)
|
(org-remove-file file)
|
(throw 'nextfile t))
|
(t (user-error "Abort"))))))
|
|
(defun org-get-agenda-file-buffer (file)
|
"Get an agenda buffer visiting FILE.
|
If the buffer needs to be created, add it to the list of buffers
|
which might be released later."
|
(let ((buf (org-find-base-buffer-visiting file)))
|
(if buf
|
buf ; just return it
|
;; Make a new buffer and remember it
|
(setq buf (find-file-noselect file))
|
(when buf (push buf org-agenda-new-buffers))
|
buf)))
|
|
(defun org-release-buffers (blist)
|
"Release all buffers in list, asking the user for confirmation when needed.
|
When a buffer is unmodified, it is just killed. When modified, it is saved
|
\(if the user agrees) and then killed."
|
(let (file)
|
(dolist (buf blist)
|
(setq file (buffer-file-name buf))
|
(when (and (buffer-modified-p buf)
|
file
|
(y-or-n-p (format "Save file %s? " file)))
|
(with-current-buffer buf (save-buffer)))
|
(kill-buffer buf))))
|
|
(defun org-agenda-prepare-buffers (files)
|
"Create buffers for all agenda files, protect archived trees and comments."
|
(interactive)
|
(let ((pa '(:org-archived t))
|
(pc '(:org-comment t))
|
(pall '(:org-archived t :org-comment t))
|
(inhibit-read-only t)
|
(org-inhibit-startup org-agenda-inhibit-startup)
|
(rea (concat ":" org-archive-tag ":"))
|
re pos)
|
(setq org-tag-alist-for-agenda nil
|
org-tag-groups-alist-for-agenda nil)
|
(save-excursion
|
(save-restriction
|
(dolist (file files)
|
(catch 'nextfile
|
(if (bufferp file)
|
(set-buffer file)
|
(org-check-agenda-file file)
|
(set-buffer (org-get-agenda-file-buffer file)))
|
(widen)
|
(org-set-regexps-and-options 'tags-only)
|
(setq pos (point))
|
(or (memq 'category org-agenda-ignore-properties)
|
(org-refresh-category-properties))
|
(or (memq 'stats org-agenda-ignore-properties)
|
(org-refresh-stats-properties))
|
(or (memq 'effort org-agenda-ignore-properties)
|
(org-refresh-effort-properties))
|
(or (memq 'appt org-agenda-ignore-properties)
|
(org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime))
|
(setq org-todo-keywords-for-agenda
|
(append org-todo-keywords-for-agenda org-todo-keywords-1))
|
(setq org-done-keywords-for-agenda
|
(append org-done-keywords-for-agenda org-done-keywords))
|
(setq org-todo-keyword-alist-for-agenda
|
(append org-todo-keyword-alist-for-agenda org-todo-key-alist))
|
(setq org-tag-alist-for-agenda
|
(org--tag-add-to-alist
|
org-tag-alist-for-agenda
|
org-current-tag-alist))
|
;; Merge current file's tag groups into global
|
;; `org-tag-groups-alist-for-agenda'.
|
(when org-group-tags
|
(dolist (alist org-tag-groups-alist)
|
(let ((old (assoc (car alist) org-tag-groups-alist-for-agenda)))
|
(if old
|
(setcdr old (org-uniquify (append (cdr old) (cdr alist))))
|
(push alist org-tag-groups-alist-for-agenda)))))
|
(org-with-silent-modifications
|
(save-excursion
|
(remove-text-properties (point-min) (point-max) pall)
|
(when org-agenda-skip-archived-trees
|
(goto-char (point-min))
|
(while (re-search-forward rea nil t)
|
(when (org-at-heading-p t)
|
(add-text-properties (point-at-bol) (org-end-of-subtree t) pa))))
|
(goto-char (point-min))
|
(setq re (format "^\\*+ .*\\<%s\\>" org-comment-string))
|
(while (re-search-forward re nil t)
|
(when (save-match-data (org-in-commented-heading-p t))
|
(add-text-properties
|
(match-beginning 0) (org-end-of-subtree t) pc)))))
|
(goto-char pos)))))
|
(setq org-todo-keywords-for-agenda
|
(org-uniquify org-todo-keywords-for-agenda))
|
(setq org-todo-keyword-alist-for-agenda
|
(org-uniquify org-todo-keyword-alist-for-agenda))))
|
|
|
;;;; CDLaTeX minor mode
|
|
(defvar org-cdlatex-mode-map (make-sparse-keymap)
|
"Keymap for the minor `org-cdlatex-mode'.")
|
|
(org-defkey org-cdlatex-mode-map "_" 'org-cdlatex-underscore-caret)
|
(org-defkey org-cdlatex-mode-map "^" 'org-cdlatex-underscore-caret)
|
(org-defkey org-cdlatex-mode-map "`" 'cdlatex-math-symbol)
|
(org-defkey org-cdlatex-mode-map "'" 'org-cdlatex-math-modify)
|
(org-defkey org-cdlatex-mode-map "\C-c{" 'org-cdlatex-environment-indent)
|
|
(defvar org-cdlatex-texmathp-advice-is-done nil
|
"Flag remembering if we have applied the advice to texmathp already.")
|
|
(define-minor-mode org-cdlatex-mode
|
"Toggle the minor `org-cdlatex-mode'.
|
This mode supports entering LaTeX environment and math in LaTeX fragments
|
in Org mode.
|
\\{org-cdlatex-mode-map}"
|
nil " OCDL" nil
|
(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)
|
"Always return t in Org buffers.
|
This is because we want to insert math symbols without dollars even outside
|
the LaTeX math segments. If Org mode thinks that point is actually inside
|
an embedded LaTeX fragment, let `texmathp' do its job.
|
`\\[org-cdlatex-mode-map]'"
|
(interactive)
|
(let (p)
|
(cond
|
((not (derived-mode-p '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)))
|
(t
|
(let ((p (org-inside-LaTeX-fragment-p)))
|
(if (and p (member (car p) (plist-get org-format-latex-options :matchers)))
|
(setq ad-return-value t
|
texmathp-why '("Org mode embedded math" . 0))
|
(when p ad-do-it)))))))))
|
|
(defun turn-on-org-cdlatex ()
|
"Unconditionally turn on `org-cdlatex-mode'."
|
(org-cdlatex-mode 1))
|
|
(defun org-try-cdlatex-tab ()
|
"Check if it makes sense to execute `cdlatex-tab', and do it if yes.
|
It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is
|
- inside a LaTeX fragment, or
|
- after the first word in a line, where an abbreviation expansion could
|
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")
|
(and (bolp) (not (org-at-heading-p))))
|
(cdlatex-tab) t)
|
((org-inside-LaTeX-fragment-p) (cdlatex-tab) t))))
|
|
(defun org-cdlatex-underscore-caret (&optional _arg)
|
"Execute `cdlatex-sub-superscript' in LaTeX fragments.
|
Revert to the normal definition outside of these fragments."
|
(interactive "P")
|
(if (org-inside-LaTeX-fragment-p)
|
(call-interactively 'cdlatex-sub-superscript)
|
(let (org-cdlatex-mode)
|
(call-interactively (key-binding (vector last-input-event))))))
|
|
(defun org-cdlatex-math-modify (&optional _arg)
|
"Execute `cdlatex-math-modify' in LaTeX fragments.
|
Revert to the normal definition outside of these fragments."
|
(interactive "P")
|
(if (org-inside-LaTeX-fragment-p)
|
(call-interactively 'cdlatex-math-modify)
|
(let (org-cdlatex-mode)
|
(call-interactively (key-binding (vector last-input-event))))))
|
|
(defun org-cdlatex-environment-indent (&optional environment item)
|
"Execute `cdlatex-environment' and indent the inserted environment.
|
|
ENVIRONMENT and ITEM are passed to `cdlatex-environment'.
|
|
The inserted environment is indented to current indentation
|
unless point is at the beginning of the line, in which the
|
environment remains unintended."
|
(interactive)
|
;; cdlatex-environment always return nil. Therefore, capture output
|
;; first and determine if an environment was selected.
|
(let* ((beg (point-marker))
|
(end (copy-marker (point) t))
|
(inserted (progn
|
(ignore-errors (cdlatex-environment environment item))
|
(< beg end)))
|
;; Figure out how many lines to move forward after the
|
;; environment has been inserted.
|
(lines (when inserted
|
(save-excursion
|
(- (cl-loop while (< beg (point))
|
with x = 0
|
do (forward-line -1)
|
(cl-incf x)
|
finally return x)
|
(if (progn (goto-char beg)
|
(and (progn (skip-chars-forward " \t") (eolp))
|
(progn (skip-chars-backward " \t") (bolp))))
|
1 0)))))
|
(env (org-trim (delete-and-extract-region beg end))))
|
(when inserted
|
;; Get indentation of next line unless at column 0.
|
(let ((ind (if (bolp) 0
|
(save-excursion
|
(org-return-indent)
|
(prog1 (org-get-indentation)
|
(when (progn (skip-chars-forward " \t") (eolp))
|
(delete-region beg (point)))))))
|
(bol (progn (skip-chars-backward " \t") (bolp))))
|
;; Insert a newline before environment unless at column zero
|
;; to "escape" the current line. Insert a newline if
|
;; something is one the same line as \end{ENVIRONMENT}.
|
(insert
|
(concat (unless bol "\n") env
|
(when (and (skip-chars-forward " \t") (not (eolp))) "\n")))
|
(unless (zerop ind)
|
(save-excursion
|
(goto-char beg)
|
(while (< (point) end)
|
(unless (eolp) (indent-line-to ind))
|
(forward-line))))
|
(goto-char beg)
|
(forward-line lines)
|
(indent-line-to ind)))
|
(set-marker beg nil)
|
(set-marker end nil)))
|
|
|
;;;; LaTeX fragments
|
|
(defun org-inside-LaTeX-fragment-p ()
|
"Test if point is inside a LaTeX fragment.
|
I.e. after a \\begin, \\(, \\[, $, or $$, without the corresponding closing
|
sequence appearing also before point.
|
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.
|
|
This function does a reasonably good job, but can locally be fooled by
|
for example currency specifications. For example it will assume being in
|
inline math after \"$22.34\". The LaTeX fragment formatter will only format
|
fragments that are properly closed, but during editing, we have to live
|
with the uncertainty caused by missing closing delimiters. This function
|
looks only before point, not after."
|
(catch 'exit
|
(let ((pos (point))
|
(dodollar (member "$" (plist-get org-format-latex-options :matchers)))
|
(lim (save-excursion (org-backward-paragraph) (point)))
|
dd-on str (start 0) m re)
|
(goto-char pos)
|
(when dodollar
|
(setq str (concat (buffer-substring lim (point)) "\000 X$.")
|
re (nth 1 (assoc "$" org-latex-regexps)))
|
(while (string-match re str start)
|
(cond
|
((= (match-end 0) (length str))
|
(throw 'exit (cons "$" (+ lim (match-beginning 0) 1))))
|
((= (match-end 0) (- (length str) 5))
|
(throw 'exit nil))
|
(t (setq start (match-end 0))))))
|
(when (setq m (re-search-backward "\\(\\\\begin{[^}]*}\\|\\\\(\\|\\\\\\[\\)\\|\\(\\\\end{[^}]*}\\|\\\\)\\|\\\\\\]\\)\\|\\(\\$\\$\\)" lim t))
|
(goto-char pos)
|
(and (match-beginning 1) (throw 'exit (cons (match-string 1) m)))
|
(and (match-beginning 2) (throw 'exit nil))
|
;; count $$
|
(while (re-search-backward "\\$\\$" lim t)
|
(setq dd-on (not dd-on)))
|
(goto-char pos)
|
(when dd-on (cons "$$" m))))))
|
|
(defun org-inside-latex-macro-p ()
|
"Is point inside a LaTeX macro or its arguments?"
|
(save-match-data
|
(org-in-regexp
|
"\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*")))
|
|
(defun org--format-latex-make-overlay (beg end image &optional imagetype)
|
"Build an overlay between BEG and END using IMAGE file.
|
Argument IMAGETYPE is the extension of the displayed image,
|
as a string. It defaults to \"png\"."
|
(let ((ov (make-overlay beg end))
|
(imagetype (or (intern imagetype) 'png)))
|
(overlay-put ov 'org-overlay-type 'org-latex-overlay)
|
(overlay-put ov 'evaporate t)
|
(overlay-put ov
|
'modification-hooks
|
(list (lambda (o _flag _beg _end &optional _l)
|
(delete-overlay o))))
|
(overlay-put ov
|
'display
|
(list 'image :type imagetype :file image :ascent 'center))))
|
|
(defun org--list-latex-overlays (&optional beg end)
|
"List all Org LaTeX overlays in current buffer.
|
Limit to overlays between BEG and END when those are provided."
|
(cl-remove-if-not
|
(lambda (o) (eq (overlay-get o 'org-overlay-type) 'org-latex-overlay))
|
(overlays-in (or beg (point-min)) (or end (point-max)))))
|
|
(defun org-remove-latex-fragment-image-overlays (&optional beg end)
|
"Remove all overlays with LaTeX fragment images in current buffer.
|
When optional arguments BEG and END are non-nil, remove all
|
overlays between them instead. Return a non-nil value when some
|
overlays were removed, nil otherwise."
|
(let ((overlays (org--list-latex-overlays beg end)))
|
(mapc #'delete-overlay overlays)
|
overlays))
|
|
(defun org-toggle-latex-fragment (&optional arg)
|
"Preview the LaTeX fragment at point, or all locally or globally.
|
|
If the cursor is on a LaTeX fragment, create the image and overlay
|
it over the source code, if there is none. Remove it otherwise.
|
If there is no fragment at point, display all fragments in the
|
current section.
|
|
With prefix ARG, preview or clear image for all fragments in the
|
current subtree or in the whole buffer when used before the first
|
headline. With a prefix ARG `\\[universal-argument] \
|
\\[universal-argument]' preview or clear images
|
for all fragments in the buffer."
|
(interactive "P")
|
(when (display-graphic-p)
|
(catch 'exit
|
(save-excursion
|
(let (beg end msg)
|
(cond
|
((or (equal arg '(16))
|
(and (equal arg '(4))
|
(org-with-limited-levels (org-before-first-heading-p))))
|
(if (org-remove-latex-fragment-image-overlays)
|
(progn (message "LaTeX fragments images removed from buffer")
|
(throw 'exit nil))
|
(setq msg "Creating images for buffer...")))
|
((equal arg '(4))
|
(org-with-limited-levels (org-back-to-heading t))
|
(setq beg (point))
|
(setq end (progn (org-end-of-subtree t) (point)))
|
(if (org-remove-latex-fragment-image-overlays beg end)
|
(progn
|
(message "LaTeX fragment images removed from subtree")
|
(throw 'exit nil))
|
(setq msg "Creating images for subtree...")))
|
((let ((datum (org-element-context)))
|
(when (memq (org-element-type datum)
|
'(latex-environment latex-fragment))
|
(setq beg (org-element-property :begin datum))
|
(setq end (org-element-property :end datum))
|
(if (org-remove-latex-fragment-image-overlays beg end)
|
(progn (message "LaTeX fragment image removed")
|
(throw 'exit nil))
|
(setq msg "Creating image...")))))
|
(t
|
(org-with-limited-levels
|
(setq beg (if (org-at-heading-p) (line-beginning-position)
|
(outline-previous-heading)
|
(point)))
|
(setq end (progn (outline-next-heading) (point)))
|
(if (org-remove-latex-fragment-image-overlays beg end)
|
(progn
|
(message "LaTeX fragment images removed from section")
|
(throw 'exit nil))
|
(setq msg "Creating images for section...")))))
|
(let ((file (buffer-file-name (buffer-base-buffer))))
|
(org-format-latex
|
(concat org-preview-latex-image-directory "org-ltximg")
|
beg end
|
;; Emacs cannot overlay images from remote hosts. Create
|
;; it in `temporary-file-directory' instead.
|
(if (or (not file) (file-remote-p file))
|
temporary-file-directory
|
default-directory)
|
'overlays msg 'forbuffer org-preview-latex-default-process))
|
(message (concat msg "done")))))))
|
|
(defun org-format-latex
|
(prefix &optional beg end dir overlays msg forbuffer processing-type)
|
"Replace LaTeX fragments with links to an image.
|
|
The function takes care of creating the replacement image.
|
|
Only consider fragments between BEG and END when those are
|
provided.
|
|
When optional argument OVERLAYS is non-nil, display the image on
|
top of the fragment instead of replacing it.
|
|
PROCESSING-TYPE is the conversion method to use, as a symbol.
|
|
Some of the options can be changed using the variable
|
`org-format-latex-options', which see."
|
(when (and overlays (fboundp 'clear-image-cache)) (clear-image-cache))
|
(unless (eq processing-type 'verbatim)
|
(let* ((math-regexp "\\$\\|\\\\[([]\\|^[ \t]*\\\\begin{[A-Za-z0-9*]+}")
|
(cnt 0)
|
checkdir-flag)
|
(goto-char (or beg (point-min)))
|
;; Optimize overlay creation: (info "(elisp) Managing Overlays").
|
(when (and overlays (memq processing-type '(dvipng imagemagick)))
|
(overlay-recenter (or end (point-max))))
|
(while (re-search-forward math-regexp end t)
|
(unless (and overlays
|
(eq (get-char-property (point) 'org-overlay-type)
|
'org-latex-overlay))
|
(let* ((context (org-element-context))
|
(type (org-element-type context)))
|
(when (memq type '(latex-environment latex-fragment))
|
(let ((block-type (eq type 'latex-environment))
|
(value (org-element-property :value context))
|
(beg (org-element-property :begin context))
|
(end (save-excursion
|
(goto-char (org-element-property :end context))
|
(skip-chars-backward " \r\t\n")
|
(point))))
|
(cond
|
((eq processing-type 'mathjax)
|
;; Prepare for MathJax processing.
|
(if (not (string-match "\\`\\$\\$?" value))
|
(goto-char end)
|
(delete-region beg end)
|
(if (string= (match-string 0 value) "$$")
|
(insert "\\[" (substring value 2 -2) "\\]")
|
(insert "\\(" (substring value 1 -1) "\\)"))))
|
((assq processing-type org-preview-latex-process-alist)
|
;; Process to an image.
|
(cl-incf cnt)
|
(goto-char beg)
|
(let* ((processing-info
|
(cdr (assq processing-type org-preview-latex-process-alist)))
|
(face (face-at-point))
|
;; Get the colors from the face at point.
|
(fg
|
(let ((color (plist-get org-format-latex-options
|
:foreground)))
|
(if (and forbuffer (eq color 'auto))
|
(face-attribute face :foreground nil 'default)
|
color)))
|
(bg
|
(let ((color (plist-get org-format-latex-options
|
:background)))
|
(if (and forbuffer (eq color 'auto))
|
(face-attribute face :background nil 'default)
|
color)))
|
(hash (sha1 (prin1-to-string
|
(list org-format-latex-header
|
org-latex-default-packages-alist
|
org-latex-packages-alist
|
org-format-latex-options
|
forbuffer value fg bg))))
|
(imagetype (or (plist-get processing-info :image-output-type) "png"))
|
(absprefix (expand-file-name prefix dir))
|
(linkfile (format "%s_%s.%s" prefix hash imagetype))
|
(movefile (format "%s_%s.%s" absprefix hash imagetype))
|
(sep (and block-type "\n\n"))
|
(link (concat sep "[[file:" linkfile "]]" sep))
|
(options
|
(org-combine-plists
|
org-format-latex-options
|
`(:foreground ,fg :background ,bg))))
|
(when msg (message msg cnt))
|
(unless checkdir-flag ; Ensure the directory exists.
|
(setq checkdir-flag t)
|
(let ((todir (file-name-directory absprefix)))
|
(unless (file-directory-p todir)
|
(make-directory todir t))))
|
(unless (file-exists-p movefile)
|
(org-create-formula-image
|
value movefile options forbuffer processing-type))
|
(if overlays
|
(progn
|
(dolist (o (overlays-in beg end))
|
(when (eq (overlay-get o 'org-overlay-type)
|
'org-latex-overlay)
|
(delete-overlay o)))
|
(org--format-latex-make-overlay beg end movefile imagetype)
|
(goto-char end))
|
(delete-region beg end)
|
(insert
|
(org-add-props link
|
(list 'org-latex-src
|
(replace-regexp-in-string "\"" "" value)
|
'org-latex-src-embed-type
|
(if block-type 'paragraph 'character)))))))
|
((eq processing-type 'mathml)
|
;; Process to MathML.
|
(unless (org-format-latex-mathml-available-p)
|
(user-error "LaTeX to MathML converter not configured"))
|
(cl-incf cnt)
|
(when msg (message msg cnt))
|
(goto-char beg)
|
(delete-region beg end)
|
(insert (org-format-latex-as-mathml
|
value block-type prefix dir)))
|
(t
|
(error "Unknown conversion process %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 (org-region-active-p)
|
(buffer-substring-no-properties
|
(region-beginning) (region-end)))))
|
(read-string "LaTeX Fragment: " frag nil frag))))
|
(unless latex-frag (user-error "Invalid LaTeX fragment"))
|
(let* ((tmp-in-file
|
(let ((file (file-relative-name
|
(make-temp-name (expand-file-name "ltxmathml-in")))))
|
(write-region latex-frag nil file)
|
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 . ,(and org-latex-to-mathml-jar-file
|
(shell-quote-argument
|
(expand-file-name
|
org-latex-to-mathml-jar-file))))
|
(?I . ,(shell-quote-argument tmp-in-file))
|
(?i . ,latex-frag)
|
(?o . ,(shell-quote-argument tmp-out-file)))))
|
mathml shell-command-output)
|
(when (called-interactively-p 'any)
|
(unless (org-format-latex-mathml-available-p)
|
(user-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
|
(format "<math[^>]*?%s[^>]*?>\\(.\\|\n\\)*</math>"
|
(regexp-quote
|
"xmlns=\"http://www.w3.org/1998/Math/MathML\""))
|
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 (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
|
latex-frag)))
|
|
(defun org--get-display-dpi ()
|
"Get the DPI of the display.
|
The function assumes that the display has the same pixel width in
|
the horizontal and vertical directions."
|
(if (display-graphic-p)
|
(round (/ (display-pixel-height)
|
(/ (display-mm-height) 25.4)))
|
(error "Attempt to calculate the dpi of a non-graphic display")))
|
|
(defun org-create-formula-image
|
(string tofile options buffer &optional processing-type)
|
"Create an image from LaTeX source using external processes.
|
|
The LaTeX STRING is saved to a temporary LaTeX file, then
|
converted to an image file by process PROCESSING-TYPE defined in
|
`org-preview-latex-process-alist'. A nil value defaults to
|
`org-preview-latex-default-process'.
|
|
The generated image file is eventually moved to TOFILE.
|
|
The OPTIONS argument controls the size, foreground color and
|
background color of the generated image.
|
|
When BUFFER non-nil, this function is used for LaTeX previewing.
|
Otherwise, it is used to deal with LaTeX snippets showed in
|
a HTML file."
|
(let* ((processing-type (or processing-type
|
org-preview-latex-default-process))
|
(processing-info
|
(cdr (assq processing-type org-preview-latex-process-alist)))
|
(programs (plist-get processing-info :programs))
|
(error-message (or (plist-get processing-info :message) ""))
|
(use-xcolor (plist-get processing-info :use-xcolor))
|
(image-input-type (plist-get processing-info :image-input-type))
|
(image-output-type (plist-get processing-info :image-output-type))
|
(post-clean (or (plist-get processing-info :post-clean)
|
'(".dvi" ".xdv" ".pdf" ".tex" ".aux" ".log"
|
".svg" ".png" ".jpg" ".jpeg" ".out")))
|
(latex-header
|
(or (plist-get processing-info :latex-header)
|
(org-latex-make-preamble
|
(org-export-get-environment (org-export-get-backend 'latex))
|
org-format-latex-header
|
'snippet)))
|
(latex-compiler (plist-get processing-info :latex-compiler))
|
(image-converter (plist-get processing-info :image-converter))
|
(tmpdir temporary-file-directory)
|
(texfilebase (make-temp-name
|
(expand-file-name "orgtex" tmpdir)))
|
(texfile (concat texfilebase ".tex"))
|
(image-size-adjust (or (plist-get processing-info :image-size-adjust)
|
'(1.0 . 1.0)))
|
(scale (* (if buffer (car image-size-adjust) (cdr image-size-adjust))
|
(or (plist-get options (if buffer :scale :html-scale)) 1.0)))
|
(dpi (* scale (if buffer (org--get-display-dpi) 140.0)))
|
(fg (or (plist-get options (if buffer :foreground :html-foreground))
|
"Black"))
|
(bg (or (plist-get options (if buffer :background :html-background))
|
"Transparent"))
|
(log-buf (get-buffer-create "*Org Preview LaTeX Output*"))
|
(resize-mini-windows nil)) ;Fix Emacs flicker when creating image.
|
(dolist (program programs)
|
(org-check-external-command program error-message))
|
(if use-xcolor
|
(progn (if (eq fg 'default)
|
(setq fg (org-latex-color :foreground))
|
(setq fg (org-latex-color-format fg)))
|
(if (eq bg 'default)
|
(setq bg (org-latex-color :background))
|
(setq bg (org-latex-color-format
|
(if (string= bg "Transparent") "white" bg))))
|
(with-temp-file texfile
|
(insert latex-header)
|
(insert "\n\\begin{document}\n"
|
"\\definecolor{fg}{rgb}{" fg "}\n"
|
"\\definecolor{bg}{rgb}{" bg "}\n"
|
"\n\\pagecolor{bg}\n"
|
"\n{\\color{fg}\n"
|
string
|
"\n}\n"
|
"\n\\end{document}\n")))
|
(if (eq fg 'default)
|
(setq fg (org-dvipng-color :foreground))
|
(unless (string= fg "Transparent")
|
(setq fg (org-dvipng-color-format fg))))
|
(if (eq bg 'default)
|
(setq bg (org-dvipng-color :background))
|
(unless (string= bg "Transparent")
|
(setq bg (org-dvipng-color-format bg))))
|
(with-temp-file texfile
|
(insert latex-header)
|
(insert "\n\\begin{document}\n" string "\n\\end{document}\n")))
|
|
(let* ((err-msg (format "Please adjust `%s' part of \
|
`org-preview-latex-process-alist'."
|
processing-type))
|
(image-input-file
|
(org-compile-file
|
texfile latex-compiler image-input-type err-msg log-buf))
|
(image-output-file
|
(org-compile-file
|
image-input-file image-converter image-output-type err-msg log-buf
|
`((?F . ,(shell-quote-argument fg))
|
(?B . ,(shell-quote-argument bg))
|
(?D . ,(shell-quote-argument (format "%s" dpi)))
|
(?S . ,(shell-quote-argument (format "%s" (/ dpi 140.0))))))))
|
(copy-file image-output-file tofile 'replace)
|
(dolist (e post-clean)
|
(when (file-exists-p (concat texfilebase e))
|
(delete-file (concat texfilebase e))))
|
image-output-file)))
|
|
(defun org-splice-latex-header (tpl def-pkg pkg snippets-p &optional extra)
|
"Fill a LaTeX header template TPL.
|
In the template, the following place holders will be recognized:
|
|
[DEFAULT-PACKAGES] \\usepackage statements for DEF-PKG
|
[NO-DEFAULT-PACKAGES] do not include DEF-PKG
|
[PACKAGES] \\usepackage statements for PKG
|
[NO-PACKAGES] do not include PKG
|
[EXTRA] the string EXTRA
|
[NO-EXTRA] do not include EXTRA
|
|
For backward compatibility, if both the positive and the negative place
|
holder is missing, the positive one (without the \"NO-\") will be
|
assumed to be present at the end of the template.
|
DEF-PKG and PKG are assumed to be alists of options/packagename lists.
|
EXTRA is a string.
|
SNIPPETS-P indicates if this is run to create snippet images for HTML."
|
(let (rpl (end ""))
|
(if (string-match "^[ \t]*\\[\\(NO-\\)?DEFAULT-PACKAGES\\][ \t]*\n?" tpl)
|
(setq rpl (if (or (match-end 1) (not def-pkg))
|
"" (org-latex-packages-to-string def-pkg snippets-p t))
|
tpl (replace-match rpl t t tpl))
|
(when def-pkg (setq end (org-latex-packages-to-string def-pkg snippets-p))))
|
|
(if (string-match "\\[\\(NO-\\)?PACKAGES\\][ \t]*\n?" tpl)
|
(setq rpl (if (or (match-end 1) (not pkg))
|
"" (org-latex-packages-to-string pkg snippets-p t))
|
tpl (replace-match rpl t t tpl))
|
(when pkg (setq end
|
(concat end "\n"
|
(org-latex-packages-to-string pkg snippets-p)))))
|
|
(if (string-match "\\[\\(NO-\\)?EXTRA\\][ \t]*\n?" tpl)
|
(setq rpl (if (or (match-end 1) (not extra))
|
"" (concat extra "\n"))
|
tpl (replace-match rpl t t tpl))
|
(when (and extra (string-match "\\S-" extra))
|
(setq end (concat end "\n" extra))))
|
|
(if (string-match "\\S-" end)
|
(concat tpl "\n" end)
|
tpl)))
|
|
(defun org-latex-packages-to-string (pkg &optional snippets-p newline)
|
"Turn an alist of packages into a string with the \\usepackage macros."
|
(setq pkg (mapconcat (lambda(p)
|
(cond
|
((stringp p) p)
|
((and snippets-p (>= (length p) 3) (not (nth 2 p)))
|
(format "%% Package %s omitted" (cadr p)))
|
((equal "" (car p))
|
(format "\\usepackage{%s}" (cadr p)))
|
(t
|
(format "\\usepackage[%s]{%s}"
|
(car p) (cadr p)))))
|
pkg
|
"\n"))
|
(if newline (concat pkg "\n") pkg))
|
|
(defun org-dvipng-color (attr)
|
"Return a RGB color specification for dvipng."
|
(org-dvipng-color-format (face-attribute 'default attr nil)))
|
|
(defun org-dvipng-color-format (color-name)
|
"Convert COLOR-NAME to a RGB color value for dvipng."
|
(apply #'format "rgb %s %s %s"
|
(mapcar 'org-normalize-color
|
(color-values color-name))))
|
|
(defun org-latex-color (attr)
|
"Return a RGB color for the LaTeX color package."
|
(org-latex-color-format (face-attribute 'default attr nil)))
|
|
(defun org-latex-color-format (color-name)
|
"Convert COLOR-NAME to a RGB color value."
|
(apply #'format "%s,%s,%s"
|
(mapcar 'org-normalize-color
|
(color-values color-name))))
|
|
(defun org-normalize-color (value)
|
"Return string to be used as color value for an RGB component."
|
(format "%g" (/ value 65535.0)))
|
|
|
|
;; Image display
|
|
(defvar-local org-inline-image-overlays nil)
|
|
(defun org-toggle-inline-images (&optional include-linked)
|
"Toggle the display of inline images.
|
INCLUDE-LINKED is passed to `org-display-inline-images'."
|
(interactive "P")
|
(if org-inline-image-overlays
|
(progn
|
(org-remove-inline-images)
|
(when (called-interactively-p 'interactive)
|
(message "Inline image display turned off")))
|
(org-display-inline-images include-linked)
|
(when (called-interactively-p 'interactive)
|
(message (if org-inline-image-overlays
|
(format "%d images displayed inline"
|
(length org-inline-image-overlays))
|
"No images to display inline")))))
|
|
(defun org-redisplay-inline-images ()
|
"Refresh the display of inline images."
|
(interactive)
|
(if (not org-inline-image-overlays)
|
(org-toggle-inline-images)
|
(org-toggle-inline-images)
|
(org-toggle-inline-images)))
|
|
(defun org-display-inline-images (&optional include-linked refresh beg end)
|
"Display inline images.
|
|
An inline image is a link which follows either of these
|
conventions:
|
|
1. Its path is a file with an extension matching return value
|
from `image-file-name-regexp' and it has no contents.
|
|
2. Its description consists in a single link of the previous
|
type.
|
|
When optional argument INCLUDE-LINKED is non-nil, also links with
|
a text description part will be inlined. This can be nice for
|
a quick look at those images, but it does not reflect what
|
exported files will look like.
|
|
When optional argument REFRESH is non-nil, refresh existing
|
images between BEG and END. This will create new image displays
|
only if necessary. BEG and END default to the buffer
|
boundaries."
|
(interactive "P")
|
(when (display-graphic-p)
|
(unless refresh
|
(org-remove-inline-images)
|
(when (fboundp 'clear-image-cache) (clear-image-cache)))
|
(org-with-wide-buffer
|
(goto-char (or beg (point-min)))
|
(let* ((case-fold-search t)
|
(file-extension-re (image-file-name-regexp))
|
(link-abbrevs (mapcar #'car
|
(append org-link-abbrev-alist-local
|
org-link-abbrev-alist)))
|
;; Check absolute, relative file names and explicit
|
;; "file:" links. Also check link abbreviations since
|
;; some might expand to "file" links.
|
(file-types-re (format "[][]\\[\\(?:file\\|[./~]%s\\)"
|
(if (not link-abbrevs) ""
|
(format "\\|\\(?:%s:\\)"
|
(regexp-opt link-abbrevs))))))
|
(while (re-search-forward file-types-re end t)
|
(let ((link (save-match-data (org-element-context))))
|
;; Check if we're at an inline image, i.e., an image file
|
;; link without a description (unless INCLUDE-LINKED is
|
;; non-nil).
|
(when (and (equal "file" (org-element-property :type link))
|
(or include-linked
|
(null (org-element-contents link)))
|
(string-match-p file-extension-re
|
(org-element-property :path link)))
|
(let ((file (expand-file-name
|
(org-link-unescape
|
(org-element-property :path link)))))
|
(when (file-exists-p file)
|
(let ((width
|
;; Apply `org-image-actual-width' specifications.
|
(cond
|
((not (image-type-available-p 'imagemagick)) nil)
|
((eq org-image-actual-width t) nil)
|
((listp org-image-actual-width)
|
(or
|
;; First try to find a width among
|
;; attributes associated to the paragraph
|
;; containing link.
|
(let ((paragraph
|
(let ((e link))
|
(while (and (setq e (org-element-property
|
:parent e))
|
(not (eq (org-element-type e)
|
'paragraph))))
|
e)))
|
(when paragraph
|
(save-excursion
|
(goto-char (org-element-property :begin paragraph))
|
(when
|
(re-search-forward
|
"^[ \t]*#\\+attr_.*?: +.*?:width +\\(\\S-+\\)"
|
(org-element-property
|
:post-affiliated paragraph)
|
t)
|
(string-to-number (match-string 1))))))
|
;; Otherwise, fall-back to provided number.
|
(car org-image-actual-width)))
|
((numberp org-image-actual-width)
|
org-image-actual-width)))
|
(old (get-char-property-and-overlay
|
(org-element-property :begin link)
|
'org-image-overlay)))
|
(if (and (car-safe old) refresh)
|
(image-refresh (overlay-get (cdr old) 'display))
|
(let ((image (create-image file
|
(and width 'imagemagick)
|
nil
|
:width width)))
|
(when image
|
(let ((ov (make-overlay
|
(org-element-property :begin link)
|
(progn
|
(goto-char
|
(org-element-property :end link))
|
(skip-chars-backward " \t")
|
(point)))))
|
(overlay-put ov 'display image)
|
(overlay-put ov 'face 'default)
|
(overlay-put ov 'org-image-overlay t)
|
(overlay-put
|
ov 'modification-hooks
|
(list 'org-display-inline-remove-overlay))
|
(push ov org-inline-image-overlays)))))))))))))))
|
|
(defun org-display-inline-remove-overlay (ov after _beg _end &optional _len)
|
"Remove inline-display overlay if a corresponding region is modified."
|
(let ((inhibit-modification-hooks t))
|
(when (and ov after)
|
(delete ov org-inline-image-overlays)
|
(delete-overlay ov))))
|
|
(defun org-remove-inline-images ()
|
"Remove inline display of images."
|
(interactive)
|
(mapc #'delete-overlay org-inline-image-overlays)
|
(setq org-inline-image-overlays nil))
|
|
;;;; Key bindings
|
|
(defun org-remap (map &rest commands)
|
"In MAP, remap the functions given in COMMANDS.
|
COMMANDS is a list of alternating OLDDEF NEWDEF command names."
|
(let (new old)
|
(while commands
|
(setq old (pop commands) new (pop commands))
|
(org-defkey map (vector 'remap old) new))))
|
|
;; 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 outline-show-subtree] 'org-show-subtree)
|
(define-key org-mode-map [remap outline-forward-same-level]
|
'org-forward-heading-same-level)
|
(define-key org-mode-map [remap outline-backward-same-level]
|
'org-backward-heading-same-level)
|
(define-key org-mode-map [remap outline-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)
|
(define-key org-mode-map [remap outline-next-visible-heading]
|
'org-next-visible-heading)
|
(define-key org-mode-map [remap outline-previous-visible-heading]
|
'org-previous-visible-heading)
|
(define-key org-mode-map [remap show-children] 'org-show-children)
|
|
;; 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-up-heading' | `C-c C-u' | still same function |
|
;; | `outline-move-subtree-up' | overridden | better: org-shiftup |
|
;; | `outline-move-subtree-down' | overridden | better: org-shiftdown |
|
;; | `show-entry' | overridden | no replacement |
|
;; | `show-branches' | `C-c C-k' | still same function |
|
;; | `show-subtree' | overridden | visibility cycling |
|
;; | `show-all' | overridden | no replacement |
|
;; | `hide-subtree' | overridden | visibility cycling |
|
;; | `hide-body' | overridden | no replacement |
|
;; | `hide-entry' | overridden | visibility cycling |
|
;; | `hide-leaves' | overridden | no replacement |
|
;; | `hide-sublevels' | overridden | no replacement |
|
;; | `hide-other' | overridden | no replacement |
|
|
;; Make `C-c C-x' a prefix key
|
(org-defkey org-mode-map "\C-c\C-x" (make-sparse-keymap))
|
|
;; TAB key with modifiers
|
(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 "\M-\t" #'pcomplete)
|
|
;; The following line is necessary under Suse GNU/Linux
|
(org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab)
|
(org-defkey org-mode-map [(shift tab)] 'org-shifttab)
|
(define-key org-mode-map [backtab] 'org-shifttab)
|
|
(org-defkey org-mode-map [(shift return)] 'org-table-copy-down)
|
(org-defkey org-mode-map [(meta shift return)] 'org-insert-todo-heading)
|
(org-defkey org-mode-map (kbd "M-RET") #'org-meta-return)
|
|
;; Cursor keys with modifiers
|
(org-defkey org-mode-map [(meta left)] 'org-metaleft)
|
(org-defkey org-mode-map [(meta right)] 'org-metaright)
|
(org-defkey org-mode-map [(meta up)] 'org-metaup)
|
(org-defkey org-mode-map [(meta down)] 'org-metadown)
|
|
(org-defkey org-mode-map [(control meta shift right)] 'org-increase-number-at-point)
|
(org-defkey org-mode-map [(control meta shift left)] 'org-decrease-number-at-point)
|
(org-defkey org-mode-map [(meta shift left)] 'org-shiftmetaleft)
|
(org-defkey org-mode-map [(meta shift right)] 'org-shiftmetaright)
|
(org-defkey org-mode-map [(meta shift up)] 'org-shiftmetaup)
|
(org-defkey org-mode-map [(meta shift down)] 'org-shiftmetadown)
|
|
(org-defkey org-mode-map [(shift up)] 'org-shiftup)
|
(org-defkey org-mode-map [(shift down)] 'org-shiftdown)
|
(org-defkey org-mode-map [(shift left)] 'org-shiftleft)
|
(org-defkey org-mode-map [(shift right)] 'org-shiftright)
|
|
(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)
|
(dolist (pair org-babel-key-bindings)
|
(define-key org-babel-map (car pair) (cdr pair)))
|
|
;;; Extra keys for tty access.
|
;; We only set them when really needed because otherwise the
|
;; menus don't show the simple keys
|
|
(when (or org-use-extra-keys (not window-system))
|
(org-defkey org-mode-map "\C-c\C-xc" 'org-table-copy-down)
|
(org-defkey org-mode-map "\C-c\C-xM" 'org-insert-todo-heading)
|
(org-defkey org-mode-map "\C-c\C-xm" 'org-meta-return)
|
(org-defkey org-mode-map [?\e (return)] 'org-meta-return)
|
(org-defkey org-mode-map [?\e (left)] 'org-metaleft)
|
(org-defkey org-mode-map "\C-c\C-xl" 'org-metaleft)
|
(org-defkey org-mode-map [?\e (right)] 'org-metaright)
|
(org-defkey org-mode-map "\C-c\C-xr" 'org-metaright)
|
(org-defkey org-mode-map [?\e (up)] 'org-metaup)
|
(org-defkey org-mode-map "\C-c\C-xu" 'org-metaup)
|
(org-defkey org-mode-map [?\e (down)] 'org-metadown)
|
(org-defkey org-mode-map "\C-c\C-xd" 'org-metadown)
|
(org-defkey org-mode-map "\C-c\C-xL" 'org-shiftmetaleft)
|
(org-defkey org-mode-map "\C-c\C-xR" 'org-shiftmetaright)
|
(org-defkey org-mode-map "\C-c\C-xU" 'org-shiftmetaup)
|
(org-defkey org-mode-map "\C-c\C-xD" 'org-shiftmetadown)
|
(org-defkey org-mode-map [?\C-c (up)] 'org-shiftup)
|
(org-defkey org-mode-map [?\C-c (down)] 'org-shiftdown)
|
(org-defkey org-mode-map [?\C-c (left)] 'org-shiftleft)
|
(org-defkey org-mode-map [?\C-c (right)] 'org-shiftright)
|
(org-defkey org-mode-map [?\C-c ?\C-x (right)] 'org-shiftcontrolright)
|
(org-defkey org-mode-map [?\C-c ?\C-x (left)] 'org-shiftcontrolleft)
|
(org-defkey org-mode-map [?\e (tab)] #'pcomplete)
|
(org-defkey org-mode-map [?\e (shift return)] 'org-insert-todo-heading)
|
(org-defkey org-mode-map [?\e (shift left)] 'org-shiftmetaleft)
|
(org-defkey org-mode-map [?\e (shift right)] 'org-shiftmetaright)
|
(org-defkey org-mode-map [?\e (shift up)] 'org-shiftmetaup)
|
(org-defkey org-mode-map [?\e (shift down)] 'org-shiftmetadown))
|
|
;; All the other keys
|
(org-remap org-mode-map
|
'self-insert-command 'org-self-insert-command
|
'delete-char 'org-delete-char
|
'delete-backward-char 'org-delete-backward-char)
|
(org-defkey org-mode-map "|" 'org-force-self-insert)
|
|
(org-defkey org-mode-map "\C-c\C-a" 'outline-show-all) ; in case allout messed up.
|
(org-defkey org-mode-map "\C-c\C-r" 'org-reveal)
|
(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))
|
(if (boundp 'narrow-map)
|
(org-defkey narrow-map "e" 'org-narrow-to-element)
|
(org-defkey org-mode-map "\C-xne" 'org-narrow-to-element))
|
(org-defkey org-mode-map "\C-\M-t" 'org-transpose-element)
|
(org-defkey org-mode-map "\M-}" 'org-forward-element)
|
(org-defkey org-mode-map "\M-{" 'org-backward-element)
|
(org-defkey org-mode-map "\C-c\C-^" 'org-up-element)
|
(org-defkey org-mode-map "\C-c\C-_" 'org-down-element)
|
(org-defkey org-mode-map "\C-c\C-f" 'org-forward-heading-same-level)
|
(org-defkey org-mode-map "\C-c\C-b" 'org-backward-heading-same-level)
|
(org-defkey org-mode-map "\C-c\M-f" 'org-next-block)
|
(org-defkey org-mode-map "\C-c\M-b" 'org-previous-block)
|
(org-defkey org-mode-map "\C-c$" 'org-archive-subtree)
|
(org-defkey org-mode-map "\C-c\C-x\C-s" 'org-archive-subtree)
|
(org-defkey org-mode-map "\C-c\C-x\C-a" 'org-archive-subtree-default)
|
(org-defkey org-mode-map "\C-c\C-xd" 'org-insert-drawer)
|
(org-defkey org-mode-map "\C-c\C-xa" 'org-toggle-archive-tag)
|
(org-defkey org-mode-map "\C-c\C-xA" 'org-archive-to-archive-sibling)
|
(org-defkey org-mode-map "\C-c\C-xb" 'org-tree-to-indirect-buffer)
|
(org-defkey org-mode-map "\C-c\C-xq" 'org-toggle-tags-groups)
|
(org-defkey org-mode-map "\C-c\C-j" 'org-goto)
|
(org-defkey org-mode-map "\C-c\C-t" 'org-todo)
|
(org-defkey org-mode-map "\C-c\C-q" 'org-set-tags-command)
|
(org-defkey org-mode-map "\C-c\C-s" 'org-schedule)
|
(org-defkey org-mode-map "\C-c\C-d" 'org-deadline)
|
(org-defkey org-mode-map "\C-c;" 'org-toggle-comment)
|
(org-defkey org-mode-map "\C-c\C-w" 'org-refile)
|
(org-defkey org-mode-map "\C-c\M-w" 'org-copy)
|
(org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved
|
(org-defkey org-mode-map "\C-c\\" 'org-match-sparse-tree) ; Minor-mode res.
|
(org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret)
|
(org-defkey org-mode-map "\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)
|
(org-defkey org-mode-map "\C-c\C-x\C-p" 'org-previous-link)
|
(org-defkey org-mode-map "\C-c\C-l" 'org-insert-link)
|
(org-defkey org-mode-map "\C-c\M-l" 'org-insert-last-stored-link)
|
(org-defkey org-mode-map "\C-c\C-\M-l" 'org-insert-all-links)
|
(org-defkey org-mode-map "\C-c\C-o" 'org-open-at-point)
|
(org-defkey org-mode-map "\C-c%" 'org-mark-ring-push)
|
(org-defkey org-mode-map "\C-c&" 'org-mark-ring-goto)
|
(org-defkey org-mode-map "\C-c\C-z" 'org-add-note) ; Alternative binding
|
(org-defkey org-mode-map "\C-c." 'org-time-stamp) ; Minor-mode reserved
|
(org-defkey org-mode-map "\C-c!" 'org-time-stamp-inactive) ; Minor-mode r.
|
(org-defkey org-mode-map "\C-c," 'org-priority) ; Minor-mode reserved
|
(org-defkey org-mode-map "\C-c\C-y" 'org-evaluate-time-range)
|
(org-defkey org-mode-map "\C-c>" 'org-goto-calendar)
|
(org-defkey org-mode-map "\C-c<" 'org-date-from-calendar)
|
(org-defkey org-mode-map [(control ?,)] 'org-cycle-agenda-files)
|
(org-defkey org-mode-map [(control ?\')] 'org-cycle-agenda-files)
|
(org-defkey org-mode-map "\C-c[" 'org-agenda-file-to-front)
|
(org-defkey org-mode-map "\C-c]" 'org-remove-file)
|
(org-defkey org-mode-map "\C-c\C-x<" 'org-agenda-set-restriction-lock)
|
(org-defkey org-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
|
(org-defkey org-mode-map "\C-c-" 'org-ctrl-c-minus)
|
(org-defkey org-mode-map "\C-c*" 'org-ctrl-c-star)
|
(org-defkey org-mode-map "\C-c^" 'org-sort)
|
(org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c)
|
(org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches)
|
(org-defkey org-mode-map "\C-c#" 'org-update-statistics-cookies)
|
(org-defkey org-mode-map [remap open-line] 'org-open-line)
|
(org-defkey org-mode-map [remap comment-dwim] 'org-comment-dwim)
|
(org-defkey org-mode-map [remap forward-paragraph] 'org-forward-paragraph)
|
(org-defkey org-mode-map [remap backward-paragraph] 'org-backward-paragraph)
|
(org-defkey org-mode-map "\M-^" 'org-delete-indentation)
|
(org-defkey org-mode-map "\C-m" 'org-return)
|
(org-defkey org-mode-map "\C-j" 'org-return-indent)
|
(org-defkey org-mode-map "\C-c?" 'org-table-field-info)
|
(org-defkey org-mode-map "\C-c " 'org-table-blank-field)
|
(org-defkey org-mode-map "\C-c+" 'org-table-sum)
|
(org-defkey org-mode-map "\C-c=" 'org-table-eval-formula)
|
(org-defkey org-mode-map "\C-c'" 'org-edit-special)
|
(org-defkey org-mode-map "\C-c`" 'org-table-edit-field)
|
(org-defkey org-mode-map "\C-c\"a" 'orgtbl-ascii-plot)
|
(org-defkey org-mode-map "\C-c\"g" 'org-plot/gnuplot)
|
(org-defkey org-mode-map "\C-c|" 'org-table-create-or-convert-from-region)
|
(org-defkey org-mode-map [(control ?#)] 'org-table-rotate-recalc-marks)
|
(org-defkey org-mode-map "\C-c~" 'org-table-create-with-table.el)
|
(org-defkey org-mode-map "\C-c\C-a" 'org-attach)
|
(org-defkey org-mode-map "\C-c}" 'org-table-toggle-coordinate-overlays)
|
(org-defkey org-mode-map "\C-c{" 'org-table-toggle-formula-debugger)
|
(org-defkey org-mode-map "\C-c\C-e" 'org-export-dispatch)
|
(org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width)
|
(org-defkey org-mode-map "\C-c\C-x\C-f" 'org-emphasize)
|
(org-defkey org-mode-map "\C-c\C-xf" 'org-footnote-action)
|
(org-defkey org-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull)
|
(org-defkey org-mode-map "\C-c\C-x\C-mp" 'org-mobile-push)
|
(org-defkey org-mode-map "\C-c@" 'org-mark-subtree)
|
(org-defkey org-mode-map "\M-h" 'org-mark-element)
|
(org-defkey org-mode-map [?\C-c (control ?*)] 'org-list-make-subtree)
|
;;(org-defkey org-mode-map [?\C-c (control ?-)] 'org-list-make-list-from-subtree)
|
|
(org-defkey org-mode-map "\C-c\C-x\C-w" 'org-cut-special)
|
(org-defkey org-mode-map "\C-c\C-x\M-w" 'org-copy-special)
|
(org-defkey org-mode-map "\C-c\C-x\C-y" 'org-paste-special)
|
|
(org-defkey org-mode-map "\C-c\C-x\C-t" 'org-toggle-time-stamp-overlays)
|
(org-defkey org-mode-map "\C-c\C-x\C-i" 'org-clock-in)
|
(org-defkey org-mode-map "\C-c\C-x\C-x" 'org-clock-in-last)
|
(org-defkey org-mode-map "\C-c\C-x\C-z" 'org-resolve-clocks)
|
(org-defkey org-mode-map "\C-c\C-x\C-o" 'org-clock-out)
|
(org-defkey org-mode-map "\C-c\C-x\C-j" 'org-clock-goto)
|
(org-defkey org-mode-map "\C-c\C-x\C-q" 'org-clock-cancel)
|
(org-defkey org-mode-map "\C-c\C-x\C-d" 'org-clock-display)
|
(org-defkey org-mode-map "\C-c\C-x\C-r" 'org-clock-report)
|
(org-defkey org-mode-map "\C-c\C-x\C-u" 'org-dblock-update)
|
(org-defkey org-mode-map "\C-c\C-x\C-l" 'org-toggle-latex-fragment)
|
(org-defkey org-mode-map "\C-c\C-x\C-v" 'org-toggle-inline-images)
|
(org-defkey org-mode-map "\C-c\C-x\C-\M-v" 'org-redisplay-inline-images)
|
(org-defkey org-mode-map "\C-c\C-x\\" 'org-toggle-pretty-entities)
|
(org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox)
|
(org-defkey org-mode-map "\C-c\C-xp" 'org-set-property)
|
(org-defkey org-mode-map "\C-c\C-xP" 'org-set-property-and-value)
|
(org-defkey org-mode-map "\C-c\C-xe" 'org-set-effort)
|
(org-defkey org-mode-map "\C-c\C-xE" 'org-inc-effort)
|
(org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property)
|
(org-defkey org-mode-map "\C-c\C-xi" 'org-columns-insert-dblock)
|
(org-defkey org-mode-map [(control ?c) (control ?x) ?\;] 'org-timer-set-timer)
|
|
(org-defkey org-mode-map "\C-c\C-x." 'org-timer)
|
(org-defkey org-mode-map "\C-c\C-x-" 'org-timer-item)
|
(org-defkey org-mode-map "\C-c\C-x0" 'org-timer-start)
|
(org-defkey org-mode-map "\C-c\C-x_" 'org-timer-stop)
|
(org-defkey org-mode-map "\C-c\C-x," 'org-timer-pause-or-continue)
|
|
(define-key org-mode-map "\C-c\C-x\C-c" 'org-columns)
|
|
(define-key org-mode-map "\C-c\C-x!" 'org-reload)
|
|
(define-key org-mode-map "\C-c\C-xg" 'org-feed-update-all)
|
(define-key org-mode-map "\C-c\C-xG" 'org-feed-goto-inbox)
|
|
(define-key org-mode-map "\C-c\C-x[" 'org-reftex-citation)
|
|
|
(defconst org-speed-commands-default
|
'(
|
("Outline Navigation")
|
("n" . (org-speed-move-safe 'org-next-visible-heading))
|
("p" . (org-speed-move-safe 'org-previous-visible-heading))
|
("f" . (org-speed-move-safe 'org-forward-heading-same-level))
|
("b" . (org-speed-move-safe 'org-backward-heading-same-level))
|
("F" . org-next-block)
|
("B" . org-previous-block)
|
("u" . (org-speed-move-safe 'outline-up-heading))
|
("j" . org-goto)
|
("g" . (org-refile t))
|
("Outline Visibility")
|
("c" . org-cycle)
|
("C" . org-shifttab)
|
(" " . org-display-outline-path)
|
("s" . org-narrow-to-subtree)
|
("=" . org-columns)
|
("Outline Structure Editing")
|
("U" . org-metaup)
|
("D" . org-metadown)
|
("r" . org-metaright)
|
("l" . org-metaleft)
|
("R" . org-shiftmetaright)
|
("L" . org-shiftmetaleft)
|
("i" . (progn (forward-char 1) (call-interactively
|
'org-insert-heading-respect-content)))
|
("^" . org-sort)
|
("w" . org-refile)
|
("a" . org-archive-subtree-default-with-confirmation)
|
("@" . org-mark-subtree)
|
("#" . org-toggle-comment)
|
("Clock Commands")
|
("I" . org-clock-in)
|
("O" . org-clock-out)
|
("Meta Data Editing")
|
("t" . org-todo)
|
("," . (org-priority))
|
("0" . (org-priority ?\ ))
|
("1" . (org-priority ?A))
|
("2" . (org-priority ?B))
|
("3" . (org-priority ?C))
|
(":" . org-set-tags-command)
|
("e" . org-set-effort)
|
("E" . org-inc-effort)
|
("W" . (lambda(m) (interactive "sMinutes before warning: ")
|
(org-entry-put (point) "APPT_WARNTIME" m)))
|
("Agenda Views etc")
|
("v" . org-agenda)
|
("/" . org-sparse-tree)
|
("Misc")
|
("o" . org-open-at-point)
|
("?" . org-speed-command-help)
|
("<" . (org-agenda-set-restriction-lock 'subtree))
|
(">" . (org-agenda-remove-restriction-lock))
|
)
|
"The default speed commands.")
|
|
(defun org-print-speed-command (e)
|
(if (> (length (car e)) 1)
|
(progn
|
(princ "\n")
|
(princ (car e))
|
(princ "\n")
|
(princ (make-string (length (car e)) ?-))
|
(princ "\n"))
|
(princ (car e))
|
(princ " ")
|
(if (symbolp (cdr e))
|
(princ (symbol-name (cdr e)))
|
(prin1 (cdr e)))
|
(princ "\n")))
|
|
(defun org-speed-command-help ()
|
"Show the available speed commands."
|
(interactive)
|
(if (not org-use-speed-commands)
|
(user-error "Speed commands are not activated, customize `org-use-speed-commands'")
|
(with-output-to-temp-buffer "*Help*"
|
(princ "User-defined Speed commands\n===========================\n")
|
(mapc #'org-print-speed-command org-speed-commands-user)
|
(princ "\n")
|
(princ "Built-in Speed commands\n=======================\n")
|
(mapc #'org-print-speed-command org-speed-commands-default))
|
(with-current-buffer "*Help*"
|
(setq truncate-lines t))))
|
|
(defun org-speed-move-safe (cmd)
|
"Execute CMD, but make sure that the cursor always ends up in a headline.
|
If not, return to the original position and throw an error."
|
(interactive)
|
(let ((pos (point)))
|
(call-interactively cmd)
|
(unless (and (bolp) (org-at-heading-p))
|
(goto-char pos)
|
(error "Boundary reached while executing %s" cmd))))
|
|
(defvar org-self-insert-command-undo-counter 0)
|
|
(defvar org-table-auto-blank-field) ; defined in org-table.el
|
(defvar org-speed-command nil)
|
|
(defun org-speed-command-activate (keys)
|
"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 org-outline-regexp))
|
(and (functionp org-use-speed-commands)
|
(funcall org-use-speed-commands)))
|
(cdr (assoc keys (append org-speed-commands-user
|
org-speed-commands-default)))))
|
|
(defun org-babel-speed-command-activate (keys)
|
"Hook for activating single-letter code block commands."
|
(when (and (bolp) (looking-at org-babel-src-block-regexp))
|
(cdr (assoc keys org-babel-key-bindings))))
|
|
(defcustom org-speed-command-hook
|
'(org-speed-command-activate org-babel-speed-command-activate)
|
"Hook for activating speed commands at strategic locations.
|
Hook functions are called in sequence until a valid handler is
|
found.
|
|
Each hook takes a single argument, a user-pressed command key
|
which is also a `self-insert-command' from the global map.
|
|
Within the hook, examine the cursor position and the command key
|
and return nil or a valid handler as appropriate. Handler could
|
be one of an interactive command, a function, or a form.
|
|
Set `org-use-speed-commands' to non-nil value to enable this
|
hook. The default setting is `org-speed-command-activate'."
|
:group 'org-structure
|
:version "24.1"
|
:type 'hook)
|
|
(defun org-self-insert-command (N)
|
"Like `self-insert-command', use overwrite-mode for whitespace in tables.
|
If the cursor is in a table looking at whitespace, the whitespace is
|
overwritten, and the table is not marked as requiring realignment."
|
(interactive "p")
|
(org-check-before-invisible-edit 'insert)
|
(cond
|
((and org-use-speed-commands
|
(let ((kv (this-command-keys-vector)))
|
(setq org-speed-command
|
(run-hook-with-args-until-success
|
'org-speed-command-hook
|
(make-string 1 (aref kv (1- (length kv))))))))
|
(cond
|
((commandp org-speed-command)
|
(setq this-command org-speed-command)
|
(call-interactively org-speed-command))
|
((functionp org-speed-command)
|
(funcall org-speed-command))
|
((and org-speed-command (listp org-speed-command))
|
(eval org-speed-command))
|
(t (let (org-use-speed-commands)
|
(call-interactively 'org-self-insert-command)))))
|
((and
|
(org-at-table-p)
|
(eq N 1)
|
(not (org-region-active-p))
|
(progn
|
;; Check if we blank the field, and if that triggers align.
|
(and (featurep 'org-table) org-table-auto-blank-field
|
(memq last-command
|
'(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c))
|
(if (or (eq (char-after) ?\s) (looking-at "[^|\n]* |"))
|
;; Got extra space, this field does not determine
|
;; column width.
|
(let (org-table-may-need-update) (org-table-blank-field))
|
;; No extra space, this field may determine column
|
;; width.
|
(org-table-blank-field)))
|
t)
|
(looking-at "[^|\n]* \\( \\)|"))
|
;; There is room for insertion without re-aligning the table.
|
(delete-region (match-beginning 1) (match-end 1))
|
(self-insert-command N))
|
(t
|
(setq org-table-may-need-update t)
|
(self-insert-command N)
|
(org-fix-tags-on-the-fly)
|
(when org-self-insert-cluster-for-undo
|
(if (not (eq last-command 'org-self-insert-command))
|
(setq org-self-insert-command-undo-counter 1)
|
(if (>= org-self-insert-command-undo-counter 20)
|
(setq org-self-insert-command-undo-counter 1)
|
(and (> org-self-insert-command-undo-counter 0)
|
buffer-undo-list (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
|
(when (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. Do not consider
|
;; invisibility obtained through text properties (e.g., link
|
;; fontification), as it cannot be toggled.
|
(let* ((invisible-at-point
|
(pcase (get-char-property-and-overlay (point) 'invisible)
|
(`(,_ . ,(and (pred overlayp) o)) o)))
|
;; Assume that point cannot land in the middle of an
|
;; overlay, or between two overlays.
|
(invisible-before-point
|
(and (not invisible-at-point)
|
(not (bobp))
|
(pcase (get-char-property-and-overlay (1- (point)) 'invisible)
|
(`(,_ . ,(and (pred overlayp) o)) o))))
|
(border-and-ok-direction
|
(or
|
;; Check if we are acting predictably before invisible
|
;; text.
|
(and invisible-at-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 invisible-at-point invisible-before-point)
|
(when (eq org-catch-invisible-edits 'error)
|
(user-error "Editing in invisible areas is prohibited, make them visible first"))
|
(if (and org-custom-properties-overlays
|
(y-or-n-p "Display invisible properties in this buffer? "))
|
(org-toggle-custom-properties-visibility)
|
;; Make the area visible
|
(save-excursion
|
(when invisible-before-point
|
(goto-char
|
(previous-single-char-property-change (point) 'invisible)))
|
;; Remove whatever overlay is currently making yet-to-be
|
;; edited text invisible. Also remove nested invisibility
|
;; related overlays.
|
(delete-overlay (or invisible-at-point invisible-before-point))
|
(let ((origin (if invisible-at-point (point) (1- (point)))))
|
(while (pcase (get-char-property-and-overlay origin 'invisible)
|
(`(,_ . ,(and (pred overlayp) o))
|
(delete-overlay o)
|
t)))))
|
(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
|
(user-error "Edit in invisible region aborted, repeat to confirm with text visible"))))))))
|
|
(defun org-fix-tags-on-the-fly ()
|
"Align tags in headline at point.
|
Unlike to `org-set-tags', it ignores region and sorting."
|
(when (and (eq (char-after (line-beginning-position)) ?*) ;short-circuit
|
(org-at-heading-p))
|
(let ((org-ignore-region t)
|
(org-tags-sort-function nil))
|
(org-set-tags nil t))))
|
|
(defun org-delete-backward-char (N)
|
"Like `delete-backward-char', insert whitespace at field end in tables.
|
When deleting backwards, in tables this function will insert whitespace in
|
front of the next \"|\" separator, to keep the table aligned. The table will
|
still be marked for re-alignment if the field did fill the entire column,
|
because, in this case the deletion might narrow the column."
|
(interactive "p")
|
(save-match-data
|
(org-check-before-invisible-edit 'delete-backward)
|
(if (and (org-at-table-p)
|
(eq N 1)
|
(not (org-region-active-p))
|
(string-match "|" (buffer-substring (point-at-bol) (point)))
|
(looking-at ".*?|"))
|
(let ((pos (point))
|
(noalign (looking-at "[^|\n\r]* |"))
|
(c org-table-may-need-update))
|
(backward-delete-char N)
|
(unless overwrite-mode
|
(skip-chars-forward "^|")
|
(insert " ")
|
(goto-char (1- pos)))
|
;; noalign: if there were two spaces at the end, this field
|
;; does not determine the width of the column.
|
(when noalign (setq org-table-may-need-update c)))
|
(backward-delete-char N)
|
(org-fix-tags-on-the-fly))))
|
|
(defun org-delete-char (N)
|
"Like `delete-char', but insert whitespace at field end in tables.
|
When deleting characters, in tables this function will insert whitespace in
|
front of the next \"|\" separator, to keep the table aligned. The table will
|
still be marked for re-alignment if the field did fill the entire column,
|
because, in this case the deletion might narrow the column."
|
(interactive "p")
|
(save-match-data
|
(org-check-before-invisible-edit 'delete)
|
(if (and (org-at-table-p)
|
(not (bolp))
|
(not (= (char-after) ?|))
|
(eq N 1))
|
(if (looking-at ".*?|")
|
(let ((pos (point))
|
(noalign (looking-at "[^|\n\r]* |"))
|
(c org-table-may-need-update))
|
(replace-match
|
(concat (substring (match-string 0) 1 -1) " |") nil t)
|
(goto-char pos)
|
;; noalign: if there were two spaces at the end, this field
|
;; does not determine the width of the column.
|
(when noalign (setq org-table-may-need-update c)))
|
(delete-char N))
|
(delete-char N)
|
(org-fix-tags-on-the-fly))))
|
|
;; Make `delete-selection-mode' work with Org mode and Orgtbl mode
|
(put 'org-self-insert-command 'delete-selection
|
(lambda ()
|
(not (run-hook-with-args-until-success
|
'self-insert-uses-region-functions))))
|
(put 'orgtbl-self-insert-command 'delete-selection
|
(lambda ()
|
(not (run-hook-with-args-until-success
|
'self-insert-uses-region-functions))))
|
(put 'org-delete-char 'delete-selection 'supersede)
|
(put 'org-delete-backward-char 'delete-selection 'supersede)
|
(put 'org-yank 'delete-selection 'yank)
|
|
;; Make `flyspell-mode' delay after some commands
|
(put 'org-self-insert-command 'flyspell-delayed t)
|
(put 'orgtbl-self-insert-command 'flyspell-delayed t)
|
(put 'org-delete-char 'flyspell-delayed t)
|
(put 'org-delete-backward-char 'flyspell-delayed t)
|
|
;; Make pabbrev-mode expand after Org mode commands
|
(put 'org-self-insert-command 'pabbrev-expand-after-command t)
|
(put 'orgtbl-self-insert-command 'pabbrev-expand-after-command t)
|
|
(defun org-transpose-words ()
|
"Transpose words for Org.
|
This uses the `org-mode-transpose-word-syntax-table' syntax
|
table, which interprets characters in `org-emphasis-alist' as
|
word constituents."
|
(interactive)
|
(with-syntax-table org-mode-transpose-word-syntax-table
|
(call-interactively 'transpose-words)))
|
(org-remap org-mode-map 'transpose-words 'org-transpose-words)
|
|
(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. 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.
|
See `org-ctrl-c-ctrl-c-hook' for more information.
|
This hook runs as the first action when TAB is pressed, even before
|
`org-cycle' messes around with the `outline-regexp' to cater for
|
inline tasks and plain list item folding.
|
If any function in this hook returns t, any other actions that
|
would have been caused by TAB (such as table field motion or visibility
|
cycling) will not occur.")
|
|
(defvar org-tab-after-check-for-table-hook nil
|
"Hook for functions to attach themselves to TAB.
|
See `org-ctrl-c-ctrl-c-hook' for more information.
|
This hook runs after it has been established that the cursor is not in a
|
table, but before checking if the cursor is in a headline or if global cycling
|
should be done.
|
If any function in this hook returns t, not other actions like visibility
|
cycling will be done.")
|
|
(defvar org-tab-after-check-for-cycling-hook nil
|
"Hook for functions to attach themselves to TAB.
|
See `org-ctrl-c-ctrl-c-hook' for more information.
|
This hook runs after it has been established that not table field motion and
|
not visibility should be done because of current context. This is probably
|
the place where a package like yasnippets can hook in.")
|
|
(defvar org-tab-before-tab-emulation-hook nil
|
"Hook for functions to attach themselves to TAB.
|
See `org-ctrl-c-ctrl-c-hook' for more information.
|
This hook runs after every other options for TAB have been exhausted, but
|
before indentation and \t insertion takes place.")
|
|
(defvar org-metaleft-hook nil
|
"Hook for functions attaching themselves to `M-left'.
|
See `org-ctrl-c-ctrl-c-hook' for more information.")
|
(defvar org-metaright-hook nil
|
"Hook for functions attaching themselves to `M-right'.
|
See `org-ctrl-c-ctrl-c-hook' for more information.")
|
(defvar org-metaup-hook nil
|
"Hook for functions attaching themselves to `M-up'.
|
See `org-ctrl-c-ctrl-c-hook' for more information.")
|
(defvar org-metadown-hook nil
|
"Hook for functions attaching themselves to `M-down'.
|
See `org-ctrl-c-ctrl-c-hook' for more information.")
|
(defvar org-shiftmetaleft-hook nil
|
"Hook for functions attaching themselves to `M-S-left'.
|
See `org-ctrl-c-ctrl-c-hook' for more information.")
|
(defvar org-shiftmetaright-hook nil
|
"Hook for functions attaching themselves to `M-S-right'.
|
See `org-ctrl-c-ctrl-c-hook' for more information.")
|
(defvar org-shiftmetaup-hook nil
|
"Hook for functions attaching themselves to `M-S-up'.
|
See `org-ctrl-c-ctrl-c-hook' for more information.")
|
(defvar org-shiftmetadown-hook nil
|
"Hook for functions attaching themselves to `M-S-down'.
|
See `org-ctrl-c-ctrl-c-hook' for more information.")
|
(defvar org-metareturn-hook nil
|
"Hook for functions attaching themselves to `M-RET'.
|
See `org-ctrl-c-ctrl-c-hook' for more information.")
|
(defvar org-shiftup-hook nil
|
"Hook for functions attaching themselves to `S-up'.
|
See `org-ctrl-c-ctrl-c-hook' for more information.")
|
(defvar org-shiftup-final-hook nil
|
"Hook for functions attaching themselves to `S-up'.
|
This one runs after all other options except shift-select have been excluded.
|
See `org-ctrl-c-ctrl-c-hook' for more information.")
|
(defvar org-shiftdown-hook nil
|
"Hook for functions attaching themselves to `S-down'.
|
See `org-ctrl-c-ctrl-c-hook' for more information.")
|
(defvar org-shiftdown-final-hook nil
|
"Hook for functions attaching themselves to `S-down'.
|
This one runs after all other options except shift-select have been excluded.
|
See `org-ctrl-c-ctrl-c-hook' for more information.")
|
(defvar org-shiftleft-hook nil
|
"Hook for functions attaching themselves to `S-left'.
|
See `org-ctrl-c-ctrl-c-hook' for more information.")
|
(defvar org-shiftleft-final-hook nil
|
"Hook for functions attaching themselves to `S-left'.
|
This one runs after all other options except shift-select have been excluded.
|
See `org-ctrl-c-ctrl-c-hook' for more information.")
|
(defvar org-shiftright-hook nil
|
"Hook for functions attaching themselves to `S-right'.
|
See `org-ctrl-c-ctrl-c-hook' for more information.")
|
(defvar org-shiftright-final-hook nil
|
"Hook for functions attaching themselves to `S-right'.
|
This one runs after all other options except shift-select have been excluded.
|
See `org-ctrl-c-ctrl-c-hook' for more information.")
|
|
(defun org-modifier-cursor-error ()
|
"Throw an error, a modified cursor command was applied in wrong context."
|
(user-error "This command is active in special context like tables, headlines or items"))
|
|
(defun org-shiftselect-error ()
|
"Throw an error because Shift-Cursor command was applied in wrong context."
|
(if (and (boundp 'shift-select-mode) shift-select-mode)
|
(user-error "To use shift-selection with Org mode, customize `org-support-shift-select'")
|
(user-error "This command works only in special context like headlines or timestamps")))
|
|
(defun org-call-for-shift-select (cmd)
|
(let ((this-command-keys-shift-translated t))
|
(call-interactively cmd)))
|
|
(defun org-shifttab (&optional arg)
|
"Global visibility cycling or move to previous table field.
|
Call `org-table-previous-field' within a table.
|
When ARG is nil, cycle globally through visibility states.
|
When ARG is a numeric prefix, show contents of this level."
|
(interactive "P")
|
(cond
|
((org-at-table-p) (call-interactively 'org-table-previous-field))
|
((integerp arg)
|
(let ((arg2 (if org-odd-levels-only (1- (* 2 arg)) arg)))
|
(message "Content view to level: %d" arg)
|
(org-content (prefix-numeric-value arg2))
|
(org-cycle-show-empty-lines t)
|
(setq org-cycle-global-status 'overview)))
|
(t (call-interactively 'org-global-cycle))))
|
|
(defun org-shiftmetaleft ()
|
"Promote subtree or delete table column.
|
Calls `org-promote-subtree', `org-outdent-item-tree', or
|
`org-table-delete-column', depending on context. See the
|
individual commands for more information."
|
(interactive)
|
(cond
|
((run-hook-with-args-until-success 'org-shiftmetaleft-hook))
|
((org-at-table-p) (call-interactively 'org-table-delete-column))
|
((org-at-heading-p) (call-interactively 'org-promote-subtree))
|
((if (not (org-region-active-p)) (org-at-item-p)
|
(save-excursion (goto-char (region-beginning))
|
(org-at-item-p)))
|
(call-interactively 'org-outdent-item-tree))
|
(t (org-modifier-cursor-error))))
|
|
(defun org-shiftmetaright ()
|
"Demote subtree or insert table column.
|
Calls `org-demote-subtree', `org-indent-item-tree', or
|
`org-table-insert-column', depending on context. See the
|
individual commands for more information."
|
(interactive)
|
(cond
|
((run-hook-with-args-until-success 'org-shiftmetaright-hook))
|
((org-at-table-p) (call-interactively 'org-table-insert-column))
|
((org-at-heading-p) (call-interactively 'org-demote-subtree))
|
((if (not (org-region-active-p)) (org-at-item-p)
|
(save-excursion (goto-char (region-beginning))
|
(org-at-item-p)))
|
(call-interactively 'org-indent-item-tree))
|
(t (org-modifier-cursor-error))))
|
|
(defun org-shiftmetaup (&optional _arg)
|
"Drag the line at point up.
|
In a table, kill the current row.
|
On a clock timestamp, update the value of the timestamp like `S-<up>'
|
but also adjust the previous clocked item in the clock history.
|
Everywhere else, drag the line at point up."
|
(interactive "P")
|
(cond
|
((run-hook-with-args-until-success 'org-shiftmetaup-hook))
|
((org-at-table-p) (call-interactively 'org-table-kill-row))
|
((org-at-clock-log-p) (let ((org-clock-adjust-closest t))
|
(call-interactively 'org-timestamp-up)))
|
(t (call-interactively 'org-drag-line-backward))))
|
|
(defun org-shiftmetadown (&optional _arg)
|
"Drag the line at point down.
|
In a table, insert an empty row at the current line.
|
On a clock timestamp, update the value of the timestamp like `S-<down>'
|
but also adjust the previous clocked item in the clock history.
|
Everywhere else, drag the line at point down."
|
(interactive "P")
|
(cond
|
((run-hook-with-args-until-success 'org-shiftmetadown-hook))
|
((org-at-table-p) (call-interactively 'org-table-insert-row))
|
((org-at-clock-log-p) (let ((org-clock-adjust-closest t))
|
(call-interactively 'org-timestamp-down)))
|
(t (call-interactively 'org-drag-line-forward))))
|
|
(defsubst org-hidden-tree-error ()
|
(user-error
|
"Hidden subtree, open with TAB or use subtree command M-S-<left>/<right>"))
|
|
(defun org-metaleft (&optional _arg)
|
"Promote heading, list item at point or move table column left.
|
|
Calls `org-do-promote', `org-outdent-item' or `org-table-move-column',
|
depending on context. With no specific context, calls the Emacs
|
default `backward-word'. See the individual commands for more
|
information.
|
|
This function runs the hook `org-metaleft-hook' as a first step,
|
and returns at first non-nil value."
|
(interactive "P")
|
(cond
|
((run-hook-with-args-until-success 'org-metaleft-hook))
|
((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left))
|
((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
|
(goto-char (region-beginning))
|
(org-at-item-p))))
|
(when (org-check-for-hidden 'items) (org-hidden-tree-error))
|
(call-interactively 'org-outdent-item))
|
(t (call-interactively 'backward-word))))
|
|
(defun org-metaright (&optional _arg)
|
"Demote heading, list item at point or move table column right.
|
|
In front of a drawer or a block keyword, indent it correctly.
|
|
Calls `org-do-demote', `org-indent-item', `org-table-move-column',
|
`org-indent-drawer' or `org-indent-block' depending on context.
|
With no specific context, calls the Emacs default `forward-word'.
|
See the individual commands for more information.
|
|
This function runs the hook `org-metaright-hook' as a first step,
|
and returns at first non-nil value."
|
(interactive "P")
|
(cond
|
((run-hook-with-args-until-success 'org-metaright-hook))
|
((org-at-table-p) (call-interactively 'org-table-move-column))
|
((org-at-drawer-p) (call-interactively 'org-indent-drawer))
|
((org-at-block-p) (call-interactively 'org-indent-block))
|
((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
|
(goto-char (region-beginning))
|
(org-at-item-p))))
|
(when (org-check-for-hidden 'items) (org-hidden-tree-error))
|
(call-interactively 'org-indent-item))
|
(t (call-interactively 'forward-word))))
|
|
(defun org-check-for-hidden (what)
|
"Check if there are hidden headlines/items in the current visual line.
|
WHAT can be either `headlines' or `items'. If the current line is
|
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) org-outline-regexp-bol)
|
((eq what 'items) (org-item-beginning-re))
|
(t (error "This should not happen"))))
|
beg end)
|
(save-excursion
|
(catch 'exit
|
(unless (org-region-active-p)
|
(setq beg (point-at-bol))
|
(beginning-of-line 2)
|
(while (and (not (eobp)) ;; this is like `next-line'
|
(get-char-property (1- (point)) 'invisible))
|
(beginning-of-line 2))
|
(setq end (point))
|
(goto-char beg)
|
(goto-char (point-at-eol))
|
(setq end (max end (point)))
|
(while (re-search-forward re end t)
|
(when (get-char-property (match-beginning 0) 'invisible)
|
(throw 'exit t))))
|
nil))))
|
|
(defun org-metaup (&optional _arg)
|
"Move subtree up or move table row up.
|
Calls `org-move-subtree-up' or `org-table-move-row' or
|
`org-move-item-up', depending on context. See the individual commands
|
for more information."
|
(interactive "P")
|
(cond
|
((run-hook-with-args-until-success 'org-metaup-hook))
|
((org-region-active-p)
|
(let* ((a (min (region-beginning) (region-end)))
|
(b (1- (max (region-beginning) (region-end))))
|
(c (save-excursion (goto-char a)
|
(move-beginning-of-line 0)))
|
(d (save-excursion (goto-char a)
|
(move-end-of-line 0) (point))))
|
(transpose-regions a b c d)
|
(goto-char c)))
|
((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up))
|
((org-at-heading-p) (call-interactively 'org-move-subtree-up))
|
((org-at-item-p) (call-interactively 'org-move-item-up))
|
(t (org-drag-element-backward))))
|
|
(defun org-metadown (&optional _arg)
|
"Move subtree down or move table row down.
|
Calls `org-move-subtree-down' or `org-table-move-row' or
|
`org-move-item-down', depending on context. See the individual
|
commands for more information."
|
(interactive "P")
|
(cond
|
((run-hook-with-args-until-success 'org-metadown-hook))
|
((org-region-active-p)
|
(let* ((a (min (region-beginning) (region-end)))
|
(b (max (region-beginning) (region-end)))
|
(c (save-excursion (goto-char b)
|
(move-beginning-of-line 1)))
|
(d (save-excursion (goto-char b)
|
(move-end-of-line 1) (1+ (point)))))
|
(transpose-regions a b c d)
|
(goto-char d)))
|
((org-at-table-p) (call-interactively 'org-table-move-row))
|
((org-at-heading-p) (call-interactively 'org-move-subtree-down))
|
((org-at-item-p) (call-interactively 'org-move-item-down))
|
(t (org-drag-element-forward))))
|
|
(defun org-shiftup (&optional arg)
|
"Increase item in timestamp or increase priority of current headline.
|
Calls `org-timestamp-up' or `org-priority-up', or `org-previous-item',
|
depending on context. See the individual commands for more information."
|
(interactive "P")
|
(cond
|
((run-hook-with-args-until-success 'org-shiftup-hook))
|
((and org-support-shift-select (org-region-active-p))
|
(org-call-for-shift-select 'previous-line))
|
((org-at-timestamp-p 'lax)
|
(call-interactively (if org-edit-timestamp-down-means-later
|
'org-timestamp-down 'org-timestamp-up)))
|
((and (not (eq org-support-shift-select 'always))
|
org-enable-priority-commands
|
(org-at-heading-p))
|
(call-interactively 'org-priority-up))
|
((and (not org-support-shift-select) (org-at-item-p))
|
(call-interactively 'org-previous-item))
|
((org-clocktable-try-shift 'up arg))
|
((run-hook-with-args-until-success 'org-shiftup-final-hook))
|
(org-support-shift-select
|
(org-call-for-shift-select 'previous-line))
|
(t (org-shiftselect-error))))
|
|
(defun org-shiftdown (&optional arg)
|
"Decrease item in timestamp or decrease priority of current headline.
|
Calls `org-timestamp-down' or `org-priority-down', or `org-next-item'
|
depending on context. See the individual commands for more information."
|
(interactive "P")
|
(cond
|
((run-hook-with-args-until-success 'org-shiftdown-hook))
|
((and org-support-shift-select (org-region-active-p))
|
(org-call-for-shift-select 'next-line))
|
((org-at-timestamp-p 'lax)
|
(call-interactively (if org-edit-timestamp-down-means-later
|
'org-timestamp-up 'org-timestamp-down)))
|
((and (not (eq org-support-shift-select 'always))
|
org-enable-priority-commands
|
(org-at-heading-p))
|
(call-interactively 'org-priority-down))
|
((and (not org-support-shift-select) (org-at-item-p))
|
(call-interactively 'org-next-item))
|
((org-clocktable-try-shift 'down arg))
|
((run-hook-with-args-until-success 'org-shiftdown-final-hook))
|
(org-support-shift-select
|
(org-call-for-shift-select 'next-line))
|
(t (org-shiftselect-error))))
|
|
(defun org-shiftright (&optional arg)
|
"Cycle the thing at point or in the current line, depending on context.
|
Depending on context, this does one of the following:
|
|
- switch a timestamp at point one day into the future
|
- on a headline, switch to the next TODO keyword.
|
- on an item, switch entire list to the next bullet type
|
- on a property line, switch to the next allowed value
|
- on a clocktable definition line, move time block into the future"
|
(interactive "P")
|
(cond
|
((run-hook-with-args-until-success 'org-shiftright-hook))
|
((and org-support-shift-select (org-region-active-p))
|
(org-call-for-shift-select 'forward-char))
|
((org-at-timestamp-p 'lax) (call-interactively 'org-timestamp-up-day))
|
((and (not (eq org-support-shift-select 'always))
|
(org-at-heading-p))
|
(let ((org-inhibit-logging
|
(not org-treat-S-cursor-todo-selection-as-state-change))
|
(org-inhibit-blocking
|
(not org-treat-S-cursor-todo-selection-as-state-change)))
|
(org-call-with-arg 'org-todo 'right)))
|
((or (and org-support-shift-select
|
(not (eq org-support-shift-select 'always))
|
(org-at-item-bullet-p))
|
(and (not org-support-shift-select) (org-at-item-p)))
|
(org-call-with-arg 'org-cycle-list-bullet nil))
|
((and (not (eq org-support-shift-select 'always))
|
(org-at-property-p))
|
(call-interactively 'org-property-next-allowed-value))
|
((org-clocktable-try-shift 'right arg))
|
((run-hook-with-args-until-success 'org-shiftright-final-hook))
|
(org-support-shift-select
|
(org-call-for-shift-select 'forward-char))
|
(t (org-shiftselect-error))))
|
|
(defun org-shiftleft (&optional arg)
|
"Cycle the thing at point or in the current line, depending on context.
|
Depending on context, this does one of the following:
|
|
- switch a timestamp at point one day into the past
|
- on a headline, switch to the previous TODO keyword.
|
- on an item, switch entire list to the previous bullet type
|
- on a property line, switch to the previous allowed value
|
- on a clocktable definition line, move time block into the past"
|
(interactive "P")
|
(cond
|
((run-hook-with-args-until-success 'org-shiftleft-hook))
|
((and org-support-shift-select (org-region-active-p))
|
(org-call-for-shift-select 'backward-char))
|
((org-at-timestamp-p 'lax) (call-interactively 'org-timestamp-down-day))
|
((and (not (eq org-support-shift-select 'always))
|
(org-at-heading-p))
|
(let ((org-inhibit-logging
|
(not org-treat-S-cursor-todo-selection-as-state-change))
|
(org-inhibit-blocking
|
(not org-treat-S-cursor-todo-selection-as-state-change)))
|
(org-call-with-arg 'org-todo 'left)))
|
((or (and org-support-shift-select
|
(not (eq org-support-shift-select 'always))
|
(org-at-item-bullet-p))
|
(and (not org-support-shift-select) (org-at-item-p)))
|
(org-call-with-arg 'org-cycle-list-bullet 'previous))
|
((and (not (eq org-support-shift-select 'always))
|
(org-at-property-p))
|
(call-interactively 'org-property-previous-allowed-value))
|
((org-clocktable-try-shift 'left arg))
|
((run-hook-with-args-until-success 'org-shiftleft-final-hook))
|
(org-support-shift-select
|
(org-call-for-shift-select 'backward-char))
|
(t (org-shiftselect-error))))
|
|
(defun org-shiftcontrolright ()
|
"Switch to next TODO set."
|
(interactive)
|
(cond
|
((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-at-heading-p))
|
(org-call-with-arg 'org-todo 'nextset))
|
(org-support-shift-select
|
(org-call-for-shift-select 'forward-word))
|
(t (org-shiftselect-error))))
|
|
(defun org-shiftcontrolleft ()
|
"Switch to previous TODO set."
|
(interactive)
|
(cond
|
((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-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 (&optional n)
|
"Change timestamps synchronously up in CLOCK log lines.
|
Optional argument N tells to change by that many units."
|
(interactive "P")
|
(if (and (org-at-clock-log-p) (org-at-timestamp-p 'lax))
|
(let (org-support-shift-select)
|
(org-clock-timestamps-up n))
|
(user-error "Not at a clock log")))
|
|
(defun org-shiftcontroldown (&optional n)
|
"Change timestamps synchronously down in CLOCK log lines.
|
Optional argument N tells to change by that many units."
|
(interactive "P")
|
(if (and (org-at-clock-log-p) (org-at-timestamp-p 'lax))
|
(let (org-support-shift-select)
|
(org-clock-timestamps-down n))
|
(user-error "Not at a clock log")))
|
|
(defun org-increase-number-at-point (&optional inc)
|
"Increment the number at point.
|
With an optional prefix numeric argument INC, increment using
|
this numeric value."
|
(interactive "p")
|
(if (not (number-at-point))
|
(user-error "Not on a number")
|
(unless inc (setq inc 1))
|
(let ((pos (point))
|
(beg (skip-chars-backward "-+^/*0-9eE."))
|
(end (skip-chars-forward "-+^/*0-9eE^.")) nap)
|
(setq nap (buffer-substring-no-properties
|
(+ pos beg) (+ pos beg end)))
|
(delete-region (+ pos beg) (+ pos beg end))
|
(insert (calc-eval (concat (number-to-string inc) "+" nap))))
|
(when (org-at-table-p)
|
(org-table-align)
|
(org-table-end-of-field 1))))
|
|
(defun org-decrease-number-at-point (&optional inc)
|
"Decrement the number at point.
|
With an optional prefix numeric argument INC, decrement using
|
this numeric value."
|
(interactive "p")
|
(org-increase-number-at-point (- (or inc 1))))
|
|
(defun org-ctrl-c-ret ()
|
"Call `org-table-hline-and-move' or `org-insert-heading' dep. on context."
|
(interactive)
|
(cond
|
((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 ((result ""))
|
(while (/= beg end)
|
(when (get-char-property beg 'invisible)
|
(setq beg (next-single-char-property-change beg 'invisible nil end)))
|
(let ((next (next-single-char-property-change beg 'invisible nil end)))
|
(setq result (concat result (buffer-substring beg next)))
|
(setq beg next)))
|
(kill-new result)))
|
|
(defun org-copy-special ()
|
"Copy region in table or copy current subtree.
|
Calls `org-table-copy-region' or `org-copy-subtree', depending on
|
context. See the individual commands for more information."
|
(interactive)
|
(call-interactively
|
(if (org-at-table-p) #'org-table-copy-region #'org-copy-subtree)))
|
|
(defun org-cut-special ()
|
"Cut region in table or cut current subtree.
|
Calls `org-table-cut-region' or `org-cut-subtree', depending on
|
context. See the individual commands for more information."
|
(interactive)
|
(call-interactively
|
(if (org-at-table-p) #'org-table-cut-region #'org-cut-subtree)))
|
|
(defun org-paste-special (arg)
|
"Paste rectangular region into table, or past subtree relative to level.
|
Calls `org-table-paste-rectangle' or `org-paste-subtree', depending on context.
|
See the individual commands for more information."
|
(interactive "P")
|
(if (org-at-table-p)
|
(org-table-paste-rectangle)
|
(org-paste-subtree arg)))
|
|
(defun org-edit-special (&optional arg)
|
"Call a special editor for the element at point.
|
When at a table, call the formula editor with `org-table-edit-formulas'.
|
When in a source code block, call `org-edit-src-code'.
|
When in a fixed-width region, call `org-edit-fixed-width-region'.
|
When in an export block, call `org-edit-export-block'.
|
When in a LaTeX environment, call `org-edit-latex-environment'.
|
When at an #+INCLUDE keyword, visit the included file.
|
When at a footnote reference, call `org-edit-footnote-reference'
|
On a link, call `ffap' to visit the link at point.
|
Otherwise, return a user error."
|
(interactive "P")
|
(let ((element (org-element-at-point)))
|
(barf-if-buffer-read-only)
|
(pcase (org-element-type element)
|
(`src-block
|
(if (not arg) (org-edit-src-code)
|
(let* ((info (org-babel-get-src-block-info))
|
(lang (nth 0 info))
|
(params (nth 2 info))
|
(session (cdr (assq :session params))))
|
(if (not session) (org-edit-src-code)
|
;; At a src-block with a session and function called with
|
;; an ARG: switch to the buffer related to the inferior
|
;; process.
|
(switch-to-buffer
|
(funcall (intern (concat "org-babel-prep-session:" lang))
|
session params))))))
|
(`keyword
|
(if (member (org-element-property :key element) '("INCLUDE" "SETUPFILE"))
|
(org-open-link-from-string
|
(format "[[%s]]"
|
(expand-file-name
|
(let ((value (org-element-property :value element)))
|
(cond ((org-file-url-p value)
|
(user-error "The file is specified as a URL, cannot be edited"))
|
((not (org-string-nw-p value))
|
(user-error "No file to edit"))
|
((string-match "\\`\"\\(.*?\\)\"" value)
|
(match-string 1 value))
|
((string-match "\\`[^ \t\"]\\S-*" value)
|
(match-string 0 value))
|
(t (user-error "No valid file specified")))))))
|
(user-error "No special environment to edit here")))
|
(`table
|
(if (eq (org-element-property :type element) 'table.el)
|
(org-edit-table.el)
|
(call-interactively 'org-table-edit-formulas)))
|
;; Only Org tables contain `table-row' type elements.
|
(`table-row (call-interactively 'org-table-edit-formulas))
|
(`example-block (org-edit-src-code))
|
(`export-block (org-edit-export-block))
|
(`fixed-width (org-edit-fixed-width-region))
|
(`latex-environment (org-edit-latex-environment))
|
(_
|
;; No notable element at point. Though, we may be at a link or
|
;; a footnote reference, which are objects. Thus, scan deeper.
|
(let ((context (org-element-context element)))
|
(pcase (org-element-type context)
|
(`footnote-reference (org-edit-footnote-reference))
|
(`inline-src-block (org-edit-inline-src-code))
|
(`link (call-interactively #'ffap))
|
(_ (user-error "No special environment to edit here"))))))))
|
|
(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.
|
|
This command does many different things, depending on context:
|
|
- If a function in `org-ctrl-c-ctrl-c-hook' recognizes this location,
|
this is what we do.
|
|
- If the cursor is on a statistics cookie, update it.
|
|
- If the cursor is in a headline, prompt for tags and insert them
|
into the current line, aligned to `org-tags-column'. When called
|
with prefix arg, realign all tags in the current buffer.
|
|
- If the cursor is in one of the special #+KEYWORD lines, this
|
triggers scanning the buffer for these lines and updating the
|
information.
|
|
- If the cursor is inside a table, realign the table. This command
|
works even if the automatic table editor has been turned off.
|
|
- If the cursor is on a #+TBLFM line, re-apply the formulas to
|
the entire table.
|
|
- If the cursor is at a footnote reference or definition, jump to
|
the corresponding definition or references, respectively.
|
|
- If the cursor is a the beginning of a dynamic block, update it.
|
|
- If the current buffer is a capture buffer, close note and file it.
|
|
- If the cursor is on a <<<target>>>, update radio targets and
|
corresponding links in this buffer.
|
|
- If the cursor is on a numbered item in a plain list, renumber the
|
ordered list.
|
|
- If the cursor is on a checkbox, toggle it.
|
|
- If the cursor is on a code block, evaluate it. The variable
|
`org-confirm-babel-evaluate' can be used to control prompting
|
before code block evaluation, by default every code block
|
evaluation requires confirmation. Code block evaluation can be
|
inhibited by setting `org-babel-no-eval-on-ctrl-c-ctrl-c'."
|
(interactive "P")
|
(cond
|
((or (bound-and-true-p org-clock-overlays) org-occur-highlights)
|
(when (boundp 'org-clock-overlays) (org-clock-remove-overlays))
|
(org-remove-occur-highlights)
|
(message "Temporary highlights/overlays removed from current buffer"))
|
((and (local-variable-p 'org-finish-function)
|
(fboundp org-finish-function))
|
(funcall org-finish-function))
|
((org-babel-hash-at-point))
|
((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook))
|
(t
|
(let* ((context
|
(org-element-lineage
|
(org-element-context)
|
;; Limit to supported contexts.
|
'(babel-call clock dynamic-block footnote-definition
|
footnote-reference inline-babel-call inline-src-block
|
inlinetask item keyword node-property paragraph
|
plain-list planning property-drawer radio-target
|
src-block statistics-cookie table table-cell table-row
|
timestamp)
|
t))
|
(type (org-element-type context)))
|
;; For convenience: at the first line of a paragraph on the same
|
;; line as an item, apply function on that item instead.
|
(when (eq type 'paragraph)
|
(let ((parent (org-element-property :parent context)))
|
(when (and (eq (org-element-type parent) 'item)
|
(= (line-beginning-position)
|
(org-element-property :begin parent)))
|
(setq context parent)
|
(setq type 'item))))
|
;; Act according to type of element or object at point.
|
;;
|
;; Do nothing on a blank line, except if it is contained in
|
;; a src block. Hence, we first check if point is in such
|
;; a block and then if it is at a blank line.
|
(pcase type
|
((or `inline-src-block `src-block)
|
(unless org-babel-no-eval-on-ctrl-c-ctrl-c
|
(org-babel-eval-wipe-error-buffer)
|
(org-babel-execute-src-block
|
current-prefix-arg (org-babel-get-src-block-info nil context))))
|
((guard (org-match-line "[ \t]*$"))
|
(or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook)
|
(user-error
|
(substitute-command-keys
|
"`\\[org-ctrl-c-ctrl-c]' can do nothing useful here"))))
|
((or `babel-call `inline-babel-call)
|
(let ((info (org-babel-lob-get-info context)))
|
(when info (org-babel-execute-src-block nil info))))
|
(`clock (org-clock-update-time-maybe))
|
(`dynamic-block
|
(save-excursion
|
(goto-char (org-element-property :post-affiliated context))
|
(org-update-dblock)))
|
(`footnote-definition
|
(goto-char (org-element-property :post-affiliated context))
|
(call-interactively 'org-footnote-action))
|
(`footnote-reference (call-interactively #'org-footnote-action))
|
((or `headline `inlinetask)
|
(save-excursion (goto-char (org-element-property :begin context))
|
(call-interactively #'org-set-tags)))
|
(`item
|
;; At an item: `C-u C-u' sets checkbox to "[-]"
|
;; unconditionally, whereas `C-u' will toggle its presence.
|
;; Without a universal argument, if the item has a checkbox,
|
;; toggle it. Otherwise repair the list.
|
(let* ((box (org-element-property :checkbox context))
|
(struct (org-element-property :structure context))
|
(old-struct (copy-tree struct))
|
(parents (org-list-parents-alist struct))
|
(prevs (org-list-prevs-alist struct))
|
(orderedp (org-not-nil (org-entry-get nil "ORDERED"))))
|
(org-list-set-checkbox
|
(org-element-property :begin context) struct
|
(cond ((equal arg '(16)) "[-]")
|
((and (not box) (equal arg '(4))) "[ ]")
|
((or (not box) (equal arg '(4))) nil)
|
((eq box 'on) "[ ]")
|
(t "[X]")))
|
;; Mimic `org-list-write-struct' but with 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)
|
(org-list-struct-fix-bul struct prevs)
|
(org-list-struct-fix-ind struct parents)
|
(let ((block-item
|
(org-list-struct-fix-box struct parents prevs orderedp)))
|
(if (and box (equal struct old-struct))
|
(if (equal arg '(16))
|
(message "Checkboxes already reset")
|
(user-error "Cannot toggle this checkbox: %s"
|
(if (eq box 'on)
|
"all subitems checked"
|
"unchecked subitems")))
|
(org-list-struct-apply-struct struct old-struct)
|
(org-update-checkbox-count-maybe))
|
(when block-item
|
(message "Checkboxes were removed due to empty box at line %d"
|
(org-current-line block-item))))))
|
(`keyword
|
(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"))
|
(`plain-list
|
;; At a plain list, with a double C-u argument, set
|
;; checkboxes of each item to "[-]", whereas a single one
|
;; will toggle their presence according to the state of the
|
;; first item in the list. Without an argument, repair the
|
;; list.
|
(let* ((begin (org-element-property :contents-begin context))
|
(beginm (move-marker (make-marker) begin))
|
(struct (org-element-property :structure context))
|
(old-struct (copy-tree struct))
|
(first-box (save-excursion
|
(goto-char begin)
|
(looking-at org-list-full-item-re)
|
(match-string-no-properties 3)))
|
(new-box (cond ((equal arg '(16)) "[-]")
|
((equal arg '(4)) (unless first-box "[ ]"))
|
((equal first-box "[X]") "[ ]")
|
(t "[X]"))))
|
(cond
|
(arg
|
(dolist (pos
|
(org-list-get-all-items
|
begin struct (org-list-prevs-alist struct)))
|
(org-list-set-checkbox pos struct new-box)))
|
((and first-box (eq (point) begin))
|
;; For convenience, when point is at bol on the first
|
;; item of the list and no argument is provided, simply
|
;; toggle checkbox of that item, if any.
|
(org-list-set-checkbox begin struct new-box)))
|
(org-list-write-struct
|
struct (org-list-parents-alist struct) old-struct)
|
(org-update-checkbox-count-maybe)
|
(save-excursion (goto-char beginm) (org-list-send-list 'maybe))))
|
((or `property-drawer `node-property)
|
(call-interactively #'org-property-action))
|
(`radio-target
|
(call-interactively #'org-update-radio-target-regexp))
|
(`statistics-cookie
|
(call-interactively #'org-update-statistics-cookies))
|
((or `table `table-cell `table-row)
|
;; At a table, recalculate every field and align it. Also
|
;; send the table if necessary. If the table has
|
;; a `table.el' type, just give up. At a table row or cell,
|
;; maybe recalculate line but always align table.
|
(if (eq (org-element-property :type context) 'table.el)
|
(message "%s" (substitute-command-keys "\\<org-mode-map>\
|
Use `\\[org-edit-special]' to edit table.el tables"))
|
(if (or (eq type 'table)
|
;; Check if point is at a TBLFM line.
|
(and (eq type 'table-row)
|
(= (point) (org-element-property :end context))))
|
(save-excursion
|
(if (org-at-TBLFM-p)
|
(progn (require 'org-table)
|
(org-table-calc-current-TBLFM))
|
(goto-char (org-element-property :contents-begin context))
|
(org-call-with-arg 'org-table-recalculate (or arg t))
|
(orgtbl-send-table 'maybe)))
|
(org-table-maybe-eval-formula)
|
(cond (arg (call-interactively #'org-table-recalculate))
|
((org-table-maybe-recalculate-line))
|
(t (org-table-align))))))
|
((or `timestamp (and `planning (guard (org-at-timestamp-p 'lax))))
|
(org-timestamp-change 0 'day))
|
((and `nil (guard (org-at-heading-p)))
|
;; When point is on an unsupported object type, we can miss
|
;; the fact that it also is at a heading. Handle it here.
|
(call-interactively #'org-set-tags))
|
((guard
|
(run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook)))
|
(_
|
(user-error
|
(substitute-command-keys
|
"`\\[org-ctrl-c-ctrl-c]' can do nothing useful here"))))))))
|
|
(defun org-mode-restart ()
|
(interactive)
|
(let ((indent-status (bound-and-true-p org-indent-mode)))
|
(funcall major-mode)
|
(hack-local-variables)
|
(when (and indent-status (not (bound-and-true-p org-indent-mode)))
|
(org-indent-mode -1))
|
(org-reset-file-cache))
|
(message "%s restarted" major-mode))
|
|
(defun org-kill-note-or-show-branches ()
|
"Abort storing current note, or call `outline-show-branches'."
|
(interactive)
|
(if (not org-finish-function)
|
(save-excursion
|
(save-restriction
|
(org-narrow-to-subtree)
|
(org-flag-subtree t)
|
(call-interactively 'outline-show-branches)
|
(org-hide-archived-subtrees (point-min) (point-max))))
|
(let ((org-note-abort t))
|
(funcall org-finish-function))))
|
|
(defun org-delete-indentation (&optional arg)
|
"Join current line to previous and fix whitespace at join.
|
|
If previous line is a headline add to headline title. Otherwise
|
the function calls `delete-indentation'.
|
|
With a non-nil optional argument, join it to the following one."
|
(interactive "*P")
|
(if (save-excursion
|
(beginning-of-line (if arg 1 0))
|
(let ((case-fold-search nil))
|
(looking-at org-complex-heading-regexp)))
|
;; At headline.
|
(let ((tags-column (when (match-beginning 5)
|
(save-excursion (goto-char (match-beginning 5))
|
(current-column))))
|
(string (concat " " (progn (when arg (forward-line 1))
|
(org-trim (delete-and-extract-region
|
(line-beginning-position)
|
(line-end-position)))))))
|
(unless (bobp) (delete-region (point) (1- (point))))
|
(goto-char (or (match-end 4)
|
(match-beginning 5)
|
(match-end 0)))
|
(skip-chars-backward " \t")
|
(save-excursion (insert string))
|
;; Adjust alignment of tags.
|
(cond
|
((not tags-column)) ;no tags
|
(org-auto-align-tags (org-set-tags nil t))
|
(t (org--align-tags-here tags-column)))) ;preserve tags column
|
(delete-indentation arg)))
|
|
(defun org-open-line (n)
|
"Insert a new row in tables, call `open-line' elsewhere.
|
If `org-special-ctrl-o' is nil, just call `open-line' everywhere.
|
As a special case, when a document starts with a table, allow to
|
call `open-line' on the very first character."
|
(interactive "*p")
|
(if (and org-special-ctrl-o (/= (point) 1) (org-at-table-p))
|
(org-table-insert-row)
|
(open-line n)))
|
|
(defun org-return (&optional indent)
|
"Goto next table row or insert a newline.
|
|
Calls `org-table-next-row' or `newline', depending on context.
|
|
When optional INDENT argument is non-nil, call
|
`newline-and-indent' instead of `newline'.
|
|
When `org-return-follows-link' is non-nil and point is on
|
a timestamp or a link, call `org-open-at-point'. However, it
|
will not happen if point is in a table or on a \"dead\"
|
object (e.g., within a comment). In these case, you need to use
|
`org-open-at-point' directly."
|
(interactive)
|
(let ((context (if org-return-follows-link (org-element-context)
|
(org-element-at-point))))
|
(cond
|
;; In a table, call `org-table-next-row'. However, before first
|
;; column or after last one, split the table.
|
((or (and (eq (org-element-type context) 'table)
|
(>= (point) (org-element-property :contents-begin context))
|
(< (point) (org-element-property :contents-end context)))
|
(org-element-lineage context '(table-row table-cell) t))
|
(if (or (looking-at-p "[ \t]*$")
|
(save-excursion (skip-chars-backward " \t") (bolp)))
|
(insert "\n")
|
(org-table-justify-field-maybe)
|
(call-interactively #'org-table-next-row)))
|
;; On a link or a timestamp, call `org-open-at-point' if
|
;; `org-return-follows-link' allows it. Tolerate fuzzy
|
;; locations, e.g., in a comment, as `org-open-at-point'.
|
((and org-return-follows-link
|
(or (and (eq 'link (org-element-type context))
|
;; Ensure point is not on the white spaces after
|
;; the link.
|
(let ((origin (point)))
|
(org-with-point-at (org-element-property :end context)
|
(skip-chars-backward " \t")
|
(> (point) origin))))
|
(org-in-regexp org-ts-regexp-both nil t)
|
(org-in-regexp org-tsr-regexp-both nil t)
|
(org-in-regexp org-any-link-re nil t)))
|
(call-interactively #'org-open-at-point))
|
;; Insert newline in heading, but preserve tags.
|
((and (not (bolp))
|
(save-excursion (beginning-of-line)
|
(let ((case-fold-search nil))
|
(looking-at org-complex-heading-regexp))))
|
;; At headline. Split line. However, if point is on keyword,
|
;; priority cookie or tags, do not break any of them: add
|
;; a newline after the headline instead.
|
(let ((tags-column (and (match-beginning 5)
|
(save-excursion (goto-char (match-beginning 5))
|
(current-column))))
|
(string
|
(when (and (match-end 4) (org-point-in-group (point) 4))
|
(delete-and-extract-region (point) (match-end 4)))))
|
;; Adjust tag alignment.
|
(cond
|
((not (and tags-column string)))
|
(org-auto-align-tags (org-set-tags nil t))
|
(t (org--align-tags-here tags-column))) ;preserve tags column
|
(end-of-line)
|
(org-show-entry)
|
(if indent (newline-and-indent) (newline))
|
(when string (save-excursion (insert (org-trim string))))))
|
;; In a list, make sure indenting keeps trailing text within.
|
((and indent
|
(not (eolp))
|
(org-element-lineage context '(item)))
|
(let ((trailing-data
|
(delete-and-extract-region (point) (line-end-position))))
|
(newline-and-indent)
|
(save-excursion (insert trailing-data))))
|
(t
|
;; Do not auto-fill when point is in an Org property drawer.
|
(let ((auto-fill-function (and (not (org-at-property-p))
|
auto-fill-function)))
|
(if indent
|
(newline-and-indent)
|
(newline)))))))
|
|
(defun org-return-indent ()
|
"Goto next table row or insert a newline and indent.
|
Calls `org-table-next-row' or `newline-and-indent', depending on
|
context. See the individual commands for more information."
|
(interactive)
|
(org-return t))
|
|
(defun org-ctrl-c-star ()
|
"Compute table, or change heading status of lines.
|
Calls `org-table-recalculate' or `org-toggle-heading',
|
depending on context."
|
(interactive)
|
(cond
|
((org-at-table-p)
|
(call-interactively 'org-table-recalculate))
|
(t
|
;; Convert all lines in region to list items
|
(call-interactively 'org-toggle-heading))))
|
|
(defun org-ctrl-c-minus ()
|
"Insert separator line in table or modify bullet status of line.
|
Also turns a plain line or a region of lines into list items.
|
Calls `org-table-insert-hline', `org-toggle-item', or
|
`org-cycle-list-bullet', depending on context."
|
(interactive)
|
(cond
|
((org-at-table-p)
|
(call-interactively 'org-table-insert-hline))
|
((org-region-active-p)
|
(call-interactively 'org-toggle-item))
|
((org-in-item-p)
|
(call-interactively 'org-cycle-list-bullet))
|
(t
|
(call-interactively 'org-toggle-item))))
|
|
(defun org-toggle-heading (&optional nstars)
|
"Convert headings to normal text, or items or text to headings.
|
If there is no active region, only convert the current line.
|
|
With a `\\[universal-argument]' prefix, convert the whole list at
|
point into heading.
|
|
In a region:
|
|
- If the first non blank line is a headline, remove the stars
|
from all headlines in the region.
|
|
- If it is a normal line, turn each and every normal line (i.e.,
|
not an heading or an item) in the region into headings. If you
|
want to convert only the first line of this region, use one
|
universal prefix argument.
|
|
- If it is a plain list item, turn all plain list items into headings.
|
|
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 numeric prefix argument is given, its value determines the
|
number of stars to add."
|
(interactive "P")
|
(let ((skip-blanks
|
(function
|
;; Return beginning of first non-blank line, starting from
|
;; line at POS.
|
(lambda (pos)
|
(save-excursion
|
(goto-char pos)
|
(while (org-at-comment-p) (forward-line))
|
(skip-chars-forward " \r\t\n")
|
(point-at-bol)))))
|
beg end toggled)
|
;; Determine boundaries of changes. If a universal prefix has
|
;; been given, put the list in a region. If region ends at a bol,
|
;; do not consider the last line to be in the region.
|
|
(when (and current-prefix-arg (org-at-item-p))
|
(when (listp current-prefix-arg) (setq current-prefix-arg 1))
|
(org-mark-element))
|
|
(if (org-region-active-p)
|
(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 "")
|
(setq toggled t))
|
(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)
|
(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-to-lisp t)) "\n")))
|
(setq toggled t))
|
(forward-line)))
|
;; Case 3. Started at normal text: make every line an heading,
|
;; skipping headlines and items.
|
(t (let* ((stars
|
(make-string
|
(if (numberp nstars) nstars (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 " "))
|
(lend (when (listp nstars) (save-excursion (end-of-line) (point)))))
|
(while (< (point) (if (equal nstars '(4)) lend end))
|
(when (and (not (or (org-at-heading-p) (org-at-item-p) (org-at-comment-p)))
|
(looking-at "\\([ \t]*\\)\\(\\S-\\)"))
|
(replace-match (concat rpl (match-string 2))) (setq toggled t))
|
(forward-line)))))))
|
(unless toggled (message "Cannot toggle heading from here"))))
|
|
(defun org-meta-return (&optional arg)
|
"Insert a new heading or wrap a region in a table.
|
Calls `org-insert-heading', `org-insert-item' or
|
`org-table-wrap-region', depending on context. When called with
|
an argument, unconditionally call `org-insert-heading'."
|
(interactive "P")
|
(org-check-before-invisible-edit 'insert)
|
(or (run-hook-with-args-until-success 'org-metareturn-hook)
|
(call-interactively (cond (arg #'org-insert-heading)
|
((org-at-table-p) #'org-table-wrap-region)
|
((org-in-item-p) #'org-insert-item)
|
(t #'org-insert-heading)))))
|
|
;;; Menu entries
|
|
(defsubst org-in-subtree-not-table-p ()
|
"Are we in a subtree and not in a table?"
|
(and (not (org-before-first-heading-p))
|
(not (org-at-table-p))))
|
|
;; Define the Org mode menus
|
(easy-menu-define org-tbl-menu org-mode-map "Tbl menu"
|
'("Tbl"
|
["Align" org-ctrl-c-ctrl-c :active (org-at-table-p)]
|
["Next Field" org-cycle (org-at-table-p)]
|
["Previous Field" org-shifttab (org-at-table-p)]
|
["Next Row" org-return (org-at-table-p)]
|
"--"
|
["Blank Field" org-table-blank-field (org-at-table-p)]
|
["Edit Field" org-table-edit-field (org-at-table-p)]
|
["Copy Field from Above" org-table-copy-down (org-at-table-p)]
|
"--"
|
("Column"
|
["Move Column Left" org-metaleft (org-at-table-p)]
|
["Move Column Right" org-metaright (org-at-table-p)]
|
["Delete Column" org-shiftmetaleft (org-at-table-p)]
|
["Insert Column" org-shiftmetaright (org-at-table-p)])
|
("Row"
|
["Move Row Up" org-metaup (org-at-table-p)]
|
["Move Row Down" org-metadown (org-at-table-p)]
|
["Delete Row" org-shiftmetaup (org-at-table-p)]
|
["Insert Row" org-shiftmetadown (org-at-table-p)]
|
["Sort lines in region" org-table-sort-lines (org-at-table-p)]
|
"--"
|
["Insert Hline" org-ctrl-c-minus (org-at-table-p)])
|
("Rectangle"
|
["Copy Rectangle" org-copy-special (org-at-table-p)]
|
["Cut Rectangle" org-cut-special (org-at-table-p)]
|
["Paste Rectangle" org-paste-special (org-at-table-p)]
|
["Fill Rectangle" org-table-wrap-region (org-at-table-p)])
|
"--"
|
("Calculate"
|
["Set Column Formula" org-table-eval-formula (org-at-table-p)]
|
["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
|
["Edit Formulas" org-edit-special (org-at-table-p)]
|
"--"
|
["Recalculate line" org-table-recalculate (org-at-table-p)]
|
["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"]
|
["Iterate all" (lambda () (interactive) (org-table-recalculate '(16))) :active (org-at-table-p) :keys "C-u C-u C-c *"]
|
"--"
|
["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)]
|
"--"
|
["Sum Column/Rectangle" org-table-sum
|
(or (org-at-table-p) (org-region-active-p))]
|
["Which Column?" org-table-current-column (org-at-table-p)])
|
["Debug Formulas"
|
org-table-toggle-formula-debugger
|
:style toggle :selected (bound-and-true-p org-table-formula-debug)]
|
["Show Col/Row Numbers"
|
org-table-toggle-coordinate-overlays
|
:style toggle
|
:selected (bound-and-true-p org-table-overlay-coordinates)]
|
"--"
|
["Create" org-table-create (not (org-at-table-p))]
|
["Convert Region" org-table-convert-region (not (org-at-table-p 'any))]
|
["Import from File" org-table-import (not (org-at-table-p))]
|
["Export to File" org-table-export (org-at-table-p)]
|
"--"
|
["Create/Convert from/to table.el" org-table-create-with-table.el t]
|
"--"
|
("Plot"
|
["Ascii plot" orgtbl-ascii-plot :active (org-at-table-p) :keys "C-c \" a"]
|
["Gnuplot" org-plot/gnuplot :active (org-at-table-p) :keys "C-c \" g"])))
|
|
(easy-menu-define org-org-menu org-mode-map "Org menu"
|
'("Org"
|
("Show/Hide"
|
["Cycle Visibility" org-cycle :active (or (bobp) (outline-on-heading-p))]
|
["Cycle Global Visibility" org-shifttab :active (not (org-at-table-p))]
|
["Sparse Tree..." org-sparse-tree t]
|
["Reveal Context" org-reveal t]
|
["Show All" outline-show-all t]
|
"--"
|
["Subtree to indirect buffer" org-tree-to-indirect-buffer t])
|
"--"
|
["New Heading" org-insert-heading t]
|
("Navigate Headings"
|
["Up" outline-up-heading t]
|
["Next" outline-next-visible-heading t]
|
["Previous" outline-previous-visible-heading t]
|
["Next Same Level" outline-forward-same-level t]
|
["Previous Same Level" outline-backward-same-level t]
|
"--"
|
["Jump" org-goto t])
|
("Edit Structure"
|
["Refile Subtree" org-refile (org-in-subtree-not-table-p)]
|
"--"
|
["Move Subtree Up" org-metaup (org-at-heading-p)]
|
["Move Subtree Down" org-metadown (org-at-heading-p)]
|
"--"
|
["Copy Subtree" org-copy-special (org-in-subtree-not-table-p)]
|
["Cut Subtree" org-cut-special (org-in-subtree-not-table-p)]
|
["Paste Subtree" org-paste-special (not (org-at-table-p))]
|
"--"
|
["Clone subtree, shift time" org-clone-subtree-with-time-shift t]
|
"--"
|
["Copy visible text" org-copy-visible t]
|
"--"
|
["Promote Heading" org-metaleft (org-in-subtree-not-table-p)]
|
["Promote Subtree" org-shiftmetaleft (org-in-subtree-not-table-p)]
|
["Demote Heading" org-metaright (org-in-subtree-not-table-p)]
|
["Demote Subtree" org-shiftmetaright (org-in-subtree-not-table-p)]
|
"--"
|
["Sort Region/Children" org-sort t]
|
"--"
|
["Convert to odd levels" org-convert-to-odd-levels t]
|
["Convert to odd/even levels" org-convert-to-oddeven-levels t])
|
("Editing"
|
["Emphasis..." org-emphasize t]
|
["Edit Source Example" org-edit-special t]
|
"--"
|
["Footnote new/jump" org-footnote-action t]
|
["Footnote extra" (org-footnote-action t) :active t :keys "C-u C-c C-x f"])
|
("Archive"
|
["Archive (default method)" org-archive-subtree-default (org-in-subtree-not-table-p)]
|
"--"
|
["Move Subtree to Archive file" org-archive-subtree (org-in-subtree-not-table-p)]
|
["Toggle ARCHIVE tag" org-toggle-archive-tag (org-in-subtree-not-table-p)]
|
["Move subtree to Archive sibling" org-archive-to-archive-sibling (org-in-subtree-not-table-p)]
|
)
|
"--"
|
("Hyperlinks"
|
["Store Link (Global)" org-store-link t]
|
["Find existing link to here" org-occur-link-in-agenda-files t]
|
["Insert Link" org-insert-link t]
|
["Follow Link" org-open-at-point t]
|
"--"
|
["Next link" org-next-link t]
|
["Previous link" org-previous-link t]
|
"--"
|
["Descriptive Links"
|
org-toggle-link-display
|
:style radio
|
:selected org-descriptive-links
|
]
|
["Literal Links"
|
org-toggle-link-display
|
:style radio
|
:selected (not org-descriptive-links)])
|
"--"
|
("TODO Lists"
|
["TODO/DONE/-" org-todo t]
|
("Select keyword"
|
["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-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 "\\[org-agenda] t"]
|
"--"
|
["Enforce dependencies" (customize-variable 'org-enforce-todo-dependencies)
|
:selected org-enforce-todo-dependencies :style toggle :active t]
|
"Settings for tree at point"
|
["Do Children sequentially" org-toggle-ordered-property :style radio
|
: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 (not (org-entry-get nil "ORDERED"))
|
:active org-enforce-todo-dependencies :keys "C-c C-x o"]
|
"--"
|
["Set Priority" org-priority t]
|
["Priority Up" org-shiftup t]
|
["Priority Down" org-shiftdown t]
|
"--"
|
["Get news from all feeds" org-feed-update-all t]
|
["Go to the inbox of a feed..." org-feed-goto-inbox t]
|
["Customize feeds" (customize-variable 'org-feed-alist) t])
|
("TAGS and Properties"
|
["Set Tags" org-set-tags-command (not (org-before-first-heading-p))]
|
["Change tag in region" org-change-tag-in-region (org-region-active-p)]
|
"--"
|
["Set property" org-set-property (not (org-before-first-heading-p))]
|
["Column view of properties" org-columns t]
|
["Insert Column View DBlock" org-columns-insert-dblock t])
|
("Dates and Scheduling"
|
["Timestamp" org-time-stamp (not (org-before-first-heading-p))]
|
["Timestamp (inactive)" org-time-stamp-inactive (not (org-before-first-heading-p))]
|
("Change Date"
|
["1 Day Later" org-shiftright (org-at-timestamp-p 'lax)]
|
["1 Day Earlier" org-shiftleft (org-at-timestamp-p 'lax)]
|
["1 ... Later" org-shiftup (org-at-timestamp-p 'lax)]
|
["1 ... Earlier" org-shiftdown (org-at-timestamp-p 'lax)])
|
["Compute Time Range" org-evaluate-time-range t]
|
["Schedule Item" org-schedule (not (org-before-first-heading-p))]
|
["Deadline" org-deadline (not (org-before-first-heading-p))]
|
"--"
|
["Custom time format" org-toggle-time-stamp-overlays
|
:style radio :selected org-display-custom-times]
|
"--"
|
["Goto Calendar" org-goto-calendar t]
|
["Date from Calendar" org-date-from-calendar t]
|
"--"
|
["Start/Restart Timer" org-timer-start t]
|
["Pause/Continue Timer" org-timer-pause-or-continue t]
|
["Stop Timer" org-timer-pause-or-continue :active t :keys "C-u C-c C-x ,"]
|
["Insert Timer String" org-timer t]
|
["Insert Timer Item" org-timer-item t])
|
("Logging work"
|
["Clock in" org-clock-in :active t :keys "C-c C-x C-i"]
|
["Switch task" (lambda () (interactive) (org-clock-in '(4))) :active t :keys "C-u C-c C-x C-i"]
|
["Clock out" org-clock-out t]
|
["Clock cancel" org-clock-cancel t]
|
"--"
|
["Mark as default task" org-clock-mark-default-task t]
|
["Clock in, mark as default" (lambda () (interactive) (org-clock-in '(16))) :active t :keys "C-u C-u C-c C-x C-i"]
|
["Goto running clock" org-clock-goto t]
|
"--"
|
["Display times" org-clock-display t]
|
["Create clock table" org-clock-report t]
|
"--"
|
["Record DONE time"
|
(progn (setq org-log-done (not org-log-done))
|
(message "Switching to %s will %s record a timestamp"
|
(car org-done-keywords)
|
(if org-log-done "automatically" "not")))
|
:style toggle :selected org-log-done])
|
"--"
|
["Agenda Command..." org-agenda t]
|
["Set Restriction Lock" org-agenda-set-restriction-lock t]
|
("File List for Agenda")
|
("Special views current file"
|
["TODO Tree" org-show-todo-tree t]
|
["Check Deadlines" org-check-deadlines t]
|
["Tags/Property tree" org-match-sparse-tree t])
|
"--"
|
["Export/Publish..." org-export-dispatch t]
|
("LaTeX"
|
["Org CDLaTeX mode" org-cdlatex-mode :active (require 'cdlatex nil t)
|
:style toggle :selected org-cdlatex-mode]
|
["Insert Environment" cdlatex-environment (fboundp 'cdlatex-environment)]
|
["Insert math symbol" cdlatex-math-symbol (fboundp 'cdlatex-math-symbol)]
|
["Modify math symbol" org-cdlatex-math-modify
|
(org-inside-LaTeX-fragment-p)]
|
["Insert citation" org-reftex-citation t])
|
"--"
|
("MobileOrg"
|
["Push Files and Views" org-mobile-push t]
|
["Get Captured and Flagged" org-mobile-pull t]
|
["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "\\[org-agenda] ?"]
|
"--"
|
["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t])
|
"--"
|
("Documentation"
|
["Show Version" org-version t]
|
["Info Documentation" org-info t])
|
("Customize"
|
["Browse Org Group" org-customize t]
|
"--"
|
["Expand This Menu" org-create-customize-menu
|
(fboundp 'customize-menu-create)])
|
["Send bug report" org-submit-bug-report t]
|
"--"
|
("Refresh/Reload"
|
["Refresh setup current buffer" org-mode-restart t]
|
["Reload Org (after update)" org-reload t]
|
["Reload Org uncompiled" (org-reload t) :active t :keys "C-u C-c C-x !"])
|
))
|
|
(defun org-info (&optional node)
|
"Read documentation for Org in the info system.
|
With optional NODE, go directly to that node."
|
(interactive)
|
(info (format "(org)%s" (or node ""))))
|
|
;;;###autoload
|
(defun org-submit-bug-report ()
|
"Submit a bug report on Org via mail.
|
|
Don't hesitate to report any problems or inaccurate documentation.
|
|
If you don't have setup sending mail from (X)Emacs, please copy the
|
output buffer into your mail program, as it gives us important
|
information about your Org version and configuration."
|
(interactive)
|
(require 'reporter)
|
(defvar reporter-prompt-for-summary-p)
|
(org-load-modules-maybe)
|
(org-require-autoloaded-modules)
|
(let ((reporter-prompt-for-summary-p "Bug report subject: "))
|
(reporter-submit-bug-report
|
"emacs-orgmode@gnu.org"
|
(org-version nil 'full)
|
(let (list)
|
(save-window-excursion
|
(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 mailing list.
|
|
We would like to add your full Org and Outline configuration to the
|
bug report. This greatly simplifies the work of the maintainer and
|
other experts on the mailing list.
|
|
HOWEVER, some variables you have customized may contain private
|
information. The names of customers, colleagues, or friends, might
|
appear in the form of file names, tags, todo states, or search strings.
|
If you answer yes to the prompt, you might want to check and remove
|
such private information before sending the email.")
|
(add-text-properties (point-min) (point-max) '(face org-warning))
|
(when (yes-or-no-p "Include your Org configuration ")
|
(mapatoms
|
(lambda (v)
|
(and (boundp v)
|
(string-match "\\`\\(org-\\|outline-\\)" (symbol-name v))
|
(or (and (symbol-value v)
|
(string-match "\\(-hook\\|-function\\)\\'" (symbol-name v)))
|
(and
|
(get v 'custom-type) (get v 'standard-value)
|
(not (equal (symbol-value v) (eval (car (get v 'standard-value)))))))
|
(push v list)))))
|
(kill-buffer (get-buffer "*Warn about privacy*"))
|
list))
|
nil nil
|
"Remember to cover the basics, that is, what you expected to happen and
|
what in fact did happen. You don't know how to make a good report? See
|
|
https://orgmode.org/manual/Feedback.html#Feedback
|
|
Your bug report will be posted to the Org mailing list.
|
------------------------------------------------------------------------")
|
(save-excursion
|
(when (re-search-backward "^\\(Subject: \\)Org mode version \\(.*?\\);[ \t]*\\(.*\\)" nil t)
|
(replace-match "\\1Bug: \\3 [\\2]")))))
|
|
|
(defun org-install-agenda-files-menu ()
|
(let ((bl (buffer-list)))
|
(save-excursion
|
(while bl
|
(set-buffer (pop bl))
|
(when (derived-mode-p 'org-mode) (setq bl nil)))
|
(when (derived-mode-p 'org-mode)
|
(easy-menu-change
|
'("Org") "File List for Agenda"
|
(append
|
(list
|
["Edit File List" (org-edit-agenda-file-list) t]
|
["Add/Move Current File to Front of List" org-agenda-file-to-front t]
|
["Remove Current File from List" org-remove-file t]
|
["Cycle through agenda files" org-cycle-agenda-files t]
|
["Occur in all agenda files" org-occur-in-agenda-files t]
|
"--")
|
(mapcar 'org-file-menu-entry
|
;; Prevent initialization from failing.
|
(ignore-errors (org-agenda-files t)))))))))
|
|
;;;; Documentation
|
|
(defun org-require-autoloaded-modules ()
|
(interactive)
|
(mapc #'require
|
'(org-agenda org-archive org-attach org-clock org-colview org-id
|
org-table org-timer)))
|
|
;;;###autoload
|
(defun org-reload (&optional uncompiled)
|
"Reload all Org Lisp files.
|
With prefix arg UNCOMPILED, load the uncompiled versions."
|
(interactive "P")
|
(require 'loadhist)
|
(let* ((org-dir (org-find-library-dir "org"))
|
(contrib-dir (or (org-find-library-dir "org-contribdir") org-dir))
|
(feature-re "^\\(org\\|ob\\|ox\\)\\(-.*\\)?")
|
(remove-re (format "\\`%s\\'"
|
(regexp-opt '("org" "org-loaddefs" "org-version"))))
|
(feats (delete-dups
|
(mapcar 'file-name-sans-extension
|
(mapcar 'file-name-nondirectory
|
(delq nil
|
(mapcar 'feature-file
|
features))))))
|
(lfeat (append
|
(sort
|
(setq feats
|
(delq nil (mapcar
|
(lambda (f)
|
(if (and (string-match feature-re f)
|
(not (string-match remove-re f)))
|
f nil))
|
feats)))
|
'string-lessp)
|
(list "org-version" "org")))
|
(load-suffixes (when (boundp 'load-suffixes) load-suffixes))
|
(load-suffixes (if uncompiled (reverse load-suffixes) load-suffixes))
|
load-uncore load-misses)
|
(setq load-misses
|
(delq 't
|
(mapcar (lambda (f)
|
(or (org-load-noerror-mustsuffix (concat org-dir f))
|
(and (string= org-dir contrib-dir)
|
(org-load-noerror-mustsuffix (concat contrib-dir f)))
|
(and (org-load-noerror-mustsuffix (concat (org-find-library-dir f) f))
|
(add-to-list 'load-uncore f 'append)
|
't)
|
f))
|
lfeat)))
|
(when load-uncore
|
(message "The following feature%s found in load-path, please check if that's correct:\n%s"
|
(if (> (length load-uncore) 1) "s were" " was") load-uncore))
|
(if load-misses
|
(message "Some error occurred while reloading Org feature%s\n%s\nPlease check *Messages*!\n%s"
|
(if (> (length load-misses) 1) "s" "") load-misses (org-version nil 'full))
|
(message "Successfully reloaded Org\n%s" (org-version nil 'full)))))
|
|
;;;###autoload
|
(defun org-customize ()
|
"Call the customize function with org as argument."
|
(interactive)
|
(org-load-modules-maybe)
|
(org-require-autoloaded-modules)
|
(customize-browse 'org))
|
|
(defun org-create-customize-menu ()
|
"Create a full customization menu for Org mode, insert it into the menu."
|
(interactive)
|
(org-load-modules-maybe)
|
(org-require-autoloaded-modules)
|
(if (fboundp 'customize-menu-create)
|
(progn
|
(easy-menu-change
|
'("Org") "Customize"
|
`(["Browse Org group" org-customize t]
|
"--"
|
,(customize-menu-create 'org)
|
["Set" Custom-set t]
|
["Save" Custom-save t]
|
["Reset to Current" Custom-reset-current t]
|
["Reset to Saved" Custom-reset-saved t]
|
["Reset to Standard Settings" Custom-reset-standard t]))
|
(message "\"Org\"-menu now contains full customization menu"))
|
(error "Cannot expand menu (outdated version of cus-edit.el)")))
|
|
;;;; Miscellaneous stuff
|
|
;;; Generally useful functions
|
|
(defun org-get-at-eol (property n)
|
"Get text property PROPERTY at the end of line less N characters."
|
(get-text-property (- (point-at-eol) n) property))
|
|
(defun org-find-text-property-in-string (prop s)
|
"Return the first non-nil value of property PROP in string S."
|
(or (get-text-property 0 prop s)
|
(get-text-property (or (next-single-property-change 0 prop s) 0)
|
prop s)))
|
|
(defun org-display-warning (message)
|
"Display the given MESSAGE as a warning."
|
(display-warning 'org message :warning))
|
|
(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-verbatim-emphasis ()
|
(save-match-data
|
(and (org-in-regexp org-verbatim-re 2)
|
(>= (point) (match-beginning 3))
|
(<= (point) (match-end 4)))))
|
|
(defun org-overlay-display (ovl text &optional face evap)
|
"Make overlay OVL display TEXT with face FACE."
|
(overlay-put ovl 'display text)
|
(if face (overlay-put ovl 'face face))
|
(if evap (overlay-put ovl 'evaporate t)))
|
|
(defun org-overlay-before-string (ovl text &optional face evap)
|
"Make overlay OVL display TEXT with face FACE."
|
(if face (org-add-props text nil 'face face))
|
(overlay-put ovl 'before-string text)
|
(if evap (overlay-put ovl 'evaporate t)))
|
|
(defun org-find-overlays (prop &optional pos delete)
|
"Find all overlays specifying PROP at POS or point.
|
If DELETE is non-nil, delete all those overlays."
|
(let (found)
|
(dolist (ov (overlays-at (or pos (point))) found)
|
(cond ((not (overlay-get ov prop)))
|
(delete (delete-overlay ov))
|
(t (push ov found))))))
|
|
(defun org-goto-marker-or-bmk (marker &optional bookmark)
|
"Go to MARKER, widen if necessary. When marker is not live, try BOOKMARK."
|
(if (and marker (marker-buffer marker)
|
(buffer-live-p (marker-buffer marker)))
|
(progn
|
(pop-to-buffer-same-window (marker-buffer marker))
|
(when (or (> marker (point-max)) (< marker (point-min)))
|
(widen))
|
(goto-char marker)
|
(org-show-context 'org-goto))
|
(if bookmark
|
(bookmark-jump bookmark)
|
(error "Cannot find location"))))
|
|
(defun org-quote-csv-field (s)
|
"Quote field for inclusion in CSV material."
|
(if (string-match "[\",]" s)
|
(concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")
|
s))
|
|
(defun org-force-self-insert (N)
|
"Needed to enforce self-insert under remapping."
|
(interactive "p")
|
(self-insert-command N))
|
|
(defun org-shorten-string (s maxlength)
|
"Shorten string S so that it is no longer than MAXLENGTH characters.
|
If the string is shorter or has length MAXLENGTH, just return the
|
original string. If it is longer, the functions finds a space in the
|
string, breaks this string off at that locations and adds three dots
|
as ellipsis. Including the ellipsis, the string will not be longer
|
than MAXLENGTH. If finding a good breaking point in the string does
|
not work, the string is just chopped off in the middle of a word
|
if necessary."
|
(if (<= (length s) maxlength)
|
s
|
(let* ((n (max (- maxlength 4) 1))
|
(re (concat "\\`\\(.\\{1," (int-to-string n) "\\}[^ ]\\)\\([ ]\\|\\'\\)")))
|
(if (string-match re s)
|
(concat (match-string 1 s) "...")
|
(concat (substring s 0 (max (- maxlength 3) 0)) "...")))))
|
|
(defun org-get-indentation (&optional line)
|
"Get the indentation of the current line, interpreting tabs.
|
When LINE is given, assume it represents a line and compute its indentation."
|
(if line
|
(when (string-match "^ *" (org-remove-tabs line))
|
(match-end 0))
|
(save-excursion
|
(beginning-of-line 1)
|
(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."
|
(setq width (or width tab-width))
|
(while (string-match "\t" s)
|
(setq s (replace-match
|
(make-string
|
(- (* width (/ (+ (match-beginning 0) width) width))
|
(match-beginning 0)) ?\ )
|
t t s)))
|
s)
|
|
(defun org-fix-indentation (line ind)
|
"Fix indentation in LINE.
|
IND is a cons cell with target and minimum indentation.
|
If the current indentation in LINE is smaller than the minimum,
|
leave it alone. If it is larger than ind, set it to the target."
|
(let* ((l (org-remove-tabs line))
|
(i (org-get-indentation l))
|
(i1 (car ind)) (i2 (cdr ind)))
|
(when (>= i i2) (setq l (substring line i2)))
|
(if (> i1 0)
|
(concat (make-string i1 ?\ ) l)
|
l)))
|
|
(defun org-remove-indentation (code &optional n)
|
"Remove maximum common indentation in string CODE and return it.
|
N may optionally be the number of columns to remove. Return CODE
|
as-is if removal failed."
|
(with-temp-buffer
|
(insert code)
|
(if (org-do-remove-indentation n) (buffer-string) code)))
|
|
(defun org-do-remove-indentation (&optional n)
|
"Remove the maximum common indentation from the buffer.
|
When optional argument N is a positive integer, remove exactly
|
that much characters from indentation, if possible. Return nil
|
if it fails."
|
(catch :exit
|
(goto-char (point-min))
|
;; Find maximum common indentation, if not specified.
|
(let ((n (or n
|
(let ((min-ind (point-max)))
|
(save-excursion
|
(while (re-search-forward "^[ \t]*\\S-" nil t)
|
(let ((ind (1- (current-column))))
|
(if (zerop ind) (throw :exit nil)
|
(setq min-ind (min min-ind ind))))))
|
min-ind))))
|
(if (zerop n) (throw :exit nil)
|
;; Remove exactly N indentation, but give up if not possible.
|
(while (not (eobp))
|
(let ((ind (progn (skip-chars-forward " \t") (current-column))))
|
(cond ((eolp) (delete-region (line-beginning-position) (point)))
|
((< ind n) (throw :exit nil))
|
(t (indent-line-to (- ind n))))
|
(forward-line)))
|
;; Signal success.
|
t))))
|
|
(defun org-fill-template (template alist)
|
"Find each %key of ALIST in TEMPLATE and replace it."
|
(let ((case-fold-search nil))
|
(dolist (entry (sort (copy-sequence alist)
|
(lambda (a b) (< (length (car a)) (length (car b))))))
|
(setq template
|
(replace-regexp-in-string
|
(concat "%" (regexp-quote (car entry)))
|
(or (cdr entry) "") template t t)))
|
template))
|
|
(defun org-base-buffer (buffer)
|
"Return the base buffer of BUFFER, if it has one. Else return the buffer."
|
(if (not buffer)
|
buffer
|
(or (buffer-base-buffer buffer)
|
buffer)))
|
|
(defun org-wrap (string &optional width lines)
|
"Wrap string to either a number of lines, or a width in characters.
|
If WIDTH is non-nil, the string is wrapped to that width, however many lines
|
that costs. If there is a word longer than WIDTH, the text is actually
|
wrapped to the length of that word.
|
IF WIDTH is nil and LINES is non-nil, the string is forced into at most that
|
many lines, whatever width that takes.
|
The return value is a list of lines, without newlines at the end."
|
(let* ((words (split-string string))
|
(maxword (apply 'max (mapcar 'org-string-width words)))
|
w ll)
|
(cond (width
|
(org-do-wrap words (max maxword width)))
|
(lines
|
(setq w maxword)
|
(setq ll (org-do-wrap words maxword))
|
(if (<= (length ll) lines)
|
ll
|
(setq ll words)
|
(while (> (length ll) lines)
|
(setq w (1+ w))
|
(setq ll (org-do-wrap words w)))
|
ll))
|
(t (error "Cannot wrap this")))))
|
|
(defun org-do-wrap (words width)
|
"Create lines of maximum width WIDTH (in characters) from word list WORDS."
|
(let (lines line)
|
(while words
|
(setq line (pop words))
|
(while (and words (< (+ (length line) (length (car words))) width))
|
(setq line (concat line " " (pop words))))
|
(setq lines (push line lines)))
|
(nreverse lines)))
|
|
(defun org-quote-vert (s)
|
"Replace \"|\" with \"\\vert\"."
|
(while (string-match "|" s)
|
(setq s (replace-match "\\vert" t t s)))
|
s)
|
|
(defun org-uuidgen-p (s)
|
"Is S an ID created by UUIDGEN?"
|
(string-match "\\`[0-9a-f]\\{8\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{12\\}\\'" (downcase s)))
|
|
(defun org-in-src-block-p (&optional inside)
|
"Whether point is in a code source block.
|
When INSIDE is non-nil, don't consider we are within a src block
|
when point is at #+BEGIN_SRC or #+END_SRC."
|
(let ((case-fold-search t))
|
(or (and (eq (get-char-property (point) 'src-block) t))
|
(and (not inside)
|
(save-match-data
|
(save-excursion
|
(beginning-of-line)
|
(looking-at ".*#\\+\\(begin\\|end\\)_src")))))))
|
|
(defun org-context ()
|
"Return a list of contexts of the current cursor position.
|
If several contexts apply, all are returned.
|
Each context entry is a list with a symbol naming the context, and
|
two positions indicating start and end of the context. Possible
|
contexts are:
|
|
:headline anywhere in a headline
|
:headline-stars on the leading stars in a headline
|
:todo-keyword on a TODO keyword (including DONE) in a headline
|
:tags on the TAGS in a headline
|
:priority on the priority cookie in a headline
|
:item on the first line of a plain list item
|
:item-bullet on the bullet/number of a plain list item
|
:checkbox on the checkbox in a plain list item
|
:table in an Org table
|
:table-special on a special filed in a table
|
:table-table in a table.el table
|
:clocktable in a clocktable
|
:src-block in a source block
|
:link on a hyperlink
|
:keyword on a keyword: SCHEDULED, DEADLINE, CLOSE, COMMENT.
|
:target on a <<target>>
|
:radio-target on a <<<radio-target>>>
|
:latex-fragment on a LaTeX fragment
|
: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,
|
and :keyword."
|
(let* ((f (get-text-property (point) 'face))
|
(faces (if (listp f) f (list f)))
|
(case-fold-search t)
|
(p (point)) clist o)
|
;; First the large context
|
(cond
|
((org-at-heading-p t)
|
(push (list :headline (point-at-bol) (point-at-eol)) clist)
|
(when (progn
|
(beginning-of-line 1)
|
(looking-at org-todo-line-tags-regexp))
|
(push (org-point-in-group p 1 :headline-stars) clist)
|
(push (org-point-in-group p 2 :todo-keyword) clist)
|
(push (org-point-in-group p 4 :tags) clist))
|
(goto-char p)
|
(skip-chars-backward "^[\n\r \t") (or (bobp) (backward-char 1))
|
(when (looking-at "\\[#[A-Z0-9]\\]")
|
(push (org-point-in-group p 0 :priority) clist)))
|
|
((org-at-item-p)
|
(push (org-point-in-group p 2 :item-bullet) clist)
|
(push (list :item (point-at-bol)
|
(save-excursion (org-end-of-item) (point)))
|
clist)
|
(and (org-at-item-checkbox-p)
|
(push (org-point-in-group p 0 :checkbox) clist)))
|
|
((org-at-table-p)
|
(push (list :table (org-table-begin) (org-table-end)) clist)
|
(when (memq 'org-formula faces)
|
(push (list :table-special
|
(previous-single-property-change p 'face)
|
(next-single-property-change p 'face)) clist)))
|
((org-at-table-p 'any)
|
(push (list :table-table) clist)))
|
(goto-char p)
|
|
(let ((case-fold-search t))
|
;; New the "medium" contexts: clocktables, source blocks
|
(cond ((org-in-clocktable-p)
|
(push (list :clocktable
|
(and (or (looking-at "[ \t]*\\(#\\+BEGIN: clocktable\\)")
|
(re-search-backward "[ \t]*\\(#+BEGIN: clocktable\\)" nil t))
|
(match-beginning 1))
|
(and (re-search-forward "[ \t]*#\\+END:?" nil t)
|
(match-end 0))) clist))
|
((org-in-src-block-p)
|
(push (list :src-block
|
(and (or (looking-at "[ \t]*\\(#\\+BEGIN_SRC\\)")
|
(re-search-backward "[ \t]*\\(#+BEGIN_SRC\\)" nil t))
|
(match-beginning 1))
|
(and (search-forward "#+END_SRC" nil t)
|
(match-beginning 0))) clist))))
|
(goto-char p)
|
|
;; Now the small context
|
(cond
|
((org-at-timestamp-p)
|
(push (org-point-in-group p 0 :timestamp) clist))
|
((memq 'org-link faces)
|
(push (list :link
|
(previous-single-property-change p 'face)
|
(next-single-property-change p 'face)) clist))
|
((memq 'org-special-keyword faces)
|
(push (list :keyword
|
(previous-single-property-change p 'face)
|
(next-single-property-change p 'face)) clist))
|
((org-at-target-p)
|
(push (org-point-in-group p 0 :target) clist)
|
(goto-char (1- (match-beginning 0)))
|
(when (looking-at org-radio-target-regexp)
|
(push (org-point-in-group p 0 :radio-target) clist))
|
(goto-char p))
|
((setq o (cl-some
|
(lambda (o)
|
(and (eq (overlay-get o 'org-overlay-type) 'org-latex-overlay)
|
o))
|
(overlays-at (point))))
|
(push (list :latex-fragment
|
(overlay-start o) (overlay-end o)) clist)
|
(push (list :latex-preview
|
(overlay-start o) (overlay-end o)) clist))
|
((org-inside-LaTeX-fragment-p)
|
;; FIXME: positions wrong.
|
(push (list :latex-fragment (point) (point)) clist)))
|
|
(setq clist (nreverse (delq nil clist)))
|
clist))
|
|
(defun org-in-regexp (regexp &optional nlines visually)
|
"Check if point is inside a match of REGEXP.
|
|
Normally only the current line is checked, but you can include
|
NLINES extra lines around point into the search. If VISUALLY is
|
set, require that the cursor is not after the match but really
|
on, so that the block visually is on the match.
|
|
Return nil or a cons cell (BEG . END) where BEG and END are,
|
respectively, the positions at the beginning and the end of the
|
match."
|
(catch :exit
|
(let ((pos (point))
|
(eol (line-end-position (if nlines (1+ nlines) 1))))
|
(save-excursion
|
(beginning-of-line (- 1 (or nlines 0)))
|
(while (and (re-search-forward regexp eol t)
|
(<= (match-beginning 0) pos))
|
(let ((end (match-end 0)))
|
(when (or (> end pos) (and (= end pos) (not visually)))
|
(throw :exit (cons (match-beginning 0) (match-end 0))))))))))
|
|
(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.
|
|
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-in-regexp 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))))
|
(dolist (name names)
|
(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)))))
|
nil)))
|
|
(defun org-occur-in-agenda-files (regexp &optional _nlines)
|
"Call `multi-occur' with buffers for all agenda files."
|
(interactive "sOrg-files matching: ")
|
(let* ((files (org-agenda-files))
|
(tnames (mapcar #'file-truename files))
|
(extra org-agenda-text-search-extra-files))
|
(when (eq (car extra) 'agenda-archives)
|
(setq extra (cdr extra))
|
(setq files (org-add-archive-files files)))
|
(dolist (f extra)
|
(unless (member (file-truename f) tnames)
|
(unless (member f files) (setq files (append files (list f))))
|
(setq tnames (append tnames (list (file-truename f))))))
|
(multi-occur
|
(mapcar (lambda (x)
|
(with-current-buffer
|
;; FIXME: Why not just (find-file-noselect x)?
|
;; Is it to avoid the "revert buffer" prompt?
|
(or (get-file-buffer x) (find-file-noselect x))
|
(widen)
|
(current-buffer)))
|
files)
|
regexp)))
|
|
(add-hook 'occur-mode-find-occurrence-hook
|
(lambda () (when (derived-mode-p 'org-mode) (org-reveal))))
|
|
(defun org-occur-link-in-agenda-files ()
|
"Create a link and search for it in the agendas.
|
The link is not stored in `org-stored-links', it is just created
|
for the search purpose."
|
(interactive)
|
(let ((link (condition-case nil
|
(org-store-link nil)
|
(error "Unable to create a link to here"))))
|
(org-occur-in-agenda-files (regexp-quote link))))
|
|
(defun org-reverse-string (string)
|
"Return the reverse of STRING."
|
(apply 'string (reverse (string-to-list string))))
|
|
;; defsubst org-uniquify must be defined before first use
|
|
(defun org-uniquify-alist (alist)
|
"Merge elements of ALIST with the same key.
|
|
For example, in this alist:
|
|
\(org-uniquify-alist \\='((a 1) (b 2) (a 3)))
|
=> \\='((a 1 3) (b 2))
|
|
merge (a 1) and (a 3) into (a 1 3).
|
|
The function returns the new ALIST."
|
(let (rtn)
|
(dolist (e alist rtn)
|
(let (n)
|
(if (not (assoc (car e) rtn))
|
(push e rtn)
|
(setq n (cons (car e) (append (cdr (assoc (car e) rtn)) (cdr e))))
|
(setq rtn (assq-delete-all (car e) rtn))
|
(push n rtn))))))
|
|
(defun org-delete-all (elts list)
|
"Remove all elements in ELTS from LIST.
|
Comparison is done with `equal'. It is a destructive operation
|
that may remove elements by altering the list structure."
|
(while elts
|
(setq list (delete (pop elts) list)))
|
list)
|
|
(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)))
|
(if (cdr (assq '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)))
|
|
(defun org-skip-whitespace ()
|
(skip-chars-forward " \t\n\r"))
|
|
(defun org-point-in-group (point group &optional context)
|
"Check if POINT is in match-group GROUP.
|
If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the
|
match. If the match group does not exist or point is not inside it,
|
return nil."
|
(and (match-beginning group)
|
(>= point (match-beginning group))
|
(<= point (match-end group))
|
(if context
|
(list context (match-beginning group) (match-end group))
|
t)))
|
|
(defun org-switch-to-buffer-other-window (&rest args)
|
"Switch to buffer in a second window on the current frame.
|
In particular, do not allow pop-up frames.
|
Returns the newly created buffer."
|
(org-no-popups
|
(apply 'switch-to-buffer-other-window args)))
|
|
(defun org-combine-plists (&rest plists)
|
"Create a single property list from all plists in PLISTS.
|
The process starts by copying the first list, and then setting properties
|
from the other lists. Settings in the last list are the most significant
|
ones and overrule settings in the other lists."
|
(let ((rtn (copy-sequence (pop plists)))
|
p v ls)
|
(while plists
|
(setq ls (pop plists))
|
(while ls
|
(setq p (pop ls) v (pop ls))
|
(setq rtn (plist-put rtn p v))))
|
rtn))
|
|
(defun org-replace-escapes (string table)
|
"Replace %-escapes in STRING with values in TABLE.
|
TABLE is an association list with keys like \"%a\" and string values.
|
The sequences in STRING may contain normal field width and padding information,
|
for example \"%-5s\". Replacements happen in the sequence given by TABLE,
|
so values can contain further %-escapes if they are define later in TABLE."
|
(let ((tbl (copy-alist table))
|
(case-fold-search nil)
|
(pchg 0)
|
re rpl)
|
(dolist (e tbl)
|
(setq re (concat "%-?[0-9.]*" (substring (car e) 1)))
|
(when (and (cdr e) (string-match re (cdr e)))
|
(let ((sref (substring (cdr e) (match-beginning 0) (match-end 0)))
|
(safe "SREF"))
|
(add-text-properties 0 3 (list 'sref sref) safe)
|
(setcdr e (replace-match safe t t (cdr e)))))
|
(while (string-match re string)
|
(setq rpl (format (concat (substring (match-string 0 string) 0 -1) "s")
|
(cdr e)))
|
(setq string (replace-match rpl t t string))))
|
(while (setq pchg (next-property-change pchg string))
|
(let ((sref (get-text-property pchg 'sref string)))
|
(when (and sref (string-match "SREF" string pchg))
|
(setq string (replace-match sref t t string)))))
|
string))
|
|
(defun org-find-base-buffer-visiting (file)
|
"Like `find-buffer-visiting' but always return the base buffer and
|
not an indirect buffer."
|
(let ((buf (or (get-file-buffer file)
|
(find-buffer-visiting file))))
|
(if buf
|
(or (buffer-base-buffer buf) buf)
|
nil)))
|
|
;;; TODO: Only called once, from ox-odt which should probably use
|
;;; org-export-inline-image-p or something.
|
(defun org-file-image-p (file)
|
"Return non-nil if FILE is an image."
|
(save-match-data
|
(string-match (image-file-name-regexp) file)))
|
|
(defun org-get-cursor-date (&optional with-time)
|
"Return the date at cursor in as a time.
|
This works in the calendar and in the agenda, anywhere else it just
|
returns the current time.
|
If WITH-TIME is non-nil, returns the time of the event at point (in
|
the agenda) or the current time of the day."
|
(let (date day defd tp hod mod)
|
(when with-time
|
(setq tp (get-text-property (point) 'time))
|
(when (and tp (string-match "\\([0-9][0-9]\\):\\([0-9][0-9]\\)" tp))
|
(setq hod (string-to-number (match-string 1 tp))
|
mod (string-to-number (match-string 2 tp))))
|
(or tp (let ((now (decode-time)))
|
(setq hod (nth 2 now)
|
mod (nth 1 now)))))
|
(cond
|
((eq major-mode 'calendar-mode)
|
(setq date (calendar-cursor-to-date)
|
defd (encode-time 0 (or mod 0) (or hod 0)
|
(nth 1 date) (nth 0 date) (nth 2 date))))
|
((eq major-mode 'org-agenda-mode)
|
(setq day (get-text-property (point) 'day))
|
(when day
|
(setq date (calendar-gregorian-from-absolute day)
|
defd (encode-time 0 (or mod 0) (or hod 0)
|
(nth 1 date) (nth 0 date) (nth 2 date))))))
|
(or defd (current-time))))
|
|
(defun org-mark-subtree (&optional up)
|
"Mark the current subtree.
|
This puts point at the start of the current subtree, and mark at
|
the end. If a numeric prefix UP is given, move up into the
|
hierarchy of headlines by UP levels before marking the subtree."
|
(interactive "P")
|
(org-with-limited-levels
|
(cond ((org-at-heading-p) (beginning-of-line))
|
((org-before-first-heading-p) (user-error "Not in a subtree"))
|
(t (outline-previous-visible-heading 1))))
|
(when up (while (and (> up 0) (org-up-heading-safe)) (cl-decf up)))
|
(if (called-interactively-p 'any)
|
(call-interactively 'org-mark-element)
|
(org-mark-element)))
|
|
(defun org-file-newer-than-p (file time)
|
"Non-nil if FILE is newer than TIME.
|
FILE is a filename, as a string, TIME is a list of integers, as
|
returned by, e.g., `current-time'."
|
(and (file-exists-p file)
|
;; Only compare times up to whole seconds as some file-systems
|
;; (e.g. HFS+) do not retain any finer granularity. As
|
;; a consequence, make sure we return non-nil when the two
|
;; times are equal.
|
(not (time-less-p (cl-subseq (nth 5 (file-attributes file)) 0 2)
|
(cl-subseq time 0 2)))))
|
|
(defun org-compile-file (source process ext &optional err-msg log-buf spec)
|
"Compile a SOURCE file using PROCESS.
|
|
PROCESS is either a function or a list of shell commands, as
|
strings. EXT is a file extension, without the leading dot, as
|
a string. It is used to check if the process actually succeeded.
|
|
PROCESS must create a file with the same base name and directory
|
as SOURCE, but ending with EXT. The function then returns its
|
filename. Otherwise, it raises an error. The error message can
|
then be refined by providing string ERR-MSG, which is appended to
|
the standard message.
|
|
If PROCESS is a function, it is called with a single argument:
|
the SOURCE file.
|
|
If it is a list of commands, each of them is called using
|
`shell-command'. By default, in each command, %b, %f, %F, %o and
|
%O are replaced with, respectively, SOURCE base name, name, full
|
name, directory and absolute output file name. It is possible,
|
however, to use more place-holders by specifying them in optional
|
argument SPEC, as an alist following the pattern
|
|
(CHARACTER . REPLACEMENT-STRING).
|
|
When PROCESS is a list of commands, optional argument LOG-BUF can
|
be set to a buffer or a buffer name. `shell-command' then uses
|
it for output."
|
(let* ((base-name (file-name-base source))
|
(full-name (file-truename source))
|
(out-dir (or (file-name-directory source) "./"))
|
(output (expand-file-name (concat base-name "." ext) out-dir))
|
(time (current-time))
|
(err-msg (if (stringp err-msg) (concat ". " err-msg) "")))
|
(save-window-excursion
|
(pcase process
|
((pred functionp) (funcall process (shell-quote-argument source)))
|
((pred consp)
|
(let ((log-buf (and log-buf (get-buffer-create log-buf)))
|
(spec (append spec
|
`((?b . ,(shell-quote-argument base-name))
|
(?f . ,(shell-quote-argument source))
|
(?F . ,(shell-quote-argument full-name))
|
(?o . ,(shell-quote-argument out-dir))
|
(?O . ,(shell-quote-argument output))))))
|
(dolist (command process)
|
(shell-command (format-spec command spec) log-buf))
|
(when log-buf (with-current-buffer log-buf (compilation-mode)))))
|
(_ (error "No valid command to process %S%s" source err-msg))))
|
;; Check for process failure. Output file is expected to be
|
;; located in the same directory as SOURCE.
|
(unless (org-file-newer-than-p output time)
|
(error (format "File %S wasn't produced%s" output err-msg)))
|
output))
|
|
;;; Indentation
|
|
(defvar org-element-greater-elements)
|
(defun org--get-expected-indentation (element contentsp)
|
"Expected indentation column for current line, according to ELEMENT.
|
ELEMENT is an element containing point. CONTENTSP is non-nil
|
when indentation is to be computed according to contents of
|
ELEMENT."
|
(let ((type (org-element-type element))
|
(start (org-element-property :begin element))
|
(post-affiliated (org-element-property :post-affiliated element)))
|
(org-with-wide-buffer
|
(cond
|
(contentsp
|
(cl-case type
|
((diary-sexp footnote-definition) 0)
|
((headline inlinetask nil)
|
(if (not org-adapt-indentation) 0
|
(let ((level (org-current-level)))
|
(if level (1+ level) 0))))
|
((item plain-list) (org-list-item-body-column post-affiliated))
|
(t
|
(goto-char start)
|
(org-get-indentation))))
|
((memq type '(headline inlinetask nil))
|
(if (org-match-line "[ \t]*$")
|
(org--get-expected-indentation element t)
|
0))
|
((memq type '(diary-sexp footnote-definition)) 0)
|
;; First paragraph of a footnote definition or an item.
|
;; Indent like parent.
|
((< (line-beginning-position) start)
|
(org--get-expected-indentation
|
(org-element-property :parent element) t))
|
;; At first line: indent according to previous sibling, if any,
|
;; ignoring footnote definitions and inline tasks, or parent's
|
;; contents.
|
((= (line-beginning-position) start)
|
(catch 'exit
|
(while t
|
(if (= (point-min) start) (throw 'exit 0)
|
(goto-char (1- start))
|
(let* ((previous (org-element-at-point))
|
(parent previous))
|
(while (and parent (<= (org-element-property :end parent) start))
|
(setq previous parent
|
parent (org-element-property :parent parent)))
|
(cond
|
((not previous) (throw 'exit 0))
|
((> (org-element-property :end previous) start)
|
(throw 'exit (org--get-expected-indentation previous t)))
|
((memq (org-element-type previous)
|
'(footnote-definition inlinetask))
|
(setq start (org-element-property :begin previous)))
|
(t (goto-char (org-element-property :begin previous))
|
(throw 'exit
|
(if (bolp) (org-get-indentation)
|
;; At first paragraph in an item or
|
;; a footnote definition.
|
(org--get-expected-indentation
|
(org-element-property :parent previous) t))))))))))
|
;; Otherwise, move to the first non-blank line above.
|
(t
|
(beginning-of-line)
|
(let ((pos (point)))
|
(skip-chars-backward " \r\t\n")
|
(cond
|
;; Two blank lines end a footnote definition or a plain
|
;; list. When we indent an empty line after them, the
|
;; containing list or footnote definition is over, so it
|
;; qualifies as a previous sibling. Therefore, we indent
|
;; like its first line.
|
((and (memq type '(footnote-definition plain-list))
|
(> (count-lines (point) pos) 2))
|
(goto-char start)
|
(org-get-indentation))
|
;; Line above is the first one of a paragraph at the
|
;; beginning of an item or a footnote definition. Indent
|
;; like parent.
|
((< (line-beginning-position) start)
|
(org--get-expected-indentation
|
(org-element-property :parent element) t))
|
;; Line above is the beginning of an element, i.e., point
|
;; was originally on the blank lines between element's start
|
;; and contents.
|
((= (line-beginning-position) post-affiliated)
|
(org--get-expected-indentation element t))
|
;; POS is after contents in a greater element. Indent like
|
;; the beginning of the element.
|
((and (memq type org-element-greater-elements)
|
(let ((cend (org-element-property :contents-end element)))
|
(and cend (<= cend pos))))
|
;; As a special case, if point is at the end of a footnote
|
;; definition or an item, indent like the very last element
|
;; within. If that last element is an item, indent like
|
;; its contents.
|
(if (memq type '(footnote-definition item plain-list))
|
(let ((last (org-element-at-point)))
|
(goto-char pos)
|
(org--get-expected-indentation
|
last (eq (org-element-type last) 'item)))
|
(goto-char start)
|
(org-get-indentation)))
|
;; In any other case, indent like the current line.
|
(t (org-get-indentation)))))))))
|
|
(defun org--align-node-property ()
|
"Align node property at point.
|
Alignment is done according to `org-property-format', which see."
|
(when (save-excursion
|
(beginning-of-line)
|
(looking-at org-property-re))
|
(replace-match
|
(concat (match-string 4)
|
(org-trim
|
(format org-property-format (match-string 1) (match-string 3))))
|
t t)))
|
|
(defun org-indent-line ()
|
"Indent line depending on context.
|
|
Indentation is done according to the following rules:
|
|
- Footnote definitions, diary sexps, headlines and inline tasks
|
have to start at column 0.
|
|
- On the very first line of an element, consider, in order, the
|
next rules until one matches:
|
|
1. If there's a sibling element before, ignoring footnote
|
definitions and inline tasks, indent like its first line.
|
|
2. If element has a parent, indent like its contents. More
|
precisely, if parent is an item, indent after the
|
description part, if any, or the bullet (see
|
`org-list-description-max-indent'). Else, indent like
|
parent's first line.
|
|
3. Otherwise, indent relatively to current level, if
|
`org-adapt-indentation' is non-nil, or to left margin.
|
|
- On a blank line at the end of an element, indent according to
|
the type of the element. More precisely
|
|
1. If element is a plain list, an item, or a footnote
|
definition, indent like the very last element within.
|
|
2. If element is a paragraph, indent like its last non blank
|
line.
|
|
3. Otherwise, indent like its very first line.
|
|
- In the code part of a source block, use language major mode
|
to indent current line if `org-src-tab-acts-natively' is
|
non-nil. If it is nil, do nothing.
|
|
- Otherwise, indent like the first non-blank line above.
|
|
The function doesn't indent an item as it could break the whole
|
list structure. Instead, use \\<org-mode-map>`\\[org-shiftmetaleft]' or \
|
`\\[org-shiftmetaright]'.
|
|
Also align node properties according to `org-property-format'."
|
(interactive)
|
(cond
|
(orgstruct-is-++
|
(let ((indent-line-function
|
(cl-cadadr (assq 'indent-line-function org-fb-vars))))
|
(indent-according-to-mode)))
|
((org-at-heading-p) 'noindent)
|
(t
|
(let* ((element (save-excursion (beginning-of-line) (org-element-at-point)))
|
(type (org-element-type element)))
|
(cond ((and (memq type '(plain-list item))
|
(= (line-beginning-position)
|
(org-element-property :post-affiliated element)))
|
'noindent)
|
((and (eq type 'latex-environment)
|
(>= (point) (org-element-property :post-affiliated element))
|
(< (point) (org-with-wide-buffer
|
(goto-char (org-element-property :end element))
|
(skip-chars-backward " \r\t\n")
|
(line-beginning-position 2))))
|
'noindent)
|
((and (eq type 'src-block)
|
org-src-tab-acts-natively
|
(> (line-beginning-position)
|
(org-element-property :post-affiliated element))
|
(< (line-beginning-position)
|
(org-with-wide-buffer
|
(goto-char (org-element-property :end element))
|
(skip-chars-backward " \r\t\n")
|
(line-beginning-position))))
|
(org-babel-do-key-sequence-in-edit-buffer (kbd "TAB")))
|
(t
|
(let ((column (org--get-expected-indentation element nil)))
|
;; Preserve current column.
|
(if (<= (current-column) (current-indentation))
|
(indent-line-to column)
|
(save-excursion (indent-line-to column))))
|
;; Align node property. Also preserve current column.
|
(when (eq type 'node-property)
|
(let ((column (current-column)))
|
(org--align-node-property)
|
(org-move-to-column column)))))))))
|
|
(defun org-indent-region (start end)
|
"Indent each non-blank line in the region.
|
Called from a program, START and END specify the region to
|
indent. The function will not indent contents of example blocks,
|
verse blocks and export blocks as leading white spaces are
|
assumed to be significant there."
|
(interactive "r")
|
(save-excursion
|
(goto-char start)
|
(skip-chars-forward " \r\t\n")
|
(unless (eobp) (beginning-of-line))
|
(let ((indent-to
|
(lambda (ind pos)
|
;; Set IND as indentation for all lines between point and
|
;; POS. Blank lines are ignored. Leave point after POS
|
;; once done.
|
(let ((limit (copy-marker pos)))
|
(while (< (point) limit)
|
(unless (looking-at-p "[ \t]*$") (indent-line-to ind))
|
(forward-line))
|
(set-marker limit nil))))
|
(end (copy-marker end)))
|
(while (< (point) end)
|
(if (or (looking-at-p " \r\t\n") (org-at-heading-p)) (forward-line)
|
(let* ((element (org-element-at-point))
|
(type (org-element-type element))
|
(element-end (copy-marker (org-element-property :end element)))
|
(ind (org--get-expected-indentation element nil)))
|
(cond
|
;; Element indented as a single block. Example blocks
|
;; preserving indentation are a special case since the
|
;; "contents" must not be indented whereas the block
|
;; boundaries can.
|
((or (memq type '(export-block latex-environment))
|
(and (eq type 'example-block)
|
(not
|
(or org-src-preserve-indentation
|
(org-element-property :preserve-indent element)))))
|
(let ((offset (- ind (org-get-indentation))))
|
(unless (zerop offset)
|
(indent-rigidly (org-element-property :begin element)
|
(org-element-property :end element)
|
offset)))
|
(goto-char element-end))
|
;; Elements indented line wise. Be sure to exclude
|
;; example blocks (preserving indentation) and source
|
;; blocks from this category as they are treated
|
;; specially later.
|
((or (memq type '(paragraph table table-row))
|
(not (or (org-element-property :contents-begin element)
|
(memq type '(example-block src-block)))))
|
(when (eq type 'node-property)
|
(org--align-node-property)
|
(beginning-of-line))
|
(funcall indent-to ind (min element-end end)))
|
;; Elements consisting of three parts: before the
|
;; contents, the contents, and after the contents. The
|
;; contents are treated specially, according to the
|
;; element type, or not indented at all. Other parts are
|
;; indented as a single block.
|
(t
|
(let* ((post (copy-marker
|
(org-element-property :post-affiliated element)))
|
(cbeg
|
(copy-marker
|
(cond
|
((not (org-element-property :contents-begin element))
|
;; Fake contents for source blocks.
|
(org-with-wide-buffer
|
(goto-char post)
|
(line-beginning-position 2)))
|
((memq type '(footnote-definition item plain-list))
|
;; Contents in these elements could start on
|
;; the same line as the beginning of the
|
;; element. Make sure we start indenting
|
;; from the second line.
|
(org-with-wide-buffer
|
(goto-char post)
|
(end-of-line)
|
(skip-chars-forward " \r\t\n")
|
(if (eobp) (point) (line-beginning-position))))
|
(t (org-element-property :contents-begin element)))))
|
(cend (copy-marker
|
(or (org-element-property :contents-end element)
|
;; Fake contents for source blocks.
|
(org-with-wide-buffer
|
(goto-char element-end)
|
(skip-chars-backward " \r\t\n")
|
(line-beginning-position)))
|
t)))
|
;; Do not change items indentation individually as it
|
;; might break the list as a whole. On the other
|
;; hand, when at a plain list, indent it as a whole.
|
(cond ((eq type 'plain-list)
|
(let ((offset (- ind (org-get-indentation))))
|
(unless (zerop offset)
|
(indent-rigidly (org-element-property :begin element)
|
(org-element-property :end element)
|
offset))
|
(goto-char cbeg)))
|
((eq type 'item) (goto-char cbeg))
|
(t (funcall indent-to ind (min cbeg end))))
|
(when (< (point) end)
|
(cl-case type
|
((example-block verse-block))
|
(src-block
|
;; In a source block, indent source code
|
;; according to language major mode, but only if
|
;; `org-src-tab-acts-natively' is non-nil.
|
(when (and (< (point) end) org-src-tab-acts-natively)
|
(ignore-errors
|
(org-babel-do-in-edit-buffer
|
(indent-region (point-min) (point-max))))))
|
(t (org-indent-region (point) (min cend end))))
|
(goto-char (min cend end))
|
(when (< (point) end)
|
(funcall indent-to ind (min element-end end))))
|
(set-marker post nil)
|
(set-marker cbeg nil)
|
(set-marker cend nil))))
|
(set-marker element-end nil))))
|
(set-marker end nil))))
|
|
(defun org-indent-drawer ()
|
"Indent the drawer at point."
|
(interactive)
|
(unless (save-excursion
|
(beginning-of-line)
|
(looking-at-p org-drawer-regexp))
|
(user-error "Not at a drawer"))
|
(let ((element (org-element-at-point)))
|
(unless (memq (org-element-type element) '(drawer property-drawer))
|
(user-error "Not at a drawer"))
|
(org-with-wide-buffer
|
(org-indent-region (org-element-property :begin element)
|
(org-element-property :end element))))
|
(message "Drawer at point indented"))
|
|
(defun org-indent-block ()
|
"Indent the block at point."
|
(interactive)
|
(unless (save-excursion
|
(beginning-of-line)
|
(let ((case-fold-search t))
|
(looking-at-p "[ \t]*#\\+\\(begin\\|end\\)_")))
|
(user-error "Not at a block"))
|
(let ((element (org-element-at-point)))
|
(unless (memq (org-element-type element)
|
'(comment-block center-block dynamic-block example-block
|
export-block quote-block special-block
|
src-block verse-block))
|
(user-error "Not at a block"))
|
(org-with-wide-buffer
|
(org-indent-region (org-element-property :begin element)
|
(org-element-property :end element))))
|
(message "Block at point indented"))
|
|
|
;;; Filling
|
|
;; We use our own fill-paragraph and auto-fill functions.
|
|
;; `org-fill-paragraph' relies on adaptive filling and context
|
;; checking. Appropriate `fill-prefix' is computed with
|
;; `org-adaptive-fill-function'.
|
|
;; `org-auto-fill-function' takes care of auto-filling. It calls
|
;; `do-auto-fill' only on valid areas with `fill-prefix' shadowed with
|
;; `org-adaptive-fill-function' value. Internally,
|
;; `org-comment-line-break-function' breaks the line.
|
|
;; `org-setup-filling' installs filling and auto-filling related
|
;; variables during `org-mode' initialization.
|
|
(defun org-setup-filling ()
|
(require 'org-element)
|
;; Prevent auto-fill from inserting unwanted new items.
|
(when (boundp 'fill-nobreak-predicate)
|
(setq-local
|
fill-nobreak-predicate
|
(org-uniquify
|
(append fill-nobreak-predicate
|
'(org-fill-line-break-nobreak-p
|
org-fill-n-macro-as-item-nobreak-p
|
org-fill-paragraph-with-timestamp-nobreak-p)))))
|
(let ((paragraph-ending (substring org-element-paragraph-separate 1)))
|
(setq-local paragraph-start paragraph-ending)
|
(setq-local paragraph-separate paragraph-ending))
|
(setq-local fill-paragraph-function 'org-fill-paragraph)
|
(setq-local auto-fill-inhibit-regexp nil)
|
(setq-local adaptive-fill-function 'org-adaptive-fill-function)
|
(setq-local normal-auto-fill-function 'org-auto-fill-function)
|
(setq-local comment-line-break-function 'org-comment-line-break-function))
|
|
(defun org-fill-line-break-nobreak-p ()
|
"Non-nil when a new line at point would create an Org line break."
|
(save-excursion
|
(skip-chars-backward "[ \t]")
|
(skip-chars-backward "\\\\")
|
(looking-at "\\\\\\\\\\($\\|[^\\\\]\\)")))
|
|
(defun org-fill-paragraph-with-timestamp-nobreak-p ()
|
"Non-nil when a new line at point would split a timestamp."
|
(and (org-at-timestamp-p 'lax)
|
(not (looking-at org-ts-regexp-both))))
|
|
(defun org-fill-n-macro-as-item-nobreak-p ()
|
"Non-nil when a new line at point would create a new list."
|
;; During export, a "n" macro followed by a dot or a closing
|
;; parenthesis can end up being parsed as a new list item.
|
(looking-at-p "[ \t]*{{{n\\(?:([^\n)]*)\\)?}}}[.)]\\(?:$\\| \\)"))
|
|
(declare-function message-in-body-p "message" ())
|
(defvar orgtbl-line-start-regexp) ; From org-table.el
|
(defun org-adaptive-fill-function ()
|
"Compute a fill prefix for the current line.
|
Return fill prefix, as a string, or nil if current line isn't
|
meant to be filled. For convenience, if `adaptive-fill-regexp'
|
matches in paragraphs or comments, use it."
|
(catch 'exit
|
(when (derived-mode-p 'message-mode)
|
(save-excursion
|
(beginning-of-line)
|
(cond ((not (message-in-body-p)) (throw 'exit nil))
|
((looking-at-p org-table-line-regexp) (throw 'exit nil))
|
((looking-at message-cite-prefix-regexp)
|
(throw 'exit (match-string-no-properties 0)))
|
((looking-at org-outline-regexp)
|
(throw 'exit (make-string (length (match-string 0)) ?\s))))))
|
(org-with-wide-buffer
|
(unless (org-at-heading-p)
|
(let* ((p (line-beginning-position))
|
(element (save-excursion
|
(beginning-of-line)
|
(org-element-at-point)))
|
(type (org-element-type element))
|
(post-affiliated (org-element-property :post-affiliated element)))
|
(unless (< p post-affiliated)
|
(cl-case type
|
(comment
|
(save-excursion
|
(beginning-of-line)
|
(looking-at "[ \t]*")
|
(concat (match-string 0) "# ")))
|
(footnote-definition "")
|
((item plain-list)
|
(make-string (org-list-item-body-column post-affiliated) ?\s))
|
(paragraph
|
;; Fill prefix is usually the same as the current line,
|
;; unless the paragraph is at the beginning of an item.
|
(let ((parent (org-element-property :parent element)))
|
(save-excursion
|
(beginning-of-line)
|
(cond ((eq (org-element-type parent) 'item)
|
(make-string (org-list-item-body-column
|
(org-element-property :begin parent))
|
?\s))
|
((and adaptive-fill-regexp
|
;; Locally disable
|
;; `adaptive-fill-function' to let
|
;; `fill-context-prefix' handle
|
;; `adaptive-fill-regexp' variable.
|
(let (adaptive-fill-function)
|
(fill-context-prefix
|
post-affiliated
|
(org-element-property :end element)))))
|
((looking-at "[ \t]+") (match-string 0))
|
(t "")))))
|
(comment-block
|
;; Only fill contents if P is within block boundaries.
|
(let* ((cbeg (save-excursion (goto-char post-affiliated)
|
(forward-line)
|
(point)))
|
(cend (save-excursion
|
(goto-char (org-element-property :end element))
|
(skip-chars-backward " \r\t\n")
|
(line-beginning-position))))
|
(when (and (>= p cbeg) (< p cend))
|
(if (save-excursion (beginning-of-line) (looking-at "[ \t]+"))
|
(match-string 0)
|
"")))))))))))
|
|
(declare-function message-goto-body "message" ())
|
(defvar message-cite-prefix-regexp) ; From message.el
|
|
(defun org-fill-element (&optional justify)
|
"Fill element at point, when applicable.
|
|
This function only applies to comment blocks, comments, example
|
blocks and paragraphs. Also, as a special case, re-align table
|
when point is at one.
|
|
If JUSTIFY is non-nil (interactively, with prefix argument),
|
justify as well. If `sentence-end-double-space' is non-nil, then
|
period followed by one space does not end a sentence, so don't
|
break a line there. The variable `fill-column' controls the
|
width for filling.
|
|
For convenience, when point is at a plain list, an item or
|
a footnote definition, try to fill the first paragraph within."
|
(with-syntax-table org-mode-transpose-word-syntax-table
|
;; Move to end of line in order to get the first paragraph within
|
;; a plain list or a footnote definition.
|
(let ((element (save-excursion (end-of-line) (org-element-at-point))))
|
;; First check if point is in a blank line at the beginning of
|
;; the buffer. In that case, ignore filling.
|
(cl-case (org-element-type element)
|
;; Use major mode filling function is src blocks.
|
(src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q")))
|
;; Align Org tables, leave table.el tables as-is.
|
(table-row (org-table-align) t)
|
(table
|
(when (eq (org-element-property :type element) 'org)
|
(save-excursion
|
(goto-char (org-element-property :post-affiliated element))
|
(org-table-align)))
|
t)
|
(paragraph
|
;; Paragraphs may contain `line-break' type objects.
|
(let ((beg (max (point-min)
|
(org-element-property :contents-begin element)))
|
(end (min (point-max)
|
(org-element-property :contents-end element))))
|
;; Do nothing if point is at an affiliated keyword.
|
(if (< (line-end-position) beg) t
|
(when (derived-mode-p 'message-mode)
|
;; In `message-mode', do not fill following citation
|
;; in current paragraph nor text before message body.
|
(let ((body-start (save-excursion (message-goto-body))))
|
(when body-start (setq beg (max body-start beg))))
|
(when (save-excursion
|
(re-search-forward
|
(concat "^" message-cite-prefix-regexp) end t))
|
(setq end (match-beginning 0))))
|
;; Fill paragraph, taking line breaks into account.
|
(save-excursion
|
(goto-char beg)
|
(let ((cuts (list beg)))
|
(while (re-search-forward "\\\\\\\\[ \t]*\n" end t)
|
(when (eq 'line-break
|
(org-element-type
|
(save-excursion (backward-char)
|
(org-element-context))))
|
(push (point) cuts)))
|
(dolist (c (delq end cuts))
|
(fill-region-as-paragraph c end justify)
|
(setq end c))))
|
t)))
|
;; Contents of `comment-block' type elements should be
|
;; filled as plain text, but only if point is within block
|
;; markers.
|
(comment-block
|
(let* ((case-fold-search t)
|
(beg (save-excursion
|
(goto-char (org-element-property :begin element))
|
(re-search-forward "^[ \t]*#\\+begin_comment" nil t)
|
(forward-line)
|
(point)))
|
(end (save-excursion
|
(goto-char (org-element-property :end element))
|
(re-search-backward "^[ \t]*#\\+end_comment" nil t)
|
(line-beginning-position))))
|
(if (or (< (point) beg) (> (point) end)) t
|
(fill-region-as-paragraph
|
(save-excursion (end-of-line)
|
(re-search-backward "^[ \t]*$" beg 'move)
|
(line-beginning-position))
|
(save-excursion (beginning-of-line)
|
(re-search-forward "^[ \t]*$" end 'move)
|
(line-beginning-position))
|
justify))))
|
;; Fill comments.
|
(comment
|
(let ((begin (org-element-property :post-affiliated element))
|
(end (org-element-property :end element)))
|
(when (and (>= (point) begin) (<= (point) end))
|
(let ((begin (save-excursion
|
(end-of-line)
|
(if (re-search-backward "^[ \t]*#[ \t]*$" begin t)
|
(progn (forward-line) (point))
|
begin)))
|
(end (save-excursion
|
(end-of-line)
|
(if (re-search-forward "^[ \t]*#[ \t]*$" end 'move)
|
(1- (line-beginning-position))
|
(skip-chars-backward " \r\t\n")
|
(line-end-position)))))
|
;; Do not fill comments when at a blank line.
|
(when (> end begin)
|
(let ((fill-prefix
|
(save-excursion
|
(beginning-of-line)
|
(looking-at "[ \t]*#")
|
(let ((comment-prefix (match-string 0)))
|
(goto-char (match-end 0))
|
(if (looking-at adaptive-fill-regexp)
|
(concat comment-prefix (match-string 0))
|
(concat comment-prefix " "))))))
|
(save-excursion
|
(fill-region-as-paragraph begin end justify))))))
|
t))
|
;; Ignore every other element.
|
(otherwise t)))))
|
|
(defun org-fill-paragraph (&optional justify region)
|
"Fill element at point, when applicable.
|
|
This function only applies to comment blocks, comments, example
|
blocks and paragraphs. Also, as a special case, re-align table
|
when point is at one.
|
|
For convenience, when point is at a plain list, an item or
|
a footnote definition, try to fill the first paragraph within.
|
|
If JUSTIFY is non-nil (interactively, with prefix argument),
|
justify as well. If `sentence-end-double-space' is non-nil, then
|
period followed by one space does not end a sentence, so don't
|
break a line there. The variable `fill-column' controls the
|
width for filling.
|
|
The REGION argument is non-nil if called interactively; in that
|
case, if Transient Mark mode is enabled and the mark is active,
|
fill each of the elements in the active region, instead of just
|
filling the current element."
|
(interactive (progn
|
(barf-if-buffer-read-only)
|
(list (if current-prefix-arg 'full) t)))
|
(cond
|
((and (derived-mode-p 'message-mode)
|
(or (not (message-in-body-p))
|
(save-excursion (move-beginning-of-line 1)
|
(looking-at message-cite-prefix-regexp))))
|
;; First ensure filling is correct in message-mode.
|
(let ((fill-paragraph-function
|
(cl-cadadr (assq 'fill-paragraph-function org-fb-vars)))
|
(fill-prefix (cl-cadadr (assq 'fill-prefix org-fb-vars)))
|
(paragraph-start (cl-cadadr (assq 'paragraph-start org-fb-vars)))
|
(paragraph-separate
|
(cl-cadadr (assq 'paragraph-separate org-fb-vars))))
|
(fill-paragraph nil)))
|
((and region transient-mark-mode mark-active
|
(not (eq (region-beginning) (region-end))))
|
(let ((origin (point-marker))
|
(start (region-beginning)))
|
(unwind-protect
|
(progn
|
(goto-char (region-end))
|
(while (> (point) start)
|
(org-backward-paragraph)
|
(org-fill-element justify)))
|
(goto-char origin)
|
(set-marker origin nil))))
|
(t (org-fill-element justify))))
|
(org-remap org-mode-map 'fill-paragraph 'org-fill-paragraph)
|
|
(defun org-auto-fill-function ()
|
"Auto-fill function."
|
;; Check if auto-filling is meaningful.
|
(let ((fc (current-fill-column)))
|
(when (and fc (> (current-column) fc))
|
(let* ((fill-prefix (org-adaptive-fill-function))
|
;; Enforce empty fill prefix, if required. Otherwise, it
|
;; will be computed again.
|
(adaptive-fill-mode (not (equal fill-prefix ""))))
|
(when fill-prefix (do-auto-fill))))))
|
|
(defun org-comment-line-break-function (&optional soft)
|
"Break line at point and indent, continuing comment if within one.
|
The inserted newline is marked hard if variable
|
`use-hard-newlines' is true, unless optional argument SOFT is
|
non-nil."
|
(if soft (insert-and-inherit ?\n) (newline 1))
|
(save-excursion (forward-char -1) (delete-horizontal-space))
|
(delete-horizontal-space)
|
(indent-to-left-margin)
|
(insert-before-markers-and-inherit fill-prefix))
|
|
|
;;; Fixed Width Areas
|
|
(defun org-toggle-fixed-width ()
|
"Toggle fixed-width markup.
|
|
Add or remove fixed-width markup on current line, whenever it
|
makes sense. Return an error otherwise.
|
|
If a region is active and if it contains only fixed-width areas
|
or blank lines, remove all fixed-width markup in it. If the
|
region contains anything else, convert all non-fixed-width lines
|
to fixed-width ones.
|
|
Blank lines at the end of the region are ignored unless the
|
region only contains such lines."
|
(interactive)
|
(if (not (org-region-active-p))
|
;; No region:
|
;;
|
;; Remove fixed width marker only in a fixed-with element.
|
;;
|
;; Add fixed width maker in paragraphs, in blank lines after
|
;; elements or at the beginning of a headline or an inlinetask,
|
;; and before any one-line elements (e.g., a clock).
|
(progn
|
(beginning-of-line)
|
(let* ((element (org-element-at-point))
|
(type (org-element-type element)))
|
(cond
|
((and (eq type 'fixed-width)
|
(looking-at "[ \t]*\\(:\\(?: \\|$\\)\\)"))
|
(replace-match
|
"" nil nil nil (if (= (line-end-position) (match-end 0)) 0 1)))
|
((and (memq type '(babel-call clock comment diary-sexp headline
|
horizontal-rule keyword paragraph
|
planning))
|
(<= (org-element-property :post-affiliated element) (point)))
|
(skip-chars-forward " \t")
|
(insert ": "))
|
((and (looking-at-p "[ \t]*$")
|
(or (eq type 'inlinetask)
|
(save-excursion
|
(skip-chars-forward " \r\t\n")
|
(<= (org-element-property :end element) (point)))))
|
(delete-region (point) (line-end-position))
|
(org-indent-line)
|
(insert ": "))
|
(t (user-error "Cannot insert a fixed-width line here")))))
|
;; Region active.
|
(let* ((begin (save-excursion
|
(goto-char (region-beginning))
|
(line-beginning-position)))
|
(end (copy-marker
|
(save-excursion
|
(goto-char (region-end))
|
(unless (eolp) (beginning-of-line))
|
(if (save-excursion (re-search-backward "\\S-" begin t))
|
(progn (skip-chars-backward " \r\t\n") (point))
|
(point)))))
|
(all-fixed-width-p
|
(catch 'not-all-p
|
(save-excursion
|
(goto-char begin)
|
(skip-chars-forward " \r\t\n")
|
(when (eobp) (throw 'not-all-p nil))
|
(while (< (point) end)
|
(let ((element (org-element-at-point)))
|
(if (eq (org-element-type element) 'fixed-width)
|
(goto-char (org-element-property :end element))
|
(throw 'not-all-p nil))))
|
t))))
|
(if all-fixed-width-p
|
(save-excursion
|
(goto-char begin)
|
(while (< (point) end)
|
(when (looking-at "[ \t]*\\(:\\(?: \\|$\\)\\)")
|
(replace-match
|
"" nil nil nil
|
(if (= (line-end-position) (match-end 0)) 0 1)))
|
(forward-line)))
|
(let ((min-ind (point-max)))
|
;; Find minimum indentation across all lines.
|
(save-excursion
|
(goto-char begin)
|
(if (not (save-excursion (re-search-forward "\\S-" end t)))
|
(setq min-ind 0)
|
(catch 'zerop
|
(while (< (point) end)
|
(unless (looking-at-p "[ \t]*$")
|
(let ((ind (org-get-indentation)))
|
(setq min-ind (min min-ind ind))
|
(when (zerop ind) (throw 'zerop t))))
|
(forward-line)))))
|
;; Loop over all lines and add fixed-width markup everywhere
|
;; but in fixed-width lines.
|
(save-excursion
|
(goto-char begin)
|
(while (< (point) end)
|
(cond
|
((org-at-heading-p)
|
(insert ": ")
|
(forward-line)
|
(while (and (< (point) end) (looking-at-p "[ \t]*$"))
|
(insert ":")
|
(forward-line)))
|
((looking-at-p "[ \t]*:\\( \\|$\\)")
|
(let* ((element (org-element-at-point))
|
(element-end (org-element-property :end element)))
|
(if (eq (org-element-type element) 'fixed-width)
|
(progn (goto-char element-end)
|
(skip-chars-backward " \r\t\n")
|
(forward-line))
|
(let ((limit (min end element-end)))
|
(while (< (point) limit)
|
(org-move-to-column min-ind t)
|
(insert ": ")
|
(forward-line))))))
|
(t
|
(org-move-to-column min-ind t)
|
(insert ": ")
|
(forward-line)))))))
|
(set-marker end nil))))
|
|
|
;;; Comments
|
|
;; Org comments syntax is quite complex. It requires the entire line
|
;; to be just a comment. Also, even with the right syntax at the
|
;; beginning of line, some elements (e.g., verse-block or
|
;; example-block) don't accept comments. Usual Emacs comment commands
|
;; cannot cope with those requirements. Therefore, Org replaces them.
|
|
;; Org still relies on `comment-dwim', but cannot trust
|
;; `comment-only-p'. So, `comment-region-function' and
|
;; `uncomment-region-function' both point
|
;; to`org-comment-or-uncomment-region'. Eventually,
|
;; `org-insert-comment' takes care of insertion of comments at the
|
;; beginning of line.
|
|
;; `org-setup-comments-handling' install comments related variables
|
;; during `org-mode' initialization.
|
|
(defun org-setup-comments-handling ()
|
(interactive)
|
(setq-local comment-use-syntax nil)
|
(setq-local comment-start "# ")
|
(setq-local comment-start-skip "^\\s-*#\\(?: \\|$\\)")
|
(setq-local comment-insert-comment-function 'org-insert-comment)
|
(setq-local comment-region-function 'org-comment-or-uncomment-region)
|
(setq-local uncomment-region-function 'org-comment-or-uncomment-region))
|
|
(defun org-insert-comment ()
|
"Insert an empty comment above current line.
|
If the line is empty, insert comment at its beginning. When
|
point is within a source block, comment according to the related
|
major mode."
|
(if (let ((element (org-element-at-point)))
|
(and (eq (org-element-type element) 'src-block)
|
(< (save-excursion
|
(goto-char (org-element-property :post-affiliated element))
|
(line-end-position))
|
(point))
|
(> (save-excursion
|
(goto-char (org-element-property :end element))
|
(skip-chars-backward " \r\t\n")
|
(line-beginning-position))
|
(point))))
|
(org-babel-do-in-edit-buffer (call-interactively 'comment-dwim))
|
(beginning-of-line)
|
(if (looking-at "\\s-*$") (delete-region (point) (point-at-eol))
|
(open-line 1))
|
(org-indent-line)
|
(insert "# ")))
|
|
(defvar comment-empty-lines) ; From newcomment.el.
|
(defun org-comment-or-uncomment-region (beg end &rest _)
|
"Comment or uncomment each non-blank line in the region.
|
Uncomment each non-blank line between BEG and END if it only
|
contains commented lines. Otherwise, comment them. If region is
|
strictly within a source block, use appropriate comment syntax."
|
(if (let ((element (org-element-at-point)))
|
(and (eq (org-element-type element) 'src-block)
|
(< (save-excursion
|
(goto-char (org-element-property :post-affiliated element))
|
(line-end-position))
|
beg)
|
(>= (save-excursion
|
(goto-char (org-element-property :end element))
|
(skip-chars-backward " \r\t\n")
|
(line-beginning-position))
|
end)))
|
;; Translate region boundaries for the Org buffer to the source
|
;; buffer.
|
(let ((offset (- end beg)))
|
(save-excursion
|
(goto-char beg)
|
(org-babel-do-in-edit-buffer
|
(comment-or-uncomment-region (point) (+ offset (point))))))
|
(save-restriction
|
;; Restrict region
|
(narrow-to-region (save-excursion (goto-char beg)
|
(skip-chars-forward " \r\t\n" end)
|
(line-beginning-position))
|
(save-excursion (goto-char end)
|
(skip-chars-backward " \r\t\n" beg)
|
(line-end-position)))
|
(let ((uncommentp
|
;; UNCOMMENTP is non-nil when every non blank line between
|
;; BEG and END is a comment.
|
(save-excursion
|
(goto-char (point-min))
|
(while (and (not (eobp))
|
(let ((element (org-element-at-point)))
|
(and (eq (org-element-type element) 'comment)
|
(goto-char (min (point-max)
|
(org-element-property
|
:end element)))))))
|
(eobp))))
|
(if uncommentp
|
;; Only blank lines and comments in region: uncomment it.
|
(save-excursion
|
(goto-char (point-min))
|
(while (not (eobp))
|
(when (looking-at "[ \t]*\\(#\\(?: \\|$\\)\\)")
|
(replace-match "" nil nil nil 1))
|
(forward-line)))
|
;; Comment each line in region.
|
(let ((min-indent (point-max)))
|
;; First find the minimum indentation across all lines.
|
(save-excursion
|
(goto-char (point-min))
|
(while (and (not (eobp)) (not (zerop min-indent)))
|
(unless (looking-at "[ \t]*$")
|
(setq min-indent (min min-indent (current-indentation))))
|
(forward-line)))
|
;; Then loop over all lines.
|
(save-excursion
|
(goto-char (point-min))
|
(while (not (eobp))
|
(unless (and (not comment-empty-lines) (looking-at "[ \t]*$"))
|
;; Don't get fooled by invisible text (e.g. link path)
|
;; when moving to column MIN-INDENT.
|
(let ((buffer-invisibility-spec nil))
|
(org-move-to-column min-indent t))
|
(insert comment-start))
|
(forward-line)))))))))
|
|
(defun org-comment-dwim (_arg)
|
"Call `comment-dwim' within a source edit buffer if needed."
|
(interactive "*P")
|
(if (org-in-src-block-p)
|
(org-babel-do-in-edit-buffer (call-interactively 'comment-dwim))
|
(call-interactively 'comment-dwim)))
|
|
|
;;; Timestamps API
|
|
;; This section contains tools to operate on timestamp objects, as
|
;; returned by, e.g. `org-element-context'.
|
|
(defun org-timestamp--to-internal-time (timestamp &optional end)
|
"Encode TIMESTAMP object into Emacs internal time.
|
Use end of date range or time range when END is non-nil."
|
(apply #'encode-time
|
(cons 0
|
(mapcar
|
(lambda (prop) (or (org-element-property prop timestamp) 0))
|
(if end '(:minute-end :hour-end :day-end :month-end :year-end)
|
'(:minute-start :hour-start :day-start :month-start
|
:year-start))))))
|
|
(defun org-timestamp-has-time-p (timestamp)
|
"Non-nil when TIMESTAMP has a time specified."
|
(org-element-property :hour-start timestamp))
|
|
(defun org-timestamp-format (timestamp format &optional end utc)
|
"Format a TIMESTAMP object into a string.
|
|
FORMAT is a format specifier to be passed to
|
`format-time-string'.
|
|
When optional argument END is non-nil, use end of date-range or
|
time-range, if possible.
|
|
When optional argument UTC is non-nil, time will be expressed as
|
Universal Time."
|
(format-time-string
|
format (org-timestamp--to-internal-time timestamp end)
|
(and utc t)))
|
|
(defun org-timestamp-split-range (timestamp &optional end)
|
"Extract a TIMESTAMP object from a date or time range.
|
|
END, when non-nil, means extract the end of the range.
|
Otherwise, extract its start.
|
|
Return a new timestamp object."
|
(let ((type (org-element-property :type timestamp)))
|
(if (memq type '(active inactive diary)) timestamp
|
(let ((split-ts (org-element-copy timestamp)))
|
;; Set new type.
|
(org-element-put-property
|
split-ts :type (if (eq type 'active-range) 'active 'inactive))
|
;; Copy start properties over end properties if END is
|
;; non-nil. Otherwise, copy end properties over `start' ones.
|
(let ((p-alist '((:minute-start . :minute-end)
|
(:hour-start . :hour-end)
|
(:day-start . :day-end)
|
(:month-start . :month-end)
|
(:year-start . :year-end))))
|
(dolist (p-cell p-alist)
|
(org-element-put-property
|
split-ts
|
(funcall (if end #'car #'cdr) p-cell)
|
(org-element-property
|
(funcall (if end #'cdr #'car) p-cell) split-ts)))
|
;; Eventually refresh `:raw-value'.
|
(org-element-put-property split-ts :raw-value nil)
|
(org-element-put-property
|
split-ts :raw-value (org-element-interpret-data split-ts)))))))
|
|
(defun org-timestamp-translate (timestamp &optional boundary)
|
"Translate TIMESTAMP object to custom format.
|
|
Format string is defined in `org-time-stamp-custom-formats',
|
which see.
|
|
When optional argument BOUNDARY is non-nil, it is either the
|
symbol `start' or `end'. In this case, only translate the
|
starting or ending part of TIMESTAMP if it is a date or time
|
range. Otherwise, translate both parts.
|
|
Return timestamp as-is if `org-display-custom-times' is nil or if
|
it has a `diary' type."
|
(let ((type (org-element-property :type timestamp)))
|
(if (or (not org-display-custom-times) (eq type 'diary))
|
(org-element-interpret-data timestamp)
|
(let ((fmt (funcall (if (org-timestamp-has-time-p timestamp) #'cdr #'car)
|
org-time-stamp-custom-formats)))
|
(if (and (not boundary) (memq type '(active-range inactive-range)))
|
(concat (org-timestamp-format timestamp fmt)
|
"--"
|
(org-timestamp-format timestamp fmt t))
|
(org-timestamp-format timestamp fmt (eq boundary 'end)))))))
|
|
|
|
;;; Other stuff.
|
|
(defvar reftex-docstruct-symbol)
|
(defvar org--rds)
|
|
(defun org-reftex-citation ()
|
"Use reftex-citation to insert a citation into the buffer.
|
This looks for a line like
|
|
#+BIBLIOGRAPHY: foo plain option:-d
|
|
and derives from it that foo.bib is the bibliography file relevant
|
for this document. It then installs the necessary environment for RefTeX
|
to work in this buffer and calls `reftex-citation' to insert a citation
|
into the buffer.
|
|
Export of such citations to both LaTeX and HTML is handled by the contributed
|
package ox-bibtex by Taru Karttunen."
|
(interactive)
|
(let ((reftex-docstruct-symbol 'org--rds)
|
org--rds bib)
|
(org-with-wide-buffer
|
(let ((case-fold-search t)
|
(re "^[ \t]*#\\+BIBLIOGRAPHY:[ \t]+\\([^ \t\n]+\\)"))
|
(if (not (save-excursion
|
(or (re-search-forward re nil t)
|
(re-search-backward re nil t))))
|
(user-error "No bibliography defined in file")
|
(setq bib (concat (match-string 1) ".bib")
|
org--rds (list (list 'bib bib))))))
|
(call-interactively 'reftex-citation)))
|
|
;;;; Functions extending outline functionality
|
|
(defun org-beginning-of-line (&optional n)
|
"Go to the beginning of the current visible line.
|
|
If this is a headline, and `org-special-ctrl-a/e' is set, ignore
|
tags on the first attempt, and only move to after the tags when
|
the cursor is already beyond the end of the headline.
|
|
With argument N not nil or 1, move forward N - 1 lines first."
|
(interactive "^p")
|
(let ((origin (point))
|
(special (pcase org-special-ctrl-a/e
|
(`(,C-a . ,_) C-a) (_ org-special-ctrl-a/e)))
|
deactivate-mark)
|
;; First move to a visible line.
|
(if (bound-and-true-p visual-line-mode)
|
(beginning-of-visual-line n)
|
(move-beginning-of-line n)
|
;; `move-beginning-of-line' may leave point after invisible
|
;; characters if line starts with such of these (e.g., with
|
;; a link at column 0). Really move to the beginning of the
|
;; current visible line.
|
(beginning-of-line))
|
(cond
|
;; No special behavior. Point is already at the beginning of
|
;; a line, logical or visual.
|
((not special))
|
;; `beginning-of-visual-line' left point before logical beginning
|
;; of line: point is at the beginning of a visual line. Bail
|
;; out.
|
((and (bound-and-true-p visual-line-mode) (not (bolp))))
|
((let ((case-fold-search nil)) (looking-at org-complex-heading-regexp))
|
;; At a headline, special position is before the title, but
|
;; after any TODO keyword or priority cookie.
|
(let ((refpos (min (1+ (or (match-end 3) (match-end 2) (match-end 1)))
|
(line-end-position)))
|
(bol (point)))
|
(if (eq special 'reversed)
|
(when (and (= origin bol) (eq last-command this-command))
|
(goto-char refpos))
|
(when (or (> origin refpos) (= origin bol))
|
(goto-char refpos)))))
|
((and (looking-at org-list-full-item-re)
|
(memq (org-element-type (save-match-data (org-element-at-point)))
|
'(item plain-list)))
|
;; Set special position at first white space character after
|
;; bullet, and check-box, if any.
|
(let ((after-bullet
|
(let ((box (match-end 3)))
|
(cond ((not box) (match-end 1))
|
((eq (char-after box) ?\s) (1+ box))
|
(t box)))))
|
(if (eq special 'reversed)
|
(when (and (= (point) origin) (eq last-command this-command))
|
(goto-char after-bullet))
|
(when (or (> origin after-bullet) (= (point) origin))
|
(goto-char after-bullet)))))
|
;; No special context. Point is already at beginning of line.
|
(t nil))))
|
|
(defun org-end-of-line (&optional n)
|
"Go to the end of the line, but before ellipsis, if any.
|
|
If this is a headline, and `org-special-ctrl-a/e' is set, ignore
|
tags on the first attempt, and only move to after the tags when
|
the cursor is already beyond the end of the headline.
|
|
With argument N not nil or 1, move forward N - 1 lines first."
|
(interactive "^p")
|
(let ((origin (point))
|
(special (pcase org-special-ctrl-a/e
|
(`(,_ . ,C-e) C-e) (_ org-special-ctrl-a/e)))
|
deactivate-mark)
|
;; First move to a visible line.
|
(if (bound-and-true-p visual-line-mode)
|
(beginning-of-visual-line n)
|
(move-beginning-of-line n))
|
(cond
|
;; At a headline, with tags.
|
((and special
|
(save-excursion
|
(beginning-of-line)
|
(let ((case-fold-search nil))
|
(looking-at org-complex-heading-regexp)))
|
(match-end 5))
|
(let ((tags (save-excursion
|
(goto-char (match-beginning 5))
|
(skip-chars-backward " \t")
|
(point)))
|
(visual-end (and (bound-and-true-p visual-line-mode)
|
(save-excursion
|
(end-of-visual-line)
|
(point)))))
|
;; If `end-of-visual-line' brings us before end of line or
|
;; even tags, i.e., the headline spans over multiple visual
|
;; lines, move there.
|
(cond ((and visual-end
|
(< visual-end tags)
|
(<= origin visual-end))
|
(goto-char visual-end))
|
((eq special 'reversed)
|
(if (and (= origin (line-end-position))
|
(eq this-command last-command))
|
(goto-char tags)
|
(end-of-line)))
|
(t
|
(if (or (< origin tags) (= origin (line-end-position)))
|
(goto-char tags)
|
(end-of-line))))))
|
((bound-and-true-p visual-line-mode)
|
(let ((bol (line-beginning-position)))
|
(end-of-visual-line)
|
;; If `end-of-visual-line' gets us past the ellipsis at the
|
;; end of a line, backtrack and use `end-of-line' instead.
|
(when (/= bol (line-beginning-position))
|
(goto-char bol)
|
(end-of-line))))
|
(t (end-of-line)))))
|
|
(define-key org-mode-map "\C-a" 'org-beginning-of-line)
|
(define-key org-mode-map "\C-e" 'org-end-of-line)
|
|
(defun org-backward-sentence (&optional _arg)
|
"Go to beginning of sentence, or beginning of table field.
|
This will call `backward-sentence' or `org-table-beginning-of-field',
|
depending on context."
|
(interactive)
|
(let* ((element (org-element-at-point))
|
(contents-begin (org-element-property :contents-begin element))
|
(table (org-element-lineage element '(table) t)))
|
(if (and table
|
(> (point) contents-begin)
|
(<= (point) (org-element-property :contents-end table)))
|
(call-interactively #'org-table-beginning-of-field)
|
(save-restriction
|
(when (and contents-begin
|
(< (point-min) contents-begin)
|
(> (point) contents-begin))
|
(narrow-to-region contents-begin
|
(org-element-property :contents-end element)))
|
(call-interactively #'backward-sentence)))))
|
|
(defun org-forward-sentence (&optional _arg)
|
"Go to end of sentence, or end of table field.
|
This will call `forward-sentence' or `org-table-end-of-field',
|
depending on context."
|
(interactive)
|
(if (and (org-at-heading-p)
|
(save-restriction (skip-chars-forward " \t") (not (eolp))))
|
(save-restriction
|
(narrow-to-region (line-beginning-position) (line-end-position))
|
(call-interactively #'forward-sentence))
|
(let* ((element (org-element-at-point))
|
(contents-end (org-element-property :contents-end element))
|
(table (org-element-lineage element '(table) t)))
|
(if (and table
|
(>= (point) (org-element-property :contents-begin table))
|
(< (point) contents-end))
|
(call-interactively #'org-table-end-of-field)
|
(save-restriction
|
(when (and contents-end
|
(> (point-max) contents-end)
|
;; Skip blank lines between elements.
|
(< (org-element-property :end element)
|
(save-excursion (goto-char contents-end)
|
(skip-chars-forward " \r\t\n"))))
|
(narrow-to-region (org-element-property :contents-begin element)
|
contents-end))
|
;; End of heading is considered as the end of a sentence.
|
(let ((sentence-end (concat (sentence-end) "\\|^\\*+ .*$")))
|
(call-interactively #'forward-sentence)))))))
|
|
(define-key org-mode-map "\M-a" 'org-backward-sentence)
|
(define-key org-mode-map "\M-e" 'org-forward-sentence)
|
|
(defun org-kill-line (&optional _arg)
|
"Kill line, to tags or end of line."
|
(interactive)
|
(cond
|
((or (not org-special-ctrl-k)
|
(bolp)
|
(not (org-at-heading-p)))
|
(when (and (get-char-property (min (point-max) (point-at-eol)) 'invisible)
|
org-ctrl-k-protect-subtree
|
(or (eq org-ctrl-k-protect-subtree 'error)
|
(not (y-or-n-p "Kill hidden subtree along with headline? "))))
|
(user-error
|
(substitute-command-keys
|
"`\\[org-kill-line]' aborted as it would kill a hidden subtree")))
|
(call-interactively
|
(if (bound-and-true-p visual-line-mode) 'kill-visual-line 'kill-line)))
|
((looking-at ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$")
|
(kill-region (point) (match-beginning 1))
|
(org-set-tags nil t))
|
(t (kill-region (point) (point-at-eol)))))
|
|
(define-key org-mode-map "\C-k" 'org-kill-line)
|
|
(defun org-yank (&optional arg)
|
"Yank. If the kill is a subtree, treat it specially.
|
This command will look at the current kill and check if is a single
|
subtree, or a series of subtrees[1]. If it passes the test, and if the
|
cursor is at the beginning of a line or after the stars of a currently
|
empty headline, then the yank is handled specially. How exactly depends
|
on the value of the following variables.
|
|
`org-yank-folded-subtrees'
|
By default, this variable is non-nil, which results in
|
subtree(s) being folded after insertion, except if doing so
|
would swallow text after the yanked text.
|
|
`org-yank-adjusted-subtrees'
|
When non-nil (the default value is nil), the subtree will be
|
promoted or demoted in order to fit into the local outline tree
|
structure, which means that the level will be adjusted so that it
|
becomes the smaller one of the two *visible* surrounding headings.
|
|
Any prefix to this command will cause `yank' to be called directly with
|
no special treatment. In particular, a simple `\\[universal-argument]' prefix \
|
will just
|
plainly yank the text as it is.
|
|
\[1] The test checks if the first non-white line is a heading
|
and if there are no other headings with fewer stars."
|
(interactive "P")
|
(org-yank-generic 'yank arg))
|
|
(defun org-yank-generic (command arg)
|
"Perform some yank-like command.
|
|
This function implements the behavior described in the `org-yank'
|
documentation. However, it has been generalized to work for any
|
interactive command with similar behavior."
|
|
;; pretend to be command COMMAND
|
(setq this-command command)
|
|
(if arg
|
(call-interactively command)
|
|
(let ((subtreep ; is kill a subtree, and the yank position appropriate?
|
(and (org-kill-is-subtree-p)
|
(or (bolp)
|
(and (looking-at "[ \t]*$")
|
(string-match
|
"\\`\\*+\\'"
|
(buffer-substring (point-at-bol) (point)))))))
|
swallowp)
|
(cond
|
((and subtreep org-yank-folded-subtrees)
|
(let ((beg (point))
|
end)
|
(if (and subtreep org-yank-adjusted-subtrees)
|
(org-paste-subtree nil nil 'for-yank)
|
(call-interactively command))
|
|
(setq end (point))
|
(goto-char beg)
|
(when (and (bolp) subtreep
|
(not (setq swallowp
|
(org-yank-folding-would-swallow-text beg 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))
|
(outline-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"))
|
|
(goto-char end)
|
(skip-chars-forward " \t\n\r")
|
(beginning-of-line 1)
|
(push-mark beg 'nomsg)))
|
((and subtreep org-yank-adjusted-subtrees)
|
(let ((beg (point-at-bol)))
|
(org-paste-subtree nil nil 'for-yank)
|
(push-mark beg 'nomsg)))
|
(t
|
(call-interactively command))))))
|
|
(defun org-yank-folding-would-swallow-text (beg end)
|
"Would hide-subtree at BEG swallow any text after END?"
|
(let (level)
|
(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")
|
(not (or (eobp)
|
(and (bolp) (looking-at-p org-outline-regexp)
|
(<= (org-outline-level) level))))))))
|
|
(define-key org-mode-map "\C-y" 'org-yank)
|
|
(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
|
`visible-mode'."
|
(unless (bound-and-true-p visible-mode)
|
(org-invisible-p)))
|
|
(defun org-invisible-p2 ()
|
"Check if point is at a character currently not visible.
|
|
If the point is at EOL (and not at the beginning of a buffer too),
|
move it back by one char before doing this check."
|
(save-excursion
|
(when (and (eolp) (not (bobp)))
|
(backward-char 1))
|
(org-invisible-p)))
|
|
(defun org-back-to-heading (&optional invisible-ok)
|
"Call `outline-back-to-heading', but provide a better error message."
|
(condition-case nil
|
(outline-back-to-heading invisible-ok)
|
(error (error "Before first headline at position %d in buffer %s"
|
(point) (current-buffer)))))
|
|
(defun org-before-first-heading-p ()
|
"Before first heading?"
|
(save-excursion
|
(end-of-line)
|
(null (re-search-backward org-outline-regexp-bol nil t))))
|
|
(defun org-at-heading-p (&optional ignored)
|
(outline-on-heading-p t))
|
|
(defun org-in-commented-heading-p (&optional no-inheritance)
|
"Non-nil if point is under a commented heading.
|
This function also checks ancestors of the current headline,
|
unless optional argument NO-INHERITANCE is non-nil."
|
(cond
|
((org-before-first-heading-p) nil)
|
((let ((headline (nth 4 (org-heading-components))))
|
(and headline
|
(let ((case-fold-search nil))
|
(string-match-p (concat "^" org-comment-string "\\(?: \\|$\\)")
|
headline)))))
|
(no-inheritance nil)
|
(t
|
(save-excursion (and (org-up-heading-safe) (org-in-commented-heading-p))))))
|
|
(defun org-at-comment-p nil
|
"Is cursor in a commented line?"
|
(save-excursion
|
(save-match-data
|
(beginning-of-line)
|
(looking-at "^[ \t]*# "))))
|
|
(defun org-at-drawer-p nil
|
"Is cursor at a drawer keyword?"
|
(save-excursion
|
(move-beginning-of-line 1)
|
(looking-at org-drawer-regexp)))
|
|
(defun org-at-block-p nil
|
"Is cursor at a block keyword?"
|
(save-excursion
|
(move-beginning-of-line 1)
|
(looking-at org-block-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."
|
(let ((case-fold-search nil))
|
(and (looking-at "[ \t]*$")
|
org-todo-line-regexp
|
(save-excursion
|
(beginning-of-line)
|
(looking-at org-todo-line-regexp)
|
(string= (match-string 3) "")))))
|
|
(defun org-at-heading-or-item-p ()
|
(or (org-at-heading-p) (org-at-item-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.
|
This function considers both visible and invisible heading lines.
|
With argument, move up ARG levels."
|
(outline-up-heading arg t))
|
|
(defun org-up-heading-safe ()
|
"Move to the heading line of which the present line is a subheading.
|
This version will not throw an error. It will return the level of the
|
headline found, or nil if no higher level is found.
|
|
Also, this function will be a lot faster than `outline-up-heading',
|
because it relies on stars being the outline starters. This can really
|
make a significant difference in outlines with very many siblings."
|
(when (ignore-errors (org-back-to-heading t))
|
(let ((level-up (1- (funcall outline-level))))
|
(and (> level-up 0)
|
(re-search-backward (format "^\\*\\{1,%d\\} " level-up) nil t)
|
(funcall outline-level)))))
|
|
(defun org-first-sibling-p ()
|
"Is this heading the first child of its parents?"
|
(interactive)
|
(let ((re org-outline-regexp-bol)
|
level l)
|
(unless (org-at-heading-p t)
|
(user-error "Not at a heading"))
|
(setq level (funcall outline-level))
|
(save-excursion
|
(if (not (re-search-backward re nil t))
|
t
|
(setq l (funcall outline-level))
|
(< l level)))))
|
|
(defun org-goto-sibling (&optional previous)
|
"Goto the next sibling, even if it is invisible.
|
When PREVIOUS is set, go to the previous sibling instead. Returns t
|
when a sibling was found. When none is found, return nil and don't
|
move point."
|
(let ((fun (if previous 're-search-backward 're-search-forward))
|
(pos (point))
|
(re org-outline-regexp-bol)
|
level l)
|
(when (ignore-errors (org-back-to-heading t))
|
(setq level (funcall outline-level))
|
(catch 'exit
|
(or previous (forward-char 1))
|
(while (funcall fun re nil t)
|
(setq l (funcall outline-level))
|
(when (< l level) (goto-char pos) (throw 'exit nil))
|
(when (= l level) (goto-char (match-beginning 0)) (throw 'exit t)))
|
(goto-char pos)
|
nil))))
|
|
(defun org-show-siblings ()
|
"Show all siblings of the current headline."
|
(save-excursion
|
(while (org-goto-sibling) (org-flag-heading nil)))
|
(save-excursion
|
(while (org-goto-sibling 'previous)
|
(org-flag-heading nil))))
|
|
(defun org-goto-first-child ()
|
"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 org-outline-regexp-bol))
|
(when (ignore-errors (org-back-to-heading t))
|
(setq level (outline-level))
|
(forward-char 1)
|
(if (and (re-search-forward re nil t) (> (outline-level) level))
|
(progn (goto-char (match-beginning 0)) t)
|
(goto-char pos) nil))))
|
|
(defun org-show-hidden-entry ()
|
"Show an entry where even the heading is hidden."
|
(save-excursion
|
(org-show-entry)))
|
|
(defun org-flag-heading (flag &optional entry)
|
"Flag the current heading. FLAG non-nil means make invisible.
|
When ENTRY is non-nil, show the entire entry."
|
(save-excursion
|
(org-back-to-heading t)
|
;; Check if we should show the entire entry
|
(if entry
|
(progn
|
(org-show-entry)
|
(save-excursion
|
(and (outline-next-heading)
|
(org-flag-heading nil))))
|
(outline-flag-region (max (point-min) (1- (point)))
|
(save-excursion (outline-end-of-heading) (point))
|
flag))))
|
|
(defun org-get-next-sibling ()
|
"Move to next heading of the same level, and return point.
|
If there is no such heading, return nil.
|
This is like outline-next-sibling, but invisible headings are ok."
|
(let ((level (funcall outline-level)))
|
(outline-next-heading)
|
(while (and (not (eobp)) (> (funcall outline-level) level))
|
(outline-next-heading))
|
(unless (or (eobp) (< (funcall outline-level) level))
|
(point))))
|
|
(defun org-get-last-sibling ()
|
"Move to previous heading of the same level, and return point.
|
If there is no such heading, return nil."
|
(let ((opoint (point))
|
(level (funcall outline-level)))
|
(outline-previous-heading)
|
(when (and (/= (point) opoint) (outline-on-heading-p t))
|
(while (and (> (funcall outline-level) level)
|
(not (bobp)))
|
(outline-previous-heading))
|
(unless (< (funcall outline-level) level)
|
(point)))))
|
|
(defun org-end-of-subtree (&optional invisible-ok to-heading)
|
"Goto to the end of a subtree."
|
;; This contains an exact copy of the original function, but it uses
|
;; `org-back-to-heading', to make it work also in invisible
|
;; trees. And is uses an invisible-ok argument.
|
;; Under Emacs this is not needed, but the old outline.el needs this fix.
|
;; Furthermore, when used inside Org, finding the end of a large subtree
|
;; with many children and grandchildren etc, this can be much faster
|
;; than the outline version.
|
(org-back-to-heading invisible-ok)
|
(let ((first t)
|
(level (funcall outline-level)))
|
(if (and (derived-mode-p 'org-mode) (< level 1000))
|
;; A true heading (not a plain list item), in Org
|
;; This means we can easily find the end by looking
|
;; only for the right number of stars. Using a regexp to do
|
;; this is so much faster than using a Lisp loop.
|
(let ((re (concat "^\\*\\{1," (int-to-string level) "\\} ")))
|
(forward-char 1)
|
(and (re-search-forward re nil 'move) (beginning-of-line 1)))
|
;; something else, do it the slow way
|
(while (and (not (eobp))
|
(or first (> (funcall outline-level) level)))
|
(setq first nil)
|
(outline-next-heading)))
|
(unless to-heading
|
(when (memq (preceding-char) '(?\n ?\^M))
|
;; Go to end of line before heading
|
(forward-char -1)
|
(when (memq (preceding-char) '(?\n ?\^M))
|
;; leave blank line before heading
|
(forward-char -1)))))
|
(point))
|
|
(defun org-end-of-meta-data (&optional full)
|
"Skip planning line and properties drawer in current entry.
|
When optional argument FULL is non-nil, also skip empty lines,
|
clocking lines and regular drawers at the beginning of the
|
entry."
|
(org-back-to-heading t)
|
(forward-line)
|
(when (looking-at-p org-planning-line-re) (forward-line))
|
(when (looking-at org-property-drawer-re)
|
(goto-char (match-end 0))
|
(forward-line))
|
(when (and full (not (org-at-heading-p)))
|
(catch 'exit
|
(let ((end (save-excursion (outline-next-heading) (point)))
|
(re (concat "[ \t]*$" "\\|" org-clock-line-re)))
|
(while (not (eobp))
|
(cond ((looking-at-p org-drawer-regexp)
|
(if (re-search-forward "^[ \t]*:END:[ \t]*$" end t)
|
(forward-line)
|
(throw 'exit t)))
|
((looking-at-p re) (forward-line))
|
(t (throw 'exit t))))))))
|
|
(defun org-forward-heading-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.
|
Normally this only looks at visible headings, but when INVISIBLE-OK is
|
non-nil it will also look at invisible ones."
|
(interactive "p")
|
(let ((backward? (and arg (< arg 0))))
|
(if (org-before-first-heading-p)
|
(if backward? (goto-char (point-min)) (outline-next-heading))
|
(org-back-to-heading invisible-ok)
|
(unless backward? (end-of-line)) ;do not match current headline
|
(let ((level (- (match-end 0) (match-beginning 0) 1))
|
(f (if backward? #'re-search-backward #'re-search-forward))
|
(count (if arg (abs arg) 1))
|
(result (point)))
|
(while (and (> count 0)
|
(funcall f org-outline-regexp-bol nil 'move))
|
(let ((l (- (match-end 0) (match-beginning 0) 1)))
|
(cond ((< l level) (setq count 0))
|
((and (= l level)
|
(or invisible-ok
|
(not (org-invisible-p
|
(line-beginning-position)))))
|
(cl-decf count)
|
(when (= l level) (setq result (point)))))))
|
(goto-char result))
|
(beginning-of-line))))
|
|
(defun org-backward-heading-same-level (arg &optional invisible-ok)
|
"Move backward to the ARG'th subheading at same level as this one.
|
Stop at the first and last subheadings of a superior heading."
|
(interactive "p")
|
(org-forward-heading-same-level (if arg (- arg) -1) invisible-ok))
|
|
(defun org-next-visible-heading (arg)
|
"Move to the next visible heading.
|
|
This function wraps `outline-next-visible-heading' with
|
`org-with-limited-levels' in order to skip over inline tasks and
|
respect customization of `org-odd-levels-only'."
|
(interactive "p")
|
(org-with-limited-levels
|
(outline-next-visible-heading arg)))
|
|
(defun org-previous-visible-heading (arg)
|
"Move to the previous visible heading.
|
|
This function wraps `outline-previous-visible-heading' with
|
`org-with-limited-levels' in order to skip over inline tasks and
|
respect customization of `org-odd-levels-only'."
|
(interactive "p")
|
(org-with-limited-levels
|
(outline-previous-visible-heading arg)))
|
|
(defun org-next-block (arg &optional backward block-regexp)
|
"Jump to the next block.
|
|
With a prefix argument ARG, jump forward ARG many blocks.
|
|
When BACKWARD is non-nil, jump to the previous block.
|
|
When BLOCK-REGEXP is non-nil, use this regexp to find blocks.
|
Match data is set according to this regexp when the function
|
returns.
|
|
Return point at beginning of the opening line of found block.
|
Throw an error if no block is found."
|
(interactive "p")
|
(let ((re (or block-regexp "^[ \t]*#\\+BEGIN"))
|
(case-fold-search t)
|
(search-fn (if backward #'re-search-backward #'re-search-forward))
|
(count (or arg 1))
|
(origin (point))
|
last-element)
|
(if backward (beginning-of-line) (end-of-line))
|
(while (and (> count 0) (funcall search-fn re nil t))
|
(let ((element (save-excursion
|
(goto-char (match-beginning 0))
|
(save-match-data (org-element-at-point)))))
|
(when (and (memq (org-element-type element)
|
'(center-block comment-block dynamic-block
|
example-block export-block quote-block
|
special-block src-block verse-block))
|
(<= (match-beginning 0)
|
(org-element-property :post-affiliated element)))
|
(setq last-element element)
|
(cl-decf count))))
|
(if (= count 0)
|
(prog1 (goto-char (org-element-property :post-affiliated last-element))
|
(save-match-data (org-show-context)))
|
(goto-char origin)
|
(user-error "No %s code blocks" (if backward "previous" "further")))))
|
|
(defun org-previous-block (arg &optional block-regexp)
|
"Jump to the previous block.
|
With a prefix argument ARG, jump backward ARG many source blocks.
|
When BLOCK-REGEXP is non-nil, use this regexp to find blocks."
|
(interactive "p")
|
(org-next-block arg t block-regexp))
|
|
(defun org-forward-paragraph ()
|
"Move forward to beginning of next paragraph or equivalent.
|
|
The function moves point to the beginning of the next visible
|
structural element, which can be a paragraph, a table, a list
|
item, etc. It also provides some special moves for convenience:
|
|
- On an affiliated keyword, jump to the beginning of the
|
relative element.
|
- On an item or a footnote definition, move to the second
|
element inside, if any.
|
- On a table or a property drawer, jump after it.
|
- On a verse or source block, stop after blank lines."
|
(interactive)
|
(unless (eobp)
|
(let* ((deactivate-mark nil)
|
(element (org-element-at-point))
|
(type (org-element-type element))
|
(post-affiliated (org-element-property :post-affiliated element))
|
(contents-begin (org-element-property :contents-begin element))
|
(contents-end (org-element-property :contents-end element))
|
(end (let ((end (org-element-property :end element)) (parent element))
|
(while (and (setq parent (org-element-property :parent parent))
|
(= (org-element-property :contents-end parent) end))
|
(setq end (org-element-property :end parent)))
|
end)))
|
(cond ((not element)
|
(skip-chars-forward " \r\t\n")
|
(or (eobp) (beginning-of-line)))
|
;; On affiliated keywords, move to element's beginning.
|
((< (point) post-affiliated)
|
(goto-char post-affiliated))
|
;; At a table row, move to the end of the table. Similarly,
|
;; at a node property, move to the end of the property
|
;; drawer.
|
((memq type '(node-property table-row))
|
(goto-char (org-element-property
|
:end (org-element-property :parent element))))
|
((memq type '(property-drawer table)) (goto-char end))
|
;; Consider blank lines as separators in verse and source
|
;; blocks to ease editing.
|
((memq type '(src-block verse-block))
|
(when (eq type 'src-block)
|
(setq contents-end
|
(save-excursion (goto-char end)
|
(skip-chars-backward " \r\t\n")
|
(line-beginning-position))))
|
(beginning-of-line)
|
(when (looking-at "[ \t]*$") (skip-chars-forward " \r\t\n"))
|
(if (not (re-search-forward "^[ \t]*$" contents-end t))
|
(goto-char end)
|
(skip-chars-forward " \r\t\n")
|
(if (= (point) contents-end) (goto-char end)
|
(beginning-of-line))))
|
;; With no contents, just skip element.
|
((not contents-begin) (goto-char end))
|
;; If contents are invisible, skip the element altogether.
|
((org-invisible-p (line-end-position))
|
(cl-case type
|
(headline
|
(org-with-limited-levels (outline-next-visible-heading 1)))
|
;; At a plain list, make sure we move to the next item
|
;; instead of skipping the whole list.
|
(plain-list (forward-char)
|
(org-forward-paragraph))
|
(otherwise (goto-char end))))
|
((>= (point) contents-end) (goto-char end))
|
((>= (point) contents-begin)
|
;; This can only happen on paragraphs and plain lists.
|
(cl-case type
|
(paragraph (goto-char end))
|
;; At a plain list, try to move to second element in
|
;; first item, if possible.
|
(plain-list (end-of-line)
|
(org-forward-paragraph))))
|
;; When contents start on the middle of a line (e.g. in
|
;; items and footnote definitions), try to reach first
|
;; element starting after current line.
|
((> (line-end-position) contents-begin)
|
(end-of-line)
|
(org-forward-paragraph))
|
(t (goto-char contents-begin))))))
|
|
(defun org-backward-paragraph ()
|
"Move backward to start of previous paragraph or equivalent.
|
|
The function moves point to the beginning of the current
|
structural element, which can be a paragraph, a table, a list
|
item, etc., or to the beginning of the previous visible one if
|
point is already there. It also provides some special moves for
|
convenience:
|
|
- On an affiliated keyword, jump to the first one.
|
- On a table or a property drawer, move to its beginning.
|
- On comment, example, export, src and verse blocks, stop
|
before blank lines."
|
(interactive)
|
(unless (bobp)
|
(let* ((deactivate-mark nil)
|
(element (org-element-at-point))
|
(type (org-element-type element))
|
(contents-end (org-element-property :contents-end element))
|
(post-affiliated (org-element-property :post-affiliated element))
|
(begin (org-element-property :begin element))
|
(special? ;blocks handled specially
|
(memq type '(comment-block example-block export-block src-block
|
verse-block)))
|
(contents-begin
|
(if special?
|
;; These types have no proper contents. Fake line
|
;; below the block opening line as contents beginning.
|
(save-excursion (goto-char begin) (line-beginning-position 2))
|
(org-element-property :contents-begin element))))
|
(cond
|
((not element) (goto-char (point-min)))
|
((= (point) begin)
|
(backward-char)
|
(org-backward-paragraph))
|
((<= (point) post-affiliated) (goto-char begin))
|
;; Special behavior: on a table or a property drawer, move to
|
;; its beginning.
|
((memq type '(node-property table-row))
|
(goto-char (org-element-property
|
:post-affiliated (org-element-property :parent element))))
|
(special?
|
(if (<= (point) contents-begin) (goto-char post-affiliated)
|
;; Inside a verse block, see blank lines as paragraph
|
;; separators.
|
(let ((origin (point)))
|
(skip-chars-backward " \r\t\n" contents-begin)
|
(when (re-search-backward "^[ \t]*$" contents-begin 'move)
|
(skip-chars-forward " \r\t\n" origin)
|
(if (= (point) origin) (goto-char contents-begin)
|
(beginning-of-line))))))
|
((eq type 'paragraph) (goto-char contents-begin)
|
;; When at first paragraph in an item or a footnote definition,
|
;; move directly to beginning of line.
|
(let ((parent-contents
|
(org-element-property
|
:contents-begin (org-element-property :parent element))))
|
(when (and parent-contents (= parent-contents contents-begin))
|
(beginning-of-line))))
|
;; At the end of a greater element, move to the beginning of
|
;; the last element within.
|
((and contents-end (>= (point) contents-end))
|
(goto-char (1- contents-end))
|
(org-backward-paragraph))
|
(t (goto-char (or post-affiliated begin))))
|
;; Ensure we never leave point invisible.
|
(when (org-invisible-p (point)) (beginning-of-visual-line)))))
|
|
(defun org-forward-element ()
|
"Move forward by one element.
|
Move to the next element at the same level, when possible."
|
(interactive)
|
(cond ((eobp) (user-error "Cannot move further down"))
|
((org-with-limited-levels (org-at-heading-p))
|
(let ((origin (point)))
|
(goto-char (org-end-of-subtree nil t))
|
(unless (org-with-limited-levels (org-at-heading-p))
|
(goto-char origin)
|
(user-error "Cannot move further down"))))
|
(t
|
(let* ((elem (org-element-at-point))
|
(end (org-element-property :end elem))
|
(parent (org-element-property :parent elem)))
|
(cond ((and parent (= (org-element-property :contents-end parent) end))
|
(goto-char (org-element-property :end parent)))
|
((integer-or-marker-p end) (goto-char end))
|
(t (message "No element at point")))))))
|
|
(defun org-backward-element ()
|
"Move backward by one element.
|
Move to the previous element at the same level, when possible."
|
(interactive)
|
(cond ((bobp) (user-error "Cannot move further up"))
|
((org-with-limited-levels (org-at-heading-p))
|
;; At a headline, move to the previous one, if any, or stay
|
;; here.
|
(let ((origin (point)))
|
(org-with-limited-levels (org-backward-heading-same-level 1))
|
;; When current headline has no sibling above, move to its
|
;; parent.
|
(when (= (point) origin)
|
(or (org-with-limited-levels (org-up-heading-safe))
|
(progn (goto-char origin)
|
(user-error "Cannot move further up"))))))
|
(t
|
(let* ((elem (org-element-at-point))
|
(beg (org-element-property :begin elem)))
|
(cond
|
;; Move to beginning of current element if point isn't
|
;; there already.
|
((null beg) (message "No element at point"))
|
((/= (point) beg) (goto-char beg))
|
(t (goto-char beg)
|
(skip-chars-backward " \r\t\n")
|
(unless (bobp)
|
(let ((prev (org-element-at-point)))
|
(goto-char (org-element-property :begin prev))
|
(while (and (setq prev (org-element-property :parent prev))
|
(<= (org-element-property :end prev) beg))
|
(goto-char (org-element-property :begin prev)))))))))))
|
|
(defun org-up-element ()
|
"Move to upper element."
|
(interactive)
|
(if (org-with-limited-levels (org-at-heading-p))
|
(unless (org-up-heading-safe) (user-error "No surrounding element"))
|
(let* ((elem (org-element-at-point))
|
(parent (org-element-property :parent elem)))
|
(if parent (goto-char (org-element-property :begin parent))
|
(if (org-with-limited-levels (org-before-first-heading-p))
|
(user-error "No surrounding element")
|
(org-with-limited-levels (org-back-to-heading)))))))
|
|
(defun org-down-element ()
|
"Move to inner element."
|
(interactive)
|
(let ((element (org-element-at-point)))
|
(cond
|
((memq (org-element-type element) '(plain-list table))
|
(goto-char (org-element-property :contents-begin element))
|
(forward-char))
|
((memq (org-element-type element) org-element-greater-elements)
|
;; If contents are hidden, first disclose them.
|
(when (org-invisible-p (line-end-position)) (org-cycle))
|
(goto-char (or (org-element-property :contents-begin element)
|
(user-error "No content for this element"))))
|
(t (user-error "No inner element")))))
|
|
(defun org-drag-element-backward ()
|
"Move backward element at point."
|
(interactive)
|
(let ((elem (or (org-element-at-point)
|
(user-error "No element at point"))))
|
(if (eq (org-element-type elem) 'headline)
|
;; Preserve point when moving a whole tree, even if point was
|
;; on blank lines below the headline.
|
(let ((offset (skip-chars-backward " \t\n")))
|
(unwind-protect (org-move-subtree-up)
|
(forward-char (- offset))))
|
(let ((prev-elem
|
(save-excursion
|
(goto-char (org-element-property :begin elem))
|
(skip-chars-backward " \r\t\n")
|
(unless (bobp)
|
(let* ((beg (org-element-property :begin elem))
|
(prev (org-element-at-point))
|
(up prev))
|
(while (and (setq up (org-element-property :parent up))
|
(<= (org-element-property :end up) beg))
|
(setq prev up))
|
prev)))))
|
;; Error out if no previous element or previous element is
|
;; a parent of the current one.
|
(if (or (not prev-elem) (org-element-nested-p elem prev-elem))
|
(user-error "Cannot drag element backward")
|
(let ((pos (point)))
|
(org-element-swap-A-B prev-elem elem)
|
(goto-char (+ (org-element-property :begin prev-elem)
|
(- pos (org-element-property :begin elem))))))))))
|
|
(defun org-drag-element-forward ()
|
"Move forward element at point."
|
(interactive)
|
(let* ((pos (point))
|
(elem (or (org-element-at-point)
|
(user-error "No element at point"))))
|
(when (= (point-max) (org-element-property :end elem))
|
(user-error "Cannot drag element forward"))
|
(goto-char (org-element-property :end elem))
|
(let ((next-elem (org-element-at-point)))
|
(when (or (org-element-nested-p elem next-elem)
|
(and (eq (org-element-type next-elem) 'headline)
|
(not (eq (org-element-type elem) 'headline))))
|
(goto-char pos)
|
(user-error "Cannot drag element forward"))
|
;; Compute new position of point: it's shifted by NEXT-ELEM
|
;; body's length (without final blanks) and by the length of
|
;; blanks between ELEM and NEXT-ELEM.
|
(let ((size-next (- (save-excursion
|
(goto-char (org-element-property :end next-elem))
|
(skip-chars-backward " \r\t\n")
|
(forward-line)
|
;; Small correction if buffer doesn't end
|
;; with a newline character.
|
(if (and (eolp) (not (bolp))) (1+ (point)) (point)))
|
(org-element-property :begin next-elem)))
|
(size-blank (- (org-element-property :end elem)
|
(save-excursion
|
(goto-char (org-element-property :end elem))
|
(skip-chars-backward " \r\t\n")
|
(forward-line)
|
(point)))))
|
(org-element-swap-A-B elem next-elem)
|
(goto-char (+ pos size-next size-blank))))))
|
|
(defun org-drag-line-forward (arg)
|
"Drag the line at point ARG lines forward."
|
(interactive "p")
|
(dotimes (_ (abs arg))
|
(let ((c (current-column)))
|
(if (< 0 arg)
|
(progn
|
(beginning-of-line 2)
|
(transpose-lines 1)
|
(beginning-of-line 0))
|
(transpose-lines 1)
|
(beginning-of-line -1))
|
(org-move-to-column c))))
|
|
(defun org-drag-line-backward (arg)
|
"Drag the line at point ARG lines backward."
|
(interactive "p")
|
(org-drag-line-forward (- arg)))
|
|
(defun org-mark-element ()
|
"Put point at beginning of this element, mark at end.
|
|
Interactively, if this command is repeated or (in Transient Mark
|
mode) if the mark is active, it marks the next element after the
|
ones already marked."
|
(interactive)
|
(let (deactivate-mark)
|
(if (and (called-interactively-p 'any)
|
(or (and (eq last-command this-command) (mark t))
|
(and transient-mark-mode mark-active)))
|
(set-mark
|
(save-excursion
|
(goto-char (mark))
|
(goto-char (org-element-property :end (org-element-at-point)))))
|
(let ((element (org-element-at-point)))
|
(end-of-line)
|
(push-mark (org-element-property :end element) t t)
|
(goto-char (org-element-property :begin element))))))
|
|
(defun org-narrow-to-element ()
|
"Narrow buffer to current element."
|
(interactive)
|
(let ((elem (org-element-at-point)))
|
(cond
|
((eq (car elem) 'headline)
|
(narrow-to-region
|
(org-element-property :begin elem)
|
(org-element-property :end elem)))
|
((memq (car elem) org-element-greater-elements)
|
(narrow-to-region
|
(org-element-property :contents-begin elem)
|
(org-element-property :contents-end elem)))
|
(t
|
(narrow-to-region
|
(org-element-property :begin elem)
|
(org-element-property :end elem))))))
|
|
(defun org-transpose-element ()
|
"Transpose current and previous elements, keeping blank lines between.
|
Point is moved after both elements."
|
(interactive)
|
(org-skip-whitespace)
|
(let ((end (org-element-property :end (org-element-at-point))))
|
(org-drag-element-backward)
|
(goto-char end)))
|
|
(defun org-unindent-buffer ()
|
"Un-indent the visible part of the buffer.
|
Relative indentation (between items, inside blocks, etc.) isn't
|
modified."
|
(interactive)
|
(unless (eq major-mode 'org-mode)
|
(user-error "Cannot un-indent a buffer not in Org mode"))
|
(letrec ((parse-tree (org-element-parse-buffer 'greater-element))
|
(unindent-tree
|
(lambda (contents)
|
(dolist (element (reverse contents))
|
(if (memq (org-element-type element) '(headline section))
|
(funcall unindent-tree (org-element-contents element))
|
(save-excursion
|
(save-restriction
|
(narrow-to-region
|
(org-element-property :begin element)
|
(org-element-property :end element))
|
(org-do-remove-indentation))))))))
|
(funcall unindent-tree (org-element-contents parse-tree))))
|
|
(defun org-show-children (&optional level)
|
"Show all direct subheadings of this heading.
|
Prefix arg LEVEL is how many levels below the current level
|
should be shown. Default is enough to cause the following
|
heading to appear."
|
(interactive "p")
|
;; If `orgstruct-mode' is active, use the slower version.
|
(if orgstruct-mode (call-interactively #'outline-show-children)
|
(save-excursion
|
(org-back-to-heading t)
|
(let* ((current-level (funcall outline-level))
|
(max-level (org-get-valid-level
|
current-level
|
(if level (prefix-numeric-value level) 1)))
|
(end (save-excursion (org-end-of-subtree t t)))
|
(regexp-fmt "^\\*\\{%d,%s\\}\\(?: \\|$\\)")
|
(past-first-child nil)
|
;; Make sure to skip inlinetasks.
|
(re (format regexp-fmt
|
current-level
|
(cond
|
((not (featurep 'org-inlinetask)) "")
|
(org-odd-levels-only (- (* 2 org-inlinetask-min-level)
|
3))
|
(t (1- org-inlinetask-min-level))))))
|
;; Display parent heading.
|
(outline-flag-region (line-end-position 0) (line-end-position) nil)
|
(forward-line)
|
;; Display children. First child may be deeper than expected
|
;; MAX-LEVEL. Since we want to display it anyway, adjust
|
;; MAX-LEVEL accordingly.
|
(while (re-search-forward re end t)
|
(unless past-first-child
|
(setq re (format regexp-fmt
|
current-level
|
(max (funcall outline-level) max-level)))
|
(setq past-first-child t))
|
(outline-flag-region
|
(line-end-position 0) (line-end-position) nil))))))
|
|
(defun org-show-subtree ()
|
"Show everything after this heading at deeper levels."
|
(interactive)
|
(outline-flag-region
|
(point)
|
(save-excursion
|
(org-end-of-subtree t t))
|
nil))
|
|
(defun org-show-entry ()
|
"Show the body directly following this heading.
|
Show the heading too, if it is currently invisible."
|
(interactive)
|
(save-excursion
|
(ignore-errors
|
(org-back-to-heading t)
|
(outline-flag-region
|
(max (point-min) (1- (point)))
|
(save-excursion
|
(if (re-search-forward
|
(concat "[\r\n]\\(" org-outline-regexp "\\)") nil t)
|
(match-beginning 1)
|
(point-max)))
|
nil)
|
(org-cycle-hide-drawers 'children))))
|
|
(defun org-make-options-regexp (kwds &optional extra)
|
"Make a regular expression for keyword lines.
|
KWDS is a list of keywords, as strings. Optional argument EXTRA,
|
when non-nil, is a regexp matching keywords names."
|
(concat "^[ \t]*#\\+\\("
|
(regexp-opt kwds)
|
(and extra (concat (and kwds "\\|") extra))
|
"\\):[ \t]*\\(.*\\)"))
|
|
;;;; Integration with and fixes for other packages
|
|
;;; Imenu support
|
|
(defvar-local org-imenu-markers nil
|
"All markers currently used by Imenu.")
|
|
(defun org-imenu-new-marker (&optional pos)
|
"Return a new marker for use by Imenu, and remember the marker."
|
(let ((m (make-marker)))
|
(move-marker m (or pos (point)))
|
(push m org-imenu-markers)
|
m))
|
|
(defun org-imenu-get-tree ()
|
"Produce the index for Imenu."
|
(dolist (x org-imenu-markers) (move-marker x nil))
|
(setq org-imenu-markers nil)
|
(let* ((case-fold-search nil)
|
(n org-imenu-depth)
|
(re (concat "^" (org-get-limited-outline-regexp)))
|
(subs (make-vector (1+ n) nil))
|
(last-level 0)
|
m level head0 head)
|
(org-with-wide-buffer
|
(goto-char (point-max))
|
(while (re-search-backward re nil t)
|
(setq level (org-reduced-level (funcall outline-level)))
|
(when (and (<= level n)
|
(looking-at org-complex-heading-regexp)
|
(setq head0 (match-string-no-properties 4)))
|
(setq head (org-link-display-format head0)
|
m (org-imenu-new-marker))
|
(org-add-props head nil 'org-imenu-marker m 'org-imenu t)
|
(if (>= level last-level)
|
(push (cons head m) (aref subs level))
|
(push (cons head (aref subs (1+ level))) (aref subs level))
|
(cl-loop for i from (1+ level) to n do (aset subs i nil)))
|
(setq last-level level))))
|
(aref subs 1)))
|
|
(eval-after-load "imenu"
|
'(progn
|
(add-hook 'imenu-after-jump-hook
|
(lambda ()
|
(when (derived-mode-p 'org-mode)
|
(org-show-context 'org-goto))))))
|
|
(defun org-link-display-format (s)
|
"Replace links in string S with their description.
|
If there is no description, use the link target."
|
(save-match-data
|
(replace-regexp-in-string
|
org-bracket-link-analytic-regexp
|
(lambda (m)
|
(if (match-end 5) (match-string 5 m)
|
(concat (match-string 1 m) (match-string 3 m))))
|
s nil t)))
|
|
(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)
|
"Overlay marking the agenda restriction line in speedbar.")
|
(overlay-put org-speedbar-restriction-lock-overlay
|
'face 'org-agenda-restriction-lock)
|
(overlay-put org-speedbar-restriction-lock-overlay
|
'help-echo "Agendas are currently limited to this item.")
|
(delete-overlay org-speedbar-restriction-lock-overlay)
|
|
(defun org-speedbar-set-agenda-restriction ()
|
"Restrict future agenda commands to the location at point in speedbar.
|
To get rid of the restriction, use `\\[org-agenda-remove-restriction-lock]'."
|
(interactive)
|
(require 'org-agenda)
|
(let (p m tp np dir txt)
|
(cond
|
((setq p (text-property-any (point-at-bol) (point-at-eol)
|
'org-imenu t))
|
(setq m (get-text-property p 'org-imenu-marker))
|
(with-current-buffer (marker-buffer m)
|
(goto-char m)
|
(org-agenda-set-restriction-lock 'subtree)))
|
((setq p (text-property-any (point-at-bol) (point-at-eol)
|
'speedbar-function 'speedbar-find-file))
|
(setq tp (previous-single-property-change
|
(1+ p) 'speedbar-function)
|
np (next-single-property-change
|
tp 'speedbar-function)
|
dir (speedbar-line-directory)
|
txt (buffer-substring-no-properties (or tp (point-min))
|
(or np (point-max))))
|
(with-current-buffer (find-file-noselect
|
(let ((default-directory dir))
|
(expand-file-name txt)))
|
(unless (derived-mode-p 'org-mode)
|
(user-error "Cannot restrict to non-Org mode file"))
|
(org-agenda-set-restriction-lock 'file)))
|
(t (user-error "Don't know how to restrict Org mode agenda")))
|
(move-overlay org-speedbar-restriction-lock-overlay
|
(point-at-bol) (point-at-eol))
|
(setq current-prefix-arg nil)
|
(org-agenda-maybe-redo)))
|
|
(defvar speedbar-file-key-map)
|
(declare-function speedbar-add-supported-extension "speedbar" (extension))
|
(eval-after-load "speedbar"
|
'(progn
|
(speedbar-add-supported-extension ".org")
|
(define-key speedbar-file-key-map "<" 'org-speedbar-set-agenda-restriction)
|
(define-key speedbar-file-key-map "\C-c\C-x<" 'org-speedbar-set-agenda-restriction)
|
(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 (derived-mode-p 'org-mode) (org-show-context 'org-goto))))))
|
|
;;; Fixes and Hacks for problems with other packages
|
|
(defun org--flyspell-object-check-p (element)
|
"Non-nil when Flyspell can check object at point.
|
ELEMENT is the element at point."
|
(let ((object (save-excursion
|
(when (looking-at-p "\\>") (backward-char))
|
(org-element-context element))))
|
(cl-case (org-element-type object)
|
;; Prevent checks in links due to keybinding conflict with
|
;; Flyspell.
|
((code entity export-snippet inline-babel-call
|
inline-src-block line-break latex-fragment link macro
|
statistics-cookie target timestamp verbatim)
|
nil)
|
(footnote-reference
|
;; Only in inline footnotes, within the definition.
|
(and (eq (org-element-property :type object) 'inline)
|
(< (save-excursion
|
(goto-char (org-element-property :begin object))
|
(search-forward ":" nil t 2))
|
(point))))
|
(otherwise t))))
|
|
(defun org-mode-flyspell-verify ()
|
"Function used for `flyspell-generic-check-word-predicate'."
|
(if (org-at-heading-p)
|
;; At a headline or an inlinetask, check title only. This is
|
;; faster than relying on `org-element-at-point'.
|
(and (save-excursion (beginning-of-line)
|
(and (let ((case-fold-search t))
|
(not (looking-at-p "\\*+ END[ \t]*$")))
|
(let ((case-fold-search nil))
|
(looking-at org-complex-heading-regexp))))
|
(match-beginning 4)
|
(>= (point) (match-beginning 4))
|
(or (not (match-beginning 5))
|
(< (point) (match-beginning 5))))
|
(let* ((element (org-element-at-point))
|
(post-affiliated (org-element-property :post-affiliated element)))
|
(cond
|
;; Ignore checks in all affiliated keywords but captions.
|
((< (point) post-affiliated)
|
(and (save-excursion
|
(beginning-of-line)
|
(let ((case-fold-search t)) (looking-at "[ \t]*#\\+CAPTION:")))
|
(> (point) (match-end 0))
|
(org--flyspell-object-check-p element)))
|
;; Ignore checks in LOGBOOK (or equivalent) drawer.
|
((let ((log (org-log-into-drawer)))
|
(and log
|
(let ((drawer (org-element-lineage element '(drawer))))
|
(and drawer
|
(eq (compare-strings
|
log nil nil
|
(org-element-property :drawer-name drawer) nil nil t)
|
t)))))
|
nil)
|
(t
|
(cl-case (org-element-type element)
|
((comment quote-section) t)
|
(comment-block
|
;; Allow checks between block markers, not on them.
|
(and (> (line-beginning-position) post-affiliated)
|
(save-excursion
|
(end-of-line)
|
(skip-chars-forward " \r\t\n")
|
(< (point) (org-element-property :end element)))))
|
;; Arbitrary list of keywords where checks are meaningful.
|
;; Make sure point is on the value part of the element.
|
(keyword
|
(and (member (org-element-property :key element)
|
'("DESCRIPTION" "TITLE"))
|
(save-excursion
|
(search-backward ":" (line-beginning-position) t))))
|
;; Check is globally allowed in paragraphs verse blocks and
|
;; table rows (after affiliated keywords) but some objects
|
;; must not be affected.
|
((paragraph table-row verse-block)
|
(let ((cbeg (org-element-property :contents-begin element))
|
(cend (org-element-property :contents-end element)))
|
(and cbeg (>= (point) cbeg) (< (point) cend)
|
(org--flyspell-object-check-p element))))))))))
|
(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify)
|
|
(defun org-remove-flyspell-overlays-in (beg end)
|
"Remove flyspell overlays in region."
|
(and (bound-and-true-p flyspell-mode)
|
(fboundp 'flyspell-delete-region-overlays)
|
(flyspell-delete-region-overlays beg end)))
|
|
(defvar flyspell-delayed-commands)
|
(eval-after-load "flyspell"
|
'(add-to-list 'flyspell-delayed-commands 'org-self-insert-command))
|
|
;; Make `bookmark-jump' shows the jump location if it was hidden.
|
(eval-after-load "bookmark"
|
'(if (boundp 'bookmark-after-jump-hook)
|
;; We can use the hook
|
(add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide)
|
;; Hook not available, use advice
|
(defadvice bookmark-jump (after org-make-visible activate)
|
"Make the position visible."
|
(org-bookmark-jump-unhide))))
|
|
;; Make sure saveplace shows the location if it was hidden
|
(eval-after-load "saveplace"
|
'(defadvice save-place-find-file-hook (after org-make-visible activate)
|
"Make the position visible."
|
(org-bookmark-jump-unhide)))
|
|
;; Make sure ecb shows the location if it was hidden
|
(eval-after-load "ecb"
|
'(defadvice ecb-method-clicked (after esf/org-show-context activate)
|
"Make hierarchy visible when jumping into location from ECB tree buffer."
|
(when (derived-mode-p 'org-mode)
|
(org-show-context))))
|
|
(defun org-bookmark-jump-unhide ()
|
"Unhide the current position, to show the bookmark location."
|
(and (derived-mode-p 'org-mode)
|
(or (org-invisible-p)
|
(save-excursion (goto-char (max (point-min) (1- (point))))
|
(org-invisible-p)))
|
(org-show-context 'bookmark-jump)))
|
|
(defun org-mark-jump-unhide ()
|
"Make the point visible with `org-show-context' after jumping to the mark."
|
(when (and (derived-mode-p 'org-mode)
|
(org-invisible-p))
|
(org-show-context 'mark-goto)))
|
|
(eval-after-load "simple"
|
'(defadvice pop-to-mark-command (after org-make-visible activate)
|
"Make the point visible with `org-show-context'."
|
(org-mark-jump-unhide)))
|
|
(eval-after-load "simple"
|
'(defadvice exchange-point-and-mark (after org-make-visible activate)
|
"Make the point visible with `org-show-context'."
|
(org-mark-jump-unhide)))
|
|
(eval-after-load "simple"
|
'(defadvice pop-global-mark (after org-make-visible activate)
|
"Make the point visible with `org-show-context'."
|
(org-mark-jump-unhide)))
|
|
;; Make session.el ignore our circular variable
|
(defvar session-globals-exclude)
|
(eval-after-load "session"
|
'(add-to-list 'session-globals-exclude 'org-mark-ring))
|
|
;;;; Finish up
|
|
(provide 'org)
|
|
(run-hooks 'org-load-hook)
|
|
;;; org.el ends here
|
