diff --git a/CONTRIB/README b/CONTRIB/README index 7531c64cb..30142591b 100644 --- a/CONTRIB/README +++ b/CONTRIB/README @@ -17,6 +17,7 @@ org-depend.el --- TODO dependencies for Org-mode org-elisp-symbol.el --- Org links to emacs-lisp symbols org-expiry.el --- expiry mechanism for Org entries org-id.el --- Global id's for identifying entries +org-iq.el --- Interactive modification of tags query org-irc.el --- Store links to IRC sessions. org-iswitchb.el --- use iswitchb to select Org buffer org-man.el --- Support for links to manpages in Org-mode diff --git a/CONTRIB/lisp/org-iq.el b/CONTRIB/lisp/org-iq.el new file mode 100644 index 000000000..a979cceb2 --- /dev/null +++ b/CONTRIB/lisp/org-iq.el @@ -0,0 +1,308 @@ +;;; org-interactive-query.el --- Interactive modification of agenda query +;; +;; Copyright 2007 Free Software Foundation, Inc. +;; +;; Author: Christopher League +;; Version: 1.0 +;; Keywords: org, wp +;; +;; This program 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, or (at your option) +;; any later version. +;; +;; This program 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 this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +;; +;;; Commentary: +;; + +;; This ibrary implements interactive modification of a tags/todo query +;; in the org-agenda. It adds 4 keys to the agenda +;; +;; / add a keyword as a positive selection criterion +;; \ add a keyword as a newgative selection criterion +;; = clear a keyword from the selection string +;; ; + +(require 'org) + +(org-defkey org-agenda-mode-map "=" 'org-agenda-query-clear-cmd) +(org-defkey org-agenda-mode-map "/" 'org-agenda-query-and-cmd) +(org-defkey org-agenda-mode-map ";" 'org-agenda-query-or-cmd) +(org-defkey org-agenda-mode-map "\\" 'org-agenda-query-not-cmd) + +;;; Agenda interactive query manipulation + +(defcustom org-agenda-query-selection-single-key t + "Non-nil means, query manipulation exits after first change. +When nil, you have to press RET to exit it. +During query 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-agenda + :type '(choice + (const :tag "No" nil) + (const :tag "Yes" t) + (const :tag "Expert" expert))) + +(defun org-agenda-query-selection (current op table &optional todo-table) + "Fast query manipulation with single keys. +CURRENT is the current query string, OP is the initial +operator (one of \"+|-=\"), 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 query string, or nil to +not change the current one." + (let* ((fulltable (append table todo-table)) + (maxlen (apply 'max (mapcar + (lambda (x) + (if (stringp (car x)) (string-width (car x)) 0)) + fulltable))) + (fwidth (+ maxlen 3 1 3)) + (ncol (/ (- (window-width) 4) fwidth)) + (expert (eq org-agenda-query-selection-single-key 'expert)) + (exit-after-next org-agenda-query-selection-single-key) + (done-keywords org-done-keywords) + tbl char cnt e groups ingroup + tg c2 c c1 ntable rtn) + (save-window-excursion + (if expert + (set-buffer (get-buffer-create " *Org tags*")) + (delete-other-windows) + (split-window-vertically) + (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*"))) + (erase-buffer) + (org-set-local 'org-done-keywords done-keywords) + (insert "Query: " current "\n") + (org-agenda-query-op-line op) + (insert "\n\n") + (org-fast-tag-show-exit exit-after-next) + (setq tbl fulltable char ?a cnt 0) + (while (setq e (pop tbl)) + (cond + ((equal e '(:startgroup)) + (push '() groups) (setq ingroup t) + (when (not (= cnt 0)) + (setq cnt 0) + (insert "\n")) + (insert "{ ")) + ((equal e '(:endgroup)) + (setq ingroup nil cnt 0) + (insert "}\n")) + (t + (setq tg (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))) + (if ingroup (push tg (car groups))) + (setq tg (org-add-props tg nil 'face + (cond + ((not (assoc tg table)) + (org-get-todo-face tg)) + (t nil)))) + (if (and (= cnt 0) (not ingroup)) (insert " ")) + (insert "[" c "] " tg (make-string + (- fwidth 4 (length tg)) ?\ )) + (push (cons tg c) ntable) + (when (= (setq cnt (1+ cnt)) ncol) + (insert "\n") + (if ingroup (insert " ")) + (setq cnt 0))))) + (setq ntable (nreverse ntable)) + (insert "\n") + (goto-char (point-min)) + (if (and (not expert) (fboundp 'fit-window-to-buffer)) + (fit-window-to-buffer)) + (setq rtn + (catch 'exit + (while t + (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free%s%s" + (if groups " [!] no groups" " [!]groups") + (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi"))) + (setq c (let ((inhibit-quit t)) (read-char-exclusive))) + (cond + ((= 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) + (split-window-vertically) + (org-switch-to-buffer-other-window " *Org tags*") + (and (fboundp 'fit-window-to-buffer) + (fit-window-to-buffer)))) + ((or (= c ?\C-g) + (and (= c ?q) (not (rassoc c ntable)))) + (setq quit-flag t)) + ((= c ?\ ) + (setq current "") + (if exit-after-next (setq exit-after-next 'now))) + ((= c ?\[) ; clear left + (org-agenda-query-decompose current) + (setq current (concat "/" (match-string 2 current))) + (if exit-after-next (setq exit-after-next 'now))) + ((= c ?\]) ; clear right + (org-agenda-query-decompose current) + (setq current (match-string 1 current)) + (if exit-after-next (setq exit-after-next 'now))) + ((= c ?\t) + (condition-case nil + (setq current (read-string "Query: " current)) + (quit)) + (if exit-after-next (setq exit-after-next 'now))) + ;; operators + ((or (= c ?/) (= c ?+)) (setq op "+")) + ((or (= c ?\;) (= c ?|)) (setq op "|")) + ((or (= c ?\\) (= c ?-)) (setq op "-")) + ((= c ?=) (setq op "=")) + ;; todos + ((setq e (rassoc c todo-table) tg (car e)) + (setq current (org-agenda-query-manip + current op groups 'todo tg)) + (if exit-after-next (setq exit-after-next 'now))) + ;; tags + ((setq e (rassoc c ntable) tg (car e)) + (setq current (org-agenda-query-manip + current op groups 'tag tg)) + (if exit-after-next (setq exit-after-next 'now)))) + (if (eq exit-after-next 'now) (throw 'exit t)) + (goto-char (point-min)) + (beginning-of-line 1) + (delete-region (point) (point-at-eol)) + (insert "Query: " current) + (beginning-of-line 2) + (delete-region (point) (point-at-eol)) + (org-agenda-query-op-line op) + (goto-char (point-min))))) + (if rtn current nil)))) + +(defun org-agenda-query-op-line (op) + (insert "Operator: " + (org-agenda-query-op-entry (equal op "+") "/+" "and") + (org-agenda-query-op-entry (equal op "|") ";|" "or") + (org-agenda-query-op-entry (equal op "-") "\\-" "not") + (org-agenda-query-op-entry (equal op "=") "=" "clear"))) + +(defun org-agenda-query-op-entry (matchp chars str) + (if matchp + (org-add-props (format "[%s %s] " chars (upcase str)) + nil 'face 'org-todo) + (format "[%s]%s " chars str))) + +(defun org-agenda-query-decompose (current) + (string-match "\\([^/]*\\)/?\\(.*\\)" current)) + +(defun org-agenda-query-clear (current prefix tag) + (if (string-match (concat prefix "\\b" (regexp-quote tag) "\\b") current) + (replace-match "" t t current) + current)) + +(defun org-agenda-query-manip (current op groups kind tag) + "Apply an operator to a query string and a tag. +CURRENT is the current query string, OP is the operator, GROUPS is a +list of lists of tags that are mutually exclusive. KIND is 'tag for a +regular tag, or 'todo for a TODO keyword, and TAG is the tag or +keyword string." + ;; If this tag is already in query string, remove it. + (setq current (org-agenda-query-clear current "[-\\+&|]?" tag)) + (if (equal op "=") current + ;; When using AND, also remove mutually exclusive tags. + (if (equal op "+") + (loop for g in groups do + (if (member tag g) + (mapc (lambda (x) + (setq current + (org-agenda-query-clear current "\\+" x))) + g)))) + ;; Decompose current query into q1 (tags) and q2 (TODOs). + (org-agenda-query-decompose current) + (let* ((q1 (match-string 1 current)) + (q2 (match-string 2 current))) + (cond + ((eq kind 'tag) + (concat q1 op tag "/" q2)) + ;; It's a TODO; when using AND, drop all other TODOs. + ((equal op "+") + (concat q1 "/+" tag)) + (t + (concat q1 "/" q2 op tag)))))) + +(defun org-agenda-query-global-todo-keys (&optional files) + "Return alist of all TODO keywords and their fast keys, in all FILES." + (let (alist) + (unless (and files (car files)) + (setq files (org-agenda-files))) + (save-excursion + (loop for f in files do + (set-buffer (find-file-noselect f)) + (loop for k in org-todo-key-alist do + (setq alist (org-agenda-query-merge-todo-key + alist k))))) + alist)) + +(defun org-agenda-query-merge-todo-key (alist entry) + (let (e) + (cond + ;; if this is not a keyword (:startgroup, etc), ignore it + ((not (stringp (car entry)))) + ;; if keyword already exists, replace char if it's null + ((setq e (assoc (car entry) alist)) + (when (null (cdr e)) (setcdr e (cdr entry)))) + ;; if char already exists, prepend keyword but drop char + ((rassoc (cdr entry) alist) + (message "TRACE POSITION 2") + (setq alist (cons (cons (car entry) nil) alist))) + ;; else, prepend COPY of entry + (t + (setq alist (cons (cons (car entry) (cdr entry)) alist))))) + alist) + +(defun org-agenda-query-generic-cmd (op) + "Activate query manipulation with OP as initial operator." + (let ((q (org-agenda-query-selection org-agenda-query-string op + org-tag-alist + (org-agenda-query-global-todo-keys)))) + (when q + (setq org-agenda-query-string q) + (org-agenda-redo)))) + +(defun org-agenda-query-clear-cmd () + "Activate query manipulation, to clear a tag from the string." + (interactive) + (org-agenda-query-generic-cmd "=")) + +(defun org-agenda-query-and-cmd () + "Activate query manipulation, initially using the AND (+) operator." + (interactive) + (org-agenda-query-generic-cmd "+")) + +(defun org-agenda-query-or-cmd () + "Activate query manipulation, initially using the OR (|) operator." + (interactive) + (org-agenda-query-generic-cmd "|")) + +(defun org-agenda-query-not-cmd () + "Activate query manipulation, initially using the NOT (-) operator." + (interactive) + (org-agenda-query-generic-cmd "-")) diff --git a/EXPERIMENTAL/interactive-query/org-interactive-query.patch.txt b/EXPERIMENTAL/interactive-query/org-interactive-query.patch.txt deleted file mode 100644 index 35c47a5a1..000000000 --- a/EXPERIMENTAL/interactive-query/org-interactive-query.patch.txt +++ /dev/null @@ -1,328 +0,0 @@ ---- org-vendor/org.el 2008-01-06 10:30:26.000000000 -0500 -+++ org/org.el 2008-01-12 17:19:15.000000000 -0500 -@@ -15078,7 +15078,8 @@ - (let ((org-last-tags-completion-table - (org-global-tags-completion-table))) - (setq match (completing-read -- "Match: " 'org-tags-completion-function nil nil nil -+ "Match: " 'org-tags-completion-function nil nil -+ org-agenda-query-string - 'org-tags-history)))) - - ;; Parse the string and create a lisp form -@@ -18812,6 +18813,7 @@ - (defvar org-agenda-follow-mode nil) - (defvar org-agenda-show-log nil) - (defvar org-agenda-redo-command nil) -+(defvar org-agenda-query-string nil) - (defvar org-agenda-mode-hook nil) - (defvar org-agenda-type nil) - (defvar org-agenda-force-single-file nil) -@@ -18947,6 +18949,10 @@ - (org-defkey org-agenda-mode-map [(right)] 'org-agenda-later) - (org-defkey org-agenda-mode-map [(left)] 'org-agenda-earlier) - (org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns) -+(org-defkey org-agenda-mode-map "=" 'org-agenda-query-clear-cmd) -+(org-defkey org-agenda-mode-map "/" 'org-agenda-query-and-cmd) -+(org-defkey org-agenda-mode-map ";" 'org-agenda-query-or-cmd) -+(org-defkey org-agenda-mode-map "\\" 'org-agenda-query-not-cmd) - - (defvar org-agenda-keymap (copy-keymap org-agenda-mode-map) - "Local keymap for agenda entries from Org-mode.") -@@ -20423,9 +20429,10 @@ - (setq matcher (org-make-tags-matcher match) - match (car matcher) matcher (cdr matcher)) - (org-prepare-agenda (concat "TAGS " match)) -+ (setq org-agenda-query-string match) - (setq org-agenda-redo-command - (list 'org-tags-view (list 'quote todo-only) -- (list 'if 'current-prefix-arg nil match))) -+ (list 'if 'current-prefix-arg nil 'org-agenda-query-string))) - (setq files (org-agenda-files) - rtnall nil) - (while (setq file (pop files)) -@@ -20461,7 +20468,7 @@ - (add-text-properties pos (1- (point)) (list 'face 'org-warning)) - (setq pos (point)) - (unless org-agenda-multi -- (insert "Press `C-u r' to search again with new search string\n")) -+ (insert "Press `C-u r' to enter new search string; use `/;\\=' to adjust interactively\n")) - (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))) - (when rtnall - (insert (org-finalize-agenda-entries rtnall) "\n")) -@@ -20471,6 +20478,275 @@ - (org-finalize-agenda) - (setq buffer-read-only t))) - -+;;; Agenda interactive query manipulation -+ -+(defcustom org-agenda-query-selection-single-key t -+ "Non-nil means, query manipulation exits after first change. -+When nil, you have to press RET to exit it. -+During query 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-agenda -+ :type '(choice -+ (const :tag "No" nil) -+ (const :tag "Yes" t) -+ (const :tag "Expert" expert))) -+ -+(defun org-agenda-query-selection (current op table &optional todo-table) -+ "Fast query manipulation with single keys. -+CURRENT is the current query string, OP is the initial -+operator (one of \"+|-=\"), 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 query string, or nil to -+not change the current one." -+ (let* ((fulltable (append table todo-table)) -+ (maxlen (apply 'max (mapcar -+ (lambda (x) -+ (if (stringp (car x)) (string-width (car x)) 0)) -+ fulltable))) -+ (fwidth (+ maxlen 3 1 3)) -+ (ncol (/ (- (window-width) 4) fwidth)) -+ (expert (eq org-agenda-query-selection-single-key 'expert)) -+ (exit-after-next org-agenda-query-selection-single-key) -+ (done-keywords org-done-keywords) -+ tbl char cnt e groups ingroup -+ tg c2 c c1 ntable rtn) -+ (save-window-excursion -+ (if expert -+ (set-buffer (get-buffer-create " *Org tags*")) -+ (delete-other-windows) -+ (split-window-vertically) -+ (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*"))) -+ (erase-buffer) -+ (org-set-local 'org-done-keywords done-keywords) -+ (insert "Query: " current "\n") -+ (org-agenda-query-op-line op) -+ (insert "\n\n") -+ (org-fast-tag-show-exit exit-after-next) -+ (setq tbl fulltable char ?a cnt 0) -+ (while (setq e (pop tbl)) -+ (cond -+ ((equal e '(:startgroup)) -+ (push '() groups) (setq ingroup t) -+ (when (not (= cnt 0)) -+ (setq cnt 0) -+ (insert "\n")) -+ (insert "{ ")) -+ ((equal e '(:endgroup)) -+ (setq ingroup nil cnt 0) -+ (insert "}\n")) -+ (t -+ (setq tg (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))) -+ (if ingroup (push tg (car groups))) -+ (setq tg (org-add-props tg nil 'face -+ (cond -+ ((not (assoc tg table)) -+ (org-get-todo-face tg)) -+ (t nil)))) -+ (if (and (= cnt 0) (not ingroup)) (insert " ")) -+ (insert "[" c "] " tg (make-string -+ (- fwidth 4 (length tg)) ?\ )) -+ (push (cons tg c) ntable) -+ (when (= (setq cnt (1+ cnt)) ncol) -+ (insert "\n") -+ (if ingroup (insert " ")) -+ (setq cnt 0))))) -+ (setq ntable (nreverse ntable)) -+ (insert "\n") -+ (goto-char (point-min)) -+ (if (and (not expert) (fboundp 'fit-window-to-buffer)) -+ (fit-window-to-buffer)) -+ (setq rtn -+ (catch 'exit -+ (while t -+ (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free%s%s" -+ (if groups " [!] no groups" " [!]groups") -+ (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi"))) -+ (setq c (let ((inhibit-quit t)) (read-char-exclusive))) -+ (cond -+ ((= 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) -+ (split-window-vertically) -+ (org-switch-to-buffer-other-window " *Org tags*") -+ (and (fboundp 'fit-window-to-buffer) -+ (fit-window-to-buffer)))) -+ ((or (= c ?\C-g) -+ (and (= c ?q) (not (rassoc c ntable)))) -+ (setq quit-flag t)) -+ ((= c ?\ ) -+ (setq current "") -+ (if exit-after-next (setq exit-after-next 'now))) -+ ((= c ?\[) ; clear left -+ (org-agenda-query-decompose current) -+ (setq current (concat "/" (match-string 2 current))) -+ (if exit-after-next (setq exit-after-next 'now))) -+ ((= c ?\]) ; clear right -+ (org-agenda-query-decompose current) -+ (setq current (match-string 1 current)) -+ (if exit-after-next (setq exit-after-next 'now))) -+ ((= c ?\t) -+ (condition-case nil -+ (setq current (read-string "Query: " current)) -+ (quit)) -+ (if exit-after-next (setq exit-after-next 'now))) -+ ;; operators -+ ((or (= c ?/) (= c ?+)) (setq op "+")) -+ ((or (= c ?\;) (= c ?|)) (setq op "|")) -+ ((or (= c ?\\) (= c ?-)) (setq op "-")) -+ ((= c ?=) (setq op "=")) -+ ;; todos -+ ((setq e (rassoc c todo-table) tg (car e)) -+ (setq current (org-agenda-query-manip -+ current op groups 'todo tg)) -+ (if exit-after-next (setq exit-after-next 'now))) -+ ;; tags -+ ((setq e (rassoc c ntable) tg (car e)) -+ (setq current (org-agenda-query-manip -+ current op groups 'tag tg)) -+ (if exit-after-next (setq exit-after-next 'now)))) -+ (if (eq exit-after-next 'now) (throw 'exit t)) -+ (goto-char (point-min)) -+ (beginning-of-line 1) -+ (delete-region (point) (point-at-eol)) -+ (insert "Query: " current) -+ (beginning-of-line 2) -+ (delete-region (point) (point-at-eol)) -+ (org-agenda-query-op-line op) -+ (goto-char (point-min))))) -+ (if rtn current nil)))) -+ -+(defun org-agenda-query-op-line (op) -+ (insert "Operator: " -+ (org-agenda-query-op-entry (equal op "+") "/+" "and") -+ (org-agenda-query-op-entry (equal op "|") ";|" "or") -+ (org-agenda-query-op-entry (equal op "-") "\\-" "not") -+ (org-agenda-query-op-entry (equal op "=") "=" "clear"))) -+ -+(defun org-agenda-query-op-entry (matchp chars str) -+ (if matchp -+ (org-add-props (format "[%s %s] " chars (upcase str)) -+ nil 'face 'org-todo) -+ (format "[%s]%s " chars str))) -+ -+(defun org-agenda-query-decompose (current) -+ (string-match "\\([^/]*\\)/?\\(.*\\)" current)) -+ -+(defun org-agenda-query-clear (current prefix tag) -+ (if (string-match (concat prefix "\\b" (regexp-quote tag) "\\b") current) -+ (replace-match "" t t current) -+ current)) -+ -+(defun org-agenda-query-manip (current op groups kind tag) -+ "Apply an operator to a query string and a tag. -+CURRENT is the current query string, OP is the operator, GROUPS is a -+list of lists of tags that are mutually exclusive. KIND is 'tag for a -+regular tag, or 'todo for a TODO keyword, and TAG is the tag or -+keyword string." -+ ;; If this tag is already in query string, remove it. -+ (setq current (org-agenda-query-clear current "[-\\+&|]?" tag)) -+ (if (equal op "=") current -+ ;; When using AND, also remove mutually exclusive tags. -+ (if (equal op "+") -+ (loop for g in groups do -+ (if (member tag g) -+ (mapc (lambda (x) -+ (setq current -+ (org-agenda-query-clear current "\\+" x))) -+ g)))) -+ ;; Decompose current query into q1 (tags) and q2 (TODOs). -+ (org-agenda-query-decompose current) -+ (let* ((q1 (match-string 1 current)) -+ (q2 (match-string 2 current))) -+ (cond -+ ((eq kind 'tag) -+ (concat q1 op tag "/" q2)) -+ ;; It's a TODO; when using AND, drop all other TODOs. -+ ((equal op "+") -+ (concat q1 "/+" tag)) -+ (t -+ (concat q1 "/" q2 op tag)))))) -+ -+(defun org-agenda-query-global-todo-keys (&optional files) -+ "Return alist of all TODO keywords and their fast keys, in all FILES." -+ (let (alist) -+ (unless (and files (car files)) -+ (setq files (org-agenda-files))) -+ (save-excursion -+ (loop for f in files do -+ (set-buffer (find-file-noselect f)) -+ (loop for k in org-todo-key-alist do -+ (setq alist (org-agenda-query-merge-todo-key -+ alist k))))) -+ alist)) -+ -+(defun org-agenda-query-merge-todo-key (alist entry) -+ (let (e) -+ (cond -+ ;; if this is not a keyword (:startgroup, etc), ignore it -+ ((not (stringp (car entry)))) -+ ;; if keyword already exists, replace char if it's null -+ ((setq e (assoc (car entry) alist)) -+ (when (null (cdr e)) (setcdr e (cdr entry)))) -+ ;; if char already exists, prepend keyword but drop char -+ ((rassoc (cdr entry) alist) -+ (error "TRACE POSITION 2") -+ (setq alist (cons (cons (car entry) nil) alist))) -+ ;; else, prepend COPY of entry -+ (t -+ (setq alist (cons (cons (car entry) (cdr entry)) alist))))) -+ alist) -+ -+(defun org-agenda-query-generic-cmd (op) -+ "Activate query manipulation with OP as initial operator." -+ (let ((q (org-agenda-query-selection org-agenda-query-string op -+ org-tag-alist -+ (org-agenda-query-global-todo-keys)))) -+ (when q -+ (setq org-agenda-query-string q) -+ (org-agenda-redo)))) -+ -+(defun org-agenda-query-clear-cmd () -+ "Activate query manipulation, to clear a tag from the string." -+ (interactive) -+ (org-agenda-query-generic-cmd "=")) -+ -+(defun org-agenda-query-and-cmd () -+ "Activate query manipulation, initially using the AND (+) operator." -+ (interactive) -+ (org-agenda-query-generic-cmd "+")) -+ -+(defun org-agenda-query-or-cmd () -+ "Activate query manipulation, initially using the OR (|) operator." -+ (interactive) -+ (org-agenda-query-generic-cmd "|")) -+ -+(defun org-agenda-query-not-cmd () -+ "Activate query manipulation, initially using the NOT (-) operator." -+ (interactive) -+ (org-agenda-query-generic-cmd "-")) -+ - ;;; Agenda Finding stuck projects - - (defvar org-agenda-skip-regexp nil diff --git a/EXPERIMENTAL/interactive-query/org-iq.el b/EXPERIMENTAL/interactive-query/org-iq.el deleted file mode 100644 index 35c47a5a1..000000000 --- a/EXPERIMENTAL/interactive-query/org-iq.el +++ /dev/null @@ -1,328 +0,0 @@ ---- org-vendor/org.el 2008-01-06 10:30:26.000000000 -0500 -+++ org/org.el 2008-01-12 17:19:15.000000000 -0500 -@@ -15078,7 +15078,8 @@ - (let ((org-last-tags-completion-table - (org-global-tags-completion-table))) - (setq match (completing-read -- "Match: " 'org-tags-completion-function nil nil nil -+ "Match: " 'org-tags-completion-function nil nil -+ org-agenda-query-string - 'org-tags-history)))) - - ;; Parse the string and create a lisp form -@@ -18812,6 +18813,7 @@ - (defvar org-agenda-follow-mode nil) - (defvar org-agenda-show-log nil) - (defvar org-agenda-redo-command nil) -+(defvar org-agenda-query-string nil) - (defvar org-agenda-mode-hook nil) - (defvar org-agenda-type nil) - (defvar org-agenda-force-single-file nil) -@@ -18947,6 +18949,10 @@ - (org-defkey org-agenda-mode-map [(right)] 'org-agenda-later) - (org-defkey org-agenda-mode-map [(left)] 'org-agenda-earlier) - (org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns) -+(org-defkey org-agenda-mode-map "=" 'org-agenda-query-clear-cmd) -+(org-defkey org-agenda-mode-map "/" 'org-agenda-query-and-cmd) -+(org-defkey org-agenda-mode-map ";" 'org-agenda-query-or-cmd) -+(org-defkey org-agenda-mode-map "\\" 'org-agenda-query-not-cmd) - - (defvar org-agenda-keymap (copy-keymap org-agenda-mode-map) - "Local keymap for agenda entries from Org-mode.") -@@ -20423,9 +20429,10 @@ - (setq matcher (org-make-tags-matcher match) - match (car matcher) matcher (cdr matcher)) - (org-prepare-agenda (concat "TAGS " match)) -+ (setq org-agenda-query-string match) - (setq org-agenda-redo-command - (list 'org-tags-view (list 'quote todo-only) -- (list 'if 'current-prefix-arg nil match))) -+ (list 'if 'current-prefix-arg nil 'org-agenda-query-string))) - (setq files (org-agenda-files) - rtnall nil) - (while (setq file (pop files)) -@@ -20461,7 +20468,7 @@ - (add-text-properties pos (1- (point)) (list 'face 'org-warning)) - (setq pos (point)) - (unless org-agenda-multi -- (insert "Press `C-u r' to search again with new search string\n")) -+ (insert "Press `C-u r' to enter new search string; use `/;\\=' to adjust interactively\n")) - (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))) - (when rtnall - (insert (org-finalize-agenda-entries rtnall) "\n")) -@@ -20471,6 +20478,275 @@ - (org-finalize-agenda) - (setq buffer-read-only t))) - -+;;; Agenda interactive query manipulation -+ -+(defcustom org-agenda-query-selection-single-key t -+ "Non-nil means, query manipulation exits after first change. -+When nil, you have to press RET to exit it. -+During query 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-agenda -+ :type '(choice -+ (const :tag "No" nil) -+ (const :tag "Yes" t) -+ (const :tag "Expert" expert))) -+ -+(defun org-agenda-query-selection (current op table &optional todo-table) -+ "Fast query manipulation with single keys. -+CURRENT is the current query string, OP is the initial -+operator (one of \"+|-=\"), 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 query string, or nil to -+not change the current one." -+ (let* ((fulltable (append table todo-table)) -+ (maxlen (apply 'max (mapcar -+ (lambda (x) -+ (if (stringp (car x)) (string-width (car x)) 0)) -+ fulltable))) -+ (fwidth (+ maxlen 3 1 3)) -+ (ncol (/ (- (window-width) 4) fwidth)) -+ (expert (eq org-agenda-query-selection-single-key 'expert)) -+ (exit-after-next org-agenda-query-selection-single-key) -+ (done-keywords org-done-keywords) -+ tbl char cnt e groups ingroup -+ tg c2 c c1 ntable rtn) -+ (save-window-excursion -+ (if expert -+ (set-buffer (get-buffer-create " *Org tags*")) -+ (delete-other-windows) -+ (split-window-vertically) -+ (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*"))) -+ (erase-buffer) -+ (org-set-local 'org-done-keywords done-keywords) -+ (insert "Query: " current "\n") -+ (org-agenda-query-op-line op) -+ (insert "\n\n") -+ (org-fast-tag-show-exit exit-after-next) -+ (setq tbl fulltable char ?a cnt 0) -+ (while (setq e (pop tbl)) -+ (cond -+ ((equal e '(:startgroup)) -+ (push '() groups) (setq ingroup t) -+ (when (not (= cnt 0)) -+ (setq cnt 0) -+ (insert "\n")) -+ (insert "{ ")) -+ ((equal e '(:endgroup)) -+ (setq ingroup nil cnt 0) -+ (insert "}\n")) -+ (t -+ (setq tg (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))) -+ (if ingroup (push tg (car groups))) -+ (setq tg (org-add-props tg nil 'face -+ (cond -+ ((not (assoc tg table)) -+ (org-get-todo-face tg)) -+ (t nil)))) -+ (if (and (= cnt 0) (not ingroup)) (insert " ")) -+ (insert "[" c "] " tg (make-string -+ (- fwidth 4 (length tg)) ?\ )) -+ (push (cons tg c) ntable) -+ (when (= (setq cnt (1+ cnt)) ncol) -+ (insert "\n") -+ (if ingroup (insert " ")) -+ (setq cnt 0))))) -+ (setq ntable (nreverse ntable)) -+ (insert "\n") -+ (goto-char (point-min)) -+ (if (and (not expert) (fboundp 'fit-window-to-buffer)) -+ (fit-window-to-buffer)) -+ (setq rtn -+ (catch 'exit -+ (while t -+ (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free%s%s" -+ (if groups " [!] no groups" " [!]groups") -+ (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi"))) -+ (setq c (let ((inhibit-quit t)) (read-char-exclusive))) -+ (cond -+ ((= 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) -+ (split-window-vertically) -+ (org-switch-to-buffer-other-window " *Org tags*") -+ (and (fboundp 'fit-window-to-buffer) -+ (fit-window-to-buffer)))) -+ ((or (= c ?\C-g) -+ (and (= c ?q) (not (rassoc c ntable)))) -+ (setq quit-flag t)) -+ ((= c ?\ ) -+ (setq current "") -+ (if exit-after-next (setq exit-after-next 'now))) -+ ((= c ?\[) ; clear left -+ (org-agenda-query-decompose current) -+ (setq current (concat "/" (match-string 2 current))) -+ (if exit-after-next (setq exit-after-next 'now))) -+ ((= c ?\]) ; clear right -+ (org-agenda-query-decompose current) -+ (setq current (match-string 1 current)) -+ (if exit-after-next (setq exit-after-next 'now))) -+ ((= c ?\t) -+ (condition-case nil -+ (setq current (read-string "Query: " current)) -+ (quit)) -+ (if exit-after-next (setq exit-after-next 'now))) -+ ;; operators -+ ((or (= c ?/) (= c ?+)) (setq op "+")) -+ ((or (= c ?\;) (= c ?|)) (setq op "|")) -+ ((or (= c ?\\) (= c ?-)) (setq op "-")) -+ ((= c ?=) (setq op "=")) -+ ;; todos -+ ((setq e (rassoc c todo-table) tg (car e)) -+ (setq current (org-agenda-query-manip -+ current op groups 'todo tg)) -+ (if exit-after-next (setq exit-after-next 'now))) -+ ;; tags -+ ((setq e (rassoc c ntable) tg (car e)) -+ (setq current (org-agenda-query-manip -+ current op groups 'tag tg)) -+ (if exit-after-next (setq exit-after-next 'now)))) -+ (if (eq exit-after-next 'now) (throw 'exit t)) -+ (goto-char (point-min)) -+ (beginning-of-line 1) -+ (delete-region (point) (point-at-eol)) -+ (insert "Query: " current) -+ (beginning-of-line 2) -+ (delete-region (point) (point-at-eol)) -+ (org-agenda-query-op-line op) -+ (goto-char (point-min))))) -+ (if rtn current nil)))) -+ -+(defun org-agenda-query-op-line (op) -+ (insert "Operator: " -+ (org-agenda-query-op-entry (equal op "+") "/+" "and") -+ (org-agenda-query-op-entry (equal op "|") ";|" "or") -+ (org-agenda-query-op-entry (equal op "-") "\\-" "not") -+ (org-agenda-query-op-entry (equal op "=") "=" "clear"))) -+ -+(defun org-agenda-query-op-entry (matchp chars str) -+ (if matchp -+ (org-add-props (format "[%s %s] " chars (upcase str)) -+ nil 'face 'org-todo) -+ (format "[%s]%s " chars str))) -+ -+(defun org-agenda-query-decompose (current) -+ (string-match "\\([^/]*\\)/?\\(.*\\)" current)) -+ -+(defun org-agenda-query-clear (current prefix tag) -+ (if (string-match (concat prefix "\\b" (regexp-quote tag) "\\b") current) -+ (replace-match "" t t current) -+ current)) -+ -+(defun org-agenda-query-manip (current op groups kind tag) -+ "Apply an operator to a query string and a tag. -+CURRENT is the current query string, OP is the operator, GROUPS is a -+list of lists of tags that are mutually exclusive. KIND is 'tag for a -+regular tag, or 'todo for a TODO keyword, and TAG is the tag or -+keyword string." -+ ;; If this tag is already in query string, remove it. -+ (setq current (org-agenda-query-clear current "[-\\+&|]?" tag)) -+ (if (equal op "=") current -+ ;; When using AND, also remove mutually exclusive tags. -+ (if (equal op "+") -+ (loop for g in groups do -+ (if (member tag g) -+ (mapc (lambda (x) -+ (setq current -+ (org-agenda-query-clear current "\\+" x))) -+ g)))) -+ ;; Decompose current query into q1 (tags) and q2 (TODOs). -+ (org-agenda-query-decompose current) -+ (let* ((q1 (match-string 1 current)) -+ (q2 (match-string 2 current))) -+ (cond -+ ((eq kind 'tag) -+ (concat q1 op tag "/" q2)) -+ ;; It's a TODO; when using AND, drop all other TODOs. -+ ((equal op "+") -+ (concat q1 "/+" tag)) -+ (t -+ (concat q1 "/" q2 op tag)))))) -+ -+(defun org-agenda-query-global-todo-keys (&optional files) -+ "Return alist of all TODO keywords and their fast keys, in all FILES." -+ (let (alist) -+ (unless (and files (car files)) -+ (setq files (org-agenda-files))) -+ (save-excursion -+ (loop for f in files do -+ (set-buffer (find-file-noselect f)) -+ (loop for k in org-todo-key-alist do -+ (setq alist (org-agenda-query-merge-todo-key -+ alist k))))) -+ alist)) -+ -+(defun org-agenda-query-merge-todo-key (alist entry) -+ (let (e) -+ (cond -+ ;; if this is not a keyword (:startgroup, etc), ignore it -+ ((not (stringp (car entry)))) -+ ;; if keyword already exists, replace char if it's null -+ ((setq e (assoc (car entry) alist)) -+ (when (null (cdr e)) (setcdr e (cdr entry)))) -+ ;; if char already exists, prepend keyword but drop char -+ ((rassoc (cdr entry) alist) -+ (error "TRACE POSITION 2") -+ (setq alist (cons (cons (car entry) nil) alist))) -+ ;; else, prepend COPY of entry -+ (t -+ (setq alist (cons (cons (car entry) (cdr entry)) alist))))) -+ alist) -+ -+(defun org-agenda-query-generic-cmd (op) -+ "Activate query manipulation with OP as initial operator." -+ (let ((q (org-agenda-query-selection org-agenda-query-string op -+ org-tag-alist -+ (org-agenda-query-global-todo-keys)))) -+ (when q -+ (setq org-agenda-query-string q) -+ (org-agenda-redo)))) -+ -+(defun org-agenda-query-clear-cmd () -+ "Activate query manipulation, to clear a tag from the string." -+ (interactive) -+ (org-agenda-query-generic-cmd "=")) -+ -+(defun org-agenda-query-and-cmd () -+ "Activate query manipulation, initially using the AND (+) operator." -+ (interactive) -+ (org-agenda-query-generic-cmd "+")) -+ -+(defun org-agenda-query-or-cmd () -+ "Activate query manipulation, initially using the OR (|) operator." -+ (interactive) -+ (org-agenda-query-generic-cmd "|")) -+ -+(defun org-agenda-query-not-cmd () -+ "Activate query manipulation, initially using the NOT (-) operator." -+ (interactive) -+ (org-agenda-query-generic-cmd "-")) -+ - ;;; Agenda Finding stuck projects - - (defvar org-agenda-skip-regexp nil diff --git a/EXPERIMENTAL/interactive-query/org.el b/EXPERIMENTAL/interactive-query/org.el deleted file mode 100644 index 0d2f0a598..000000000 --- a/EXPERIMENTAL/interactive-query/org.el +++ /dev/null @@ -1,28057 +0,0 @@ -;;; org.el --- Outline-based notes management and organizer -;; Carstens outline-mode for keeping track of everything. -;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. -;; -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; Version: 5.18a -;; -;; 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, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: -;; -;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing -;; project planning with a fast and effective plain-text system. -;; -;; Org-mode develops organizational tasks around 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-mode 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 -;; -;; http://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 etc/ directory of Emacs 22. -;; -;; A list of recent changes can be found at -;; http://orgmode.org/Changes.html -;; -;;; Code: - -;;;; Require other packages - -(eval-when-compile - (require 'cl) - (require 'gnus-sum) - (require 'calendar)) -;; For XEmacs, noutline is not yet provided by outline.el, so arrange for -;; the file noutline.el being loaded. -(if (featurep 'xemacs) (condition-case nil (require 'noutline))) -;; We require noutline, which might be provided in outline.el -(require 'outline) (require 'noutline) -;; Other stuff we need. -(require 'time-date) -(unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time)) -(require 'easymenu) - -;;;; Customization variables - -;;; Version - -(defconst org-version "5.17a" - "The version number of the file org.el.") -(defun org-version () - (interactive) - (message "Org-mode version %s" org-version)) - -;;; Compatibility constants -(defconst org-xemacs-p (featurep 'xemacs)) ; not used by org.el itself -(defconst org-format-transports-properties-p - (let ((x "a")) - (add-text-properties 0 1 '(test t) x) - (get-text-property 0 'test (format "%s" x))) - "Does format transport text properties?") - -(defmacro org-bound-and-true-p (var) - "Return the value of symbol VAR if it is bound, else nil." - `(and (boundp (quote ,var)) ,var)) - -(defmacro org-unmodified (&rest body) - "Execute body without changing buffer-modified-p." - `(set-buffer-modified-p - (prog1 (buffer-modified-p) ,@body))) - -(defmacro org-re (s) - "Replace posix classes in regular expression." - (if (featurep 'xemacs) - (let ((ss s)) - (save-match-data - (while (string-match "\\[:alnum:\\]" ss) - (setq ss (replace-match "a-zA-Z0-9" t t ss))) - (while (string-match "\\[:alpha:\\]" ss) - (setq ss (replace-match "a-zA-Z" t t ss))) - ss)) - s)) - -(defmacro org-preserve-lc (&rest body) - `(let ((_line (org-current-line)) - (_col (current-column))) - (unwind-protect - (progn ,@body) - (goto-line _line) - (move-to-column _col)))) - -(defmacro org-without-partial-completion (&rest body) - `(let ((pc-mode (and (boundp 'partial-completion-mode) - partial-completion-mode))) - (unwind-protect - (progn - (if pc-mode (partial-completion-mode -1)) - ,@body) - (if pc-mode (partial-completion-mode 1))))) - -;;; The custom variables - -(defgroup org nil - "Outline-based notes management and organizer." - :tag "Org" - :group 'outlines - :group 'hypermedia - :group 'calendar) - -;; FIXME: Needs a separate group... -(defcustom org-completion-fallback-command 'hippie-expand - "The expansion command called by \\[org-complete] in normal context. -Normal means, no org-mode-specific context." - :group 'org - :type 'function) - -(defgroup org-startup nil - "Options concerning startup of Org-mode." - :tag "Org Startup" - :group 'org) - -(defcustom org-startup-folded t - "Non-nil means, entering Org-mode will switch to OVERVIEW. -This can also be configured on a per-file basis by adding one of -the following lines anywhere in the buffer: - - #+STARTUP: fold - #+STARTUP: nofold - #+STARTUP: content" - :group 'org-startup - :type '(choice - (const :tag "nofold: show all" nil) - (const :tag "fold: overview" t) - (const :tag "content: all headlines" content))) - -(defcustom org-startup-truncated t - "Non-nil means, entering Org-mode will set `truncate-lines'. -This is useful since some lines containing links can be very long and -uninteresting. Also tables look terrible when wrapped." - :group 'org-startup - :type 'boolean) - -(defcustom org-startup-align-all-tables nil - "Non-nil means, align all tables when visiting a file. -This is useful when the column width in tables is forced with 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-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- keys for changing timestamps and priorities. -These keys are also used by other packages like `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) - -(if (fboundp 'defvaralias) - (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's 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." - (if org-replace-disputed-keys - (let* ((nkey (key-description key)) - (x (org-find-if (lambda (x) - (equal (key-description (car x)) nkey)) - org-disputed-keys))) - (if x (cdr x) key)) - key)) - -(defun org-find-if (predicate seq) - (catch 'exit - (while seq - (if (funcall predicate (car seq)) - (throw 'exit (car seq)) - (pop seq))))) - -(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 string, use that instead, -When a face, use the standart 3 dots, but with the specified face. -The change affects only Org-mode (which will then use its own display table). -Changing this requires executing `M-x org-mode' in a buffer to become -effective." - :group 'org-startup - :type '(choice (const :tag "Default" nil) - (face :tag "Face" :value org-warning) - (string :tag "String" :value "...#"))) - -(defvar org-display-table nil - "The display table for org-mode, in case `org-ellipsis' is non-nil.") - -(defgroup org-keywords nil - "Keywords in Org-mode." - :tag "Org Keywords" - :group 'org) - -(defcustom org-deadline-string "DEADLINE:" - "String to mark deadline entries. -A deadline is this string, followed by a time stamp. Should be a word, -terminated by a colon. You can insert a schedule keyword and -a timestamp with \\[org-deadline]. -Changes become only effective after restarting Emacs." - :group 'org-keywords - :type 'string) - -(defcustom org-scheduled-string "SCHEDULED:" - "String to mark scheduled TODO entries. -A schedule is this string, followed by a time stamp. Should be a word, -terminated by a colon. You can insert a schedule keyword and -a timestamp with \\[org-schedule]. -Changes become only effective after restarting Emacs." - :group 'org-keywords - :type 'string) - -(defcustom org-closed-string "CLOSED:" - "String used as the prefix for timestamps logging closing a TODO entry." - :group 'org-keywords - :type 'string) - -(defcustom org-clock-string "CLOCK:" - "String used as prefix for timestamps clocking work hours on an item." - :group 'org-keywords - :type 'string) - -(defcustom org-comment-string "COMMENT" - "Entries starting with this keyword will never be exported. -An entry can be toggled between COMMENT and normal with -\\[org-toggle-comment]. -Changes become only effective after restarting Emacs." - :group 'org-keywords - :type 'string) - -(defcustom org-quote-string "QUOTE" - "Entries starting with this keyword will be exported in fixed-width font. -Quoting applies only to the text in the entry following the headline, and does -not extend beyond the next headline, even if that is lower level. -An entry can be toggled between QUOTE and normal with -\\[org-toggle-fixed-width-section]." - :group 'org-keywords - :type 'string) - -(defconst org-repeat-re - (concat "\\(?:\\<\\(?:" org-scheduled-string "\\|" org-deadline-string "\\)" - " +<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*\\)\\(\\+[0-9]+[dwmy]\\)") - "Regular expression for specifying repeated events. -After a match, group 1 contains the repeat expression.") - -(defgroup org-structure nil - "Options concerning the general structure of Org-mode 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) - -(defconst org-context-choice - '(choice - (const :tag "Always" t) - (const :tag "Never" 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)) - (boolean)))) - "Contexts for the reveal options.") - -(defcustom org-show-hierarchy-above '((default . t)) - "Non-nil means, show full hierarchy when revealing a location. -Org-mode often shows locations in an org-mode file which might have -been invisible before. When this is set, the hierarchy of headings -above the exposed location is shown. -Turning this off for example for sparse trees makes them very compact. -Instead of t, this can also be an alist specifying this option for different -contexts. Valid contexts are - agenda when exposing an entry from the agenda - org-goto when using the command `org-goto' on key C-c C-j - occur-tree when using the command `org-occur' on key C-c / - 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" - :group 'org-reveal-location - :type org-context-choice) - -(defcustom org-show-following-heading '((default . nil)) - "Non-nil means, show following heading when revealing a location. -Org-mode often shows locations in an org-mode file which might have -been invisible before. When this is set, the heading following the -match is shown. -Turning this off for example for sparse trees makes them very compact, -but makes it harder to edit the location of the match. In such a case, -use the command \\[org-reveal] to show more context. -Instead of t, this can also be an alist specifying this option for different -contexts. See `org-show-hierarchy-above' for valid contexts." - :group 'org-reveal-location - :type org-context-choice) - -(defcustom org-show-siblings '((default . nil) (isearch t)) - "Non-nil means, show all sibling heading when revealing a location. -Org-mode often shows locations in an org-mode file which might have -been invisible before. When this is set, the sibling of the current entry -heading are all made visible. If `org-show-hierarchy-above' is t, -the same happens on each level of the hierarchy above the current entry. - -By default this is on for the isearch context, off for all other contexts. -Turning this off for example for sparse trees makes them very compact, -but makes it harder to edit the location of the match. In such a case, -use the command \\[org-reveal] to show more context. -Instead of t, this can also be an alist specifying this option for different -contexts. See `org-show-hierarchy-above' for valid contexts." - :group 'org-reveal-location - :type org-context-choice) - -(defcustom org-show-entry-below '((default . nil)) - "Non-nil means, show the entry below a headline when revealing a location. -Org-mode often shows locations in an org-mode file which might have -been invisible before. When this is set, the text below the headline that is -exposed is also shown. - -By default this is off for all contexts. -Instead of t, this can also be an alist specifying this option for different -contexts. See `org-show-hierarchy-above' for valid contexts." - :group 'org-reveal-location - :type org-context-choice) - -(defgroup org-cycle nil - "Options concerning visibility cycling in Org-mode." - :tag "Org Cycle" - :group 'org-structure) - -(defcustom org-drawers '("PROPERTIES" "CLOCK") - "Names of drawers. Drawers are not opened by cycling on the headline above. -Drawers only open with a TAB on the drawer line itself. A drawer looks like -this: - :DRAWERNAME: - ..... - :END: -The drawer \"PROPERTIES\" is special for capturing properties through -the property API. - -Drawers can be defined on the per-file basis with a line like: - -#+DRAWERS: HIDDEN STATE PROPERTIES" - :group 'org-structure - :type '(repeat (string :tag "Drawer Name"))) - -(defcustom org-cycle-global-at-bob nil - "Cycle globally if cursor is at beginning of buffer and not at a headline. -This makes it possible to do global cycling without having to use S-TAB or -C-u TAB. For this special case to work, the first line of the buffer -must not be a headline - it may be empty ot some other text. When used in -this way, `org-cycle-hook' is disables temporarily, to make sure the -cursor stays at the beginning of the buffer. -When this option is nil, don't do anything special at the beginning -of the buffer." - :group 'org-cycle - :type 'boolean) - -(defcustom org-cycle-emulate-tab t - "Where should `org-cycle' emulate TAB. -nil Never -white Only in completely white lines -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. - -Special case: when 0, never leave empty lines in collapsed view." - :group 'org-cycle - :type 'integer) - -(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', `content', or `all'. After a local state change, it can have -the values `folded', `children', or `subtree'." - :group 'org-cycle - :type 'hook) - -(defgroup org-edit-structure nil - "Options concerning structure editing in Org-mode." - :tag "Org Edit Structure" - :group 'org-structure) - -(defcustom org-special-ctrl-a/e nil - "Non-nil means `C-a' and `C-e' behave specially in headlines and items. -When t, `C-a' will bring back the cursor to the beginning of the -headline text, i.e. after the stars and after a possible TODO keyword. -In an item, this will be the position after the bullet. -When the cursor is already at that position, another `C-a' will bring -it to the beginning of the line. -`C-e' will jump to the end of the headline, ignoring the presence of tags -in the headline. A second `C-e' will then jump to the true end of the -line, after any tags. -When set to the symbol `reversed', the first `C-a' or `C-e' works normally, -and only a directly following, identical keypress will bring the cursor -to the special positions." - :group 'org-edit-structure - :type '(choice - (const :tag "off" nil) - (const :tag "after bullet first" t) - (const :tag "border first" reversed))) - -(if (fboundp 'defvaralias) - (defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e)) - -(defcustom org-odd-levels-only nil - "Non-nil means, skip even levels and only use odd levels for the outline. -This has the effect that two stars are being added/taken away in -promotion/demotion commands. It also influences how levels are -handled by the exporters. -Changing it requires restart of `font-lock-mode' to become effective -for fontification also in regions already fontified. -You may also set this on a per-file basis by adding one of the following -lines to the buffer: - - #+STARTUP: odd - #+STARTUP: oddeven" - :group 'org-edit-structure - :group 'org-font-lock - :type 'boolean) - -(defcustom org-adapt-indentation t - "Non-nil means, adapt indentation when promoting and demoting. -When this is set and the *entire* text in an entry is indented, the -indentation is increased by one space in a demotion command, and -decreased by one in a promotion command. If any line in the entry -body starts at column 0, indentation is not changed at all." - :group 'org-edit-structure - :type 'boolean) - -(defcustom org-blank-before-new-entry '((heading . nil) - (plain-list-item . nil)) - "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." - :group 'org-edit-structure - :type '(list - (cons (const heading) (boolean)) - (cons (const plain-list-item) (boolean)))) - -(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. -See also the QUOTE keyword." - :group 'org-edit-structure - :type 'boolean) - -(defgroup org-sparse-trees nil - "Options concerning sparse trees in Org-mode." - :tag "Org Sparse Trees" - :group 'org-structure) - -(defcustom org-highlight-sparse-tree-matches t - "Non-nil means, highlight all matches that define a sparse tree. -The highlights will automatically disappear the next time the buffer is -changed by an edit command." - :group 'org-sparse-trees - :type 'boolean) - -(defcustom org-remove-highlights-with-change t - "Non-nil means, any change to the buffer will remove temporary highlights. -Such highlights are created by `org-occur' and `org-clock-display'. -When nil, `C-c C-c needs to be used to get rid of the highlights. -The highlights created by `org-preview-latex-fragment' always need -`C-c C-c' to be removed." - :group 'org-sparse-trees - :group 'org-time - :type 'boolean) - - -(defcustom org-occur-hook '(org-first-headline-recenter) - "Hook that is run after `org-occur' has constructed a sparse tree. -This can be used to recenter the window to show as much of the structure -as possible." - :group 'org-sparse-trees - :type 'hook) - -(defgroup org-plain-lists nil - "Options concerning plain lists in Org-mode." - :tag "Org Plain lists" - :group 'org-structure) - -(defcustom org-cycle-include-plain-lists nil - "Non-nil means, include plain lists into visibility cycling. -This means that during cycling, plain list items will *temporarily* be -interpreted as outline headlines with a level given by 1000+i where i is the -indentation of the bullet. In all other operations, plain list items are -not seen as headlines. For example, you cannot assign a TODO keyword to -such an item." - :group 'org-plain-lists - :type 'boolean) - -(defcustom org-plain-list-ordered-item-terminator t - "The character that makes a line with leading number an ordered list item. -Valid values are ?. and ?\). To get both terminators, use t. While -?. may look nicer, it creates the danger that a line with leading -number may be incorrectly interpreted as an item. ?\) therefore is -the safe choice." - :group 'org-plain-lists - :type '(choice (const :tag "dot like in \"2.\"" ?.) - (const :tag "paren like in \"2)\"" ?\)) - (const :tab "both" t))) - -(defcustom org-auto-renumber-ordered-lists t - "Non-nil means, automatically renumber ordered plain lists. -Renumbering happens when the sequence have been changed with -\\[org-shiftmetaup] or \\[org-shiftmetadown]. After other editing commands, -use \\[org-ctrl-c-ctrl-c] to trigger renumbering." - :group 'org-plain-lists - :type 'boolean) - -(defcustom org-provide-checkbox-statistics t - "Non-nil means, update checkbox statistics after insert and toggle. -When this is set, checkbox statistics is updated each time you either insert -a new checkbox with \\[org-insert-todo-heading] or toggle a checkbox -with \\[org-ctrl-c-ctrl-c\\]." - :group 'org-plain-lists - :type 'boolean) - -(defgroup org-archive nil - "Options concerning archiving in Org-mode." - :tag "Org Archive" - :group 'org-structure) - -(defcustom org-archive-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. -After changing this, font-lock must be restarted in the relevant buffers to -get the proper fontification." - :group 'org-archive - :group 'org-keywords - :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." - :group 'org-archive - :group 'org-agenda-skip - :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-archive-location "%s_archive::" - "The location where subtrees should be archived. -This string consists of two parts, separated by a double-colon. - -The first part is a file name - when omitted, archiving happens in the same -file. %s will be replaced by the current file name (without directory part). -Archiving to a different file is useful to keep archived entries from -contributing to the Org-mode Agenda. - -The part after the double colon is a headline. The archived entries will be -filed under that headline. When omitted, the subtrees are simply filed away -at the end of the file, as top-level entries. - -Here are a few examples: -\"%s_archive::\" - If the current file is Projects.org, archive in file - Projects.org_archive, as top-level trees. This is the default. - -\"::* Archived Tasks\" - Archive in the current file, under the top-level headline - \"* Archived Tasks\". - -\"~/org/archive.org::\" - Archive in file ~/org/archive.org (absolute path), as top-level trees. - -\"basement::** Finished Tasks\" - Archive in file ./basement (relative path), as level 3 trees - below the level 2 heading \"** Finished Tasks\". - -You may set this option on a per-file basis by adding to the buffer a -line like - -#+ARCHIVE: basement::** Finished Tasks" - :group 'org-archive - :type 'string) - -(defcustom org-archive-mark-done t - "Non-nil means, mark entries as DONE when they are moved to the archive file. -This can be a string to set the keyword to use. When t, Org-mode will -use the first keyword in its list that means done." - :group 'org-archive - :type '(choice - (const :tag "No" nil) - (const :tag "Yes" t) - (string :tag "Use this keyword"))) - -(defcustom org-archive-stamp-time t - "Non-nil means, add a time stamp to entries moved to an archive file. -This variable is obsolete and has no effect anymore, instead add ot remove -`time' from the variablle `org-archive-save-context-info'." - :group 'org-archive - :type 'boolean) - -(defcustom org-archive-save-context-info '(time file category todo itags) - "Parts of context info that should be stored as properties when archiving. -When a subtree is moved to an archive file, it looses information given by -context, like inherited tags, the category, and possibly also the TODO -state (depending on the variable `org-archive-mark-done'). -This variable can be a list of any of the following symbols: - -time The time of archiving. -file The file where the entry originates. -itags The local tags, in the headline of the subtree. -ltags The tags the subtree inherits from further up the hierarchy. -todo The pre-archive TODO state. -category The category, taken from file name or #+CATEGORY lines. - -For each symbol present in the list, a property will be created in -the archived entry, with a prefix \"PRE_ARCHIVE_\", to remember this -information." - :group 'org-archive - :type '(set :greedy t - (const :tag "Time" time) - (const :tag "File" file) - (const :tag "Category" category) - (const :tag "TODO state" todo) - (const :tag "TODO state" priority) - (const :tag "Inherited tags" itags) - (const :tag "Local tags" ltags))) - -(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-mode headlines. -This also applied for speedbar access." - :group 'org-imenu-and-speedbar - :type 'number) - -(defgroup org-table nil - "Options concerning tables in Org-mode." - :tag "Org Table" - :group 'org) - -(defcustom org-enable-table-editor 'optimized - "Non-nil means, lines starting with \"|\" are handled by the table editor. -When nil, such lines will be treated like ordinary lines. - -When equal to the symbol `optimized', the table editor will be optimized to -do the following: -- Automatic overwrite mode in front of whitespace in table fields. - This makes the structure of the table stay in tact as long as the edited - field does not exceed the column width. -- Minimize the number of realigns. Normally, the table is aligned each time - TAB or RET are pressed to move to another field. With optimization this - happens only if changes to a field might have changed the column width. -Optimization requires replacing the functions `self-insert-command', -`delete-char', and `backward-delete-char' in Org-mode buffers, with a -slight (in fact: unnoticeable) speed impact for normal typing. Org-mode is -very good at guessing when a re-align will be necessary, but you can always -force one with \\[org-ctrl-c-ctrl-c]. - -If you would like to use the optimized version in Org-mode, but the -un-optimized version in OrgTbl-mode, see the variable `orgtbl-optimized'. - -This variable can be used to turn on and off the table editor during a session, -but in order to toggle optimization, a restart is required. - -See also the variable `org-table-auto-blank-field'." - :group 'org-table - :type '(choice - (const :tag "off" nil) - (const :tag "on" t) - (const :tag "on, optimized" optimized))) - -(defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized) - "Non-nil means, use the optimized table editor version for `orgtbl-mode'. -In the optimized version, the table editor takes over all simple keys that -normally just insert a character. In tables, the characters are inserted -in a way to minimize disturbing the table structure (i.e. in overwrite mode -for empty fields). Outside tables, the correct binding of the keys is -restored. - -The default for this option is t if the optimized version is also used in -Org-mode. See the variable `org-enable-table-editor' for details. Changing -this variable requires a restart of Emacs to become effective." - :group 'org-table - :type 'boolean) - -(defcustom orgtbl-radio-table-templates - '((latex-mode "% BEGIN RECEIVE ORGTBL %n -% END RECEIVE ORGTBL %n -\\begin{comment} -#+ORGTBL: SEND %n orgtbl-to-latex :splice nil :skip 0 -| | | -\\end{comment}\n") - (texinfo-mode "@c BEGIN RECEIVE ORGTBL %n -@c END RECEIVE ORGTBL %n -@ignore -#+ORGTBL: SEND %n orgtbl-to-html :splice nil :skip 0 -| | | -@end ignore\n") - (html-mode " - -\n")) - "Templates for radio tables in different major modes. -All occurrences of %n in a template will be replaced with the name of the -table, obtained by prompting the user." - :group 'org-table - :type '(repeat - (list (symbol :tag "Major mode") - (string :tag "Format")))) - -(defgroup org-table-settings nil - "Settings for tables in Org-mode." - :tag "Org Table Settings" - :group 'org-table) - -(defcustom org-table-default-size "5x2" - "The default size for newly created tables, Columns x Rows." - :group 'org-table-settings - :type 'string) - -(defcustom org-table-number-regexp - "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%:]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$" - "Regular expression for recognizing numbers in table columns. -If a table column contains mostly numbers, it will be aligned to the -right. If not, it will be aligned to the left. - -The default value of this option is a regular expression which allows -anything which looks remotely like a number as used in scientific -context. For example, all of the following will be considered a -number: - 12 12.2 2.4e-08 2x10^12 4.034+-0.02 2.7(10) >3.5 - -Other options offered by the customize interface are more restrictive." - :group 'org-table-settings - :type '(choice - (const :tag "Positive Integers" - "^[0-9]+$") - (const :tag "Integers" - "^[-+]?[0-9]+$") - (const :tag "Floating Point Numbers" - "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.[0-9]*\\)$") - (const :tag "Floating Point Number or Integer" - "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.?[0-9]*\\)$") - (const :tag "Exponential, Floating point, Integer" - "^[-+]?[0-9.]+\\([eEdD][-+0-9]+\\)?$") - (const :tag "Very General Number-Like, including hex" - "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$") - (string :tag "Regexp:"))) - -(defcustom org-table-number-fraction 0.5 - "Fraction of numbers in a column required to make the column align right. -In a column all non-white fields are considered. If at least this -fraction of fields is matched by `org-table-number-fraction', -alignment to the right border applies." - :group 'org-table-settings - :type 'number) - -(defgroup org-table-editing nil - "Behavior of tables during editing in Org-mode." - :tag "Org Table Editing" - :group 'org-table) - -(defcustom org-table-automatic-realign t - "Non-nil means, automatically re-align table when pressing TAB or RETURN. -When nil, aligning is only done with \\[org-table-align], or after column -removal/insertion." - :group 'org-table-editing - :type 'boolean) - -(defcustom org-table-auto-blank-field t - "Non-nil means, automatically blank table field when starting to type into it. -This only happens when typing immediately after a field motion -command (TAB, S-TAB or RET). -Only relevant when `org-enable-table-editor' is equal to `optimized'." - :group 'org-table-editing - :type 'boolean) - -(defcustom org-table-tab-jumps-over-hlines t - "Non-nil means, tab in the last column of a table with jump over a hline. -If a horizontal separator line is following the current line, -`org-table-next-field' can either create a new row before that line, or jump -over the line. When this option is nil, a new line will be created before -this line." - :group 'org-table-editing - :type 'boolean) - -(defcustom org-table-tab-recognizes-table.el t - "Non-nil means, TAB will automatically notice a table.el table. -When it sees such a table, it moves point into it and - if necessary - -calls `table-recognize-table'." - :group 'org-table-editing - :type 'boolean) - -(defgroup org-table-calculation nil - "Options concerning tables in Org-mode." - :tag "Org Table Calculation" - :group 'org-table) - -(defcustom org-table-use-standard-references t - "Should org-mode work with table refrences like B3 instead of @3$2? -Possible values are: -nil never use them -from accept as input, do not present for editing -t: accept as input and present for editing" - :group 'org-table-calculation - :type '(choice - (const :tag "Never, don't even check unser input for them" nil) - (const :tag "Always, both as user input, and when editing" t) - (const :tag "Convert user input, don't offer during editing" 'from))) - -(defcustom org-table-copy-increment t - "Non-nil means, increment when copying current field with \\[org-table-copy-down]." - :group 'org-table-calculation - :type 'boolean) - -(defcustom org-calc-default-modes - '(calc-internal-prec 12 - calc-float-format (float 5) - calc-angle-mode deg - calc-prefer-frac nil - calc-symbolic-mode nil - calc-date-format (YYYY "-" MM "-" DD " " Www (" " HH ":" mm)) - calc-display-working-message t - ) - "List with Calc mode settings for use in calc-eval for table formulas. -The list must contain alternating symbols (Calc modes variables and values). -Don't remove any of the default settings, just change the values. Org-mode -relies on the variables to be present in the list." - :group 'org-table-calculation - :type 'plist) - -(defcustom org-table-formula-evaluate-inline t - "Non-nil means, TAB and RET evaluate a formula in current table field. -If the current field starts with an equal sign, it is assumed to be a formula -which should be evaluated as described in the manual and in the documentation -string of the command `org-table-eval-formula'. This feature requires the -Emacs calc package. -When this variable is nil, formula calculation is only available through -the command \\[org-table-eval-formula]." - :group 'org-table-calculation - :type 'boolean) - -(defcustom org-table-formula-use-constants t - "Non-nil means, interpret constants in formulas in tables. -A constant looks like `$c' or `$Grav' and will be replaced before evaluation -by the value given in `org-table-formula-constants', or by a value obtained -from the `constants.el' package." - :group 'org-table-calculation - :type 'boolean) - -(defcustom org-table-formula-constants nil - "Alist with constant names and values, for use in table formulas. -The car of each element is a name of a constant, without the `$' before it. -The cdr is the value as a string. For example, if you'd like to use the -speed of light in a formula, you would configure - - (setq org-table-formula-constants '((\"c\" . \"299792458.\"))) - -and then use it in an equation like `$1*$c'. - -Constants can also be defined on a per-file basis using a line like - -#+CONSTANTS: c=299792458. pi=3.14 eps=2.4e-6" - :group 'org-table-calculation - :type '(repeat - (cons (string :tag "name") - (string :tag "value")))) - -(defvar org-table-formula-constants-local nil - "Local version of `org-table-formula-constants'.") -(make-variable-buffer-local 'org-table-formula-constants-local) - -(defcustom org-table-allow-automatic-line-recalculation t - "Non-nil means, lines marked with |#| or |*| will be recomputed automatically. -Automatically means, when TAB or RET or C-c C-c are pressed in the line." - :group 'org-table-calculation - :type 'boolean) - -(defgroup org-link nil - "Options concerning links in Org-mode." - :tag "Org Link" - :group 'org) - -(defvar 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.") -(make-variable-buffer-local 'org-link-abbrev-alist-local) - -(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-mode buffers can have an optional tag after a double colon, e.g. - - [[linkkey:tag][description]] - -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. - -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 'alist) - -(defcustom org-descriptive-links t - "Non-nil means, hide link part and only show description of bracket links. -Bracket links are like [[link][descritpion]]. This variable sets the initial -state in new org-mode buffers. The setting can then be toggled on a -per-buffer basis from the Org->Hyperlinks menu." - :group 'org-link - :type 'boolean) - -(defcustom org-link-file-path-type 'adaptive - "How the path name in file links should be stored. -Valid values are: - -relative relative to the current directory, i.e. the directory of the file - into which the link is being inserted. -absolute absolute path, if possible with ~ for home directory. -noabbrev absolute path, no abbreviation of home directory. -adaptive Use relative path for files in the current directory and sub- - directories of it. For other files, use an absolute path." - :group 'org-link - :type '(choice - (const relative) - (const absolute) - (const noabbrev) - (const adaptive))) - -(defcustom org-activate-links '(bracket angle plain radio tag date) - "Types of links that should be activated in Org-mode files. -This is a list of symbols, each leading to the activation of a certain link -type. In principle, it does not hurt to turn on most link types - there may -be a small gain when turning off unused link types. The types are: - -bracket The recommended [[link][description]] or [[link]] links with hiding. -angular Links in angular brackes that may contain whitespace like - . -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). - -Changing this variable requires a restart of Emacs to become effective." - :group 'org-link - :type '(set (const :tag "Double bracket links (new style)" bracket) - (const :tag "Angular bracket links (old style)" angular) - (const :tag "plain text links" plain) - (const :tag "Radio target matches" radio) - (const :tag "Tags" tag) - (const :tag "Tags" target) - (const :tag "Timestamps" date))) - -(defgroup org-link-store nil - "Options concerning storing links in Org-mode" - :tag "Org Store Link" - :group 'org-link) - -(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 %-excapes 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. Unually \"from NAME\", but if you sent it yourself, it - will be \"to NAME\". See also the variable `org-from-is-user-regexp'. -%s subject -%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 mached 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. -A search string will be added to the file name with :: as separator and -used to find the context when the link is activated by the command -`org-open-at-point'. -Using a prefix arg to the command \\[org-store-link] (`org-store-link') -negates this setting for the duration of the command." - :group 'org-link-store - :type 'boolean) - -(defcustom org-keep-stored-link-after-insertion nil - "Non-nil means, keep link in list for entire session. - -The command `org-store-link' adds a link pointing to the current -location to an internal list. These links accumulate during a session. -The command `org-insert-link' can be used to insert links into any -Org-mode file (offering completion for all stored links). When this -option is nil, every link which has been inserted once using \\[org-insert-link] -will be removed from the list, to make completing the unused links -more efficient." - :group 'org-link-store - :type 'boolean) - -(defcustom org-usenet-links-prefer-google nil - "Non-nil means, `org-store-link' will create web links to Google groups. -When nil, Gnus will be used for such links. -Using a prefix arg to the command \\[org-store-link] (`org-store-link') -negates this setting for the duration of the command." - :group 'org-link-store - :type 'boolean) - -(defgroup org-link-follow nil - "Options concerning following links in Org-mode" - :tag "Org Follow Link" - :group 'org-link) - -(defcustom org-tab-follows-link nil - "Non-nil means, on links TAB will follow the link. -Needs to be set before org.el is loaded." - :group 'org-link-follow - :type 'boolean) - -(defcustom org-return-follows-link nil - "Non-nil means, on links RET will follow the link. -Needs to be set before org.el is loaded." - :group 'org-link-follow - :type 'boolean) - -(defcustom org-mouse-1-follows-link t - "Non-nil means, mouse-1 on a link will follow the link. -A longer mouse click will still set point. Does not wortk on XEmacs. -Needs to be set before org.el is loaded." - :group 'org-link-follow - :type 'boolean) - -(defcustom org-mark-ring-length 4 - "Number of different positions to be recorded in the ring -Changing this requires a restart of Emacs to work correctly." - :group 'org-link-follow - :type 'interger) - -(defcustom org-link-frame-setup - '((vm . vm-visit-folder-other-frame) - (gnus . gnus-other-frame) - (file . find-file-other-window)) - "Setup the frame configuration for following links. -When following a link with Emacs, it may often be useful to display -this link in another window or frame. This variable can be used to -set this up for the different types of links. -For VM, use any of - `vm-visit-folder' - `vm-visit-folder-other-frame' -For Gnus, use any of - `gnus' - `gnus-other-frame' -For FILE, use any of - `find-file' - `find-file-other-window' - `find-file-other-frame' -For the calendar, use the variable `calendar-setup'. -For BBDB, it is currently only possible to display the matches in -another window." - :group 'org-link-follow - :type '(list - (cons (const vm) - (choice - (const vm-visit-folder) - (const vm-visit-folder-other-window) - (const vm-visit-folder-other-frame))) - (cons (const gnus) - (choice - (const gnus) - (const gnus-other-frame))) - (cons (const file) - (choice - (const find-file) - (const find-file-other-window) - (const find-file-other-frame))))) - -(defcustom org-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 C-u 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." - :group 'org-link-follow - :type 'boolean) - -(defcustom org-link-mailto-program '(browse-url "mailto:%a?subject=%s") - "Function and arguments to call for following mailto links. -This is a list with the first element being a lisp function, and the -remaining elements being arguments to the function. In string arguments, -%a will be replaced by the address, and %s will be replaced by the subject -if one was given like in ." - :group 'org-link-follow - :type '(choice - (const :tag "browse-url" (browse-url-mail "mailto:%a?subject=%s")) - (const :tag "compose-mail" (compose-mail "%a" "%s")) - (const :tag "message-mail" (message-mail "%a" "%s")) - (cons :tag "other" (function) (repeat :tag "argument" sexp)))) - -(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-mode document as \"Google Search\", -but really it would remove your entire home directory. -Therefore we advise against setting this variable to nil. -Just change it to `y-or-n-p' of you want to confirm with a -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))) - -(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-mode document as \"Google Search\", -but really it would remove your entire home directory. -Therefore we advise against setting this variable to nil. -Just change it to `y-or-n-p' of you want to confirm with a -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))) - -(defconst org-file-apps-defaults-gnu - '((remote . emacs) - (t . mailcap)) - "Default file applications on a UNIX or GNU/Linux system. -See `org-file-apps'.") - -(defconst org-file-apps-defaults-macosx - '((remote . emacs) - (t . "open %s") - ("ps" . "gv %s") - ("ps.gz" . "gv %s") - ("eps" . "gv %s") - ("eps.gz" . "gv %s") - ("dvi" . "xdvi %s") - ("fig" . "xfig %s")) - "Default file applications on a MacOS X system. -The system \"open\" is known as a default, but we use X11 applications -for some files for which the OS does not have a good default. -See `org-file-apps'.") - -(defconst org-file-apps-defaults-windowsnt - (list - '(remote . emacs) - (cons t - (list (if (featurep 'xemacs) - 'mswindows-shell-execute - 'w32-shell-execute) - "open" 'file))) - "Default file applications on a Windows NT system. -The system \"open\" is used for most files. -See `org-file-apps'.") - -(defcustom org-file-apps - '( - ("txt" . emacs) - ("tex" . emacs) - ("ltx" . emacs) - ("org" . emacs) - ("el" . emacs) - ("bib" . emacs) - ) - "External applications for opening `file:path' items in a document. -Org-mode uses system defaults for different file types, but -you can use this variable to set the application for a given file -extension. The entries in this list are cons cells where the car identifies -files and the cdr the corresponding command. Possible values for the -file identifier are - \"ext\" A string identifying an extension - `directory' Matches a directory - `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. - t Default for all remaining files - -Possible values for the command are: - `emacs' The file will be visited by the current Emacs process. - `default' Use the default application for this file type. - string A command to be executed by a shell; %s will be replaced - by the path to the file. - sexp A Lisp form which will be evaluated. The file path will - be available in the Lisp variable `file'. -For more examples, see the system specific constants -`org-file-apps-defaults-macosx' -`org-file-apps-defaults-windowsnt' -`org-file-apps-defaults-gnu'." - :group 'org-link-follow - :type '(repeat - (cons (choice :value "" - (string :tag "Extension") - (const :tag "Default for unrecognized files" t) - (const :tag "Remote file" remote) - (const :tag "Links to a directory" directory)) - (choice :value "" - (const :tag "Visit with Emacs" emacs) - (const :tag "Use system default" default) - (string :tag "Command") - (sexp :tag "Lisp form"))))) - -(defcustom org-mhe-search-all-folders nil - "Non-nil means, that the search for the mh-message will be extended to -all folders if the message cannot be found in the folder given in the link. -Searching all folders is very efficient with one of the search engines -supported by MH-E, but will be slow with pick." - :group 'org-link-follow - :type 'boolean) - -(defgroup org-remember nil - "Options concerning interaction with remember.el." - :tag "Org Remember" - :group 'org) - -(defcustom org-directory "~/org" - "Directory with org files. -This directory will be used as default to prompt for org files. -Used by the hooks for remember.el." - :group 'org-remember - :type 'directory) - -(defcustom org-default-notes-file "~/.notes" - "Default target for storing notes. -Used by the hooks for remember.el. This can be a string, or nil to mean -the value of `remember-data-file'. -You can set this on a per-template basis with the variable -`org-remember-templates'." - :group 'org-remember - :type '(choice - (const :tag "Default from remember-data-file" nil) - file)) - -(defcustom org-remember-store-without-prompt t - "Non-nil means, `C-c C-c' stores remember note without further promts. -In this case, you need `C-u C-c C-c' to get the prompts for -note file and headline. -When this variable is nil, `C-c C-c' give you the prompts, and -`C-u C-c C-c' trigger the fasttrack." - :group 'org-remember - :type 'boolean) - -(defcustom org-remember-default-headline "" - "The headline that should be the default location in the notes file. -When filing remember notes, the cursor will start at that position. -You can set this on a per-template basis with the variable -`org-remember-templates'." - :group 'org-remember - :type 'string) - -(defcustom org-remember-templates nil - "Templates for the creation of remember buffers. -When nil, just let remember make the buffer. -When not nil, this is a list of 5-element lists. In each entry, the first -element is a the name of the template, It should be a single short word. -The second element is a character, a unique key to select this template. -The third element is the template. The forth element is optional and can -specify a destination file for remember items created with this template. -The default file is given by `org-default-notes-file'. An optional fifth -element can specify the headline in that file that should be offered -first when the user is asked to file the entry. The default headline is -given in the variable `org-remember-default-headline'. - -The template specifies the structure of the remember buffer. It should have -a first line starting with a star, to act as the org-mode headline. -Furthermore, the following %-escapes will be replaced with content: - - %^{prompt} Prompt the user for a string and replace this sequence with it. - A default value and a completion table ca be specified like this: - %^{prompt|default|completion2|completion3|...} - %t time stamp, date only - %T time stamp with date and time - %u, %U like the above, but inactive time stamps - %^t like %t, but prompt for date. Similarly %^T, %^u, %^U - You may define a prompt like %^{Please specify birthday}t - %n user name (taken from `user-full-name') - %a annotation, normally the link created with org-store-link - %i initial content, the region when remember is called with C-u. - If %i is indented, the entire inserted text will be indented - as well. - %c content of the clipboard, or current kill ring head - %^g prompt for tags, with completion on tags in target file - %^G prompt for tags, with completion all tags in all agenda files - %:keyword specific information for certain link types, see below - %[pathname] insert the contents of the file given by `pathname' - %(sexp) evaluate elisp `(sexp)' and replace with the result - %! Store this note immediately after filling the template - - %? After completing the template, position cursor here. - -Apart from these general escapes, you can access information specific to the -link type that is created. For example, calling `remember' in emails or gnus -will record the author and the subject of the message, which you can access -with %:author and %:subject, respectively. Here is a complete list of what -is recorded for each link type. - -Link type | Available information --------------------+------------------------------------------------------ -bbdb | %:type %:name %:company -vm, wl, mh, rmail | %:type %:subject %:message-id - | %:from %:fromname %:fromaddress - | %:to %:toname %:toaddress - | %:fromto (either \"to NAME\" or \"from NAME\") -gnus | %:group, for messages also all email fields -w3, w3m | %:type %:url -info | %:type %:file %:node -calendar | %:type %:date" - :group 'org-remember - :get (lambda (var) ; Make sure all entries have 5 elements - (mapcar (lambda (x) - (if (not (stringp (car x))) (setq x (cons "" x))) - (cond ((= (length x) 4) (append x '(""))) - ((= (length x) 3) (append x '("" ""))) - (t x))) - (default-value var))) - :type '(repeat - :tag "enabled" - (list :value ("" ?a "\n" nil nil) - (string :tag "Name") - (character :tag "Selection Key") - (string :tag "Template") - (choice - (file :tag "Destination file") - (const :tag "Prompt for file" nil)) - (choice - (string :tag "Destination headline") - (const :tag "Selection interface for heading"))))) - -(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-remember - :type '(choice - (const :tag "Reverse always" t) - (const :tag "Reverse never" nil) - (repeat :tag "By file name regexp" - (cons regexp boolean)))) - -(defcustom org-refile-targets '((nil . (:level . 1))) - "Targets for refiling entries with \\[org-refile]. -This is 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 value fields will be used to retrieve - a file name or a list of file names. Nil means, refile to a different - heading 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 targes 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. - - a cons cell (:maxlevel . N). Any headline with level <= N is a target." -;; FIXME: what if there are a var and func with same name??? - :group 'org-remember - :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 :tag) (string)) - (cons :tag "TODO keyword" (const :todo) (string)) - (cons :tag "Regular expression" (const :regexp) (regexp)) - (cons :tag "Level number" (const :level) (integer)) - (cons :tag "Max Level number" (const :maxlevel) (integer)))))) - -(defcustom org-refile-use-outline-path nil - "Non-nil means, provide refile targets as paths. -So a level 3 headline will be available as level1/level2/level3. -When the value is `file', also include the file name (without directory) -into the path. When `full-file-path', include the full file path." - :group 'org-remember - :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))) - -(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) - -(defcustom org-todo-keywords '((sequence "TODO" "DONE")) - "List of TODO entry keyword sequences and their interpretation. -\\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-mode produces. If one of -the \"keywords\" is the vertical bat \"|\" 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. - -For backward compatibility, this variable may also be just a list -of keywords - in this case the interptetation (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" - (const :tag "Sequence (cycling hits every state)" sequence) - (const :tag "Type (cycling directly to DONE)" type)) - (repeat - (string :tag "Keyword")))))) - -(defvar org-todo-keywords-1 nil) -(make-variable-buffer-local 'org-todo-keywords-1) -(defvar org-todo-keywords-for-agenda nil) -(defvar org-done-keywords-for-agenda nil) -(defvar org-not-done-keywords nil) -(make-variable-buffer-local 'org-not-done-keywords) -(defvar org-done-keywords nil) -(make-variable-buffer-local 'org-done-keywords) -(defvar org-todo-heads nil) -(make-variable-buffer-local 'org-todo-heads) -(defvar org-todo-sets nil) -(make-variable-buffer-local 'org-todo-sets) -(defvar org-todo-log-states nil) -(make-variable-buffer-local 'org-todo-log-states) -(defvar org-todo-kwd-alist nil) -(make-variable-buffer-local 'org-todo-kwd-alist) -(defvar org-todo-key-alist nil) -(make-variable-buffer-local 'org-todo-key-alist) -(defvar org-todo-key-trigger nil) -(make-variable-buffer-local 'org-todo-key-trigger) - -(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 'prefix - "Non-nil means, use the fast todo selection scheme with C-c C-t. -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. `C-u C-c C-t' in an Org-mode buffer, and `C-u 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-after-todo-state-change-hook nil - "Hook which is run after the state of a TODO item was changed. -The new state (a string with a TODO keyword, or nil) is available in the -Lisp variable `state'." - :group 'org-todo - :type 'hook) - -(defcustom org-log-done nil - "When set, insert a (non-active) time stamp when TODO entry is marked DONE. -When the state of an entry is changed from nothing or a DONE state to -a not-done TODO state, remove a previous closing date. - -This can also be a list of symbols indicating under which conditions -the time stamp recording the action should be annotated with a short note. -Valid members of this list are - - done Offer to record a note when marking entries done - state Offer to record a note whenever changing the TODO state - of an item. This is only relevant if TODO keywords are - interpreted as sequence, see variable `org-todo-interpretation'. - When `state' is set, this includes tracking `done'. - clock-out Offer to record a note when clocking out of an item. - -A separate window will then pop up and allow you to type a note. -After finishing with C-c C-c, the note will be added directly after the -timestamp, as a plain list item. See also the variable -`org-log-note-headings'. - -Logging can also be configured on a per-file basis by adding one of -the following lines anywhere in the buffer: - - #+STARTUP: logdone - #+STARTUP: nologging - #+STARTUP: lognotedone - #+STARTUP: lognotestate - #+STARTUP: lognoteclock-out - -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 "off" nil) - (const :tag "on" t) - (set :tag "on, with notes, detailed control" :greedy t :value (done) - (const :tag "when item is marked DONE" done) - (const :tag "when TODO state changes" state) - (const :tag "when clocking out" clock-out)))) - -(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 %t") - (clock-out . "")) - "Headings for notes added when clocking out or closing TODO items. -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. -%t in the heading will be replaced by a time stamp. -%s will be replaced by the new TODO state, in double quotes. -%u will be replaced by the user name. -%U will be replaced by the full user name." - :group 'org-todo - :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 clocking out" clock-out) string))) - -(defcustom org-log-states-order-reversed t - "Non-nil means, the latest state change note will be directly after heading. -When nil, the notes will be orderer according to time." - :group 'org-todo - :group 'org-progress - :type 'boolean) - -(defcustom org-log-repeat t - "Non-nil means, prompt for a note when REPEAT is resetting a TODO entry. -When nil, no note will be taken. -This option can also be set with on a per-file-basis with - - #+STARTUP: logrepeat - #+STARTUP: nologrepeat - -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 'boolean) - -(defcustom org-clock-into-drawer 2 - "Should clocking info be wrapped into a drawer? -When t, clocking info will always be inserted into a :CLOCK: drawer. -If necessary, the drawer will be created. -When nil, the drawer will not be created, but used when present. -When an integer and the number of clocking entries in an item -reaches or exceeds this number, a drawer will be created." - :group 'org-todo - :group 'org-progress - :type '(choice - (const :tag "Always" t) - (const :tag "Only when drawer exists" nil) - (integer :tag "When at least N clock entries"))) - -(defcustom org-clock-out-when-done t - "When t, the clock will be stopped when the relevant entry is marked DONE. -Nil means, clock will keep running until stopped explicitly with -`C-c C-x C-o', or until the clock is started in a different item." - :group 'org-progress - :type 'boolean) - -(defcustom org-clock-in-switch-to-state nil - "Set task to a special todo state while clocking it. -The value should be the state to which the entry should be switched." - :group 'org-progress - :group 'org-todo - :type '(choice - (const :tag "Don't force a state" nil) - (string :tag "State"))) - -(defgroup org-priorities nil - "Priorities in Org-mode." - :tag "Org Priorities" - :group 'org-todo) - -(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 get if no explicit priority is given." - :group 'org-priorities - :type 'character) - -(defcustom org-priority-start-cycle-with-default t - "Non-nil means, start with default priority when starting to cycle. -When this is nil, the first step in the cycle will be (depending on the -command used) one higher or lower that the default priority." - :group 'org-priorities - :type 'boolean) - -(defgroup org-time nil - "Options concerning time stamps and deadlines in Org-mode." - :tag "Org Time" - :group 'org) - -(defcustom org-insert-labeled-timestamps-at-point nil - "Non-nil means, SCHEDULED and DEADLINE timestamps are inserted at point. -When nil, these labeled time stamps are forces into the second line of an -entry, just after the headline. When scheduling from the global TODO list, -the time stamp will always be forced into the second line." - :group 'org-time - :type 'boolean) - -(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>") - "Formats for `format-time-string' which are used for time stamps. -It is not recommended to change this constant.") - -(defcustom org-time-stamp-rounding-minutes 0 - "Number of minutes to round time stamps to upon insertion. -When zero, insert the time unmodified. Useful rounding numbers -should be factors of 60, so for example 5, 10, 15. -When this is not zero, you can still force an exact time-stamp by using -a double prefix argument to a time-stamp command like `C-c .' or `C-c !'." - :group 'org-time - :type 'integer) - -(defcustom org-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 overlayed over the default ISO format if the variable -`org-display-custom-times' is set. Time like %H:%M should be at the -end of the second format." - :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-read-date-prefer-future t - "Non-nil means, assume future for incomplete date input from user. -This affects the following situations: -1. The user gives a day, but no month. - For example, if today is the 15th, and you enter \"3\", Org-mode will - read this as the third of *next* month. However, if you enter \"17\", - it will be considered as *this* month. -2. The user gives a month but not a year. - For example, if it is april and you enter \"feb 2\", this will be read - as feb 2, *next* year. \"May 5\", however, will be this year. - -When this option is nil, the current month and year will always be used -as defaults." - :group 'org-time - :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) -(if (fboundp 'defvaralias) - (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. -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. - -FIXME: -IMPORTANT: This is still a very experimental feature, it may disappear -again or it may be extended to mean more things." - :group 'org-time - :type 'number) - -(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) - -(defcustom org-clock-heading-function nil - "When non-nil, should be a function to create `org-clock-heading'. -This is the string shown in the mode line when a clock is running. -The function is called with point at the beginning of the headline." - :group 'org-time ; FIXME: Should we have a separate group???? - :type 'function) - -(defgroup org-tags nil - "Options concerning tags in Org-mode." - :tag "Org Tags" - :group 'org) - -(defcustom org-tag-alist nil - "List of tags allowed in Org-mode files. -When this list is nil, Org-mode will base TAG input on what is already in the -buffer. -The value of this variable is an alist, the car of each entry must be a -keyword as a string, the cdr may be a character that is used to select -that tag through the fast-tag-selection interface. -See the manual for details." - :group 'org-tags - :type '(repeat - (choice - (cons (string :tag "Tag name") - (character :tag "Access char")) - (const :tag "Start radio group" (:startgroup)) - (const :tag "End radio group" (:endgroup))))) - -(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 -80 - "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." - :group 'org-tags - :type 'integer) - -(defcustom org-auto-align-tags t - "Non-nil means, realign tags after pro/demotion of TODO state change. -These operations change the length of a headline and therefore shift -the tags around. With this options turned on, after each such operation -the tags are again aligned to `org-tags-column'." - :group 'org-tags - :type 'boolean) - -(defcustom org-use-tag-inheritance t - "Non-nil means, tags in levels apply also for sublevels. -When nil, only the tags directly given in a specific line apply there. -If you turn off this option, you very likely want to turn on the -companion option `org-tags-match-list-sublevels'." - :group 'org-tags - :type 'boolean) - -(defcustom org-tags-match-list-sublevels nil - "Non-nil means list also sublevels of headlines matching tag search. -Because of tag inheritance (see variable `org-use-tag-inheritance'), -the sublevels of a headline matching a tag search often also match -the same search. Listing all of them can create very long lists. -Setting this variable to nil causes subtrees of a match to be skipped. -This option is off by default, because inheritance in on. If you turn -inheritance off, you very likely want to turn this option on. - -As a special case, if the tag search is restricted to TODO items, the -value of this variable is ignored and sublevels are always checked, to -make sure all corresponding TODO items find their way into the list." - :group 'org-tags - :type 'boolean) - -(defvar org-tags-history nil - "History of minibuffer reads for tags.") -(defvar org-last-tags-completion-table nil - "The last used completion table for tags.") -(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-use-property-inheritance nil - "Non-nil means, properties apply also for sublevels. -This setting is only relevant during property searches, not when querying -an entry with `org-entry-get'. To retrieve a property with inheritance, -you need to call `org-entry-get' with the inheritance flag. -Turning this on can cause significant overhead when doing a search, so -this is turned off by default. -When nil, only the properties directly given in the current entry count. -The value may also be a list of properties that shouldhave inheritance. - -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." - :group 'org-properties - :type '(choice - (const :tag "Not" nil) - (const :tag "Always" nil) - (repeat :tag "Specific properties" (string :tag "Property")))) - -(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-global-properties nil - "List of property/value pairs that can be inherited by any entry. -You can set buffer-local values for this by adding lines like - -#+PROPERTY: NAME VALUE" - :group 'org-properties - :type '(repeat - (cons (string :tag "Property") - (string :tag "Value")))) - -(defvar org-local-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 org-category nil - "Variable used by org files to set a category for agenda display. -Such files should use a file variable to set it, for example - -# -*- mode: org; org-category: \"ELisp\" - -or contain a special line - -#+CATEGORY: ELisp - -If the file does not specify a category, then file's base name -is used instead.") -(make-variable-buffer-local 'org-category) - -(defcustom org-agenda-files nil - "The files to be used for agenda display. -Entries may be added to this list with \\[org-agenda-file-to-front] and removed with -\\[org-remove-file]. You can also use customize to edit the list. - -If 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." - :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-skip-unavailable-files nil - "t means to just skip non-reachable files in `org-agenda-files'. -Nil means to remove them, after a query, from the list." - :group 'org-agenda - :type 'boolean) - -(defcustom org-agenda-multi-occur-extra-files nil - "List of extra files to be searched by `org-occur-in-agenda-files'. -The files in `org-agenda-files' are always searched." - :group 'org-agenda - :type '(repeat file)) - -(defcustom org-agenda-confirm-kill 1 - "When set, remote killing from the agenda buffer needs confirmation. -When t, a confirmation is always needed. When a number N, confirmation is -only needed when the text to be killed contains more than N non-white lines." - :group 'org-agenda - :type '(choice - (const :tag "Never" nil) - (const :tag "Always" t) - (number :tag "When more than N lines"))) - -(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-agenda-compact-blocks nil - "Non-nil means, make the block agenda more compact. -This is done by leaving out unnecessary lines." - :group 'org-agenda - :type nil) - -(defgroup org-agenda-export nil - "Options concerning exporting agenda views in Org-mode." - :tag "Org Agenda Export" - :group 'org-agenda) - -(defcustom org-agenda-with-colors t - "Non-nil means, use colors in agenda views." - :group 'org-agenda-export - :type 'boolean) - -(defcustom org-agenda-exporter-settings nil - "Alist of variable/value pairs that should be active during agenda export. -This is a good place to set uptions for ps-print and for htmlize." - :group 'org-agenda-export - :type '(repeat - (list - (variable) - (sexp :tag "Value")))) - -(defcustom org-agenda-export-html-style "" - "The style specification for exported HTML Agenda files. -If this variable contains a string, it will replace the default - -or, if you want to keep the style in a file, - - - -As the value of this option simply gets inserted into the HTML header, -you can \"misuse\" it to also add other text to the header. However, - is required, if not present the variable will be ignored." - :group 'org-agenda-export - :group 'org-export-html - :type 'string) - -(defgroup org-agenda-custom-commands nil - "Options concerning agenda views in Org-mode." - :tag "Org Agenda Custom Commands" - :group 'org-agenda) - -(defcustom org-agenda-custom-commands nil - "Custom commands for the agenda. -These commands will be offered on the splash screen displayed by the -agenda dispatcher \\[org-agenda]. Each entry is a list like this: - - (key desc type match options files) - -key The key (one or more characters as a string) to be associated - with the command. -desc A description of the commend, when omitted or nil, a default - description is built using MATCH. -type The command type, any of the following symbols: - todo Entries with a specific TODO keyword, in all agenda files. - tags Tags match in all agenda files. - tags-todo Tags match in all agenda files, TODO entries only. - todo-tree Sparse tree of specific TODO keyword in *current* file. - tags-tree Sparse tree with all tags matches in *current* file. - occur-tree Occur sparse tree for *current* file. - ... A user-defined function. -match What to search for: - - a single keyword for TODO keyword searches - - a tags match expression for tags searches - - a regular expression for occur searches -options A list of option settings, similar to that in a let form, so like - this: ((opt1 val1) (opt2 val2) ...) -files A list of files file to write the produced agenda buffer to - with the command `org-store-agenda-views'. - If a file name ends in \".html\", an HTML version of the buffer - is written out. If it ends in \".ps\", a postscript version is - produced. Otherwide, only the plain text is written to the file. - -You can also define a set of commands, to create a composite agenda buffer. -In this case, an entry looks like this: - - (key desc (cmd1 cmd2 ...) general-options file) - -where - -desc A description string to be displayed in the dispatcher menu. -cmd An agenda command, similar to the above. However, tree commands - are no allowed, but instead you can get agenda and global todo list. - So valid commands for a set are: - (agenda) - (alltodo) - (stuck) - (todo \"match\" options files) - (tags \"match\" options files) - (tags-todo \"match\" options files) - -Each command can carry a list of options, and another set of options can be -given for the whole set of commands. Individual command options take -precedence over the general options. - -When using several characters as key to a command, the first characters -are prefix commands. For the dispatcher to display useful information, you -should provide a description for the prefix, like - - (setq org-agenda-custom-commands - '((\"h\" . \"HOME + Name tag searches\") ; describe prefix \"h\" - (\"hl\" tags \"+HOME+Lisa\") - (\"hp\" tags \"+HOME+Peter\") - (\"hk\" tags \"+HOME+Kim\")))" - :group 'org-agenda-custom-commands - :type '(repeat - (choice :value ("a" "" tags "" nil) - (list :tag "Single command" - (string :tag "Access Key(s) ") - (option (string :tag "Description")) - (choice - (const :tag "Agenda" agenda) - (const :tag "TODO list" alltodo) - (const :tag "Stuck projects" stuck) - (const :tag "Tags search (all agenda files)" tags) - (const :tag "Tags search of TODO entries (all agenda files)" tags-todo) - (const :tag "TODO keyword search (all agenda files)" todo) - (const :tag "Tags sparse tree (current buffer)" tags-tree) - (const :tag "TODO keyword tree (current buffer)" todo-tree) - (const :tag "Occur tree (current buffer)" occur-tree) - (sexp :tag "Other, user-defined function")) - (string :tag "Match") - (repeat :tag "Local options" - (list (variable :tag "Option") (sexp :tag "Value"))) - (option (repeat :tag "Export" (file :tag "Export to")))) - (list :tag "Command series, all agenda files" - (string :tag "Access Key(s)") - (string :tag "Description ") - (repeat - (choice - (const :tag "Agenda" (agenda)) - (const :tag "TODO list" (alltodo)) - (const :tag "Stuck projects" (stuck)) - (list :tag "Tags search" - (const :format "" tags) - (string :tag "Match") - (repeat :tag "Local options" - (list (variable :tag "Option") - (sexp :tag "Value")))) - - (list :tag "Tags search, TODO entries only" - (const :format "" tags-todo) - (string :tag "Match") - (repeat :tag "Local options" - (list (variable :tag "Option") - (sexp :tag "Value")))) - - (list :tag "TODO keyword search" - (const :format "" todo) - (string :tag "Match") - (repeat :tag "Local options" - (list (variable :tag "Option") - (sexp :tag "Value")))) - - (list :tag "Other, user-defined function" - (symbol :tag "function") - (string :tag "Match") - (repeat :tag "Local options" - (list (variable :tag "Option") - (sexp :tag "Value")))))) - - (repeat :tag "General options" - (list (variable :tag "Option") - (sexp :tag "Value"))) - (option (repeat :tag "Export" (file :tag "Export to")))) - (cons :tag "Prefix key documentation" - (string :tag "Access Key(s)") - (string :tag "Description "))))) - -(defcustom org-stuck-projects - '("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil "") - "How to identify stuck projects. -This is a list of four items: -1. A tags/todo matcher string that is used to identify a project. - The entire tree below a headline matched by this is considered one project. -2. A list of TODO keywords identifying non-stuck projects. - If the project subtree contains any headline with one of these todo - keywords, the project is considered to be not stuck. If you specify - \"*\" as a keyword, any TODO keyword will mark the project unstuck. -3. A list of tags identifying non-stuck projects. - If the project subtree contains any headline with one of these tags, - the project is considered to be not stuck. If you specify \"*\" as - a tag, any tag will mark the project unstuck. -4. An arbitrary regular expression matching non-stuck projects. - -After defining this variable, you may use \\[org-agenda-list-stuck-projects] -or `C-c a #' to produce the list." - :group 'org-agenda-custom-commands - :type '(list - (string :tag "Tags/TODO match to identify a project") - (repeat :tag "Projects are *not* stuck if they have an entry with TODO keyword any of" (string)) - (repeat :tag "Projects are *not* stuck if they have an entry with TAG being any of" (string)) - (regexp :tag "Projects are *not* stuck if this regexp matches\ninside the subtree"))) - - -(defgroup org-agenda-skip nil - "Options concerning skipping parts of agenda files." - :tag "Org Agenda Skip" - :group 'org-agenda) - -(defcustom org-agenda-todo-list-sublevels t - "Non-nil means, check also the sublevels of a TODO entry for TODO entries. -When nil, the sublevels of a TODO entry are not checked, resulting in -potentially much shorter TODO lists." - :group 'org-agenda-skip - :group 'org-todo - :type 'boolean) - -(defcustom org-agenda-todo-ignore-with-date nil - "Non-nil means, don't show entries with a date in the global todo list. -You can use this if you prefer to mark mere appointments with a TODO keyword, -but don't want them to show up in the TODO list. -When this is set, it also covers deadlines and scheduled items, the settings -of `org-agenda-todo-ignore-scheduled' and `org-agenda-todo-ignore-deadlines' -will be ignored." - :group 'org-agenda-skip - :group 'org-todo - :type 'boolean) - -(defcustom org-agenda-todo-ignore-scheduled nil - "Non-nil means, don't show scheduled entries in the global todo list. -The idea behind this is that by scheduling it, you have already taken care -of this item. -See also `org-agenda-todo-ignore-with-date'." - :group 'org-agenda-skip - :group 'org-todo - :type 'boolean) - -(defcustom org-agenda-todo-ignore-deadlines nil - "Non-nil means, don't show near deadline entries in the global todo list. -Near means closer than `org-deadline-warning-days' days. -The idea behind this is that such items will appear in the agenda anyway. -See also `org-agenda-todo-ignore-with-date'." - :group 'org-agenda-skip - :group 'org-todo - :type 'boolean) - -(defcustom org-agenda-skip-scheduled-if-done nil - "Non-nil means don't show scheduled items in agenda when they are done. -This is relevant for the daily/weekly agenda, not for the TODO list. And -it applies only to the actual date of the scheduling. Warnings about -an item with a past scheduling dates are always turned off when the item -is DONE." - :group 'org-agenda-skip - :type 'boolean) - -(defcustom org-agenda-skip-deadline-if-done nil - "Non-nil means don't show deadines when the corresponding item is done. -When nil, the deadline is still shown and should give you a happy feeling. -This is relevant for the daily/weekly agenda. And it applied only to the -actualy date of the deadline. Warnings about approching and past-due -deadlines are always turned off when the item is DONE." - :group 'org-agenda-skip - :type 'boolean) - -(defcustom org-agenda-skip-timestamp-if-done nil - "Non-nil means don't don't select item by timestamp or -range if it is DONE." - :group 'org-agenda-skip - :type 'boolean) - -(defcustom org-timeline-show-empty-dates 3 - "Non-nil means, `org-timeline' also shows dates without an entry. -When nil, only the days which actually have entries are shown. -When t, all days between the first and the last date are shown. -When an integer, show also empty dates, but if there is a gap of more than -N days, just insert a special line indicating the size of the gap." - :group 'org-agenda-skip - :type '(choice - (const :tag "None" nil) - (const :tag "All" t) - (number :tag "at most"))) - - -(defgroup org-agenda-startup nil - "Options concerning initial settings in the Agenda in Org Mode." - :tag "Org Agenda Startup" - :group 'org-agenda) - -(defcustom org-finalize-agenda-hook nil - "Hook run just before displaying an agenda buffer." - :group 'org-agenda-startup - :type 'hook) - -(defcustom org-agenda-mouse-1-follows-link nil - "Non-nil means, mouse-1 on a link will follow the link in the agenda. -A longer mouse click will still set point. Does not wortk on XEmacs. -Needs to be set before org.el is loaded." - :group 'org-agenda-startup - :type 'boolean) - -(defcustom org-agenda-start-with-follow-mode nil - "The initial value of follow-mode in a newly created agenda window." - :group 'org-agenda-startup - :type 'boolean) - -(defgroup org-agenda-windows nil - "Options concerning the windows used by the Agenda in Org Mode." - :tag "Org Agenda Windows" - :group 'org-agenda) - -(defcustom org-agenda-window-setup 'reorganize-frame - "How the agenda buffer should be displayed. -Possible values for this option are: - -current-window Show agenda in the current window, keeping all other windows. -other-frame Use `switch-to-buffer-other-frame' to display agenda. -other-window Use `switch-to-buffer-other-window' to display agenda. -reorganize-frame Show only two windows on the current frame, the current - window and the agenda. -See also the variable `org-agenda-restore-windows-after-quit'." - :group 'org-agenda-windows - :type '(choice - (const current-window) - (const other-frame) - (const other-window) - (const reorganize-frame))) - -(defcustom org-agenda-window-frame-fractions '(0.5 . 0.75) - "The min and max height of the agenda window as a fraction of frame height. -The value of the variable is a cons cell with two numbers between 0 and 1. -It only matters if `org-agenda-window-setup' is `reorganize-frame'." - :group 'org-agenda-windows - :type '(cons (number :tag "Minimum") (number :tag "Maximum"))) - -(defcustom org-agenda-restore-windows-after-quit nil - "Non-nil means, restore window configuration open exiting agenda. -Before the window configuration is changed for displaying the agenda, -the current status is recorded. When the agenda is exited with -`q' or `x' and this option is set, the old state is restored. If -`org-agenda-window-setup' is `other-frame', the value of this -option will be ignored.." - :group 'org-agenda-windows - :type 'boolean) - -(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))) - -(defgroup org-agenda-daily/weekly nil - "Options concerning the daily/weekly agenda." - :tag "Org Agenda Daily/Weekly" - :group 'org-agenda) - -(defcustom org-agenda-ndays 7 - "Number of days to include in overview display. -Should be 1 or 7." - :group 'org-agenda-daily/weekly - :type 'number) - -(defcustom org-agenda-start-on-weekday 1 - "Non-nil means, start the overview always on the specified weekday. -0 denotes Sunday, 1 denotes Monday etc. -When nil, always start on the current day." - :group 'org-agenda-daily/weekly - :type '(choice (const :tag "Today" nil) - (number :tag "Weekday No."))) - -(defcustom org-agenda-show-all-dates t - "Non-nil means, `org-agenda' shows every day in the selected range. -When nil, only the days which actually have entries are shown." - :group 'org-agenda-daily/weekly - :type 'boolean) - -(defcustom org-agenda-format-date 'org-agenda-format-date-aligned - "Format string for displaying dates in the agenda. -Used by the daily/weekly agenda and by the timeline. This should be -a format string understood by `format-time-string', or a function returning -the formatted date as a string. The function must take a single argument, -a calendar-style date list like (month day year)." - :group 'org-agenda-daily/weekly - :type '(choice - (string :tag "Format string") - (function :tag "Function"))) - -(defun org-agenda-format-date-aligned (date) - "Format a date string for display in the daily/weekly agenda, or timeline. -This function makes sure that dates are aligned for easy reading." - (format "%-9s %2d %s %4d" - (calendar-day-name date) - (extract-calendar-day date) - (calendar-month-name (extract-calendar-month date)) - (extract-calendar-year date))) - -(defcustom org-agenda-include-diary nil - "If non-nil, include in the agenda entries from the Emacs Calendar's diary." - :group 'org-agenda-daily/weekly - :type 'boolean) - -(defcustom org-agenda-include-all-todo nil - "Set means weekly/daily agenda will always contain all TODO entries. -The TODO entries will be listed at the top of the agenda, before -the entries for specific days." - :group 'org-agenda-daily/weekly - :type 'boolean) - -(defcustom org-agenda-repeating-timestamp-show-all t - "Non-nil means, show all occurences of a repeating stamp in the agenda. -When nil, only one occurence is shown, either today or the -nearest into the future." - :group 'org-agenda-daily/weekly - :type 'boolean) - -(defcustom org-deadline-warning-days 14 - "No. of days before expiration during which a deadline becomes active. -This variable governs the display in sparse trees and in the agenda. -When negative, it means use this number (the absolute value of it) -even if a deadline has a different individual lead time specified." - :group 'org-time - :group 'org-agenda-daily/weekly - :type 'number) - -(defcustom org-scheduled-past-days 10000 - "No. of days to continue listing scheduled items that are not marked DONE. -When an item is scheduled on a date, it shows up in the agenda on this -day and will be listed until it is marked done for the number of days -given here." - :group 'org-agenda-daily/weekly - :type 'number) - -(defgroup org-agenda-time-grid nil - "Options concerning the time grid in the Org-mode Agenda." - :tag "Org Agenda Time Grid" - :group 'org-agenda) - -(defcustom org-agenda-use-time-grid t - "Non-nil means, show a time grid in the agenda schedule. -A time grid is a set of lines for specific times (like every two hours between -8:00 and 20:00). The items scheduled for a day at specific times are -sorted in between these lines. -For details about when the grid will be shown, and what it will look like, see -the variable `org-agenda-time-grid'." - :group 'org-agenda-time-grid - :type 'boolean) - -(defcustom org-agenda-time-grid - '((daily today require-timed) - "----------------" - (800 1000 1200 1400 1600 1800 2000)) - - "The settings for time grid for agenda display. -This is a list of three items. The first item is again a list. It contains -symbols specifying conditions when the grid should be displayed: - - daily if the agenda shows a single day - weekly if the agenda shows an entire week - today show grid on current date, independent of daily/weekly display - require-timed show grid only if at least one item has a time specification - -The second item is a string which will be places behing the grid time. - -The third item is a list of integers, indicating the times that should have -a grid line." - :group 'org-agenda-time-grid - :type - '(list - (set :greedy t :tag "Grid Display Options" - (const :tag "Show grid in single day agenda display" daily) - (const :tag "Show grid in weekly agenda display" weekly) - (const :tag "Always show grid for today" today) - (const :tag "Show grid only if any timed entries are present" - require-timed) - (const :tag "Skip grid times already present in an entry" - remove-match)) - (string :tag "Grid String") - (repeat :tag "Grid Times" (integer :tag "Time")))) - -(defgroup org-agenda-sorting nil - "Options concerning sorting in the Org-mode Agenda." - :tag "Org Agenda Sorting" - :group 'org-agenda) - -(defconst org-sorting-choice - '(choice - (const time-up) (const time-down) - (const category-keep) (const category-up) (const category-down) - (const tag-down) (const tag-up) - (const priority-up) (const priority-down)) - "Sorting choices.") - -(defcustom org-agenda-sorting-strategy - '((agenda time-up category-keep priority-down) - (todo category-keep priority-down) - (tags category-keep priority-down)) - "Sorting structure for the agenda items of a single day. -This is a list of symbols which will be used in sequence to determine -if an entry should be listed before another entry. The following -symbols are recognized: - -time-up Put entries with time-of-day indications first, early first -time-down Put entries with time-of-day indications first, late first -category-keep Keep the default order of categories, corresponding to the - sequence in `org-agenda-files'. -category-up Sort alphabetically by category, A-Z. -category-down Sort alphabetically by category, Z-A. -tag-up Sort alphabetically by last tag, A-Z. -tag-down Sort alphabetically by last tag, Z-A. -priority-up Sort numerically by priority, high priority last. -priority-down Sort numerically by priority, high priority first. - -The different possibilities will be tried in sequence, and testing stops -if one comparison returns a \"not-equal\". For example, the default - '(time-up category-keep priority-down) -means: Pull out all entries having a specified time of day and sort them, -in order to make a time schedule for the current day the first thing in the -agenda listing for the day. Of the entries without a time indication, keep -the grouped in categories, don't sort the categories, but keep them in -the sequence given in `org-agenda-files'. Within each category sort by -priority. - -Leaving out `category-keep' would mean that items will be sorted across -categories by priority. - -Instead of a single list, this can also be a set of list for specific -contents, with a context symbol in the car of the list, any of -`agenda', `todo', `tags' for the corresponding agenda views." - :group 'org-agenda-sorting - :type `(choice - (repeat :tag "General" ,org-sorting-choice) - (list :tag "Individually" - (cons (const :tag "Strategy for Weekly/Daily agenda" agenda) - (repeat ,org-sorting-choice)) - (cons (const :tag "Strategy for TODO lists" todo) - (repeat ,org-sorting-choice)) - (cons (const :tag "Strategy for Tags matches" tags) - (repeat ,org-sorting-choice))))) - -(defcustom org-sort-agenda-notime-is-late t - "Non-nil means, items without time are considered late. -This is only relevant for sorting. When t, items which have no explicit -time like 15:30 will be considered as 99:01, i.e. later than any items which -do have a time. When nil, the default time is before 0:00. You can use this -option to decide if the schedule for today should come before or after timeless -agenda entries." - :group 'org-agenda-sorting - :type 'boolean) - -(defgroup org-agenda-line-format nil - "Options concerning the entry prefix in the Org-mode agenda display." - :tag "Org Agenda Line Format" - :group 'org-agenda) - -(defcustom org-agenda-prefix-format - '((agenda . " %-12:c%?-12t% s") - (timeline . " % s") - (todo . " %-12:c") - (tags . " %-12:c")) - "Format specifications for the prefix of items in the agenda views. -An alist with four entries, for the different agenda types. The keys to the -sublists are `agenda', `timeline', `todo', and `tags'. The values -are format strings. -This format works similar to a printf format, with the following meaning: - - %c the category of the item, \"Diary\" for entries from the diary, or - as given by the CATEGORY keyword or derived from the file name. - %T the *last* tag of the item. Last because inherited tags come - first in the list. - %t the time-of-day specification if one applies to the entry, in the - format HH:MM - %s Scheduling/Deadline information, a short string - -All specifiers work basically like the standard `%s' of printf, but may -contain two additional characters: A question mark just after the `%' and -a whitespace/punctuation character just before the final letter. - -If the first character after `%' is a question mark, the entire field -will only be included if the corresponding value applies to the -current entry. This is useful for fields which should have fixed -width when present, but zero width when absent. For example, -\"%?-12t\" will result in a 12 character time field if a time of the -day is specified, but will completely disappear in entries which do -not contain a time. - -If there is punctuation or whitespace character just before the final -format letter, this character will be appended to the field value if -the value is not empty. For example, the format \"%-12:c\" leads to -\"Diary: \" if the category is \"Diary\". If the category were be -empty, no additional colon would be interted. - -The default value of this option is \" %-12:c%?-12t% s\", meaning: -- Indent the line with two space characters -- Give the category in a 12 chars wide field, padded with whitespace on - the right (because of `-'). Append a colon if there is a category - (because of `:'). -- If there is a time-of-day, put it into a 12 chars wide field. If no - time, don't put in an empty field, just skip it (because of '?'). -- Finally, put the scheduling information and append a whitespace. - -As another example, if you don't want the time-of-day of entries in -the prefix, you could use: - - (setq org-agenda-prefix-format \" %-11:c% s\") - -See also the variables `org-agenda-remove-times-when-in-prefix' and -`org-agenda-remove-tags'." - :type '(choice - (string :tag "General format") - (list :greedy t :tag "View dependent" - (cons (const agenda) (string :tag "Format")) - (cons (const timeline) (string :tag "Format")) - (cons (const todo) (string :tag "Format")) - (cons (const tags) (string :tag "Format")))) - :group 'org-agenda-line-format) - -(defvar org-prefix-format-compiled nil - "The compiled version of the most recently used prefix format. -See the variable `org-agenda-prefix-format'.") - -(defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ") - "Text preceeding scheduled items in the agenda view. -THis is a list with two strings. The first applies when the item is -scheduled on the current day. The second applies when it has been scheduled -previously, it may contain a %d to capture how many days ago the item was -scheduled." - :group 'org-agenda-line-format - :type '(list - (string :tag "Scheduled today ") - (string :tag "Scheduled previously"))) - -(defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: ") - "Text preceeding deadline items in the agenda view. -This is a list with two strings. The first applies when the item has its -deadline on the current day. The second applies when it is in the past or -in the future, it may contain %d to capture how many days away the deadline -is (was)." - :group 'org-agenda-line-format - :type '(list - (string :tag "Deadline today ") - (string :tag "Deadline relative"))) - -(defcustom org-agenda-remove-times-when-in-prefix t - "Non-nil means, remove duplicate time specifications in agenda items. -When the format `org-agenda-prefix-format' contains a `%t' specifier, a -time-of-day specification in a headline or diary entry is extracted and -placed into the prefix. If this option is non-nil, the original specification -\(a timestamp or -range, or just a plain time(range) specification like -11:30-4pm) will be removed for agenda display. This makes the agenda less -cluttered. -The option can be t or nil. It may also be the symbol `beg', indicating -that the time should only be removed what it is located at the beginning of -the headline/diary entry." - :group 'org-agenda-line-format - :type '(choice - (const :tag "Always" t) - (const :tag "Never" nil) - (const :tag "When at beginning of entry" beg))) - - -(defcustom org-agenda-default-appointment-duration nil - "Default duration for appointments that only have a starting time. -When nil, no duration is specified in such cases. -When non-nil, this must be the number of minutes, e.g. 60 for one hour." - :group 'org-agenda-line-format - :type '(choice - (integer :tag "Minutes") - (const :tag "No default duration"))) - - -(defcustom org-agenda-remove-tags nil - "Non-nil means, remove the tags from the headline copy in the agenda. -When this is the symbol `prefix', only remove tags when -`org-agenda-prefix-format' contains a `%T' specifier." - :group 'org-agenda-line-format - :type '(choice - (const :tag "Always" t) - (const :tag "Never" nil) - (const :tag "When prefix format contains %T" prefix))) - -(if (fboundp 'defvaralias) - (defvaralias 'org-agenda-remove-tags-when-in-prefix - 'org-agenda-remove-tags)) - -(defcustom org-agenda-tags-column -80 - "Shift tags in agenda items to this column. -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." - :group 'org-agenda-line-format - :type 'integer) - -(if (fboundp 'defvaralias) - (defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column)) - -(defcustom org-agenda-fontify-priorities t - "Non-nil means, highlight low and high priorities in agenda. -When t, the highest priority entries are bold, lowest priority italic. -This may also be an association list of priority faces. The face may be -a names face, or a list like `(:background \"Red\")'." - :group 'org-agenda-line-format - :type '(choice - (const :tag "Never" nil) - (const :tag "Defaults" t) - (repeat :tag "Specify" - (list (character :tag "Priority" :value ?A) - (sexp :tag "face"))))) - -(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" "$" "$$" "\\(" "\\[")) - "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 forground of the default face. -:background the background color, or \"Transparent\". - `default' means use the background of the default face. -:scale a scaling factor for the size of the images -: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 - \"$\" 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-header "\\documentclass{article} -\\usepackage{fullpage} % do not remove -\\usepackage{amssymb} -\\usepackage[usenames]{color} -\\usepackage{amsmath} -\\usepackage{latexsym} -\\usepackage[mathscr]{eucal} -\\pagestyle{empty} % do not remove" - "The document header used for processing LaTeX fragments." - :group 'org-latex - :type 'string) - -(defgroup org-export nil - "Options for exporting org-listings." - :tag "Org Export" - :group 'org) - -(defgroup org-export-general nil - "General options for exporting Org-mode files." - :tag "Org Export General" - :group 'org-export) - -;; FIXME -(defvar org-export-publishing-directory nil) - -(defcustom org-export-with-special-strings t - "Non-nil means, interpret \"\-\", \"--\" and \"---\" for export. -When this option is turned on, these strings will be exported as: - - Org HTML LaTeX - -----+----------+-------- - \\- ­ \\- - -- – -- - --- — --- - ... … \ldots - -This option can also be set with the +OPTIONS line, e.g. \"-:nil\"." - :group 'org-export-translation - :type 'boolean) - -(defcustom org-export-language-setup - '(("en" "Author" "Date" "Table of Contents") - ("cs" "Autor" "Datum" "Obsah") - ("da" "Ophavsmand" "Dato" "Indhold") - ("de" "Autor" "Datum" "Inhaltsverzeichnis") - ("es" "Autor" "Fecha" "\xcdndice") - ("fr" "Auteur" "Date" "Table des mati\xe8res") - ("it" "Autore" "Data" "Indice") - ("nl" "Auteur" "Datum" "Inhoudsopgave") - ("nn" "Forfattar" "Dato" "Innhold") ;; nn = Norsk (nynorsk) - ("sv" "F\xf6rfattarens" "Datum" "Inneh\xe5ll")) - "Terms used in export text, translated to different languages. -Use the variable `org-export-default-language' to set the language, -or use the +OPTION lines for a per-file setting." - :group 'org-export-general - :type '(repeat - (list - (string :tag "HTML language tag") - (string :tag "Author") - (string :tag "Date") - (string :tag "Table of Contents")))) - -(defcustom org-export-default-language "en" - "The default language of HTML export, as a string. -This should have an association in `org-export-language-setup'." - :group 'org-export-general - :type 'string) - -(defcustom org-export-skip-text-before-1st-heading t - "Non-nil means, skip all text before the first headline when exporting. -When nil, that text is exported as well." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-headline-levels 3 - "The last level which is still exported as a headline. -Inferior levels will produce itemize lists when exported. -Note that a numeric prefix argument to an exporter function overrides -this setting. - -This option can also be set with the +OPTIONS line, e.g. \"H:2\"." - :group 'org-export-general - :type 'number) - -(defcustom org-export-with-section-numbers t - "Non-nil means, add section numbers to headlines when exporting. - -This option can also be set with the +OPTIONS line, e.g. \"num:t\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-toc t - "Non-nil means, create a table of contents in exported files. -The TOC contains headlines with levels up to`org-export-headline-levels'. -When an integer, include levels up to N in the toc, this may then be -different from `org-export-headline-levels', but it will not be allowed -to be larger than the number of headline levels. -When nil, no table of contents is made. - -Headlines which contain any TODO items will be marked with \"(*)\" in -ASCII export, and with red color in HTML output, if the option -`org-export-mark-todo-in-toc' is set. - -In HTML output, the TOC will be clickable. - -This option can also be set with the +OPTIONS line, e.g. \"toc:nil\" -or \"toc:3\"." - :group 'org-export-general - :type '(choice - (const :tag "No Table of Contents" nil) - (const :tag "Full Table of Contents" t) - (integer :tag "TOC to level"))) - -(defcustom org-export-mark-todo-in-toc nil - "Non-nil means, mark TOC lines that contain any open TODO items." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-preserve-breaks nil - "Non-nil means, preserve all line breaks when exporting. -Normally, in HTML output paragraphs will be reformatted. In ASCII -export, line breaks will always be preserved, regardless of this variable. - -This option can also be set with the +OPTIONS line, e.g. \"\\n:t\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-archived-trees 'headline - "Whether subtrees with the ARCHIVE tag should be exported. -This can have three different values -nil Do not export, pretend this tree is not present -t Do export the entire tree -headline Only export the headline, but skip the tree below it." - :group 'org-export-general - :group 'org-archive - :type '(choice - (const :tag "not at all" nil) - (const :tag "headline only" 'headline) - (const :tag "entirely" t))) - -(defcustom org-export-author-info t - "Non-nil means, insert author name and email into the exported file. - -This option can also be set with the +OPTIONS line, -e.g. \"author-info:nil\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-time-stamp-file t - "Non-nil means, insert a time stamp into the exported file. -The time stamp shows when the file was created. - -This option can also be set with the +OPTIONS line, -e.g. \"timestamp:nil\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-timestamps t - "If nil, do not export time stamps and associated keywords." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-remove-timestamps-from-toc t - "If nil, remove timestamps from the table of contents entries." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-tags 'not-in-toc - "If nil, do not export tags, just remove them from headlines. -If this is the symbol `not-in-toc', tags will be removed from table of -contents entries, but still be shown in the headlines of the document. - -This option can also be set with the +OPTIONS line, e.g. \"tags:nil\"." - :group 'org-export-general - :type '(choice - (const :tag "Off" nil) - (const :tag "Not in TOC" not-in-toc) - (const :tag "On" t))) - -(defcustom org-export-with-drawers nil - "Non-nil means, export with drawers like the property drawer. -When t, all drawers are exported. This may also be a list of -drawer names to export." - :group 'org-export-general - :type '(choice - (const :tag "All drawers" t) - (const :tag "None" nil) - (repeat :tag "Selected drawers" - (string :tag "Drawer name")))) - -(defgroup org-export-translation nil - "Options for translating special ascii sequences for the export backends." - :tag "Org Export Translation" - :group 'org-export) - -(defcustom org-export-with-emphasize t - "Non-nil means, interpret *word*, /word/, and _word_ as emphasized text. -If the export target supports emphasizing text, the word will be -typeset in bold, italic, or underlined, respectively. Works only for -single words, but you can say: I *really* *mean* *this*. -Not all export backends support this. - -This option can also be set with the +OPTIONS line, e.g. \"*:nil\"." - :group 'org-export-translation - :type 'boolean) - -(defcustom org-export-with-footnotes t - "If nil, export [1] as a footnote marker. -Lines starting with [1] will be formatted as footnotes. - -This option can also be set with the +OPTIONS line, e.g. \"f:nil\"." - :group 'org-export-translation - :type 'boolean) - -(defcustom org-export-with-sub-superscripts t - "Non-nil means, interpret \"_\" and \"^\" for export. -When this option is turned on, you can use TeX-like syntax for sub- and -superscripts. Several characters after \"_\" or \"^\" will be -considered as a single item - so grouping with {} is normally not -needed. For example, the following things will be parsed as single -sub- or superscripts. - - 10^24 or 10^tau several digits will be considered 1 item. - 10^-12 or 10^-tau a leading sign with digits or a word - x^2-y^3 will be read as x^2 - y^3, because items are - terminated by almost any nonword/nondigit char. - x_{i^2} or x^(2-i) braces or parenthesis do grouping. - -Still, ambiguity is possible - so when in doubt use {} to enclose the -sub/superscript. 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. - -Not all export backends support this, but HTML does. - -This option can also be set with the +OPTIONS line, e.g. \"^:nil\"." - :group 'org-export-translation - :type '(choice - (const :tag "Always interpret" t) - (const :tag "Only with braces" {}) - (const :tag "Never interpret" nil))) - -(defcustom org-export-with-special-strings t - "Non-nil means, interpret \"\-\", \"--\" and \"---\" for export. -When this option is turned on, these strings will be exported as: - -\\- : ­ --- : – ---- : — - -Not all export backends support this, but HTML does. - -This option can also be set with the +OPTIONS line, e.g. \"-:nil\"." - :group 'org-export-translation - :type 'boolean) - -(defcustom org-export-with-TeX-macros t - "Non-nil means, interpret simple TeX-like macros when exporting. -For example, HTML export converts \\alpha to α and \\AA to Å. -No only real TeX macros will work here, but the standard HTML entities -for math can be used as macro names as well. For a list of supported -names in HTML export, see the constant `org-html-entities'. -Not all export backends support this. - -This option can also be set with the +OPTIONS line, e.g. \"TeX:nil\"." - :group 'org-export-translation - :group 'org-export-latex - :type 'boolean) - -(defcustom org-export-with-LaTeX-fragments nil - "Non-nil means, convert LaTeX fragments to images when exporting to HTML. -When set, the exporter will find LaTeX environments if the \\begin line is -the first non-white thing on a line. It will also find the math delimiters -like $a=b$ and \\( a=b \\) for inline math, $$a=b$$ and \\[ a=b \\] for -display math. - -This option can also be set with the +OPTIONS line, e.g. \"LaTeX:t\"." - :group 'org-export-translation - :group 'org-export-latex - :type 'boolean) - -(defcustom org-export-with-fixed-width t - "Non-nil means, lines starting with \":\" will be in fixed width font. -This can be used to have pre-formatted text, fragments of code etc. For -example: - : ;; Some Lisp examples - : (while (defc cnt) - : (ding)) -will be looking just like this in also HTML. See also the QUOTE keyword. -Not all export backends support this. - -This option can also be set with the +OPTIONS line, e.g. \"::nil\"." - :group 'org-export-translation - :type 'boolean) - -(defcustom org-match-sexp-depth 3 - "Number of stacked braces for sub/superscript matching. -This has to be set before loading org.el to be effective." - :group 'org-export-translation - :type 'integer) - -(defgroup org-export-tables nil - "Options for exporting tables in Org-mode." - :tag "Org Export Tables" - :group 'org-export) - -(defcustom org-export-with-tables t - "If non-nil, lines starting with \"|\" define a table. -For example: - - | Name | Address | Birthday | - |-------------+----------+-----------| - | Arthur Dent | England | 29.2.2100 | - -Not all export backends support this. - -This option can also be set with the +OPTIONS line, e.g. \"|:nil\"." - :group 'org-export-tables - :type 'boolean) - -(defcustom org-export-highlight-first-table-line t - "Non-nil means, highlight the first table line. -In HTML export, this means use instead of . -In tables created with table.el, this applies to the first table line. -In Org-mode tables, all lines before the first horizontal separator -line will be formatted with tags." - :group 'org-export-tables - :type 'boolean) - -(defcustom org-export-table-remove-special-lines t - "Remove special lines and marking characters in calculating tables. -This removes the special marking character column from tables that are set -up for spreadsheet calculations. It also removes the entire lines -marked with `!', `_', or `^'. The lines with `$' are kept, because -the values of constants may be useful to have." - :group 'org-export-tables - :type 'boolean) - -(defcustom org-export-prefer-native-exporter-for-tables nil - "Non-nil means, always export tables created with table.el natively. -Natively means, use the HTML code generator in table.el. -When nil, Org-mode's own HTML generator is used when possible (i.e. if -the table does not use row- or column-spanning). This has the -advantage, that the automatic HTML conversions for math symbols and -sub/superscripts can be applied. Org-mode's HTML generator is also -much faster." - :group 'org-export-tables - :type 'boolean) - -(defgroup org-export-ascii nil - "Options specific for ASCII export of Org-mode files." - :tag "Org Export ASCII" - :group 'org-export) - -(defcustom org-export-ascii-underline '(?\$ ?\# ?^ ?\~ ?\= ?\-) - "Characters for underlining headings in ASCII export. -In the given sequence, these characters will be used for level 1, 2, ..." - :group 'org-export-ascii - :type '(repeat character)) - -(defcustom org-export-ascii-bullets '(?* ?+ ?-) - "Bullet characters for headlines converted to lists in ASCII export. -The first character is is used for the first lest level generated in this -way, and so on. If there are more levels than characters given here, -the list will be repeated. -Note that plain lists will keep the same bullets as the have in the -Org-mode file." - :group 'org-export-ascii - :type '(repeat character)) - -(defgroup org-export-xml nil - "Options specific for XML export of Org-mode files." - :tag "Org Export XML" - :group 'org-export) - -(defgroup org-export-html nil - "Options specific for HTML export of Org-mode files." - :tag "Org Export HTML" - :group 'org-export) - -(defcustom org-export-html-coding-system nil - "" - :group 'org-export-html - :type 'coding-system) - -(defcustom org-export-html-extension "html" - "The extension for exported HTML files." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-style -"" - "The default style specification for exported HTML files. -Since there are different ways of setting style information, this variable -needs to contain the full HTML structure to provide a style, including the -surrounding HTML tags. The style specifications should include definitions -for new classes todo, done, title, and deadline. For example, legal values -would be: - - - -or, if you want to keep the style in a file, - - - -As the value of this option simply gets inserted into the HTML header, -you can \"misuse\" it to add arbitrary text to the header." - :group 'org-export-html - :type 'string) - - -(defcustom org-export-html-title-format "

%s

\n" - "Format for typesetting the document title in HTML export." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-toplevel-hlevel 2 - "The level for level 1 headings in HTML export." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-link-org-files-as-html t - "Non-nil means, make file links to `file.org' point to `file.html'. -When org-mode is exporting an org-mode file to HTML, links to -non-html files are directly put into a href tag in HTML. -However, links to other Org-mode files (recognized by the -extension `.org.) should become links to the corresponding html -file, assuming that the linked org-mode file will also be -converted to HTML. -When nil, the links still point to the plain `.org' file." - :group 'org-export-html - :type 'boolean) - -(defcustom org-export-html-inline-images 'maybe - "Non-nil means, inline images into exported HTML pages. -This is done using an tag. When nil, an anchor with href is used to -link to the image. If this option is `maybe', then images in links with -an empty description will be inlined, while images with a description will -be linked only." - :group 'org-export-html - :type '(choice (const :tag "Never" nil) - (const :tag "Always" t) - (const :tag "When there is no description" maybe))) - -;; FIXME: rename -(defcustom org-export-html-expand t - "Non-nil means, for HTML export, treat @<...> as HTML tag. -When nil, these tags will be exported as plain text and therefore -not be interpreted by a browser. - -This option can also be set with the +OPTIONS line, e.g. \"@:nil\"." - :group 'org-export-html - :type 'boolean) - -(defcustom org-export-html-table-tag - "" - "The HTML tag that is used to start a table. -This must be a
tag, but you may change the options like -borders and spacing." - :group 'org-export-html - :type 'string) - -(defcustom org-export-table-header-tags '("") - "The opening tag for table header fields. -This is customizable so that alignment options can be specified." - :group 'org-export-tables - :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) - -(defcustom org-export-table-data-tags '("") - "The opening tag for table data fields. -This is customizable so that alignment options can be specified." - :group 'org-export-tables - :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) - -(defcustom org-export-html-with-timestamp nil - "If non-nil, write `org-export-html-html-helper-timestamp' -into the exported HTML text. Otherwise, the buffer will just be saved -to a file." - :group 'org-export-html - :type 'boolean) - -(defcustom org-export-html-html-helper-timestamp - "

\n" - "The HTML tag used as timestamp delimiter for HTML-helper-mode." - :group 'org-export-html - :type 'string) - -(defgroup org-export-icalendar nil - "Options specific for iCalendar export of Org-mode files." - :tag "Org Export iCalendar" - :group 'org-export) - -(defcustom org-combined-agenda-icalendar-file "~/org.ics" - "The file name for the iCalendar file covering all agenda files. -This file is created with the command \\[org-export-icalendar-all-agenda-files]. -The file name should be absolute, the file will be overwritten without warning." - :group 'org-export-icalendar - :type 'file) - -(defcustom org-icalendar-include-todo nil - "Non-nil means, export to iCalendar files should also cover TODO items." - :group 'org-export-icalendar - :type '(choice - (const :tag "None" nil) - (const :tag "Unfinished" t) - (const :tag "All" all))) - -(defcustom org-icalendar-include-sexps t - "Non-nil means, export to iCalendar files should also cover sexp entries. -These are entries like in the diary, but directly in an Org-mode file." - :group 'org-export-icalendar - :type 'boolean) - -(defcustom org-icalendar-include-body 100 - "Amount of text below headline to be included in iCalendar export. -This is a number of characters that should maximally be included. -Properties, scheduling and clocking lines will always be removed. -The text will be inserted into the DESCRIPTION field." - :group 'org-export-icalendar - :type '(choice - (const :tag "Nothing" nil) - (const :tag "Everything" t) - (integer :tag "Max characters"))) - -(defcustom org-icalendar-combined-name "OrgMode" - "Calendar name for the combined iCalendar representing all agenda files." - :group 'org-export-icalendar - :type 'string) - -(defgroup org-font-lock nil - "Font-lock settings for highlighting in Org-mode." - :tag "Org Font Lock" - :group 'org) - -(defcustom org-level-color-stars-only nil - "Non-nil means fontify only the stars in each headline. -When nil, the entire headline is fontified. -Changing it requires restart of `font-lock-mode' to become effective -also in regions already fontified." - :group 'org-font-lock - :type 'boolean) - -(defcustom org-hide-leading-stars nil - "Non-nil means, hide the first N-1 stars in a headline. -This works by using the face `org-hide' for these stars. This -face is white for a light background, and black for a dark -background. You may have to customize the face `org-hide' to -make this work. -Changing it requires restart of `font-lock-mode' to become effective -also in regions already fontified. -You may also set this on a per-file basis by adding one of the following -lines to the buffer: - - #+STARTUP: hidestars - #+STARTUP: showstars" - :group 'org-font-lock - :type 'boolean) - -(defcustom org-fontify-done-headline nil - "Non-nil means, change the face of a headline if it is marked DONE. -Normally, only the TODO/DONE keyword indicates the state of a headline. -When this is non-nil, the headline after the keyword is set to the -`org-headline-done' as an additional indication." - :group 'org-font-lock - :type 'boolean) - -(defcustom org-fontify-emphasized-text t - "Non-nil means fontify *bold*, /italic/ and _underlined_ text. -Changing this variable requires a restart of Emacs to take effect." - :group 'org-font-lock - :type 'boolean) - -(defcustom org-highlight-latex-fragments-and-specials nil - "Non-nil means, fontify what is treated specially by the exporters." - :group 'org-font-lock - :type 'boolean) - -(defcustom org-hide-emphasis-markers nil - "Non-nil mean font-lock should hide the emphasis marker characters." - :group 'org-font-lock - :type 'boolean) - -(defvar org-emph-re nil - "Regular expression for matching emphasis.") -(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) - (let* ((e org-emphasis-regexp-components) - (pre (car e)) - (post (nth 1 e)) - (border (nth 2 e)) - (body (nth 3 e)) - (nl (nth 4 e)) - (stacked (and nil (nth 5 e))) ; stacked is no longer allowed, forced to nil - (body1 (concat body "*?")) - (markers (mapconcat 'car org-emphasis-alist "")) - (vmarkers (mapconcat - (lambda (x) (if (eq (nth 4 x) 'verbatim) (car x) "")) - org-emphasis-alist ""))) - ;; make sure special characters appear at the right position in the class - (if (string-match "\\^" markers) - (setq markers (concat (replace-match "" t t markers) "^"))) - (if (string-match "-" markers) - (setq markers (concat (replace-match "" t t markers) "-"))) - (if (string-match "\\^" vmarkers) - (setq vmarkers (concat (replace-match "" t t vmarkers) "^"))) - (if (string-match "-" vmarkers) - (setq vmarkers (concat (replace-match "" t t vmarkers) "-"))) - (if (> nl 0) - (setq body1 (concat body1 "\\(?:\n" body "*?\\)\\{0," - (int-to-string nl) "\\}"))) - ;; Make the regexp - (setq org-emph-re - (concat "\\([" pre (if (and nil stacked) markers) "]\\|^\\)" - "\\(" - "\\([" markers "]\\)" - "\\(" - "[^" border "]\\|" - "[^" border (if (and nil stacked) markers) "]" - body1 - "[^" border (if (and nil stacked) markers) "]" - "\\)" - "\\3\\)" - "\\([" post (if (and nil stacked) markers) "]\\|$\\)")) - (setq org-verbatim-re - (concat "\\([" pre "]\\|^\\)" - "\\(" - "\\([" vmarkers "]\\)" - "\\(" - "[^" border "]\\|" - "[^" border "]" - body1 - "[^" border "]" - "\\)" - "\\3\\)" - "\\([" post "]\\|$\\)"))))) - -(defcustom org-emphasis-regexp-components - '(" \t('\"" "- \t.,:?;'\")" " \t\r\n,\"'" "." 1) - "Components used to build the regular expression for emphasis. -This is a list with 6 entries. Terminology: In an emphasis string -like \" *strong word* \", we call the initial space PREMATCH, the final -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. - -Use customize to modify this, or restart Emacs after changing it." - :group 'org-font-lock - :set 'org-set-emph-re - :type '(list - (sexp :tag "Allowed chars in pre ") - (sexp :tag "Allowed chars in post ") - (sexp :tag "Forbidden chars in border ") - (sexp :tag "Regexp for body ") - (integer :tag "number of newlines allowed") - (option (boolean :tag "Stacking (DISABLED) ")))) - -(defcustom org-emphasis-alist - '(("*" bold "" "") - ("/" italic "" "") - ("_" underline "" "") - ("=" org-code "" "" verbatim) - ("~" org-verbatim "" "" verbatim) - ("+" (:strike-through t) "" "") - ) - "Special syntax for emphasized text. -Text starting and ending with a special character will be emphasized, for -example *bold*, _underlined_ and /italic/. This variable sets the marker -characters, the face to be used by font-lock for highlighting in Org-mode -Emacs buffers, and the HTML tags to be used for this. -Use customize to modify this, or restart Emacs after changing it." - :group 'org-font-lock - :set 'org-set-emph-re - :type '(repeat - (list - (string :tag "Marker character") - (choice - (face :tag "Font-lock-face") - (plist :tag "Face property list")) - (string :tag "HTML start tag") - (string :tag "HTML end tag") - (option (const verbatim))))) - -;;; The faces - -(defgroup org-faces nil - "Faces in Org-mode." - :tag "Org Faces" - :group 'org-font-lock) - -(defun org-compatible-face (inherits specs) - "Make a compatible face specification. -If INHERITS is an existing face and if the Emacs version supports it, -just inherit the face. If not, use SPECS to define the face. -XEmacs and Emacs 21 do not know about the `min-colors' attribute. -For them we convert a (min-colors 8) entry to a `tty' entry and move it -to the top of the list. The `min-colors' attribute will be removed from -any other entries, and any resulting duplicates will be removed entirely." - (cond - ((and inherits (facep inherits) - (not (featurep 'xemacs)) (> emacs-major-version 22)) - ;; In Emacs 23, we use inheritance where possible. - ;; We only do this in Emacs 23, because only there the outline - ;; faces have been changed to the original org-mode-level-faces. - (list (list t :inherit inherits))) - ((or (featurep 'xemacs) (< emacs-major-version 22)) - ;; These do not understand the `min-colors' attribute. - (let (r e a) - (while (setq e (pop specs)) - (cond - ((memq (car e) '(t default)) (push e r)) - ((setq a (member '(min-colors 8) (car e))) - (nconc r (list (cons (cons '(type tty) (delq (car a) (car e))) - (cdr e))))) - ((setq a (assq 'min-colors (car e))) - (setq e (cons (delq a (car e)) (cdr e))) - (or (assoc (car e) r) (push e r))) - (t (or (assoc (car e) r) (push e r))))) - (nreverse r))) - (t specs))) -(put 'org-compatible-face 'lisp-indent-function 1) - -(defface org-hide - '((((background light)) (:foreground "white")) - (((background dark)) (:foreground "black"))) - "Face used to hide leading stars in headlines. -The forground color of this face should be equal to the background -color of the frame." - :group 'org-faces) - -(defface org-level-1 ;; font-lock-function-name-face - (org-compatible-face 'outline-1 - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8)) (:foreground "blue" :bold t)) - (t (:bold t)))) - "Face used for level 1 headlines." - :group 'org-faces) - -(defface org-level-2 ;; font-lock-variable-name-face - (org-compatible-face 'outline-2 - '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) - (((class color) (min-colors 8) (background light)) (:foreground "yellow")) - (((class color) (min-colors 8) (background dark)) (:foreground "yellow" :bold t)) - (t (:bold t)))) - "Face used for level 2 headlines." - :group 'org-faces) - -(defface org-level-3 ;; font-lock-keyword-face - (org-compatible-face 'outline-3 - '((((class color) (min-colors 88) (background light)) (:foreground "Purple")) - (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1")) - (((class color) (min-colors 16) (background light)) (:foreground "Purple")) - (((class color) (min-colors 16) (background dark)) (:foreground "Cyan")) - (((class color) (min-colors 8) (background light)) (:foreground "purple" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "cyan" :bold t)) - (t (:bold t)))) - "Face used for level 3 headlines." - :group 'org-faces) - -(defface org-level-4 ;; font-lock-comment-face - (org-compatible-face 'outline-4 - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 16) (background light)) (:foreground "red")) - (((class color) (min-colors 16) (background dark)) (:foreground "red1")) - (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) - "Face used for level 4 headlines." - :group 'org-faces) - -(defface org-level-5 ;; font-lock-type-face - (org-compatible-face 'outline-5 - '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen")) - (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen")) - (((class color) (min-colors 8)) (:foreground "green")))) - "Face used for level 5 headlines." - :group 'org-faces) - -(defface org-level-6 ;; font-lock-constant-face - (org-compatible-face 'outline-6 - '((((class color) (min-colors 16) (background light)) (:foreground "CadetBlue")) - (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine")) - (((class color) (min-colors 8)) (:foreground "magenta")))) - "Face used for level 6 headlines." - :group 'org-faces) - -(defface org-level-7 ;; font-lock-builtin-face - (org-compatible-face 'outline-7 - '((((class color) (min-colors 16) (background light)) (:foreground "Orchid")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue")) - (((class color) (min-colors 8)) (:foreground "blue")))) - "Face used for level 7 headlines." - :group 'org-faces) - -(defface org-level-8 ;; font-lock-string-face - (org-compatible-face 'outline-8 - '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) - (((class color) (min-colors 8)) (:foreground "green")))) - "Face used for level 8 headlines." - :group 'org-faces) - -(defface org-special-keyword ;; font-lock-string-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) - (t (:italic t)))) - "Face used for special keywords." - :group 'org-faces) - -(defface org-drawer ;; font-lock-function-name-face - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8)) (:foreground "blue" :bold t)) - (t (:bold t)))) - "Face used for drawers." - :group 'org-faces) - -(defface org-property-value nil - "Face used for the value of a property." - :group 'org-faces) - -(defface org-column - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) - (:background "grey90")) - (((class color) (min-colors 16) (background dark)) - (:background "grey30")) - (((class color) (min-colors 8)) - (:background "cyan" :foreground "black")) - (t (:inverse-video t)))) - "Face for column display of entry properties." - :group 'org-faces) - -(when (fboundp 'set-face-attribute) - ;; Make sure that a fixed-width face is used when we have a column table. - (set-face-attribute 'org-column nil - :height (face-attribute 'default :height) - :family (face-attribute 'default :family))) - -(defface org-warning - (org-compatible-face 'font-lock-warning-face - '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) - (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) - (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) - "Face for deadlines and TODO keywords." - :group 'org-faces) - -(defface org-archived ; similar to shadow - (org-compatible-face 'shadow - '((((class color grayscale) (min-colors 88) (background light)) - (:foreground "grey50")) - (((class color grayscale) (min-colors 88) (background dark)) - (:foreground "grey70")) - (((class color) (min-colors 8) (background light)) - (:foreground "green")) - (((class color) (min-colors 8) (background dark)) - (:foreground "yellow")))) - "Face for headline with the ARCHIVE tag." - :group 'org-faces) - -(defface org-link - '((((class color) (background light)) (:foreground "Purple" :underline t)) - (((class color) (background dark)) (:foreground "Cyan" :underline t)) - (t (:underline t))) - "Face for links." - :group 'org-faces) - -(defface org-ellipsis - '((((class color) (background light)) (:foreground "DarkGoldenrod" :underline t)) - (((class color) (background dark)) (:foreground "LightGoldenrod" :underline t)) - (t (:strike-through t))) - "Face for the ellipsis in folded text." - :group 'org-faces) - -(defface org-target - '((((class color) (background light)) (:underline t)) - (((class color) (background dark)) (:underline t)) - (t (:underline t))) - "Face for links." - :group 'org-faces) - -(defface org-date - '((((class color) (background light)) (:foreground "Purple" :underline t)) - (((class color) (background dark)) (:foreground "Cyan" :underline t)) - (t (:underline t))) - "Face for links." - :group 'org-faces) - -(defface org-sexp-date - '((((class color) (background light)) (:foreground "Purple")) - (((class color) (background dark)) (:foreground "Cyan")) - (t (:underline t))) - "Face for links." - :group 'org-faces) - -(defface org-tag - '((t (:bold t))) - "Face for tags." - :group 'org-faces) - -(defface org-todo ; font-lock-warning-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) - (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) - (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:inverse-video t :bold t)))) - "Face for TODO keywords." - :group 'org-faces) - -(defface org-done ;; font-lock-type-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen" :bold t)) - (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :bold t)) - (((class color) (min-colors 8)) (:foreground "green")) - (t (:bold t)))) - "Face used for todo keywords that indicate DONE items." - :group 'org-faces) - -(defface org-headline-done ;; font-lock-string-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) - (((class color) (min-colors 8) (background light)) (:bold nil)))) - "Face used to indicate that a headline is DONE. -This face is only used if `org-fontify-done-headline' is set. If applies -to the part of the headline after the DONE keyword." - :group 'org-faces) - -(defcustom org-todo-keyword-faces nil - "Faces for specific TODO keywords. -This is a list of cons cells, with TODO keywords in the car -and faces in the cdr. The face can be a symbol, or a property -list of attributes, like (:foreground \"blue\" :weight bold :underline t)." - :group 'org-faces - :group 'org-todo - :type '(repeat - (cons - (string :tag "keyword") - (sexp :tag "face")))) - -(defface org-table ;; font-lock-function-name-face - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8) (background light)) (:foreground "blue")) - (((class color) (min-colors 8) (background dark))))) - "Face used for tables." - :group 'org-faces) - -(defface org-formula - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 8) (background light)) (:foreground "red")) - (((class color) (min-colors 8) (background dark)) (:foreground "red")) - (t (:bold t :italic t)))) - "Face for formulas." - :group 'org-faces) - -(defface org-code - (org-compatible-face nil - '((((class color grayscale) (min-colors 88) (background light)) - (:foreground "grey50")) - (((class color grayscale) (min-colors 88) (background dark)) - (:foreground "grey70")) - (((class color) (min-colors 8) (background light)) - (:foreground "green")) - (((class color) (min-colors 8) (background dark)) - (:foreground "yellow")))) - "Face for fixed-with text like code snippets." - :group 'org-faces - :version "22.1") - -(defface org-verbatim - (org-compatible-face nil - '((((class color grayscale) (min-colors 88) (background light)) - (:foreground "grey50" :underline t)) - (((class color grayscale) (min-colors 88) (background dark)) - (:foreground "grey70" :underline t)) - (((class color) (min-colors 8) (background light)) - (:foreground "green" :underline t)) - (((class color) (min-colors 8) (background dark)) - (:foreground "yellow" :underline t)))) - "Face for fixed-with text like code snippets." - :group 'org-faces - :version "22.1") - -(defface org-agenda-structure ;; font-lock-function-name-face - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8)) (:foreground "blue" :bold t)) - (t (:bold t)))) - "Face used in agenda for captions and dates." - :group 'org-faces) - -(defface org-scheduled-today - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen")) - (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen")) - (((class color) (min-colors 8)) (:foreground "green")) - (t (:bold t :italic t)))) - "Face for items scheduled for a certain day." - :group 'org-faces) - -(defface org-scheduled-previously - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 8) (background light)) (:foreground "red")) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) - "Face for items scheduled previously, and not yet done." - :group 'org-faces) - -(defface org-upcoming-deadline - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 8) (background light)) (:foreground "red")) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) - "Face for items scheduled previously, and not yet done." - :group 'org-faces) - -(defcustom org-agenda-deadline-faces - '((1.0 . org-warning) - (0.5 . org-upcoming-deadline) - (0.0 . default)) - "Faces for showing deadlines in the agenda. -This is a list of cons cells. The cdr of each cess is a face to be used, -and it can also just be a like like '(:foreground \"yellow\"). -Each car is a fraction of the head-warning time that must have passed for -this the face in the cdr to be used for display. The numbers must be -given in descending order. The head-warning time is normally taken -from `org-deadline-warning-days', but can also be specified in the deadline -timestamp itself, like this: - - DEADLINE: <2007-08-13 Mon -8d> - -You may use d for days, w for weeks, m for months and y for years. Months -and years will only be treated in an approximate fashion (30.4 days for a -month and 365.24 days for a year)." - :group 'org-faces - :group 'org-agenda-daily/weekly - :type '(repeat - (cons - (number :tag "Fraction of head-warning time passed") - (sexp :tag "Face")))) - -;; FIXME: this is not a good face yet. -(defface org-agenda-restriction-lock - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:background "yellow1")) - (((class color) (min-colors 88) (background dark)) (:background "skyblue4")) - (((class color) (min-colors 16) (background light)) (:background "yellow1")) - (((class color) (min-colors 16) (background dark)) (:background "skyblue4")) - (((class color) (min-colors 8)) (:background "cyan" :foreground "black")) - (t (:inverse-video t)))) - "Face for showing the agenda restriction lock." - :group 'org-faces) - -(defface org-time-grid ;; font-lock-variable-name-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) - (((class color) (min-colors 8)) (:foreground "yellow" :weight light)))) - "Face used for time grids." - :group 'org-faces) - -(defconst org-level-faces - '(org-level-1 org-level-2 org-level-3 org-level-4 - org-level-5 org-level-6 org-level-7 org-level-8 - )) - -(defcustom org-n-level-faces (length org-level-faces) - "The number different faces to be used for headlines. -Org-mode defines 8 different headline faces, so this can be at most 8. -If it is less than 8, the level-1 face gets re-used for level N+1 etc." - :type 'number - :group 'org-faces) - -;;; Functions and variables from ther packages -;; Declared here to avoid compiler warnings - -(eval-and-compile - (unless (fboundp 'declare-function) - (defmacro declare-function (fn file &optional arglist fileonly)))) - -;; XEmacs only -(defvar outline-mode-menu-heading) -(defvar outline-mode-menu-show) -(defvar outline-mode-menu-hide) -(defvar zmacs-regions) ; XEmacs regions - -;; Emacs only -(defvar mark-active) - -;; Various packages -;; FIXME: get the argument lists for the UNKNOWN stuff -(declare-function add-to-diary-list "diary-lib" - (date string specifier &optional marker globcolor literal)) -(declare-function table--at-cell-p "table" (position &optional object at-column)) -(declare-function Info-find-node "info" (filename nodename &optional no-going-back)) -(declare-function Info-goto-node "info" (nodename &optional fork)) -(declare-function bbdb "ext:bbdb-com" (string elidep)) -(declare-function bbdb-company "ext:bbdb-com" (string elidep)) -(declare-function bbdb-current-record "ext:bbdb-com" (&optional planning-on-modifying)) -(declare-function bbdb-name "ext:bbdb-com" (string elidep)) -(declare-function bbdb-record-getprop "ext:bbdb" (record property)) -(declare-function bbdb-record-name "ext:bbdb" (record)) -(declare-function bibtex-beginning-of-entry "bibtex" ()) -(declare-function bibtex-generate-autokey "bibtex" ()) -(declare-function bibtex-parse-entry "bibtex" (&optional content)) -(declare-function bibtex-url "bibtex" (&optional pos no-browse)) -(defvar calc-embedded-close-formula) -(defvar calc-embedded-open-formula) -(declare-function calendar-astro-date-string "cal-julian" (&optional date)) -(declare-function calendar-bahai-date-string "cal-bahai" (&optional date)) -(declare-function calendar-check-holidays "holidays" (date)) -(declare-function calendar-chinese-date-string "cal-china" (&optional date)) -(declare-function calendar-coptic-date-string "cal-coptic" (&optional date)) -(declare-function calendar-ethiopic-date-string "cal-coptic" (&optional date)) -(declare-function calendar-forward-day "cal-move" (arg)) -(declare-function calendar-french-date-string "cal-french" (&optional date)) -(declare-function calendar-goto-date "cal-move" (date)) -(declare-function calendar-goto-today "cal-move" ()) -(declare-function calendar-hebrew-date-string "cal-hebrew" (&optional date)) -(declare-function calendar-islamic-date-string "cal-islam" (&optional date)) -(declare-function calendar-iso-date-string "cal-iso" (&optional date)) -(declare-function calendar-julian-date-string "cal-julian" (&optional date)) -(declare-function calendar-mayan-date-string "cal-mayan" (&optional date)) -(declare-function calendar-persian-date-string "cal-persia" (&optional date)) -(defvar calendar-mode-map) -(defvar original-date) ; dynamically scoped in calendar.el does scope this -(declare-function cdlatex-tab "ext:cdlatex" ()) -(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) -(declare-function elmo-folder-exists-p "ext:elmo" (folder) t) -(declare-function elmo-message-entity-field "ext:elmo-msgdb" (entity field &optional type)) -(declare-function elmo-message-field "ext:elmo" (folder number field &optional type) t) -(declare-function elmo-msgdb-overview-get-entity "ext:elmo" (&rest unknown) t) -(defvar font-lock-unfontify-region-function) -(declare-function gnus-article-show-summary "gnus-art" ()) -(declare-function gnus-summary-last-subject "gnus-sum" ()) -(defvar gnus-other-frame-object) -(defvar gnus-group-name) -(defvar gnus-article-current) -(defvar Info-current-file) -(defvar Info-current-node) -(declare-function mh-display-msg "mh-show" (msg-num folder-name)) -(declare-function mh-find-path "mh-utils" ()) -(declare-function mh-get-header-field "mh-utils" (field)) -(declare-function mh-get-msg-num "mh-utils" (error-if-no-message)) -(declare-function mh-header-display "mh-show" ()) -(declare-function mh-index-previous-folder "mh-search" ()) -(declare-function mh-normalize-folder-name "mh-utils" (folder &optional empty-string-okay dont-remove-trailing-slash return-nil-if-folder-empty)) -(declare-function mh-search "mh-search" (folder search-regexp &optional redo-search-flag window-config)) -(declare-function mh-search-choose "mh-search" (&optional searcher)) -(declare-function mh-show "mh-show" (&optional message redisplay-flag)) -(declare-function mh-show-buffer-message-number "mh-comp" (&optional buffer)) -(declare-function mh-show-header-display "mh-show" t t) -(declare-function mh-show-msg "mh-show" (msg)) -(declare-function mh-show-show "mh-show" t t) -(declare-function mh-visit-folder "mh-folder" (folder &optional range index-data)) -(defvar mh-progs) -(defvar mh-current-folder) -(defvar mh-show-folder-buffer) -(defvar mh-index-folder) -(defvar mh-searcher) -(declare-function org-export-latex-cleaned-string "org-export-latex" (&optional commentsp)) -(declare-function parse-time-string "parse-time" (string)) -(declare-function remember "remember" (&optional initial)) -(declare-function remember-buffer-desc "remember" ()) -(defvar remember-save-after-remembering) -(defvar remember-data-file) -(defvar remember-register) -(defvar remember-buffer) -(defvar remember-handler-functions) -(defvar remember-annotation-functions) -(declare-function rmail-narrow-to-non-pruned-header "rmail" ()) -(declare-function rmail-show-message "rmail" (&optional n no-summary)) -(declare-function rmail-what-message "rmail" ()) -(defvar texmathp-why) -(declare-function vm-beginning-of-message "ext:vm-page" ()) -(declare-function vm-follow-summary-cursor "ext:vm-motion" ()) -(declare-function vm-get-header-contents "ext:vm-summary" (message header-name-regexp &optional clump-sep)) -(declare-function vm-isearch-narrow "ext:vm-search" ()) -(declare-function vm-isearch-update "ext:vm-search" ()) -(declare-function vm-select-folder-buffer "ext:vm-macro" ()) -(declare-function vm-su-message-id "ext:vm-summary" (m)) -(declare-function vm-su-subject "ext:vm-summary" (m)) -(declare-function vm-summarize "ext:vm-summary" (&optional display raise)) -(defvar vm-message-pointer) -(defvar vm-folder-directory) -(defvar w3m-current-url) -(defvar w3m-current-title) -;; backward compatibility to old version of wl -(declare-function wl-summary-buffer-msgdb "ext:wl-folder" (&rest unknown) t) -(declare-function wl-folder-get-elmo-folder "ext:wl-folder" (entity &optional no-cache)) -(declare-function wl-summary-goto-folder-subr "ext:wl-summary" (&optional name scan-type other-window sticky interactive scoring force-exit)) -(declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary" (&optional id)) -(declare-function wl-summary-line-from "ext:wl-summary" ()) -(declare-function wl-summary-line-subject "ext:wl-summary" ()) -(declare-function wl-summary-message-number "ext:wl-summary" ()) -(declare-function wl-summary-redisplay "ext:wl-summary" (&optional arg)) -(defvar wl-summary-buffer-elmo-folder) -(defvar wl-summary-buffer-folder-name) -(declare-function speedbar-line-directory "speedbar" (&optional depth)) - -(defvar org-latex-regexps) -(defvar constants-unit-system) - -;;; Variables for pre-computed regular expressions, all buffer local - -(defvar org-drawer-regexp nil - "Matches first line of a hidden block.") -(make-variable-buffer-local 'org-drawer-regexp) -(defvar org-todo-regexp nil - "Matches any of the TODO state keywords.") -(make-variable-buffer-local 'org-todo-regexp) -(defvar org-not-done-regexp nil - "Matches any of the TODO state keywords except the last one.") -(make-variable-buffer-local 'org-not-done-regexp) -(defvar org-todo-line-regexp nil - "Matches a headline and puts TODO state into group 2 if present.") -(make-variable-buffer-local 'org-todo-line-regexp) -(defvar org-complex-heading-regexp nil - "Matches a headline and puts everything into groups: -group 1: the stars -group 2: The todo keyword, maybe -group 3: Priority cookie -group 4: True headline -group 5: Tags") -(make-variable-buffer-local 'org-complex-heading-regexp) -(defvar org-todo-line-tags-regexp nil - "Matches a headline and puts TODO state into group 2 if present. -Also put tags into group 4 if tags are present.") -(make-variable-buffer-local 'org-todo-line-tags-regexp) -(defvar org-nl-done-regexp nil - "Matches newline followed by a headline with the DONE keyword.") -(make-variable-buffer-local 'org-nl-done-regexp) -(defvar org-looking-at-done-regexp nil - "Matches the DONE keyword a point.") -(make-variable-buffer-local 'org-looking-at-done-regexp) -(defvar org-ds-keyword-length 12 - "Maximum length of the Deadline and SCHEDULED keywords.") -(make-variable-buffer-local 'org-ds-keyword-length) -(defvar org-deadline-regexp nil - "Matches the DEADLINE keyword.") -(make-variable-buffer-local 'org-deadline-regexp) -(defvar org-deadline-time-regexp nil - "Matches the DEADLINE keyword together with a time stamp.") -(make-variable-buffer-local 'org-deadline-time-regexp) -(defvar org-deadline-line-regexp nil - "Matches the DEADLINE keyword and the rest of the line.") -(make-variable-buffer-local 'org-deadline-line-regexp) -(defvar org-scheduled-regexp nil - "Matches the SCHEDULED keyword.") -(make-variable-buffer-local 'org-scheduled-regexp) -(defvar org-scheduled-time-regexp nil - "Matches the SCHEDULED keyword together with a time stamp.") -(make-variable-buffer-local 'org-scheduled-time-regexp) -(defvar org-closed-time-regexp nil - "Matches the CLOSED keyword together with a time stamp.") -(make-variable-buffer-local 'org-closed-time-regexp) - -(defvar org-keyword-time-regexp nil - "Matches any of the 4 keywords, together with the time stamp.") -(make-variable-buffer-local 'org-keyword-time-regexp) -(defvar org-keyword-time-not-clock-regexp nil - "Matches any of the 3 keywords, together with the time stamp.") -(make-variable-buffer-local 'org-keyword-time-not-clock-regexp) -(defvar org-maybe-keyword-time-regexp nil - "Matches a timestamp, possibly preceeded by a keyword.") -(make-variable-buffer-local 'org-maybe-keyword-time-regexp) -(defvar org-planning-or-clock-line-re nil - "Matches a line with planning or clock info.") -(make-variable-buffer-local 'org-planning-or-clock-line-re) - -(defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t - rear-nonsticky t mouse-map t fontified t) - "Properties to remove when a string without properties is wanted.") - -(defsubst org-match-string-no-properties (num &optional string) - (if (featurep 'xemacs) - (let ((s (match-string num string))) - (remove-text-properties 0 (length s) org-rm-props s) - s) - (match-string-no-properties num string))) - -(defsubst org-no-properties (s) - (if (fboundp 'set-text-properties) - (set-text-properties 0 (length s) nil s) - (remove-text-properties 0 (length s) org-rm-props s)) - s) - -(defsubst org-get-alist-option (option key) - (cond ((eq key t) t) - ((eq option t) t) - ((assoc key option) (cdr (assoc key option))) - (t (cdr (assq 'default option))))) - -(defsubst org-inhibit-invisibility () - "Modified `buffer-invisibility-spec' for Emacs 21. -Some ops with invisible text do not work correctly on Emacs 21. For these -we turn off invisibility temporarily. Use this in a `let' form." - (if (< emacs-major-version 22) nil buffer-invisibility-spec)) - -(defsubst org-set-local (var value) - "Make VAR local in current buffer and set it to VALUE." - (set (make-variable-buffer-local var) value)) - -(defsubst org-mode-p () - "Check if the current buffer is in Org-mode." - (eq major-mode 'org-mode)) - -(defsubst org-last (list) - "Return the last element of LIST." - (car (last list))) - -(defun org-let (list &rest body) - (eval (cons 'let (cons list body)))) -(put 'org-let 'lisp-indent-function 1) - -(defun org-let2 (list1 list2 &rest body) - (eval (cons 'let (cons list1 (list (cons 'let (cons list2 body))))))) -(put 'org-let2 'lisp-indent-function 2) -(defconst org-startup-options - '(("fold" org-startup-folded t) - ("overview" org-startup-folded t) - ("nofold" org-startup-folded nil) - ("showall" org-startup-folded nil) - ("content" org-startup-folded content) - ("hidestars" org-hide-leading-stars t) - ("showstars" org-hide-leading-stars nil) - ("odd" org-odd-levels-only t) - ("oddeven" org-odd-levels-only nil) - ("align" org-startup-align-all-tables t) - ("noalign" org-startup-align-all-tables nil) - ("customtime" org-display-custom-times t) - ("logging" org-log-done t) - ("logdone" org-log-done t) - ("nologging" org-log-done nil) - ("lognotedone" org-log-done done push) - ("lognotestate" org-log-done state push) - ("lognoteclock-out" org-log-done clock-out push) - ("logrepeat" org-log-repeat t) - ("nologrepeat" org-log-repeat nil) - ("constcgs" constants-unit-system cgs) - ("constSI" constants-unit-system SI)) - "Variable associated with STARTUP options for org-mode. -Each element is a list of three items: The startup options as written -in the #+STARTUP line, the corresponding variable, and the value to -set this variable to if the option is found. An optional forth element PUSH -means to push this value onto the list in the variable.") - -(defun org-set-regexps-and-options () - "Precompute regular expressions for current buffer." - (when (org-mode-p) - (org-set-local 'org-todo-kwd-alist nil) - (org-set-local 'org-todo-key-alist nil) - (org-set-local 'org-todo-key-trigger nil) - (org-set-local 'org-todo-keywords-1 nil) - (org-set-local 'org-done-keywords nil) - (org-set-local 'org-todo-heads nil) - (org-set-local 'org-todo-sets nil) - (org-set-local 'org-todo-log-states nil) - (let ((re (org-make-options-regexp - '("CATEGORY" "SEQ_TODO" "TYP_TODO" "TODO" "COLUMNS" - "STARTUP" "ARCHIVE" "TAGS" "LINK" "PRIORITIES" - "CONSTANTS" "PROPERTY" "DRAWERS"))) - (splitre "[ \t]+") - kwds kws0 kwsa key value cat arch tags const links hw dws - tail sep kws1 prio props drawers - ex log) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (setq key (match-string 1) value (org-match-string-no-properties 2)) - (cond - ((equal key "CATEGORY") - (if (string-match "[ \t]+$" value) - (setq value (replace-match "" t t value))) - (setq cat value)) - ((member key '("SEQ_TODO" "TODO")) - (push (cons 'sequence (org-split-string value splitre)) kwds)) - ((equal key "TYP_TODO") - (push (cons 'type (org-split-string value splitre)) kwds)) - ((equal key "TAGS") - (setq tags (append tags (org-split-string value splitre)))) - ((equal key "COLUMNS") - (org-set-local 'org-columns-default-format value)) - ((equal key "LINK") - (when (string-match "^\\(\\S-+\\)[ \t]+\\(.+\\)" value) - (push (cons (match-string 1 value) - (org-trim (match-string 2 value))) - links))) - ((equal key "PRIORITIES") - (setq prio (org-split-string value " +"))) - ((equal key "PROPERTY") - (when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value) - (push (cons (match-string 1 value) (match-string 2 value)) - props))) - ((equal key "DRAWERS") - (setq drawers (org-split-string value splitre))) - ((equal key "CONSTANTS") - (setq const (append const (org-split-string value splitre)))) - ((equal key "STARTUP") - (let ((opts (org-split-string value splitre)) - l var val) - (while (setq l (pop opts)) - (when (setq l (assoc l org-startup-options)) - (setq var (nth 1 l) val (nth 2 l)) - (if (not (nth 3 l)) - (set (make-local-variable var) val) - (if (not (listp (symbol-value var))) - (set (make-local-variable var) nil)) - (set (make-local-variable var) (symbol-value var)) - (add-to-list var val)))))) - ((equal key "ARCHIVE") - (string-match " *$" value) - (setq arch (replace-match "" t t value)) - (remove-text-properties 0 (length arch) - '(face t fontified t) arch))) - ))) - (when cat - (org-set-local 'org-category (intern cat)) - (push (cons "CATEGORY" cat) props)) - (when prio - (if (< (length prio) 3) (setq prio '("A" "C" "B"))) - (setq prio (mapcar 'string-to-char prio)) - (org-set-local 'org-highest-priority (nth 0 prio)) - (org-set-local 'org-lowest-priority (nth 1 prio)) - (org-set-local 'org-default-priority (nth 2 prio))) - (and props (org-set-local 'org-local-properties (nreverse props))) - (and drawers (org-set-local 'org-drawers drawers)) - (and arch (org-set-local 'org-archive-location arch)) - (and links (setq org-link-abbrev-alist-local (nreverse links))) - ;; Process the TODO keywords - (unless kwds - ;; Use the global values as if they had been given locally. - (setq kwds (default-value 'org-todo-keywords)) - (if (stringp (car kwds)) - (setq kwds (list (cons org-todo-interpretation - (default-value 'org-todo-keywords))))) - (setq kwds (reverse kwds))) - (setq kwds (nreverse kwds)) - (let (inter kws kw) - (while (setq kws (pop kwds)) - (setq inter (pop kws) sep (member "|" kws) - kws0 (delete "|" (copy-sequence kws)) - kwsa nil - kws1 (mapcar - (lambda (x) - (if (string-match "^\\(.*?\\)\\(?:(\\(..?\\))\\)?$" x) - (progn - (setq kw (match-string 1 x) - ex (and (match-end 2) (match-string 2 x)) - log (and ex (string-match "@" ex)) - key (and ex (substring ex 0 1))) - (if (equal key "@") (setq key nil)) - (push (cons kw (and key (string-to-char key))) kwsa) - (and log (push kw org-todo-log-states)) - kw) - (error "Invalid TODO keyword %s" x))) - kws0) - kwsa (if kwsa (append '((:startgroup)) - (nreverse kwsa) - '((:endgroup)))) - hw (car kws1) - dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1)) - tail (list inter hw (car dws) (org-last dws))) - (add-to-list 'org-todo-heads hw 'append) - (push kws1 org-todo-sets) - (setq org-done-keywords (append org-done-keywords dws nil)) - (setq org-todo-key-alist (append org-todo-key-alist kwsa)) - (mapc (lambda (x) (push (cons x tail) org-todo-kwd-alist)) kws1) - (setq org-todo-keywords-1 (append org-todo-keywords-1 kws1 nil))) - (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))) - ;; Process the constants - (when const - (let (e cst) - (while (setq e (pop const)) - (if (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e) - (push (cons (match-string 1 e) (match-string 2 e)) cst))) - (setq org-table-formula-constants-local cst))) - - ;; Process the tags. - (when tags - (let (e tgs) - (while (setq e (pop tags)) - (cond - ((equal e "{") (push '(:startgroup) tgs)) - ((equal e "}") (push '(:endgroup) tgs)) - ((string-match (org-re "^\\([[:alnum:]_@]+\\)(\\(.\\))$") e) - (push (cons (match-string 1 e) - (string-to-char (match-string 2 e))) - tgs)) - (t (push (list e) tgs)))) - (org-set-local 'org-tag-alist nil) - (while (setq e (pop tgs)) - (or (and (stringp (car e)) - (assoc (car e) org-tag-alist)) - (push e org-tag-alist)))))) - - ;; Compute the regular expressions and other local variables - (if (not org-done-keywords) - (setq org-done-keywords (list (org-last org-todo-keywords-1)))) - (setq org-ds-keyword-length (+ 2 (max (length org-deadline-string) - (length org-scheduled-string))) - org-drawer-regexp - (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") - "\\):[ \t]*$") - org-not-done-keywords - (org-delete-all org-done-keywords (copy-sequence org-todo-keywords-1)) - org-todo-regexp - (concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords-1 - "\\|") "\\)\\>") - org-not-done-regexp - (concat "\\<\\(" - (mapconcat 'regexp-quote org-not-done-keywords "\\|") - "\\)\\>") - org-todo-line-regexp - (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" - (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") - "\\)\\>\\)?[ \t]*\\(.*\\)") - org-complex-heading-regexp - (concat "^\\(\\*+\\)\\(?:[ \t]+\\(" - (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") - "\\)\\>\\)?\\(?:[ \t]*\\(\\[#.\\]\\)\\)?[ \t]*\\(.*?\\)" - "\\(?:[ \t]+\\(:[[:alnum:]_@:]+:\\)\\)?[ \t]*$") - org-nl-done-regexp - (concat "\n\\*+[ \t]+" - "\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|") - "\\)" "\\>") - org-todo-line-tags-regexp - (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" - (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") - (org-re - "\\)\\>\\)? *\\(.*?\\([ \t]:[[:alnum:]:_@]+:[ \t]*\\)?$\\)")) - org-looking-at-done-regexp - (concat "^" "\\(?:" - (mapconcat 'regexp-quote org-done-keywords "\\|") "\\)" - "\\>") - org-deadline-regexp (concat "\\<" org-deadline-string) - org-deadline-time-regexp - (concat "\\<" org-deadline-string " *<\\([^>]+\\)>") - org-deadline-line-regexp - (concat "\\<\\(" org-deadline-string "\\).*") - org-scheduled-regexp - (concat "\\<" org-scheduled-string) - org-scheduled-time-regexp - (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>") - org-closed-time-regexp - (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]") - org-keyword-time-regexp - (concat "\\<\\(" org-scheduled-string - "\\|" org-deadline-string - "\\|" org-closed-string - "\\|" org-clock-string "\\)" - " *[[<]\\([^]>]+\\)[]>]") - org-keyword-time-not-clock-regexp - (concat "\\<\\(" org-scheduled-string - "\\|" org-deadline-string - "\\|" org-closed-string - "\\)" - " *[[<]\\([^]>]+\\)[]>]") - org-maybe-keyword-time-regexp - (concat "\\(\\<\\(" org-scheduled-string - "\\|" org-deadline-string - "\\|" org-closed-string - "\\|" org-clock-string "\\)\\)?" - " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^]\r\n>]*?[]>]\\|<%%([^\r\n>]*>\\)") - org-planning-or-clock-line-re - (concat "\\(?:^[ \t]*\\(" org-scheduled-string - "\\|" org-deadline-string - "\\|" org-closed-string "\\|" org-clock-string - "\\)\\>\\)") - ) - (org-compute-latex-and-specials-regexp) - (org-set-font-lock-defaults))) - -(defun org-remove-keyword-keys (list) - (mapcar (lambda (x) - (if (string-match "(..?)$" x) - (substring x 0 (match-beginning 0)) - x)) - list)) - -;; FIXME: this could be done much better, using second characters etc. -(defun org-assign-fast-keys (alist) - "Assign fast keys to a keyword-key alist. -Respect keys that are already there." - (let (new e k c c1 c2 (char ?a)) - (while (setq e (pop alist)) - (cond - ((equal e '(:startgroup)) (push e new)) - ((equal e '(:endgroup)) (push e new)) - (t - (setq k (car e) c2 nil) - (if (cdr e) - (setq c (cdr e)) - ;; automatically assign a character. - (setq c1 (string-to-char - (downcase (substring - k (if (= (string-to-char k) ?@) 1 0))))) - (if (or (rassoc c1 new) (rassoc c1 alist)) - (while (or (rassoc char new) (rassoc char alist)) - (setq char (1+ char))) - (setq c2 c1)) - (setq c (or c2 char))) - (push (cons k c) new)))) - (nreverse new))) - -;;; Some variables ujsed in various places - -(defvar org-window-configuration nil - "Used in various places to store a window configuration.") -(defvar org-finish-function nil - "Function to be called when `C-c C-c' is used. -This is for getting out of special buffers like remember.") - - -;; FIXME: Occasionally check by commenting these, to make sure -;; no other functions uses these, forgetting to let-bind them. -(defvar entry) -(defvar state) -(defvar last-state) -(defvar date) -(defvar description) - -;; Defined somewhere in this file, but used before definition. -(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized -(defvar org-agenda-buffer-name) -(defvar org-agenda-undo-list) -(defvar org-agenda-pending-undo-list) -(defvar org-agenda-overriding-header) -(defvar orgtbl-mode) -(defvar org-html-entities) -(defvar org-struct-menu) -(defvar org-org-menu) -(defvar org-tbl-menu) -(defvar org-agenda-keymap) - -;;;; Emacs/XEmacs compatibility - -;; Overlay compatibility functions -(defun org-make-overlay (beg end &optional buffer) - (if (featurep 'xemacs) - (make-extent beg end buffer) - (make-overlay beg end buffer))) -(defun org-delete-overlay (ovl) - (if (featurep 'xemacs) (delete-extent ovl) (delete-overlay ovl))) -(defun org-detach-overlay (ovl) - (if (featurep 'xemacs) (detach-extent ovl) (delete-overlay ovl))) -(defun org-move-overlay (ovl beg end &optional buffer) - (if (featurep 'xemacs) - (set-extent-endpoints ovl beg end (or buffer (current-buffer))) - (move-overlay ovl beg end buffer))) -(defun org-overlay-put (ovl prop value) - (if (featurep 'xemacs) - (set-extent-property ovl prop value) - (overlay-put ovl prop value))) -(defun org-overlay-display (ovl text &optional face evap) - "Make overlay OVL display TEXT with face FACE." - (if (featurep 'xemacs) - (let ((gl (make-glyph text))) - (and face (set-glyph-face gl face)) - (set-extent-property ovl 'invisible t) - (set-extent-property ovl 'end-glyph gl)) - (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 (featurep 'xemacs) - (let ((gl (make-glyph text))) - (and face (set-glyph-face gl face)) - (set-extent-property ovl 'begin-glyph gl)) - (if face (org-add-props text nil 'face face)) - (overlay-put ovl 'before-string text) - (if evap (overlay-put ovl 'evaporate t)))) -(defun org-overlay-get (ovl prop) - (if (featurep 'xemacs) - (extent-property ovl prop) - (overlay-get ovl prop))) -(defun org-overlays-at (pos) - (if (featurep 'xemacs) (extents-at pos) (overlays-at pos))) -(defun org-overlays-in (&optional start end) - (if (featurep 'xemacs) - (extent-list nil start end) - (overlays-in start end))) -(defun org-overlay-start (o) - (if (featurep 'xemacs) (extent-start-position o) (overlay-start o))) -(defun org-overlay-end (o) - (if (featurep 'xemacs) (extent-end-position o) (overlay-end o))) -(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 ((overlays (org-overlays-at (or pos (point)))) - ov found) - (while (setq ov (pop overlays)) - (if (org-overlay-get ov prop) - (if delete (org-delete-overlay ov) (push ov found)))) - found)) - -;; Region compatibility - -(defun org-add-hook (hook function &optional append local) - "Add-hook, compatible with both Emacsen." - (if (and local (featurep 'xemacs)) - (add-local-hook hook function append) - (add-hook hook function append local))) - -(defvar org-ignore-region nil - "To temporarily disable the active region.") - -(defun org-region-active-p () - "Is `transient-mark-mode' on and the region active? -Works on both Emacs and XEmacs." - (if org-ignore-region - nil - (if (featurep 'xemacs) - (and zmacs-regions (region-active-p)) - (if (fboundp 'use-region-p) - (use-region-p) - (and transient-mark-mode mark-active))))) ; Emacs 22 and before - -;; Invisibility compatibility - -(defun org-add-to-invisibility-spec (arg) - "Add elements to `buffer-invisibility-spec'. -See documentation for `buffer-invisibility-spec' for the kind of elements -that can be added." - (cond - ((fboundp 'add-to-invisibility-spec) - (add-to-invisibility-spec arg)) - ((or (null buffer-invisibility-spec) (eq buffer-invisibility-spec t)) - (setq buffer-invisibility-spec (list arg))) - (t - (setq buffer-invisibility-spec - (cons arg buffer-invisibility-spec))))) - -(defun org-remove-from-invisibility-spec (arg) - "Remove elements from `buffer-invisibility-spec'." - (if (fboundp 'remove-from-invisibility-spec) - (remove-from-invisibility-spec arg) - (if (consp buffer-invisibility-spec) - (setq buffer-invisibility-spec - (delete arg buffer-invisibility-spec))))) - -(defun org-in-invisibility-spec-p (arg) - "Is ARG a member of `buffer-invisibility-spec'?" - (if (consp buffer-invisibility-spec) - (member arg buffer-invisibility-spec) - nil)) - -;;;; Define the Org-mode - -(if (and (not (keymapp outline-mode-map)) (featurep 'allout)) - (error "Conflict with outdated version of allout.el. Load org.el before allout.el, or ugrade to newer allout, for example by switching to Emacs 22.")) - - -;; We use a before-change function to check if a table might need -;; an update. -(defvar org-table-may-need-update t - "Indicates that a table might need an update. -This variable is set by `org-before-change-function'. -`org-table-align' sets it back to nil.") -(defvar org-mode-map) -(defvar org-mode-hook nil) -(defvar org-inhibit-startup nil) ; Dynamically-scoped param. -(defvar org-agenda-keep-modes nil) ; Dynamically-scoped param. -(defvar org-table-buffer-is-an nil) -(defconst org-outline-regexp "\\*+ ") - -;;;###autoload -(define-derived-mode org-mode outline-mode "Org" - "Outline-based notes management and organizer, alias -\"Carsten's outline-mode for keeping track of everything.\" - -Org-mode develops organizational tasks around a NOTES file which -contains information about projects as plain text. Org-mode is -implemented on top of outline-mode, which is ideal to keep the content -of large files well structured. It supports ToDo items, deadlines and -time stamps, which magically appear in the diary listing of the Emacs -calendar. Tables are easily created with a built-in table editor. -Plain text URL-like links connect to websites, emails (VM), Usenet -messages (Gnus), BBDB entries, and any files related to the project. -For printing and sharing of notes, an Org-mode file (or a part of it) -can be exported as a structured ASCII or HTML file. - -The following commands are available: - -\\{org-mode-map}" - - ;; Get rid of Outline menus, they are not needed - ;; Need to do this here because define-derived-mode sets up - ;; the keymap so late. Still, it is a waste to call this each time - ;; we switch another buffer into org-mode. - (if (featurep 'xemacs) - (when (boundp 'outline-mode-menu-heading) - ;; Assume this is Greg's port, it used easymenu - (easy-menu-remove outline-mode-menu-heading) - (easy-menu-remove outline-mode-menu-show) - (easy-menu-remove outline-mode-menu-hide)) - (define-key org-mode-map [menu-bar headings] 'undefined) - (define-key org-mode-map [menu-bar hide] 'undefined) - (define-key org-mode-map [menu-bar show] 'undefined)) - - (easy-menu-add org-org-menu) - (easy-menu-add org-tbl-menu) - (org-install-agenda-files-menu) - (if org-descriptive-links (org-add-to-invisibility-spec '(org-link))) - (org-add-to-invisibility-spec '(org-cwidth)) - (when (featurep 'xemacs) - (org-set-local 'line-move-ignore-invisible t)) - (org-set-local 'outline-regexp org-outline-regexp) - (org-set-local 'outline-level 'org-outline-level) - (when (and org-ellipsis - (fboundp 'set-display-table-slot) (boundp 'buffer-display-table) - (fboundp 'make-glyph-code)) - (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 (and (not (stringp org-ellipsis)) - org-ellipsis))) - (if (stringp org-ellipsis) org-ellipsis "...")))) - (setq buffer-display-table org-display-table)) - (org-set-regexps-and-options) - ;; Calc embedded - (org-set-local 'calc-embedded-open-mode "# ") - (modify-syntax-entry ?# "<") - (modify-syntax-entry ?@ "w") - (if org-startup-truncated (setq truncate-lines t)) - (org-set-local 'font-lock-unfontify-region-function - 'org-unfontify-region) - ;; Activate before-change-function - (org-set-local 'org-table-may-need-update t) - (org-add-hook 'before-change-functions 'org-before-change-function nil - 'local) - ;; Check for running clock before killing a buffer - (org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) - ;; Paragraphs and auto-filling - (org-set-autofill-regexps) - (setq indent-line-function 'org-indent-line-function) - (org-update-radio-target-regexp) - - ;; Comment characters -; (org-set-local 'comment-start "#") ;; FIXME: this breaks wrapping - (org-set-local 'comment-padding " ") - - ;; Imenu - (org-set-local 'imenu-create-index-function - 'org-imenu-get-tree) - - ;; Make isearch reveal context - (if (or (featurep 'xemacs) - (not (boundp 'outline-isearch-open-invisible-function))) - ;; Emacs 21 and XEmacs make use of the hook - (org-add-hook 'isearch-mode-end-hook 'org-isearch-end 'append 'local) - ;; Emacs 22 deals with this through a special variable - (org-set-local 'outline-isearch-open-invisible-function - (lambda (&rest ignore) (org-show-context 'isearch)))) - - ;; If empty file that did not turn on org-mode automatically, make it to. - (if (and org-insert-mode-line-in-empty-file - (interactive-p) - (= (point-min) (point-max))) - (insert "# -*- mode: org -*-\n\n")) - - (unless org-inhibit-startup - (when org-startup-align-all-tables - (let ((bmp (buffer-modified-p))) - (org-table-map-tables 'org-table-align) - (set-buffer-modified-p bmp))) - (org-cycle-hide-drawers 'all) - (cond - ((eq org-startup-folded t) - (org-cycle '(4))) - ((eq org-startup-folded 'content) - (let ((this-command 'org-cycle) (last-command 'org-cycle)) - (org-cycle '(4)) (org-cycle '(4))))))) - -(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify) - -(defsubst org-call-with-arg (command arg) - "Call COMMAND interactively, but pretend prefix are was ARG." - (let ((current-prefix-arg arg)) (call-interactively command))) - -(defsubst org-current-line (&optional pos) - (save-excursion - (and pos (goto-char pos)) - ;; works also in narrowed buffer, because we start at 1, not point-min - (+ (if (bolp) 1 0) (count-lines 1 (point))))) - -(defun org-current-time () - "Current time, possibly rounded to `org-time-stamp-rounding-minutes'." - (if (> org-time-stamp-rounding-minutes 0) - (let ((r org-time-stamp-rounding-minutes) - (time (decode-time))) - (apply 'encode-time - (append (list 0 (* r (floor (+ .5 (/ (float (nth 1 time)) r))))) - (nthcdr 2 time)))) - (current-time))) - -(defun org-add-props (string plist &rest props) - "Add text properties to entire string, from beginning to end. -PLIST may be a list of properties, PROPS are individual properties and values -that will be added to PLIST. Returns the string that was modified." - (add-text-properties - 0 (length string) (if props (append plist props) plist) string) - string) -(put 'org-add-props 'lisp-indent-function 2) - - -;;;; Font-Lock stuff, including the activators - -(defvar org-mouse-map (make-sparse-keymap)) -(org-defkey org-mouse-map - (if (featurep 'xemacs) [button2] [mouse-2]) 'org-open-at-mouse) -(org-defkey org-mouse-map - (if (featurep 'xemacs) [button3] [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)) -(when org-return-follows-link - (org-defkey org-mouse-map [(return)] 'org-open-at-point) - (org-defkey org-mouse-map "\C-m" 'org-open-at-point)) - -(require 'font-lock) - -(defconst org-non-link-chars "]\t\n\r<>") -(defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news" "bbdb" "vm" - "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp")) -(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-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-any-link-re nil - "Regular expression matching any link.") - -(defun org-make-link-regexps () - "Update the link regular expressions. -This should be called after the variable `org-link-types' has changed." - (setq org-link-re-with-space - (concat - "?") - org-link-re-with-space2 - (concat - "?") - org-angle-link-re - (concat - "<\\(" (mapconcat 'identity org-link-types "\\|") "\\):" - "\\([^" org-non-link-chars " ]" - "[^" org-non-link-chars "]*" - "\\)>") - org-plain-link-re - (concat - "\\<\\(" (mapconcat 'identity org-link-types "\\|") "\\):" - "\\([^]\t\n\r<>,;() ]+\\)") - org-bracket-link-regexp - "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]" - org-bracket-link-analytic-regexp - (concat - "\\[\\[" - "\\(\\(" (mapconcat 'identity org-link-types "\\|") "\\):\\)?" - "\\([^]]+\\)" - "\\]" - "\\(\\[" "\\([^]]+\\)" "\\]\\)?" - "\\]") - org-any-link-re - (concat "\\(" org-bracket-link-regexp "\\)\\|\\(" - org-angle-link-re "\\)\\|\\(" - org-plain-link-re "\\)"))) - -(org-make-link-regexps) - -(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^\r\n>]*?\\)>" - "Regular expression for fast time stamp matching.") -(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^\r\n>]*?\\)[]>]" - "Regular expression for fast time stamp matching.") -(defconst org-ts-regexp0 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\([^]0-9>\r\n]*\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" - "Regular expression matching time strings for analysis. -This one does not require the space after the date.") -(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) \\([^]0-9>\r\n]*\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" - "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.") - -(defvar org-emph-face nil) - -(defun org-do-emphasis-faces (limit) - "Run through the buffer and add overlays to links." - (let (rtn) - (while (and (not rtn) (re-search-forward org-emph-re limit t)) - (if (not (= (char-after (match-beginning 3)) - (char-after (match-beginning 4)))) - (progn - (setq rtn t) - (font-lock-prepend-text-property (match-beginning 2) (match-end 2) - 'face - (nth 1 (assoc (match-string 3) - org-emphasis-alist))) - (add-text-properties (match-beginning 2) (match-end 2) - '(font-lock-multiline 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))))) - (backward-char 1)) - rtn)) - -(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 either the marker character, or the first character of the -HTML tag associated with that emphasis. If CHAR is a space, the 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 ((eal org-emphasis-alist) e det - (erc org-emphasis-regexp-components) - (prompt "") - (string "") beg end move tag c s) - (if (org-region-active-p) - (setq beg (region-beginning) end (region-end) - string (buffer-substring beg end)) - (setq move t)) - - (while (setq e (pop eal)) - (setq tag (car (org-split-string (nth 2 e) "[ <>/]+")) - c (aref tag 0)) - (push (cons c (string-to-char (car e))) det) - (setq prompt (concat prompt (format " [%s%c]%s" (car e) c - (substring tag 1))))) - (unless char - (message "%s" (concat "Emphasis marker or tag:" prompt)) - (setq char (read-char-exclusive))) - (setq char (or (cdr (assoc char det)) char)) - (if (equal char ?\ ) - (setq s "" move nil) - (unless (assoc (char-to-string char) org-emphasis-alist) - (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)) - (if beg (delete-region beg end)) - (unless (or (bolp) - (string-match (concat "[" (nth 0 erc) "\n]") - (char-to-string (char-before (point))))) - (insert " ")) - (unless (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)) - - -(defun org-activate-plain-links (limit) - "Run through the buffer and add overlays to links." - (catch 'exit - (let (f) - (while (re-search-forward org-plain-link-re limit t) - (setq f (get-text-property (match-beginning 0) 'face)) - (if (or (eq f 'org-tag) - (and (listp f) (memq 'org-tag f))) - nil - (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'rear-nonsticky org-nonsticky-props - 'keymap org-mouse-map - )) - (throw 'exit t)))))) - -(defun org-activate-code (limit) - (if (re-search-forward "^[ \t]*\\(:.*\\)" limit t) - (unless (get-text-property (match-beginning 1) 'face) - (remove-text-properties (match-beginning 0) (match-end 0) - '(display t invisible t intangible t)) - t))) - -(defun org-activate-angle-links (limit) - "Run through the buffer and add overlays to links." - (if (re-search-forward org-angle-link-re limit t) - (progn - (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'rear-nonsticky org-nonsticky-props - 'keymap org-mouse-map - )) - t))) - -(defmacro org-maybe-intangible (props) - "Add '(intangigble t) to PROPS if Emacs version is earlier than Emacs 22. -In emacs 21, invisible text is not avoided by the command loop, so the -intangible property is needed to make sure point skips this text. -In Emacs 22, this is not necessary. The intangible text property has -led to problems with flyspell. These problems are fixed in flyspell.el, -but we still avoid setting the property in Emacs 22 and later. -We use a macro so that the test can happen at compilation time." - (if (< emacs-major-version 22) - `(append '(intangible t) ,props) - props)) - -(defun org-activate-bracket-links (limit) - "Run through the buffer and add overlays to bracketed links." - (if (re-search-forward org-bracket-link-regexp limit t) - (let* ((help (concat "LINK: " - (org-match-string-no-properties 1))) - ;; FIXME: above we should remove the escapes. - ;; but that requires another match, protecting match data, - ;; a lot of overhead for font-lock. - (ip (org-maybe-intangible - (list 'invisible 'org-link 'rear-nonsticky org-nonsticky-props - 'keymap org-mouse-map 'mouse-face 'highlight - 'font-lock-multiline t 'help-echo help))) - (vp (list 'rear-nonsticky org-nonsticky-props - 'keymap org-mouse-map 'mouse-face 'highlight - ' font-lock-multiline t 'help-echo help))) - ;; We need to remove the invisible property here. Table narrowing - ;; may have made some of this invisible. - (remove-text-properties (match-beginning 0) (match-end 0) - '(invisible nil)) - (if (match-end 3) - (progn - (add-text-properties (match-beginning 0) (match-beginning 3) ip) - (add-text-properties (match-beginning 3) (match-end 3) vp) - (add-text-properties (match-end 3) (match-end 0) ip)) - (add-text-properties (match-beginning 0) (match-beginning 1) ip) - (add-text-properties (match-beginning 1) (match-end 1) vp) - (add-text-properties (match-end 1) (match-end 0) ip)) - t))) - -(defun org-activate-dates (limit) - "Run through the buffer and add overlays to dates." - (if (re-search-forward org-tsr-regexp-both limit t) - (progn - (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'rear-nonsticky org-nonsticky-props - 'keymap org-mouse-map)) - (when org-display-custom-times - (if (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 org-target-link-regexp nil - "Regular expression matching radio targets in plain text.") -(defvar org-target-regexp "<<\\([^<>\n\r]+\\)>>" - "Regular expression matching a link target.") -(defvar org-radio-target-regexp "<<<\\([^<>\n\r]+\\)>>>" - "Regular expression matching a radio target.") -(defvar org-any-target-regexp "<<\n\r]+\\)>>>?" ; FIXME, not exact, would match <<> as a radio target. - "Regular expression matching any target.") - -(defun org-activate-target-links (limit) - "Run through the buffer and add overlays to target matches." - (when org-target-link-regexp - (let ((case-fold-search t)) - (if (re-search-forward org-target-link-regexp limit t) - (progn - (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'rear-nonsticky org-nonsticky-props - 'keymap org-mouse-map - 'help-echo "Radio target link" - 'org-linked-text t)) - t))))) - -(defun org-update-radio-target-regexp () - "Find all radio targets in this file and update the regular expression." - (interactive) - (when (memq 'radio org-activate-links) - (setq org-target-link-regexp - (org-make-target-link-regexp (org-all-targets 'radio))) - (org-restart-font-lock))) - -(defun org-hide-wide-columns (limit) - (let (s e) - (setq s (text-property-any (point) (or limit (point-max)) - 'org-cwidth t)) - (when s - (setq e (next-single-property-change s 'org-cwidth)) - (add-text-properties s e (org-maybe-intangible '(invisible org-cwidth))) - (goto-char e) - t))) - -(defvar org-latex-and-specials-regexp nil - "Regular expression for highlighting export special stuff.") -(defvar org-match-substring-regexp) -(defvar org-match-substring-with-braces-regexp) -(defvar org-export-html-special-string-regexps) - -(defun org-compute-latex-and-specials-regexp () - "Compute regular expression for stuff treated specially by exporters." - (if (not org-highlight-latex-fragments-and-specials) - (org-set-local 'org-latex-and-specials-regexp nil) - (let* - ((matchers (plist-get org-format-latex-options :matchers)) - (latexs (delq nil (mapcar (lambda (x) (if (member (car x) matchers) x)) - org-latex-regexps))) - (options (org-combine-plists (org-default-export-plist) - (org-infile-export-plist))) - (org-export-with-sub-superscripts (plist-get options :sub-superscript)) - (org-export-with-LaTeX-fragments (plist-get options :LaTeX-fragments)) - (org-export-with-TeX-macros (plist-get options :TeX-macros)) - (org-export-html-expand (plist-get options :expand-quoted-html)) - (org-export-with-special-strings (plist-get options :special-strings)) - (re-sub - (cond - ((equal org-export-with-sub-superscripts '{}) - (list org-match-substring-with-braces-regexp)) - (org-export-with-sub-superscripts - (list org-match-substring-regexp)) - (t nil))) - (re-latex - (if org-export-with-LaTeX-fragments - (mapcar (lambda (x) (nth 1 x)) latexs))) - (re-macros - (if org-export-with-TeX-macros - (list (concat "\\\\" - (regexp-opt - (append (mapcar 'car org-html-entities) - (if (boundp 'org-latex-entities) - org-latex-entities nil)) - 'words))) ; FIXME - )) - ;; (list "\\\\\\(?:[a-zA-Z]+\\)"))) - (re-special (if org-export-with-special-strings - (mapcar (lambda (x) (car x)) - org-export-html-special-string-regexps))) - (re-rest - (delq nil - (list - (if org-export-html-expand "@<[^>\n]+>") - )))) - (org-set-local - 'org-latex-and-specials-regexp - (mapconcat 'identity (append re-latex re-sub re-macros re-special - re-rest) "\\|"))))) - -(defface org-latex-and-export-specials - (let ((font (cond ((assq :inherit custom-face-attributes) - '(:inherit underline)) - (t '(:underline t))))) - `((((class grayscale) (background light)) - (:foreground "DimGray" ,@font)) - (((class grayscale) (background dark)) - (:foreground "LightGray" ,@font)) - (((class color) (background light)) - (:foreground "SaddleBrown")) - (((class color) (background dark)) - (:foreground "burlywood")) - (t (,@font)))) - "Face used to highlight math latex and other special exporter stuff." - :group 'org-faces) - -(defun org-do-latex-and-special-faces (limit) - "Run through the buffer and add overlays to links." - (when org-latex-and-specials-regexp - (let (rtn d) - (while (and (not rtn) (re-search-forward org-latex-and-specials-regexp - limit t)) - (if (not (memq (car-safe (get-text-property (1+ (match-beginning 0)) - 'face)) - '(org-code org-verbatim underline))) - (progn - (setq rtn t - d (cond ((member (char-after (1+ (match-beginning 0))) - '(?_ ?^)) 1) - (t 0))) - (font-lock-prepend-text-property - (+ d (match-beginning 0)) (match-end 0) - 'face 'org-latex-and-export-specials) - (add-text-properties (+ d (match-beginning 0)) (match-end 0) - '(font-lock-multiline t))))) - rtn))) - -(defun org-restart-font-lock () - "Restart font-lock-mode, to force refontification." - (when (and (boundp 'font-lock-mode) font-lock-mode) - (font-lock-mode -1) - (font-lock-mode 1))) - -(defun org-all-targets (&optional radio) - "Return a list of all targets in this file. -With optional argument RADIO, only find radio targets." - (let ((re (if radio org-radio-target-regexp org-target-regexp)) - rtn) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward re nil t) - (add-to-list 'rtn (downcase (org-match-string-no-properties 1)))) - rtn))) - -(defun org-make-target-link-regexp (targets) - "Make regular expression matching all strings in TARGETS. -The regular expression finds the targets also if there is a line break -between words." - (and targets - (concat - "\\<\\(" - (mapconcat - (lambda (x) - (while (string-match " +" x) - (setq x (replace-match "\\s-+" t t x))) - x) - targets - "\\|") - "\\)\\>"))) - -(defun org-activate-tags (limit) - (if (re-search-forward (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \r\n]") limit t) - (progn - (add-text-properties (match-beginning 1) (match-end 1) - (list 'mouse-face 'highlight - 'rear-nonsticky org-nonsticky-props - 'keymap org-mouse-map)) - t))) - -(defun org-outline-level () - (save-excursion - (looking-at outline-regexp) - (if (match-beginning 1) - (+ (org-get-string-indentation (match-string 1)) 1000) - (1- (- (match-end 0) (match-beginning 0)))))) - -(defvar org-font-lock-keywords nil) - -(defconst org-property-re (org-re "^[ \t]*\\(:\\([[:alnum:]_]+\\):\\)[ \t]*\\(\\S-.*\\)") - "Regular expression matching a property line.") - -(defun org-set-font-lock-defaults () - (let* ((em org-fontify-emphasized-text) - (lk org-activate-links) - (org-font-lock-extra-keywords - (list - ;; Headlines - '("^\\(\\**\\)\\(\\* \\)\\(.*\\)" (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)) - ;; Drawers - (list org-drawer-regexp '(0 'org-special-keyword t)) - (list "^[ \t]*:END:" '(0 'org-special-keyword t)) - ;; Properties - (list org-property-re - '(1 'org-special-keyword t) - '(3 'org-property-value t)) - (if org-format-transports-properties-p - '("| *\\(<[0-9]+>\\) *" (1 'org-formula t))) - ;; Links - (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend))) - (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t))) - (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t))) - (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t))) - (if (memq 'radio lk) '(org-activate-target-links (0 'org-link t))) - (if (memq 'date lk) '(org-activate-dates (0 'org-date t))) - '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t)) - '(org-hide-wide-columns (0 nil append)) - ;; TODO lines - (list (concat "^\\*+[ \t]+" org-todo-regexp) - '(1 (org-get-todo-face 1) t)) - ;; DONE - (if org-fontify-done-headline - (list (concat "^[*]+ +\\<\\(" - (mapconcat 'regexp-quote org-done-keywords "\\|") - "\\)\\(.*\\)") - '(2 'org-headline-done t)) - nil) - ;; Priorities - (list (concat "\\[#[A-Z0-9]\\]") '(0 'org-special-keyword t)) - ;; Special keywords - (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t)) - (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t)) - (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t)) - (list (concat "\\<" org-clock-string) '(0 'org-special-keyword t)) - ;; Emphasis - (if em - (if (featurep 'xemacs) - '(org-do-emphasis-faces (0 nil append)) - '(org-do-emphasis-faces))) - ;; Checkboxes - '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)" - 2 'bold prepend) - (if org-provide-checkbox-statistics - '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" - (0 (org-get-checkbox-statistics-face) t))) - (list (concat "^\\*+ \\(.*:" org-archive-tag ":.*\\)") - '(1 'org-archived prepend)) - ;; Specials - '(org-do-latex-and-special-faces) - ;; Code - '(org-activate-code (1 'org-code t)) - ;; COMMENT - (list (concat "^\\*+[ \t]+\\<\\(" org-comment-string - "\\|" org-quote-string "\\)\\>") - '(1 'org-special-keyword t)) - '("^#.*" (0 'font-lock-comment-face t)) - ))) - (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) - ;; Now set the full font-lock-keywords - (org-set-local 'org-font-lock-keywords org-font-lock-extra-keywords) - (org-set-local 'font-lock-defaults - '(org-font-lock-keywords t nil nil backward-paragraph)) - (kill-local-variable 'font-lock-keywords) nil)) - -(defvar org-m nil) -(defvar org-l nil) -(defvar org-f nil) -(defun org-get-level-face (n) - "Get the right face for match N in font-lock matching of healdines." - (setq org-l (- (match-end 2) (match-beginning 1) 1)) - (if org-odd-levels-only (setq org-l (1+ (/ org-l 2)))) - (setq org-f (nth (% (1- 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 (if org-level-color-stars-only nil org-f)))) - -(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." - (if (numberp kwd) (setq kwd (match-string kwd))) - (or (cdr (assoc kwd org-todo-keyword-faces)) - (and (member kwd org-done-keywords) 'org-done) - 'org-todo)) - -(defun org-unfontify-region (beg end &optional maybe_loudly) - "Remove fontification and activation overlays from links." - (font-lock-default-unfontify-region beg end) - (let* ((buffer-undo-list t) - (inhibit-read-only t) (inhibit-point-motion-hooks t) - (inhibit-modification-hooks t) - deactivate-mark buffer-file-name buffer-file-truename) - (remove-text-properties beg end - '(mouse-face t keymap t org-linked-text t - invisible t intangible t)))) - -;;;; Visibility cycling, including org-goto and indirect buffer - -;;; Cycling - -(defvar org-cycle-global-status nil) -(make-variable-buffer-local 'org-cycle-global-status) -(defvar org-cycle-subtree-status nil) -(make-variable-buffer-local 'org-cycle-subtree-status) - -;;;###autoload -(defun org-cycle (&optional arg) - "Visibility cycling for Org-mode. - -- When this function is called with a prefix argument, rotate the entire - buffer through 3 states (global cycling) - 1. OVERVIEW: Show only top-level headlines. - 2. CONTENTS: Show all headlines of all levels, but no body text. - 3. SHOW ALL: Show everything. - -- When point is at the beginning of a headline, rotate the subtree started - by this line through 3 different states (local cycling) - 1. FOLDED: Only the main headline is shown. - 2. CHILDREN: The main headline and the direct children are shown. - From this state, you can move to one of the children - and zoom in further. - 3. SUBTREE: Show the entire subtree, including body text. - -- When there is a numeric prefix, go up to a heading with level ARG, do - a `show-subtree' and return to the previous cursor position. If ARG - is negative, go up that many levels. - -- When point is not at the beginning of a headline, execute - `indent-relative', like TAB normally does. See the option - `org-cycle-emulate-tab' for details. - -- Special case: if point is at the beginning of the buffer and there is - no headline in line 1, this function will act as if called with prefix arg. - But only if also the variable `org-cycle-global-at-bob' is t." - (interactive "P") - (let* ((outline-regexp - (if (and (org-mode-p) org-cycle-include-plain-lists) - "\\(?:\\*+ \\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) \\)" - outline-regexp)) - (bob-special (and org-cycle-global-at-bob (bobp) - (not (looking-at outline-regexp)))) - (org-cycle-hook - (if bob-special - (delq 'org-optimize-window-after-visibility-change - (copy-sequence org-cycle-hook)) - org-cycle-hook)) - (pos (point))) - - (if (or bob-special (equal arg '(4))) - ;; special case: use global cycling - (setq arg t)) - - (cond - - ((org-at-table-p 'any) - ;; Enter the table or move to the next field in the table - (or (org-table-recognize-table.el) - (progn - (if arg (org-table-edit-field t) - (org-table-justify-field-maybe) - (call-interactively 'org-table-next-field))))) - - ((eq arg t) ;; Global cycling - - (cond - ((and (eq last-command this-command) - (eq org-cycle-global-status 'overview)) - ;; We just created the overview - now do table of contents - ;; This can be slow in very large buffers, so indicate action - (message "CONTENTS...") - (org-content) - (message "CONTENTS...done") - (setq org-cycle-global-status 'contents) - (run-hook-with-args 'org-cycle-hook 'contents)) - - ((and (eq last-command this-command) - (eq org-cycle-global-status 'contents)) - ;; We just showed the table of contents - now show everything - (show-all) - (message "SHOW ALL") - (setq org-cycle-global-status 'all) - (run-hook-with-args 'org-cycle-hook 'all)) - - (t - ;; Default action: go to overview - (org-overview) - (message "OVERVIEW") - (setq org-cycle-global-status 'overview) - (run-hook-with-args 'org-cycle-hook 'overview)))) - - ((and org-drawers org-drawer-regexp - (save-excursion - (beginning-of-line 1) - (looking-at org-drawer-regexp))) - ;; Toggle block visibility - (org-flag-drawer - (not (get-char-property (match-end 0) 'invisible)))) - - ((integerp arg) - ;; Show-subtree, ARG levels up from here. - (save-excursion - (org-back-to-heading) - (outline-up-heading (if (< arg 0) (- arg) - (- (funcall outline-level) arg))) - (org-show-subtree))) - - ((and (save-excursion (beginning-of-line 1) (looking-at outline-regexp)) - (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) - ;; At a heading: rotate between three different views - (org-back-to-heading) - (let ((goal-column 0) eoh eol eos) - ;; First, some boundaries - (save-excursion - (org-back-to-heading) - (save-excursion - (beginning-of-line 2) - (while (and (not (eobp)) ;; this is like `next-line' - (get-char-property (1- (point)) 'invisible)) - (beginning-of-line 2)) (setq eol (point))) - (outline-end-of-heading) (setq eoh (point)) - (org-end-of-subtree t) - (unless (eobp) - (skip-chars-forward " \t\n") - (beginning-of-line 1) ; in case this is an item - ) - (setq eos (1- (point)))) - ;; Find out what to do next and set `this-command' - (cond - ((= eos eoh) - ;; Nothing is hidden behind this heading - (message "EMPTY ENTRY") - (setq org-cycle-subtree-status nil) - (save-excursion - (goto-char eos) - (outline-next-heading) - (if (org-invisible-p) (org-flag-heading nil)))) - ((or (>= eol eos) - (not (string-match "\\S-" (buffer-substring eol eos)))) - ;; Entire subtree is hidden in one line: open it - (org-show-entry) - (show-children) - (message "CHILDREN") - (save-excursion - (goto-char eos) - (outline-next-heading) - (if (org-invisible-p) (org-flag-heading nil))) - (setq org-cycle-subtree-status 'children) - (run-hook-with-args 'org-cycle-hook 'children)) - ((and (eq last-command this-command) - (eq org-cycle-subtree-status 'children)) - ;; We just showed the children, now show everything. - (org-show-subtree) - (message "SUBTREE") - (setq org-cycle-subtree-status 'subtree) - (run-hook-with-args 'org-cycle-hook 'subtree)) - (t - ;; Default action: hide the subtree. - (hide-subtree) - (message "FOLDED") - (setq org-cycle-subtree-status 'folded) - (run-hook-with-args 'org-cycle-hook 'folded))))) - - ;; TAB emulation - (buffer-read-only (org-back-to-heading)) - - ((org-try-cdlatex-tab)) - - ((and (eq org-cycle-emulate-tab 'exc-hl-bol) - (or (not (bolp)) - (not (looking-at 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)) -; (if (and (looking-at "[ \n\r\t]") -; (string-match "^[ \t]*$" (buffer-substring -; (point-at-bol) (point)))) -; (progn -; (beginning-of-line 1) -; (and (looking-at "[ \t]+") (replace-match "")))) - (call-interactively (global-key-binding "\t"))) - - (t (save-excursion - (org-back-to-heading) - (org-cycle)))))) - -;;;###autoload -(defun org-global-cycle (&optional arg) - "Cycle the global visibility. For details see `org-cycle'." - (interactive "P") - (let ((org-cycle-include-plain-lists - (if (org-mode-p) org-cycle-include-plain-lists nil))) - (if (integerp arg) - (progn - (show-all) - (hide-sublevels arg) - (setq org-cycle-global-status 'contents)) - (org-cycle '(4))))) - -(defun org-overview () - "Switch to overview mode, shoing only top-level headlines. -Really, this shows all headlines with level equal or greater than the level -of the first headline in the buffer. This is important, because if the -first headline is not level one, then (hide-sublevels 1) gives confusing -results." - (interactive) - (let ((level (save-excursion - (goto-char (point-min)) - (if (re-search-forward (concat "^" outline-regexp) nil t) - (progn - (goto-char (match-beginning 0)) - (funcall outline-level)))))) - (and level (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") - (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 outline-regexp)) - (if (integerp arg) - (show-children (1- arg)) - (show-branches)) - (if (bobp) (throw 'exit nil)))))) - - -(defun org-optimize-window-after-visibility-change (state) - "Adjust the window after a change in outline visibility. -This function is the default value of the hook `org-cycle-hook'." - (when (get-buffer-window (current-buffer)) - (cond -; ((eq state 'overview) (org-first-headline-recenter 1)) -; ((eq state 'overview) (org-beginning-of-line)) - ((eq state 'content) nil) - ((eq state 'all) nil) - ((eq state 'folded) nil) - ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1))) - ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1)))))) - -(defun org-compact-display-after-subtree-move () - (let (beg end) - (save-excursion - (if (org-up-heading-safe) - (progn - (hide-subtree) - (show-entry) - (show-children) - (org-cycle-show-empty-lines 'children) - (org-cycle-hide-drawers 'children)) - (org-overview))))) - -(defun org-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 headeline." - (when (> org-cycle-separator-lines 0) - (save-excursion - (let* ((n 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) - (beginning-of-line 2) - (point))))) - (when beg - (goto-char beg) - (while (re-search-forward re end t) - (if (not (get-char-property (match-end 1) 'invisible)) - (outline-flag-region - (match-beginning 1) (match-end 1) nil))))))) - ;; Never hide empty lines at the end of the file. - (save-excursion - (goto-char (point-max)) - (outline-previous-heading) - (outline-end-of-heading) - (if (and (looking-at "[ \t\n]+") - (= (match-end 0) (point-max))) - (outline-flag-region (point) (match-end 0) nil)))) - -(defun org-subtree-end-visible-p () - "Is the end of the current subtree visible?" - (pos-visible-in-window-p - (save-excursion (org-end-of-subtree t) (point)))) - -(defun org-first-headline-recenter (&optional N) - "Move cursor to the first headline and recenter the headline. -Optional argument N means, put the headline into the Nth line of the window." - (goto-char (point-min)) - (when (re-search-forward (concat "^\\(" outline-regexp "\\)") nil t) - (beginning-of-line) - (recenter (prefix-numeric-value N)))) - -;;; Org-goto - -(defvar org-goto-window-configuration nil) -(defvar org-goto-marker nil) -(defvar 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)) cmd) - (while (setq cmd (pop cmds)) - (substitute-key-definition cmd cmd map global-map))) - (suppress-keymap map) - (org-defkey map "\C-m" 'org-goto-ret) - (org-defkey map [(left)] 'org-goto-left) - (org-defkey map [(right)] 'org-goto-right) - (org-defkey map [(?q)] 'org-goto-quit) - (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) - (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 copy of buffer to find location or copy text. -RET=jump to location [Q]uit 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 () - "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 is will also jump to -the location selected in the indirect buffer and expose the -the headline hierarchy above." - (interactive) - (let* ((org-goto-start-pos (point)) - (selected-point - (car (org-get-location (current-buffer) org-goto-help)))) - (if selected-point - (progn - (org-mark-ring-push org-goto-start-pos) - (goto-char selected-point) - (if (or (org-invisible-p) (org-invisible-p2)) - (org-show-context 'org-goto))) - (message "Quit")))) - -(defvar org-goto-selected-point nil) ; dynamically scoped parameter -(defvar org-goto-exit-command nil) ; dynamically scoped parameter - -(defun org-get-location (buf help) - "Let the user select a location in the Org-mode buffer BUF. -This function uses a recursive edit. It returns the selected position -or nil." - (let (org-goto-selected-point org-goto-exit-command) - (save-excursion - (save-window-excursion - (delete-other-windows) - (and (get-buffer "*org-goto*") (kill-buffer "*org-goto*")) - (switch-to-buffer - (condition-case nil - (make-indirect-buffer (current-buffer) "*org-goto*") - (error (make-indirect-buffer (current-buffer) "*org-goto*")))) - (with-output-to-temp-buffer "*Help*" - (princ help)) - (shrink-window-if-larger-than-buffer (get-buffer-window "*Help*")) - (setq buffer-read-only nil) - (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)) - (let ((org-show-hierarchy-above t) - (org-show-siblings t) - (org-show-following-heading t)) - (goto-char org-goto-start-pos) - (and (org-invisible-p) (org-show-context))) - (goto-char (point-min))) - (org-beginning-of-line) - (message "Select location and press RET") - ;; now we make sure that during selection, ony very few keys work - ;; and that it is impossible to switch to another window. -; (let ((gm (current-global-map)) -; (overriding-local-map org-goto-map)) -; (unwind-protect -; (progn -; (use-global-map org-goto-map) -; (recursive-edit)) -; (use-global-map gm))) - (use-local-map org-goto-map) - (recursive-edit) - )) - (kill-buffer "*org-goto*") - (cons org-goto-selected-point org-goto-exit-command))) - -(defun org-goto-ret (&optional arg) - "Finish `org-goto' by going to the new location." - (interactive "P") - (setq org-goto-selected-point (point) - org-goto-exit-command 'return) - (throw 'exit nil)) - -(defun org-goto-left () - "Finish `org-goto' by going to the new location." - (interactive) - (if (org-on-heading-p) - (progn - (beginning-of-line 1) - (setq org-goto-selected-point (point) - org-goto-exit-command 'left) - (throw 'exit nil)) - (error "Not on a heading"))) - -(defun org-goto-right () - "Finish `org-goto' by going to the new location." - (interactive) - (if (org-on-heading-p) - (progn - (setq org-goto-selected-point (point) - org-goto-exit-command 'right) - (throw 'exit nil)) - (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 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 `C-u' 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 C-u 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)) - (if (< arg 0) (setq arg (+ level arg))) - (while (> (setq level (org-outline-level)) arg) - (outline-up-heading 1 t))) - (setq beg (point) - heading (org-get-heading)) - (org-end-of-subtree t) (setq end (point))) - (if (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) - 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) - (switch-to-buffer 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) - (switch-to-buffer ibuf) - (org-set-frame-title (concat "Indirect: " heading))) - ((eq org-indirect-buffer-display 'current-window) - (switch-to-buffer ibuf)) - ((eq org-indirect-buffer-display 'other-window) - (pop-to-buffer ibuf)) - (t (error "Invalid value."))) - (if (featurep 'xemacs) - (save-excursion (org-mode) (turn-on-font-lock))) - (narrow-to-region beg end) - (show-all) - (goto-char pos) - (and (window-live-p cwin) (select-window cwin)))) - -(defun org-get-indirect-buffer (&optional buffer) - (setq buffer (or buffer (current-buffer))) - (let ((n 1) (base (buffer-name buffer)) bname) - (while (buffer-live-p - (get-buffer (setq bname (concat base "-" (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." - ;; FIXME: how to name a single frame in XEmacs??? - (unless (featurep 'xemacs) - (modify-frame-parameters (selected-frame) (list (cons 'name title))))) - -;;;; Structure editing - -;;; Inserting headlines - -(defun org-insert-heading (&optional force-heading) - "Insert a new heading or item with same depth at point. -If point is in a plain list and FORCE-HEADING is nil, create a new list item. -If point is at the beginning of a headline, insert a sibling before the -current headline. If point is in the middle of a headline, split the headline -at that position and make the rest of the headline part of the sibling below -the current headline." - (interactive "P") - (if (= (buffer-size) 0) - (insert "\n* ") - (when (or force-heading (not (org-insert-item))) - (let* ((head (save-excursion - (condition-case nil - (progn - (org-back-to-heading) - (match-string 0)) - (error "*")))) - (blank (cdr (assq 'heading org-blank-before-new-entry))) - pos) - (cond - ((and (org-on-heading-p) (bolp) - (or (bobp) - (save-excursion (backward-char 1) (not (org-invisible-p))))) - (open-line (if blank 2 1))) - ((and (bolp) - (or (bobp) - (save-excursion - (backward-char 1) (not (org-invisible-p))))) - nil) - (t (newline (if blank 2 1)))) - (insert head) (just-one-space) - (setq pos (point)) - (end-of-line 1) - (unless (= (point) pos) (just-one-space) (backward-delete-char 1)) - (run-hooks 'org-insert-heading-hook))))) - -(defun org-insert-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-todo-heading (arg) - "Insert a new heading with the same level and TODO state as current heading. -If the heading has no TODO state, or if the state is DONE, use the first -state (TODO by default). Also with prefix arg, force first state." - (interactive "P") - (when (not (org-insert-item 'checkbox)) - (org-insert-heading) - (save-excursion - (org-back-to-heading) - (outline-previous-heading) - (looking-at org-todo-line-regexp)) - (if (or arg - (not (match-beginning 2)) - (member (match-string 2) org-done-keywords)) - (insert (car org-todo-keywords-1) " ") - (insert (match-string 2) " ")))) - -(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-on-heading-p) (org-do-demote)) - ((org-at-item-p) (org-indent-item 1)))) - -(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-on-heading-p) (org-do-demote)) - ((org-at-item-p) (org-indent-item 1)))) - -;;; Promotion and Demotion - -(defun org-promote-subtree () - "Promote the entire subtree. -See also `org-promote'." - (interactive) - (save-excursion - (org-map-tree 'org-promote)) - (org-fix-position-after-promote)) - -(defun org-demote-subtree () - "Demote the entire subtree. See `org-demote'. -See also `org-promote'." - (interactive) - (save-excursion - (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 () - "Make sure that after pro/demotion cursor position is right." - (let ((pos (point))) - (when (save-excursion - (beginning-of-line 1) - (looking-at org-todo-line-regexp) - (or (equal pos (match-end 1)) (equal pos (match-end 2)))) - (cond ((eobp) (insert " ")) - ((eolp) (insert " ")) - ((equal (char-after) ?\ ) (forward-char 1)))))) - -(defun org-reduced-level (l) - (if org-odd-levels-only (1+ (floor (/ l 2))) l)) - -(defun org-get-legal-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." - (if org-odd-levels-only - (cond ((or (not change) (= 0 change)) (1+ (* 2 (/ level 2)))) - ((> change 0) (1+ (* 2 (/ (+ level (* 2 change)) 2)))) - ((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2)))))) - (max 1 (+ level change)))) - -(defun org-promote () - "Promote the current heading higher up the tree. -If the region is active in `transient-mark-mode', promote all headings -in the region." - (org-back-to-heading t) - (let* ((level (save-match-data (funcall outline-level))) - (up-head (concat (make-string (org-get-legal-level level -1) ?*) " ")) - (diff (abs (- level (length up-head) -1)))) - (if (= level 1) (error "Cannot promote to level 0. UNDO to recover if necessary")) - (replace-match up-head nil t) - ;; Fixup tag positioning - (and org-auto-align-tags (org-set-tags nil t)) - (if org-adapt-indentation (org-fixup-indentation (- diff))))) - -(defun org-demote () - "Demote the current heading lower down the tree. -If the region is active in `transient-mark-mode', demote all headings -in the region." - (org-back-to-heading t) - (let* ((level (save-match-data (funcall outline-level))) - (down-head (concat (make-string (org-get-legal-level level 1) ?*) " ")) - (diff (abs (- level (length down-head) -1)))) - (replace-match down-head nil t) - ;; Fixup tag positioning - (and org-auto-align-tags (org-set-tags nil t)) - (if org-adapt-indentation (org-fixup-indentation diff)))) - -(defun org-map-tree (fun) - "Call FUN for every heading underneath the current one." - (org-back-to-heading) - (let ((level (funcall outline-level))) - (save-excursion - (funcall fun) - (while (and (progn - (outline-next-heading) - (> (funcall outline-level) level)) - (not (eobp))) - (funcall fun))))) - -(defun org-map-region (fun beg end) - "Call FUN for every heading between BEG and END." - (let ((org-ignore-region t)) - (save-excursion - (setq end (copy-marker end)) - (goto-char beg) - (if (and (re-search-forward (concat "^" outline-regexp) nil t) - (< (point) end)) - (funcall fun)) - (while (and (progn - (outline-next-heading) - (< (point) end)) - (not (eobp))) - (funcall fun))))) - -(defun org-fixup-indentation (diff) - "Change the indentation in the current entry by DIFF -However, if any line in the current entry has no indentation, or if it -would end up with no indentation after the change, nothing at all is done." - (save-excursion - (let ((end (save-excursion (outline-next-heading) - (point-marker))) - (prohibit (if (> diff 0) - "^\\S-" - (concat "^ \\{0," (int-to-string (- diff)) "\\}\\S-"))) - col) - (unless (save-excursion (end-of-line 1) - (re-search-forward prohibit end t)) - (while (and (< (point) end) - (re-search-forward "^[ \t]+" end t)) - (goto-char (match-end 0)) - (setq col (current-column)) - (if (< diff 0) (replace-match "")) - (indent-to (+ diff col)))) - (move-marker end nil)))) - -(defun org-convert-to-odd-levels () - "Convert an org-mode file with all levels allowed to one with odd levels. -This will leave level 1 alone, convert level 2 to level 3, level 3 to -level 5 etc." - (interactive) - (when (yes-or-no-p "Are you sure you want to globally change levels to odd? ") - (let ((org-odd-levels-only nil) n) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "^\\*\\*+ " nil t) - (setq n (- (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-mode file with only odd levels to one with odd and even levels. -This promotes level 3 to level 2, level 5 to level 3 etc. If the file contains a -section with an even level, conversion would destroy the structure of the file. An error -is signaled in this case." - (interactive) - (goto-char (point-min)) - ;; First check if there are no even levels - (when (re-search-forward "^\\(\\*\\*\\)+ " nil t) - (org-show-context t) - (error "Not all levels are odd in this file. Conversion not possible.")) - (when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ") - (let ((org-odd-levels-only nil) n) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "^\\*\\*+ " nil t) - (setq n (/ (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) 'outline-get-next-sibling - 'outline-get-last-sibling)) - (ins-point (make-marker)) - (cnt (abs arg)) - 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))) - (outline-end-of-subtree)) - (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 outline-regexp)) - (progn (goto-char beg0) - (error "Cannot move past superior level or buffer limit"))) - (setq cnt (1- cnt))) - (if (> arg 0) - ;; Moving forward - still need to move over subtree - (progn (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)) - (delete-region beg end) - (outline-flag-region (1- beg) beg nil) - (outline-flag-region (1- (point)) (point) nil) - (insert txt) - (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) - (org-compact-display-after-subtree-move) - (unless folded - (org-show-entry) - (show-children) - (org-cycle-hide-drawers 'children)))) - -(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) - "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 copying it. -If CUT is non-nil, actually cut the subtree." - (interactive "p") - (let (beg end folded (beg0 (point))) - (if (interactive-p) - (org-back-to-heading nil) ; take what looks like a subtree - (org-back-to-heading t)) ; take what is really there - (org-back-over-empty-lines) - (setq beg (point)) - (skip-chars-forward " \t\r\n") - (save-match-data - (save-excursion (outline-end-of-heading) - (setq folded (org-invisible-p))) - (condition-case nil - (outline-forward-same-level (1- n)) - (error nil)) - (org-end-of-subtree t t)) - (org-back-over-empty-lines) - (setq end (point)) - (goto-char beg0) - (when (> end beg) - (setq org-subtree-clip-folded folded) - (if cut (kill-region beg end) (copy-region-as-kill beg end)) - (setq org-subtree-clip (current-kill 0)) - (message "%s: Subtree(s) with %d characters" - (if cut "Cut" "Copied") - (length org-subtree-clip))))) - -(defun org-paste-subtree (&optional level tree) - "Paste the clipboard as a subtree, with modification of headline level. -The entire subtree is promoted or demoted in order to match a new headline -level. By default, the new level is derived from the visible headings -before and after the insertion point, and taken to be the inferior headline -level of the two. So if the previous visible heading is level 3 and the -next is level 4 (or vice versa), level 4 will be used for insertion. -This makes sure that the subtree remains an independent subtree and does -not swallow low level entries. - -You can also force a different level, either by using a numeric prefix -argument, or by inserting the heading marker by hand. For example, if the -cursor is after \"*****\", then the tree will be shifted to level 5. - -If you want to insert the tree as is, just use \\[yank]. - -If optional TREE is given, use this text instead of the kill ring." - (interactive "P") - (unless (org-kill-is-subtree-p tree) - (error "%s" - (substitute-command-keys - "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) - (let* ((txt (or tree (and kill-ring (current-kill 0)))) - (^re (concat "^\\(" outline-regexp "\\)")) - (re (concat "\\(" outline-regexp "\\)")) - (^re_ (concat "\\(\\*+\\)[ \t]*")) - - (old-level (if (string-match ^re txt) - (- (match-end 0) (match-beginning 0) 1) - -1)) - (force-level (cond (level (prefix-numeric-value level)) - ((string-match - ^re_ (buffer-substring (point-at-bol) (point))) - (- (match-end 1) (match-beginning 1))) - (t nil))) - (previous-level (save-excursion - (condition-case nil - (progn - (outline-previous-visible-heading 1) - (if (looking-at re) - (- (match-end 0) (match-beginning 0) 1) - 1)) - (error 1)))) - (next-level (save-excursion - (condition-case nil - (progn - (or (looking-at outline-regexp) - (outline-next-visible-heading 1)) - (if (looking-at re) - (- (match-end 0) (match-beginning 0) 1) - 1)) - (error 1)))) - (new-level (or force-level (max previous-level next-level))) - (shift (if (or (= old-level -1) - (= new-level -1) - (= old-level new-level)) - 0 - (- new-level old-level))) - (delta (if (> shift 0) -1 1)) - (func (if (> shift 0) 'org-demote 'org-promote)) - (org-odd-levels-only nil) - beg end) - ;; Remove the forced level indicator - (if force-level - (delete-region (point-at-bol) (point))) - ;; Paste - (beginning-of-line 1) - (org-back-over-empty-lines) ;; FIXME: correct fix???? - (setq beg (point)) - (insert-before-markers txt) ;; FIXME: correct fix???? - (unless (string-match "\n\\'" txt) (insert "\n")) - (setq end (point)) - (goto-char beg) - (skip-chars-forward " \t\n\r") - (setq beg (point)) - ;; 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)))) - (when (interactive-p) - (message "Clipboard pasted as level %d subtree" new-level)) - (if (and kill-ring - (eq org-subtree-clip (current-kill 0)) - org-subtree-clip-folded) - ;; The tree was folded before it was killed/copied - (hide-subtree)))) - -(defun org-kill-is-subtree-p (&optional txt) - "Check if the current kill is an outline subtree, or a set of trees. -Returns nil if kill does not start with a headline, or if the first -headline level is not the largest headline level in the tree. -So this will actually accept several entries of equal levels as well, -which is OK for `org-paste-subtree'. -If optional TXT is given, check this string instead of the current kill." - (let* ((kill (or txt (and kill-ring (current-kill 0)) "")) - (start-level (and kill - (string-match (concat "\\`\\([ \t\n\r]*?\n\\)?\\(" - org-outline-regexp "\\)") - kill) - (- (match-end 2) (match-beginning 2) 1))) - (re (concat "^" org-outline-regexp)) - (start (1+ (match-beginning 2)))) - (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)))) - -(defun org-narrow-to-subtree () - "Narrow buffer to the current subtree." - (interactive) - (save-excursion - (narrow-to-region - (progn (org-back-to-heading) (point)) - (progn (org-end-of-subtree t t) (point))))) - - -;;; Outline Sorting - -(defun org-sort (with-case) - "Call `org-sort-entries-or-items' or `org-table-sort-lines'. -Optional argument WITH-CASE means sort case-sensitively." - (interactive "P") - (if (org-at-table-p) - (org-call-with-arg 'org-table-sort-lines with-case) - (org-call-with-arg 'org-sort-entries-or-items with-case))) - -(defvar org-priority-regexp) ; defined later in the file - -(defun org-sort-entries-or-items (&optional with-case sorting-type getkey-func property) - "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, and by date/time as given by -the first time stamp in the entry. The command prompts for the sorting -type unless it has been given to the function through the SORTING-TYPE -argument, which needs to a character, any of (?n ?N ?a ?A ?t ?T ?p ?P ?f ?F). -If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be -called with point at the beginning of the record. It must return either -a string or a number that should serve as the sorting key for that record. - -Comparing entries ignores case by default. However, with an optional argument -WITH-CASE, the sorting considers case as well." - (interactive "P") - (let ((case-func (if with-case 'identity 'downcase)) - start beg end stars re re2 - txt what tmp plain-list-p) - ;; 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)) - (if (not (org-on-heading-p)) (outline-next-heading)) - (setq start (point))) - ((org-at-item-p) - ;; we will sort this plain list - (org-beginning-of-item-list) (setq start (point)) - (org-end-of-item-list) (setq end (point)) - (goto-char start) - (setq plain-list-p t - what "plain list")) - ((or (org-on-heading-p) - (condition-case nil (progn (org-back-to-heading) t) (error nil))) - ;; we will sort the children of the current headline - (org-back-to-heading) - (setq start (point) - end (progn (org-end-of-subtree t t) - (org-back-over-empty-lines) - (point)) - what "children") - (goto-char start) - (show-subtree) - (outline-next-heading)) - (t - ;; we will sort the top-level entries in this file - (goto-char (point-min)) - (or (org-on-heading-p) (outline-next-heading)) - (setq start (point) end (point-max) what "top-level") - (goto-char start) - (show-all))) - - (setq beg (point)) - (if (>= beg end) (error "Nothing to sort")) - - (unless plain-list-p - (looking-at "\\(\\*+\\)") - (setq stars (match-string 1) - re (concat "^" (regexp-quote stars) " +") - re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[^*]") - txt (buffer-substring beg end)) - (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n"))) - (if (and (not (equal stars "*")) (string-match re2 txt)) - (error "Region to sort contains a level above the first entry"))) - - (unless sorting-type - (message - (if plain-list-p - "Sort %s: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:" - "Sort %s: [a]lpha [n]umeric [t]ime [p]riority p[r]operty [f]unc A/N/T/P/F means reversed:") - what) - (setq sorting-type (read-char-exclusive)) - - (and (= (downcase sorting-type) ?f) - (setq getkey-func - (completing-read "Sort using function: " - obarray 'fboundp t nil nil)) - (setq getkey-func (intern getkey-func))) - - (and (= (downcase sorting-type) ?r) - (setq property - (completing-read "Property: " - (mapcar 'list (org-buffer-property-keys t)) - nil t)))) - - (message "Sorting entries...") - - (save-restriction - (narrow-to-region start end) - - (let ((dcst (downcase sorting-type)) - (now (current-time))) - (sort-subr - (/= dcst sorting-type) - ;; This function moves to the beginning character of the "record" to - ;; be sorted. - (if plain-list-p - (lambda nil - (if (org-at-item-p) t (goto-char (point-max)))) - (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. - (if plain-list-p - 'org-end-of-item - (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. - (if plain-list-p - (lambda nil - (when (looking-at "[ \t]*[-+*0-9.)]+[ \t]+") - (cond - ((= dcst ?n) - (string-to-number (buffer-substring (match-end 0) - (point-at-eol)))) - ((= dcst ?a) - (buffer-substring (match-end 0) (point-at-eol))) - ((= dcst ?t) - (if (re-search-forward org-ts-regexp - (point-at-eol) t) - (org-time-string-to-time (match-string 0)) - now)) - ((= dcst ?f) - (if getkey-func - (progn - (setq tmp (funcall getkey-func)) - (if (stringp tmp) (setq tmp (funcall case-func tmp))) - tmp) - (error "Invalid key function `%s'" getkey-func))) - (t (error "Invalid sorting type `%c'" sorting-type))))) - (lambda nil - (cond - ((= dcst ?n) - (if (looking-at outline-regexp) - (string-to-number (buffer-substring (match-end 0) - (point-at-eol))) - nil)) - ((= dcst ?a) - (funcall case-func (buffer-substring (point-at-bol) - (point-at-eol)))) - ((= dcst ?t) - (if (re-search-forward org-ts-regexp - (save-excursion - (forward-line 2) - (point)) t) - (org-time-string-to-time (match-string 0)) - now)) - ((= 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 ?f) - (if getkey-func - (progn - (setq tmp (funcall getkey-func)) - (if (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 ?t) 'time-less-p) - (t nil))))) - (message "Sorting entries...done"))) - -(defun org-do-sort (table what &optional with-case sorting-type) - "Sort TABLE of WHAT according to SORTING-TYPE. -The user will be prompted for the SORTING-TYPE if the call to this -function does not specify it. WHAT is only for the prompt, to indicate -what is being sorted. The sorting key will be extracted from -the car of the elements of the table. -If WITH-CASE is non-nil, the sorting will be case-sensitive." - (unless sorting-type - (message - "Sort %s: [a]lphabetic. [n]umeric. [t]ime. A/N/T means reversed:" - what) - (setq sorting-type (read-char-exclusive))) - (let ((dcst (downcase sorting-type)) - extractfun comparefun) - ;; Define the appropriate functions - (cond - ((= dcst ?n) - (setq extractfun 'string-to-number - comparefun (if (= dcst sorting-type) '< '>))) - ((= dcst ?a) - (setq extractfun (if with-case (lambda(x) (org-sort-remove-invisible x)) - (lambda(x) (downcase (org-sort-remove-invisible x)))) - comparefun (if (= dcst sorting-type) - 'string< - (lambda (a b) (and (not (string< a b)) - (not (string= a b))))))) - ((= dcst ?t) - (setq extractfun - (lambda (x) - (if (string-match org-ts-regexp x) - (time-to-seconds - (org-time-string-to-time (match-string 0 x))) - 0)) - comparefun (if (= dcst sorting-type) '< '>))) - (t (error "Invalid sorting type `%c'" sorting-type))) - - (sort (mapcar (lambda (x) (cons (funcall extractfun (car x)) (cdr x))) - table) - (lambda (a b) (funcall comparefun (car a) (car b)))))) - -;;;; Plain list items, including checkboxes - -;;; Plain list items - -(defun org-at-item-p () - "Is point in a line starting a hand-formatted item?" - (let ((llt org-plain-list-ordered-item-terminator)) - (save-excursion - (goto-char (point-at-bol)) - (looking-at - (cond - ((eq llt t) "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") - ((= llt ?.) "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") - ((= llt ?\)) "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") - (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))))))) - -(defun org-in-item-p () - "It the cursor inside a plain list item. -Does not have to be the first line." - (save-excursion - (condition-case nil - (progn - (org-beginning-of-item) - (org-at-item-p) - t) - (error nil)))) - -(defun org-insert-item (&optional checkbox) - "Insert a new item at the current level. -Return t when things worked, nil when we are not in an item." - (when (save-excursion - (condition-case nil - (progn - (org-beginning-of-item) - (org-at-item-p) - (if (org-invisible-p) (error "Invisible item")) - t) - (error nil))) - (let* ((bul (match-string 0)) - (eow (save-excursion (beginning-of-line 1) (looking-at "[ \t]*") - (match-end 0))) - (blank (cdr (assq 'plain-list-item org-blank-before-new-entry))) - pos) - (cond - ((and (org-at-item-p) (<= (point) eow)) - ;; before the bullet - (beginning-of-line 1) - (open-line (if blank 2 1))) - ((<= (point) eow) - (beginning-of-line 1)) - (t (newline (if blank 2 1)))) - (insert bul (if checkbox "[ ]" "")) - (just-one-space) - (setq pos (point)) - (end-of-line 1) - (unless (= (point) pos) (just-one-space) (backward-delete-char 1))) - (org-maybe-renumber-ordered-list) - (and checkbox (org-update-checkbox-count-maybe)) - t)) - -;;; Checkboxes - -(defun org-at-item-checkbox-p () - "Is point at a line starting a plain-list item with a checklet?" - (and (org-at-item-p) - (save-excursion - (goto-char (match-end 0)) - (skip-chars-forward " \t") - (looking-at "\\[[- X]\\]")))) - -(defun org-toggle-checkbox (&optional arg) - "Toggle the checkbox in the current line." - (interactive "P") - (catch 'exit - (let (beg end status (firstnew 'unknown)) - (cond - ((org-region-active-p) - (setq beg (region-beginning) end (region-end))) - ((org-on-heading-p) - (setq beg (point) end (save-excursion (outline-next-heading) (point)))) - ((org-at-item-checkbox-p) - (let ((pos (point))) - (replace-match - (cond (arg "[-]") - ((member (match-string 0) '("[ ]" "[-]")) "[X]") - (t "[ ]")) - t t) - (goto-char pos)) - (throw 'exit t)) - (t (error "Not at a checkbox or heading, and no active region"))) - (save-excursion - (goto-char beg) - (while (< (point) end) - (when (org-at-item-checkbox-p) - (setq status (equal (match-string 0) "[X]")) - (when (eq firstnew 'unknown) - (setq firstnew (not status))) - (replace-match - (if (if arg (not status) firstnew) "[X]" "[ ]") t t)) - (beginning-of-line 2))))) - (org-update-checkbox-count-maybe)) - -(defun org-update-checkbox-count-maybe () - "Update checkbox statistics unless turned off by user." - (when org-provide-checkbox-statistics - (org-update-checkbox-count))) - -(defun org-update-checkbox-count (&optional all) - "Update the checkbox statistics in the current section. -This will find all statistic cookies like [57%] and [6/12] and update them -with the current numbers. With optional prefix argument ALL, do this for -the whole buffer." - (interactive "P") - (save-excursion - (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21 - (beg (condition-case nil - (progn (outline-back-to-heading) (point)) - (error (point-min)))) - (end (move-marker (make-marker) - (progn (outline-next-heading) (point)))) - (re "\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)") - (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)") - b1 e1 f1 c-on c-off lim (cstat 0)) - (when all - (goto-char (point-min)) - (outline-next-heading) - (setq beg (point) end (point-max))) - (goto-char beg) - (while (re-search-forward re end t) - (setq cstat (1+ cstat) - b1 (match-beginning 0) - e1 (match-end 0) - f1 (match-beginning 1) - lim (cond - ((org-on-heading-p) (outline-next-heading) (point)) - ((org-at-item-p) (org-end-of-item) (point)) - (t nil)) - c-on 0 c-off 0) - (goto-char e1) - (when lim - (while (re-search-forward re-box lim t) - (if (member (match-string 2) '("[ ]" "[-]")) - (setq c-off (1+ c-off)) - (setq c-on (1+ c-on)))) -; (delete-region b1 e1) - (goto-char b1) - (insert (if f1 - (format "[%d%%]" (/ (* 100 c-on) (max 1 (+ c-on c-off)))) - (format "[%d/%d]" c-on (+ c-on c-off)))) - (and (looking-at "\\[.*?\\]") - (replace-match "")))) - (when (interactive-p) - (message "Checkbox satistics updated %s (%d places)" - (if all "in entire file" "in current outline entry") cstat))))) - -(defun org-get-checkbox-statistics-face () - "Select the face for checkbox statistics. -The face will be `org-done' when all relevant boxes are checked. Otherwise -it will be `org-todo'." - (if (match-end 1) - (if (equal (match-string 1) "100%") 'org-done 'org-todo) - (if (and (> (match-end 2) (match-beginning 2)) - (equal (match-string 2) (match-string 3))) - 'org-done - 'org-todo))) - -(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 - (if (string-match "^ *" (org-remove-tabs line)) - (match-end 0)) - (save-excursion - (beginning-of-line 1) - (skip-chars-forward " \t") - (current-column)))) - -(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 indenation 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))) - (if (>= i i2) (setq l (substring line i2))) - (if (> i1 0) - (concat (make-string i1 ?\ ) l) - l))) - -(defcustom org-empty-line-terminates-plain-lists nil - "Non-nil means, an empty line ends all plain list levels. -When nil, empty lines are part of the preceeding item." - :group 'org-plain-lists - :type 'boolean) - -(defun org-beginning-of-item () - "Go to the beginning of the current hand-formatted item. -If the cursor is not in an item, throw an error." - (interactive) - (let ((pos (point)) - (limit (save-excursion - (condition-case nil - (progn - (org-back-to-heading) - (beginning-of-line 2) (point)) - (error (point-min))))) - (ind-empty (if org-empty-line-terminates-plain-lists 0 10000)) - ind ind1) - (if (org-at-item-p) - (beginning-of-line 1) - (beginning-of-line 1) - (skip-chars-forward " \t") - (setq ind (current-column)) - (if (catch 'exit - (while t - (beginning-of-line 0) - (if (or (bobp) (< (point) limit)) (throw 'exit nil)) - - (if (looking-at "[ \t]*$") - (setq ind1 ind-empty) - (skip-chars-forward " \t") - (setq ind1 (current-column))) - (if (< ind1 ind) - (progn (beginning-of-line 1) (throw 'exit (org-at-item-p)))))) - nil - (goto-char pos) - (error "Not in an item"))))) - -(defun org-end-of-item () - "Go to the end of the current hand-formatted item. -If the cursor is not in an item, throw an error." - (interactive) - (let* ((pos (point)) - ind1 - (ind-empty (if org-empty-line-terminates-plain-lists 0 10000)) - (limit (save-excursion (outline-next-heading) (point))) - (ind (save-excursion - (org-beginning-of-item) - (skip-chars-forward " \t") - (current-column))) - (end (catch 'exit - (while t - (beginning-of-line 2) - (if (eobp) (throw 'exit (point))) - (if (>= (point) limit) (throw 'exit (point-at-bol))) - (if (looking-at "[ \t]*$") - (setq ind1 ind-empty) - (skip-chars-forward " \t") - (setq ind1 (current-column))) - (if (<= ind1 ind) - (throw 'exit (point-at-bol))))))) - (if end - (goto-char end) - (goto-char pos) - (error "Not in an item")))) - -(defun org-next-item () - "Move to the beginning of the next item in the current plain list. -Error if not at a plain list, or if this is the last item in the list." - (interactive) - (let (ind ind1 (pos (point))) - (org-beginning-of-item) - (setq ind (org-get-indentation)) - (org-end-of-item) - (setq ind1 (org-get-indentation)) - (unless (and (org-at-item-p) (= ind ind1)) - (goto-char pos) - (error "On last item")))) - -(defun org-previous-item () - "Move to the beginning of the previous item in the current plain list. -Error if not at a plain list, or if this is the first item in the list." - (interactive) - (let (beg ind ind1 (pos (point))) - (org-beginning-of-item) - (setq beg (point)) - (setq ind (org-get-indentation)) - (goto-char beg) - (catch 'exit - (while t - (beginning-of-line 0) - (if (looking-at "[ \t]*$") - nil - (if (<= (setq ind1 (org-get-indentation)) ind) - (throw 'exit t))))) - (condition-case nil - (if (or (not (org-at-item-p)) - (< ind1 (1- ind))) - (error "") - (org-beginning-of-item)) - (error (goto-char pos) - (error "On first item"))))) - -(defun org-first-list-item-p () - "Is this heading the item in a plain list?" - (unless (org-at-item-p) - (error "Not at a plain list item")) - (org-beginning-of-item) - (= (point) (save-excursion (org-beginning-of-item-list)))) - -(defun org-move-item-down () - "Move the plain list item at point down, i.e. swap with following item. -Subitems (items with larger indentation) are considered part of the item, -so this really moves item trees." - (interactive) - (let (beg beg0 end end0 ind ind1 (pos (point)) txt ne-end ne-beg) - (org-beginning-of-item) - (setq beg0 (point)) - (save-excursion - (setq ne-beg (org-back-over-empty-lines)) - (setq beg (point))) - (goto-char beg0) - (setq ind (org-get-indentation)) - (org-end-of-item) - (setq end0 (point)) - (setq ind1 (org-get-indentation)) - (setq ne-end (org-back-over-empty-lines)) - (setq end (point)) - (goto-char beg0) - (when (and (org-first-list-item-p) (< ne-end ne-beg)) - ;; include less whitespace - (save-excursion - (goto-char beg) - (forward-line (- ne-beg ne-end)) - (setq beg (point)))) - (goto-char end0) - (if (and (org-at-item-p) (= ind ind1)) - (progn - (org-end-of-item) - (org-back-over-empty-lines) - (setq txt (buffer-substring beg end)) - (save-excursion - (delete-region beg end)) - (setq pos (point)) - (insert txt) - (goto-char pos) (org-skip-whitespace) - (org-maybe-renumber-ordered-list)) - (goto-char pos) - (error "Cannot move this item further down")))) - -(defun org-move-item-up (arg) - "Move the plain list item at point up, i.e. swap with previous item. -Subitems (items with larger indentation) are considered part of the item, -so this really moves item trees." - (interactive "p") - (let (beg beg0 end end0 ind ind1 (pos (point)) txt - ne-beg ne-end ne-ins ins-end) - (org-beginning-of-item) - (setq beg0 (point)) - (setq ind (org-get-indentation)) - (save-excursion - (setq ne-beg (org-back-over-empty-lines)) - (setq beg (point))) - (goto-char beg0) - (org-end-of-item) - (setq ne-end (org-back-over-empty-lines)) - (setq end (point)) - (goto-char beg0) - (catch 'exit - (while t - (beginning-of-line 0) - (if (looking-at "[ \t]*$") - (if org-empty-line-terminates-plain-lists - (progn - (goto-char pos) - (error "Cannot move this item further up")) - nil) - (if (<= (setq ind1 (org-get-indentation)) ind) - (throw 'exit t))))) - (condition-case nil - (org-beginning-of-item) - (error (goto-char beg) - (error "Cannot move this item further up"))) - (setq ind1 (org-get-indentation)) - (if (and (org-at-item-p) (= ind ind1)) - (progn - (setq ne-ins (org-back-over-empty-lines)) - (setq txt (buffer-substring beg end)) - (save-excursion - (delete-region beg end)) - (setq pos (point)) - (insert txt) - (setq ins-end (point)) - (goto-char pos) (org-skip-whitespace) - - (when (and (org-first-list-item-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))) - - (org-maybe-renumber-ordered-list)) - (goto-char pos) - (error "Cannot move this item further up")))) - -(defun org-maybe-renumber-ordered-list () - "Renumber the ordered list at point if setup allows it. -This tests the user option `org-auto-renumber-ordered-lists' before -doing the renumbering." - (interactive) - (when (and org-auto-renumber-ordered-lists - (org-at-item-p)) - (if (match-beginning 3) - (org-renumber-ordered-list 1) - (org-fix-bullet-type)))) - -(defun org-maybe-renumber-ordered-list-safe () - (condition-case nil - (save-excursion - (org-maybe-renumber-ordered-list)) - (error nil))) - -(defun org-cycle-list-bullet (&optional which) - "Cycle through the different itemize/enumerate bullets. -This cycle the entire list level through the sequence: - - `-' -> `+' -> `*' -> `1.' -> `1)' - -If WHICH is a string, use that as the new bullet. If WHICH is an integer, -0 meand `-', 1 means `+' etc." - (interactive "P") - (org-preserve-lc - (org-beginning-of-item-list) - (org-at-item-p) - (beginning-of-line 1) - (let ((current (match-string 0)) - (prevp (eq which 'previous)) - new) - (setq new (cond - ((and (numberp which) - (nth (1- which) '("-" "+" "*" "1." "1)")))) - ((string-match "-" current) (if prevp "1)" "+")) - ((string-match "\\+" current) - (if prevp "-" (if (looking-at "\\S-") "1." "*"))) - ((string-match "\\*" current) (if prevp "+" "1.")) - ((string-match "\\." current) (if prevp "*" "1)")) - ((string-match ")" current) (if prevp "1." "-")) - (t (error "This should not happen")))) - (and (looking-at "\\([ \t]*\\)\\S-+") (replace-match (concat "\\1" new))) - (org-fix-bullet-type) - (org-maybe-renumber-ordered-list)))) - -(defun org-get-string-indentation (s) - "What indentation has S due to SPACE and TAB at the beginning of the string?" - (let ((n -1) (i 0) (w tab-width) c) - (catch 'exit - (while (< (setq n (1+ n)) (length s)) - (setq c (aref s n)) - (cond ((= c ?\ ) (setq i (1+ i))) - ((= c ?\t) (setq i (* (/ (+ w i) w) w))) - (t (throw 'exit t))))) - i)) - -(defun org-renumber-ordered-list (arg) - "Renumber an ordered plain list. -Cursor needs to be in the first line of an item, the line that starts -with something like \"1.\" or \"2)\"." - (interactive "p") - (unless (and (org-at-item-p) - (match-beginning 3)) - (error "This is not an ordered list")) - (let ((line (org-current-line)) - (col (current-column)) - (ind (org-get-string-indentation - (buffer-substring (point-at-bol) (match-beginning 3)))) - ;; (term (substring (match-string 3) -1)) - ind1 (n (1- arg)) - fmt) - ;; find where this list begins - (org-beginning-of-item-list) - (looking-at "[ \t]*[0-9]+\\([.)]\\)") - (setq fmt (concat "%d" (match-string 1))) - (beginning-of-line 0) - ;; walk forward and replace these numbers - (catch 'exit - (while t - (catch 'next - (beginning-of-line 2) - (if (eobp) (throw 'exit nil)) - (if (looking-at "[ \t]*$") (throw 'next nil)) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (if (> ind1 ind) (throw 'next t)) - (if (< ind1 ind) (throw 'exit t)) - (if (not (org-at-item-p)) (throw 'exit nil)) - (delete-region (match-beginning 2) (match-end 2)) - (goto-char (match-beginning 2)) - (insert (format fmt (setq n (1+ n))))))) - (goto-line line) - (move-to-column col))) - -(defun org-fix-bullet-type () - "Make sure all items in this list have the same bullet as the firsst item." - (interactive) - (unless (org-at-item-p) (error "This is not a list")) - (let ((line (org-current-line)) - (col (current-column)) - (ind (current-indentation)) - ind1 bullet) - ;; find where this list begins - (org-beginning-of-item-list) - (beginning-of-line 1) - ;; find out what the bullet type is - (looking-at "[ \t]*\\(\\S-+\\)") - (setq bullet (match-string 1)) - ;; walk forward and replace these numbers - (beginning-of-line 0) - (catch 'exit - (while t - (catch 'next - (beginning-of-line 2) - (if (eobp) (throw 'exit nil)) - (if (looking-at "[ \t]*$") (throw 'next nil)) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (if (> ind1 ind) (throw 'next t)) - (if (< ind1 ind) (throw 'exit t)) - (if (not (org-at-item-p)) (throw 'exit nil)) - (skip-chars-forward " \t") - (looking-at "\\S-+") - (replace-match bullet)))) - (goto-line line) - (move-to-column col) - (if (string-match "[0-9]" bullet) - (org-renumber-ordered-list 1)))) - -(defun org-beginning-of-item-list () - "Go to the beginning of the current item list. -I.e. to the first item in this list." - (interactive) - (org-beginning-of-item) - (let ((pos (point-at-bol)) - (ind (org-get-indentation)) - ind1) - ;; find where this list begins - (catch 'exit - (while t - (catch 'next - (beginning-of-line 0) - (if (looking-at "[ \t]*$") - (throw (if (bobp) 'exit 'next) t)) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (if (or (< ind1 ind) - (and (= ind1 ind) - (not (org-at-item-p))) - (bobp)) - (throw 'exit t) - (when (org-at-item-p) (setq pos (point-at-bol))))))) - (goto-char pos))) - - -(defun org-end-of-item-list () - "Go to the end of the current item list. -I.e. to the text after the last item." - (interactive) - (org-beginning-of-item) - (let ((pos (point-at-bol)) - (ind (org-get-indentation)) - ind1) - ;; find where this list begins - (catch 'exit - (while t - (catch 'next - (beginning-of-line 2) - (if (looking-at "[ \t]*$") - (throw (if (eobp) 'exit 'next) t)) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (if (or (< ind1 ind) - (and (= ind1 ind) - (not (org-at-item-p))) - (eobp)) - (progn - (setq pos (point-at-bol)) - (throw 'exit t)))))) - (goto-char pos))) - - -(defvar org-last-indent-begin-marker (make-marker)) -(defvar org-last-indent-end-marker (make-marker)) - -(defun org-outdent-item (arg) - "Outdent a local list item." - (interactive "p") - (org-indent-item (- arg))) - -(defun org-indent-item (arg) - "Indent a local list item." - (interactive "p") - (unless (org-at-item-p) - (error "Not on an item")) - (save-excursion - (let (beg end ind ind1 tmp delta ind-down ind-up) - (if (memq last-command '(org-shiftmetaright org-shiftmetaleft)) - (setq beg org-last-indent-begin-marker - end org-last-indent-end-marker) - (org-beginning-of-item) - (setq beg (move-marker org-last-indent-begin-marker (point))) - (org-end-of-item) - (setq end (move-marker org-last-indent-end-marker (point)))) - (goto-char beg) - (setq tmp (org-item-indent-positions) - ind (car tmp) - ind-down (nth 2 tmp) - ind-up (nth 1 tmp) - delta (if (> arg 0) - (if ind-down (- ind-down ind) 2) - (if ind-up (- ind-up ind) -2))) - (if (< (+ delta ind) 0) (error "Cannot outdent beyond margin")) - (while (< (point) end) - (beginning-of-line 1) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (delete-region (point-at-bol) (point)) - (or (eolp) (indent-to-column (+ ind1 delta))) - (beginning-of-line 2)))) - (org-fix-bullet-type) - (org-maybe-renumber-ordered-list-safe) - (save-excursion - (beginning-of-line 0) - (condition-case nil (org-beginning-of-item) (error nil)) - (org-maybe-renumber-ordered-list-safe))) - -(defun org-item-indent-positions () - "Return indentation for plain list items. -This returns a list with three values: The current indentation, the -parent indentation and the indentation a child should habe. -Assumes cursor in item line." - (let* ((bolpos (point-at-bol)) - (ind (org-get-indentation)) - ind-down ind-up pos) - (save-excursion - (org-beginning-of-item-list) - (skip-chars-backward "\n\r \t") - (when (org-in-item-p) - (org-beginning-of-item) - (setq ind-up (org-get-indentation)))) - (setq pos (point)) - (save-excursion - (cond - ((and (condition-case nil (progn (org-previous-item) t) - (error nil)) - (or (forward-char 1) t) - (re-search-forward "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)" bolpos t)) - (setq ind-down (org-get-indentation))) - ((and (goto-char pos) - (org-at-item-p)) - (goto-char (match-end 0)) - (skip-chars-forward " \t") - (setq ind-down (current-column))))) - (list ind ind-up ind-down))) - -;;; 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. - -;; Another challenge is that the key binding for TAB can be tab or \C-i, -;; likewise the binding for RET can be return or \C-m. Orgtbl-mode -;; addresses this by checking explicitly for both bindings. - -(defvar orgstruct-mode-map (make-sparse-keymap) - "Keymap for the minor `orgstruct-mode'.") - -(defvar org-local-vars nil - "List of local variables, for use by `orgstruct-mode'") - -;;;###autoload -(define-minor-mode orgstruct-mode - "Toggle the minor more `orgstruct-mode'. -This mode is for using Org-mode structure commands in other modes. -The following key behave as if Org-mode was active, if the cursor -is on a headline, or on a plain list item (both in the definition -of Org-mode). - -M-up Move entry/item up -M-down Move entry/item down -M-left Promote -M-right Demote -M-S-up Move entry/item up -M-S-down Move entry/item down -M-S-left Promote subtree -M-S-right Demote subtree -M-q Fill paragraph and items like in Org-mode -C-c ^ Sort entries -C-c - Cycle list bullet -TAB Cycle item visibility -M-RET Insert new heading/item -S-M-RET Insert new TODO heading / Chekbox item -C-c C-c Set tags / toggle checkbox" - nil " OrgStruct" nil - (and (orgstruct-setup) (defun orgstruct-setup () nil))) - -;;;###autoload -(defun turn-on-orgstruct () - "Unconditionally turn on `orgstruct-mode'." - (orgstruct-mode 1)) - -;;;###autoload -(defun turn-on-orgstruct++ () - "Unconditionally turn on `orgstruct-mode', and force org-mode indentations. -In addition to setting orgstruct-mode, this also exports all indentation and -autofilling variables from org-mode into the buffer. Note that turning -off orgstruct-mode will *not* remove these additonal settings." - (orgstruct-mode 1) - (let (var val) - (mapc - (lambda (x) - (when (string-match - "^\\(paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)" - (symbol-name (car x))) - (setq var (car x) val (nth 1 x)) - (org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val)))) - org-local-vars))) - -(defun orgstruct-error () - "Error when there is no default binding for a structure key." - (interactive) - (error "This key has no function outside structure elements")) - -(defun orgstruct-setup () - "Setup orgstruct keymaps." - (let ((nfunc 0) - (bindings - (list - '([(meta up)] org-metaup) - '([(meta down)] org-metadown) - '([(meta left)] org-metaleft) - '([(meta right)] org-metaright) - '([(meta shift up)] org-shiftmetaup) - '([(meta shift down)] org-shiftmetadown) - '([(meta shift left)] org-shiftmetaleft) - '([(meta shift right)] org-shiftmetaright) - '([(shift up)] org-shiftup) - '([(shift down)] org-shiftdown) - '("\C-c\C-c" org-ctrl-c-ctrl-c) - '("\M-q" fill-paragraph) - '("\C-c^" org-sort) - '("\C-c-" org-cycle-list-bullet))) - elt key fun cmd) - (while (setq elt (pop bindings)) - (setq nfunc (1+ nfunc)) - (setq key (org-key (car elt)) - fun (nth 1 elt) - cmd (orgstruct-make-binding fun nfunc key)) - (org-defkey orgstruct-mode-map key cmd)) - - ;; Special treatment needed for TAB and RET - (org-defkey orgstruct-mode-map [(tab)] - (orgstruct-make-binding 'org-cycle 102 [(tab)] "\C-i")) - (org-defkey orgstruct-mode-map "\C-i" - (orgstruct-make-binding 'org-cycle 103 "\C-i" [(tab)])) - - (org-defkey orgstruct-mode-map "\M-\C-m" - (orgstruct-make-binding 'org-insert-heading 105 - "\M-\C-m" [(meta return)])) - (org-defkey orgstruct-mode-map [(meta return)] - (orgstruct-make-binding 'org-insert-heading 106 - [(meta return)] "\M-\C-m")) - - (org-defkey orgstruct-mode-map [(shift meta return)] - (orgstruct-make-binding 'org-insert-todo-heading 107 - [(meta return)] "\M-\C-m")) - - (unless org-local-vars - (setq org-local-vars (org-get-local-variables))) - - t)) - -(defun orgstruct-make-binding (fun n &rest keys) - "Create a function for binding in the structure minor mode. -FUN is the command to call inside a table. N is used to create a unique -command name. KEYS are keys that should be checked in for a command -to execute outside of tables." - (eval - (list 'defun - (intern (concat "orgstruct-hijacker-command-" (int-to-string n))) - '(arg) - (concat "In Structure, run `" (symbol-name fun) "'.\n" - "Outside of structure, run the binding of `" - (mapconcat (lambda (x) (format "%s" x)) keys "' or `") - "'.") - '(interactive "p") - (list 'if - '(org-context-p 'headline 'item) - (list 'org-run-like-in-org-mode (list 'quote fun)) - (list 'let '(orgstruct-mode) - (list 'call-interactively - (append '(or) - (mapcar (lambda (k) - (list 'key-binding k)) - keys) - '('orgstruct-error)))))))) - -(defun org-context-p (&rest contexts) - "Check if local context is and 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 "\\*+")) - (and (memq 'item contexts) - (looking-at "[ \t]*\\([-+*] \\|[0-9]+[.)] \\)"))) - (goto-char pos)))) - -(defun org-get-local-variables () - "Return a list of all local variables in an org-mode buffer." - (let (varlist) - (with-current-buffer (get-buffer-create "*Org tmp*") - (erase-buffer) - (org-mode) - (setq varlist (buffer-local-variables))) - (kill-buffer "*Org tmp*") - (delq nil - (mapcar - (lambda (x) - (setq x - (if (symbolp x) - (list x) - (list (car x) (list 'quote (cdr x))))) - (if (string-match - "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)" - (symbol-name (car x))) - x nil)) - varlist)))) - -;;;###autoload -(defun org-run-like-in-org-mode (cmd) - (unless org-local-vars - (setq org-local-vars (org-get-local-variables))) - (eval (list 'let org-local-vars - (list 'call-interactively (list 'quote cmd))))) - -;;;; Archiving - -(defalias 'org-advertized-archive-subtree 'org-archive-subtree) - -(defun org-archive-subtree (&optional find-done) - "Move the current subtree to the archive. -The archive can be a certain top-level heading in the current file, or in -a different file. The tree will be moved to that location, the subtree -heading be marked DONE, and the current time will be added. - -When called with prefix argument FIND-DONE, find whole trees without any -open TODO items and archive them (after getting confirmation from the user). -If the cursor is not at a headline when this comand is called, try all level -1 trees. If the cursor is on a headline, only try the direct children of -this heading." - (interactive "P") - (if find-done - (org-archive-all-done) - ;; Save all relevant TODO keyword-relatex variables - - (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler - (tr-org-todo-keywords-1 org-todo-keywords-1) - (tr-org-todo-kwd-alist org-todo-kwd-alist) - (tr-org-done-keywords org-done-keywords) - (tr-org-todo-regexp org-todo-regexp) - (tr-org-todo-line-regexp org-todo-line-regexp) - (tr-org-odd-levels-only org-odd-levels-only) - (this-buffer (current-buffer)) - (org-archive-location org-archive-location) - (re "^#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$") - ;; start of variables that will be used for saving context - ;; The compiler complains about them - keep them anyway! - (file (abbreviate-file-name (buffer-file-name))) - (time (format-time-string - (substring (cdr org-time-stamp-formats) 1 -1) - (current-time))) - afile heading buffer level newfile-p - category todo priority - ;; start of variables that will be used for savind context - ltags itags prop) - - ;; Try to find a local archive location - (save-excursion - (save-restriction - (widen) - (setq prop (org-entry-get nil "ARCHIVE" 'inherit)) - (if (and prop (string-match "\\S-" prop)) - (setq org-archive-location prop) - (if (or (re-search-backward re nil t) - (re-search-forward re nil t)) - (setq org-archive-location (match-string 1)))))) - - (if (string-match "\\(.*\\)::\\(.*\\)" org-archive-location) - (progn - (setq afile (format (match-string 1 org-archive-location) - (file-name-nondirectory buffer-file-name)) - heading (match-string 2 org-archive-location))) - (error "Invalid `org-archive-location'")) - (if (> (length afile) 0) - (setq newfile-p (not (file-exists-p afile)) - buffer (find-file-noselect afile)) - (setq buffer (current-buffer))) - (unless buffer - (error "Cannot access file \"%s\"" afile)) - (if (and (> (length heading) 0) - (string-match "^\\*+" heading)) - (setq level (match-end 0)) - (setq heading nil level 0)) - (save-excursion - (org-back-to-heading t) - ;; Get context information that will be lost by moving the tree - (org-refresh-category-properties) - (setq category (org-get-category) - todo (and (looking-at org-todo-line-regexp) - (match-string 2)) - priority (org-get-priority (if (match-end 3) (match-string 3) "")) - ltags (org-get-tags) - itags (org-delete-all ltags (org-get-tags-at))) - (setq ltags (mapconcat 'identity ltags " ") - itags (mapconcat 'identity itags " ")) - ;; We first only copy, in case something goes wrong - ;; we need to protect this-command, to avoid kill-region sets it, - ;; which would lead to duplication of subtrees - (let (this-command) (org-copy-subtree)) - (set-buffer buffer) - ;; Enforce org-mode for the archive buffer - (if (not (org-mode-p)) - ;; Force the mode for future visits. - (let ((org-insert-mode-line-in-empty-file t) - (org-inhibit-startup t)) - (call-interactively 'org-mode))) - (when newfile-p - (goto-char (point-max)) - (insert (format "\nArchived entries from file %s\n\n" - (buffer-file-name this-buffer)))) - ;; Force the TODO keywords of the original buffer - (let ((org-todo-line-regexp tr-org-todo-line-regexp) - (org-todo-keywords-1 tr-org-todo-keywords-1) - (org-todo-kwd-alist tr-org-todo-kwd-alist) - (org-done-keywords tr-org-done-keywords) - (org-todo-regexp tr-org-todo-regexp) - (org-todo-line-regexp tr-org-todo-line-regexp) - (org-odd-levels-only - (if (local-variable-p 'org-odd-levels-only (current-buffer)) - org-odd-levels-only - tr-org-odd-levels-only))) - (goto-char (point-min)) - (if heading - (progn - (if (re-search-forward - (concat "^" (regexp-quote heading) - (org-re "[ \t]*\\(:[[:alnum:]_@:]+:\\)?[ \t]*\\($\\|\r\\)")) - nil t) - (goto-char (match-end 0)) - ;; Heading not found, just insert it at the end - (goto-char (point-max)) - (or (bolp) (insert "\n")) - (insert "\n" heading "\n") - (end-of-line 0)) - ;; Make the subtree visible - (show-subtree) - (org-end-of-subtree t) - (skip-chars-backward " \t\r\n") - (and (looking-at "[ \t\r\n]*") - (replace-match "\n\n"))) - ;; No specific heading, just go to end of file. - (goto-char (point-max)) (insert "\n")) - ;; Paste - (org-paste-subtree (org-get-legal-level level 1)) - - ;; Mark the entry as done - (when (and org-archive-mark-done - (looking-at org-todo-line-regexp) - (or (not (match-end 2)) - (not (member (match-string 2) org-done-keywords)))) - (let (org-log-done) - (org-todo - (car (or (member org-archive-mark-done org-done-keywords) - org-done-keywords))))) - - ;; Add the context info - (when org-archive-save-context-info - (let ((l org-archive-save-context-info) e n v) - (while (setq e (pop l)) - (when (and (setq v (symbol-value e)) - (stringp v) (string-match "\\S-" v)) - (setq n (concat "ARCHIVE_" (upcase (symbol-name e)))) - (org-entry-put (point) n v))))) - - ;; Save the buffer, if it is not the same buffer. - (if (not (eq this-buffer buffer)) (save-buffer)))) - ;; Here we are back in the original buffer. Everything seems to have - ;; worked. So now cut the tree and finish up. - (let (this-command) (org-cut-subtree)) - (if (and (not (eobp)) (looking-at "[ \t]*$")) (kill-line)) - (message "Subtree archived %s" - (if (eq this-buffer buffer) - (concat "under heading: " heading) - (concat "in file: " (abbreviate-file-name afile))))))) - -(defun org-refresh-category-properties () - "Refresh category text properties in teh buffer." - (let ((def-cat (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))) - beg end cat pos optionp) - (org-unmodified - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (put-text-property (point) (point-max) 'org-category def-cat) - (while (re-search-forward - "^\\(#\\+CATEGORY:\\|[ \t]*:CATEGORY:\\)\\(.*\\)" nil t) - (setq pos (match-end 0) - optionp (equal (char-after (match-beginning 0)) ?#) - cat (org-trim (match-string 2))) - (if optionp - (setq beg (point-at-bol) end (point-max)) - (org-back-to-heading t) - (setq beg (point) end (org-end-of-subtree t t))) - (put-text-property beg end 'org-category cat) - (goto-char pos))))))) - -(defun org-archive-all-done (&optional tag) - "Archive sublevels of the current tree without open TODO items. -If the cursor is not on a headline, try all level 1 trees. If -it is on a headline, try all direct children. -When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag." - (let ((re (concat "^\\*+ +" org-not-done-regexp)) re1 - (rea (concat ".*:" org-archive-tag ":")) - (begm (make-marker)) - (endm (make-marker)) - (question (if tag "Set ARCHIVE tag (no open TODO items)? " - "Move subtree to archive (no open TODO items)? ")) - beg end (cntarch 0)) - (if (org-on-heading-p) - (progn - (setq re1 (concat "^" (regexp-quote - (make-string - (1+ (- (match-end 0) (match-beginning 0))) - ?*)) - " ")) - (move-marker begm (point)) - (move-marker endm (org-end-of-subtree t))) - (setq re1 "^* ") - (move-marker begm (point-min)) - (move-marker endm (point-max))) - (save-excursion - (goto-char begm) - (while (re-search-forward re1 endm t) - (setq beg (match-beginning 0) - end (save-excursion (org-end-of-subtree t) (point))) - (goto-char beg) - (if (re-search-forward re end t) - (goto-char end) - (goto-char beg) - (if (and (or (not tag) (not (looking-at rea))) - (y-or-n-p question)) - (progn - (if tag - (org-toggle-tag org-archive-tag 'on) - (org-archive-subtree)) - (setq cntarch (1+ cntarch))) - (goto-char end))))) - (message "%d trees archived" cntarch))) - -(defun org-cycle-hide-drawers (state) - "Re-hide all drawers after a visibility state change." - (when (and (org-mode-p) - (not (memq state '(overview folded)))) - (save-excursion - (let* ((globalp (memq state '(contents all))) - (beg (if globalp (point-min) (point))) - (end (if globalp (point-max) (org-end-of-subtree t)))) - (goto-char beg) - (while (re-search-forward org-drawer-regexp end t) - (org-flag-drawer t)))))) - -(defun org-flag-drawer (flag) - (save-excursion - (beginning-of-line 1) - (when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:") - (let ((b (match-end 0))) - (if (re-search-forward - "^[ \t]*:END:" - (save-excursion (outline-next-heading) (point)) t) - (outline-flag-region b (point-at-eol) flag) - (error ":END: line missing")))))) - -(defun org-cycle-hide-archived-subtrees (state) - "Re-hide all archived subtrees after a visibility state change." - (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) - (if (looking-at (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." - (save-excursion - (let* ((re (concat ":" org-archive-tag ":"))) - (goto-char beg) - (while (re-search-forward re end t) - (and (org-on-heading-p) (hide-subtree)) - (org-end-of-subtree t))))) - -(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." - (unless (org-on-heading-p t) (error "Not on headling")) - (let (res current) - (save-excursion - (beginning-of-line) - (if (re-search-forward (org-re "[ \t]:\\([[:alnum:]_@:]+\\):[ \t]*$") - (point-at-eol) t) - (progn - (setq current (match-string 1)) - (replace-match "")) - (setq current "")) - (setq current (nreverse (org-split-string current ":"))) - (cond - ((eq onoff 'on) - (setq res t) - (or (member tag current) (push tag current))) - ((eq onoff 'off) - (or (not (member tag current)) (setq current (delete tag current)))) - (t (if (member tag current) - (setq current (delete tag current)) - (setq res t) - (push tag current)))) - (end-of-line 1) - (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-toggle-archive-tag (&optional arg) - "Toggle the archive tag for the current headline. -With prefix ARG, check all children of current headline and offer tagging -the children that do not contain any open TODO items." - (interactive "P") - (if arg - (org-archive-all-done 'tag) - (let (set) - (save-excursion - (org-back-to-heading t) - (setq set (org-toggle-tag org-archive-tag)) - (when set (hide-subtree))) - (and set (beginning-of-line 1)) - (message "Subtree %s" (if set "archived" "unarchived"))))) - - -;;;; Tables - -;;; The table editor - -;; Watch out: Here we are talking about two different kind of tables. -;; Most of the code is for the tables created with the Org-mode table editor. -;; Sometimes, we talk about tables created and edited with the table.el -;; Emacs package. We call the former org-type tables, and the latter -;; table.el-type tables. - -(defun org-before-change-function (beg end) - "Every change indicates that a table might need an update." - (setq org-table-may-need-update t)) - -(defconst org-table-line-regexp "^[ \t]*|" - "Detects an org-type table line.") -(defconst org-table-dataline-regexp "^[ \t]*|[^-]" - "Detects an org-type table line.") -(defconst org-table-auto-recalculate-regexp "^[ \t]*| *# *\\(|\\|$\\)" - "Detects a table line marked for automatic recalculation.") -(defconst org-table-recalculate-regexp "^[ \t]*| *[#*] *\\(|\\|$\\)" - "Detects a table line marked for automatic recalculation.") -(defconst org-table-calculate-mark-regexp "^[ \t]*| *[!$^_#*] *\\(|\\|$\\)" - "Detects a table line marked for automatic recalculation.") -(defconst org-table-hline-regexp "^[ \t]*|-" - "Detects an org-type table hline.") -(defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]" - "Detects a table-type table hline.") -(defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)" - "Detects an org-type or table-type table.") -(defconst org-table-border-regexp "^[ \t]*[^| \t]" - "Searching from within a table (any type) this finds the first line -outside the table.") -(defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]" - "Searching from within a table (any type) this finds the first line -outside the table.") - -(defvar org-table-last-highlighted-reference nil) -(defvar org-table-formula-history nil) - -(defvar org-table-column-names nil - "Alist with column names, derived from the `!' line.") -(defvar org-table-column-name-regexp nil - "Regular expression matching the current column names.") -(defvar org-table-local-parameters nil - "Alist with parameter names, derived from the `$' line.") -(defvar org-table-named-field-locations nil - "Alist with locations of named fields.") - -(defvar org-table-current-line-types nil - "Table row types, non-nil only for the duration of a comand.") -(defvar org-table-current-begin-line nil - "Table begin line, non-nil only for the duration of a comand.") -(defvar org-table-current-begin-pos nil - "Table begin position, non-nil only for the duration of a comand.") -(defvar org-table-dlines nil - "Vector of data line line numbers in the current table.") -(defvar org-table-hlines nil - "Vector of hline line numbers in the current table.") - -(defconst org-table-range-regexp - "@\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\(\\.\\.@?\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\)?" - ;; 1 2 3 4 5 - "Regular expression for matching ranges in formulas.") - -(defconst org-table-range-regexp2 - (concat - "\\(" "@[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)" - "\\.\\." - "\\(" "@?[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)") - "Match a range for reference display.") - -(defconst org-table-translate-regexp - (concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)") - "Match a reference that needs translation, for reference display.") - -(defvar org-inhibit-highlight-removal nil) ; dynamically scoped param - -(defun org-table-create-with-table.el () - "Use the table.el package to insert a new table. -If there is already a table at point, convert between Org-mode tables -and table.el tables." - (interactive) - (require 'table) - (cond - ((org-at-table.el-p) - (if (y-or-n-p "Convert table to Org-mode table? ") - (org-table-convert))) - ((org-at-table-p) - (if (y-or-n-p "Convert table to table.el table? ") - (org-table-convert))) - (t (call-interactively 'table-insert)))) - -(defun org-table-create-or-convert-from-region (arg) - "Convert region to table, or create an empty table. -If there is an active region, convert it to a table, using the function -`org-table-convert-region'. See the documentation of that function -to learn how the prefix argument is interpreted to determine the field -separator. -If there is no such region, create an empty table with `org-table-create'." - (interactive "P") - (if (org-region-active-p) - (org-table-convert-region (region-beginning) (region-end) arg) - (org-table-create arg))) - -(defun org-table-create (&optional size) - "Query for a size and insert a table skeleton. -SIZE is a string Columns x Rows like for example \"3x2\"." - (interactive "P") - (unless size - (setq size (read-string - (concat "Table size Columns x Rows [e.g. " - org-table-default-size "]: ") - "" nil org-table-default-size))) - - (let* ((pos (point)) - (indent (make-string (current-column) ?\ )) - (split (org-split-string size " *x *")) - (rows (string-to-number (nth 1 split))) - (columns (string-to-number (car split))) - (line (concat (apply 'concat indent "|" (make-list columns " |")) - "\n"))) - (if (string-match "^[ \t]*$" (buffer-substring-no-properties - (point-at-bol) (point))) - (beginning-of-line 1) - (newline)) - ;; (mapcar (lambda (x) (insert line)) (make-list rows t)) - (dotimes (i rows) (insert line)) - (goto-char pos) - (if (> rows 1) - ;; Insert a hline after the first row. - (progn - (end-of-line 1) - (insert "\n|-") - (goto-char pos))) - (org-table-align))) - -(defun org-table-convert-region (beg0 end0 &optional separator) - "Convert region to a table. -The region goes from BEG0 to END0, but these borders will be moved -slightly, to make sure a beginning of line in the first line is included. - -SEPARATOR specifies the field separator in the lines. It can have the -following values: - -'(4) Use the comma as a field separator -'(16) Use a TAB as field separator -integer When a number, use that many spaces as field separator -nil When nil, the command tries to be smart and figure out the - separator in the following way: - - when each line contains a TAB, assume TAB-separated material - - when each line contains a comme, assume CSV material - - else, assume one or more SPACE charcters as separator." - (interactive "rP") - (let* ((beg (min beg0 end0)) - (end (max beg0 end0)) - re) - (goto-char beg) - (beginning-of-line 1) - (setq beg (move-marker (make-marker) (point))) - (goto-char end) - (if (bolp) (backward-char 1) (end-of-line 1)) - (setq end (move-marker (make-marker) (point))) - ;; Get the right field separator - (unless separator - (goto-char beg) - (setq separator - (cond - ((not (re-search-forward "^[^\n\t]+$" end t)) '(16)) - ((not (re-search-forward "^[^\n,]+$" end t)) '(4)) - (t 1)))) - (setq re (cond - ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?") - ((equal separator '(16)) "^\\|\t") - ((integerp separator) - (format "^ *\\| *\t *\\| \\{%d,\\}" separator)) - (t (error "This should not happen")))) - (goto-char beg) - (while (re-search-forward re end t) - (replace-match "| " t t)) - (goto-char beg) - (insert " ") - (org-table-align))) - -(defun org-table-import (file arg) - "Import FILE as a table. -The file is assumed to be tab-separated. Such files can be produced by most -spreadsheet and database applications. If no tabs (at least one per line) -are found, lines will be split on whitespace into fields." - (interactive "f\nP") - (or (bolp) (newline)) - (let ((beg (point)) - (pm (point-max))) - (insert-file-contents file) - (org-table-convert-region beg (+ (point) (- (point-max) pm)) arg))) - -(defun org-table-export () - "Export table as a tab-separated file. -Such a file can be imported into a spreadsheet program like Excel." - (interactive) - (let* ((beg (org-table-begin)) - (end (org-table-end)) - (table (buffer-substring beg end)) - (file (read-file-name "Export table to: ")) - buf) - (unless (or (not (file-exists-p file)) - (y-or-n-p (format "Overwrite file %s? " file))) - (error "Abort")) - (with-current-buffer (find-file-noselect file) - (setq buf (current-buffer)) - (erase-buffer) - (fundamental-mode) - (insert table) - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*|[ \t]*" nil t) - (replace-match "" t t) - (end-of-line 1)) - (goto-char (point-min)) - (while (re-search-forward "[ \t]*|[ \t]*$" nil t) - (replace-match "" t t) - (goto-char (min (1+ (point)) (point-max)))) - (goto-char (point-min)) - (while (re-search-forward "^-[-+]*$" nil t) - (replace-match "") - (if (looking-at "\n") - (delete-char 1))) - (goto-char (point-min)) - (while (re-search-forward "[ \t]*|[ \t]*" nil t) - (replace-match "\t" t t)) - (save-buffer)) - (kill-buffer buf))) - -(defvar org-table-aligned-begin-marker (make-marker) - "Marker at the beginning of the table last aligned. -Used to check if cursor still is in that table, to minimize realignment.") -(defvar org-table-aligned-end-marker (make-marker) - "Marker at the end of the table last aligned. -Used to check if cursor still is in that table, to minimize realignment.") -(defvar org-table-last-alignment nil - "List of flags for flushright alignment, from the last re-alignment. -This is being used to correctly align a single field after TAB or RET.") -(defvar org-table-last-column-widths nil - "List of max width of fields in each column. -This is being used to correctly align a single field after TAB or RET.") -(defvar org-table-overlay-coordinates nil - "Overlay coordinates after each align of a table.") -(make-variable-buffer-local 'org-table-overlay-coordinates) - -(defvar org-last-recalc-line nil) -(defconst org-narrow-column-arrow "=>" - "Used as display property in narrowed table columns.") - -(defun org-table-align () - "Align the table at point by aligning all vertical bars." - (interactive) - (let* ( - ;; Limits of table - (beg (org-table-begin)) - (end (org-table-end)) - ;; Current cursor position - (linepos (org-current-line)) - (colpos (org-table-current-column)) - (winstart (window-start)) - (winstartline (org-current-line (min winstart (1- (point-max))))) - lines (new "") lengths l typenums ty fields maxfields i - column - (indent "") cnt frac - rfmt hfmt - (spaces '(1 . 1)) - (sp1 (car spaces)) - (sp2 (cdr spaces)) - (rfmt1 (concat - (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|")) - (hfmt1 (concat - (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+")) - emptystrings links dates emph narrow fmax f1 len c e) - (untabify beg end) - (remove-text-properties beg end '(org-cwidth t org-dwidth t display t)) - ;; Check if we have links or dates - (goto-char beg) - (setq links (re-search-forward org-bracket-link-regexp end t)) - (goto-char beg) - (setq emph (and org-hide-emphasis-markers - (re-search-forward org-emph-re end t))) - (goto-char beg) - (setq dates (and org-display-custom-times - (re-search-forward org-ts-regexp-both end t))) - ;; Make sure the link properties are right - (when links (goto-char beg) (while (org-activate-bracket-links end))) - ;; Make sure the date properties are right - (when dates (goto-char beg) (while (org-activate-dates end))) - (when emph (goto-char beg) (while (org-do-emphasis-faces end))) - - ;; Check if we are narrowing any columns - (goto-char beg) - (setq narrow (and org-format-transports-properties-p - (re-search-forward "<[0-9]+>" end t))) - ;; Get the rows - (setq lines (org-split-string - (buffer-substring beg end) "\n")) - ;; Store the indentation of the first line - (if (string-match "^ *" (car lines)) - (setq indent (make-string (- (match-end 0) (match-beginning 0)) ?\ ))) - ;; Mark the hlines by setting the corresponding element to nil - ;; At the same time, we remove trailing space. - (setq lines (mapcar (lambda (l) - (if (string-match "^ *|-" l) - nil - (if (string-match "[ \t]+$" l) - (substring l 0 (match-beginning 0)) - l))) - lines)) - ;; Get the data fields by splitting the lines. - (setq fields (mapcar - (lambda (l) - (org-split-string l " *| *")) - (delq nil (copy-sequence lines)))) - ;; How many fields in the longest line? - (condition-case nil - (setq maxfields (apply 'max (mapcar 'length fields))) - (error - (kill-region beg end) - (org-table-create org-table-default-size) - (error "Empty table - created default table"))) - ;; A list of empty strings to fill any short rows on output - (setq emptystrings (make-list maxfields "")) - ;; Check for special formatting. - (setq i -1) - (while (< (setq i (1+ i)) maxfields) ;; Loop over all columns - (setq column (mapcar (lambda (x) (or (nth i x) "")) fields)) - ;; Check if there is an explicit width specified - (when narrow - (setq c column fmax nil) - (while c - (setq e (pop c)) - (if (and (stringp e) (string-match "^<\\([0-9]+\\)>$" e)) - (setq fmax (string-to-number (match-string 1 e)) c nil))) - ;; Find fields that are wider than fmax, and shorten them - (when fmax - (loop for xx in column do - (when (and (stringp xx) - (> (org-string-width xx) fmax)) - (org-add-props xx nil - 'help-echo - (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (org-no-properties (copy-sequence xx)))) - (setq f1 (min fmax (or (string-match org-bracket-link-regexp xx) fmax))) - (unless (> f1 1) - (error "Cannot narrow field starting with wide link \"%s\"" - (match-string 0 xx))) - (add-text-properties f1 (length xx) (list 'org-cwidth t) xx) - (add-text-properties (- f1 2) f1 - (list 'display org-narrow-column-arrow) - xx))))) - ;; Get the maximum width for each column - (push (apply 'max 1 (mapcar 'org-string-width column)) lengths) - ;; Get the fraction of numbers, to decide about alignment of the column - (setq cnt 0 frac 0.0) - (loop for x in column do - (if (equal x "") - nil - (setq frac ( / (+ (* frac cnt) - (if (string-match org-table-number-regexp x) 1 0)) - (setq cnt (1+ cnt)))))) - (push (>= frac org-table-number-fraction) typenums)) - (setq lengths (nreverse lengths) typenums (nreverse typenums)) - - ;; Store the alignment of this table, for later editing of single fields - (setq org-table-last-alignment typenums - org-table-last-column-widths lengths) - - ;; With invisible characters, `format' does not get the field width right - ;; So we need to make these fields wide by hand. - (when (or links emph) - (loop for i from 0 upto (1- maxfields) do - (setq len (nth i lengths)) - (loop for j from 0 upto (1- (length fields)) do - (setq c (nthcdr i (car (nthcdr j fields)))) - (if (and (stringp (car c)) - (text-property-any 0 (length (car c)) 'invisible 'org-link (car c)) -; (string-match org-bracket-link-regexp (car c)) - (< (org-string-width (car c)) len)) - (setcar c (concat (car c) (make-string (- len (org-string-width (car c))) ?\ ))))))) - - ;; Compute the formats needed for output of the table - (setq rfmt (concat indent "|") hfmt (concat indent "|")) - (while (setq l (pop lengths)) - (setq ty (if (pop typenums) "" "-")) ; number types flushright - (setq rfmt (concat rfmt (format rfmt1 ty l)) - hfmt (concat hfmt (format hfmt1 (make-string l ?-))))) - (setq rfmt (concat rfmt "\n") - hfmt (concat (substring hfmt 0 -1) "|\n")) - - (setq new (mapconcat - (lambda (l) - (if l (apply 'format rfmt - (append (pop fields) emptystrings)) - hfmt)) - lines "")) - ;; Replace the old one - (delete-region beg end) - (move-marker end nil) - (move-marker org-table-aligned-begin-marker (point)) - (insert new) - (move-marker org-table-aligned-end-marker (point)) - (when (and orgtbl-mode (not (org-mode-p))) - (goto-char org-table-aligned-begin-marker) - (while (org-hide-wide-columns org-table-aligned-end-marker))) - ;; Try to move to the old location - (goto-line winstartline) - (setq winstart (point-at-bol)) - (goto-line linepos) - (set-window-start (selected-window) winstart 'noforce) - (org-table-goto-column colpos) - (and org-table-overlay-coordinates (org-table-overlay-coordinates)) - (setq org-table-may-need-update nil) - )) - -(defun org-string-width (s) - "Compute width of string, ignoring invisible characters. -This ignores character with invisibility property `org-link', and also -characters with property `org-cwidth', because these will become invisible -upon the next fontification round." - (let (b l) - (when (or (eq t buffer-invisibility-spec) - (assq 'org-link buffer-invisibility-spec)) - (while (setq b (text-property-any 0 (length s) - 'invisible 'org-link s)) - (setq s (concat (substring s 0 b) - (substring s (or (next-single-property-change - b 'invisible s) (length s))))))) - (while (setq b (text-property-any 0 (length s) 'org-cwidth t s)) - (setq s (concat (substring s 0 b) - (substring s (or (next-single-property-change - b 'org-cwidth s) (length s)))))) - (setq l (string-width s) b -1) - (while (setq b (text-property-any (1+ b) (length s) 'org-dwidth t s)) - (setq l (- l (get-text-property b 'org-dwidth-n s)))) - l)) - -(defun org-table-begin (&optional table-type) - "Find the beginning of the table and return its position. -With argument TABLE-TYPE, go to the beginning of a table.el-type table." - (save-excursion - (if (not (re-search-backward - (if table-type org-table-any-border-regexp - org-table-border-regexp) - nil t)) - (progn (goto-char (point-min)) (point)) - (goto-char (match-beginning 0)) - (beginning-of-line 2) - (point)))) - -(defun org-table-end (&optional table-type) - "Find the end of the table and return its position. -With argument TABLE-TYPE, go to the end of a table.el-type table." - (save-excursion - (if (not (re-search-forward - (if table-type org-table-any-border-regexp - org-table-border-regexp) - nil t)) - (goto-char (point-max)) - (goto-char (match-beginning 0))) - (point-marker))) - -(defun org-table-justify-field-maybe (&optional new) - "Justify the current field, text to left, number to right. -Optional argument NEW may specify text to replace the current field content." - (cond - ((and (not new) org-table-may-need-update)) ; Realignment will happen anyway - ((org-at-table-hline-p)) - ((and (not new) - (or (not (equal (marker-buffer org-table-aligned-begin-marker) - (current-buffer))) - (< (point) org-table-aligned-begin-marker) - (>= (point) org-table-aligned-end-marker))) - ;; This is not the same table, force a full re-align - (setq org-table-may-need-update t)) - (t ;; realign the current field, based on previous full realign - (let* ((pos (point)) s - (col (org-table-current-column)) - (num (if (> col 0) (nth (1- col) org-table-last-alignment))) - l f n o e) - (when (> col 0) - (skip-chars-backward "^|\n") - (if (looking-at " *\\([^|\n]*?\\) *\\(|\\|$\\)") - (progn - (setq s (match-string 1) - o (match-string 0) - l (max 1 (- (match-end 0) (match-beginning 0) 3)) - e (not (= (match-beginning 2) (match-end 2)))) - (setq f (format (if num " %%%ds %s" " %%-%ds %s") - l (if e "|" (setq org-table-may-need-update t) "")) - n (format f s)) - (if new - (if (<= (length new) l) ;; FIXME: length -> str-width? - (setq n (format f new)) - (setq n (concat new "|") org-table-may-need-update t))) - (or (equal n o) - (let (org-table-may-need-update) - (replace-match n t t)))) - (setq org-table-may-need-update t)) - (goto-char pos)))))) - -(defun org-table-next-field () - "Go to the next field in the current table, creating new lines as needed. -Before doing so, re-align the table if necessary." - (interactive) - (org-table-maybe-eval-formula) - (org-table-maybe-recalculate-line) - (if (and org-table-automatic-realign - org-table-may-need-update) - (org-table-align)) - (let ((end (org-table-end))) - (if (org-at-table-hline-p) - (end-of-line 1)) - (condition-case nil - (progn - (re-search-forward "|" end) - (if (looking-at "[ \t]*$") - (re-search-forward "|" end)) - (if (and (looking-at "-") - org-table-tab-jumps-over-hlines - (re-search-forward "^[ \t]*|\\([^-]\\)" end t)) - (goto-char (match-beginning 1))) - (if (looking-at "-") - (progn - (beginning-of-line 0) - (org-table-insert-row 'below)) - (if (looking-at " ") (forward-char 1)))) - (error - (org-table-insert-row 'below))))) - -(defun org-table-previous-field () - "Go to the previous field in the table. -Before doing so, re-align the table if necessary." - (interactive) - (org-table-justify-field-maybe) - (org-table-maybe-recalculate-line) - (if (and org-table-automatic-realign - org-table-may-need-update) - (org-table-align)) - (if (org-at-table-hline-p) - (end-of-line 1)) - (re-search-backward "|" (org-table-begin)) - (re-search-backward "|" (org-table-begin)) - (while (looking-at "|\\(-\\|[ \t]*$\\)") - (re-search-backward "|" (org-table-begin))) - (if (looking-at "| ?") - (goto-char (match-end 0)))) - -(defun org-table-next-row () - "Go to the next row (same column) in the current table. -Before doing so, re-align the table if necessary." - (interactive) - (org-table-maybe-eval-formula) - (org-table-maybe-recalculate-line) - (if (or (looking-at "[ \t]*$") - (save-excursion (skip-chars-backward " \t") (bolp))) - (newline) - (if (and org-table-automatic-realign - org-table-may-need-update) - (org-table-align)) - (let ((col (org-table-current-column))) - (beginning-of-line 2) - (if (or (not (org-at-table-p)) - (org-at-table-hline-p)) - (progn - (beginning-of-line 0) - (org-table-insert-row 'below))) - (org-table-goto-column col) - (skip-chars-backward "^|\n\r") - (if (looking-at " ") (forward-char 1))))) - -(defun org-table-copy-down (n) - "Copy a field down in the current column. -If the field at the cursor is empty, copy into it the content of the nearest -non-empty field above. With argument N, use the Nth non-empty field. -If the current field is not empty, it is copied down to the next row, and -the cursor is moved with it. Therefore, repeating this command causes the -column to be filled row-by-row. -If the variable `org-table-copy-increment' is non-nil and the field is an -integer or a timestamp, it will be incremented while copying. In the case of -a timestamp, if the cursor is on the year, change the year. If it is on the -month or the day, change that. Point will stay on the current date field -in order to easily repeat the interval." - (interactive "p") - (let* ((colpos (org-table-current-column)) - (col (current-column)) - (field (org-table-get-field)) - (non-empty (string-match "[^ \t]" field)) - (beg (org-table-begin)) - txt) - (org-table-check-inside-data-field) - (if non-empty - (progn - (setq txt (org-trim field)) - (org-table-next-row) - (org-table-blank-field)) - (save-excursion - (setq txt - (catch 'exit - (while (progn (beginning-of-line 1) - (re-search-backward org-table-dataline-regexp - beg t)) - (org-table-goto-column colpos t) - (if (and (looking-at - "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|") - (= (setq n (1- n)) 0)) - (throw 'exit (match-string 1)))))))) - (if txt - (progn - (if (and org-table-copy-increment - (string-match "^[0-9]+$" txt)) - (setq txt (format "%d" (+ (string-to-number txt) 1)))) - (insert txt) - (move-to-column col) - (if (and org-table-copy-increment (org-at-timestamp-p t)) - (org-timestamp-up 1) - (org-table-maybe-recalculate-line)) - (org-table-align) - (move-to-column col)) - (error "No non-empty field found")))) - -(defun org-table-check-inside-data-field () - "Is point inside a table data field? -I.e. not on a hline or before the first or after the last column? -This actually throws an error, so it aborts the current command." - (if (or (not (org-at-table-p)) - (= (org-table-current-column) 0) - (org-at-table-hline-p) - (looking-at "[ \t]*$")) - (error "Not in table data field"))) - -(defvar org-table-clip nil - "Clipboard for table regions.") - -(defun org-table-blank-field () - "Blank the current table field or active region." - (interactive) - (org-table-check-inside-data-field) - (if (and (interactive-p) (org-region-active-p)) - (let (org-table-clip) - (org-table-cut-region (region-beginning) (region-end))) - (skip-chars-backward "^|") - (backward-char 1) - (if (looking-at "|[^|\n]+") - (let* ((pos (match-beginning 0)) - (match (match-string 0)) - (len (org-string-width match))) - (replace-match (concat "|" (make-string (1- len) ?\ ))) - (goto-char (+ 2 pos)) - (substring match 1))))) - -(defun org-table-get-field (&optional n replace) - "Return the value of the field in column N of current row. -N defaults to current field. -If REPLACE is a string, replace field with this value. The return value -is always the old value." - (and n (org-table-goto-column n)) - (skip-chars-backward "^|\n") - (backward-char 1) - (if (looking-at "|[^|\r\n]*") - (let* ((pos (match-beginning 0)) - (val (buffer-substring (1+ pos) (match-end 0)))) - (if replace - (replace-match (concat "|" replace) t t)) - (goto-char (min (point-at-eol) (+ 2 pos))) - val) - (forward-char 1) "")) - -(defun org-table-field-info (arg) - "Show info about the current field, and highlight any reference at point." - (interactive "P") - (org-table-get-specials) - (save-excursion - (let* ((pos (point)) - (col (org-table-current-column)) - (cname (car (rassoc (int-to-string col) org-table-column-names))) - (name (car (rassoc (list (org-current-line) col) - org-table-named-field-locations))) - (eql (org-table-get-stored-formulas)) - (dline (org-table-current-dline)) - (ref (format "@%d$%d" dline col)) - (ref1 (org-table-convert-refs-to-an ref)) - (fequation (or (assoc name eql) (assoc ref eql))) - (cequation (assoc (int-to-string col) eql)) - (eqn (or fequation cequation))) - (goto-char pos) - (condition-case nil - (org-table-show-reference 'local) - (error nil)) - (message "line @%d, col $%s%s, ref @%d$%d or %s%s%s" - dline col - (if cname (concat " or $" cname) "") - dline col ref1 - (if name (concat " or $" name) "") - ;; FIXME: formula info not correct if special table line - (if eqn - (concat ", formula: " - (org-table-formula-to-user - (concat - (if (string-match "^[$@]"(car eqn)) "" "$") - (car eqn) "=" (cdr eqn)))) - ""))))) - -(defun org-table-current-column () - "Find out which column we are in. -When called interactively, column is also displayed in echo area." - (interactive) - (if (interactive-p) (org-table-check-inside-data-field)) - (save-excursion - (let ((cnt 0) (pos (point))) - (beginning-of-line 1) - (while (search-forward "|" pos t) - (setq cnt (1+ cnt))) - (if (interactive-p) (message "This is table column %d" cnt)) - cnt))) - -(defun org-table-current-dline () - "Find out what table data line we are in. -Only datalins count for this." - (interactive) - (if (interactive-p) (org-table-check-inside-data-field)) - (save-excursion - (let ((cnt 0) (pos (point))) - (goto-char (org-table-begin)) - (while (<= (point) pos) - (if (looking-at org-table-dataline-regexp) (setq cnt (1+ cnt))) - (beginning-of-line 2)) - (if (interactive-p) (message "This is table line %d" cnt)) - cnt))) - -(defun org-table-goto-column (n &optional on-delim force) - "Move the cursor to the Nth column in the current table line. -With optional argument ON-DELIM, stop with point before the left delimiter -of the field. -If there are less than N fields, just go to after the last delimiter. -However, when FORCE is non-nil, create new columns if necessary." - (interactive "p") - (let ((pos (point-at-eol))) - (beginning-of-line 1) - (when (> n 0) - (while (and (> (setq n (1- n)) -1) - (or (search-forward "|" pos t) - (and force - (progn (end-of-line 1) - (skip-chars-backward "^|") - (insert " | ")))))) -; (backward-char 2) t))))) - (when (and force (not (looking-at ".*|"))) - (save-excursion (end-of-line 1) (insert " | "))) - (if on-delim - (backward-char 1) - (if (looking-at " ") (forward-char 1)))))) - -(defun org-at-table-p (&optional table-type) - "Return t if the cursor is inside an org-type table. -If TABLE-TYPE is non-nil, also check for table.el-type tables." - (if org-enable-table-editor - (save-excursion - (beginning-of-line 1) - (looking-at (if table-type org-table-any-line-regexp - org-table-line-regexp))) - nil)) - -(defun org-at-table.el-p () - "Return t if and only if we are at a table.el table." - (and (org-at-table-p 'any) - (save-excursion - (goto-char (org-table-begin 'any)) - (looking-at org-table1-hline-regexp)))) - -(defun org-table-recognize-table.el () - "If there is a table.el table nearby, recognize it and move into it." - (if org-table-tab-recognizes-table.el - (if (org-at-table.el-p) - (progn - (beginning-of-line 1) - (if (looking-at org-table-dataline-regexp) - nil - (if (looking-at org-table1-hline-regexp) - (progn - (beginning-of-line 2) - (if (looking-at org-table-any-border-regexp) - (beginning-of-line -1))))) - (if (re-search-forward "|" (org-table-end t) t) - (progn - (require 'table) - (if (table--at-cell-p (point)) - t - (message "recognizing table.el table...") - (table-recognize-table) - (message "recognizing table.el table...done"))) - (error "This should not happen...")) - t) - nil) - nil)) - -(defun org-at-table-hline-p () - "Return t if the cursor is inside a hline in a table." - (if org-enable-table-editor - (save-excursion - (beginning-of-line 1) - (looking-at org-table-hline-regexp)) - nil)) - -(defun org-table-insert-column () - "Insert a new column into the table." - (interactive) - (if (not (org-at-table-p)) - (error "Not at a table")) - (org-table-find-dataline) - (let* ((col (max 1 (org-table-current-column))) - (beg (org-table-begin)) - (end (org-table-end)) - ;; Current cursor position - (linepos (org-current-line)) - (colpos col)) - (goto-char beg) - (while (< (point) end) - (if (org-at-table-hline-p) - nil - (org-table-goto-column col t) - (insert "| ")) - (beginning-of-line 2)) - (move-marker end nil) - (goto-line linepos) - (org-table-goto-column colpos) - (org-table-align) - (org-table-fix-formulas "$" nil (1- col) 1))) - -(defun org-table-find-dataline () - "Find a dataline in the current table, which is needed for column commands." - (if (and (org-at-table-p) - (not (org-at-table-hline-p))) - t - (let ((col (current-column)) - (end (org-table-end))) - (move-to-column col) - (while (and (< (point) end) - (or (not (= (current-column) col)) - (org-at-table-hline-p))) - (beginning-of-line 2) - (move-to-column col)) - (if (and (org-at-table-p) - (not (org-at-table-hline-p))) - t - (error - "Please position cursor in a data line for column operations"))))) - -(defun org-table-delete-column () - "Delete a column from the table." - (interactive) - (if (not (org-at-table-p)) - (error "Not at a table")) - (org-table-find-dataline) - (org-table-check-inside-data-field) - (let* ((col (org-table-current-column)) - (beg (org-table-begin)) - (end (org-table-end)) - ;; Current cursor position - (linepos (org-current-line)) - (colpos col)) - (goto-char beg) - (while (< (point) end) - (if (org-at-table-hline-p) - nil - (org-table-goto-column col t) - (and (looking-at "|[^|\n]+|") - (replace-match "|"))) - (beginning-of-line 2)) - (move-marker end nil) - (goto-line linepos) - (org-table-goto-column colpos) - (org-table-align) - (org-table-fix-formulas "$" (list (cons (number-to-string col) "INVALID")) - col -1 col))) - -(defun org-table-move-column-right () - "Move column to the right." - (interactive) - (org-table-move-column nil)) -(defun org-table-move-column-left () - "Move column to the left." - (interactive) - (org-table-move-column 'left)) - -(defun org-table-move-column (&optional left) - "Move the current column to the right. With arg LEFT, move to the left." - (interactive "P") - (if (not (org-at-table-p)) - (error "Not at a table")) - (org-table-find-dataline) - (org-table-check-inside-data-field) - (let* ((col (org-table-current-column)) - (col1 (if left (1- col) col)) - (beg (org-table-begin)) - (end (org-table-end)) - ;; Current cursor position - (linepos (org-current-line)) - (colpos (if left (1- col) (1+ col)))) - (if (and left (= col 1)) - (error "Cannot move column further left")) - (if (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) - (error "Cannot move column further right")) - (goto-char beg) - (while (< (point) end) - (if (org-at-table-hline-p) - nil - (org-table-goto-column col1 t) - (and (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|") - (replace-match "|\\2|\\1|"))) - (beginning-of-line 2)) - (move-marker end nil) - (goto-line linepos) - (org-table-goto-column colpos) - (org-table-align) - (org-table-fix-formulas - "$" (list (cons (number-to-string col) (number-to-string colpos)) - (cons (number-to-string colpos) (number-to-string col)))))) - -(defun org-table-move-row-down () - "Move table row down." - (interactive) - (org-table-move-row nil)) -(defun org-table-move-row-up () - "Move table row up." - (interactive) - (org-table-move-row 'up)) - -(defun org-table-move-row (&optional up) - "Move the current table line down. With arg UP, move it up." - (interactive "P") - (let* ((col (current-column)) - (pos (point)) - (hline1p (save-excursion (beginning-of-line 1) - (looking-at org-table-hline-regexp))) - (dline1 (org-table-current-dline)) - (dline2 (+ dline1 (if up -1 1))) - (tonew (if up 0 2)) - txt hline2p) - (beginning-of-line tonew) - (unless (org-at-table-p) - (goto-char pos) - (error "Cannot move row further")) - (setq hline2p (looking-at org-table-hline-regexp)) - (goto-char pos) - (beginning-of-line 1) - (setq pos (point)) - (setq txt (buffer-substring (point) (1+ (point-at-eol)))) - (delete-region (point) (1+ (point-at-eol))) - (beginning-of-line tonew) - (insert txt) - (beginning-of-line 0) - (move-to-column col) - (unless (or hline1p hline2p) - (org-table-fix-formulas - "@" (list (cons (number-to-string dline1) (number-to-string dline2)) - (cons (number-to-string dline2) (number-to-string dline1))))))) - -(defun org-table-insert-row (&optional arg) - "Insert a new row above the current line into the table. -With prefix ARG, insert below the current line." - (interactive "P") - (if (not (org-at-table-p)) - (error "Not at a table")) - (let* ((line (buffer-substring (point-at-bol) (point-at-eol))) - (new (org-table-clean-line line))) - ;; Fix the first field if necessary - (if (string-match "^[ \t]*| *[#$] *|" line) - (setq new (replace-match (match-string 0 line) t t new))) - (beginning-of-line (if arg 2 1)) - (let (org-table-may-need-update) (insert-before-markers new "\n")) - (beginning-of-line 0) - (re-search-forward "| ?" (point-at-eol) t) - (and (or org-table-may-need-update org-table-overlay-coordinates) - (org-table-align)) - (org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1))) - -(defun org-table-insert-hline (&optional above) - "Insert a horizontal-line below the current line into the table. -With prefix ABOVE, insert above the current line." - (interactive "P") - (if (not (org-at-table-p)) - (error "Not at a table")) - (let ((line (org-table-clean-line - (buffer-substring (point-at-bol) (point-at-eol)))) - (col (current-column))) - (while (string-match "|\\( +\\)|" line) - (setq line (replace-match - (concat "+" (make-string (- (match-end 1) (match-beginning 1)) - ?-) "|") t t line))) - (and (string-match "\\+" line) (setq line (replace-match "|" t t line))) - (beginning-of-line (if above 1 2)) - (insert line "\n") - (beginning-of-line (if above 1 -1)) - (move-to-column col) - (and org-table-overlay-coordinates (org-table-align)))) - -(defun org-table-hline-and-move (&optional same-column) - "Insert a hline and move to the row below that line." - (interactive "P") - (let ((col (org-table-current-column))) - (org-table-maybe-eval-formula) - (org-table-maybe-recalculate-line) - (org-table-insert-hline) - (end-of-line 2) - (if (looking-at "\n[ \t]*|-") - (progn (insert "\n|") (org-table-align)) - (org-table-next-field)) - (if same-column (org-table-goto-column col)))) - -(defun org-table-clean-line (s) - "Convert a table line S into a string with only \"|\" and space. -In particular, this does handle wide and invisible characters." - (if (string-match "^[ \t]*|-" s) - ;; It's a hline, just map the characters - (setq s (mapconcat (lambda (x) (if (member x '(?| ?+)) "|" " ")) s "")) - (while (string-match "|\\([ \t]*?[^ \t\r\n|][^\r\n|]*\\)|" s) - (setq s (replace-match - (concat "|" (make-string (org-string-width (match-string 1 s)) - ?\ ) "|") - t t s))) - s)) - -(defun org-table-kill-row () - "Delete the current row or horizontal line from the table." - (interactive) - (if (not (org-at-table-p)) - (error "Not at a table")) - (let ((col (current-column)) - (dline (org-table-current-dline))) - (kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))) - (if (not (org-at-table-p)) (beginning-of-line 0)) - (move-to-column col) - (org-table-fix-formulas "@" (list (cons (number-to-string dline) "INVALID")) - dline -1 dline))) - -(defun org-table-sort-lines (with-case &optional sorting-type) - "Sort table lines according to the column at point. - -The position of point indicates the column to be used for -sorting, and the range of lines is the range between the nearest -horizontal separator lines, or the entire table of no such lines -exist. If point is before the first column, you will be prompted -for the sorting column. If there is an active region, the mark -specifies the first line and the sorting column, while point -should be in the last line to be included into the sorting. - -The command then prompts for the sorting type which can be -alphabetically, numerically, or by time (as given in a time stamp -in the field). Sorting in reverse order is also possible. - -With prefix argument WITH-CASE, alphabetic sorting will be case-sensitive. - -If SORTING-TYPE is specified when this function is called from a Lisp -program, no prompting will take place. SORTING-TYPE must be a character, -any of (?a ?A ?n ?N ?t ?T) where the capital letter indicate that sorting -should be done in reverse order." - (interactive "P") - (let* ((thisline (org-current-line)) - (thiscol (org-table-current-column)) - beg end bcol ecol tend tbeg column lns pos) - (when (equal thiscol 0) - (if (interactive-p) - (setq thiscol - (string-to-number - (read-string "Use column N for sorting: "))) - (setq thiscol 1)) - (org-table-goto-column thiscol)) - (org-table-check-inside-data-field) - (if (org-region-active-p) - (progn - (setq beg (region-beginning) end (region-end)) - (goto-char beg) - (setq column (org-table-current-column) - beg (point-at-bol)) - (goto-char end) - (setq end (point-at-bol 2))) - (setq column (org-table-current-column) - pos (point) - tbeg (org-table-begin) - tend (org-table-end)) - (if (re-search-backward org-table-hline-regexp tbeg t) - (setq beg (point-at-bol 2)) - (goto-char tbeg) - (setq beg (point-at-bol 1))) - (goto-char pos) - (if (re-search-forward org-table-hline-regexp tend t) - (setq end (point-at-bol 1)) - (goto-char tend) - (setq end (point-at-bol)))) - (setq beg (move-marker (make-marker) beg) - end (move-marker (make-marker) end)) - (untabify beg end) - (goto-char beg) - (org-table-goto-column column) - (skip-chars-backward "^|") - (setq bcol (current-column)) - (org-table-goto-column (1+ column)) - (skip-chars-backward "^|") - (setq ecol (1- (current-column))) - (org-table-goto-column column) - (setq lns (mapcar (lambda(x) (cons - (org-sort-remove-invisible - (nth (1- column) - (org-split-string x "[ \t]*|[ \t]*"))) - x)) - (org-split-string (buffer-substring beg end) "\n"))) - (setq lns (org-do-sort lns "Table" with-case sorting-type)) - (delete-region beg end) - (move-marker beg nil) - (move-marker end nil) - (insert (mapconcat 'cdr lns "\n") "\n") - (goto-line thisline) - (org-table-goto-column thiscol) - (message "%d lines sorted, based on column %d" (length lns) column))) - -;; FIXME: maybe we will not need this? Table sorting is broken.... -(defun org-sort-remove-invisible (s) - (remove-text-properties 0 (length s) org-rm-props s) - (while (string-match org-bracket-link-regexp s) - (setq s (replace-match (if (match-end 2) - (match-string 3 s) - (match-string 1 s)) t t s))) - s) - -(defun org-table-cut-region (beg end) - "Copy region in table to the clipboard and blank all relevant fields." - (interactive "r") - (org-table-copy-region beg end 'cut)) - -(defun org-table-copy-region (beg end &optional cut) - "Copy rectangular region in table to clipboard. -A special clipboard is used which can only be accessed -with `org-table-paste-rectangle'." - (interactive "rP") - (let* (l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2 - region cols - (rpl (if cut " " nil))) - (goto-char beg) - (org-table-check-inside-data-field) - (setq l01 (org-current-line) - c01 (org-table-current-column)) - (goto-char end) - (org-table-check-inside-data-field) - (setq l02 (org-current-line) - c02 (org-table-current-column)) - (setq l1 (min l01 l02) l2 (max l01 l02) - c1 (min c01 c02) c2 (max c01 c02)) - (catch 'exit - (while t - (catch 'nextline - (if (> l1 l2) (throw 'exit t)) - (goto-line l1) - (if (org-at-table-hline-p) (throw 'nextline (setq l1 (1+ l1)))) - (setq cols nil ic1 c1 ic2 c2) - (while (< ic1 (1+ ic2)) - (push (org-table-get-field ic1 rpl) cols) - (setq ic1 (1+ ic1))) - (push (nreverse cols) region) - (setq l1 (1+ l1))))) - (setq org-table-clip (nreverse region)) - (if cut (org-table-align)) - org-table-clip)) - -(defun org-table-paste-rectangle () - "Paste a rectangular region into a table. -The upper right corner ends up in the current field. All involved fields -will be overwritten. If the rectangle does not fit into the present table, -the table is enlarged as needed. The process ignores horizontal separator -lines." - (interactive) - (unless (and org-table-clip (listp org-table-clip)) - (error "First cut/copy a region to paste!")) - (org-table-check-inside-data-field) - (let* ((clip org-table-clip) - (line (org-current-line)) - (col (org-table-current-column)) - (org-enable-table-editor t) - (org-table-automatic-realign nil) - c cols field) - (while (setq cols (pop clip)) - (while (org-at-table-hline-p) (beginning-of-line 2)) - (if (not (org-at-table-p)) - (progn (end-of-line 0) (org-table-next-field))) - (setq c col) - (while (setq field (pop cols)) - (org-table-goto-column c nil 'force) - (org-table-get-field nil field) - (setq c (1+ c))) - (beginning-of-line 2)) - (goto-line line) - (org-table-goto-column col) - (org-table-align))) - -(defun org-table-convert () - "Convert from `org-mode' table to table.el and back. -Obviously, this only works within limits. When an Org-mode table is -converted to table.el, all horizontal separator lines get lost, because -table.el uses these as cell boundaries and has no notion of horizontal lines. -A table.el table can be converted to an Org-mode table only if it does not -do row or column spanning. Multiline cells will become multiple cells. -Beware, Org-mode does not test if the table can be successfully converted - it -blindly applies a recipe that works for simple tables." - (interactive) - (require 'table) - (if (org-at-table.el-p) - ;; convert to Org-mode table - (let ((beg (move-marker (make-marker) (org-table-begin t))) - (end (move-marker (make-marker) (org-table-end t)))) - (table-unrecognize-region beg end) - (goto-char beg) - (while (re-search-forward "^\\([ \t]*\\)\\+-.*\n" end t) - (replace-match "")) - (goto-char beg)) - (if (org-at-table-p) - ;; convert to table.el table - (let ((beg (move-marker (make-marker) (org-table-begin))) - (end (move-marker (make-marker) (org-table-end)))) - ;; first, get rid of all horizontal lines - (goto-char beg) - (while (re-search-forward "^\\([ \t]*\\)|-.*\n" end t) - (replace-match "")) - ;; insert a hline before first - (goto-char beg) - (org-table-insert-hline 'above) - (beginning-of-line -1) - ;; insert a hline after each line - (while (progn (beginning-of-line 3) (< (point) end)) - (org-table-insert-hline)) - (goto-char beg) - (setq end (move-marker end (org-table-end))) - ;; replace "+" at beginning and ending of hlines - (while (re-search-forward "^\\([ \t]*\\)|-" end t) - (replace-match "\\1+-")) - (goto-char beg) - (while (re-search-forward "-|[ \t]*$" end t) - (replace-match "-+")) - (goto-char beg))))) - -(defun org-table-wrap-region (arg) - "Wrap several fields in a column like a paragraph. -This is useful if you'd like to spread the contents of a field over several -lines, in order to keep the table compact. - -If there is an active region, and both point and mark are in the same column, -the text in the column is wrapped to minimum width for the given number of -lines. Generally, this makes the table more compact. A prefix ARG may be -used to change the number of desired lines. For example, `C-2 \\[org-table-wrap]' -formats the selected text to two lines. If the region was longer than two -lines, the remaining lines remain empty. A negative prefix argument reduces -the current number of lines by that amount. The wrapped text is pasted back -into the table. If you formatted it to more lines than it was before, fields -further down in the table get overwritten - so you might need to make space in -the table first. - -If there is no region, the current field is split at the cursor position and -the text fragment to the right of the cursor is prepended to the field one -line down. - -If there is no region, but you specify a prefix ARG, the current field gets -blank, and the content is appended to the field above." - (interactive "P") - (org-table-check-inside-data-field) - (if (org-region-active-p) - ;; There is a region: fill as a paragraph - (let* ((beg (region-beginning)) - (cline (save-excursion (goto-char beg) (org-current-line))) - (ccol (save-excursion (goto-char beg) (org-table-current-column))) - nlines) - (org-table-cut-region (region-beginning) (region-end)) - (if (> (length (car org-table-clip)) 1) - (error "Region must be limited to single column")) - (setq nlines (if arg - (if (< arg 1) - (+ (length org-table-clip) arg) - arg) - (length org-table-clip))) - (setq org-table-clip - (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ") - nil nlines))) - (goto-line cline) - (org-table-goto-column ccol) - (org-table-paste-rectangle)) - ;; No region, split the current field at point - (if arg - ;; combine with field above - (let ((s (org-table-blank-field)) - (col (org-table-current-column))) - (beginning-of-line 0) - (while (org-at-table-hline-p) (beginning-of-line 0)) - (org-table-goto-column col) - (skip-chars-forward "^|") - (skip-chars-backward " ") - (insert " " (org-trim s)) - (org-table-align)) - ;; split field - (when (looking-at "\\([^|]+\\)+|") - (let ((s (match-string 1))) - (replace-match " |") - (goto-char (match-beginning 0)) - (org-table-next-row) - (insert (org-trim s) " ") - (org-table-align)))))) - -(defvar org-field-marker nil) - -(defun org-table-edit-field (arg) - "Edit table field in a different window. -This is mainly useful for fields that contain hidden parts. -When called with a \\[universal-argument] prefix, just make the full field visible so that -it can be edited in place." - (interactive "P") - (if arg - (let ((b (save-excursion (skip-chars-backward "^|") (point))) - (e (save-excursion (skip-chars-forward "^|\r\n") (point)))) - (remove-text-properties b e '(org-cwidth t invisible t - display t intangible t)) - (if (and (boundp 'font-lock-mode) font-lock-mode) - (font-lock-fontify-block))) - (let ((pos (move-marker (make-marker) (point))) - (field (org-table-get-field)) - (cw (current-window-configuration)) - p) - (org-switch-to-buffer-other-window "*Org tmp*") - (erase-buffer) - (insert "#\n# Edit field and finish with C-c C-c\n#\n") - (let ((org-inhibit-startup t)) (org-mode)) - (goto-char (setq p (point-max))) - (insert (org-trim field)) - (remove-text-properties p (point-max) - '(invisible t org-cwidth t display t - intangible t)) - (goto-char p) - (org-set-local 'org-finish-function 'org-table-finish-edit-field) - (org-set-local 'org-window-configuration cw) - (org-set-local 'org-field-marker pos) - (message "Edit and finish with C-c C-c")))) - -(defun org-table-finish-edit-field () - "Finish editing a table data field. -Remove all newline characters, insert the result into the table, realign -the table and kill the editing buffer." - (let ((pos org-field-marker) - (cw org-window-configuration) - (cb (current-buffer)) - text) - (goto-char (point-min)) - (while (re-search-forward "^#.*\n?" nil t) (replace-match "")) - (while (re-search-forward "\\([ \t]*\n[ \t]*\\)+" nil t) - (replace-match " ")) - (setq text (org-trim (buffer-string))) - (set-window-configuration cw) - (kill-buffer cb) - (select-window (get-buffer-window (marker-buffer pos))) - (goto-char pos) - (move-marker pos nil) - (org-table-check-inside-data-field) - (org-table-get-field nil text) - (org-table-align) - (message "New field value inserted"))) - -(defun org-trim (s) - "Remove whitespace at beginning and end of string." - (if (string-match "\\`[ \t\n\r]+" s) (setq s (replace-match "" t t s))) - (if (string-match "[ \t\n\r]+\\'" s) (setq s (replace-match "" t t s))) - s) - -(defun org-wrap (string &optional width lines) - "Wrap string to either a number of lines, or a width in characters. -If WIDTH is non-nil, the string is wrapped to that width, however many lines -that costs. If there is a word longer than WIDTH, the text is actually -wrapped to the length of that word. -IF WIDTH is nil and LINES is non-nil, the string is forced into at most that -many lines, whatever width that takes. -The return value is a list of lines, without newlines at the end." - (let* ((words (org-split-string string "[ \t\n]+")) - (maxword (apply 'max (mapcar 'org-string-width words))) - w ll) - (cond (width - (org-do-wrap words (max maxword width))) - (lines - (setq w maxword) - (setq ll (org-do-wrap words maxword)) - (if (<= (length ll) lines) - ll - (setq ll words) - (while (> (length ll) lines) - (setq w (1+ w)) - (setq ll (org-do-wrap words w))) - ll)) - (t (error "Cannot wrap this"))))) - - -(defun org-do-wrap (words width) - "Create lines of maximum width WIDTH (in characters) from word list WORDS." - (let (lines line) - (while words - (setq line (pop words)) - (while (and words (< (+ (length line) (length (car words))) width)) - (setq line (concat line " " (pop words)))) - (setq lines (push line lines))) - (nreverse lines))) - -(defun org-split-string (string &optional separators) - "Splits STRING into substrings at SEPARATORS. -No empty strings are returned if there are matches at the beginning -and end of string." - (let ((rexp (or separators "[ \f\t\n\r\v]+")) - (start 0) - notfirst - (list nil)) - (while (and (string-match rexp string - (if (and notfirst - (= start (match-beginning 0)) - (< start (length string))) - (1+ start) start)) - (< (match-beginning 0) (length string))) - (setq notfirst t) - (or (eq (match-beginning 0) 0) - (and (eq (match-beginning 0) (match-end 0)) - (eq (match-beginning 0) start)) - (setq list - (cons (substring string start (match-beginning 0)) - list))) - (setq start (match-end 0))) - (or (eq start (length string)) - (setq list - (cons (substring string start) - list))) - (nreverse list))) - -(defun org-table-map-tables (function) - "Apply FUNCTION to the start of all tables in the buffer." - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward org-table-any-line-regexp nil t) - (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size))) - (beginning-of-line 1) - (if (looking-at org-table-line-regexp) - (save-excursion (funcall function))) - (re-search-forward org-table-any-border-regexp nil 1)))) - (message "Mapping tables: done")) - -(defvar org-timecnt) ; dynamically scoped parameter - -(defun org-table-sum (&optional beg end nlast) - "Sum numbers in region of current table column. -The result will be displayed in the echo area, and will be available -as kill to be inserted with \\[yank]. - -If there is an active region, it is interpreted as a rectangle and all -numbers in that rectangle will be summed. If there is no active -region and point is located in a table column, sum all numbers in that -column. - -If at least one number looks like a time HH:MM or HH:MM:SS, all other -numbers are assumed to be times as well (in decimal hours) and the -numbers are added as such. - -If NLAST is a number, only the NLAST fields will actually be summed." - (interactive) - (save-excursion - (let (col (org-timecnt 0) diff h m s org-table-clip) - (cond - ((and beg end)) ; beg and end given explicitly - ((org-region-active-p) - (setq beg (region-beginning) end (region-end))) - (t - (setq col (org-table-current-column)) - (goto-char (org-table-begin)) - (unless (re-search-forward "^[ \t]*|[^-]" nil t) - (error "No table data")) - (org-table-goto-column col) - (setq beg (point)) - (goto-char (org-table-end)) - (unless (re-search-backward "^[ \t]*|[^-]" nil t) - (error "No table data")) - (org-table-goto-column col) - (setq end (point)))) - (let* ((items (apply 'append (org-table-copy-region beg end))) - (items1 (cond ((not nlast) items) - ((>= nlast (length items)) items) - (t (setq items (reverse items)) - (setcdr (nthcdr (1- nlast) items) nil) - (nreverse items)))) - (numbers (delq nil (mapcar 'org-table-get-number-for-summing - items1))) - (res (apply '+ numbers)) - (sres (if (= org-timecnt 0) - (format "%g" res) - (setq diff (* 3600 res) - h (floor (/ diff 3600)) diff (mod diff 3600) - m (floor (/ diff 60)) diff (mod diff 60) - s diff) - (format "%d:%02d:%02d" h m s)))) - (kill-new sres) - (if (interactive-p) - (message "%s" - (substitute-command-keys - (format "Sum of %d items: %-20s (\\[yank] will insert result into buffer)" - (length numbers) sres)))) - sres)))) - -(defun org-table-get-number-for-summing (s) - (let (n) - (if (string-match "^ *|? *" s) - (setq s (replace-match "" nil nil s))) - (if (string-match " *|? *$" s) - (setq s (replace-match "" nil nil s))) - (setq n (string-to-number s)) - (cond - ((and (string-match "0" s) - (string-match "\\`[-+ \t0.edED]+\\'" s)) 0) - ((string-match "\\`[ \t]+\\'" s) nil) - ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?\\'" s) - (let ((h (string-to-number (or (match-string 1 s) "0"))) - (m (string-to-number (or (match-string 2 s) "0"))) - (s (string-to-number (or (match-string 4 s) "0")))) - (if (boundp 'org-timecnt) (setq org-timecnt (1+ org-timecnt))) - (* 1.0 (+ h (/ m 60.0) (/ s 3600.0))))) - ((equal n 0) nil) - (t n)))) - -(defun org-table-current-field-formula (&optional key noerror) - "Return the formula active for the current field. -Assumes that specials are in place. -If KEY is given, return the key to this formula. -Otherwise return the formula preceeded with \"=\" or \":=\"." - (let* ((name (car (rassoc (list (org-current-line) - (org-table-current-column)) - org-table-named-field-locations))) - (col (org-table-current-column)) - (scol (int-to-string col)) - (ref (format "@%d$%d" (org-table-current-dline) col)) - (stored-list (org-table-get-stored-formulas noerror)) - (ass (or (assoc name stored-list) - (assoc ref stored-list) - (assoc scol stored-list)))) - (if key - (car ass) - (if ass (concat (if (string-match "^[0-9]+$" (car ass)) "=" ":=") - (cdr ass)))))) - -(defun org-table-get-formula (&optional equation named) - "Read a formula from the minibuffer, offer stored formula as default. -When NAMED is non-nil, look for a named equation." - (let* ((stored-list (org-table-get-stored-formulas)) - (name (car (rassoc (list (org-current-line) - (org-table-current-column)) - org-table-named-field-locations))) - (ref (format "@%d$%d" (org-table-current-dline) - (org-table-current-column))) - (refass (assoc ref stored-list)) - (scol (if named - (if name name ref) - (int-to-string (org-table-current-column)))) - (dummy (and (or name refass) (not named) - (not (y-or-n-p "Replace field formula with column formula? " )) - (error "Abort"))) - (name (or name ref)) - (org-table-may-need-update nil) - (stored (cdr (assoc scol stored-list))) - (eq (cond - ((and stored equation (string-match "^ *=? *$" equation)) - stored) - ((stringp equation) - equation) - (t (org-table-formula-from-user - (read-string - (org-table-formula-to-user - (format "%s formula %s%s=" - (if named "Field" "Column") - (if (member (string-to-char scol) '(?$ ?@)) "" "$") - scol)) - (if stored (org-table-formula-to-user stored) "") - 'org-table-formula-history - ))))) - mustsave) - (when (not (string-match "\\S-" eq)) - ;; remove formula - (setq stored-list (delq (assoc scol stored-list) stored-list)) - (org-table-store-formulas stored-list) - (error "Formula removed")) - (if (string-match "^ *=?" eq) (setq eq (replace-match "" t t eq))) - (if (string-match " *$" eq) (setq eq (replace-match "" t t eq))) - (if (and name (not named)) - ;; We set the column equation, delete the named one. - (setq stored-list (delq (assoc name stored-list) stored-list) - mustsave t)) - (if stored - (setcdr (assoc scol stored-list) eq) - (setq stored-list (cons (cons scol eq) stored-list))) - (if (or mustsave (not (equal stored eq))) - (org-table-store-formulas stored-list)) - eq)) - -(defun org-table-store-formulas (alist) - "Store the list of formulas below the current table." - (setq alist (sort alist 'org-table-formula-less-p)) - (save-excursion - (goto-char (org-table-end)) - (if (looking-at "\\([ \t]*\n\\)*#\\+TBLFM:\\(.*\n?\\)") - (progn - ;; don't overwrite TBLFM, we might use text properties to store stuff - (goto-char (match-beginning 2)) - (delete-region (match-beginning 2) (match-end 0))) - (insert "#+TBLFM:")) - (insert " " - (mapconcat (lambda (x) - (concat - (if (equal (string-to-char (car x)) ?@) "" "$") - (car x) "=" (cdr x))) - alist "::") - "\n"))) - -(defsubst org-table-formula-make-cmp-string (a) - (when (string-match "^\\(@\\([0-9]+\\)\\)?\\(\\$?\\([0-9]+\\)\\)?\\(\\$?[a-zA-Z0-9]+\\)?" a) - (concat - (if (match-end 2) (format "@%05d" (string-to-number (match-string 2 a))) "") - (if (match-end 4) (format "$%05d" (string-to-number (match-string 4 a))) "") - (if (match-end 5) (concat "@@" (match-string 5 a)))))) - -(defun org-table-formula-less-p (a b) - "Compare two formulas for sorting." - (let ((as (org-table-formula-make-cmp-string (car a))) - (bs (org-table-formula-make-cmp-string (car b)))) - (and as bs (string< as bs)))) - -(defun org-table-get-stored-formulas (&optional noerror) - "Return an alist with the stored formulas directly after current table." - (interactive) - (let (scol eq eq-alist strings string seen) - (save-excursion - (goto-char (org-table-end)) - (when (looking-at "\\([ \t]*\n\\)*#\\+TBLFM: *\\(.*\\)") - (setq strings (org-split-string (match-string 2) " *:: *")) - (while (setq string (pop strings)) - (when (string-match "\\(@[0-9]+\\$[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*[^ \t]\\)" string) - (setq scol (if (match-end 2) - (match-string 2 string) - (match-string 1 string)) - eq (match-string 3 string) - eq-alist (cons (cons scol eq) eq-alist)) - (if (member scol seen) - (if noerror - (progn - (message "Double definition `$%s=' in TBLFM line, please fix by hand" scol) - (ding) - (sit-for 2)) - (error "Double definition `$%s=' in TBLFM line, please fix by hand" scol)) - (push scol seen)))))) - (nreverse eq-alist))) - -(defun org-table-fix-formulas (key replace &optional limit delta remove) - "Modify the equations after the table structure has been edited. -KEY is \"@\" or \"$\". REPLACE is an alist of numbers to replace. -For all numbers larger than LIMIT, shift them by DELTA." - (save-excursion - (goto-char (org-table-end)) - (when (looking-at "#\\+TBLFM:") - (let ((re (concat key "\\([0-9]+\\)")) - (re2 - (when remove - (if (equal key "$") - (format "\\(@[0-9]+\\)?\\$%d=.*?\\(::\\|$\\)" remove) - (format "@%d\\$[0-9]+=.*?\\(::\\|$\\)" remove)))) - s n a) - (when remove - (while (re-search-forward re2 (point-at-eol) t) - (replace-match ""))) - (while (re-search-forward re (point-at-eol) t) - (setq s (match-string 1) n (string-to-number s)) - (cond - ((setq a (assoc s replace)) - (replace-match (concat key (cdr a)) t t)) - ((and limit (> n limit)) - (replace-match (concat key (int-to-string (+ n delta))) t t)))))))) - -(defun org-table-get-specials () - "Get the column names and local parameters for this table." - (save-excursion - (let ((beg (org-table-begin)) (end (org-table-end)) - names name fields fields1 field cnt - c v l line col types dlines hlines) - (setq org-table-column-names nil - org-table-local-parameters nil - org-table-named-field-locations nil - org-table-current-begin-line nil - org-table-current-begin-pos nil - org-table-current-line-types nil) - (goto-char beg) - (when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t) - (setq names (org-split-string (match-string 1) " *| *") - cnt 1) - (while (setq name (pop names)) - (setq cnt (1+ cnt)) - (if (string-match "^[a-zA-Z][a-zA-Z0-9]*$" name) - (push (cons name (int-to-string cnt)) org-table-column-names)))) - (setq org-table-column-names (nreverse org-table-column-names)) - (setq org-table-column-name-regexp - (concat "\\$\\(" (mapconcat 'car org-table-column-names "\\|") "\\)\\>")) - (goto-char beg) - (while (re-search-forward "^[ \t]*| *\\$ *\\(|.*\\)" end t) - (setq fields (org-split-string (match-string 1) " *| *")) - (while (setq field (pop fields)) - (if (string-match "^\\([a-zA-Z][_a-zA-Z0-9]*\\|%\\) *= *\\(.*\\)" field) - (push (cons (match-string 1 field) (match-string 2 field)) - org-table-local-parameters)))) - (goto-char beg) - (while (re-search-forward "^[ \t]*| *\\([_^]\\) *\\(|.*\\)" end t) - (setq c (match-string 1) - fields (org-split-string (match-string 2) " *| *")) - (save-excursion - (beginning-of-line (if (equal c "_") 2 0)) - (setq line (org-current-line) col 1) - (and (looking-at "^[ \t]*|[^|]*\\(|.*\\)") - (setq fields1 (org-split-string (match-string 1) " *| *")))) - (while (and fields1 (setq field (pop fields))) - (setq v (pop fields1) col (1+ col)) - (when (and (stringp field) (stringp v) - (string-match "^[a-zA-Z][a-zA-Z0-9]*$" field)) - (push (cons field v) org-table-local-parameters) - (push (list field line col) org-table-named-field-locations)))) - ;; Analyse the line types - (goto-char beg) - (setq org-table-current-begin-line (org-current-line) - org-table-current-begin-pos (point) - l org-table-current-begin-line) - (while (looking-at "[ \t]*|\\(-\\)?") - (push (if (match-end 1) 'hline 'dline) types) - (if (match-end 1) (push l hlines) (push l dlines)) - (beginning-of-line 2) - (setq l (1+ l))) - (setq org-table-current-line-types (apply 'vector (nreverse types)) - org-table-dlines (apply 'vector (cons nil (nreverse dlines))) - org-table-hlines (apply 'vector (cons nil (nreverse hlines))))))) - -(defun org-table-maybe-eval-formula () - "Check if the current field starts with \"=\" or \":=\". -If yes, store the formula and apply it." - ;; We already know we are in a table. Get field will only return a formula - ;; when appropriate. It might return a separator line, but no problem. - (when org-table-formula-evaluate-inline - (let* ((field (org-trim (or (org-table-get-field) ""))) - named eq) - (when (string-match "^:?=\\(.*\\)" field) - (setq named (equal (string-to-char field) ?:) - eq (match-string 1 field)) - (if (or (fboundp 'calc-eval) - (equal (substring eq 0 (min 2 (length eq))) "'(")) - (org-table-eval-formula (if named '(4) nil) - (org-table-formula-from-user eq)) - (error "Calc does not seem to be installed, and is needed to evaluate the formula")))))) - -(defvar org-recalc-commands nil - "List of commands triggering the recalculation of a line. -Will be filled automatically during use.") - -(defvar org-recalc-marks - '((" " . "Unmarked: no special line, no automatic recalculation") - ("#" . "Automatically recalculate this line upon TAB, RET, and C-c C-c in the line") - ("*" . "Recalculate only when entire table is recalculated with `C-u C-c *'") - ("!" . "Column name definition line. Reference in formula as $name.") - ("$" . "Parameter definition line name=value. Reference in formula as $name.") - ("_" . "Names for values in row below this one.") - ("^" . "Names for values in row above this one."))) - -(defun org-table-rotate-recalc-marks (&optional newchar) - "Rotate the recalculation mark in the first column. -If in any row, the first field is not consistent with a mark, -insert a new column for the markers. -When there is an active region, change all the lines in the region, -after prompting for the marking character. -After each change, a message will be displayed indicating the meaning -of the new mark." - (interactive) - (unless (org-at-table-p) (error "Not at a table")) - (let* ((marks (append (mapcar 'car org-recalc-marks) '(" "))) - (beg (org-table-begin)) - (end (org-table-end)) - (l (org-current-line)) - (l1 (if (org-region-active-p) (org-current-line (region-beginning)))) - (l2 (if (org-region-active-p) (org-current-line (region-end)))) - (have-col - (save-excursion - (goto-char beg) - (not (re-search-forward "^[ \t]*|[^-|][^|]*[^#!$*_^| \t][^|]*|" end t)))) - (col (org-table-current-column)) - (forcenew (car (assoc newchar org-recalc-marks))) - epos new) - (when l1 - (message "Change region to what mark? Type # * ! $ or SPC: ") - (setq newchar (char-to-string (read-char-exclusive)) - forcenew (car (assoc newchar org-recalc-marks)))) - (if (and newchar (not forcenew)) - (error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'" - newchar)) - (if l1 (goto-line l1)) - (save-excursion - (beginning-of-line 1) - (unless (looking-at org-table-dataline-regexp) - (error "Not at a table data line"))) - (unless have-col - (org-table-goto-column 1) - (org-table-insert-column) - (org-table-goto-column (1+ col))) - (setq epos (point-at-eol)) - (save-excursion - (beginning-of-line 1) - (org-table-get-field - 1 (if (looking-at "^[ \t]*| *\\([#!$*^_ ]\\) *|") - (concat " " - (setq new (or forcenew - (cadr (member (match-string 1) marks)))) - " ") - " # "))) - (if (and l1 l2) - (progn - (goto-line l1) - (while (progn (beginning-of-line 2) (not (= (org-current-line) l2))) - (and (looking-at org-table-dataline-regexp) - (org-table-get-field 1 (concat " " new " ")))) - (goto-line l1))) - (if (not (= epos (point-at-eol))) (org-table-align)) - (goto-line l) - (and (interactive-p) (message "%s" (cdr (assoc new org-recalc-marks)))))) - -(defun org-table-maybe-recalculate-line () - "Recompute the current line if marked for it, and if we haven't just done it." - (interactive) - (and org-table-allow-automatic-line-recalculation - (not (and (memq last-command org-recalc-commands) - (equal org-last-recalc-line (org-current-line)))) - (save-excursion (beginning-of-line 1) - (looking-at org-table-auto-recalculate-regexp)) - (org-table-recalculate) t)) - -(defvar org-table-formula-debug nil - "Non-nil means, debug table formulas. -When nil, simply write \"#ERROR\" in corrupted fields.") -(make-variable-buffer-local 'org-table-formula-debug) - -(defvar modes) -(defsubst org-set-calc-mode (var &optional value) - (if (stringp var) - (setq var (assoc var '(("D" calc-angle-mode deg) - ("R" calc-angle-mode rad) - ("F" calc-prefer-frac t) - ("S" calc-symbolic-mode t))) - value (nth 2 var) var (nth 1 var))) - (if (memq var modes) - (setcar (cdr (memq var modes)) value) - (cons var (cons value modes))) - modes) - -(defun org-table-eval-formula (&optional arg equation - suppress-align suppress-const - suppress-store suppress-analysis) - "Replace the table field value at the cursor by the result of a calculation. - -This function makes use of Dave Gillespie's Calc package, in my view the -most exciting program ever written for GNU Emacs. So you need to have Calc -installed in order to use this function. - -In a table, this command replaces the value in the current field with the -result of a formula. It also installs the formula as the \"current\" column -formula, by storing it in a special line below the table. When called -with a `C-u' prefix, the current field must ba a named field, and the -formula is installed as valid in only this specific field. - -When called with two `C-u' prefixes, insert the active equation -for the field back into the current field, so that it can be -edited there. This is useful in order to use \\[org-table-show-reference] -to check the referenced fields. - -When called, the command first prompts for a formula, which is read in -the minibuffer. Previously entered formulas are available through the -history list, and the last used formula is offered as a default. -These stored formulas are adapted correctly when moving, inserting, or -deleting columns with the corresponding commands. - -The formula can be any algebraic expression understood by the Calc package. -For details, see the Org-mode manual. - -This function can also be called from Lisp programs and offers -additional arguments: EQUATION can be the formula to apply. If this -argument is given, the user will not be prompted. SUPPRESS-ALIGN is -used to speed-up recursive calls by by-passing unnecessary aligns. -SUPPRESS-CONST suppresses the interpretation of constants in the -formula, assuming that this has been done already outside the function. -SUPPRESS-STORE means the formula should not be stored, either because -it is already stored, or because it is a modified equation that should -not overwrite the stored one." - (interactive "P") - (org-table-check-inside-data-field) - (or suppress-analysis (org-table-get-specials)) - (if (equal arg '(16)) - (let ((eq (org-table-current-field-formula))) - (or eq (error "No equation active for current field")) - (org-table-get-field nil eq) - (org-table-align) - (setq org-table-may-need-update t)) - (let* (fields - (ndown (if (integerp arg) arg 1)) - (org-table-automatic-realign nil) - (case-fold-search nil) - (down (> ndown 1)) - (formula (if (and equation suppress-store) - equation - (org-table-get-formula equation (equal arg '(4))))) - (n0 (org-table-current-column)) - (modes (copy-sequence org-calc-default-modes)) - (numbers nil) ; was a variable, now fixed default - (keep-empty nil) - n form form0 bw fmt x ev orig c lispp literal) - ;; Parse the format string. Since we have a lot of modes, this is - ;; a lot of work. However, I think calc still uses most of the time. - (if (string-match ";" formula) - (let ((tmp (org-split-string formula ";"))) - (setq formula (car tmp) - fmt (concat (cdr (assoc "%" org-table-local-parameters)) - (nth 1 tmp))) - (while (string-match "\\([pnfse]\\)\\(-?[0-9]+\\)" fmt) - (setq c (string-to-char (match-string 1 fmt)) - n (string-to-number (match-string 2 fmt))) - (if (= c ?p) - (setq modes (org-set-calc-mode 'calc-internal-prec n)) - (setq modes (org-set-calc-mode - 'calc-float-format - (list (cdr (assoc c '((?n . float) (?f . fix) - (?s . sci) (?e . eng)))) - n)))) - (setq fmt (replace-match "" t t fmt))) - (if (string-match "[NT]" fmt) - (setq numbers (equal (match-string 0 fmt) "N") - fmt (replace-match "" t t fmt))) - (if (string-match "L" fmt) - (setq literal t - fmt (replace-match "" t t fmt))) - (if (string-match "E" fmt) - (setq keep-empty t - fmt (replace-match "" t t fmt))) - (while (string-match "[DRFS]" fmt) - (setq modes (org-set-calc-mode (match-string 0 fmt))) - (setq fmt (replace-match "" t t fmt))) - (unless (string-match "\\S-" fmt) - (setq fmt nil)))) - (if (and (not suppress-const) org-table-formula-use-constants) - (setq formula (org-table-formula-substitute-names formula))) - (setq orig (or (get-text-property 1 :orig-formula formula) "?")) - (while (> ndown 0) - (setq fields (org-split-string - (org-no-properties - (buffer-substring (point-at-bol) (point-at-eol))) - " *| *")) - (if (eq numbers t) - (setq fields (mapcar - (lambda (x) (number-to-string (string-to-number x))) - fields))) - (setq ndown (1- ndown)) - (setq form (copy-sequence formula) - lispp (and (> (length form) 2)(equal (substring form 0 2) "'("))) - (if (and lispp literal) (setq lispp 'literal)) - ;; Check for old vertical references - (setq form (org-rewrite-old-row-references form)) - ;; Insert complex ranges - (while (string-match org-table-range-regexp form) - (setq form - (replace-match - (save-match-data - (org-table-make-reference - (org-table-get-range (match-string 0 form) nil n0) - keep-empty numbers lispp)) - t t form))) - ;; Insert simple ranges - (while (string-match "\\$\\([0-9]+\\)\\.\\.\\$\\([0-9]+\\)" form) - (setq form - (replace-match - (save-match-data - (org-table-make-reference - (org-sublist - fields (string-to-number (match-string 1 form)) - (string-to-number (match-string 2 form))) - keep-empty numbers lispp)) - t t form))) - (setq form0 form) - ;; Insert the references to fields in same row - (while (string-match "\\$\\([0-9]+\\)" form) - (setq n (string-to-number (match-string 1 form)) - x (nth (1- (if (= n 0) n0 n)) fields)) - (unless x (error "Invalid field specifier \"%s\"" - (match-string 0 form))) - (setq form (replace-match - (save-match-data - (org-table-make-reference x nil numbers lispp)) - t t form))) - - (if lispp - (setq ev (condition-case nil - (eval (eval (read form))) - (error "#ERROR")) - ev (if (numberp ev) (number-to-string ev) ev)) - (or (fboundp 'calc-eval) - (error "Calc does not seem to be installed, and is needed to evaluate the formula")) - (setq ev (calc-eval (cons form modes) - (if numbers 'num)))) - - (when org-table-formula-debug - (with-output-to-temp-buffer "*Substitution History*" - (princ (format "Substitution history of formula -Orig: %s -$xyz-> %s -@r$c-> %s -$1-> %s\n" orig formula form0 form)) - (if (listp ev) - (princ (format " %s^\nError: %s" - (make-string (car ev) ?\-) (nth 1 ev))) - (princ (format "Result: %s\nFormat: %s\nFinal: %s" - ev (or fmt "NONE") - (if fmt (format fmt (string-to-number ev)) ev))))) - (setq bw (get-buffer-window "*Substitution History*")) - (shrink-window-if-larger-than-buffer bw) - (unless (and (interactive-p) (not ndown)) - (unless (let (inhibit-redisplay) - (y-or-n-p "Debugging Formula. Continue to next? ")) - (org-table-align) - (error "Abort")) - (delete-window bw) - (message ""))) - (if (listp ev) (setq fmt nil ev "#ERROR")) - (org-table-justify-field-maybe - (if fmt (format fmt (string-to-number ev)) ev)) - (if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]")) - (call-interactively 'org-return) - (setq ndown 0))) - (and down (org-table-maybe-recalculate-line)) - (or suppress-align (and org-table-may-need-update - (org-table-align)))))) - -(defun org-table-put-field-property (prop value) - (save-excursion - (put-text-property (progn (skip-chars-backward "^|") (point)) - (progn (skip-chars-forward "^|") (point)) - prop value))) - -(defun org-table-get-range (desc &optional tbeg col highlight) - "Get a calc vector from a column, accorting to descriptor DESC. -Optional arguments TBEG and COL can give the beginning of the table and -the current column, to avoid unnecessary parsing. -HIGHLIGHT means, just highlight the range." - (if (not (equal (string-to-char desc) ?@)) - (setq desc (concat "@" desc))) - (save-excursion - (or tbeg (setq tbeg (org-table-begin))) - (or col (setq col (org-table-current-column))) - (let ((thisline (org-current-line)) - beg end c1 c2 r1 r2 rangep tmp) - (unless (string-match org-table-range-regexp desc) - (error "Invalid table range specifier `%s'" desc)) - (setq rangep (match-end 3) - r1 (and (match-end 1) (match-string 1 desc)) - r2 (and (match-end 4) (match-string 4 desc)) - c1 (and (match-end 2) (substring (match-string 2 desc) 1)) - c2 (and (match-end 5) (substring (match-string 5 desc) 1))) - - (and c1 (setq c1 (+ (string-to-number c1) - (if (memq (string-to-char c1) '(?- ?+)) col 0)))) - (and c2 (setq c2 (+ (string-to-number c2) - (if (memq (string-to-char c2) '(?- ?+)) col 0)))) - (if (equal r1 "") (setq r1 nil)) - (if (equal r2 "") (setq r2 nil)) - (if r1 (setq r1 (org-table-get-descriptor-line r1))) - (if r2 (setq r2 (org-table-get-descriptor-line r2))) -; (setq r2 (or r2 r1) c2 (or c2 c1)) - (if (not r1) (setq r1 thisline)) - (if (not r2) (setq r2 thisline)) - (if (not c1) (setq c1 col)) - (if (not c2) (setq c2 col)) - (if (or (not rangep) (and (= r1 r2) (= c1 c2))) - ;; just one field - (progn - (goto-line r1) - (while (not (looking-at org-table-dataline-regexp)) - (beginning-of-line 2)) - (prog1 (org-trim (org-table-get-field c1)) - (if highlight (org-table-highlight-rectangle (point) (point))))) - ;; A range, return a vector - ;; First sort the numbers to get a regular ractangle - (if (< r2 r1) (setq tmp r1 r1 r2 r2 tmp)) - (if (< c2 c1) (setq tmp c1 c1 c2 c2 tmp)) - (goto-line r1) - (while (not (looking-at org-table-dataline-regexp)) - (beginning-of-line 2)) - (org-table-goto-column c1) - (setq beg (point)) - (goto-line r2) - (while (not (looking-at org-table-dataline-regexp)) - (beginning-of-line 0)) - (org-table-goto-column c2) - (setq end (point)) - (if highlight - (org-table-highlight-rectangle - beg (progn (skip-chars-forward "^|\n") (point)))) - ;; return string representation of calc vector - (mapcar 'org-trim - (apply 'append (org-table-copy-region beg end))))))) - -(defun org-table-get-descriptor-line (desc &optional cline bline table) - "Analyze descriptor DESC and retrieve the corresponding line number. -The cursor is currently in line CLINE, the table begins in line BLINE, -and TABLE is a vector with line types." - (if (string-match "^[0-9]+$" desc) - (aref org-table-dlines (string-to-number desc)) - (setq cline (or cline (org-current-line)) - bline (or bline org-table-current-begin-line) - table (or table org-table-current-line-types)) - (if (or - (not (string-match "^\\(\\([-+]\\)?\\(I+\\)\\)?\\(\\([-+]\\)?\\([0-9]+\\)\\)?" desc)) - ;; 1 2 3 4 5 6 - (and (not (match-end 3)) (not (match-end 6))) - (and (match-end 3) (match-end 6) (not (match-end 5)))) - (error "invalid row descriptor `%s'" desc)) - (let* ((hdir (and (match-end 2) (match-string 2 desc))) - (hn (if (match-end 3) (- (match-end 3) (match-beginning 3)) nil)) - (odir (and (match-end 5) (match-string 5 desc))) - (on (if (match-end 6) (string-to-number (match-string 6 desc)))) - (i (- cline bline)) - (rel (and (match-end 6) - (or (and (match-end 1) (not (match-end 3))) - (match-end 5))))) - (if (and hn (not hdir)) - (progn - (setq i 0 hdir "+") - (if (eq (aref table 0) 'hline) (setq hn (1- hn))))) - (if (and (not hn) on (not odir)) - (error "should never happen");;(aref org-table-dlines on) - (if (and hn (> hn 0)) - (setq i (org-find-row-type table i 'hline (equal hdir "-") nil hn))) - (if on - (setq i (org-find-row-type table i 'dline (equal odir "-") rel on))) - (+ bline i))))) - -(defun org-find-row-type (table i type backwards relative n) - (let ((l (length table))) - (while (> n 0) - (while (and (setq i (+ i (if backwards -1 1))) - (>= i 0) (< i l) - (not (eq (aref table i) type)) - (if (and relative (eq (aref table i) 'hline)) - (progn (setq i (- i (if backwards -1 1)) n 1) nil) - t))) - (setq n (1- n))) - (if (or (< i 0) (>= i l)) - (error "Row descriptior leads outside table") - i))) - -(defun org-rewrite-old-row-references (s) - (if (string-match "&[-+0-9I]" s) - (error "Formula contains old &row reference, please rewrite using @-syntax") - s)) - -(defun org-table-make-reference (elements keep-empty numbers lispp) - "Convert list ELEMENTS to something appropriate to insert into formula. -KEEP-EMPTY indicated to keep empty fields, default is to skip them. -NUMBERS indicates that everything should be converted to numbers. -LISPP means to return something appropriate for a Lisp list." - (if (stringp elements) ; just a single val - (if lispp - (if (eq lispp 'literal) - elements - (prin1-to-string (if numbers (string-to-number elements) elements))) - (if (equal elements "") (setq elements "0")) - (if numbers (number-to-string (string-to-number elements)) elements)) - (unless keep-empty - (setq elements - (delq nil - (mapcar (lambda (x) (if (string-match "\\S-" x) x nil)) - elements)))) - (setq elements (or elements '("0"))) - (if lispp - (mapconcat - (lambda (x) - (if (eq lispp 'literal) - x - (prin1-to-string (if numbers (string-to-number x) x)))) - elements " ") - (concat "[" (mapconcat - (lambda (x) - (if numbers (number-to-string (string-to-number x)) x)) - elements - ",") "]")))) - -(defun org-table-recalculate (&optional all noalign) - "Recalculate the current table line by applying all stored formulas. -With prefix arg ALL, do this for all lines in the table." - (interactive "P") - (or (memq this-command org-recalc-commands) - (setq org-recalc-commands (cons this-command org-recalc-commands))) - (unless (org-at-table-p) (error "Not at a table")) - (if (equal all '(16)) - (org-table-iterate) - (org-table-get-specials) - (let* ((eqlist (sort (org-table-get-stored-formulas) - (lambda (a b) (string< (car a) (car b))))) - (inhibit-redisplay (not debug-on-error)) - (line-re org-table-dataline-regexp) - (thisline (org-current-line)) - (thiscol (org-table-current-column)) - beg end entry eqlnum eqlname eqlname1 eql (cnt 0) eq a name) - ;; Insert constants in all formulas - (setq eqlist - (mapcar (lambda (x) - (setcdr x (org-table-formula-substitute-names (cdr x))) - x) - eqlist)) - ;; Split the equation list - (while (setq eq (pop eqlist)) - (if (<= (string-to-char (car eq)) ?9) - (push eq eqlnum) - (push eq eqlname))) - (setq eqlnum (nreverse eqlnum) eqlname (nreverse eqlname)) - (if all - (progn - (setq end (move-marker (make-marker) (1+ (org-table-end)))) - (goto-char (setq beg (org-table-begin))) - (if (re-search-forward org-table-calculate-mark-regexp end t) - ;; This is a table with marked lines, compute selected lines - (setq line-re org-table-recalculate-regexp) - ;; Move forward to the first non-header line - (if (and (re-search-forward org-table-dataline-regexp end t) - (re-search-forward org-table-hline-regexp end t) - (re-search-forward org-table-dataline-regexp end t)) - (setq beg (match-beginning 0)) - nil))) ;; just leave beg where it is - (setq beg (point-at-bol) - end (move-marker (make-marker) (1+ (point-at-eol))))) - (goto-char beg) - (and all (message "Re-applying formulas to full table...")) - - ;; First find the named fields, and mark them untouchanble - (remove-text-properties beg end '(org-untouchable t)) - (while (setq eq (pop eqlname)) - (setq name (car eq) - a (assoc name org-table-named-field-locations)) - (and (not a) - (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" name) - (setq a (list name - (aref org-table-dlines - (string-to-number (match-string 1 name))) - (string-to-number (match-string 2 name))))) - (when (and a (or all (equal (nth 1 a) thisline))) - (message "Re-applying formula to field: %s" name) - (goto-line (nth 1 a)) - (org-table-goto-column (nth 2 a)) - (push (append a (list (cdr eq))) eqlname1) - (org-table-put-field-property :org-untouchable t))) - - ;; Now evauluate the column formulas, but skip fields covered by - ;; field formulas - (goto-char beg) - (while (re-search-forward line-re end t) - (unless (string-match "^ *[_^!$/] *$" (org-table-get-field 1)) - ;; Unprotected line, recalculate - (and all (message "Re-applying formulas to full table...(line %d)" - (setq cnt (1+ cnt)))) - (setq org-last-recalc-line (org-current-line)) - (setq eql eqlnum) - (while (setq entry (pop eql)) - (goto-line org-last-recalc-line) - (org-table-goto-column (string-to-number (car entry)) nil 'force) - (unless (get-text-property (point) :org-untouchable) - (org-table-eval-formula nil (cdr entry) - 'noalign 'nocst 'nostore 'noanalysis))))) - - ;; Now evaluate the field formulas - (while (setq eq (pop eqlname1)) - (message "Re-applying formula to field: %s" (car eq)) - (goto-line (nth 1 eq)) - (org-table-goto-column (nth 2 eq)) - (org-table-eval-formula nil (nth 3 eq) 'noalign 'nocst - 'nostore 'noanalysis)) - - (goto-line thisline) - (org-table-goto-column thiscol) - (remove-text-properties (point-min) (point-max) '(org-untouchable t)) - (or noalign (and org-table-may-need-update (org-table-align)) - (and all (message "Re-applying formulas to %d lines...done" cnt))) - - ;; back to initial position - (message "Re-applying formulas...done") - (goto-line thisline) - (org-table-goto-column thiscol) - (or noalign (and org-table-may-need-update (org-table-align)) - (and all (message "Re-applying formulas...done")))))) - -(defun org-table-iterate (&optional arg) - "Recalculate the table until it does not change anymore." - (interactive "P") - (let ((imax (if arg (prefix-numeric-value arg) 10)) - (i 0) - (lasttbl (buffer-substring (org-table-begin) (org-table-end))) - thistbl) - (catch 'exit - (while (< i imax) - (setq i (1+ i)) - (org-table-recalculate 'all) - (setq thistbl (buffer-substring (org-table-begin) (org-table-end))) - (if (not (string= lasttbl thistbl)) - (setq lasttbl thistbl) - (if (> i 1) - (message "Convergence after %d iterations" i) - (message "Table was already stable")) - (throw 'exit t))) - (error "No convergence after %d iterations" i)))) - -(defun org-table-formula-substitute-names (f) - "Replace $const with values in string F." - (let ((start 0) a (f1 f) (pp (/= (string-to-char f) ?'))) - ;; First, check for column names - (while (setq start (string-match org-table-column-name-regexp f start)) - (setq start (1+ start)) - (setq a (assoc (match-string 1 f) org-table-column-names)) - (setq f (replace-match (concat "$" (cdr a)) t t f))) - ;; Parameters and constants - (setq start 0) - (while (setq start (string-match "\\$\\([a-zA-Z][_a-zA-Z0-9]*\\)" f start)) - (setq start (1+ start)) - (if (setq a (save-match-data - (org-table-get-constant (match-string 1 f)))) - (setq f (replace-match - (concat (if pp "(") a (if pp ")")) t t f)))) - (if org-table-formula-debug - (put-text-property 0 (length f) :orig-formula f1 f)) - f)) - -(defun org-table-get-constant (const) - "Find the value for a parameter or constant in a formula. -Parameters get priority." - (or (cdr (assoc const org-table-local-parameters)) - (cdr (assoc const org-table-formula-constants-local)) - (cdr (assoc const org-table-formula-constants)) - (and (fboundp 'constants-get) (constants-get const)) - (and (string= (substring const 0 (min 5 (length const))) "PROP_") - (org-entry-get nil (substring const 5) 'inherit)) - "#UNDEFINED_NAME")) - -(defvar org-table-fedit-map - (let ((map (make-sparse-keymap))) - (org-defkey map "\C-x\C-s" 'org-table-fedit-finish) - (org-defkey map "\C-c\C-s" 'org-table-fedit-finish) - (org-defkey map "\C-c\C-c" 'org-table-fedit-finish) - (org-defkey map "\C-c\C-q" 'org-table-fedit-abort) - (org-defkey map "\C-c?" 'org-table-show-reference) - (org-defkey map [(meta shift up)] 'org-table-fedit-line-up) - (org-defkey map [(meta shift down)] 'org-table-fedit-line-down) - (org-defkey map [(shift up)] 'org-table-fedit-ref-up) - (org-defkey map [(shift down)] 'org-table-fedit-ref-down) - (org-defkey map [(shift left)] 'org-table-fedit-ref-left) - (org-defkey map [(shift right)] 'org-table-fedit-ref-right) - (org-defkey map [(meta up)] 'org-table-fedit-scroll-down) - (org-defkey map [(meta down)] 'org-table-fedit-scroll) - (org-defkey map [(meta tab)] 'lisp-complete-symbol) - (org-defkey map "\M-\C-i" 'lisp-complete-symbol) - (org-defkey map [(tab)] 'org-table-fedit-lisp-indent) - (org-defkey map "\C-i" 'org-table-fedit-lisp-indent) - (org-defkey map "\C-c\C-r" 'org-table-fedit-toggle-ref-type) - (org-defkey map "\C-c}" 'org-table-fedit-toggle-coordinates) - map)) - -(easy-menu-define org-table-fedit-menu org-table-fedit-map "Org Edit Formulas Menu" - '("Edit-Formulas" - ["Finish and Install" org-table-fedit-finish t] - ["Finish, Install, and Apply" (org-table-fedit-finish t) :keys "C-u C-c C-c"] - ["Abort" org-table-fedit-abort t] - "--" - ["Pretty-Print Lisp Formula" org-table-fedit-lisp-indent t] - ["Complete Lisp Symbol" lisp-complete-symbol t] - "--" - "Shift Reference at Point" - ["Up" org-table-fedit-ref-up t] - ["Down" org-table-fedit-ref-down t] - ["Left" org-table-fedit-ref-left t] - ["Right" org-table-fedit-ref-right t] - "-" - "Change Test Row for Column Formulas" - ["Up" org-table-fedit-line-up t] - ["Down" org-table-fedit-line-down t] - "--" - ["Scroll Table Window" org-table-fedit-scroll t] - ["Scroll Table Window down" org-table-fedit-scroll-down t] - ["Show Table Grid" org-table-fedit-toggle-coordinates - :style toggle :selected (with-current-buffer (marker-buffer org-pos) - org-table-overlay-coordinates)] - "--" - ["Standard Refs (B3 instead of @3$2)" org-table-fedit-toggle-ref-type - :style toggle :selected org-table-buffer-is-an])) - -(defvar org-pos) - -(defun org-table-edit-formulas () - "Edit the formulas of the current table in a separate buffer." - (interactive) - (when (save-excursion (beginning-of-line 1) (looking-at "#\\+TBLFM")) - (beginning-of-line 0)) - (unless (org-at-table-p) (error "Not at a table")) - (org-table-get-specials) - (let ((key (org-table-current-field-formula 'key 'noerror)) - (eql (sort (org-table-get-stored-formulas 'noerror) - 'org-table-formula-less-p)) - (pos (move-marker (make-marker) (point))) - (startline 1) - (wc (current-window-configuration)) - (titles '((column . "# Column Formulas\n") - (field . "# Field Formulas\n") - (named . "# Named Field Formulas\n"))) - entry s type title) - (org-switch-to-buffer-other-window "*Edit Formulas*") - (erase-buffer) - ;; Keep global-font-lock-mode from turning on font-lock-mode - (let ((font-lock-global-modes '(not fundamental-mode))) - (fundamental-mode)) - (org-set-local 'font-lock-global-modes (list 'not major-mode)) - (org-set-local 'org-pos pos) - (org-set-local 'org-window-configuration wc) - (use-local-map org-table-fedit-map) - (org-add-hook 'post-command-hook 'org-table-fedit-post-command t t) - (easy-menu-add org-table-fedit-menu) - (setq startline (org-current-line)) - (while (setq entry (pop eql)) - (setq type (cond - ((equal (string-to-char (car entry)) ?@) 'field) - ((string-match "^[0-9]" (car entry)) 'column) - (t 'named))) - (when (setq title (assq type titles)) - (or (bobp) (insert "\n")) - (insert (org-add-props (cdr title) nil 'face font-lock-comment-face)) - (setq titles (delq title titles))) - (if (equal key (car entry)) (setq startline (org-current-line))) - (setq s (concat (if (equal (string-to-char (car entry)) ?@) "" "$") - (car entry) " = " (cdr entry) "\n")) - (remove-text-properties 0 (length s) '(face nil) s) - (insert s)) - (if (eq org-table-use-standard-references t) - (org-table-fedit-toggle-ref-type)) - (goto-line startline) - (message "Edit formulas and finish with `C-c C-c'. See menu for more commands."))) - -(defun org-table-fedit-post-command () - (when (not (memq this-command '(lisp-complete-symbol))) - (let ((win (selected-window))) - (save-excursion - (condition-case nil - (org-table-show-reference) - (error nil)) - (select-window win))))) - -(defun org-table-formula-to-user (s) - "Convert a formula from internal to user representation." - (if (eq org-table-use-standard-references t) - (org-table-convert-refs-to-an s) - s)) - -(defun org-table-formula-from-user (s) - "Convert a formula from user to internal representation." - (if org-table-use-standard-references - (org-table-convert-refs-to-rc s) - s)) - -(defun org-table-convert-refs-to-rc (s) - "Convert spreadsheet references from AB7 to @7$28. -Works for single references, but also for entire formulas and even the -full TBLFM line." - (let ((start 0)) - (while (string-match "\\<\\([a-zA-Z]+\\)\\([0-9]+\\>\\|&\\)\\|\\(;[^\r\n:]+\\)" s start) - (cond - ((match-end 3) - ;; format match, just advance - (setq start (match-end 0))) - ((and (> (match-beginning 0) 0) - (equal ?. (aref s (max (1- (match-beginning 0)) 0))) - (not (equal ?. (aref s (max (- (match-beginning 0) 2) 0))))) - ;; 3.e5 or something like this. - (setq start (match-end 0))) - (t - (setq start (match-beginning 0) - s (replace-match - (if (equal (match-string 2 s) "&") - (format "$%d" (org-letters-to-number (match-string 1 s))) - (format "@%d$%d" - (string-to-number (match-string 2 s)) - (org-letters-to-number (match-string 1 s)))) - t t s))))) - s)) - -(defun org-table-convert-refs-to-an (s) - "Convert spreadsheet references from to @7$28 to AB7. -Works for single references, but also for entire formulas and even the -full TBLFM line." - (while (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" s) - (setq s (replace-match - (format "%s%d" - (org-number-to-letters - (string-to-number (match-string 2 s))) - (string-to-number (match-string 1 s))) - t t s))) - (while (string-match "\\(^\\|[^0-9a-zA-Z]\\)\\$\\([0-9]+\\)" s) - (setq s (replace-match (concat "\\1" - (org-number-to-letters - (string-to-number (match-string 2 s))) "&") - t nil s))) - s) - -(defun org-letters-to-number (s) - "Convert a base 26 number represented by letters into an integer. -For example: AB -> 28." - (let ((n 0)) - (setq s (upcase s)) - (while (> (length s) 0) - (setq n (+ (* n 26) (string-to-char s) (- ?A) 1) - s (substring s 1))) - n)) - -(defun org-number-to-letters (n) - "Convert an integer into a base 26 number represented by letters. -For example: 28 -> AB." - (let ((s "")) - (while (> n 0) - (setq s (concat (char-to-string (+ (mod (1- n) 26) ?A)) s) - n (/ (1- n) 26))) - s)) - -(defun org-table-fedit-convert-buffer (function) - "Convert all references in this buffer, using FUNTION." - (let ((line (org-current-line))) - (goto-char (point-min)) - (while (not (eobp)) - (insert (funcall function (buffer-substring (point) (point-at-eol)))) - (delete-region (point) (point-at-eol)) - (or (eobp) (forward-char 1))) - (goto-line line))) - -(defun org-table-fedit-toggle-ref-type () - "Convert all references in the buffer from B3 to @3$2 and back." - (interactive) - (org-set-local 'org-table-buffer-is-an (not org-table-buffer-is-an)) - (org-table-fedit-convert-buffer - (if org-table-buffer-is-an - 'org-table-convert-refs-to-an 'org-table-convert-refs-to-rc)) - (message "Reference type switched to %s" - (if org-table-buffer-is-an "A1 etc" "@row$column"))) - -(defun org-table-fedit-ref-up () - "Shift the reference at point one row/hline up." - (interactive) - (org-table-fedit-shift-reference 'up)) -(defun org-table-fedit-ref-down () - "Shift the reference at point one row/hline down." - (interactive) - (org-table-fedit-shift-reference 'down)) -(defun org-table-fedit-ref-left () - "Shift the reference at point one field to the left." - (interactive) - (org-table-fedit-shift-reference 'left)) -(defun org-table-fedit-ref-right () - "Shift the reference at point one field to the right." - (interactive) - (org-table-fedit-shift-reference 'right)) - -(defun org-table-fedit-shift-reference (dir) - (cond - ((org-at-regexp-p "\\(\\<[a-zA-Z]\\)&") - (if (memq dir '(left right)) - (org-rematch-and-replace 1 (eq dir 'left)) - (error "Cannot shift reference in this direction"))) - ((org-at-regexp-p "\\(\\<[a-zA-Z]\\{1,2\\}\\)\\([0-9]+\\)") - ;; A B3-like reference - (if (memq dir '(up down)) - (org-rematch-and-replace 2 (eq dir 'up)) - (org-rematch-and-replace 1 (eq dir 'left)))) - ((org-at-regexp-p - "\\(@\\|\\.\\.\\)\\([-+]?\\(I+\\>\\|[0-9]+\\)\\)\\(\\$\\([-+]?[0-9]+\\)\\)?") - ;; An internal reference - (if (memq dir '(up down)) - (org-rematch-and-replace 2 (eq dir 'up) (match-end 3)) - (org-rematch-and-replace 5 (eq dir 'left)))))) - -(defun org-rematch-and-replace (n &optional decr hline) - "Re-match the group N, and replace it with the shifted refrence." - (or (match-end n) (error "Cannot shift reference in this direction")) - (goto-char (match-beginning n)) - (and (looking-at (regexp-quote (match-string n))) - (replace-match (org-shift-refpart (match-string 0) decr hline) - t t))) - -(defun org-shift-refpart (ref &optional decr hline) - "Shift a refrence part REF. -If DECR is set, decrease the references row/column, else increase. -If HLINE is set, this may be a hline reference, it certainly is not -a translation reference." - (save-match-data - (let* ((sign (string-match "^[-+]" ref)) n) - - (if sign (setq sign (substring ref 0 1) ref (substring ref 1))) - (cond - ((and hline (string-match "^I+" ref)) - (setq n (string-to-number (concat sign (number-to-string (length ref))))) - (setq n (+ n (if decr -1 1))) - (if (= n 0) (setq n (+ n (if decr -1 1)))) - (if sign - (setq sign (if (< n 0) "-" "+") n (abs n)) - (setq n (max 1 n))) - (concat sign (make-string n ?I))) - - ((string-match "^[0-9]+" ref) - (setq n (string-to-number (concat sign ref))) - (setq n (+ n (if decr -1 1))) - (if sign - (concat (if (< n 0) "-" "+") (number-to-string (abs n))) - (number-to-string (max 1 n)))) - - ((string-match "^[a-zA-Z]+" ref) - (org-number-to-letters - (max 1 (+ (org-letters-to-number ref) (if decr -1 1))))) - - (t (error "Cannot shift reference")))))) - -(defun org-table-fedit-toggle-coordinates () - "Toggle the display of coordinates in the refrenced table." - (interactive) - (let ((pos (marker-position org-pos))) - (with-current-buffer (marker-buffer org-pos) - (save-excursion - (goto-char pos) - (org-table-toggle-coordinate-overlays))))) - -(defun org-table-fedit-finish (&optional arg) - "Parse the buffer for formula definitions and install them. -With prefix ARG, apply the new formulas to the table." - (interactive "P") - (org-table-remove-rectangle-highlight) - (if org-table-use-standard-references - (progn - (org-table-fedit-convert-buffer 'org-table-convert-refs-to-rc) - (setq org-table-buffer-is-an nil))) - (let ((pos org-pos) eql var form) - (goto-char (point-min)) - (while (re-search-forward - "^\\(@[0-9]+\\$[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)" - nil t) - (setq var (if (match-end 2) (match-string 2) (match-string 1)) - form (match-string 3)) - (setq form (org-trim form)) - (when (not (equal form "")) - (while (string-match "[ \t]*\n[ \t]*" form) - (setq form (replace-match " " t t form))) - (when (assoc var eql) - (error "Double formulas for %s" var)) - (push (cons var form) eql))) - (setq org-pos nil) - (set-window-configuration org-window-configuration) - (select-window (get-buffer-window (marker-buffer pos))) - (goto-char pos) - (unless (org-at-table-p) - (error "Lost table position - cannot install formulae")) - (org-table-store-formulas eql) - (move-marker pos nil) - (kill-buffer "*Edit Formulas*") - (if arg - (org-table-recalculate 'all) - (message "New formulas installed - press C-u C-c C-c to apply.")))) - -(defun org-table-fedit-abort () - "Abort editing formulas, without installing the changes." - (interactive) - (org-table-remove-rectangle-highlight) - (let ((pos org-pos)) - (set-window-configuration org-window-configuration) - (select-window (get-buffer-window (marker-buffer pos))) - (goto-char pos) - (move-marker pos nil) - (message "Formula editing aborted without installing changes"))) - -(defun org-table-fedit-lisp-indent () - "Pretty-print and re-indent Lisp expressions in the Formula Editor." - (interactive) - (let ((pos (point)) beg end ind) - (beginning-of-line 1) - (cond - ((looking-at "[ \t]") - (goto-char pos) - (call-interactively 'lisp-indent-line)) - ((looking-at "[$&@0-9a-zA-Z]+ *= *[^ \t\n']") (goto-char pos)) - ((not (fboundp 'pp-buffer)) - (error "Cannot pretty-print. Command `pp-buffer' is not available.")) - ((looking-at "[$&@0-9a-zA-Z]+ *= *'(") - (goto-char (- (match-end 0) 2)) - (setq beg (point)) - (setq ind (make-string (current-column) ?\ )) - (condition-case nil (forward-sexp 1) - (error - (error "Cannot pretty-print Lisp expression: Unbalanced parenthesis"))) - (setq end (point)) - (save-restriction - (narrow-to-region beg end) - (if (eq last-command this-command) - (progn - (goto-char (point-min)) - (setq this-command nil) - (while (re-search-forward "[ \t]*\n[ \t]*" nil t) - (replace-match " "))) - (pp-buffer) - (untabify (point-min) (point-max)) - (goto-char (1+ (point-min))) - (while (re-search-forward "^." nil t) - (beginning-of-line 1) - (insert ind)) - (goto-char (point-max)) - (backward-delete-char 1))) - (goto-char beg)) - (t nil)))) - -(defvar org-show-positions nil) - -(defun org-table-show-reference (&optional local) - "Show the location/value of the $ expression at point." - (interactive) - (org-table-remove-rectangle-highlight) - (catch 'exit - (let ((pos (if local (point) org-pos)) - (face2 'highlight) - (org-inhibit-highlight-removal t) - (win (selected-window)) - (org-show-positions nil) - var name e what match dest) - (if local (org-table-get-specials)) - (setq what (cond - ((or (org-at-regexp-p org-table-range-regexp2) - (org-at-regexp-p org-table-translate-regexp) - (org-at-regexp-p org-table-range-regexp)) - (setq match - (save-match-data - (org-table-convert-refs-to-rc (match-string 0)))) - 'range) - ((org-at-regexp-p "\\$[a-zA-Z][a-zA-Z0-9]*") 'name) - ((org-at-regexp-p "\\$[0-9]+") 'column) - ((not local) nil) - (t (error "No reference at point"))) - match (and what (or match (match-string 0)))) - (when (and match (not (equal (match-beginning 0) (point-at-bol)))) - (org-table-add-rectangle-overlay (match-beginning 0) (match-end 0) - 'secondary-selection)) - (org-add-hook 'before-change-functions - 'org-table-remove-rectangle-highlight) - (if (eq what 'name) (setq var (substring match 1))) - (when (eq what 'range) - (or (equal (string-to-char match) ?@) (setq match (concat "@" match))) - (setq match (org-table-formula-substitute-names match))) - (unless local - (save-excursion - (end-of-line 1) - (re-search-backward "^\\S-" nil t) - (beginning-of-line 1) - (when (looking-at "\\(\\$[0-9a-zA-Z]+\\|@[0-9]+\\$[0-9]+\\|[a-zA-Z]+\\([0-9]+\\|&\\)\\) *=") - (setq dest - (save-match-data - (org-table-convert-refs-to-rc (match-string 1)))) - (org-table-add-rectangle-overlay - (match-beginning 1) (match-end 1) face2)))) - (if (and (markerp pos) (marker-buffer pos)) - (if (get-buffer-window (marker-buffer pos)) - (select-window (get-buffer-window (marker-buffer pos))) - (org-switch-to-buffer-other-window (get-buffer-window - (marker-buffer pos))))) - (goto-char pos) - (org-table-force-dataline) - (when dest - (setq name (substring dest 1)) - (cond - ((string-match "^\\$[a-zA-Z][a-zA-Z0-9]*" dest) - (setq e (assoc name org-table-named-field-locations)) - (goto-line (nth 1 e)) - (org-table-goto-column (nth 2 e))) - ((string-match "^@\\([0-9]+\\)\\$\\([0-9]+\\)" dest) - (let ((l (string-to-number (match-string 1 dest))) - (c (string-to-number (match-string 2 dest)))) - (goto-line (aref org-table-dlines l)) - (org-table-goto-column c))) - (t (org-table-goto-column (string-to-number name)))) - (move-marker pos (point)) - (org-table-highlight-rectangle nil nil face2)) - (cond - ((equal dest match)) - ((not match)) - ((eq what 'range) - (condition-case nil - (save-excursion - (org-table-get-range match nil nil 'highlight)) - (error nil))) - ((setq e (assoc var org-table-named-field-locations)) - (goto-line (nth 1 e)) - (org-table-goto-column (nth 2 e)) - (org-table-highlight-rectangle (point) (point)) - (message "Named field, column %d of line %d" (nth 2 e) (nth 1 e))) - ((setq e (assoc var org-table-column-names)) - (org-table-goto-column (string-to-number (cdr e))) - (org-table-highlight-rectangle (point) (point)) - (goto-char (org-table-begin)) - (if (re-search-forward (concat "^[ \t]*| *! *.*?| *\\(" var "\\) *|") - (org-table-end) t) - (progn - (goto-char (match-beginning 1)) - (org-table-highlight-rectangle) - (message "Named column (column %s)" (cdr e))) - (error "Column name not found"))) - ((eq what 'column) - ;; column number - (org-table-goto-column (string-to-number (substring match 1))) - (org-table-highlight-rectangle (point) (point)) - (message "Column %s" (substring match 1))) - ((setq e (assoc var org-table-local-parameters)) - (goto-char (org-table-begin)) - (if (re-search-forward (concat "^[ \t]*| *\\$ *.*?| *\\(" var "=\\)") nil t) - (progn - (goto-char (match-beginning 1)) - (org-table-highlight-rectangle) - (message "Local parameter.")) - (error "Parameter not found"))) - (t - (cond - ((not var) (error "No reference at point")) - ((setq e (assoc var org-table-formula-constants-local)) - (message "Local Constant: $%s=%s in #+CONSTANTS line." - var (cdr e))) - ((setq e (assoc var org-table-formula-constants)) - (message "Constant: $%s=%s in `org-table-formula-constants'." - var (cdr e))) - ((setq e (and (fboundp 'constants-get) (constants-get var))) - (message "Constant: $%s=%s, from `constants.el'%s." - var e (format " (%s units)" constants-unit-system))) - (t (error "Undefined name $%s" var))))) - (goto-char pos) - (when (and org-show-positions - (not (memq this-command '(org-table-fedit-scroll - org-table-fedit-scroll-down)))) - (push pos org-show-positions) - (push org-table-current-begin-pos org-show-positions) - (let ((min (apply 'min org-show-positions)) - (max (apply 'max org-show-positions))) - (goto-char min) (recenter 0) - (goto-char max) - (or (pos-visible-in-window-p max) (recenter -1)))) - (select-window win)))) - -(defun org-table-force-dataline () - "Make sure the cursor is in a dataline in a table." - (unless (save-excursion - (beginning-of-line 1) - (looking-at org-table-dataline-regexp)) - (let* ((re org-table-dataline-regexp) - (p1 (save-excursion (re-search-forward re nil 'move))) - (p2 (save-excursion (re-search-backward re nil 'move)))) - (cond ((and p1 p2) - (goto-char (if (< (abs (- p1 (point))) (abs (- p2 (point)))) - p1 p2))) - ((or p1 p2) (goto-char (or p1 p2))) - (t (error "No table dataline around here")))))) - -(defun org-table-fedit-line-up () - "Move cursor one line up in the window showing the table." - (interactive) - (org-table-fedit-move 'previous-line)) - -(defun org-table-fedit-line-down () - "Move cursor one line down in the window showing the table." - (interactive) - (org-table-fedit-move 'next-line)) - -(defun org-table-fedit-move (command) - "Move the cursor in the window shoinw the table. -Use COMMAND to do the motion, repeat if necessary to end up in a data line." - (let ((org-table-allow-automatic-line-recalculation nil) - (pos org-pos) (win (selected-window)) p) - (select-window (get-buffer-window (marker-buffer org-pos))) - (setq p (point)) - (call-interactively command) - (while (and (org-at-table-p) - (org-at-table-hline-p)) - (call-interactively command)) - (or (org-at-table-p) (goto-char p)) - (move-marker pos (point)) - (select-window win))) - -(defun org-table-fedit-scroll (N) - (interactive "p") - (let ((other-window-scroll-buffer (marker-buffer org-pos))) - (scroll-other-window N))) - -(defun org-table-fedit-scroll-down (N) - (interactive "p") - (org-table-fedit-scroll (- N))) - -(defvar org-table-rectangle-overlays nil) - -(defun org-table-add-rectangle-overlay (beg end &optional face) - "Add a new overlay." - (let ((ov (org-make-overlay beg end))) - (org-overlay-put ov 'face (or face 'secondary-selection)) - (push ov org-table-rectangle-overlays))) - -(defun org-table-highlight-rectangle (&optional beg end face) - "Highlight rectangular region in a table." - (setq beg (or beg (point)) end (or end (point))) - (let ((b (min beg end)) - (e (max beg end)) - l1 c1 l2 c2 tmp) - (and (boundp 'org-show-positions) - (setq org-show-positions (cons b (cons e org-show-positions)))) - (goto-char (min beg end)) - (setq l1 (org-current-line) - c1 (org-table-current-column)) - (goto-char (max beg end)) - (setq l2 (org-current-line) - c2 (org-table-current-column)) - (if (> c1 c2) (setq tmp c1 c1 c2 c2 tmp)) - (goto-line l1) - (beginning-of-line 1) - (loop for line from l1 to l2 do - (when (looking-at org-table-dataline-regexp) - (org-table-goto-column c1) - (skip-chars-backward "^|\n") (setq beg (point)) - (org-table-goto-column c2) - (skip-chars-forward "^|\n") (setq end (point)) - (org-table-add-rectangle-overlay beg end face)) - (beginning-of-line 2)) - (goto-char b)) - (add-hook 'before-change-functions 'org-table-remove-rectangle-highlight)) - -(defun org-table-remove-rectangle-highlight (&rest ignore) - "Remove the rectangle overlays." - (unless org-inhibit-highlight-removal - (remove-hook 'before-change-functions 'org-table-remove-rectangle-highlight) - (mapc 'org-delete-overlay org-table-rectangle-overlays) - (setq org-table-rectangle-overlays nil))) - -(defvar org-table-coordinate-overlays nil - "Collects the cooordinate grid overlays, so that they can be removed.") -(make-variable-buffer-local 'org-table-coordinate-overlays) - -(defun org-table-overlay-coordinates () - "Add overlays to the table at point, to show row/column coordinates." - (interactive) - (mapc 'org-delete-overlay org-table-coordinate-overlays) - (setq org-table-coordinate-overlays nil) - (save-excursion - (let ((id 0) (ih 0) hline eol s1 s2 str ic ov beg) - (goto-char (org-table-begin)) - (while (org-at-table-p) - (setq eol (point-at-eol)) - (setq ov (org-make-overlay (point-at-bol) (1+ (point-at-bol)))) - (push ov org-table-coordinate-overlays) - (setq hline (looking-at org-table-hline-regexp)) - (setq str (if hline (format "I*%-2d" (setq ih (1+ ih))) - (format "%4d" (setq id (1+ id))))) - (org-overlay-before-string ov str 'org-special-keyword 'evaporate) - (when hline - (setq ic 0) - (while (re-search-forward "[+|]\\(-+\\)" eol t) - (setq beg (1+ (match-beginning 0)) - ic (1+ ic) - s1 (concat "$" (int-to-string ic)) - s2 (org-number-to-letters ic) - str (if (eq org-table-use-standard-references t) s2 s1)) - (setq ov (org-make-overlay beg (+ beg (length str)))) - (push ov org-table-coordinate-overlays) - (org-overlay-display ov str 'org-special-keyword 'evaporate))) - (beginning-of-line 2))))) - -(defun org-table-toggle-coordinate-overlays () - "Toggle the display of Row/Column numbers in tables." - (interactive) - (setq org-table-overlay-coordinates (not org-table-overlay-coordinates)) - (message "Row/Column number display turned %s" - (if org-table-overlay-coordinates "on" "off")) - (if (and (org-at-table-p) org-table-overlay-coordinates) - (org-table-align)) - (unless org-table-overlay-coordinates - (mapc 'org-delete-overlay org-table-coordinate-overlays) - (setq org-table-coordinate-overlays nil))) - -(defun org-table-toggle-formula-debugger () - "Toggle the formula debugger in tables." - (interactive) - (setq org-table-formula-debug (not org-table-formula-debug)) - (message "Formula debugging has been turned %s" - (if org-table-formula-debug "on" "off"))) - -;;; The orgtbl minor mode - -;; Define a minor mode which can be used in other modes in order to -;; integrate the org-mode table editor. - -;; This is really a hack, because the org-mode table editor uses several -;; keys which normally belong to the major mode, for example the TAB and -;; RET keys. Here is how it works: The minor mode defines all the keys -;; necessary to operate the table editor, but wraps the commands into a -;; function which tests if the cursor is currently inside a table. If that -;; is the case, the table editor command is executed. However, when any of -;; those keys is used outside a table, the function uses `key-binding' to -;; look up if the key has an associated command in another currently active -;; keymap (minor modes, major mode, global), and executes that command. -;; There might be problems if any of the keys used by the table editor is -;; otherwise used as a prefix key. - -;; Another challenge is that the key binding for TAB can be tab or \C-i, -;; likewise the binding for RET can be return or \C-m. Orgtbl-mode -;; addresses this by checking explicitly for both bindings. - -;; The optimized version (see variable `orgtbl-optimized') takes over -;; all keys which are bound to `self-insert-command' in the *global map*. -;; Some modes bind other commands to simple characters, for example -;; AUCTeX binds the double quote to `Tex-insert-quote'. With orgtbl-mode -;; active, this binding is ignored inside tables and replaced with a -;; modified self-insert. - -(defvar orgtbl-mode nil - "Variable controlling `orgtbl-mode', a minor mode enabling the `org-mode' -table editor in arbitrary modes.") -(make-variable-buffer-local 'orgtbl-mode) - -(defvar orgtbl-mode-map (make-keymap) - "Keymap for `orgtbl-mode'.") - -;;;###autoload -(defun turn-on-orgtbl () - "Unconditionally turn on `orgtbl-mode'." - (orgtbl-mode 1)) - -(defvar org-old-auto-fill-inhibit-regexp nil - "Local variable used by `orgtbl-mode'") - -(defconst orgtbl-line-start-regexp "[ \t]*\\(|\\|#\\+\\(TBLFM\\|ORGTBL\\):\\)" - "Matches a line belonging to an orgtbl.") - -(defconst orgtbl-extra-font-lock-keywords - (list (list (concat "^" orgtbl-line-start-regexp ".*") - 0 (quote 'org-table) 'prepend)) - "Extra font-lock-keywords to be added when orgtbl-mode is active.") - -;;;###autoload -(defun orgtbl-mode (&optional arg) - "The `org-mode' table editor as a minor mode for use in other modes." - (interactive) - (if (org-mode-p) - ;; Exit without error, in case some hook functions calls this - ;; by accident in org-mode. - (message "Orgtbl-mode is not useful in org-mode, command ignored") - (setq orgtbl-mode - (if arg (> (prefix-numeric-value arg) 0) (not orgtbl-mode))) - (if orgtbl-mode - (progn - (and (orgtbl-setup) (defun orgtbl-setup () nil)) - ;; Make sure we are first in minor-mode-map-alist - (let ((c (assq 'orgtbl-mode minor-mode-map-alist))) - (and c (setq minor-mode-map-alist - (cons c (delq c minor-mode-map-alist))))) - (org-set-local (quote org-table-may-need-update) t) - (org-add-hook 'before-change-functions 'org-before-change-function - nil 'local) - (org-set-local 'org-old-auto-fill-inhibit-regexp - auto-fill-inhibit-regexp) - (org-set-local 'auto-fill-inhibit-regexp - (if auto-fill-inhibit-regexp - (concat orgtbl-line-start-regexp "\\|" - auto-fill-inhibit-regexp) - orgtbl-line-start-regexp)) - (org-add-to-invisibility-spec '(org-cwidth)) - (when (fboundp 'font-lock-add-keywords) - (font-lock-add-keywords nil orgtbl-extra-font-lock-keywords) - (org-restart-font-lock)) - (easy-menu-add orgtbl-mode-menu) - (run-hooks 'orgtbl-mode-hook)) - (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp) - (org-cleanup-narrow-column-properties) - (org-remove-from-invisibility-spec '(org-cwidth)) - (remove-hook 'before-change-functions 'org-before-change-function t) - (when (fboundp 'font-lock-remove-keywords) - (font-lock-remove-keywords nil orgtbl-extra-font-lock-keywords) - (org-restart-font-lock)) - (easy-menu-remove orgtbl-mode-menu) - (force-mode-line-update 'all)))) - -(defun org-cleanup-narrow-column-properties () - "Remove all properties related to narrow-column invisibility." - (let ((s 1)) - (while (setq s (text-property-any s (point-max) - 'display org-narrow-column-arrow)) - (remove-text-properties s (1+ s) '(display t))) - (setq s 1) - (while (setq s (text-property-any s (point-max) 'org-cwidth 1)) - (remove-text-properties s (1+ s) '(org-cwidth t))) - (setq s 1) - (while (setq s (text-property-any s (point-max) 'invisible 'org-cwidth)) - (remove-text-properties s (1+ s) '(invisible t))))) - -;; Install it as a minor mode. -(put 'orgtbl-mode :included t) -(put 'orgtbl-mode :menu-tag "Org Table Mode") -(add-minor-mode 'orgtbl-mode " OrgTbl" orgtbl-mode-map) - -(defun orgtbl-make-binding (fun n &rest keys) - "Create a function for binding in the table minor mode. -FUN is the command to call inside a table. N is used to create a unique -command name. KEYS are keys that should be checked in for a command -to execute outside of tables." - (eval - (list 'defun - (intern (concat "orgtbl-hijacker-command-" (int-to-string n))) - '(arg) - (concat "In tables, run `" (symbol-name fun) "'.\n" - "Outside of tables, run the binding of `" - (mapconcat (lambda (x) (format "%s" x)) keys "' or `") - "'.") - '(interactive "p") - (list 'if - '(org-at-table-p) - (list 'call-interactively (list 'quote fun)) - (list 'let '(orgtbl-mode) - (list 'call-interactively - (append '(or) - (mapcar (lambda (k) - (list 'key-binding k)) - keys) - '('orgtbl-error)))))))) - -(defun orgtbl-error () - "Error when there is no default binding for a table key." - (interactive) - (error "This key has no function outside tables")) - -(defun orgtbl-setup () - "Setup orgtbl keymaps." - (let ((nfunc 0) - (bindings - (list - '([(meta shift left)] org-table-delete-column) - '([(meta left)] org-table-move-column-left) - '([(meta right)] org-table-move-column-right) - '([(meta shift right)] org-table-insert-column) - '([(meta shift up)] org-table-kill-row) - '([(meta shift down)] org-table-insert-row) - '([(meta up)] org-table-move-row-up) - '([(meta down)] org-table-move-row-down) - '("\C-c\C-w" org-table-cut-region) - '("\C-c\M-w" org-table-copy-region) - '("\C-c\C-y" org-table-paste-rectangle) - '("\C-c-" org-table-insert-hline) - '("\C-c}" org-table-toggle-coordinate-overlays) - '("\C-c{" org-table-toggle-formula-debugger) - '("\C-m" org-table-next-row) - '([(shift return)] org-table-copy-down) - '("\C-c\C-q" org-table-wrap-region) - '("\C-c?" org-table-field-info) - '("\C-c " org-table-blank-field) - '("\C-c+" org-table-sum) - '("\C-c=" org-table-eval-formula) - '("\C-c'" org-table-edit-formulas) - '("\C-c`" org-table-edit-field) - '("\C-c*" org-table-recalculate) - '("\C-c|" org-table-create-or-convert-from-region) - '("\C-c^" org-table-sort-lines) - '([(control ?#)] org-table-rotate-recalc-marks))) - elt key fun cmd) - (while (setq elt (pop bindings)) - (setq nfunc (1+ nfunc)) - (setq key (org-key (car elt)) - fun (nth 1 elt) - cmd (orgtbl-make-binding fun nfunc key)) - (org-defkey orgtbl-mode-map key cmd)) - - ;; Special treatment needed for TAB and RET - (org-defkey orgtbl-mode-map [(return)] - (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m")) - (org-defkey orgtbl-mode-map "\C-m" - (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)])) - - (org-defkey orgtbl-mode-map [(tab)] - (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i")) - (org-defkey orgtbl-mode-map "\C-i" - (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)])) - - (org-defkey orgtbl-mode-map [(shift tab)] - (orgtbl-make-binding 'org-table-previous-field 104 - [(shift tab)] [(tab)] "\C-i")) - - (org-defkey orgtbl-mode-map "\M-\C-m" - (orgtbl-make-binding 'org-table-wrap-region 105 - "\M-\C-m" [(meta return)])) - (org-defkey orgtbl-mode-map [(meta return)] - (orgtbl-make-binding 'org-table-wrap-region 106 - [(meta return)] "\M-\C-m")) - - (org-defkey orgtbl-mode-map "\C-c\C-c" 'orgtbl-ctrl-c-ctrl-c) - (when orgtbl-optimized - ;; If the user wants maximum table support, we need to hijack - ;; some standard editing functions - (org-remap orgtbl-mode-map - 'self-insert-command 'orgtbl-self-insert-command - 'delete-char 'org-delete-char - 'delete-backward-char 'org-delete-backward-char) - (org-defkey orgtbl-mode-map "|" 'org-force-self-insert)) - (easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu" - '("OrgTbl" - ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"] - ["Next Field" org-cycle :active (org-at-table-p) :keys "TAB"] - ["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"] - ["Next Row" org-return :active (org-at-table-p) :keys "RET"] - "--" - ["Blank Field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"] - ["Edit Field" org-table-edit-field :active (org-at-table-p) :keys "C-c ` "] - ["Copy Field from Above" - org-table-copy-down :active (org-at-table-p) :keys "S-RET"] - "--" - ("Column" - ["Move Column Left" org-metaleft :active (org-at-table-p) :keys "M-"] - ["Move Column Right" org-metaright :active (org-at-table-p) :keys "M-"] - ["Delete Column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-"] - ["Insert Column" org-shiftmetaright :active (org-at-table-p) :keys "M-S-"]) - ("Row" - ["Move Row Up" org-metaup :active (org-at-table-p) :keys "M-"] - ["Move Row Down" org-metadown :active (org-at-table-p) :keys "M-"] - ["Delete Row" org-shiftmetaup :active (org-at-table-p) :keys "M-S-"] - ["Insert Row" org-shiftmetadown :active (org-at-table-p) :keys "M-S-"] - ["Sort lines in region" org-table-sort-lines (org-at-table-p) :keys "C-c ^"] - "--" - ["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"]) - ("Rectangle" - ["Copy Rectangle" org-copy-special :active (org-at-table-p)] - ["Cut Rectangle" org-cut-special :active (org-at-table-p)] - ["Paste Rectangle" org-paste-special :active (org-at-table-p)] - ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p)]) - "--" - ("Radio tables" - ["Insert table template" orgtbl-insert-radio-table - (assq major-mode orgtbl-radio-table-templates)] - ["Comment/uncomment table" orgtbl-toggle-comment t]) - "--" - ["Set Column Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="] - ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="] - ["Edit Formulas" org-table-edit-formulas :active (org-at-table-p) :keys "C-c '"] - ["Recalculate line" org-table-recalculate :active (org-at-table-p) :keys "C-c *"] - ["Recalculate all" (org-table-recalculate '(4)) :active (org-at-table-p) :keys "C-u C-c *"] - ["Iterate all" (org-table-recalculate '(16)) :active (org-at-table-p) :keys "C-u C-u C-c *"] - ["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"] - ["Sum Column/Rectangle" org-table-sum - :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"] - ["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"] - ["Debug Formulas" - org-table-toggle-formula-debugger :active (org-at-table-p) - :keys "C-c {" - :style toggle :selected org-table-formula-debug] - ["Show Col/Row Numbers" - org-table-toggle-coordinate-overlays :active (org-at-table-p) - :keys "C-c }" - :style toggle :selected org-table-overlay-coordinates] - )) - t)) - -(defun orgtbl-ctrl-c-ctrl-c (arg) - "If the cursor is inside a table, realign the table. -It it is a table to be sent away to a receiver, do it. -With prefix arg, also recompute table." - (interactive "P") - (let ((pos (point)) action) - (save-excursion - (beginning-of-line 1) - (setq action (cond ((looking-at "#\\+ORGTBL:.*\n[ \t]*|") (match-end 0)) - ((looking-at "[ \t]*|") pos) - ((looking-at "#\\+TBLFM:") 'recalc)))) - (cond - ((integerp action) - (goto-char action) - (org-table-maybe-eval-formula) - (if arg - (call-interactively 'org-table-recalculate) - (org-table-maybe-recalculate-line)) - (call-interactively 'org-table-align) - (orgtbl-send-table 'maybe)) - ((eq action 'recalc) - (save-excursion - (beginning-of-line 1) - (skip-chars-backward " \r\n\t") - (if (org-at-table-p) - (org-call-with-arg 'org-table-recalculate t)))) - (t (let (orgtbl-mode) - (call-interactively (key-binding "\C-c\C-c"))))))) - -(defun orgtbl-tab (arg) - "Justification and field motion for `orgtbl-mode'." - (interactive "P") - (if arg (org-table-edit-field t) - (org-table-justify-field-maybe) - (org-table-next-field))) - -(defun orgtbl-ret () - "Justification and field motion for `orgtbl-mode'." - (interactive) - (org-table-justify-field-maybe) - (org-table-next-row)) - -(defun orgtbl-self-insert-command (N) - "Like `self-insert-command', use overwrite-mode for whitespace in tables. -If the cursor is in a table looking at whitespace, the whitespace is -overwritten, and the table is not marked as requiring realignment." - (interactive "p") - (if (and (org-at-table-p) - (or - (and org-table-auto-blank-field - (member last-command - '(orgtbl-hijacker-command-100 - orgtbl-hijacker-command-101 - orgtbl-hijacker-command-102 - orgtbl-hijacker-command-103 - orgtbl-hijacker-command-104 - orgtbl-hijacker-command-105)) - (org-table-blank-field)) - t) - (eq N 1) - (looking-at "[^|\n]* +|")) - (let (org-table-may-need-update) - (goto-char (1- (match-end 0))) - (delete-backward-char 1) - (goto-char (match-beginning 0)) - (self-insert-command N)) - (setq org-table-may-need-update t) - (let (orgtbl-mode) - (call-interactively (key-binding (vector last-input-event)))))) - -(defun org-force-self-insert (N) - "Needed to enforce self-insert under remapping." - (interactive "p") - (self-insert-command N)) - -(defvar orgtbl-exp-regexp "^\\([-+]?[0-9][0-9.]*\\)[eE]\\([-+]?[0-9]+\\)$" - "Regula expression matching exponentials as produced by calc.") - -(defvar org-table-clean-did-remove-column nil) - -(defun orgtbl-export (table target) - (let ((func (intern (concat "orgtbl-to-" (symbol-name target)))) - (lines (org-split-string table "[ \t]*\n[ \t]*")) - org-table-last-alignment org-table-last-column-widths - maxcol column) - (if (not (fboundp func)) - (error "Cannot export orgtbl table to %s" target)) - (setq lines (org-table-clean-before-export lines)) - (setq table - (mapcar - (lambda (x) - (if (string-match org-table-hline-regexp x) - 'hline - (org-split-string (org-trim x) "\\s-*|\\s-*"))) - lines)) - (setq maxcol (apply 'max (mapcar (lambda (x) (if (listp x) (length x) 0)) - table))) - (loop for i from (1- maxcol) downto 0 do - (setq column (mapcar (lambda (x) (if (listp x) (nth i x) nil)) table)) - (setq column (delq nil column)) - (push (apply 'max (mapcar 'string-width column)) org-table-last-column-widths) - (push (> (/ (apply '+ (mapcar (lambda (x) (if (string-match org-table-number-regexp x) 1 0)) column)) maxcol) org-table-number-fraction) org-table-last-alignment)) - (funcall func table nil))) - -(defun orgtbl-send-table (&optional maybe) - "Send a tranformed version of this table to the receiver position. -With argument MAYBE, fail quietly if no transformation is defined for -this table." - (interactive) - (catch 'exit - (unless (org-at-table-p) (error "Not at a table")) - ;; when non-interactive, we assume align has just happened. - (when (interactive-p) (org-table-align)) - (save-excursion - (goto-char (org-table-begin)) - (beginning-of-line 0) - (unless (looking-at "#\\+ORGTBL: *SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?") - (if maybe - (throw 'exit nil) - (error "Don't know how to transform this table.")))) - (let* ((name (match-string 1)) - beg - (transform (intern (match-string 2))) - (params (if (match-end 3) (read (concat "(" (match-string 3) ")")))) - (skip (plist-get params :skip)) - (skipcols (plist-get params :skipcols)) - (txt (buffer-substring-no-properties - (org-table-begin) (org-table-end))) - (lines (nthcdr (or skip 0) (org-split-string txt "[ \t]*\n[ \t]*"))) - (lines (org-table-clean-before-export lines)) - (i0 (if org-table-clean-did-remove-column 2 1)) - (table (mapcar - (lambda (x) - (if (string-match org-table-hline-regexp x) - 'hline - (org-remove-by-index - (org-split-string (org-trim x) "\\s-*|\\s-*") - skipcols i0))) - lines)) - (fun (if (= i0 2) 'cdr 'identity)) - (org-table-last-alignment - (org-remove-by-index (funcall fun org-table-last-alignment) - skipcols i0)) - (org-table-last-column-widths - (org-remove-by-index (funcall fun org-table-last-column-widths) - skipcols i0))) - - (unless (fboundp transform) - (error "No such transformation function %s" transform)) - (setq txt (funcall transform table params)) - ;; Find the insertion place - (save-excursion - (goto-char (point-min)) - (unless (re-search-forward - (concat "BEGIN RECEIVE ORGTBL +" name "\\([ \t]\\|$\\)") nil t) - (error "Don't know where to insert translated table")) - (goto-char (match-beginning 0)) - (beginning-of-line 2) - (setq beg (point)) - (unless (re-search-forward (concat "END RECEIVE ORGTBL +" name) nil t) - (error "Cannot find end of insertion region")) - (beginning-of-line 1) - (delete-region beg (point)) - (goto-char beg) - (insert txt "\n")) - (message "Table converted and installed at receiver location")))) - -(defun org-remove-by-index (list indices &optional i0) - "Remove the elements in LIST with indices in INDICES. -First element has index 0, or I0 if given." - (if (not indices) - list - (if (integerp indices) (setq indices (list indices))) - (setq i0 (1- (or i0 0))) - (delq :rm (mapcar (lambda (x) - (setq i0 (1+ i0)) - (if (memq i0 indices) :rm x)) - list)))) - -(defun orgtbl-toggle-comment () - "Comment or uncomment the orgtbl at point." - (interactive) - (let* ((re1 (concat "^" (regexp-quote comment-start) orgtbl-line-start-regexp)) - (re2 (concat "^" orgtbl-line-start-regexp)) - (commented (save-excursion (beginning-of-line 1) - (cond ((looking-at re1) t) - ((looking-at re2) nil) - (t (error "Not at an org table"))))) - (re (if commented re1 re2)) - beg end) - (save-excursion - (beginning-of-line 1) - (while (looking-at re) (beginning-of-line 0)) - (beginning-of-line 2) - (setq beg (point)) - (while (looking-at re) (beginning-of-line 2)) - (setq end (point))) - (comment-region beg end (if commented '(4) nil)))) - -(defun orgtbl-insert-radio-table () - "Insert a radio table template appropriate for this major mode." - (interactive) - (let* ((e (assq major-mode orgtbl-radio-table-templates)) - (txt (nth 1 e)) - name pos) - (unless e (error "No radio table setup defined for %s" major-mode)) - (setq name (read-string "Table name: ")) - (while (string-match "%n" txt) - (setq txt (replace-match name t t txt))) - (or (bolp) (insert "\n")) - (setq pos (point)) - (insert txt) - (goto-char pos))) - -(defun org-get-param (params header i sym &optional hsym) - "Get parameter value for symbol SYM. -If this is a header line, actually get the value for the symbol with an -additional \"h\" inserted after the colon. -If the value is a protperty list, get the element for the current column. -Assumes variables VAL, PARAMS, HEAD and I to be scoped into the function." - (let ((val (plist-get params sym))) - (and hsym header (setq val (or (plist-get params hsym) val))) - (if (consp val) (plist-get val i) val))) - -(defun orgtbl-to-generic (table params) - "Convert the orgtbl-mode TABLE to some other format. -This generic routine can be used for many standard cases. -TABLE is a list, each entry either the symbol `hline' for a horizontal -separator line, or a list of fields for that line. -PARAMS is a property list of parameters that can influence the conversion. -For the generic converter, some parameters are obligatory: You need to -specify either :lfmt, or all of (:lstart :lend :sep). If you do not use -:splice, you must have :tstart and :tend. - -Valid parameters are - -:tstart String to start the table. Ignored when :splice is t. -:tend String to end the table. Ignored when :splice is t. - -:splice When set to t, return only table body lines, don't wrap - them into :tstart and :tend. Default is nil. - -:hline String to be inserted on horizontal separation lines. - May be nil to ignore hlines. - -:lstart String to start a new table line. -:lend String to end a table line -:sep Separator between two fields -:lfmt Format for entire line, with enough %s to capture all fields. - If this is present, :lstart, :lend, and :sep are ignored. -:fmt A format to be used to wrap the field, should contain - %s for the original field value. For example, to wrap - everything in dollars, you could use :fmt \"$%s$\". - This may also be a property list with column numbers and - formats. for example :fmt (2 \"$%s$\" 4 \"%s%%\") - -:hlstart :hlend :hlsep :hlfmt :hfmt - Same as above, specific for the header lines in the table. - All lines before the first hline are treated as header. - If any of these is not present, the data line value is used. - -:efmt Use this format to print numbers with exponentials. - The format should have %s twice for inserting mantissa - and exponent, for example \"%s\\\\times10^{%s}\". This - may also be a property list with column numbers and - formats. :fmt will still be applied after :efmt. - -In addition to this, the parameters :skip and :skipcols are always handled -directly by `orgtbl-send-table'. See manual." - (interactive) - (let* ((p params) - (splicep (plist-get p :splice)) - (hline (plist-get p :hline)) - rtn line i fm efm lfmt h) - - ;; Do we have a header? - (if (and (not splicep) (listp (car table)) (memq 'hline table)) - (setq h t)) - - ;; Put header - (unless splicep - (push (or (plist-get p :tstart) "ERROR: no :tstart") rtn)) - - ;; Now loop over all lines - (while (setq line (pop table)) - (if (eq line 'hline) - ;; A horizontal separator line - (progn (if hline (push hline rtn)) - (setq h nil)) ; no longer in header - ;; A normal line. Convert the fields, push line onto the result list - (setq i 0) - (setq line - (mapcar - (lambda (f) - (setq i (1+ i) - fm (org-get-param p h i :fmt :hfmt) - efm (org-get-param p h i :efmt)) - (if (and efm (string-match orgtbl-exp-regexp f)) - (setq f (format - efm (match-string 1 f) (match-string 2 f)))) - (if fm (setq f (format fm f))) - f) - line)) - (if (setq lfmt (org-get-param p h i :lfmt :hlfmt)) - (push (apply 'format lfmt line) rtn) - (push (concat - (org-get-param p h i :lstart :hlstart) - (mapconcat 'identity line (org-get-param p h i :sep :hsep)) - (org-get-param p h i :lend :hlend)) - rtn)))) - - (unless splicep - (push (or (plist-get p :tend) "ERROR: no :tend") rtn)) - - (mapconcat 'identity (nreverse rtn) "\n"))) - -(defun orgtbl-to-latex (table params) - "Convert the orgtbl-mode TABLE to LaTeX. -TABLE is a list, each entry either the symbol `hline' for a horizontal -separator line, or a list of fields for that line. -PARAMS is a property list of parameters that can influence the conversion. -Supports all parameters from `orgtbl-to-generic'. Most important for -LaTeX are: - -:splice When set to t, return only table body lines, don't wrap - them into a tabular environment. Default is nil. - -:fmt A format to be used to wrap the field, should contain %s for the - original field value. For example, to wrap everything in dollars, - use :fmt \"$%s$\". This may also be a property list with column - numbers and formats. for example :fmt (2 \"$%s$\" 4 \"%s%%\") - -:efmt Format for transforming numbers with exponentials. The format - should have %s twice for inserting mantissa and exponent, for - example \"%s\\\\times10^{%s}\". LaTeX default is \"%s\\\\,(%s)\". - This may also be a property list with column numbers and formats. - -The general parameters :skip and :skipcols have already been applied when -this function is called." - (let* ((alignment (mapconcat (lambda (x) (if x "r" "l")) - org-table-last-alignment "")) - (params2 - (list - :tstart (concat "\\begin{tabular}{" alignment "}") - :tend "\\end{tabular}" - :lstart "" :lend " \\\\" :sep " & " - :efmt "%s\\,(%s)" :hline "\\hline"))) - (orgtbl-to-generic table (org-combine-plists params2 params)))) - -(defun orgtbl-to-html (table params) - "Convert the orgtbl-mode TABLE to LaTeX. -TABLE is a list, each entry either the symbol `hline' for a horizontal -separator line, or a list of fields for that line. -PARAMS is a property list of parameters that can influence the conversion. -Currently this function recognizes the following parameters: - -:splice When set to t, return only table body lines, don't wrap - them into a
" . "" . "
environment. Default is nil. - -The general parameters :skip and :skipcols have already been applied when -this function is called. The function does *not* use `orgtbl-to-generic', -so you cannot specify parameters for it." - (let* ((splicep (plist-get params :splice)) - html) - ;; Just call the formatter we already have - ;; We need to make text lines for it, so put the fields back together. - (setq html (org-format-org-table-html - (mapcar - (lambda (x) - (if (eq x 'hline) - "|----+----|" - (concat "| " (mapconcat 'identity x " | ") " |"))) - table) - splicep)) - (if (string-match "\n+\\'" html) - (setq html (replace-match "" t t html))) - html)) - -(defun orgtbl-to-texinfo (table params) - "Convert the orgtbl-mode TABLE to TeXInfo. -TABLE is a list, each entry either the symbol `hline' for a horizontal -separator line, or a list of fields for that line. -PARAMS is a property list of parameters that can influence the conversion. -Supports all parameters from `orgtbl-to-generic'. Most important for -TeXInfo are: - -:splice nil/t When set to t, return only table body lines, don't wrap - them into a multitable environment. Default is nil. - -:fmt fmt A format to be used to wrap the field, should contain - %s for the original field value. For example, to wrap - everything in @kbd{}, you could use :fmt \"@kbd{%s}\". - This may also be a property list with column numbers and - formats. for example :fmt (2 \"@kbd{%s}\" 4 \"@code{%s}\"). - -:cf \"f1 f2..\" The column fractions for the table. Bye default these - are computed automatically from the width of the columns - under org-mode. - -The general parameters :skip and :skipcols have already been applied when -this function is called." - (let* ((total (float (apply '+ org-table-last-column-widths))) - (colfrac (or (plist-get params :cf) - (mapconcat - (lambda (x) (format "%.3f" (/ (float x) total))) - org-table-last-column-widths " "))) - (params2 - (list - :tstart (concat "@multitable @columnfractions " colfrac) - :tend "@end multitable" - :lstart "@item " :lend "" :sep " @tab " - :hlstart "@headitem "))) - (orgtbl-to-generic table (org-combine-plists params2 params)))) - -;;;; Link Stuff - -;;; Link abbreviations - -(defun org-link-expand-abbrev (link) - "Apply replacements as defined in `org-link-abbrev-alist." - (if (string-match "^\\([a-zA-Z][-_a-zA-Z0-9]*\\)\\(::?\\(.*\\)\\)?$" link) - (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 "%s" rpl) (replace-match (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'.") - -(defvar org-link-protocols nil - "Link protocols added to Org-mode using `org-add-link-type'.") - -(defvar org-store-link-functions nil - "List of functions that are called to create and store a link. -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 a 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 remember templates.") - -(defun org-add-link-type (type &optional follow publish) - "Add TYPE to the list of `org-link-types'. -Re-compute all regular expressions depending on `org-link-types' -FOLLOW and PUBLISH are two functions. Both take the link path as -an argument. -FOLLOW should do whatever is necessary to follow the link, for example -to find a file or display a mail message. - -PUBLISH takes the path and retuns the string that should be used when -this document is published. FIMXE: This is actually not yet implemented." - (add-to-list 'org-link-types type t) - (org-make-link-regexps) - (add-to-list 'org-link-protocols - (list type follow publish))) - -(defun org-add-agenda-custom-command (entry) - "Replace or add a command in `org-agenda-custom-commands'. -This is mostly for hacking and trying a new command - once the command -works you probably want to add it to `org-agenda-custom-commands' for good." - (let ((ass (assoc (car entry) org-agenda-custom-commands))) - (if ass - (setcdr ass (cdr entry)) - (push entry org-agenda-custom-commands)))) - -;;;###autoload -(defun org-store-link (arg) - "\\Store an org-link to the current location. -This link can later be inserted into an org-buffer with -\\[org-insert-link]. -For some link types, a prefix arg is interpreted: -For links to usenet articles, arg negates `org-usenet-links-prefer-google'. -For file links, arg negates `org-context-in-file-links'." - (interactive "P") - (setq org-store-link-plist nil) ; reset - (let (link cpltxt desc description search txt) - (cond - - ((run-hook-with-args-until-success 'org-store-link-functions) - (setq link (plist-get org-store-link-plist :link) - desc (or (plist-get org-store-link-plist :description) link))) - - ((eq major-mode 'bbdb-mode) - (let ((name (bbdb-record-name (bbdb-current-record))) - (company (bbdb-record-getprop (bbdb-current-record) 'company))) - (setq cpltxt (concat "bbdb:" (or name company)) - link (org-make-link cpltxt)) - (org-store-link-props :type "bbdb" :name name :company company))) - - ((eq major-mode 'Info-mode) - (setq link (org-make-link "info:" - (file-name-nondirectory Info-current-file) - ":" Info-current-node)) - (setq cpltxt (concat (file-name-nondirectory Info-current-file) - ":" Info-current-node)) - (org-store-link-props :type "info" :file Info-current-file - :node Info-current-node)) - - ((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))) - - ((or (eq major-mode 'vm-summary-mode) - (eq major-mode 'vm-presentation-mode)) - (and (eq major-mode 'vm-presentation-mode) (vm-summarize)) - (vm-follow-summary-cursor) - (save-excursion - (vm-select-folder-buffer) - (let* ((message (car vm-message-pointer)) - (folder buffer-file-name) - (subject (vm-su-subject message)) - (to (vm-get-header-contents message "To")) - (from (vm-get-header-contents message "From")) - (message-id (vm-su-message-id message))) - (org-store-link-props :type "vm" :from from :to to :subject subject - :message-id message-id) - (setq message-id (org-remove-angle-brackets message-id)) - (setq folder (abbreviate-file-name folder)) - (if (string-match (concat "^" (regexp-quote vm-folder-directory)) - folder) - (setq folder (replace-match "" t t folder))) - (setq cpltxt (org-email-link-description)) - (setq link (org-make-link "vm:" folder "#" message-id))))) - - ((eq major-mode 'wl-summary-mode) - (let* ((msgnum (wl-summary-message-number)) - (message-id (elmo-message-field wl-summary-buffer-elmo-folder - msgnum 'message-id)) - (wl-message-entity - (if (fboundp 'elmo-message-entity) - (elmo-message-entity - wl-summary-buffer-elmo-folder msgnum) - (elmo-msgdb-overview-get-entity - msgnum (wl-summary-buffer-msgdb)))) - (from (wl-summary-line-from)) - (to (car (elmo-message-entity-field wl-message-entity 'to))) - (subject (let (wl-thr-indent-string wl-parent-message-entity) - (wl-summary-line-subject)))) - (org-store-link-props :type "wl" :from from :to to - :subject subject :message-id message-id) - (setq message-id (org-remove-angle-brackets message-id)) - (setq cpltxt (org-email-link-description)) - (setq link (org-make-link "wl:" wl-summary-buffer-folder-name - "#" message-id)))) - - ((or (equal major-mode 'mh-folder-mode) - (equal major-mode 'mh-show-mode)) - (let ((from (org-mhe-get-header "From:")) - (to (org-mhe-get-header "To:")) - (message-id (org-mhe-get-header "Message-Id:")) - (subject (org-mhe-get-header "Subject:"))) - (org-store-link-props :type "mh" :from from :to to - :subject subject :message-id message-id) - (setq cpltxt (org-email-link-description)) - (setq link (org-make-link "mhe:" (org-mhe-get-message-real-folder) "#" - (org-remove-angle-brackets message-id))))) - - ((eq major-mode 'rmail-mode) - (save-excursion - (save-restriction - (rmail-narrow-to-non-pruned-header) - (let ((folder buffer-file-name) - (message-id (mail-fetch-field "message-id")) - (from (mail-fetch-field "from")) - (to (mail-fetch-field "to")) - (subject (mail-fetch-field "subject"))) - (org-store-link-props - :type "rmail" :from from :to to - :subject subject :message-id message-id) - (setq message-id (org-remove-angle-brackets message-id)) - (setq cpltxt (org-email-link-description)) - (setq link (org-make-link "rmail:" folder "#" message-id)))))) - - ((eq major-mode 'gnus-group-mode) - (let ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus - (gnus-group-group-name)) ; version - ((fboundp 'gnus-group-name) - (gnus-group-name)) - (t "???")))) - (unless group (error "Not on a group")) - (org-store-link-props :type "gnus" :group group) - (setq cpltxt (concat - (if (org-xor arg org-usenet-links-prefer-google) - "http://groups.google.com/groups?group=" - "gnus:") - group) - link (org-make-link cpltxt)))) - - ((memq major-mode '(gnus-summary-mode gnus-article-mode)) - (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary)) - (let* ((group gnus-newsgroup-name) - (article (gnus-summary-article-number)) - (header (gnus-summary-article-header article)) - (from (mail-header-from header)) - (message-id (mail-header-id header)) - (date (mail-header-date header)) - (subject (gnus-summary-subject-string))) - (org-store-link-props :type "gnus" :from from :subject subject - :message-id message-id :group group) - (setq cpltxt (org-email-link-description)) - (if (org-xor arg org-usenet-links-prefer-google) - (setq link - (concat - cpltxt "\n " - (format "http://groups.google.com/groups?as_umsgid=%s" - (org-fixup-message-id-for-http message-id)))) - (setq link (org-make-link "gnus:" group - "#" (number-to-string article)))))) - - ((eq major-mode 'w3-mode) - (setq cpltxt (url-view-url t) - link (org-make-link cpltxt)) - (org-store-link-props :type "w3" :url (url-view-url t))) - - ((eq major-mode 'w3m-mode) - (setq cpltxt (or w3m-current-title w3m-current-url) - link (org-make-link w3m-current-url)) - (org-store-link-props :type "w3m" :url (url-view-url t))) - - ((setq search (run-hook-with-args-until-success - 'org-create-file-search-functions)) - (setq link (concat "file:" (abbreviate-file-name buffer-file-name) - "::" search)) - (setq cpltxt (or description link))) - - ((eq major-mode 'image-mode) - (setq cpltxt (concat "file:" - (abbreviate-file-name buffer-file-name)) - link (org-make-link cpltxt)) - (org-store-link-props :type "image" :file buffer-file-name)) - - ((eq major-mode 'dired-mode) - ;; link to the file in the current line - (setq cpltxt (concat "file:" - (abbreviate-file-name - (expand-file-name - (dired-get-filename nil t)))) - link (org-make-link cpltxt))) - - ((and buffer-file-name (org-mode-p)) - ;; Just link to current headline - (setq cpltxt (concat "file:" - (abbreviate-file-name buffer-file-name))) - ;; Add a context search string - (when (org-xor org-context-in-file-links arg) - ;; Check if we are on a target - (if (org-in-regexp "<<\\(.*?\\)>>") - (setq cpltxt (concat cpltxt "::" (match-string 1))) - (setq txt (cond - ((org-on-heading-p) nil) - ((org-region-active-p) - (buffer-substring (region-beginning) (region-end))) - (t (buffer-substring (point-at-bol) (point-at-eol))))) - (when (or (null txt) (string-match "\\S-" txt)) - (setq cpltxt - (concat cpltxt "::" (org-make-org-heading-search-string txt)) - desc "NONE")))) - (if (string-match "::\\'" cpltxt) - (setq cpltxt (substring cpltxt 0 -2))) - (setq link (org-make-link cpltxt))) - - ((buffer-file-name (buffer-base-buffer)) - ;; Just link to this file here. - (setq cpltxt (concat "file:" - (abbreviate-file-name - (buffer-file-name (buffer-base-buffer))))) - ;; Add a context string - (when (org-xor org-context-in-file-links arg) - (setq txt (if (org-region-active-p) - (buffer-substring (region-beginning) (region-end)) - (buffer-substring (point-at-bol) (point-at-eol)))) - ;; Only use search option if there is some text. - (when (string-match "\\S-" txt) - (setq cpltxt - (concat cpltxt "::" (org-make-org-heading-search-string txt)) - desc "NONE"))) - (setq link (org-make-link cpltxt))) - - ((interactive-p) - (error "Cannot link to a buffer which is not visiting a file")) - - (t (setq link nil))) - - (if (consp link) (setq cpltxt (car link) link (cdr link))) - (setq link (or link cpltxt) - desc (or desc cpltxt)) - (if (equal desc "NONE") (setq desc nil)) - - (if (and (interactive-p) link) - (progn - (setq org-stored-links - (cons (list link desc) org-stored-links)) - (message "Stored: %s" (or desc link))) - (and link (org-make-link-string link desc))))) - -(defun org-store-link-props (&rest plist) - "Store link properties, extract names and addresses." - (let (x adr) - (when (setq x (plist-get plist :from)) - (setq adr (mail-extract-address-components x)) - (plist-put plist :fromname (car adr)) - (plist-put plist :fromaddress (nth 1 adr))) - (when (setq x (plist-get plist :to)) - (setq adr (mail-extract-address-components x)) - (plist-put plist :toname (car adr)) - (plist-put plist :toaddress (nth 1 adr)))) - (let ((from (plist-get plist :from)) - (to (plist-get plist :to))) - (when (and from to org-from-is-user-regexp) - (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-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 "%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 heading) - "Make search string for STRING or current headline." - (interactive) - (let ((s (or string (org-get-heading)))) - (unless (and string (not heading)) - ;; We are using a headline, clean up garbage in there. - (if (string-match org-todo-regexp s) - (setq s (replace-match "" t t s))) - (if (string-match (org-re ":[[:alnum:]_@:]+:[ \t]*$") s) - (setq s (replace-match "" t t s))) - (setq s (org-trim s)) - (if (string-match (concat "^\\(" org-quote-string "\\|" - org-comment-string "\\)") s) - (setq s (replace-match "" t t s))) - (while (string-match org-ts-regexp s) - (setq s (replace-match "" t t s)))) - (while (string-match "[^a-zA-Z_0-9 \t]+" s) - (setq s (replace-match " " t t s))) - (or string (setq s (concat "*" s))) ; Add * for headlines - (mapconcat 'identity (org-split-string s "[ \t]+") " "))) - -(defun org-make-link (&rest strings) - "Concatenate STRINGS." - (apply 'concat strings)) - -(defun org-make-link-string (link &optional description) - "Make a link with brackets, consisting of LINK and DESCRIPTION." - (unless (string-match "\\S-" link) - (error "Empty link")) - (when (stringp description) - ;; Remove brackets from the description, they are fatal. - (while (string-match "\\[" description) - (setq description (replace-match "{" t t description))) - (while (string-match "\\]" description) - (setq description (replace-match "}" t t description)))) - (when (equal (org-link-escape link) description) - ;; No description needed, it is identical - (setq description nil)) - (when (and (not description) - (not (equal link (org-link-escape link)))) - (setq description link)) - (concat "[[" (org-link-escape link) "]" - (if description (concat "[" description "]") "") - "]")) - -(defconst org-link-escape-chars - '((?\ . "%20") - (?\[ . "%5B") - (?\] . "%5D") - (?\340 . "%E0") ; `a - (?\342 . "%E2") ; ^a - (?\347 . "%E7") ; ,c - (?\350 . "%E8") ; `e - (?\351 . "%E9") ; 'e - (?\352 . "%EA") ; ^e - (?\356 . "%EE") ; ^i - (?\364 . "%F4") ; ^o - (?\371 . "%F9") ; `u - (?\373 . "%FB") ; ^u - (?\; . "%3B") - (?? . "%3F") - (?= . "%3D") - (?+ . "%2B") - ) - "Association list of escapes for some characters problematic in links. -This is the list that is used for internal purposes.") - -(defconst org-link-escape-chars-browser - '((?\ . "%20")) ; 32 for the SPC char - "Association list of escapes for some characters problematic in links. -This is the list that is used before handing over to the browser.") - -(defun org-link-escape (text &optional table) - "Escape charaters in TEXT that are problematic for links." - (setq table (or table org-link-escape-chars)) - (when text - (let ((re (mapconcat (lambda (x) (regexp-quote - (char-to-string (car x)))) - table "\\|"))) - (while (string-match re text) - (setq text - (replace-match - (cdr (assoc (string-to-char (match-string 0 text)) - table)) - t t text))) - text))) - -(defun org-link-unescape (text &optional table) - "Reverse the action of `org-link-escape'." - (setq table (or table org-link-escape-chars)) - (when text - (let ((re (mapconcat (lambda (x) (regexp-quote (cdr x))) - table "\\|"))) - (while (string-match re text) - (setq text - (replace-match - (char-to-string (car (rassoc (match-string 0 text) table))) - t t text))) - text))) - -(defun org-xor (a b) - "Exclusive or." - (if a (not b) b)) - -(defun org-get-header (header) - "Find a header field in the current buffer." - (save-excursion - (goto-char (point-min)) - (let ((case-fold-search t) s) - (cond - ((eq header 'from) - (if (re-search-forward "^From:\\s-+\\(.*\\)" nil t) - (setq s (match-string 1))) - (while (string-match "\"" s) - (setq s (replace-match "" t t s))) - (if (string-match "[<(].*" s) - (setq s (replace-match "" t t s)))) - ((eq header 'message-id) - (if (re-search-forward "^message-id:\\s-+\\(.*\\)" nil t) - (setq s (match-string 1)))) - ((eq header 'subject) - (if (re-search-forward "^subject:\\s-+\\(.*\\)" nil t) - (setq s (match-string 1))))) - (if (string-match "\\`[ \t\]+" s) (setq s (replace-match "" t t s))) - (if (string-match "[ \t\]+\\'" s) (setq s (replace-match "" t t s))) - s))) - - -(defun org-fixup-message-id-for-http (s) - "Replace special characters in a message id, so it can be used in an http query." - (while (string-match "<" s) - (setq s (replace-match "%3C" t t s))) - (while (string-match ">" s) - (setq s (replace-match "%3E" t t s))) - (while (string-match "@" s) - (setq s (replace-match "%40" t t s))) - s) - -;;;###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-mode syntax." - (interactive) - (org-run-like-in-org-mode 'org-insert-link)) - -(defun org-insert-link (&optional complete-file) - "Insert a link. At the prompt, enter the link. - -Completion can be used to select a link previously stored with -`org-store-link'. When the empty string is entered (i.e. if you just -press RET at the prompt), the link defaults to the most recently -stored link. As SPC triggers completion in the minibuffer, you need to -use M-SPC or C-q SPC to force the insertion of a space character. - -You will also be prompted for a description, and if one is given, it will -be displayed in the buffer instead of the link. - -If there is already a link at point, this command will allow you to edit link -and description parts. - -With a \\[universal-argument] prefix, prompts for a file to link to. The file name can be -selected using completion. The path to the file will be relative to -the current directory if the file is in the current directory or a -subdirectory. Otherwise, the link will be the absolute path as -completed in the minibuffer (i.e. normally ~/path/to/file). - -With two \\[universal-argument] prefixes, enforce an absolute path even if the file -is in the current directory or below. -With three \\[universal-argument] prefixes, negate the meaning of -`org-keep-stored-link-after-insertion'." - (interactive "P") - (let* ((wcf (current-window-configuration)) - (region (if (org-region-active-p) - (buffer-substring (region-beginning) (region-end)))) - (remove (and region (list (region-beginning) (region-end)))) - (desc region) - tmphist ; byte-compile incorrectly complains about this - link entry file) - (cond - ((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 (if (match-end 3) (org-match-string-no-properties 3))) - (setq link (read-string "Link: " - (org-link-unescape - (org-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-remove-angle-brackets (match-string 0))))) - ((equal complete-file '(4)) - ;; Completing read for file names. - (setq file (read-file-name "File: ")) - (let ((pwd (file-name-as-directory (expand-file-name "."))) - (pwd1 (file-name-as-directory (abbreviate-file-name - (expand-file-name "."))))) - (cond - ((equal complete-file '(16)) - (setq link (org-make-link - "file:" - (abbreviate-file-name (expand-file-name file))))) - ((string-match (concat "^" (regexp-quote pwd1) "\\(.+\\)") file) - (setq link (org-make-link "file:" (match-string 1 file)))) - ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)") - (expand-file-name file)) - (setq link (org-make-link - "file:" (match-string 1 (expand-file-name file))))) - (t (setq link (org-make-link "file:" file)))))) - (t - ;; Read link, with completion for stored links. - (with-output-to-temp-buffer "*Org Links*" - (princ "Insert a link. Use TAB to complete valid link prefixes.\n") - (when org-stored-links - (princ "\nStored links are available with / or M-p/n (most recent with RET):\n\n") - (princ (mapconcat - (lambda (x) - (if (nth 1 x) (concat (car x) " (" (nth 1 x) ")") (car x))) - (reverse org-stored-links) "\n")))) - (let ((cw (selected-window))) - (select-window (get-buffer-window "*Org Links*")) - (shrink-window-if-larger-than-buffer) - (setq truncate-lines t) - (select-window cw)) - ;; Fake a link history, containing the stored links. - (setq tmphist (append (mapcar 'car org-stored-links) - org-insert-link-history)) - (unwind-protect - (setq link (org-completing-read - "Link: " - (append - (mapcar (lambda (x) (list (concat (car x) ":"))) - (append org-link-abbrev-alist-local org-link-abbrev-alist)) - (mapcar (lambda (x) (list (concat x ":"))) - org-link-types)) - nil nil nil - 'tmphist - (or (car (car org-stored-links))))) - (set-window-configuration wcf) - (kill-buffer "*Org Links*")) - (setq entry (assoc link org-stored-links)) - (or entry (push link org-insert-link-history)) - (if (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))) - (setq desc (or desc (nth 1 entry))))) - - (if (string-match org-plain-link-re link) - ;; URL-like link, normalize the use of angular brackets. - (setq link (org-make-link (org-remove-angle-brackets link)))) - - ;; Check if we are linking to the current file with a search option - ;; If yes, simplify the link by using only the search option. - (when (and buffer-file-name - (string-match "\\]+\\)" link)) - (let* ((path (match-string 1 link)) - (case-fold-search nil) - (search (match-string 2 link))) - (save-match-data - (if (equal (file-truename buffer-file-name) (file-truename path)) - ;; We are linking to this same file, with a search option - (setq link search))))) - - ;; Check if we can/should use a relative path. If yes, simplify the link - (when (string-match "\\" "") html)) - (setq tbopen t) - (while (setq line (pop lines)) - (catch 'next-line - (if (string-match "^[ \t]*|-" line) - (progn - (unless splice - (push (if head "" "") html) - (if lines (push "" html) (setq tbopen nil))) - (setq head nil) ;; head ends here, first time around - ;; ignore this line - (throw 'next-line t))) - ;; Break the line into fields - (setq fields (org-split-string line "[ \t]*|[ \t]*")) - (unless fnum (setq fnum (make-vector (length fields) 0))) - (setq nlines (1+ nlines) i -1) - (push (concat "" - (mapconcat - (lambda (x) - (setq i (1+ i)) - (if (and (< i nlines) - (string-match org-table-number-regexp x)) - (incf (aref fnum i))) - (if head - (concat (car org-export-table-header-tags) x - (cdr org-export-table-header-tags)) - (concat (car org-export-table-data-tags) x - (cdr org-export-table-data-tags)))) - fields "") - "") - html))) - (unless splice (if tbopen (push "" html))) - (unless splice (push "
\n" html)) - (setq html (nreverse html)) - (unless splice - ;; Put in col tags with the alignment (unfortuntely often ignored...) - (push (mapconcat - (lambda (x) - (setq gr (pop org-table-colgroup-info)) - (format "%s%s" - (if (memq gr '(:start :startend)) - (prog1 - (if colgropen "\n" "") - (setq colgropen t)) - "") - (if (> (/ (float x) nlines) org-table-number-fraction) - "right" "left") - (if (memq gr '(:end :startend)) - (progn (setq colgropen nil) "") - ""))) - fnum "") - html) - (if colgropen (setq html (cons (car html) (cons "" (cdr html))))) - (push html-table-tag html)) - (concat (mapconcat 'identity html "\n") "\n"))) - -(defun org-table-clean-before-export (lines) - "Check if the table has a marking column. -If yes remove the column and the special lines." - (setq org-table-colgroup-info nil) - (if (memq nil - (mapcar - (lambda (x) (or (string-match "^[ \t]*|-" x) - (string-match "^[ \t]*| *\\([#!$*_^ /]\\) *|" x))) - lines)) - (progn - (setq org-table-clean-did-remove-column nil) - (delq nil - (mapcar - (lambda (x) - (cond - ((string-match "^[ \t]*| */ *|" x) - (setq org-table-colgroup-info - (mapcar (lambda (x) - (cond ((member x '("<" "<")) :start) - ((member x '(">" ">")) :end) - ((member x '("<>" "<>")) :startend) - (t nil))) - (org-split-string x "[ \t]*|[ \t]*"))) - nil) - (t x))) - lines))) - (setq org-table-clean-did-remove-column t) - (delq nil - (mapcar - (lambda (x) - (cond - ((string-match "^[ \t]*| */ *|" x) - (setq org-table-colgroup-info - (mapcar (lambda (x) - (cond ((member x '("<" "<")) :start) - ((member x '(">" ">")) :end) - ((member x '("<>" "<>")) :startend) - (t nil))) - (cdr (org-split-string x "[ \t]*|[ \t]*")))) - nil) - ((string-match "^[ \t]*| *[!_^/] *|" x) - nil) ; ignore this line - ((or (string-match "^\\([ \t]*\\)|-+\\+" x) - (string-match "^\\([ \t]*\\)|[^|]*|" x)) - ;; remove the first column - (replace-match "\\1|" t nil x)))) - lines)))) - -(defun org-format-table-table-html (lines) - "Format a table generated by table.el into HTML. -This conversion does *not* use `table-generate-source' from table.el. -This has the advantage that Org-mode's HTML conversions can be used. -But it has the disadvantage, that no cell- or row-spanning is allowed." - (let (line field-buffer - (head org-export-highlight-first-table-line) - fields html empty) - (setq html (concat html-table-tag "\n")) - (while (setq line (pop lines)) - (setq empty " ") - (catch 'next-line - (if (string-match "^[ \t]*\\+-" line) - (progn - (if field-buffer - (progn - (setq - html - (concat - html - "" - (mapconcat - (lambda (x) - (if (equal x "") (setq x empty)) - (if head - (concat (car org-export-table-header-tags) x - (cdr org-export-table-header-tags)) - (concat (car org-export-table-data-tags) x - (cdr org-export-table-data-tags)))) - field-buffer "\n") - "\n")) - (setq head nil) - (setq field-buffer nil))) - ;; Ignore this line - (throw 'next-line t))) - ;; Break the line into fields and store the fields - (setq fields (org-split-string line "[ \t]*|[ \t]*")) - (if field-buffer - (setq field-buffer (mapcar - (lambda (x) - (concat x "
" (pop fields))) - field-buffer)) - (setq field-buffer fields)))) - (setq html (concat html "\n")) - html)) - -(defun org-format-table-table-html-using-table-generate-source (lines) - "Format a table into html, using `table-generate-source' from table.el. -This has the advantage that cell- or row-spanning is allowed. -But it has the disadvantage, that Org-mode's HTML conversions cannot be used." - (require 'table) - (with-current-buffer (get-buffer-create " org-tmp1 ") - (erase-buffer) - (insert (mapconcat 'identity lines "\n")) - (goto-char (point-min)) - (if (not (re-search-forward "|[^+]" nil t)) - (error "Error processing table")) - (table-recognize-table) - (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer)) - (table-generate-source 'html " org-tmp2 ") - (set-buffer " org-tmp2 ") - (buffer-substring (point-min) (point-max)))) - -(defun org-html-handle-time-stamps (s) - "Format time stamps in string S, or remove them." - (catch 'exit - (let (r b) - (while (string-match org-maybe-keyword-time-regexp s) - (if (and (match-end 1) (equal (match-string 1 s) org-clock-string)) - ;; never export CLOCK - (throw 'exit "")) - (or b (setq b (substring s 0 (match-beginning 0)))) - (if (not org-export-with-timestamps) - (setq r (concat r (substring s 0 (match-beginning 0))) - s (substring s (match-end 0))) - (setq r (concat - r (substring s 0 (match-beginning 0)) - (if (match-end 1) - (format "@%s @" - (match-string 1 s))) - (format " @%s@" - (substring - (org-translate-time (match-string 3 s)) 1 -1))) - s (substring s (match-end 0))))) - ;; Line break if line started and ended with time stamp stuff - (if (not r) - s - (setq r (concat r s)) - (unless (string-match "\\S-" (concat b s)) - (setq r (concat r "@
"))) - r)))) - -(defun org-html-protect (s) - ;; convert & to &, < to < and > to > - (let ((start 0)) - (while (string-match "&" s start) - (setq s (replace-match "&" t t s) - start (1+ (match-beginning 0)))) - (while (string-match "<" s) - (setq s (replace-match "<" t t s))) - (while (string-match ">" s) - (setq s (replace-match ">" t t s)))) - s) - -(defun org-export-cleanup-toc-line (s) - "Remove tags and time staps from lines going into the toc." - (when (memq org-export-with-tags '(not-in-toc nil)) - (if (string-match (org-re " +:[[:alnum:]_@:]+: *$") s) - (setq s (replace-match "" t t s)))) - (when org-export-remove-timestamps-from-toc - (while (string-match org-maybe-keyword-time-regexp s) - (setq s (replace-match "" t t s)))) - (while (string-match org-bracket-link-regexp s) - (setq s (replace-match (match-string (if (match-end 3) 3 1) s) - t t s))) - s) - -(defun org-html-expand (string) - "Prepare STRING for HTML export. Applies all active conversions. -If there are links in the string, don't modify these." - (let* ((re (concat org-bracket-link-regexp "\\|" - (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$"))) - m s l res) - (while (setq m (string-match re string)) - (setq s (substring string 0 m) - l (match-string 0 string) - string (substring string (match-end 0))) - (push (org-html-do-expand s) res) - (push l res)) - (push (org-html-do-expand string) res) - (apply 'concat (nreverse res)))) - -(defun org-html-do-expand (s) - "Apply all active conversions to translate special ASCII to HTML." - (setq s (org-html-protect s)) - (if org-export-html-expand - (let ((start 0)) - (while (string-match "@<\\([^&]*\\)>" s) - (setq s (replace-match "<\\1>" t nil s))))) - (if org-export-with-emphasize - (setq s (org-export-html-convert-emphasize s))) - (if org-export-with-special-strings - (setq s (org-export-html-convert-special-strings s))) - (if org-export-with-sub-superscripts - (setq s (org-export-html-convert-sub-super s))) - (if org-export-with-TeX-macros - (let ((start 0) wd ass) - (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)" s start)) - (if (get-text-property (match-beginning 0) 'org-protected s) - (setq start (match-end 0)) - (setq wd (match-string 1 s)) - (if (setq ass (assoc wd org-html-entities)) - (setq s (replace-match (or (cdr ass) - (concat "&" (car ass) ";")) - t t s)) - (setq start (+ start (length wd)))))))) - s) - -(defun org-create-multibrace-regexp (left right n) - "Create a regular expression which will match a balanced sexp. -Opening delimiter is LEFT, and closing delimiter is RIGHT, both given -as single character strings. -The regexp returned will match the entire expression including the -delimiters. It will also define a single group which contains the -match except for the outermost delimiters. The maximum depth of -stacked delimiters is N. Escaping delimiters is not possible." - (let* ((nothing (concat "[^" "\\" left "\\" right "]*?")) - (or "\\|") - (re nothing) - (next (concat "\\(?:" nothing left nothing right "\\)+" nothing))) - (while (> n 1) - (setq n (1- n) - re (concat re or next) - next (concat "\\(?:" nothing left next right "\\)+" nothing))) - (concat left "\\(" re "\\)" right))) - -(defvar org-match-substring-regexp - (concat - "\\([^\\]\\)\\([_^]\\)\\(" - "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" - "\\|" - "\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)" - "\\|" - "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)") - "The regular expression matching a sub- or superscript.") - -(defvar org-match-substring-with-braces-regexp - (concat - "\\([^\\]\\)\\([_^]\\)\\(" - "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" - "\\)") - "The regular expression matching a sub- or superscript, forcing braces.") - -(defconst org-export-html-special-string-regexps - '(("\\\\-" . "­") - ("---\\([^-]\\)" . "—\\1") - ("--\\([^-]\\)" . "–\\1") - ("\\.\\.\\." . "…")) - "Regular expressions for special string conversion.") - -(defun org-export-html-convert-special-strings (string) - "Convert special characters in STRING to HTML." - (let ((all org-export-html-special-string-regexps) - e a re rpl start) - (while (setq a (pop all)) - (setq re (car a) rpl (cdr a) start 0) - (while (string-match re string start) - (if (get-text-property (match-beginning 0) 'org-protected string) - (setq start (match-end 0)) - (setq string (replace-match rpl t nil string))))) - string)) - -(defun org-export-html-convert-sub-super (string) - "Convert sub- and superscripts in STRING to HTML." - (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{}))) - (while (string-match org-match-substring-regexp string s) - (cond - ((and requireb (match-end 8)) (setq s (match-end 2))) - ((get-text-property (match-beginning 2) 'org-protected string) - (setq s (match-end 2))) - (t - (setq s (match-end 1) - key (if (string= (match-string 2 string) "_") "sub" "sup") - c (or (match-string 8 string) - (match-string 6 string) - (match-string 5 string)) - string (replace-match - (concat (match-string 1 string) - "<" key ">" c "") - t t string))))) - (while (string-match "\\\\\\([_^]\\)" string) - (setq string (replace-match (match-string 1 string) t t string))) - string)) - -(defun org-export-html-convert-emphasize (string) - "Apply emphasis." - (let ((s 0) rpl) - (while (string-match org-emph-re string s) - (if (not (equal - (substring string (match-beginning 3) (1+ (match-beginning 3))) - (substring string (match-beginning 4) (1+ (match-beginning 4))))) - (setq s (match-beginning 0) - rpl - (concat - (match-string 1 string) - (nth 2 (assoc (match-string 3 string) org-emphasis-alist)) - (match-string 4 string) - (nth 3 (assoc (match-string 3 string) - org-emphasis-alist)) - (match-string 5 string)) - string (replace-match rpl t t string) - s (+ s (- (length rpl) 2))) - (setq s (1+ s)))) - string)) - -(defvar org-par-open nil) -(defun org-open-par () - "Insert

, but first close previous paragraph if any." - (org-close-par-maybe) - (insert "\n

") - (setq org-par-open t)) -(defun org-close-par-maybe () - "Close paragraph if there is one open." - (when org-par-open - (insert "

") - (setq org-par-open nil))) -(defun org-close-li () - "Close
  • if necessary." - (org-close-par-maybe) - (insert "
    • \n")) - -(defvar body-only) ; dynamically scoped into this. -(defun org-html-level-start (level title umax with-toc head-count) - "Insert a new level in HTML export. -When TITLE is nil, just close all open levels." - (org-close-par-maybe) - (let ((l org-level-max)) - (while (>= l level) - (if (aref org-levels-open (1- l)) - (progn - (org-html-level-close l umax) - (aset org-levels-open (1- l) nil))) - (setq l (1- l))) - (when title - ;; If title is nil, this means this function is called to close - ;; all levels, so the rest is done only if title is given - (when (string-match (org-re "\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title) - (setq title (replace-match - (if org-export-with-tags - (save-match-data - (concat - "   " - (mapconcat 'identity (org-split-string - (match-string 1 title) ":") - " ") - "")) - "") - t t title))) - (if (> level umax) - (progn - (if (aref org-levels-open (1- level)) - (progn - (org-close-li) - (insert "
  • " title "
    \n")) - (aset org-levels-open (1- level) t) - (org-close-par-maybe) - (insert "
      \n
    • " title "
      \n"))) - (aset org-levels-open (1- level) t) - (if (and org-export-with-section-numbers (not body-only)) - (setq title (concat (org-section-number level) " " title))) - (setq level (+ level org-export-html-toplevel-hlevel -1)) - (if with-toc - (insert (format "\n
      \n%s\n" - level level head-count title level)) - (insert (format "\n
      \n%s\n" level level title level))) - (org-open-par))))) - -(defun org-html-level-close (level max-outline-level) - "Terminate one level in HTML export." - (if (<= level max-outline-level) - (insert "
      \n") - (org-close-li) - (insert "
    \n"))) - -;;; iCalendar export - -;;;###autoload -(defun org-export-icalendar-this-file () - "Export current file as an iCalendar file. -The iCalendar file will be located in the same directory as the Org-mode -file, but with extension `.ics'." - (interactive) - (org-export-icalendar nil buffer-file-name)) - -;;;###autoload -(defun org-export-icalendar-all-agenda-files () - "Export all files in `org-agenda-files' to iCalendar .ics files. -Each iCalendar file will be located in the same directory as the Org-mode -file, but with extension `.ics'." - (interactive) - (apply 'org-export-icalendar nil (org-agenda-files t))) - -;;;###autoload -(defun org-export-icalendar-combine-agenda-files () - "Export all files in `org-agenda-files' to a single combined iCalendar file. -The file is stored under the name `org-combined-agenda-icalendar-file'." - (interactive) - (apply 'org-export-icalendar t (org-agenda-files t))) - -(defun org-export-icalendar (combine &rest files) - "Create iCalendar files for all elements of FILES. -If COMBINE is non-nil, combine all calendar entries into a single large -file and store it under the name `org-combined-agenda-icalendar-file'." - (save-excursion - (org-prepare-agenda-buffers files) - (let* ((dir (org-export-directory - :ical (list :publishing-directory - org-export-publishing-directory))) - file ical-file ical-buffer category started org-agenda-new-buffers) - - (and (get-buffer "*ical-tmp*") (kill-buffer "*ical-tmp*")) - (when combine - (setq ical-file - (if (file-name-absolute-p org-combined-agenda-icalendar-file) - org-combined-agenda-icalendar-file - (expand-file-name org-combined-agenda-icalendar-file dir)) - ical-buffer (org-get-agenda-file-buffer ical-file)) - (set-buffer ical-buffer) (erase-buffer)) - (while (setq file (pop files)) - (catch 'nextfile - (org-check-agenda-file file) - (set-buffer (org-get-agenda-file-buffer file)) - (unless combine - (setq ical-file (concat (file-name-as-directory dir) - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) - ".ics")) - (setq ical-buffer (org-get-agenda-file-buffer ical-file)) - (with-current-buffer ical-buffer (erase-buffer))) - (setq category (or org-category - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)))) - (if (symbolp category) (setq category (symbol-name category))) - (let ((standard-output ical-buffer)) - (if combine - (and (not started) (setq started t) - (org-start-icalendar-file org-icalendar-combined-name)) - (org-start-icalendar-file category)) - (org-print-icalendar-entries combine) - (when (or (and combine (not files)) (not combine)) - (org-finish-icalendar-file) - (set-buffer ical-buffer) - (save-buffer) - (run-hooks 'org-after-save-iCalendar-file-hook))))) - (org-release-buffers org-agenda-new-buffers)))) - -(defvar org-after-save-iCalendar-file-hook nil - "Hook run after an iCalendar file has been saved. -The iCalendar buffer is still current when this hook is run. -A good way to use this is to tell a desktop calenndar application to re-read -the iCalendar file.") - -(defun org-print-icalendar-entries (&optional combine) - "Print iCalendar entries for the current Org-mode file to `standard-output'. -When COMBINE is non nil, add the category to each line." - (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>")) - (re2 (concat "--?-?\\(" org-ts-regexp "\\)")) - (dts (org-ical-ts-to-string - (format-time-string (cdr org-time-stamp-formats) (current-time)) - "DTSTART")) - hd ts ts2 state status (inc t) pos b sexp rrule - scheduledp deadlinep tmp pri category entry location summary desc - (sexp-buffer (get-buffer-create "*ical-tmp*"))) - (org-refresh-category-properties) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward re1 nil t) - (catch :skip - (org-agenda-skip) - (setq pos (match-beginning 0) - ts (match-string 0) - inc t - hd (org-get-heading) - summary (org-icalendar-cleanup-string - (org-entry-get nil "SUMMARY")) - desc (org-icalendar-cleanup-string - (or (org-entry-get nil "DESCRIPTION") - (and org-icalendar-include-body (org-get-entry))) - t org-icalendar-include-body) - location (org-icalendar-cleanup-string - (org-entry-get nil "LOCATION")) - category (org-get-category)) - (if (looking-at re2) - (progn - (goto-char (match-end 0)) - (setq ts2 (match-string 1) inc nil)) - (setq tmp (buffer-substring (max (point-min) - (- pos org-ds-keyword-length)) - pos) - ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts) - (progn - (setq inc nil) - (replace-match "\\1" t nil ts)) - ts) - deadlinep (string-match org-deadline-regexp tmp) - scheduledp (string-match org-scheduled-regexp tmp) - ;; donep (org-entry-is-done-p) - )) - (if (or (string-match org-tr-regexp hd) - (string-match org-ts-regexp hd)) - (setq hd (replace-match "" t t hd))) - (if (string-match "\\+\\([0-9]+\\)\\([dwmy]\\)>" ts) - (setq rrule - (concat "\nRRULE:FREQ=" - (cdr (assoc - (match-string 2 ts) - '(("d" . "DAILY")("w" . "WEEKLY") - ("m" . "MONTHLY")("y" . "YEARLY")))) - ";INTERVAL=" (match-string 1 ts))) - (setq rrule "")) - (setq summary (or summary hd)) - (if (string-match org-bracket-link-regexp summary) - (setq summary - (replace-match (if (match-end 3) - (match-string 3 summary) - (match-string 1 summary)) - t t summary))) - (if deadlinep (setq summary (concat "DL: " summary))) - (if scheduledp (setq summary (concat "S: " summary))) - (if (string-match "\\`<%%" ts) - (with-current-buffer sexp-buffer - (insert (substring ts 1 -1) " " summary "\n")) - (princ (format "BEGIN:VEVENT -%s -%s%s -SUMMARY:%s%s%s -CATEGORIES:%s -END:VEVENT\n" - (org-ical-ts-to-string ts "DTSTART") - (org-ical-ts-to-string ts2 "DTEND" inc) - rrule summary - (if (and desc (string-match "\\S-" desc)) - (concat "\nDESCRIPTION: " desc) "") - (if (and location (string-match "\\S-" location)) - (concat "\nLOCATION: " location) "") - category))))) - - (when (and org-icalendar-include-sexps - (condition-case nil (require 'icalendar) (error nil)) - (fboundp 'icalendar-export-region)) - ;; Get all the literal sexps - (goto-char (point-min)) - (while (re-search-forward "^&?%%(" nil t) - (catch :skip - (org-agenda-skip) - (setq b (match-beginning 0)) - (goto-char (1- (match-end 0))) - (forward-sexp 1) - (end-of-line 1) - (setq sexp (buffer-substring b (point))) - (with-current-buffer sexp-buffer - (insert sexp "\n")) - (princ (org-diary-to-ical-string sexp-buffer))))) - - (when org-icalendar-include-todo - (goto-char (point-min)) - (while (re-search-forward org-todo-line-regexp nil t) - (catch :skip - (org-agenda-skip) - (setq state (match-string 2)) - (setq status (if (member state org-done-keywords) - "COMPLETED" "NEEDS-ACTION")) - (when (and state - (or (not (member state org-done-keywords)) - (eq org-icalendar-include-todo 'all)) - (not (member org-archive-tag (org-get-tags-at))) - ) - (setq hd (match-string 3) - summary (org-icalendar-cleanup-string - (org-entry-get nil "SUMMARY")) - desc (org-icalendar-cleanup-string - (or (org-entry-get nil "DESCRIPTION") - (and org-icalendar-include-body (org-get-entry))) - t org-icalendar-include-body) - location (org-icalendar-cleanup-string - (org-entry-get nil "LOCATION"))) - (if (string-match org-bracket-link-regexp hd) - (setq hd (replace-match (if (match-end 3) (match-string 3 hd) - (match-string 1 hd)) - t t hd))) - (if (string-match org-priority-regexp hd) - (setq pri (string-to-char (match-string 2 hd)) - hd (concat (substring hd 0 (match-beginning 1)) - (substring hd (match-end 1)))) - (setq pri org-default-priority)) - (setq pri (floor (1+ (* 8. (/ (float (- org-lowest-priority pri)) - (- org-lowest-priority org-highest-priority)))))) - - (princ (format "BEGIN:VTODO -%s -SUMMARY:%s%s%s -CATEGORIES:%s -SEQUENCE:1 -PRIORITY:%d -STATUS:%s -END:VTODO\n" - dts - (or summary hd) - (if (and location (string-match "\\S-" location)) - (concat "\nLOCATION: " location) "") - (if (and desc (string-match "\\S-" desc)) - (concat "\nDESCRIPTION: " desc) "") - category pri status))))))))) - -(defun org-icalendar-cleanup-string (s &optional is-body maxlength) - "Take out stuff and quote what needs to be quoted. -When IS-BODY is non-nil, assume that this is the body of an item, clean up -whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH -characters." - (if (not s) - nil - (when is-body - (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?")) - (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) - (while (string-match re s) (setq s (replace-match "" t t s))) - (while (string-match re2 s) (setq s (replace-match "" t t s))))) - (let ((start 0)) - (while (string-match "\\([,;\\]\\)" s start) - (setq start (+ (match-beginning 0) 2) - s (replace-match "\\\\\\1" nil nil s)))) - (when is-body - (while (string-match "[ \t]*\n[ \t]*" s) - (setq s (replace-match "\\n" t t s)))) - (setq s (org-trim s)) - (if is-body - (if maxlength - (if (and (numberp maxlength) - (> (length s) maxlength)) - (setq s (substring s 0 maxlength))))) - s)) - -(defun org-get-entry () - "Clean-up description string." - (save-excursion - (org-back-to-heading t) - (buffer-substring (point-at-bol 2) (org-end-of-subtree t)))) - -(defun org-start-icalendar-file (name) - "Start an iCalendar file by inserting the header." - (let ((user user-full-name) - (name (or name "unknown")) - (timezone (cadr (current-time-zone)))) - (princ - (format "BEGIN:VCALENDAR -VERSION:2.0 -X-WR-CALNAME:%s -PRODID:-//%s//Emacs with Org-mode//EN -X-WR-TIMEZONE:%s -CALSCALE:GREGORIAN\n" name user timezone)))) - -(defun org-finish-icalendar-file () - "Finish an iCalendar file by inserting the END statement." - (princ "END:VCALENDAR\n")) - -(defun org-ical-ts-to-string (s keyword &optional inc) - "Take a time string S and convert it to iCalendar format. -KEYWORD is added in front, to make a complete line like DTSTART.... -When INC is non-nil, increase the hour by two (if time string contains -a time), or the day by one (if it does not contain a time)." - (let ((t1 (org-parse-time-string s 'nodefault)) - t2 fmt have-time time) - (if (and (car t1) (nth 1 t1) (nth 2 t1)) - (setq t2 t1 have-time t) - (setq t2 (org-parse-time-string s))) - (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2)) - (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2))) - (when inc - (if have-time - (if org-agenda-default-appointment-duration - (setq mi (+ org-agenda-default-appointment-duration mi)) - (setq h (+ 2 h))) - (setq d (1+ d)))) - (setq time (encode-time s mi h d m y))) - (setq fmt (if have-time ":%Y%m%dT%H%M%S" ";VALUE=DATE:%Y%m%d")) - (concat keyword (format-time-string fmt time)))) - -;;; XOXO export - -(defun org-export-as-xoxo-insert-into (buffer &rest output) - (with-current-buffer buffer - (apply 'insert output))) -(put 'org-export-as-xoxo-insert-into 'lisp-indent-function 1) - -(defun org-export-as-xoxo (&optional buffer) - "Export the org buffer as XOXO. -The XOXO buffer is named *xoxo-*" - (interactive (list (current-buffer))) - ;; A quickie abstraction - - ;; Output everything as XOXO - (with-current-buffer (get-buffer buffer) - (let* ((pos (point)) - (opt-plist (org-combine-plists (org-default-export-plist) - (org-infile-export-plist))) - (filename (concat (file-name-as-directory - (org-export-directory :xoxo opt-plist)) - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) - ".html")) - (out (find-file-noselect filename)) - (last-level 1) - (hanging-li nil)) - (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed. - ;; Check the output buffer is empty. - (with-current-buffer out (erase-buffer)) - ;; Kick off the output - (org-export-as-xoxo-insert-into out "
      \n") - (while (re-search-forward "^\\(\\*+\\)[ \t]+\\(.+\\)" (point-max) 't) - (let* ((hd (match-string-no-properties 1)) - (level (length hd)) - (text (concat - (match-string-no-properties 2) - (save-excursion - (goto-char (match-end 0)) - (let ((str "")) - (catch 'loop - (while 't - (forward-line) - (if (looking-at "^[ \t]\\(.*\\)") - (setq str (concat str (match-string-no-properties 1))) - (throw 'loop str))))))))) - - ;; Handle level rendering - (cond - ((> level last-level) - (org-export-as-xoxo-insert-into out "\n
        \n")) - - ((< level last-level) - (dotimes (- (- last-level level) 1) - (if hanging-li - (org-export-as-xoxo-insert-into out "\n")) - (org-export-as-xoxo-insert-into out "
      \n")) - (when hanging-li - (org-export-as-xoxo-insert-into out "\n") - (setq hanging-li nil))) - - ((equal level last-level) - (if hanging-li - (org-export-as-xoxo-insert-into out "\n"))) - ) - - (setq last-level level) - - ;; And output the new li - (setq hanging-li 't) - (if (equal ?+ (elt text 0)) - (org-export-as-xoxo-insert-into out "
    1. ") - (org-export-as-xoxo-insert-into out "
    2. " text)))) - - ;; Finally finish off the ol - (dotimes (- last-level 1) - (if hanging-li - (org-export-as-xoxo-insert-into out "
      3. \n")) - (org-export-as-xoxo-insert-into out "
    \n")) - - (goto-char pos) - ;; Finish the buffer off and clean it up. - (switch-to-buffer-other-window out) - (indent-region (point-min) (point-max) nil) - (save-buffer) - (goto-char (point-min)) - ))) - - -;;;; Key bindings - -;; 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 [(meta tab)] 'org-complete) -(org-defkey org-mode-map "\M-\t" 'org-complete) -(org-defkey org-mode-map "\M-\C-i" 'org-complete) -;; The following line is necessary under Suse GNU/Linux -(unless (featurep 'xemacs) - (org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab)) -(org-defkey org-mode-map [(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 [(meta return)] '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 [(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) - -;;; Extra keys for tty access. -;; We only set them when really needed because otherwise the -;; menus don't show the simple keys - -(when (or (featurep 'xemacs) ;; because XEmacs supports multi-device stuff - (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)) - - ;; All the other keys - -(org-defkey org-mode-map "\C-c\C-a" 'show-all) ; in case allout messed up. -(org-defkey org-mode-map "\C-c\C-r" 'org-reveal) -(org-defkey org-mode-map "\C-xns" 'org-narrow-to-subtree) -(org-defkey org-mode-map "\C-c$" 'org-archive-subtree) -(org-defkey org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree) -(org-defkey org-mode-map "\C-c\C-x\C-a" 'org-toggle-archive-tag) -(org-defkey org-mode-map "\C-c\C-xb" 'org-tree-to-indirect-buffer) -(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-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-v" 'org-show-todo-tree) -(org-defkey org-mode-map "\C-c\C-w" 'org-refile) -(org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved -(org-defkey org-mode-map "\C-c\\" 'org-tags-sparse-tree) ; Minor-mode res. -(org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret) -(org-defkey org-mode-map "\M-\C-m" 'org-insert-heading) -(org-defkey org-mode-map [(control return)] 'org-insert-heading-after-current) -(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\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-time-stamp) ; 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-sort) -(org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) -(org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches) -(org-defkey org-mode-map "\C-c#" 'org-update-checkbox-count) -(org-defkey org-mode-map "\C-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-table-edit-formulas) -(org-defkey org-mode-map "\C-c`" 'org-table-edit-field) -(org-defkey org-mode-map "\C-c|" 'org-table-create-or-convert-from-region) -(org-defkey org-mode-map "\C-c*" 'org-table-recalculate) -(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-q" 'org-table-wrap-region) -(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) -(org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width-section) -(org-defkey org-mode-map "\C-c\C-x\C-f" 'org-emphasize) - -(org-defkey org-mode-map "\C-c\C-x\C-k" 'org-cut-special) -(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-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-x" '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-preview-latex-fragment) -(org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox) -(org-defkey org-mode-map "\C-c\C-xp" 'org-set-property) -(org-defkey org-mode-map "\C-c\C-xr" 'org-insert-columns-dblock) - -(define-key org-mode-map "\C-c\C-x\C-c" 'org-columns) - -(when (featurep 'xemacs) - (org-defkey org-mode-map 'button3 'popup-mode-menu)) - -(defsubst org-table-p () (org-at-table-p)) - -(defun org-self-insert-command (N) - "Like `self-insert-command', use overwrite-mode for whitespace in tables. -If the cursor is in a table looking at whitespace, the whitespace is -overwritten, and the table is not marked as requiring realignment." - (interactive "p") - (if (and (org-table-p) - (progn - ;; check if we blank the field, and if that triggers align - (and org-table-auto-blank-field - (member last-command - '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c)) - (if (or (equal (char-after) ?\ ) (looking-at "[^|\n]* |")) - ;; got extra space, this field does not determine column width - (let (org-table-may-need-update) (org-table-blank-field)) - ;; no extra space, this field may determine column width - (org-table-blank-field))) - t) - (eq N 1) - (looking-at "[^|\n]* |")) - (let (org-table-may-need-update) - (goto-char (1- (match-end 0))) - (delete-backward-char 1) - (goto-char (match-beginning 0)) - (self-insert-command N)) - (setq org-table-may-need-update t) - (self-insert-command N) - (org-fix-tags-on-the-fly))) - -(defun org-fix-tags-on-the-fly () - (when (and (equal (char-after (point-at-bol)) ?*) - (org-on-heading-p)) - (org-align-tags-here org-tags-column))) - -(defun org-delete-backward-char (N) - "Like `delete-backward-char', insert whitespace at field end in tables. -When deleting backwards, in tables this function will insert whitespace in -front of the next \"|\" separator, to keep the table aligned. The table will -still be marked for re-alignment if the field did fill the entire column, -because, in this case the deletion might narrow the column." - (interactive "p") - (if (and (org-table-p) - (eq N 1) - (string-match "|" (buffer-substring (point-at-bol) (point))) - (looking-at ".*?|")) - (let ((pos (point)) - (noalign (looking-at "[^|\n\r]* |")) - (c org-table-may-need-update)) - (backward-delete-char N) - (skip-chars-forward "^|") - (insert " ") - (goto-char (1- pos)) - ;; noalign: if there were two spaces at the end, this field - ;; does not determine the width of the column. - (if noalign (setq org-table-may-need-update c))) - (backward-delete-char N) - (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") - (if (and (org-table-p) - (not (bolp)) - (not (= (char-after) ?|)) - (eq N 1)) - (if (looking-at ".*?|") - (let ((pos (point)) - (noalign (looking-at "[^|\n\r]* |")) - (c org-table-may-need-update)) - (replace-match (concat - (substring (match-string 0) 1 -1) - " |")) - (goto-char pos) - ;; noalign: if there were two spaces at the end, this field - ;; does not determine the width of the column. - (if noalign (setq org-table-may-need-update c))) - (delete-char N)) - (delete-char N) - (org-fix-tags-on-the-fly))) - -;; Make `delete-selection-mode' work with org-mode and orgtbl-mode -(put 'org-self-insert-command 'delete-selection t) -(put 'orgtbl-self-insert-command 'delete-selection t) -(put 'org-delete-char 'delete-selection 'supersede) -(put 'org-delete-backward-char 'delete-selection 'supersede) - -;; 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 'orgybl-self-insert-command 'pabbrev-expand-after-command t) - -;; How to do this: Measure non-white length of current string -;; If equal to column width, we should realign. - -(defun org-remap (map &rest commands) - "In MAP, remap the functions given in COMMANDS. -COMMANDS is a list of alternating OLDDEF NEWDEF command names." - (let (new old) - (while commands - (setq old (pop commands) new (pop commands)) - (if (fboundp 'command-remapping) - (org-defkey map (vector 'remap old) new) - (substitute-key-definition old new map global-map))))) - -(when (eq org-enable-table-editor 'optimized) - ;; If the user wants maximum table support, we need to hijack - ;; some standard editing functions - (org-remap org-mode-map - 'self-insert-command 'org-self-insert-command - 'delete-char 'org-delete-char - 'delete-backward-char 'org-delete-backward-char) - (org-defkey org-mode-map "|" 'org-force-self-insert)) - -(defun org-shiftcursor-error () - "Throw an error because Shift-Cursor command was applied in wrong context." - (error "This command is active in special context like tables, headlines or timestamps")) - -(defun org-shifttab (&optional arg) - "Global visibility cycling or move to previous table field. -Calls `org-cycle' with argument t, or `org-table-previous-field', depending -on context. -See the individual commands for more information." - (interactive "P") - (cond - ((org-at-table-p) (call-interactively 'org-table-previous-field)) - (arg (message "Content view to level: ") - (org-content (prefix-numeric-value arg)) - (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', -or `org-table-delete-column', depending on context. -See the individual commands for more information." - (interactive) - (cond - ((org-at-table-p) (call-interactively 'org-table-delete-column)) - ((org-on-heading-p) (call-interactively 'org-promote-subtree)) - ((org-at-item-p) (call-interactively 'org-outdent-item)) - (t (org-shiftcursor-error)))) - -(defun org-shiftmetaright () - "Demote subtree or insert table column. -Calls `org-demote-subtree', `org-indent-item', -or `org-table-insert-column', depending on context. -See the individual commands for more information." - (interactive) - (cond - ((org-at-table-p) (call-interactively 'org-table-insert-column)) - ((org-on-heading-p) (call-interactively 'org-demote-subtree)) - ((org-at-item-p) (call-interactively 'org-indent-item)) - (t (org-shiftcursor-error)))) - -(defun org-shiftmetaup (&optional arg) - "Move subtree up or kill table row. -Calls `org-move-subtree-up' or `org-table-kill-row' or -`org-move-item-up' depending on context. See the individual commands -for more information." - (interactive "P") - (cond - ((org-at-table-p) (call-interactively 'org-table-kill-row)) - ((org-on-heading-p) (call-interactively 'org-move-subtree-up)) - ((org-at-item-p) (call-interactively 'org-move-item-up)) - (t (org-shiftcursor-error)))) -(defun org-shiftmetadown (&optional arg) - "Move subtree down or insert table row. -Calls `org-move-subtree-down' or `org-table-insert-row' or -`org-move-item-down', depending on context. See the individual -commands for more information." - (interactive "P") - (cond - ((org-at-table-p) (call-interactively 'org-table-insert-row)) - ((org-on-heading-p) (call-interactively 'org-move-subtree-down)) - ((org-at-item-p) (call-interactively 'org-move-item-down)) - (t (org-shiftcursor-error)))) - -(defun org-metaleft (&optional arg) - "Promote heading or move table column to left. -Calls `org-do-promote' or `org-table-move-column', depending on context. -With no specific context, calls the Emacs default `backward-word'. -See the individual commands for more information." - (interactive "P") - (cond - ((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left)) - ((or (org-on-heading-p) (org-region-active-p)) - (call-interactively 'org-do-promote)) - ((org-at-item-p) (call-interactively 'org-outdent-item)) - (t (call-interactively 'backward-word)))) - -(defun org-metaright (&optional arg) - "Demote subtree or move table column to right. -Calls `org-do-demote' or `org-table-move-column', depending on context. -With no specific context, calls the Emacs default `forward-word'. -See the individual commands for more information." - (interactive "P") - (cond - ((org-at-table-p) (call-interactively 'org-table-move-column)) - ((or (org-on-heading-p) (org-region-active-p)) - (call-interactively 'org-do-demote)) - ((org-at-item-p) (call-interactively 'org-indent-item)) - (t (call-interactively 'forward-word)))) - -(defun org-metaup (&optional arg) - "Move subtree up or move table row up. -Calls `org-move-subtree-up' or `org-table-move-row' or -`org-move-item-up', depending on context. See the individual commands -for more information." - (interactive "P") - (cond - ((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up)) - ((org-on-heading-p) (call-interactively 'org-move-subtree-up)) - ((org-at-item-p) (call-interactively 'org-move-item-up)) - (t (transpose-lines 1) (beginning-of-line -1)))) - -(defun org-metadown (&optional arg) - "Move subtree down or move table row down. -Calls `org-move-subtree-down' or `org-table-move-row' or -`org-move-item-down', depending on context. See the individual -commands for more information." - (interactive "P") - (cond - ((org-at-table-p) (call-interactively 'org-table-move-row)) - ((org-on-heading-p) (call-interactively 'org-move-subtree-down)) - ((org-at-item-p) (call-interactively 'org-move-item-down)) - (t (beginning-of-line 2) (transpose-lines 1) (beginning-of-line 0)))) - -(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 - ((org-at-timestamp-p t) - (call-interactively (if org-edit-timestamp-down-means-later - 'org-timestamp-down 'org-timestamp-up))) - ((org-on-heading-p) (call-interactively 'org-priority-up)) - ((org-at-item-p) (call-interactively 'org-previous-item)) - (t (call-interactively 'org-beginning-of-item) (beginning-of-line 1)))) - -(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 - ((org-at-timestamp-p t) - (call-interactively (if org-edit-timestamp-down-means-later - 'org-timestamp-up 'org-timestamp-down))) - ((org-on-heading-p) (call-interactively 'org-priority-down)) - (t (call-interactively 'org-next-item)))) - -(defun org-shiftright () - "Next TODO keyword or timestamp one day later, depending on context." - (interactive) - (cond - ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day)) - ((org-on-heading-p) (org-call-with-arg 'org-todo 'right)) - ((org-at-item-p) (org-call-with-arg 'org-cycle-list-bullet nil)) - ((org-at-property-p) (call-interactively 'org-property-next-allowed-value)) - (t (org-shiftcursor-error)))) - -(defun org-shiftleft () - "Previous TODO keyword or timestamp one day earlier, depending on context." - (interactive) - (cond - ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day)) - ((org-on-heading-p) (org-call-with-arg 'org-todo 'left)) - ((org-at-item-p) (org-call-with-arg 'org-cycle-list-bullet 'previous)) - ((org-at-property-p) - (call-interactively 'org-property-previous-allowed-value)) - (t (org-shiftcursor-error)))) - -(defun org-shiftcontrolright () - "Switch to next TODO set." - (interactive) - (cond - ((org-on-heading-p) (org-call-with-arg 'org-todo 'nextset)) - (t (org-shiftcursor-error)))) - -(defun org-shiftcontrolleft () - "Switch to previous TODO set." - (interactive) - (cond - ((org-on-heading-p) (org-call-with-arg 'org-todo 'previousset)) - (t (org-shiftcursor-error)))) - -(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-copy-special () - "Copy region in table or copy current subtree. -Calls `org-table-copy' or `org-copy-subtree', depending on context. -See the individual commands for more information." - (interactive) - (call-interactively - (if (org-at-table-p) 'org-table-copy-region 'org-copy-subtree))) - -(defun org-cut-special () - "Cut region in table or cut current subtree. -Calls `org-table-copy' or `org-cut-subtree', depending on context. -See the individual commands for more information." - (interactive) - (call-interactively - (if (org-at-table-p) 'org-table-cut-region 'org-cut-subtree))) - -(defun org-paste-special (arg) - "Paste rectangular region into table, or past subtree relative to level. -Calls `org-table-paste-rectangle' or `org-paste-subtree', depending on context. -See the individual commands for more information." - (interactive "P") - (if (org-at-table-p) - (org-table-paste-rectangle) - (org-paste-subtree arg))) - -(defun org-ctrl-c-ctrl-c (&optional arg) - "Set tags in headline, or update according to changed information at point. - -This command does many different things, depending on context: - -- If the cursor is in a headline, prompt for tags and insert them - into the current line, aligned to `org-tags-column'. When called - with prefix arg, realign all tags in the current buffer. - -- If the cursor is in one of the special #+KEYWORD lines, this - triggers scanning the buffer for these lines and updating the - information. - -- If the cursor is inside a table, realign the table. This command - works even if the automatic table editor has been turned off. - -- If the cursor is on a #+TBLFM line, re-apply the formulas to - the entire table. - -- If the cursor is a the beginning of a dynamic block, update it. - -- If the cursor is inside a table created by the table.el package, - activate that table. - -- If the current buffer is a remember buffer, close note and file it. - with a prefix argument, file it without further interaction to the default - location. - -- If the cursor is on a <<>>, 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." - (interactive "P") - (let ((org-enable-table-editor t)) - (cond - ((or org-clock-overlays - org-occur-highlights - org-latex-fragment-image-overlays) - (org-remove-clock-overlays) - (org-remove-occur-highlights) - (org-remove-latex-fragment-image-overlays) - (message "Temporary highlights/overlays removed from current buffer")) - ((and (local-variable-p 'org-finish-function (current-buffer)) - (fboundp org-finish-function)) - (funcall org-finish-function)) - ((org-at-property-p) - (call-interactively 'org-property-action)) - ((org-on-target-p) (call-interactively 'org-update-radio-target-regexp)) - ((org-on-heading-p) (call-interactively 'org-set-tags)) - ((org-at-table.el-p) - (require 'table) - (beginning-of-line 1) - (re-search-forward "|" (save-excursion (end-of-line 2) (point))) - (call-interactively 'table-recognize-table)) - ((org-at-table-p) - (org-table-maybe-eval-formula) - (if arg - (call-interactively 'org-table-recalculate) - (org-table-maybe-recalculate-line)) - (call-interactively 'org-table-align)) - ((org-at-item-checkbox-p) - (call-interactively 'org-toggle-checkbox)) - ((org-at-item-p) - (call-interactively 'org-maybe-renumber-ordered-list)) - ((save-excursion (beginning-of-line 1) (looking-at "#\\+BEGIN:")) - ;; Dynamic block - (beginning-of-line 1) - (org-update-dblock)) - ((save-excursion (beginning-of-line 1) (looking-at "#\\+\\([A-Z]+\\)")) - (cond - ((equal (match-string 1) "TBLFM") - ;; Recalculate the table before this line - (save-excursion - (beginning-of-line 1) - (skip-chars-backward " \r\n\t") - (if (org-at-table-p) - (org-call-with-arg 'org-table-recalculate t)))) - (t - (call-interactively 'org-mode-restart)))) - (t (error "C-c C-c can do nothing useful at this location."))))) - -(defun org-mode-restart () - "Restart Org-mode, to scan again for special lines. -Also updates the keyword regular expressions." - (interactive) - (let ((org-inhibit-startup t)) (org-mode)) - (message "Org-mode restarted to refresh keyword and special line setup")) - -(defun org-kill-note-or-show-branches () - "If this is a Note buffer, abort storing the note. Else call `show-branches'." - (interactive) - (if (not org-finish-function) - (call-interactively 'show-branches) - (let ((org-note-abort t)) - (funcall org-finish-function)))) - -(defun org-return (&optional indent) - "Goto next table row or insert a newline. -Calls `org-table-next-row' or `newline', depending on context. -See the individual commands for more information." - (interactive) - (cond - ((bobp) (if indent (newline-and-indent) (newline))) - ((org-at-table-p) - (org-table-justify-field-maybe) - (call-interactively 'org-table-next-row)) - (t (if indent (newline-and-indent) (newline))))) - -(defun org-return-indent () - (interactive) - "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." - (org-return t)) - -(defun org-ctrl-c-minus () - "Insert separator line in table or modify bullet type in list. -Calls `org-table-insert-hline' or `org-cycle-list-bullet', -depending on context." - (interactive) - (cond - ((org-at-table-p) - (call-interactively 'org-table-insert-hline)) - ((org-on-heading-p) - ;; Convert to item - (save-excursion - (beginning-of-line 1) - (if (looking-at "\\*+ ") - (replace-match (concat (make-string (- (match-end 0) (point)) ?\ ) "- "))))) - ((org-in-item-p) - (call-interactively 'org-cycle-list-bullet)) - (t (error "`C-c -' does have no function here.")))) - -(defun org-meta-return (&optional arg) - "Insert a new heading or wrap a region in a table. -Calls `org-insert-heading' or `org-table-wrap-region', depending on context. -See the individual commands for more information." - (interactive "P") - (cond - ((org-at-table-p) - (call-interactively 'org-table-wrap-region)) - (t (call-interactively 'org-insert-heading)))) - -;;; Menu entries - -;; Define the Org-mode menus -(easy-menu-define org-tbl-menu org-mode-map "Tbl menu" - '("Tbl" - ["Align" org-ctrl-c-ctrl-c (org-at-table-p)] - ["Next Field" org-cycle (org-at-table-p)] - ["Previous Field" org-shifttab (org-at-table-p)] - ["Next Row" org-return (org-at-table-p)] - "--" - ["Blank Field" org-table-blank-field (org-at-table-p)] - ["Edit Field" org-table-edit-field (org-at-table-p)] - ["Copy Field from Above" org-table-copy-down (org-at-table-p)] - "--" - ("Column" - ["Move Column Left" org-metaleft (org-at-table-p)] - ["Move Column Right" org-metaright (org-at-table-p)] - ["Delete Column" org-shiftmetaleft (org-at-table-p)] - ["Insert Column" org-shiftmetaright (org-at-table-p)]) - ("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-table-edit-formulas (org-at-table-p)] - "--" - ["Recalculate line" org-table-recalculate (org-at-table-p)] - ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"] - ["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 org-table-formula-debug] - ["Show Col/Row Numbers" - org-table-toggle-coordinate-overlays - :style toggle :selected org-table-overlay-coordinates] - "--" - ["Create" org-table-create (and (not (org-at-table-p)) - org-enable-table-editor)] - ["Convert Region" org-table-convert-region (not (org-at-table-p 'any))] - ["Import from File" org-table-import (not (org-at-table-p))] - ["Export to File" org-table-export (org-at-table-p)] - "--" - ["Create/Convert from/to table.el" org-table-create-with-table.el t])) - -(easy-menu-define org-org-menu org-mode-map "Org menu" - '("Org" - ("Show/Hide" - ["Cycle Visibility" org-cycle (or (bobp) (outline-on-heading-p))] - ["Cycle Global Visibility" org-shifttab (not (org-at-table-p))] - ["Sparse Tree" org-occur t] - ["Reveal Context" org-reveal t] - ["Show All" 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" - ["Move Subtree Up" org-shiftmetaup (not (org-at-table-p))] - ["Move Subtree Down" org-shiftmetadown (not (org-at-table-p))] - "--" - ["Copy Subtree" org-copy-special (not (org-at-table-p))] - ["Cut Subtree" org-cut-special (not (org-at-table-p))] - ["Paste Subtree" org-paste-special (not (org-at-table-p))] - "--" - ["Promote Heading" org-metaleft (not (org-at-table-p))] - ["Promote Subtree" org-shiftmetaleft (not (org-at-table-p))] - ["Demote Heading" org-metaright (not (org-at-table-p))] - ["Demote Subtree" org-shiftmetaright (not (org-at-table-p))] - "--" - ["Sort Region/Children" org-sort (not (org-at-table-p))] - "--" - ["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]) - ("Archive" - ["Toggle ARCHIVE tag" org-toggle-archive-tag t] -; ["Check and Tag Children" (org-toggle-archive-tag (4)) -; :active t :keys "C-u C-c C-x C-a"] - ["Sparse trees open ARCHIVE trees" - (setq org-sparse-tree-open-archived-trees - (not org-sparse-tree-open-archived-trees)) - :style toggle :selected org-sparse-tree-open-archived-trees] - ["Cycling opens ARCHIVE trees" - (setq org-cycle-open-archived-trees (not org-cycle-open-archived-trees)) - :style toggle :selected org-cycle-open-archived-trees] - ["Agenda includes ARCHIVE trees" - (setq org-agenda-skip-archived-trees (not org-agenda-skip-archived-trees)) - :style toggle :selected (not org-agenda-skip-archived-trees)] - "--" - ["Move Subtree to Archive" org-advertized-archive-subtree t] - ; ["Check and Move Children" (org-archive-subtree '(4)) - ; :active t :keys "C-u C-c C-x C-s"] - ) - "--" - ("TODO Lists" - ["TODO/DONE/-" org-todo t] - ("Select keyword" - ["Next keyword" org-shiftright (org-on-heading-p)] - ["Previous keyword" org-shiftleft (org-on-heading-p)] - ["Complete Keyword" org-complete (assq :todo-keyword (org-context))] - ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))] - ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))]) - ["Show TODO Tree" org-show-todo-tree t] - ["Global TODO list" org-todo-list t] - "--" - ["Set Priority" org-priority t] - ["Priority Up" org-shiftup t] - ["Priority Down" org-shiftdown t]) - ("TAGS and Properties" - ["Set Tags" 'org-ctrl-c-ctrl-c (org-at-heading-p)] - ["Change tag in region" 'org-change-tag-in-region (org-region-active-p)] - "--" - ["Set property" 'org-set-property t] - ["Column view of properties" org-columns t] - ["Insert Column View DBlock" org-insert-columns-dblock t]) - ("Dates and Scheduling" - ["Timestamp" org-time-stamp t] - ["Timestamp (inactive)" org-time-stamp-inactive t] - ("Change Date" - ["1 Day Later" org-shiftright t] - ["1 Day Earlier" org-shiftleft t] - ["1 ... Later" org-shiftup t] - ["1 ... Earlier" org-shiftdown t]) - ["Compute Time Range" org-evaluate-time-range t] - ["Schedule Item" org-schedule t] - ["Deadline" org-deadline t] - "--" - ["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]) - ("Logging work" - ["Clock in" org-clock-in t] - ["Clock out" org-clock-out t] - ["Clock cancel" org-clock-cancel t] - ["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] - ["Timeline" org-timeline t] - ["Tags Tree" org-tags-sparse-tree t]) - "--" - ("Hyperlinks" - ["Store Link (Global)" org-store-link t] - ["Insert Link" org-insert-link t] - ["Follow Link" org-open-at-point t] - "--" - ["Next link" org-next-link t] - ["Previous link" org-previous-link t] - "--" - ["Descriptive Links" - (progn (org-add-to-invisibility-spec '(org-link)) (org-restart-font-lock)) - :style radio :selected (member '(org-link) buffer-invisibility-spec)] - ["Literal Links" - (progn - (org-remove-from-invisibility-spec '(org-link)) (org-restart-font-lock)) - :style radio :selected (not (member '(org-link) buffer-invisibility-spec))]) - "--" - ["Export/Publish..." org-export t] - ("LaTeX" - ["Org CDLaTeX mode" org-cdlatex-mode :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)] - ["Export LaTeX fragments as images" - (setq org-export-with-LaTeX-fragments (not org-export-with-LaTeX-fragments)) - :style toggle :selected org-export-with-LaTeX-fragments]) - "--" - ("Documentation" - ["Show Version" org-version t] - ["Info Documentation" org-info t]) - ("Customize" - ["Browse Org Group" org-customize t] - "--" - ["Expand This Menu" org-create-customize-menu - (fboundp 'customize-menu-create)]) - "--" - ["Refresh setup" org-mode-restart t] - )) - -(defun org-info (&optional node) - "Read documentation for Org-mode in the info system. -With optional NODE, go directly to that node." - (interactive) - (require 'info) - (Info-goto-node (format "(org)%s" (or node "")))) - -(defun org-install-agenda-files-menu () - (let ((bl (buffer-list))) - (save-excursion - (while bl - (set-buffer (pop bl)) - (if (org-mode-p) (setq bl nil))) - (when (org-mode-p) - (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 (org-agenda-files t)))))))) - -;;;; Documentation - -(defun org-customize () - "Call the customize function with org as argument." - (interactive) - (customize-browse 'org)) - -(defun org-create-customize-menu () - "Create a full customization menu for Org-mode, insert it into the menu." - (interactive) - (if (fboundp 'customize-menu-create) - (progn - (easy-menu-change - '("Org") "Customize" - `(["Browse Org group" org-customize t] - "--" - ,(customize-menu-create 'org) - ["Set" Custom-set t] - ["Save" Custom-save t] - ["Reset to Current" Custom-reset-current t] - ["Reset to Saved" Custom-reset-saved t] - ["Reset to Standard Settings" Custom-reset-standard t])) - (message "\"Org\"-menu now contains full customization menu")) - (error "Cannot expand menu (outdated version of cus-edit.el)"))) - -;;;; Miscellaneous stuff - - -;;; Generally useful functions - -(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-mode table -:table-special on a special filed in a table -:table-table in a table.el table -:link on a hyperlink -:keyword on a keyword: SCHEDULED, DEADLINE, CLOSE,COMMENT, QUOTE. -:target on a <> -:radio-target on a <<>> -:latex-fragment on a LaTeX fragment -:latex-preview on a LaTeX fragment with overlayed 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))) - (p (point)) clist o) - ;; First the large context - (cond - ((org-on-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 (eobp) (backward-char 1)) - (if (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) - (if (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) - - ;; 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-on-target-p) - (push (org-point-in-group p 0 :target) clist) - (goto-char (1- (match-beginning 0))) - (if (looking-at org-radio-target-regexp) - (push (org-point-in-group p 0 :radio-target) clist)) - (goto-char p)) - ((setq o (car (delq nil - (mapcar - (lambda (x) - (if (memq x org-latex-fragment-image-overlays) x)) - (org-overlays-at (point)))))) - (push (list :latex-fragment - (org-overlay-start o) (org-overlay-end o)) clist) - (push (list :latex-preview - (org-overlay-start o) (org-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)) - -;; FIXME: Compare with at-regexp-p Do we need both? -(defun org-in-regexp (re &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 both before and after 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." - (catch 'exit - (let ((pos (point)) - (eol (point-at-eol (+ 1 (or nlines 0)))) - (inc (if visually 1 0))) - (save-excursion - (beginning-of-line (- 1 (or nlines 0))) - (while (re-search-forward re eol t) - (if (and (<= (match-beginning 0) pos) - (>= (+ inc (match-end 0)) pos)) - (throw 'exit (cons (match-beginning 0) (match-end 0))))))))) - -(defun org-at-regexp-p (regexp) - "Is point inside a match of REGEXP in the current line?" - (catch 'exit - (save-excursion - (let ((pos (point)) (end (point-at-eol))) - (beginning-of-line 1) - (while (re-search-forward regexp end t) - (if (and (<= (match-beginning 0) pos) - (>= (match-end 0) pos)) - (throw 'exit t))) - nil)))) - -(defun org-occur-in-agenda-files (regexp &optional nlines) - "Call `multi-occur' with buffers for all agenda files." - (interactive "sOrg-files matching: \np") - (let* ((files (org-agenda-files)) - (tnames (mapcar 'file-truename files)) - (extra org-agenda-multi-occur-extra-files) - f) - (while (setq f (pop extra)) - (unless (member (file-truename f) tnames) - (add-to-list 'files f 'append) - (add-to-list 'tnames (file-truename f) 'append))) - (multi-occur - (mapcar (lambda (x) (or (get-file-buffer x) (find-file-noselect x))) files) - regexp))) - -(defun org-uniquify (list) - "Remove duplicate elements from LIST." - (let (res) - (mapc (lambda (x) (add-to-list 'res x 'append)) list) - res)) - -(defun org-delete-all (elts list) - "Remove all elements in ELTS from LIST." - (while elts - (setq list (delete (pop elts) list))) - list) - -(defun org-back-over-empty-lines () - "Move backwards over witespace, to the beginning of the first empty line. -Returns the number o empty lines passed." - (let ((pos (point))) - (skip-chars-backward " \t\n\r") - (beginning-of-line 2) - (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 ot 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." - (let (pop-up-frames special-display-buffer-names special-display-regexps - special-display-function) - (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-move-line-down (arg) - "Move the current line down. With prefix argument, move it past ARG lines." - (interactive "p") - (let ((col (current-column)) - beg end pos) - (beginning-of-line 1) (setq beg (point)) - (beginning-of-line 2) (setq end (point)) - (beginning-of-line (+ 1 arg)) - (setq pos (move-marker (make-marker) (point))) - (insert (delete-and-extract-region beg end)) - (goto-char pos) - (move-to-column col))) - -(defun org-move-line-up (arg) - "Move the current line up. With prefix argument, move it past ARG lines." - (interactive "p") - (let ((col (current-column)) - beg end pos) - (beginning-of-line 1) (setq beg (point)) - (beginning-of-line 2) (setq end (point)) - (beginning-of-line (- arg)) - (setq pos (move-marker (make-marker) (point))) - (insert (delete-and-extract-region beg end)) - (goto-char pos) - (move-to-column col))) - -(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 ((case-fold-search nil) - e re rpl) - (while (setq e (pop table)) - (setq re (concat "%-?[0-9.]*" (substring (car e) 1))) - (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)))) - string)) - - -(defun org-sublist (list start end) - "Return a section of LIST, from START to END. -Counting starts at 1." - (let (rtn (c start)) - (setq list (nthcdr (1- start) list)) - (while (and list (<= c end)) - (push (pop list) rtn) - (setq c (1+ c))) - (nreverse rtn))) - -(defun org-find-base-buffer-visiting (file) - "Like `find-buffer-visiting' but alway return the base buffer and -not an indirect buffer" - (let ((buf (find-buffer-visiting file))) - (if buf - (or (buffer-base-buffer buf) buf) - nil))) - -(defun org-image-file-name-regexp () - "Return regexp matching the file names of images." - (if (fboundp 'image-file-name-regexp) - (image-file-name-regexp) - (let ((image-file-name-extensions - '("png" "jpeg" "jpg" "gif" "tiff" "tif" - "xbm" "xpm" "pbm" "pgm" "ppm"))) - (concat "\\." - (regexp-opt (nconc (mapcar 'upcase - image-file-name-extensions) - image-file-name-extensions) - t) - "\\'")))) - -(defun org-file-image-p (file) - "Return non-nil if FILE is an image." - (save-match-data - (string-match (org-image-file-name-regexp) file))) - -;;; Paragraph filling stuff. -;; We want this to be just right, so use the full arsenal. - -(defun org-indent-line-function () - "Indent line like previous, but further if previous was headline or item." - (interactive) - (let* ((pos (point)) - (itemp (org-at-item-p)) - column bpos bcol tpos tcol bullet btype bullet-type) - ;; Find the previous relevant line - (beginning-of-line 1) - (cond - ((looking-at "#") (setq column 0)) - ((looking-at "\\*+ ") (setq column 0)) - (t - (beginning-of-line 0) - (while (and (not (bobp)) (looking-at "[ \t]*[\n:#|]")) - (beginning-of-line 0)) - (cond - ((looking-at "\\*+[ \t]+") - (goto-char (match-end 0)) - (setq column (current-column))) - ((org-in-item-p) - (org-beginning-of-item) -; (looking-at "[ \t]*\\(\\S-+\\)[ \t]*") - (looking-at "[ \t]*\\(\\S-+\\)[ \t]*\\(\\[[- X]\\][ \t]*\\)?") - (setq bpos (match-beginning 1) tpos (match-end 0) - bcol (progn (goto-char bpos) (current-column)) - tcol (progn (goto-char tpos) (current-column)) - bullet (match-string 1) - bullet-type (if (string-match "[0-9]" bullet) "n" bullet)) - (if (not itemp) - (setq column tcol) - (goto-char pos) - (beginning-of-line 1) - (if (looking-at "\\S-") - (progn - (looking-at "[ \t]*\\(\\S-+\\)[ \t]*") - (setq bullet (match-string 1) - btype (if (string-match "[0-9]" bullet) "n" bullet)) - (setq column (if (equal btype bullet-type) bcol tcol))) - (setq column (org-get-indentation))))) - (t (setq column (org-get-indentation)))))) - (goto-char pos) - (if (<= (current-column) (current-indentation)) - (indent-line-to column) - (save-excursion (indent-line-to column))) - (setq column (current-column)) - (beginning-of-line 1) - (if (looking-at - "\\([ \t]+\\)\\(:[-_0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)") - (replace-match (concat "\\1" (format org-property-format - (match-string 2) (match-string 3))) - t nil)) - (move-to-column column))) - -(defun org-set-autofill-regexps () - (interactive) - ;; In the paragraph separator we include headlines, because filling - ;; text in a line directly attached to a headline would otherwise - ;; fill the headline as well. - (org-set-local 'comment-start-skip "^#+[ \t]*") - (org-set-local 'paragraph-separate "\f\\|\\*+ \\|[ ]*$\\|[ \t]*[:|]") - ;; The paragraph starter includes hand-formatted lists. - (org-set-local 'paragraph-start - "\f\\|[ ]*$\\|\\*+ \\|\f\\|[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)\\|[ \t]*[:|]") - ;; Inhibit auto-fill for headers, tables and fixed-width lines. - ;; But only if the user has not turned off tables or fixed-width regions - (org-set-local - 'auto-fill-inhibit-regexp - (concat "\\*+ \\|#\\+" - "\\|[ \t]*" org-keyword-time-regexp - (if (or org-enable-table-editor org-enable-fixed-width-editor) - (concat - "\\|[ \t]*[" - (if org-enable-table-editor "|" "") - (if org-enable-fixed-width-editor ":" "") - "]")))) - ;; We use our own fill-paragraph function, to make sure that tables - ;; and fixed-width regions are not wrapped. That function will pass - ;; through to `fill-paragraph' when appropriate. - (org-set-local 'fill-paragraph-function 'org-fill-paragraph) - ; Adaptive filling: To get full control, first make sure that - ;; `adaptive-fill-regexp' never matches. Then install our own matcher. - (org-set-local 'adaptive-fill-regexp "\000") - (org-set-local 'adaptive-fill-function - 'org-adaptive-fill-function)) - -(defun org-fill-paragraph (&optional justify) - "Re-align a table, pass through to fill-paragraph if no table." - (let ((table-p (org-at-table-p)) - (table.el-p (org-at-table.el-p))) - (cond ((and (equal (char-after (point-at-bol)) ?*) - (save-excursion (goto-char (point-at-bol)) - (looking-at outline-regexp))) - t) ; skip headlines - (table.el-p t) ; skip table.el tables - (table-p (org-table-align) t) ; align org-mode tables - (t nil)))) ; call paragraph-fill - -;; For reference, this is the default value of adaptive-fill-regexp -;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*" - -(defun org-adaptive-fill-function () - "Return a fill prefix for org-mode files. -In particular, this makes sure hanging paragraphs for hand-formatted lists -work correctly." - (cond ((looking-at "#[ \t]+") - (match-string 0)) - ((looking-at "[ \t]*\\([-*+] \\|[0-9]+[.)] \\)?") - (save-excursion - (goto-char (match-end 0)) - (make-string (current-column) ?\ ))) - (t nil))) - -;;;; Functions extending outline functionality - -(defun org-beginning-of-line (&optional arg) - "Go to the beginning of the current line. If that is invisible, continue -to a visible line beginning. This makes the function of C-a more intuitive. -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." - (interactive "P") - (let ((pos (point))) - (beginning-of-line 1) - (if (bobp) - nil - (backward-char 1) - (if (org-invisible-p) - (while (and (not (bobp)) (org-invisible-p)) - (backward-char 1) - (beginning-of-line 1)) - (forward-char 1))) - (when org-special-ctrl-a/e - (cond - ((and (looking-at org-todo-line-regexp) - (= (char-after (match-end 1)) ?\ )) - (goto-char - (if (eq org-special-ctrl-a/e t) - (cond ((> pos (match-beginning 3)) (match-beginning 3)) - ((= pos (point)) (match-beginning 3)) - (t (point))) - (cond ((> pos (point)) (point)) - ((not (eq last-command this-command)) (point)) - (t (match-beginning 3)))))) - ((org-at-item-p) - (goto-char - (if (eq org-special-ctrl-a/e t) - (cond ((> pos (match-end 4)) (match-end 4)) - ((= pos (point)) (match-end 4)) - (t (point))) - (cond ((> pos (point)) (point)) - ((not (eq last-command this-command)) (point)) - (t (match-end 4)))))))))) - -(defun org-end-of-line (&optional arg) - "Go to the end of the 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." - (interactive "P") - (if (or (not org-special-ctrl-a/e) - (not (org-on-heading-p))) - (end-of-line arg) - (let ((pos (point))) - (beginning-of-line 1) - (if (looking-at (org-re ".*?\\([ \t]*\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) - (if (eq org-special-ctrl-a/e t) - (if (or (< pos (match-beginning 1)) - (= pos (match-end 0))) - (goto-char (match-beginning 1)) - (goto-char (match-end 0))) - (if (or (< pos (match-end 0)) (not (eq this-command last-command))) - (goto-char (match-end 0)) - (goto-char (match-beginning 1)))) - (end-of-line arg))))) - -(define-key org-mode-map "\C-a" 'org-beginning-of-line) -(define-key org-mode-map "\C-e" 'org-end-of-line) - -(defun org-invisible-p () - "Check if point is at a character currently not visible." - ;; Early versions of noutline don't have `outline-invisible-p'. - (if (fboundp 'outline-invisible-p) - (outline-invisible-p) - (get-char-property (point) 'invisible))) - -(defun org-invisible-p2 () - "Check if point is at a character currently not visible." - (save-excursion - (if (and (eolp) (not (bobp))) (backward-char 1)) - ;; Early versions of noutline don't have `outline-invisible-p'. - (if (fboundp 'outline-invisible-p) - (outline-invisible-p) - (get-char-property (point) 'invisible)))) - -(defalias 'org-back-to-heading 'outline-back-to-heading) -(defalias 'org-on-heading-p 'outline-on-heading-p) -(defalias 'org-at-heading-p 'outline-on-heading-p) -(defun org-at-heading-or-item-p () - (or (org-on-heading-p) (org-at-item-p))) - -(defun org-on-target-p () - (or (org-in-regexp org-radio-target-regexp) - (org-in-regexp org-target-regexp))) - -(defun org-up-heading-all (arg) - "Move to the heading line of which the present line is a subheading. -This function considers both visible and invisible heading lines. -With argument, move up ARG levels." - (if (fboundp 'outline-up-heading-all) - (outline-up-heading-all arg) ; emacs 21 version of outline.el - (outline-up-heading arg t))) ; emacs 22 version of outline.el - -(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." - (let ((pos (point)) start-level level - (re (concat "^" outline-regexp))) - (catch 'exit - (outline-back-to-heading t) - (setq start-level (funcall outline-level)) - (if (equal start-level 1) (throw 'exit nil)) - (while (re-search-backward re nil t) - (setq level (funcall outline-level)) - (if (< level start-level) (throw 'exit level))) - nil))) - -(defun org-first-sibling-p () - "Is this heading the first child of its parents?" - (interactive) - (let ((re (concat "^" outline-regexp)) - level l) - (unless (org-at-heading-p t) - (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 (concat "^" outline-regexp)) - level l) - (when (condition-case nil (org-back-to-heading t) (error nil)) - (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-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-end-of-subtree (&optional invisible-OK to-heading) - ;; This is an exact copy of the original function, but it uses - ;; `org-back-to-heading', to make it work also in invisible - ;; trees. And is uses an invisible-OK argument. - ;; Under Emacs this is not needed, but the old outline.el needs this fix. - (org-back-to-heading invisible-OK) - (let ((first t) - (level (funcall outline-level))) - (while (and (not (eobp)) - (or first (> (funcall outline-level) level))) - (setq first nil) - (outline-next-heading)) - (unless to-heading - (if (memq (preceding-char) '(?\n ?\^M)) - (progn - ;; Go to end of line before heading - (forward-char -1) - (if (memq (preceding-char) '(?\n ?\^M)) - ;; leave blank line before heading - (forward-char -1)))))) - (point)) - -(defun org-show-subtree () - "Show everything after this heading at deeper levels." - (outline-flag-region - (point) - (save-excursion - (outline-end-of-subtree) (outline-next-heading) (point)) - nil)) - -(defun org-show-entry () - "Show the body directly following this heading. -Show the heading too, if it is currently invisible." - (interactive) - (save-excursion - (condition-case nil - (progn - (org-back-to-heading t) - (outline-flag-region - (max (point-min) (1- (point))) - (save-excursion - (re-search-forward - (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move) - (or (match-beginning 1) (point-max))) - nil)) - (error nil)))) - -(defun org-make-options-regexp (kwds) - "Make a regular expression for keyword lines." - (concat - "^" - "#?[ \t]*\\+\\(" - (mapconcat 'regexp-quote kwds "\\|") - "\\):[ \t]*" - "\\(.+\\)")) - -;; Make isearch reveal the necessary context -(defun org-isearch-end () - "Reveal context after isearch exits." - (when isearch-success ; only if search was successful - (if (featurep 'xemacs) - ;; Under XEmacs, the hook is run in the correct place, - ;; we directly show the context. - (org-show-context 'isearch) - ;; In Emacs the hook runs *before* restoring the overlays. - ;; So we have to use a one-time post-command-hook to do this. - ;; (Emacs 22 has a special variable, see function `org-mode') - (unless (and (boundp 'isearch-mode-end-hook-quit) - isearch-mode-end-hook-quit) - ;; Only when the isearch was not quitted. - (org-add-hook 'post-command-hook 'org-isearch-post-command - 'append 'local))))) - -(defun org-isearch-post-command () - "Remove self from hook, and show context." - (remove-hook 'post-command-hook 'org-isearch-post-command 'local) - (org-show-context 'isearch)) - - -;;;; Integration with and fixes for other packages - -;;; Imenu support - -(defvar org-imenu-markers nil - "All markers currently used by Imenu.") -(make-variable-buffer-local 'org-imenu-markers) - -(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." - (mapc (lambda (x) (move-marker x nil)) org-imenu-markers) - (setq org-imenu-markers nil) - (let* ((n org-imenu-depth) - (re (concat "^" outline-regexp)) - (subs (make-vector (1+ n) nil)) - (last-level 0) - m tree level head) - (save-excursion - (save-restriction - (widen) - (goto-char (point-max)) - (while (re-search-backward re nil t) - (setq level (org-reduced-level (funcall outline-level))) - (when (<= level n) - (looking-at org-complex-heading-regexp) - (setq head (org-match-string-no-properties 4) - 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)) - (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 () (org-show-context 'org-goto))))) - -;; Speedbar support - -(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) - (let (p m tp np dir txt w) - (cond - ((setq p (text-property-any (point-at-bol) (point-at-eol) - 'org-imenu t)) - (setq m (get-text-property p 'org-imenu-marker)) - (save-excursion - (save-restriction - (set-buffer (marker-buffer m)) - (goto-char m) - (org-agenda-set-restriction-lock 'subtree)))) - ((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)))) - (save-excursion - (save-restriction - (set-buffer (find-file-noselect - (let ((default-directory dir)) - (expand-file-name txt)))) - (unless (org-mode-p) - (error "Cannot restrict to non-Org-mode file")) - (org-agenda-set-restriction-lock 'file)))) - (t (error "Don't know how to restrict Org-mode's agenda"))) - (org-move-overlay org-speedbar-restriction-lock-overlay - (point-at-bol) (point-at-eol)) - (setq current-prefix-arg nil) - (org-agenda-maybe-redo))) - -(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 () (org-show-context 'org-goto))))) - - -;;; Fixes and Hacks - -;; Make flyspell not check words in links, to not mess up our keymap -(defun org-mode-flyspell-verify () - "Don't let flyspell put overlays at active buttons." - (not (get-text-property (point) 'keymap))) - -;; Make `bookmark-jump' show the jump location if it was hidden. -(eval-after-load "bookmark" - '(if (boundp 'bookmark-after-jump-hook) - ;; We can use the hook - (add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide) - ;; Hook not available, use advice - (defadvice bookmark-jump (after org-make-visible activate) - "Make the position visible." - (org-bookmark-jump-unhide)))) - -(defun org-bookmark-jump-unhide () - "Unhide the current position, to show the bookmark location." - (and (org-mode-p) - (or (org-invisible-p) - (save-excursion (goto-char (max (point-min) (1- (point)))) - (org-invisible-p))) - (org-show-context 'bookmark-jump))) - -;; Fix a bug in htmlize where there are text properties (face nil) -(eval-after-load "htmlize" - '(progn - (defadvice htmlize-faces-in-buffer (after org-no-nil-faces activate) - "Make sure there are no nil faces" - (setq ad-return-value (delq nil ad-return-value))))) - -;; Make session.el ignore our circular variable -(eval-after-load "session" - '(add-to-list 'session-globals-exclude 'org-mark-ring)) - -;;;; Experimental code - -(defun org-closed-in-range () - "Sparse tree of items closed in a certain time range. -Still experimental, may disappear in the future." - (interactive) - ;; Get the time interval from the user. - (let* ((time1 (time-to-seconds - (org-read-date nil 'to-time nil "Starting date: "))) - (time2 (time-to-seconds - (org-read-date nil 'to-time nil "End date:"))) - ;; callback function - (callback (lambda () - (let ((time - (time-to-seconds - (apply 'encode-time - (org-parse-time-string - (match-string 1)))))) - ;; check if time in interval - (and (>= time time1) (<= time time2)))))) - ;; make tree, check each match with the callback - (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback))) - -;;;; Finish up - -(provide 'org) - -(run-hooks 'org-load-hook) - -;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd -;;; org.el ends here - diff --git a/EXPERIMENTAL/interactive-query/org.el.orig b/EXPERIMENTAL/interactive-query/org.el.orig deleted file mode 100644 index 276854ad5..000000000 --- a/EXPERIMENTAL/interactive-query/org.el.orig +++ /dev/null @@ -1,27781 +0,0 @@ -;;; org.el --- Outline-based notes management and organizer -;; Carstens outline-mode for keeping track of everything. -;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. -;; -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; Version: 5.18a -;; -;; 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, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: -;; -;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing -;; project planning with a fast and effective plain-text system. -;; -;; Org-mode develops organizational tasks around 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-mode 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 -;; -;; http://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 etc/ directory of Emacs 22. -;; -;; A list of recent changes can be found at -;; http://orgmode.org/Changes.html -;; -;;; Code: - -;;;; Require other packages - -(eval-when-compile - (require 'cl) - (require 'gnus-sum) - (require 'calendar)) -;; For XEmacs, noutline is not yet provided by outline.el, so arrange for -;; the file noutline.el being loaded. -(if (featurep 'xemacs) (condition-case nil (require 'noutline))) -;; We require noutline, which might be provided in outline.el -(require 'outline) (require 'noutline) -;; Other stuff we need. -(require 'time-date) -(unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time)) -(require 'easymenu) - -;;;; Customization variables - -;;; Version - -(defconst org-version "5.17a" - "The version number of the file org.el.") -(defun org-version () - (interactive) - (message "Org-mode version %s" org-version)) - -;;; Compatibility constants -(defconst org-xemacs-p (featurep 'xemacs)) ; not used by org.el itself -(defconst org-format-transports-properties-p - (let ((x "a")) - (add-text-properties 0 1 '(test t) x) - (get-text-property 0 'test (format "%s" x))) - "Does format transport text properties?") - -(defmacro org-bound-and-true-p (var) - "Return the value of symbol VAR if it is bound, else nil." - `(and (boundp (quote ,var)) ,var)) - -(defmacro org-unmodified (&rest body) - "Execute body without changing buffer-modified-p." - `(set-buffer-modified-p - (prog1 (buffer-modified-p) ,@body))) - -(defmacro org-re (s) - "Replace posix classes in regular expression." - (if (featurep 'xemacs) - (let ((ss s)) - (save-match-data - (while (string-match "\\[:alnum:\\]" ss) - (setq ss (replace-match "a-zA-Z0-9" t t ss))) - (while (string-match "\\[:alpha:\\]" ss) - (setq ss (replace-match "a-zA-Z" t t ss))) - ss)) - s)) - -(defmacro org-preserve-lc (&rest body) - `(let ((_line (org-current-line)) - (_col (current-column))) - (unwind-protect - (progn ,@body) - (goto-line _line) - (move-to-column _col)))) - -(defmacro org-without-partial-completion (&rest body) - `(let ((pc-mode (and (boundp 'partial-completion-mode) - partial-completion-mode))) - (unwind-protect - (progn - (if pc-mode (partial-completion-mode -1)) - ,@body) - (if pc-mode (partial-completion-mode 1))))) - -;;; The custom variables - -(defgroup org nil - "Outline-based notes management and organizer." - :tag "Org" - :group 'outlines - :group 'hypermedia - :group 'calendar) - -;; FIXME: Needs a separate group... -(defcustom org-completion-fallback-command 'hippie-expand - "The expansion command called by \\[org-complete] in normal context. -Normal means, no org-mode-specific context." - :group 'org - :type 'function) - -(defgroup org-startup nil - "Options concerning startup of Org-mode." - :tag "Org Startup" - :group 'org) - -(defcustom org-startup-folded t - "Non-nil means, entering Org-mode will switch to OVERVIEW. -This can also be configured on a per-file basis by adding one of -the following lines anywhere in the buffer: - - #+STARTUP: fold - #+STARTUP: nofold - #+STARTUP: content" - :group 'org-startup - :type '(choice - (const :tag "nofold: show all" nil) - (const :tag "fold: overview" t) - (const :tag "content: all headlines" content))) - -(defcustom org-startup-truncated t - "Non-nil means, entering Org-mode will set `truncate-lines'. -This is useful since some lines containing links can be very long and -uninteresting. Also tables look terrible when wrapped." - :group 'org-startup - :type 'boolean) - -(defcustom org-startup-align-all-tables nil - "Non-nil means, align all tables when visiting a file. -This is useful when the column width in tables is forced with 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-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- keys for changing timestamps and priorities. -These keys are also used by other packages like `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) - -(if (fboundp 'defvaralias) - (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's 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." - (if org-replace-disputed-keys - (let* ((nkey (key-description key)) - (x (org-find-if (lambda (x) - (equal (key-description (car x)) nkey)) - org-disputed-keys))) - (if x (cdr x) key)) - key)) - -(defun org-find-if (predicate seq) - (catch 'exit - (while seq - (if (funcall predicate (car seq)) - (throw 'exit (car seq)) - (pop seq))))) - -(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 string, use that instead, -When a face, use the standart 3 dots, but with the specified face. -The change affects only Org-mode (which will then use its own display table). -Changing this requires executing `M-x org-mode' in a buffer to become -effective." - :group 'org-startup - :type '(choice (const :tag "Default" nil) - (face :tag "Face" :value org-warning) - (string :tag "String" :value "...#"))) - -(defvar org-display-table nil - "The display table for org-mode, in case `org-ellipsis' is non-nil.") - -(defgroup org-keywords nil - "Keywords in Org-mode." - :tag "Org Keywords" - :group 'org) - -(defcustom org-deadline-string "DEADLINE:" - "String to mark deadline entries. -A deadline is this string, followed by a time stamp. Should be a word, -terminated by a colon. You can insert a schedule keyword and -a timestamp with \\[org-deadline]. -Changes become only effective after restarting Emacs." - :group 'org-keywords - :type 'string) - -(defcustom org-scheduled-string "SCHEDULED:" - "String to mark scheduled TODO entries. -A schedule is this string, followed by a time stamp. Should be a word, -terminated by a colon. You can insert a schedule keyword and -a timestamp with \\[org-schedule]. -Changes become only effective after restarting Emacs." - :group 'org-keywords - :type 'string) - -(defcustom org-closed-string "CLOSED:" - "String used as the prefix for timestamps logging closing a TODO entry." - :group 'org-keywords - :type 'string) - -(defcustom org-clock-string "CLOCK:" - "String used as prefix for timestamps clocking work hours on an item." - :group 'org-keywords - :type 'string) - -(defcustom org-comment-string "COMMENT" - "Entries starting with this keyword will never be exported. -An entry can be toggled between COMMENT and normal with -\\[org-toggle-comment]. -Changes become only effective after restarting Emacs." - :group 'org-keywords - :type 'string) - -(defcustom org-quote-string "QUOTE" - "Entries starting with this keyword will be exported in fixed-width font. -Quoting applies only to the text in the entry following the headline, and does -not extend beyond the next headline, even if that is lower level. -An entry can be toggled between QUOTE and normal with -\\[org-toggle-fixed-width-section]." - :group 'org-keywords - :type 'string) - -(defconst org-repeat-re - (concat "\\(?:\\<\\(?:" org-scheduled-string "\\|" org-deadline-string "\\)" - " +<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*\\)\\(\\+[0-9]+[dwmy]\\)") - "Regular expression for specifying repeated events. -After a match, group 1 contains the repeat expression.") - -(defgroup org-structure nil - "Options concerning the general structure of Org-mode 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) - -(defconst org-context-choice - '(choice - (const :tag "Always" t) - (const :tag "Never" 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)) - (boolean)))) - "Contexts for the reveal options.") - -(defcustom org-show-hierarchy-above '((default . t)) - "Non-nil means, show full hierarchy when revealing a location. -Org-mode often shows locations in an org-mode file which might have -been invisible before. When this is set, the hierarchy of headings -above the exposed location is shown. -Turning this off for example for sparse trees makes them very compact. -Instead of t, this can also be an alist specifying this option for different -contexts. Valid contexts are - agenda when exposing an entry from the agenda - org-goto when using the command `org-goto' on key C-c C-j - occur-tree when using the command `org-occur' on key C-c / - 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" - :group 'org-reveal-location - :type org-context-choice) - -(defcustom org-show-following-heading '((default . nil)) - "Non-nil means, show following heading when revealing a location. -Org-mode often shows locations in an org-mode file which might have -been invisible before. When this is set, the heading following the -match is shown. -Turning this off for example for sparse trees makes them very compact, -but makes it harder to edit the location of the match. In such a case, -use the command \\[org-reveal] to show more context. -Instead of t, this can also be an alist specifying this option for different -contexts. See `org-show-hierarchy-above' for valid contexts." - :group 'org-reveal-location - :type org-context-choice) - -(defcustom org-show-siblings '((default . nil) (isearch t)) - "Non-nil means, show all sibling heading when revealing a location. -Org-mode often shows locations in an org-mode file which might have -been invisible before. When this is set, the sibling of the current entry -heading are all made visible. If `org-show-hierarchy-above' is t, -the same happens on each level of the hierarchy above the current entry. - -By default this is on for the isearch context, off for all other contexts. -Turning this off for example for sparse trees makes them very compact, -but makes it harder to edit the location of the match. In such a case, -use the command \\[org-reveal] to show more context. -Instead of t, this can also be an alist specifying this option for different -contexts. See `org-show-hierarchy-above' for valid contexts." - :group 'org-reveal-location - :type org-context-choice) - -(defcustom org-show-entry-below '((default . nil)) - "Non-nil means, show the entry below a headline when revealing a location. -Org-mode often shows locations in an org-mode file which might have -been invisible before. When this is set, the text below the headline that is -exposed is also shown. - -By default this is off for all contexts. -Instead of t, this can also be an alist specifying this option for different -contexts. See `org-show-hierarchy-above' for valid contexts." - :group 'org-reveal-location - :type org-context-choice) - -(defgroup org-cycle nil - "Options concerning visibility cycling in Org-mode." - :tag "Org Cycle" - :group 'org-structure) - -(defcustom org-drawers '("PROPERTIES" "CLOCK") - "Names of drawers. Drawers are not opened by cycling on the headline above. -Drawers only open with a TAB on the drawer line itself. A drawer looks like -this: - :DRAWERNAME: - ..... - :END: -The drawer \"PROPERTIES\" is special for capturing properties through -the property API. - -Drawers can be defined on the per-file basis with a line like: - -#+DRAWERS: HIDDEN STATE PROPERTIES" - :group 'org-structure - :type '(repeat (string :tag "Drawer Name"))) - -(defcustom org-cycle-global-at-bob nil - "Cycle globally if cursor is at beginning of buffer and not at a headline. -This makes it possible to do global cycling without having to use S-TAB or -C-u TAB. For this special case to work, the first line of the buffer -must not be a headline - it may be empty ot some other text. When used in -this way, `org-cycle-hook' is disables temporarily, to make sure the -cursor stays at the beginning of the buffer. -When this option is nil, don't do anything special at the beginning -of the buffer." - :group 'org-cycle - :type 'boolean) - -(defcustom org-cycle-emulate-tab t - "Where should `org-cycle' emulate TAB. -nil Never -white Only in completely white lines -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. - -Special case: when 0, never leave empty lines in collapsed view." - :group 'org-cycle - :type 'integer) - -(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', `content', or `all'. After a local state change, it can have -the values `folded', `children', or `subtree'." - :group 'org-cycle - :type 'hook) - -(defgroup org-edit-structure nil - "Options concerning structure editing in Org-mode." - :tag "Org Edit Structure" - :group 'org-structure) - -(defcustom org-special-ctrl-a/e nil - "Non-nil means `C-a' and `C-e' behave specially in headlines and items. -When t, `C-a' will bring back the cursor to the beginning of the -headline text, i.e. after the stars and after a possible TODO keyword. -In an item, this will be the position after the bullet. -When the cursor is already at that position, another `C-a' will bring -it to the beginning of the line. -`C-e' will jump to the end of the headline, ignoring the presence of tags -in the headline. A second `C-e' will then jump to the true end of the -line, after any tags. -When set to the symbol `reversed', the first `C-a' or `C-e' works normally, -and only a directly following, identical keypress will bring the cursor -to the special positions." - :group 'org-edit-structure - :type '(choice - (const :tag "off" nil) - (const :tag "after bullet first" t) - (const :tag "border first" reversed))) - -(if (fboundp 'defvaralias) - (defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e)) - -(defcustom org-odd-levels-only nil - "Non-nil means, skip even levels and only use odd levels for the outline. -This has the effect that two stars are being added/taken away in -promotion/demotion commands. It also influences how levels are -handled by the exporters. -Changing it requires restart of `font-lock-mode' to become effective -for fontification also in regions already fontified. -You may also set this on a per-file basis by adding one of the following -lines to the buffer: - - #+STARTUP: odd - #+STARTUP: oddeven" - :group 'org-edit-structure - :group 'org-font-lock - :type 'boolean) - -(defcustom org-adapt-indentation t - "Non-nil means, adapt indentation when promoting and demoting. -When this is set and the *entire* text in an entry is indented, the -indentation is increased by one space in a demotion command, and -decreased by one in a promotion command. If any line in the entry -body starts at column 0, indentation is not changed at all." - :group 'org-edit-structure - :type 'boolean) - -(defcustom org-blank-before-new-entry '((heading . nil) - (plain-list-item . nil)) - "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." - :group 'org-edit-structure - :type '(list - (cons (const heading) (boolean)) - (cons (const plain-list-item) (boolean)))) - -(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. -See also the QUOTE keyword." - :group 'org-edit-structure - :type 'boolean) - -(defgroup org-sparse-trees nil - "Options concerning sparse trees in Org-mode." - :tag "Org Sparse Trees" - :group 'org-structure) - -(defcustom org-highlight-sparse-tree-matches t - "Non-nil means, highlight all matches that define a sparse tree. -The highlights will automatically disappear the next time the buffer is -changed by an edit command." - :group 'org-sparse-trees - :type 'boolean) - -(defcustom org-remove-highlights-with-change t - "Non-nil means, any change to the buffer will remove temporary highlights. -Such highlights are created by `org-occur' and `org-clock-display'. -When nil, `C-c C-c needs to be used to get rid of the highlights. -The highlights created by `org-preview-latex-fragment' always need -`C-c C-c' to be removed." - :group 'org-sparse-trees - :group 'org-time - :type 'boolean) - - -(defcustom org-occur-hook '(org-first-headline-recenter) - "Hook that is run after `org-occur' has constructed a sparse tree. -This can be used to recenter the window to show as much of the structure -as possible." - :group 'org-sparse-trees - :type 'hook) - -(defgroup org-plain-lists nil - "Options concerning plain lists in Org-mode." - :tag "Org Plain lists" - :group 'org-structure) - -(defcustom org-cycle-include-plain-lists nil - "Non-nil means, include plain lists into visibility cycling. -This means that during cycling, plain list items will *temporarily* be -interpreted as outline headlines with a level given by 1000+i where i is the -indentation of the bullet. In all other operations, plain list items are -not seen as headlines. For example, you cannot assign a TODO keyword to -such an item." - :group 'org-plain-lists - :type 'boolean) - -(defcustom org-plain-list-ordered-item-terminator t - "The character that makes a line with leading number an ordered list item. -Valid values are ?. and ?\). To get both terminators, use t. While -?. may look nicer, it creates the danger that a line with leading -number may be incorrectly interpreted as an item. ?\) therefore is -the safe choice." - :group 'org-plain-lists - :type '(choice (const :tag "dot like in \"2.\"" ?.) - (const :tag "paren like in \"2)\"" ?\)) - (const :tab "both" t))) - -(defcustom org-auto-renumber-ordered-lists t - "Non-nil means, automatically renumber ordered plain lists. -Renumbering happens when the sequence have been changed with -\\[org-shiftmetaup] or \\[org-shiftmetadown]. After other editing commands, -use \\[org-ctrl-c-ctrl-c] to trigger renumbering." - :group 'org-plain-lists - :type 'boolean) - -(defcustom org-provide-checkbox-statistics t - "Non-nil means, update checkbox statistics after insert and toggle. -When this is set, checkbox statistics is updated each time you either insert -a new checkbox with \\[org-insert-todo-heading] or toggle a checkbox -with \\[org-ctrl-c-ctrl-c\\]." - :group 'org-plain-lists - :type 'boolean) - -(defgroup org-archive nil - "Options concerning archiving in Org-mode." - :tag "Org Archive" - :group 'org-structure) - -(defcustom org-archive-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. -After changing this, font-lock must be restarted in the relevant buffers to -get the proper fontification." - :group 'org-archive - :group 'org-keywords - :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." - :group 'org-archive - :group 'org-agenda-skip - :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-archive-location "%s_archive::" - "The location where subtrees should be archived. -This string consists of two parts, separated by a double-colon. - -The first part is a file name - when omitted, archiving happens in the same -file. %s will be replaced by the current file name (without directory part). -Archiving to a different file is useful to keep archived entries from -contributing to the Org-mode Agenda. - -The part after the double colon is a headline. The archived entries will be -filed under that headline. When omitted, the subtrees are simply filed away -at the end of the file, as top-level entries. - -Here are a few examples: -\"%s_archive::\" - If the current file is Projects.org, archive in file - Projects.org_archive, as top-level trees. This is the default. - -\"::* Archived Tasks\" - Archive in the current file, under the top-level headline - \"* Archived Tasks\". - -\"~/org/archive.org::\" - Archive in file ~/org/archive.org (absolute path), as top-level trees. - -\"basement::** Finished Tasks\" - Archive in file ./basement (relative path), as level 3 trees - below the level 2 heading \"** Finished Tasks\". - -You may set this option on a per-file basis by adding to the buffer a -line like - -#+ARCHIVE: basement::** Finished Tasks" - :group 'org-archive - :type 'string) - -(defcustom org-archive-mark-done t - "Non-nil means, mark entries as DONE when they are moved to the archive file. -This can be a string to set the keyword to use. When t, Org-mode will -use the first keyword in its list that means done." - :group 'org-archive - :type '(choice - (const :tag "No" nil) - (const :tag "Yes" t) - (string :tag "Use this keyword"))) - -(defcustom org-archive-stamp-time t - "Non-nil means, add a time stamp to entries moved to an archive file. -This variable is obsolete and has no effect anymore, instead add ot remove -`time' from the variablle `org-archive-save-context-info'." - :group 'org-archive - :type 'boolean) - -(defcustom org-archive-save-context-info '(time file category todo itags) - "Parts of context info that should be stored as properties when archiving. -When a subtree is moved to an archive file, it looses information given by -context, like inherited tags, the category, and possibly also the TODO -state (depending on the variable `org-archive-mark-done'). -This variable can be a list of any of the following symbols: - -time The time of archiving. -file The file where the entry originates. -itags The local tags, in the headline of the subtree. -ltags The tags the subtree inherits from further up the hierarchy. -todo The pre-archive TODO state. -category The category, taken from file name or #+CATEGORY lines. - -For each symbol present in the list, a property will be created in -the archived entry, with a prefix \"PRE_ARCHIVE_\", to remember this -information." - :group 'org-archive - :type '(set :greedy t - (const :tag "Time" time) - (const :tag "File" file) - (const :tag "Category" category) - (const :tag "TODO state" todo) - (const :tag "TODO state" priority) - (const :tag "Inherited tags" itags) - (const :tag "Local tags" ltags))) - -(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-mode headlines. -This also applied for speedbar access." - :group 'org-imenu-and-speedbar - :type 'number) - -(defgroup org-table nil - "Options concerning tables in Org-mode." - :tag "Org Table" - :group 'org) - -(defcustom org-enable-table-editor 'optimized - "Non-nil means, lines starting with \"|\" are handled by the table editor. -When nil, such lines will be treated like ordinary lines. - -When equal to the symbol `optimized', the table editor will be optimized to -do the following: -- Automatic overwrite mode in front of whitespace in table fields. - This makes the structure of the table stay in tact as long as the edited - field does not exceed the column width. -- Minimize the number of realigns. Normally, the table is aligned each time - TAB or RET are pressed to move to another field. With optimization this - happens only if changes to a field might have changed the column width. -Optimization requires replacing the functions `self-insert-command', -`delete-char', and `backward-delete-char' in Org-mode buffers, with a -slight (in fact: unnoticeable) speed impact for normal typing. Org-mode is -very good at guessing when a re-align will be necessary, but you can always -force one with \\[org-ctrl-c-ctrl-c]. - -If you would like to use the optimized version in Org-mode, but the -un-optimized version in OrgTbl-mode, see the variable `orgtbl-optimized'. - -This variable can be used to turn on and off the table editor during a session, -but in order to toggle optimization, a restart is required. - -See also the variable `org-table-auto-blank-field'." - :group 'org-table - :type '(choice - (const :tag "off" nil) - (const :tag "on" t) - (const :tag "on, optimized" optimized))) - -(defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized) - "Non-nil means, use the optimized table editor version for `orgtbl-mode'. -In the optimized version, the table editor takes over all simple keys that -normally just insert a character. In tables, the characters are inserted -in a way to minimize disturbing the table structure (i.e. in overwrite mode -for empty fields). Outside tables, the correct binding of the keys is -restored. - -The default for this option is t if the optimized version is also used in -Org-mode. See the variable `org-enable-table-editor' for details. Changing -this variable requires a restart of Emacs to become effective." - :group 'org-table - :type 'boolean) - -(defcustom orgtbl-radio-table-templates - '((latex-mode "% BEGIN RECEIVE ORGTBL %n -% END RECEIVE ORGTBL %n -\\begin{comment} -#+ORGTBL: SEND %n orgtbl-to-latex :splice nil :skip 0 -| | | -\\end{comment}\n") - (texinfo-mode "@c BEGIN RECEIVE ORGTBL %n -@c END RECEIVE ORGTBL %n -@ignore -#+ORGTBL: SEND %n orgtbl-to-html :splice nil :skip 0 -| | | -@end ignore\n") - (html-mode " - -\n")) - "Templates for radio tables in different major modes. -All occurrences of %n in a template will be replaced with the name of the -table, obtained by prompting the user." - :group 'org-table - :type '(repeat - (list (symbol :tag "Major mode") - (string :tag "Format")))) - -(defgroup org-table-settings nil - "Settings for tables in Org-mode." - :tag "Org Table Settings" - :group 'org-table) - -(defcustom org-table-default-size "5x2" - "The default size for newly created tables, Columns x Rows." - :group 'org-table-settings - :type 'string) - -(defcustom org-table-number-regexp - "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%:]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$" - "Regular expression for recognizing numbers in table columns. -If a table column contains mostly numbers, it will be aligned to the -right. If not, it will be aligned to the left. - -The default value of this option is a regular expression which allows -anything which looks remotely like a number as used in scientific -context. For example, all of the following will be considered a -number: - 12 12.2 2.4e-08 2x10^12 4.034+-0.02 2.7(10) >3.5 - -Other options offered by the customize interface are more restrictive." - :group 'org-table-settings - :type '(choice - (const :tag "Positive Integers" - "^[0-9]+$") - (const :tag "Integers" - "^[-+]?[0-9]+$") - (const :tag "Floating Point Numbers" - "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.[0-9]*\\)$") - (const :tag "Floating Point Number or Integer" - "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.?[0-9]*\\)$") - (const :tag "Exponential, Floating point, Integer" - "^[-+]?[0-9.]+\\([eEdD][-+0-9]+\\)?$") - (const :tag "Very General Number-Like, including hex" - "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$") - (string :tag "Regexp:"))) - -(defcustom org-table-number-fraction 0.5 - "Fraction of numbers in a column required to make the column align right. -In a column all non-white fields are considered. If at least this -fraction of fields is matched by `org-table-number-fraction', -alignment to the right border applies." - :group 'org-table-settings - :type 'number) - -(defgroup org-table-editing nil - "Behavior of tables during editing in Org-mode." - :tag "Org Table Editing" - :group 'org-table) - -(defcustom org-table-automatic-realign t - "Non-nil means, automatically re-align table when pressing TAB or RETURN. -When nil, aligning is only done with \\[org-table-align], or after column -removal/insertion." - :group 'org-table-editing - :type 'boolean) - -(defcustom org-table-auto-blank-field t - "Non-nil means, automatically blank table field when starting to type into it. -This only happens when typing immediately after a field motion -command (TAB, S-TAB or RET). -Only relevant when `org-enable-table-editor' is equal to `optimized'." - :group 'org-table-editing - :type 'boolean) - -(defcustom org-table-tab-jumps-over-hlines t - "Non-nil means, tab in the last column of a table with jump over a hline. -If a horizontal separator line is following the current line, -`org-table-next-field' can either create a new row before that line, or jump -over the line. When this option is nil, a new line will be created before -this line." - :group 'org-table-editing - :type 'boolean) - -(defcustom org-table-tab-recognizes-table.el t - "Non-nil means, TAB will automatically notice a table.el table. -When it sees such a table, it moves point into it and - if necessary - -calls `table-recognize-table'." - :group 'org-table-editing - :type 'boolean) - -(defgroup org-table-calculation nil - "Options concerning tables in Org-mode." - :tag "Org Table Calculation" - :group 'org-table) - -(defcustom org-table-use-standard-references t - "Should org-mode work with table refrences like B3 instead of @3$2? -Possible values are: -nil never use them -from accept as input, do not present for editing -t: accept as input and present for editing" - :group 'org-table-calculation - :type '(choice - (const :tag "Never, don't even check unser input for them" nil) - (const :tag "Always, both as user input, and when editing" t) - (const :tag "Convert user input, don't offer during editing" 'from))) - -(defcustom org-table-copy-increment t - "Non-nil means, increment when copying current field with \\[org-table-copy-down]." - :group 'org-table-calculation - :type 'boolean) - -(defcustom org-calc-default-modes - '(calc-internal-prec 12 - calc-float-format (float 5) - calc-angle-mode deg - calc-prefer-frac nil - calc-symbolic-mode nil - calc-date-format (YYYY "-" MM "-" DD " " Www (" " HH ":" mm)) - calc-display-working-message t - ) - "List with Calc mode settings for use in calc-eval for table formulas. -The list must contain alternating symbols (Calc modes variables and values). -Don't remove any of the default settings, just change the values. Org-mode -relies on the variables to be present in the list." - :group 'org-table-calculation - :type 'plist) - -(defcustom org-table-formula-evaluate-inline t - "Non-nil means, TAB and RET evaluate a formula in current table field. -If the current field starts with an equal sign, it is assumed to be a formula -which should be evaluated as described in the manual and in the documentation -string of the command `org-table-eval-formula'. This feature requires the -Emacs calc package. -When this variable is nil, formula calculation is only available through -the command \\[org-table-eval-formula]." - :group 'org-table-calculation - :type 'boolean) - -(defcustom org-table-formula-use-constants t - "Non-nil means, interpret constants in formulas in tables. -A constant looks like `$c' or `$Grav' and will be replaced before evaluation -by the value given in `org-table-formula-constants', or by a value obtained -from the `constants.el' package." - :group 'org-table-calculation - :type 'boolean) - -(defcustom org-table-formula-constants nil - "Alist with constant names and values, for use in table formulas. -The car of each element is a name of a constant, without the `$' before it. -The cdr is the value as a string. For example, if you'd like to use the -speed of light in a formula, you would configure - - (setq org-table-formula-constants '((\"c\" . \"299792458.\"))) - -and then use it in an equation like `$1*$c'. - -Constants can also be defined on a per-file basis using a line like - -#+CONSTANTS: c=299792458. pi=3.14 eps=2.4e-6" - :group 'org-table-calculation - :type '(repeat - (cons (string :tag "name") - (string :tag "value")))) - -(defvar org-table-formula-constants-local nil - "Local version of `org-table-formula-constants'.") -(make-variable-buffer-local 'org-table-formula-constants-local) - -(defcustom org-table-allow-automatic-line-recalculation t - "Non-nil means, lines marked with |#| or |*| will be recomputed automatically. -Automatically means, when TAB or RET or C-c C-c are pressed in the line." - :group 'org-table-calculation - :type 'boolean) - -(defgroup org-link nil - "Options concerning links in Org-mode." - :tag "Org Link" - :group 'org) - -(defvar 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.") -(make-variable-buffer-local 'org-link-abbrev-alist-local) - -(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-mode buffers can have an optional tag after a double colon, e.g. - - [[linkkey:tag][description]] - -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. - -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 'alist) - -(defcustom org-descriptive-links t - "Non-nil means, hide link part and only show description of bracket links. -Bracket links are like [[link][descritpion]]. This variable sets the initial -state in new org-mode buffers. The setting can then be toggled on a -per-buffer basis from the Org->Hyperlinks menu." - :group 'org-link - :type 'boolean) - -(defcustom org-link-file-path-type 'adaptive - "How the path name in file links should be stored. -Valid values are: - -relative relative to the current directory, i.e. the directory of the file - into which the link is being inserted. -absolute absolute path, if possible with ~ for home directory. -noabbrev absolute path, no abbreviation of home directory. -adaptive Use relative path for files in the current directory and sub- - directories of it. For other files, use an absolute path." - :group 'org-link - :type '(choice - (const relative) - (const absolute) - (const noabbrev) - (const adaptive))) - -(defcustom org-activate-links '(bracket angle plain radio tag date) - "Types of links that should be activated in Org-mode files. -This is a list of symbols, each leading to the activation of a certain link -type. In principle, it does not hurt to turn on most link types - there may -be a small gain when turning off unused link types. The types are: - -bracket The recommended [[link][description]] or [[link]] links with hiding. -angular Links in angular brackes that may contain whitespace like - . -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). - -Changing this variable requires a restart of Emacs to become effective." - :group 'org-link - :type '(set (const :tag "Double bracket links (new style)" bracket) - (const :tag "Angular bracket links (old style)" angular) - (const :tag "plain text links" plain) - (const :tag "Radio target matches" radio) - (const :tag "Tags" tag) - (const :tag "Tags" target) - (const :tag "Timestamps" date))) - -(defgroup org-link-store nil - "Options concerning storing links in Org-mode" - :tag "Org Store Link" - :group 'org-link) - -(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 %-excapes 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. Unually \"from NAME\", but if you sent it yourself, it - will be \"to NAME\". See also the variable `org-from-is-user-regexp'. -%s subject -%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 mached 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. -A search string will be added to the file name with :: as separator and -used to find the context when the link is activated by the command -`org-open-at-point'. -Using a prefix arg to the command \\[org-store-link] (`org-store-link') -negates this setting for the duration of the command." - :group 'org-link-store - :type 'boolean) - -(defcustom org-keep-stored-link-after-insertion nil - "Non-nil means, keep link in list for entire session. - -The command `org-store-link' adds a link pointing to the current -location to an internal list. These links accumulate during a session. -The command `org-insert-link' can be used to insert links into any -Org-mode file (offering completion for all stored links). When this -option is nil, every link which has been inserted once using \\[org-insert-link] -will be removed from the list, to make completing the unused links -more efficient." - :group 'org-link-store - :type 'boolean) - -(defcustom org-usenet-links-prefer-google nil - "Non-nil means, `org-store-link' will create web links to Google groups. -When nil, Gnus will be used for such links. -Using a prefix arg to the command \\[org-store-link] (`org-store-link') -negates this setting for the duration of the command." - :group 'org-link-store - :type 'boolean) - -(defgroup org-link-follow nil - "Options concerning following links in Org-mode" - :tag "Org Follow Link" - :group 'org-link) - -(defcustom org-tab-follows-link nil - "Non-nil means, on links TAB will follow the link. -Needs to be set before org.el is loaded." - :group 'org-link-follow - :type 'boolean) - -(defcustom org-return-follows-link nil - "Non-nil means, on links RET will follow the link. -Needs to be set before org.el is loaded." - :group 'org-link-follow - :type 'boolean) - -(defcustom org-mouse-1-follows-link t - "Non-nil means, mouse-1 on a link will follow the link. -A longer mouse click will still set point. Does not wortk on XEmacs. -Needs to be set before org.el is loaded." - :group 'org-link-follow - :type 'boolean) - -(defcustom org-mark-ring-length 4 - "Number of different positions to be recorded in the ring -Changing this requires a restart of Emacs to work correctly." - :group 'org-link-follow - :type 'interger) - -(defcustom org-link-frame-setup - '((vm . vm-visit-folder-other-frame) - (gnus . gnus-other-frame) - (file . find-file-other-window)) - "Setup the frame configuration for following links. -When following a link with Emacs, it may often be useful to display -this link in another window or frame. This variable can be used to -set this up for the different types of links. -For VM, use any of - `vm-visit-folder' - `vm-visit-folder-other-frame' -For Gnus, use any of - `gnus' - `gnus-other-frame' -For FILE, use any of - `find-file' - `find-file-other-window' - `find-file-other-frame' -For the calendar, use the variable `calendar-setup'. -For BBDB, it is currently only possible to display the matches in -another window." - :group 'org-link-follow - :type '(list - (cons (const vm) - (choice - (const vm-visit-folder) - (const vm-visit-folder-other-window) - (const vm-visit-folder-other-frame))) - (cons (const gnus) - (choice - (const gnus) - (const gnus-other-frame))) - (cons (const file) - (choice - (const find-file) - (const find-file-other-window) - (const find-file-other-frame))))) - -(defcustom org-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 C-u 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." - :group 'org-link-follow - :type 'boolean) - -(defcustom org-link-mailto-program '(browse-url "mailto:%a?subject=%s") - "Function and arguments to call for following mailto links. -This is a list with the first element being a lisp function, and the -remaining elements being arguments to the function. In string arguments, -%a will be replaced by the address, and %s will be replaced by the subject -if one was given like in ." - :group 'org-link-follow - :type '(choice - (const :tag "browse-url" (browse-url-mail "mailto:%a?subject=%s")) - (const :tag "compose-mail" (compose-mail "%a" "%s")) - (const :tag "message-mail" (message-mail "%a" "%s")) - (cons :tag "other" (function) (repeat :tag "argument" sexp)))) - -(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-mode document as \"Google Search\", -but really it would remove your entire home directory. -Therefore we advise against setting this variable to nil. -Just change it to `y-or-n-p' of you want to confirm with a -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))) - -(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-mode document as \"Google Search\", -but really it would remove your entire home directory. -Therefore we advise against setting this variable to nil. -Just change it to `y-or-n-p' of you want to confirm with a -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))) - -(defconst org-file-apps-defaults-gnu - '((remote . emacs) - (t . mailcap)) - "Default file applications on a UNIX or GNU/Linux system. -See `org-file-apps'.") - -(defconst org-file-apps-defaults-macosx - '((remote . emacs) - (t . "open %s") - ("ps" . "gv %s") - ("ps.gz" . "gv %s") - ("eps" . "gv %s") - ("eps.gz" . "gv %s") - ("dvi" . "xdvi %s") - ("fig" . "xfig %s")) - "Default file applications on a MacOS X system. -The system \"open\" is known as a default, but we use X11 applications -for some files for which the OS does not have a good default. -See `org-file-apps'.") - -(defconst org-file-apps-defaults-windowsnt - (list - '(remote . emacs) - (cons t - (list (if (featurep 'xemacs) - 'mswindows-shell-execute - 'w32-shell-execute) - "open" 'file))) - "Default file applications on a Windows NT system. -The system \"open\" is used for most files. -See `org-file-apps'.") - -(defcustom org-file-apps - '( - ("txt" . emacs) - ("tex" . emacs) - ("ltx" . emacs) - ("org" . emacs) - ("el" . emacs) - ("bib" . emacs) - ) - "External applications for opening `file:path' items in a document. -Org-mode uses system defaults for different file types, but -you can use this variable to set the application for a given file -extension. The entries in this list are cons cells where the car identifies -files and the cdr the corresponding command. Possible values for the -file identifier are - \"ext\" A string identifying an extension - `directory' Matches a directory - `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. - t Default for all remaining files - -Possible values for the command are: - `emacs' The file will be visited by the current Emacs process. - `default' Use the default application for this file type. - string A command to be executed by a shell; %s will be replaced - by the path to the file. - sexp A Lisp form which will be evaluated. The file path will - be available in the Lisp variable `file'. -For more examples, see the system specific constants -`org-file-apps-defaults-macosx' -`org-file-apps-defaults-windowsnt' -`org-file-apps-defaults-gnu'." - :group 'org-link-follow - :type '(repeat - (cons (choice :value "" - (string :tag "Extension") - (const :tag "Default for unrecognized files" t) - (const :tag "Remote file" remote) - (const :tag "Links to a directory" directory)) - (choice :value "" - (const :tag "Visit with Emacs" emacs) - (const :tag "Use system default" default) - (string :tag "Command") - (sexp :tag "Lisp form"))))) - -(defcustom org-mhe-search-all-folders nil - "Non-nil means, that the search for the mh-message will be extended to -all folders if the message cannot be found in the folder given in the link. -Searching all folders is very efficient with one of the search engines -supported by MH-E, but will be slow with pick." - :group 'org-link-follow - :type 'boolean) - -(defgroup org-remember nil - "Options concerning interaction with remember.el." - :tag "Org Remember" - :group 'org) - -(defcustom org-directory "~/org" - "Directory with org files. -This directory will be used as default to prompt for org files. -Used by the hooks for remember.el." - :group 'org-remember - :type 'directory) - -(defcustom org-default-notes-file "~/.notes" - "Default target for storing notes. -Used by the hooks for remember.el. This can be a string, or nil to mean -the value of `remember-data-file'. -You can set this on a per-template basis with the variable -`org-remember-templates'." - :group 'org-remember - :type '(choice - (const :tag "Default from remember-data-file" nil) - file)) - -(defcustom org-remember-store-without-prompt t - "Non-nil means, `C-c C-c' stores remember note without further promts. -In this case, you need `C-u C-c C-c' to get the prompts for -note file and headline. -When this variable is nil, `C-c C-c' give you the prompts, and -`C-u C-c C-c' trigger the fasttrack." - :group 'org-remember - :type 'boolean) - -(defcustom org-remember-default-headline "" - "The headline that should be the default location in the notes file. -When filing remember notes, the cursor will start at that position. -You can set this on a per-template basis with the variable -`org-remember-templates'." - :group 'org-remember - :type 'string) - -(defcustom org-remember-templates nil - "Templates for the creation of remember buffers. -When nil, just let remember make the buffer. -When not nil, this is a list of 5-element lists. In each entry, the first -element is a the name of the template, It should be a single short word. -The second element is a character, a unique key to select this template. -The third element is the template. The forth element is optional and can -specify a destination file for remember items created with this template. -The default file is given by `org-default-notes-file'. An optional fifth -element can specify the headline in that file that should be offered -first when the user is asked to file the entry. The default headline is -given in the variable `org-remember-default-headline'. - -The template specifies the structure of the remember buffer. It should have -a first line starting with a star, to act as the org-mode headline. -Furthermore, the following %-escapes will be replaced with content: - - %^{prompt} Prompt the user for a string and replace this sequence with it. - A default value and a completion table ca be specified like this: - %^{prompt|default|completion2|completion3|...} - %t time stamp, date only - %T time stamp with date and time - %u, %U like the above, but inactive time stamps - %^t like %t, but prompt for date. Similarly %^T, %^u, %^U - You may define a prompt like %^{Please specify birthday}t - %n user name (taken from `user-full-name') - %a annotation, normally the link created with org-store-link - %i initial content, the region when remember is called with C-u. - If %i is indented, the entire inserted text will be indented - as well. - %c content of the clipboard, or current kill ring head - %^g prompt for tags, with completion on tags in target file - %^G prompt for tags, with completion all tags in all agenda files - %:keyword specific information for certain link types, see below - %[pathname] insert the contents of the file given by `pathname' - %(sexp) evaluate elisp `(sexp)' and replace with the result - %! Store this note immediately after filling the template - - %? After completing the template, position cursor here. - -Apart from these general escapes, you can access information specific to the -link type that is created. For example, calling `remember' in emails or gnus -will record the author and the subject of the message, which you can access -with %:author and %:subject, respectively. Here is a complete list of what -is recorded for each link type. - -Link type | Available information --------------------+------------------------------------------------------ -bbdb | %:type %:name %:company -vm, wl, mh, rmail | %:type %:subject %:message-id - | %:from %:fromname %:fromaddress - | %:to %:toname %:toaddress - | %:fromto (either \"to NAME\" or \"from NAME\") -gnus | %:group, for messages also all email fields -w3, w3m | %:type %:url -info | %:type %:file %:node -calendar | %:type %:date" - :group 'org-remember - :get (lambda (var) ; Make sure all entries have 5 elements - (mapcar (lambda (x) - (if (not (stringp (car x))) (setq x (cons "" x))) - (cond ((= (length x) 4) (append x '(""))) - ((= (length x) 3) (append x '("" ""))) - (t x))) - (default-value var))) - :type '(repeat - :tag "enabled" - (list :value ("" ?a "\n" nil nil) - (string :tag "Name") - (character :tag "Selection Key") - (string :tag "Template") - (choice - (file :tag "Destination file") - (const :tag "Prompt for file" nil)) - (choice - (string :tag "Destination headline") - (const :tag "Selection interface for heading"))))) - -(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-remember - :type '(choice - (const :tag "Reverse always" t) - (const :tag "Reverse never" nil) - (repeat :tag "By file name regexp" - (cons regexp boolean)))) - -(defcustom org-refile-targets '((nil . (:level . 1))) - "Targets for refiling entries with \\[org-refile]. -This is 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 value fields will be used to retrieve - a file name or a list of file names. Nil means, refile to a different - heading 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 targes 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. - - a cons cell (:maxlevel . N). Any headline with level <= N is a target." -;; FIXME: what if there are a var and func with same name??? - :group 'org-remember - :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 :tag) (string)) - (cons :tag "TODO keyword" (const :todo) (string)) - (cons :tag "Regular expression" (const :regexp) (regexp)) - (cons :tag "Level number" (const :level) (integer)) - (cons :tag "Max Level number" (const :maxlevel) (integer)))))) - -(defcustom org-refile-use-outline-path nil - "Non-nil means, provide refile targets as paths. -So a level 3 headline will be available as level1/level2/level3. -When the value is `file', also include the file name (without directory) -into the path. When `full-file-path', include the full file path." - :group 'org-remember - :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))) - -(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) - -(defcustom org-todo-keywords '((sequence "TODO" "DONE")) - "List of TODO entry keyword sequences and their interpretation. -\\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-mode produces. If one of -the \"keywords\" is the vertical bat \"|\" 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. - -For backward compatibility, this variable may also be just a list -of keywords - in this case the interptetation (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" - (const :tag "Sequence (cycling hits every state)" sequence) - (const :tag "Type (cycling directly to DONE)" type)) - (repeat - (string :tag "Keyword")))))) - -(defvar org-todo-keywords-1 nil) -(make-variable-buffer-local 'org-todo-keywords-1) -(defvar org-todo-keywords-for-agenda nil) -(defvar org-done-keywords-for-agenda nil) -(defvar org-not-done-keywords nil) -(make-variable-buffer-local 'org-not-done-keywords) -(defvar org-done-keywords nil) -(make-variable-buffer-local 'org-done-keywords) -(defvar org-todo-heads nil) -(make-variable-buffer-local 'org-todo-heads) -(defvar org-todo-sets nil) -(make-variable-buffer-local 'org-todo-sets) -(defvar org-todo-log-states nil) -(make-variable-buffer-local 'org-todo-log-states) -(defvar org-todo-kwd-alist nil) -(make-variable-buffer-local 'org-todo-kwd-alist) -(defvar org-todo-key-alist nil) -(make-variable-buffer-local 'org-todo-key-alist) -(defvar org-todo-key-trigger nil) -(make-variable-buffer-local 'org-todo-key-trigger) - -(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 'prefix - "Non-nil means, use the fast todo selection scheme with C-c C-t. -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. `C-u C-c C-t' in an Org-mode buffer, and `C-u 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-after-todo-state-change-hook nil - "Hook which is run after the state of a TODO item was changed. -The new state (a string with a TODO keyword, or nil) is available in the -Lisp variable `state'." - :group 'org-todo - :type 'hook) - -(defcustom org-log-done nil - "When set, insert a (non-active) time stamp when TODO entry is marked DONE. -When the state of an entry is changed from nothing or a DONE state to -a not-done TODO state, remove a previous closing date. - -This can also be a list of symbols indicating under which conditions -the time stamp recording the action should be annotated with a short note. -Valid members of this list are - - done Offer to record a note when marking entries done - state Offer to record a note whenever changing the TODO state - of an item. This is only relevant if TODO keywords are - interpreted as sequence, see variable `org-todo-interpretation'. - When `state' is set, this includes tracking `done'. - clock-out Offer to record a note when clocking out of an item. - -A separate window will then pop up and allow you to type a note. -After finishing with C-c C-c, the note will be added directly after the -timestamp, as a plain list item. See also the variable -`org-log-note-headings'. - -Logging can also be configured on a per-file basis by adding one of -the following lines anywhere in the buffer: - - #+STARTUP: logdone - #+STARTUP: nologging - #+STARTUP: lognotedone - #+STARTUP: lognotestate - #+STARTUP: lognoteclock-out - -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 "off" nil) - (const :tag "on" t) - (set :tag "on, with notes, detailed control" :greedy t :value (done) - (const :tag "when item is marked DONE" done) - (const :tag "when TODO state changes" state) - (const :tag "when clocking out" clock-out)))) - -(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 %t") - (clock-out . "")) - "Headings for notes added when clocking out or closing TODO items. -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. -%t in the heading will be replaced by a time stamp. -%s will be replaced by the new TODO state, in double quotes. -%u will be replaced by the user name. -%U will be replaced by the full user name." - :group 'org-todo - :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 clocking out" clock-out) string))) - -(defcustom org-log-states-order-reversed t - "Non-nil means, the latest state change note will be directly after heading. -When nil, the notes will be orderer according to time." - :group 'org-todo - :group 'org-progress - :type 'boolean) - -(defcustom org-log-repeat t - "Non-nil means, prompt for a note when REPEAT is resetting a TODO entry. -When nil, no note will be taken. -This option can also be set with on a per-file-basis with - - #+STARTUP: logrepeat - #+STARTUP: nologrepeat - -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 'boolean) - -(defcustom org-clock-into-drawer 2 - "Should clocking info be wrapped into a drawer? -When t, clocking info will always be inserted into a :CLOCK: drawer. -If necessary, the drawer will be created. -When nil, the drawer will not be created, but used when present. -When an integer and the number of clocking entries in an item -reaches or exceeds this number, a drawer will be created." - :group 'org-todo - :group 'org-progress - :type '(choice - (const :tag "Always" t) - (const :tag "Only when drawer exists" nil) - (integer :tag "When at least N clock entries"))) - -(defcustom org-clock-out-when-done t - "When t, the clock will be stopped when the relevant entry is marked DONE. -Nil means, clock will keep running until stopped explicitly with -`C-c C-x C-o', or until the clock is started in a different item." - :group 'org-progress - :type 'boolean) - -(defcustom org-clock-in-switch-to-state nil - "Set task to a special todo state while clocking it. -The value should be the state to which the entry should be switched." - :group 'org-progress - :group 'org-todo - :type '(choice - (const :tag "Don't force a state" nil) - (string :tag "State"))) - -(defgroup org-priorities nil - "Priorities in Org-mode." - :tag "Org Priorities" - :group 'org-todo) - -(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 get if no explicit priority is given." - :group 'org-priorities - :type 'character) - -(defcustom org-priority-start-cycle-with-default t - "Non-nil means, start with default priority when starting to cycle. -When this is nil, the first step in the cycle will be (depending on the -command used) one higher or lower that the default priority." - :group 'org-priorities - :type 'boolean) - -(defgroup org-time nil - "Options concerning time stamps and deadlines in Org-mode." - :tag "Org Time" - :group 'org) - -(defcustom org-insert-labeled-timestamps-at-point nil - "Non-nil means, SCHEDULED and DEADLINE timestamps are inserted at point. -When nil, these labeled time stamps are forces into the second line of an -entry, just after the headline. When scheduling from the global TODO list, -the time stamp will always be forced into the second line." - :group 'org-time - :type 'boolean) - -(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>") - "Formats for `format-time-string' which are used for time stamps. -It is not recommended to change this constant.") - -(defcustom org-time-stamp-rounding-minutes 0 - "Number of minutes to round time stamps to upon insertion. -When zero, insert the time unmodified. Useful rounding numbers -should be factors of 60, so for example 5, 10, 15. -When this is not zero, you can still force an exact time-stamp by using -a double prefix argument to a time-stamp command like `C-c .' or `C-c !'." - :group 'org-time - :type 'integer) - -(defcustom org-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 overlayed over the default ISO format if the variable -`org-display-custom-times' is set. Time like %H:%M should be at the -end of the second format." - :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-read-date-prefer-future t - "Non-nil means, assume future for incomplete date input from user. -This affects the following situations: -1. The user gives a day, but no month. - For example, if today is the 15th, and you enter \"3\", Org-mode will - read this as the third of *next* month. However, if you enter \"17\", - it will be considered as *this* month. -2. The user gives a month but not a year. - For example, if it is april and you enter \"feb 2\", this will be read - as feb 2, *next* year. \"May 5\", however, will be this year. - -When this option is nil, the current month and year will always be used -as defaults." - :group 'org-time - :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) -(if (fboundp 'defvaralias) - (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. -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. - -FIXME: -IMPORTANT: This is still a very experimental feature, it may disappear -again or it may be extended to mean more things." - :group 'org-time - :type 'number) - -(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) - -(defcustom org-clock-heading-function nil - "When non-nil, should be a function to create `org-clock-heading'. -This is the string shown in the mode line when a clock is running. -The function is called with point at the beginning of the headline." - :group 'org-time ; FIXME: Should we have a separate group???? - :type 'function) - -(defgroup org-tags nil - "Options concerning tags in Org-mode." - :tag "Org Tags" - :group 'org) - -(defcustom org-tag-alist nil - "List of tags allowed in Org-mode files. -When this list is nil, Org-mode will base TAG input on what is already in the -buffer. -The value of this variable is an alist, the car of each entry must be a -keyword as a string, the cdr may be a character that is used to select -that tag through the fast-tag-selection interface. -See the manual for details." - :group 'org-tags - :type '(repeat - (choice - (cons (string :tag "Tag name") - (character :tag "Access char")) - (const :tag "Start radio group" (:startgroup)) - (const :tag "End radio group" (:endgroup))))) - -(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 -80 - "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." - :group 'org-tags - :type 'integer) - -(defcustom org-auto-align-tags t - "Non-nil means, realign tags after pro/demotion of TODO state change. -These operations change the length of a headline and therefore shift -the tags around. With this options turned on, after each such operation -the tags are again aligned to `org-tags-column'." - :group 'org-tags - :type 'boolean) - -(defcustom org-use-tag-inheritance t - "Non-nil means, tags in levels apply also for sublevels. -When nil, only the tags directly given in a specific line apply there. -If you turn off this option, you very likely want to turn on the -companion option `org-tags-match-list-sublevels'." - :group 'org-tags - :type 'boolean) - -(defcustom org-tags-match-list-sublevels nil - "Non-nil means list also sublevels of headlines matching tag search. -Because of tag inheritance (see variable `org-use-tag-inheritance'), -the sublevels of a headline matching a tag search often also match -the same search. Listing all of them can create very long lists. -Setting this variable to nil causes subtrees of a match to be skipped. -This option is off by default, because inheritance in on. If you turn -inheritance off, you very likely want to turn this option on. - -As a special case, if the tag search is restricted to TODO items, the -value of this variable is ignored and sublevels are always checked, to -make sure all corresponding TODO items find their way into the list." - :group 'org-tags - :type 'boolean) - -(defvar org-tags-history nil - "History of minibuffer reads for tags.") -(defvar org-last-tags-completion-table nil - "The last used completion table for tags.") -(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-use-property-inheritance nil - "Non-nil means, properties apply also for sublevels. -This setting is only relevant during property searches, not when querying -an entry with `org-entry-get'. To retrieve a property with inheritance, -you need to call `org-entry-get' with the inheritance flag. -Turning this on can cause significant overhead when doing a search, so -this is turned off by default. -When nil, only the properties directly given in the current entry count. -The value may also be a list of properties that shouldhave inheritance. - -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." - :group 'org-properties - :type '(choice - (const :tag "Not" nil) - (const :tag "Always" nil) - (repeat :tag "Specific properties" (string :tag "Property")))) - -(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-global-properties nil - "List of property/value pairs that can be inherited by any entry. -You can set buffer-local values for this by adding lines like - -#+PROPERTY: NAME VALUE" - :group 'org-properties - :type '(repeat - (cons (string :tag "Property") - (string :tag "Value")))) - -(defvar org-local-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 org-category nil - "Variable used by org files to set a category for agenda display. -Such files should use a file variable to set it, for example - -# -*- mode: org; org-category: \"ELisp\" - -or contain a special line - -#+CATEGORY: ELisp - -If the file does not specify a category, then file's base name -is used instead.") -(make-variable-buffer-local 'org-category) - -(defcustom org-agenda-files nil - "The files to be used for agenda display. -Entries may be added to this list with \\[org-agenda-file-to-front] and removed with -\\[org-remove-file]. You can also use customize to edit the list. - -If 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." - :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-skip-unavailable-files nil - "t means to just skip non-reachable files in `org-agenda-files'. -Nil means to remove them, after a query, from the list." - :group 'org-agenda - :type 'boolean) - -(defcustom org-agenda-multi-occur-extra-files nil - "List of extra files to be searched by `org-occur-in-agenda-files'. -The files in `org-agenda-files' are always searched." - :group 'org-agenda - :type '(repeat file)) - -(defcustom org-agenda-confirm-kill 1 - "When set, remote killing from the agenda buffer needs confirmation. -When t, a confirmation is always needed. When a number N, confirmation is -only needed when the text to be killed contains more than N non-white lines." - :group 'org-agenda - :type '(choice - (const :tag "Never" nil) - (const :tag "Always" t) - (number :tag "When more than N lines"))) - -(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-agenda-compact-blocks nil - "Non-nil means, make the block agenda more compact. -This is done by leaving out unnecessary lines." - :group 'org-agenda - :type nil) - -(defgroup org-agenda-export nil - "Options concerning exporting agenda views in Org-mode." - :tag "Org Agenda Export" - :group 'org-agenda) - -(defcustom org-agenda-with-colors t - "Non-nil means, use colors in agenda views." - :group 'org-agenda-export - :type 'boolean) - -(defcustom org-agenda-exporter-settings nil - "Alist of variable/value pairs that should be active during agenda export. -This is a good place to set uptions for ps-print and for htmlize." - :group 'org-agenda-export - :type '(repeat - (list - (variable) - (sexp :tag "Value")))) - -(defcustom org-agenda-export-html-style "" - "The style specification for exported HTML Agenda files. -If this variable contains a string, it will replace the default - -or, if you want to keep the style in a file, - - - -As the value of this option simply gets inserted into the HTML header, -you can \"misuse\" it to also add other text to the header. However, - is required, if not present the variable will be ignored." - :group 'org-agenda-export - :group 'org-export-html - :type 'string) - -(defgroup org-agenda-custom-commands nil - "Options concerning agenda views in Org-mode." - :tag "Org Agenda Custom Commands" - :group 'org-agenda) - -(defcustom org-agenda-custom-commands nil - "Custom commands for the agenda. -These commands will be offered on the splash screen displayed by the -agenda dispatcher \\[org-agenda]. Each entry is a list like this: - - (key desc type match options files) - -key The key (one or more characters as a string) to be associated - with the command. -desc A description of the commend, when omitted or nil, a default - description is built using MATCH. -type The command type, any of the following symbols: - todo Entries with a specific TODO keyword, in all agenda files. - tags Tags match in all agenda files. - tags-todo Tags match in all agenda files, TODO entries only. - todo-tree Sparse tree of specific TODO keyword in *current* file. - tags-tree Sparse tree with all tags matches in *current* file. - occur-tree Occur sparse tree for *current* file. - ... A user-defined function. -match What to search for: - - a single keyword for TODO keyword searches - - a tags match expression for tags searches - - a regular expression for occur searches -options A list of option settings, similar to that in a let form, so like - this: ((opt1 val1) (opt2 val2) ...) -files A list of files file to write the produced agenda buffer to - with the command `org-store-agenda-views'. - If a file name ends in \".html\", an HTML version of the buffer - is written out. If it ends in \".ps\", a postscript version is - produced. Otherwide, only the plain text is written to the file. - -You can also define a set of commands, to create a composite agenda buffer. -In this case, an entry looks like this: - - (key desc (cmd1 cmd2 ...) general-options file) - -where - -desc A description string to be displayed in the dispatcher menu. -cmd An agenda command, similar to the above. However, tree commands - are no allowed, but instead you can get agenda and global todo list. - So valid commands for a set are: - (agenda) - (alltodo) - (stuck) - (todo \"match\" options files) - (tags \"match\" options files) - (tags-todo \"match\" options files) - -Each command can carry a list of options, and another set of options can be -given for the whole set of commands. Individual command options take -precedence over the general options. - -When using several characters as key to a command, the first characters -are prefix commands. For the dispatcher to display useful information, you -should provide a description for the prefix, like - - (setq org-agenda-custom-commands - '((\"h\" . \"HOME + Name tag searches\") ; describe prefix \"h\" - (\"hl\" tags \"+HOME+Lisa\") - (\"hp\" tags \"+HOME+Peter\") - (\"hk\" tags \"+HOME+Kim\")))" - :group 'org-agenda-custom-commands - :type '(repeat - (choice :value ("a" "" tags "" nil) - (list :tag "Single command" - (string :tag "Access Key(s) ") - (option (string :tag "Description")) - (choice - (const :tag "Agenda" agenda) - (const :tag "TODO list" alltodo) - (const :tag "Stuck projects" stuck) - (const :tag "Tags search (all agenda files)" tags) - (const :tag "Tags search of TODO entries (all agenda files)" tags-todo) - (const :tag "TODO keyword search (all agenda files)" todo) - (const :tag "Tags sparse tree (current buffer)" tags-tree) - (const :tag "TODO keyword tree (current buffer)" todo-tree) - (const :tag "Occur tree (current buffer)" occur-tree) - (sexp :tag "Other, user-defined function")) - (string :tag "Match") - (repeat :tag "Local options" - (list (variable :tag "Option") (sexp :tag "Value"))) - (option (repeat :tag "Export" (file :tag "Export to")))) - (list :tag "Command series, all agenda files" - (string :tag "Access Key(s)") - (string :tag "Description ") - (repeat - (choice - (const :tag "Agenda" (agenda)) - (const :tag "TODO list" (alltodo)) - (const :tag "Stuck projects" (stuck)) - (list :tag "Tags search" - (const :format "" tags) - (string :tag "Match") - (repeat :tag "Local options" - (list (variable :tag "Option") - (sexp :tag "Value")))) - - (list :tag "Tags search, TODO entries only" - (const :format "" tags-todo) - (string :tag "Match") - (repeat :tag "Local options" - (list (variable :tag "Option") - (sexp :tag "Value")))) - - (list :tag "TODO keyword search" - (const :format "" todo) - (string :tag "Match") - (repeat :tag "Local options" - (list (variable :tag "Option") - (sexp :tag "Value")))) - - (list :tag "Other, user-defined function" - (symbol :tag "function") - (string :tag "Match") - (repeat :tag "Local options" - (list (variable :tag "Option") - (sexp :tag "Value")))))) - - (repeat :tag "General options" - (list (variable :tag "Option") - (sexp :tag "Value"))) - (option (repeat :tag "Export" (file :tag "Export to")))) - (cons :tag "Prefix key documentation" - (string :tag "Access Key(s)") - (string :tag "Description "))))) - -(defcustom org-stuck-projects - '("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil "") - "How to identify stuck projects. -This is a list of four items: -1. A tags/todo matcher string that is used to identify a project. - The entire tree below a headline matched by this is considered one project. -2. A list of TODO keywords identifying non-stuck projects. - If the project subtree contains any headline with one of these todo - keywords, the project is considered to be not stuck. If you specify - \"*\" as a keyword, any TODO keyword will mark the project unstuck. -3. A list of tags identifying non-stuck projects. - If the project subtree contains any headline with one of these tags, - the project is considered to be not stuck. If you specify \"*\" as - a tag, any tag will mark the project unstuck. -4. An arbitrary regular expression matching non-stuck projects. - -After defining this variable, you may use \\[org-agenda-list-stuck-projects] -or `C-c a #' to produce the list." - :group 'org-agenda-custom-commands - :type '(list - (string :tag "Tags/TODO match to identify a project") - (repeat :tag "Projects are *not* stuck if they have an entry with TODO keyword any of" (string)) - (repeat :tag "Projects are *not* stuck if they have an entry with TAG being any of" (string)) - (regexp :tag "Projects are *not* stuck if this regexp matches\ninside the subtree"))) - - -(defgroup org-agenda-skip nil - "Options concerning skipping parts of agenda files." - :tag "Org Agenda Skip" - :group 'org-agenda) - -(defcustom org-agenda-todo-list-sublevels t - "Non-nil means, check also the sublevels of a TODO entry for TODO entries. -When nil, the sublevels of a TODO entry are not checked, resulting in -potentially much shorter TODO lists." - :group 'org-agenda-skip - :group 'org-todo - :type 'boolean) - -(defcustom org-agenda-todo-ignore-with-date nil - "Non-nil means, don't show entries with a date in the global todo list. -You can use this if you prefer to mark mere appointments with a TODO keyword, -but don't want them to show up in the TODO list. -When this is set, it also covers deadlines and scheduled items, the settings -of `org-agenda-todo-ignore-scheduled' and `org-agenda-todo-ignore-deadlines' -will be ignored." - :group 'org-agenda-skip - :group 'org-todo - :type 'boolean) - -(defcustom org-agenda-todo-ignore-scheduled nil - "Non-nil means, don't show scheduled entries in the global todo list. -The idea behind this is that by scheduling it, you have already taken care -of this item. -See also `org-agenda-todo-ignore-with-date'." - :group 'org-agenda-skip - :group 'org-todo - :type 'boolean) - -(defcustom org-agenda-todo-ignore-deadlines nil - "Non-nil means, don't show near deadline entries in the global todo list. -Near means closer than `org-deadline-warning-days' days. -The idea behind this is that such items will appear in the agenda anyway. -See also `org-agenda-todo-ignore-with-date'." - :group 'org-agenda-skip - :group 'org-todo - :type 'boolean) - -(defcustom org-agenda-skip-scheduled-if-done nil - "Non-nil means don't show scheduled items in agenda when they are done. -This is relevant for the daily/weekly agenda, not for the TODO list. And -it applies only to the actual date of the scheduling. Warnings about -an item with a past scheduling dates are always turned off when the item -is DONE." - :group 'org-agenda-skip - :type 'boolean) - -(defcustom org-agenda-skip-deadline-if-done nil - "Non-nil means don't show deadines when the corresponding item is done. -When nil, the deadline is still shown and should give you a happy feeling. -This is relevant for the daily/weekly agenda. And it applied only to the -actualy date of the deadline. Warnings about approching and past-due -deadlines are always turned off when the item is DONE." - :group 'org-agenda-skip - :type 'boolean) - -(defcustom org-agenda-skip-timestamp-if-done nil - "Non-nil means don't don't select item by timestamp or -range if it is DONE." - :group 'org-agenda-skip - :type 'boolean) - -(defcustom org-timeline-show-empty-dates 3 - "Non-nil means, `org-timeline' also shows dates without an entry. -When nil, only the days which actually have entries are shown. -When t, all days between the first and the last date are shown. -When an integer, show also empty dates, but if there is a gap of more than -N days, just insert a special line indicating the size of the gap." - :group 'org-agenda-skip - :type '(choice - (const :tag "None" nil) - (const :tag "All" t) - (number :tag "at most"))) - - -(defgroup org-agenda-startup nil - "Options concerning initial settings in the Agenda in Org Mode." - :tag "Org Agenda Startup" - :group 'org-agenda) - -(defcustom org-finalize-agenda-hook nil - "Hook run just before displaying an agenda buffer." - :group 'org-agenda-startup - :type 'hook) - -(defcustom org-agenda-mouse-1-follows-link nil - "Non-nil means, mouse-1 on a link will follow the link in the agenda. -A longer mouse click will still set point. Does not wortk on XEmacs. -Needs to be set before org.el is loaded." - :group 'org-agenda-startup - :type 'boolean) - -(defcustom org-agenda-start-with-follow-mode nil - "The initial value of follow-mode in a newly created agenda window." - :group 'org-agenda-startup - :type 'boolean) - -(defgroup org-agenda-windows nil - "Options concerning the windows used by the Agenda in Org Mode." - :tag "Org Agenda Windows" - :group 'org-agenda) - -(defcustom org-agenda-window-setup 'reorganize-frame - "How the agenda buffer should be displayed. -Possible values for this option are: - -current-window Show agenda in the current window, keeping all other windows. -other-frame Use `switch-to-buffer-other-frame' to display agenda. -other-window Use `switch-to-buffer-other-window' to display agenda. -reorganize-frame Show only two windows on the current frame, the current - window and the agenda. -See also the variable `org-agenda-restore-windows-after-quit'." - :group 'org-agenda-windows - :type '(choice - (const current-window) - (const other-frame) - (const other-window) - (const reorganize-frame))) - -(defcustom org-agenda-window-frame-fractions '(0.5 . 0.75) - "The min and max height of the agenda window as a fraction of frame height. -The value of the variable is a cons cell with two numbers between 0 and 1. -It only matters if `org-agenda-window-setup' is `reorganize-frame'." - :group 'org-agenda-windows - :type '(cons (number :tag "Minimum") (number :tag "Maximum"))) - -(defcustom org-agenda-restore-windows-after-quit nil - "Non-nil means, restore window configuration open exiting agenda. -Before the window configuration is changed for displaying the agenda, -the current status is recorded. When the agenda is exited with -`q' or `x' and this option is set, the old state is restored. If -`org-agenda-window-setup' is `other-frame', the value of this -option will be ignored.." - :group 'org-agenda-windows - :type 'boolean) - -(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))) - -(defgroup org-agenda-daily/weekly nil - "Options concerning the daily/weekly agenda." - :tag "Org Agenda Daily/Weekly" - :group 'org-agenda) - -(defcustom org-agenda-ndays 7 - "Number of days to include in overview display. -Should be 1 or 7." - :group 'org-agenda-daily/weekly - :type 'number) - -(defcustom org-agenda-start-on-weekday 1 - "Non-nil means, start the overview always on the specified weekday. -0 denotes Sunday, 1 denotes Monday etc. -When nil, always start on the current day." - :group 'org-agenda-daily/weekly - :type '(choice (const :tag "Today" nil) - (number :tag "Weekday No."))) - -(defcustom org-agenda-show-all-dates t - "Non-nil means, `org-agenda' shows every day in the selected range. -When nil, only the days which actually have entries are shown." - :group 'org-agenda-daily/weekly - :type 'boolean) - -(defcustom org-agenda-format-date 'org-agenda-format-date-aligned - "Format string for displaying dates in the agenda. -Used by the daily/weekly agenda and by the timeline. This should be -a format string understood by `format-time-string', or a function returning -the formatted date as a string. The function must take a single argument, -a calendar-style date list like (month day year)." - :group 'org-agenda-daily/weekly - :type '(choice - (string :tag "Format string") - (function :tag "Function"))) - -(defun org-agenda-format-date-aligned (date) - "Format a date string for display in the daily/weekly agenda, or timeline. -This function makes sure that dates are aligned for easy reading." - (format "%-9s %2d %s %4d" - (calendar-day-name date) - (extract-calendar-day date) - (calendar-month-name (extract-calendar-month date)) - (extract-calendar-year date))) - -(defcustom org-agenda-include-diary nil - "If non-nil, include in the agenda entries from the Emacs Calendar's diary." - :group 'org-agenda-daily/weekly - :type 'boolean) - -(defcustom org-agenda-include-all-todo nil - "Set means weekly/daily agenda will always contain all TODO entries. -The TODO entries will be listed at the top of the agenda, before -the entries for specific days." - :group 'org-agenda-daily/weekly - :type 'boolean) - -(defcustom org-agenda-repeating-timestamp-show-all t - "Non-nil means, show all occurences of a repeating stamp in the agenda. -When nil, only one occurence is shown, either today or the -nearest into the future." - :group 'org-agenda-daily/weekly - :type 'boolean) - -(defcustom org-deadline-warning-days 14 - "No. of days before expiration during which a deadline becomes active. -This variable governs the display in sparse trees and in the agenda. -When negative, it means use this number (the absolute value of it) -even if a deadline has a different individual lead time specified." - :group 'org-time - :group 'org-agenda-daily/weekly - :type 'number) - -(defcustom org-scheduled-past-days 10000 - "No. of days to continue listing scheduled items that are not marked DONE. -When an item is scheduled on a date, it shows up in the agenda on this -day and will be listed until it is marked done for the number of days -given here." - :group 'org-agenda-daily/weekly - :type 'number) - -(defgroup org-agenda-time-grid nil - "Options concerning the time grid in the Org-mode Agenda." - :tag "Org Agenda Time Grid" - :group 'org-agenda) - -(defcustom org-agenda-use-time-grid t - "Non-nil means, show a time grid in the agenda schedule. -A time grid is a set of lines for specific times (like every two hours between -8:00 and 20:00). The items scheduled for a day at specific times are -sorted in between these lines. -For details about when the grid will be shown, and what it will look like, see -the variable `org-agenda-time-grid'." - :group 'org-agenda-time-grid - :type 'boolean) - -(defcustom org-agenda-time-grid - '((daily today require-timed) - "----------------" - (800 1000 1200 1400 1600 1800 2000)) - - "The settings for time grid for agenda display. -This is a list of three items. The first item is again a list. It contains -symbols specifying conditions when the grid should be displayed: - - daily if the agenda shows a single day - weekly if the agenda shows an entire week - today show grid on current date, independent of daily/weekly display - require-timed show grid only if at least one item has a time specification - -The second item is a string which will be places behing the grid time. - -The third item is a list of integers, indicating the times that should have -a grid line." - :group 'org-agenda-time-grid - :type - '(list - (set :greedy t :tag "Grid Display Options" - (const :tag "Show grid in single day agenda display" daily) - (const :tag "Show grid in weekly agenda display" weekly) - (const :tag "Always show grid for today" today) - (const :tag "Show grid only if any timed entries are present" - require-timed) - (const :tag "Skip grid times already present in an entry" - remove-match)) - (string :tag "Grid String") - (repeat :tag "Grid Times" (integer :tag "Time")))) - -(defgroup org-agenda-sorting nil - "Options concerning sorting in the Org-mode Agenda." - :tag "Org Agenda Sorting" - :group 'org-agenda) - -(defconst org-sorting-choice - '(choice - (const time-up) (const time-down) - (const category-keep) (const category-up) (const category-down) - (const tag-down) (const tag-up) - (const priority-up) (const priority-down)) - "Sorting choices.") - -(defcustom org-agenda-sorting-strategy - '((agenda time-up category-keep priority-down) - (todo category-keep priority-down) - (tags category-keep priority-down)) - "Sorting structure for the agenda items of a single day. -This is a list of symbols which will be used in sequence to determine -if an entry should be listed before another entry. The following -symbols are recognized: - -time-up Put entries with time-of-day indications first, early first -time-down Put entries with time-of-day indications first, late first -category-keep Keep the default order of categories, corresponding to the - sequence in `org-agenda-files'. -category-up Sort alphabetically by category, A-Z. -category-down Sort alphabetically by category, Z-A. -tag-up Sort alphabetically by last tag, A-Z. -tag-down Sort alphabetically by last tag, Z-A. -priority-up Sort numerically by priority, high priority last. -priority-down Sort numerically by priority, high priority first. - -The different possibilities will be tried in sequence, and testing stops -if one comparison returns a \"not-equal\". For example, the default - '(time-up category-keep priority-down) -means: Pull out all entries having a specified time of day and sort them, -in order to make a time schedule for the current day the first thing in the -agenda listing for the day. Of the entries without a time indication, keep -the grouped in categories, don't sort the categories, but keep them in -the sequence given in `org-agenda-files'. Within each category sort by -priority. - -Leaving out `category-keep' would mean that items will be sorted across -categories by priority. - -Instead of a single list, this can also be a set of list for specific -contents, with a context symbol in the car of the list, any of -`agenda', `todo', `tags' for the corresponding agenda views." - :group 'org-agenda-sorting - :type `(choice - (repeat :tag "General" ,org-sorting-choice) - (list :tag "Individually" - (cons (const :tag "Strategy for Weekly/Daily agenda" agenda) - (repeat ,org-sorting-choice)) - (cons (const :tag "Strategy for TODO lists" todo) - (repeat ,org-sorting-choice)) - (cons (const :tag "Strategy for Tags matches" tags) - (repeat ,org-sorting-choice))))) - -(defcustom org-sort-agenda-notime-is-late t - "Non-nil means, items without time are considered late. -This is only relevant for sorting. When t, items which have no explicit -time like 15:30 will be considered as 99:01, i.e. later than any items which -do have a time. When nil, the default time is before 0:00. You can use this -option to decide if the schedule for today should come before or after timeless -agenda entries." - :group 'org-agenda-sorting - :type 'boolean) - -(defgroup org-agenda-line-format nil - "Options concerning the entry prefix in the Org-mode agenda display." - :tag "Org Agenda Line Format" - :group 'org-agenda) - -(defcustom org-agenda-prefix-format - '((agenda . " %-12:c%?-12t% s") - (timeline . " % s") - (todo . " %-12:c") - (tags . " %-12:c")) - "Format specifications for the prefix of items in the agenda views. -An alist with four entries, for the different agenda types. The keys to the -sublists are `agenda', `timeline', `todo', and `tags'. The values -are format strings. -This format works similar to a printf format, with the following meaning: - - %c the category of the item, \"Diary\" for entries from the diary, or - as given by the CATEGORY keyword or derived from the file name. - %T the *last* tag of the item. Last because inherited tags come - first in the list. - %t the time-of-day specification if one applies to the entry, in the - format HH:MM - %s Scheduling/Deadline information, a short string - -All specifiers work basically like the standard `%s' of printf, but may -contain two additional characters: A question mark just after the `%' and -a whitespace/punctuation character just before the final letter. - -If the first character after `%' is a question mark, the entire field -will only be included if the corresponding value applies to the -current entry. This is useful for fields which should have fixed -width when present, but zero width when absent. For example, -\"%?-12t\" will result in a 12 character time field if a time of the -day is specified, but will completely disappear in entries which do -not contain a time. - -If there is punctuation or whitespace character just before the final -format letter, this character will be appended to the field value if -the value is not empty. For example, the format \"%-12:c\" leads to -\"Diary: \" if the category is \"Diary\". If the category were be -empty, no additional colon would be interted. - -The default value of this option is \" %-12:c%?-12t% s\", meaning: -- Indent the line with two space characters -- Give the category in a 12 chars wide field, padded with whitespace on - the right (because of `-'). Append a colon if there is a category - (because of `:'). -- If there is a time-of-day, put it into a 12 chars wide field. If no - time, don't put in an empty field, just skip it (because of '?'). -- Finally, put the scheduling information and append a whitespace. - -As another example, if you don't want the time-of-day of entries in -the prefix, you could use: - - (setq org-agenda-prefix-format \" %-11:c% s\") - -See also the variables `org-agenda-remove-times-when-in-prefix' and -`org-agenda-remove-tags'." - :type '(choice - (string :tag "General format") - (list :greedy t :tag "View dependent" - (cons (const agenda) (string :tag "Format")) - (cons (const timeline) (string :tag "Format")) - (cons (const todo) (string :tag "Format")) - (cons (const tags) (string :tag "Format")))) - :group 'org-agenda-line-format) - -(defvar org-prefix-format-compiled nil - "The compiled version of the most recently used prefix format. -See the variable `org-agenda-prefix-format'.") - -(defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ") - "Text preceeding scheduled items in the agenda view. -THis is a list with two strings. The first applies when the item is -scheduled on the current day. The second applies when it has been scheduled -previously, it may contain a %d to capture how many days ago the item was -scheduled." - :group 'org-agenda-line-format - :type '(list - (string :tag "Scheduled today ") - (string :tag "Scheduled previously"))) - -(defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: ") - "Text preceeding deadline items in the agenda view. -This is a list with two strings. The first applies when the item has its -deadline on the current day. The second applies when it is in the past or -in the future, it may contain %d to capture how many days away the deadline -is (was)." - :group 'org-agenda-line-format - :type '(list - (string :tag "Deadline today ") - (string :tag "Deadline relative"))) - -(defcustom org-agenda-remove-times-when-in-prefix t - "Non-nil means, remove duplicate time specifications in agenda items. -When the format `org-agenda-prefix-format' contains a `%t' specifier, a -time-of-day specification in a headline or diary entry is extracted and -placed into the prefix. If this option is non-nil, the original specification -\(a timestamp or -range, or just a plain time(range) specification like -11:30-4pm) will be removed for agenda display. This makes the agenda less -cluttered. -The option can be t or nil. It may also be the symbol `beg', indicating -that the time should only be removed what it is located at the beginning of -the headline/diary entry." - :group 'org-agenda-line-format - :type '(choice - (const :tag "Always" t) - (const :tag "Never" nil) - (const :tag "When at beginning of entry" beg))) - - -(defcustom org-agenda-default-appointment-duration nil - "Default duration for appointments that only have a starting time. -When nil, no duration is specified in such cases. -When non-nil, this must be the number of minutes, e.g. 60 for one hour." - :group 'org-agenda-line-format - :type '(choice - (integer :tag "Minutes") - (const :tag "No default duration"))) - - -(defcustom org-agenda-remove-tags nil - "Non-nil means, remove the tags from the headline copy in the agenda. -When this is the symbol `prefix', only remove tags when -`org-agenda-prefix-format' contains a `%T' specifier." - :group 'org-agenda-line-format - :type '(choice - (const :tag "Always" t) - (const :tag "Never" nil) - (const :tag "When prefix format contains %T" prefix))) - -(if (fboundp 'defvaralias) - (defvaralias 'org-agenda-remove-tags-when-in-prefix - 'org-agenda-remove-tags)) - -(defcustom org-agenda-tags-column -80 - "Shift tags in agenda items to this column. -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." - :group 'org-agenda-line-format - :type 'integer) - -(if (fboundp 'defvaralias) - (defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column)) - -(defcustom org-agenda-fontify-priorities t - "Non-nil means, highlight low and high priorities in agenda. -When t, the highest priority entries are bold, lowest priority italic. -This may also be an association list of priority faces. The face may be -a names face, or a list like `(:background \"Red\")'." - :group 'org-agenda-line-format - :type '(choice - (const :tag "Never" nil) - (const :tag "Defaults" t) - (repeat :tag "Specify" - (list (character :tag "Priority" :value ?A) - (sexp :tag "face"))))) - -(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" "$" "$$" "\\(" "\\[")) - "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 forground of the default face. -:background the background color, or \"Transparent\". - `default' means use the background of the default face. -:scale a scaling factor for the size of the images -: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 - \"$\" 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-header "\\documentclass{article} -\\usepackage{fullpage} % do not remove -\\usepackage{amssymb} -\\usepackage[usenames]{color} -\\usepackage{amsmath} -\\usepackage{latexsym} -\\usepackage[mathscr]{eucal} -\\pagestyle{empty} % do not remove" - "The document header used for processing LaTeX fragments." - :group 'org-latex - :type 'string) - -(defgroup org-export nil - "Options for exporting org-listings." - :tag "Org Export" - :group 'org) - -(defgroup org-export-general nil - "General options for exporting Org-mode files." - :tag "Org Export General" - :group 'org-export) - -;; FIXME -(defvar org-export-publishing-directory nil) - -(defcustom org-export-with-special-strings t - "Non-nil means, interpret \"\-\", \"--\" and \"---\" for export. -When this option is turned on, these strings will be exported as: - - Org HTML LaTeX - -----+----------+-------- - \\- ­ \\- - -- – -- - --- — --- - ... … \ldots - -This option can also be set with the +OPTIONS line, e.g. \"-:nil\"." - :group 'org-export-translation - :type 'boolean) - -(defcustom org-export-language-setup - '(("en" "Author" "Date" "Table of Contents") - ("cs" "Autor" "Datum" "Obsah") - ("da" "Ophavsmand" "Dato" "Indhold") - ("de" "Autor" "Datum" "Inhaltsverzeichnis") - ("es" "Autor" "Fecha" "\xcdndice") - ("fr" "Auteur" "Date" "Table des mati\xe8res") - ("it" "Autore" "Data" "Indice") - ("nl" "Auteur" "Datum" "Inhoudsopgave") - ("nn" "Forfattar" "Dato" "Innhold") ;; nn = Norsk (nynorsk) - ("sv" "F\xf6rfattarens" "Datum" "Inneh\xe5ll")) - "Terms used in export text, translated to different languages. -Use the variable `org-export-default-language' to set the language, -or use the +OPTION lines for a per-file setting." - :group 'org-export-general - :type '(repeat - (list - (string :tag "HTML language tag") - (string :tag "Author") - (string :tag "Date") - (string :tag "Table of Contents")))) - -(defcustom org-export-default-language "en" - "The default language of HTML export, as a string. -This should have an association in `org-export-language-setup'." - :group 'org-export-general - :type 'string) - -(defcustom org-export-skip-text-before-1st-heading t - "Non-nil means, skip all text before the first headline when exporting. -When nil, that text is exported as well." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-headline-levels 3 - "The last level which is still exported as a headline. -Inferior levels will produce itemize lists when exported. -Note that a numeric prefix argument to an exporter function overrides -this setting. - -This option can also be set with the +OPTIONS line, e.g. \"H:2\"." - :group 'org-export-general - :type 'number) - -(defcustom org-export-with-section-numbers t - "Non-nil means, add section numbers to headlines when exporting. - -This option can also be set with the +OPTIONS line, e.g. \"num:t\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-toc t - "Non-nil means, create a table of contents in exported files. -The TOC contains headlines with levels up to`org-export-headline-levels'. -When an integer, include levels up to N in the toc, this may then be -different from `org-export-headline-levels', but it will not be allowed -to be larger than the number of headline levels. -When nil, no table of contents is made. - -Headlines which contain any TODO items will be marked with \"(*)\" in -ASCII export, and with red color in HTML output, if the option -`org-export-mark-todo-in-toc' is set. - -In HTML output, the TOC will be clickable. - -This option can also be set with the +OPTIONS line, e.g. \"toc:nil\" -or \"toc:3\"." - :group 'org-export-general - :type '(choice - (const :tag "No Table of Contents" nil) - (const :tag "Full Table of Contents" t) - (integer :tag "TOC to level"))) - -(defcustom org-export-mark-todo-in-toc nil - "Non-nil means, mark TOC lines that contain any open TODO items." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-preserve-breaks nil - "Non-nil means, preserve all line breaks when exporting. -Normally, in HTML output paragraphs will be reformatted. In ASCII -export, line breaks will always be preserved, regardless of this variable. - -This option can also be set with the +OPTIONS line, e.g. \"\\n:t\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-archived-trees 'headline - "Whether subtrees with the ARCHIVE tag should be exported. -This can have three different values -nil Do not export, pretend this tree is not present -t Do export the entire tree -headline Only export the headline, but skip the tree below it." - :group 'org-export-general - :group 'org-archive - :type '(choice - (const :tag "not at all" nil) - (const :tag "headline only" 'headline) - (const :tag "entirely" t))) - -(defcustom org-export-author-info t - "Non-nil means, insert author name and email into the exported file. - -This option can also be set with the +OPTIONS line, -e.g. \"author-info:nil\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-time-stamp-file t - "Non-nil means, insert a time stamp into the exported file. -The time stamp shows when the file was created. - -This option can also be set with the +OPTIONS line, -e.g. \"timestamp:nil\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-timestamps t - "If nil, do not export time stamps and associated keywords." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-remove-timestamps-from-toc t - "If nil, remove timestamps from the table of contents entries." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-tags 'not-in-toc - "If nil, do not export tags, just remove them from headlines. -If this is the symbol `not-in-toc', tags will be removed from table of -contents entries, but still be shown in the headlines of the document. - -This option can also be set with the +OPTIONS line, e.g. \"tags:nil\"." - :group 'org-export-general - :type '(choice - (const :tag "Off" nil) - (const :tag "Not in TOC" not-in-toc) - (const :tag "On" t))) - -(defcustom org-export-with-drawers nil - "Non-nil means, export with drawers like the property drawer. -When t, all drawers are exported. This may also be a list of -drawer names to export." - :group 'org-export-general - :type '(choice - (const :tag "All drawers" t) - (const :tag "None" nil) - (repeat :tag "Selected drawers" - (string :tag "Drawer name")))) - -(defgroup org-export-translation nil - "Options for translating special ascii sequences for the export backends." - :tag "Org Export Translation" - :group 'org-export) - -(defcustom org-export-with-emphasize t - "Non-nil means, interpret *word*, /word/, and _word_ as emphasized text. -If the export target supports emphasizing text, the word will be -typeset in bold, italic, or underlined, respectively. Works only for -single words, but you can say: I *really* *mean* *this*. -Not all export backends support this. - -This option can also be set with the +OPTIONS line, e.g. \"*:nil\"." - :group 'org-export-translation - :type 'boolean) - -(defcustom org-export-with-footnotes t - "If nil, export [1] as a footnote marker. -Lines starting with [1] will be formatted as footnotes. - -This option can also be set with the +OPTIONS line, e.g. \"f:nil\"." - :group 'org-export-translation - :type 'boolean) - -(defcustom org-export-with-sub-superscripts t - "Non-nil means, interpret \"_\" and \"^\" for export. -When this option is turned on, you can use TeX-like syntax for sub- and -superscripts. Several characters after \"_\" or \"^\" will be -considered as a single item - so grouping with {} is normally not -needed. For example, the following things will be parsed as single -sub- or superscripts. - - 10^24 or 10^tau several digits will be considered 1 item. - 10^-12 or 10^-tau a leading sign with digits or a word - x^2-y^3 will be read as x^2 - y^3, because items are - terminated by almost any nonword/nondigit char. - x_{i^2} or x^(2-i) braces or parenthesis do grouping. - -Still, ambiguity is possible - so when in doubt use {} to enclose the -sub/superscript. 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. - -Not all export backends support this, but HTML does. - -This option can also be set with the +OPTIONS line, e.g. \"^:nil\"." - :group 'org-export-translation - :type '(choice - (const :tag "Always interpret" t) - (const :tag "Only with braces" {}) - (const :tag "Never interpret" nil))) - -(defcustom org-export-with-special-strings t - "Non-nil means, interpret \"\-\", \"--\" and \"---\" for export. -When this option is turned on, these strings will be exported as: - -\\- : ­ --- : – ---- : — - -Not all export backends support this, but HTML does. - -This option can also be set with the +OPTIONS line, e.g. \"-:nil\"." - :group 'org-export-translation - :type 'boolean) - -(defcustom org-export-with-TeX-macros t - "Non-nil means, interpret simple TeX-like macros when exporting. -For example, HTML export converts \\alpha to α and \\AA to Å. -No only real TeX macros will work here, but the standard HTML entities -for math can be used as macro names as well. For a list of supported -names in HTML export, see the constant `org-html-entities'. -Not all export backends support this. - -This option can also be set with the +OPTIONS line, e.g. \"TeX:nil\"." - :group 'org-export-translation - :group 'org-export-latex - :type 'boolean) - -(defcustom org-export-with-LaTeX-fragments nil - "Non-nil means, convert LaTeX fragments to images when exporting to HTML. -When set, the exporter will find LaTeX environments if the \\begin line is -the first non-white thing on a line. It will also find the math delimiters -like $a=b$ and \\( a=b \\) for inline math, $$a=b$$ and \\[ a=b \\] for -display math. - -This option can also be set with the +OPTIONS line, e.g. \"LaTeX:t\"." - :group 'org-export-translation - :group 'org-export-latex - :type 'boolean) - -(defcustom org-export-with-fixed-width t - "Non-nil means, lines starting with \":\" will be in fixed width font. -This can be used to have pre-formatted text, fragments of code etc. For -example: - : ;; Some Lisp examples - : (while (defc cnt) - : (ding)) -will be looking just like this in also HTML. See also the QUOTE keyword. -Not all export backends support this. - -This option can also be set with the +OPTIONS line, e.g. \"::nil\"." - :group 'org-export-translation - :type 'boolean) - -(defcustom org-match-sexp-depth 3 - "Number of stacked braces for sub/superscript matching. -This has to be set before loading org.el to be effective." - :group 'org-export-translation - :type 'integer) - -(defgroup org-export-tables nil - "Options for exporting tables in Org-mode." - :tag "Org Export Tables" - :group 'org-export) - -(defcustom org-export-with-tables t - "If non-nil, lines starting with \"|\" define a table. -For example: - - | Name | Address | Birthday | - |-------------+----------+-----------| - | Arthur Dent | England | 29.2.2100 | - -Not all export backends support this. - -This option can also be set with the +OPTIONS line, e.g. \"|:nil\"." - :group 'org-export-tables - :type 'boolean) - -(defcustom org-export-highlight-first-table-line t - "Non-nil means, highlight the first table line. -In HTML export, this means use instead of . -In tables created with table.el, this applies to the first table line. -In Org-mode tables, all lines before the first horizontal separator -line will be formatted with tags." - :group 'org-export-tables - :type 'boolean) - -(defcustom org-export-table-remove-special-lines t - "Remove special lines and marking characters in calculating tables. -This removes the special marking character column from tables that are set -up for spreadsheet calculations. It also removes the entire lines -marked with `!', `_', or `^'. The lines with `$' are kept, because -the values of constants may be useful to have." - :group 'org-export-tables - :type 'boolean) - -(defcustom org-export-prefer-native-exporter-for-tables nil - "Non-nil means, always export tables created with table.el natively. -Natively means, use the HTML code generator in table.el. -When nil, Org-mode's own HTML generator is used when possible (i.e. if -the table does not use row- or column-spanning). This has the -advantage, that the automatic HTML conversions for math symbols and -sub/superscripts can be applied. Org-mode's HTML generator is also -much faster." - :group 'org-export-tables - :type 'boolean) - -(defgroup org-export-ascii nil - "Options specific for ASCII export of Org-mode files." - :tag "Org Export ASCII" - :group 'org-export) - -(defcustom org-export-ascii-underline '(?\$ ?\# ?^ ?\~ ?\= ?\-) - "Characters for underlining headings in ASCII export. -In the given sequence, these characters will be used for level 1, 2, ..." - :group 'org-export-ascii - :type '(repeat character)) - -(defcustom org-export-ascii-bullets '(?* ?+ ?-) - "Bullet characters for headlines converted to lists in ASCII export. -The first character is is used for the first lest level generated in this -way, and so on. If there are more levels than characters given here, -the list will be repeated. -Note that plain lists will keep the same bullets as the have in the -Org-mode file." - :group 'org-export-ascii - :type '(repeat character)) - -(defgroup org-export-xml nil - "Options specific for XML export of Org-mode files." - :tag "Org Export XML" - :group 'org-export) - -(defgroup org-export-html nil - "Options specific for HTML export of Org-mode files." - :tag "Org Export HTML" - :group 'org-export) - -(defcustom org-export-html-coding-system nil - "" - :group 'org-export-html - :type 'coding-system) - -(defcustom org-export-html-extension "html" - "The extension for exported HTML files." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-style -"" - "The default style specification for exported HTML files. -Since there are different ways of setting style information, this variable -needs to contain the full HTML structure to provide a style, including the -surrounding HTML tags. The style specifications should include definitions -for new classes todo, done, title, and deadline. For example, legal values -would be: - - - -or, if you want to keep the style in a file, - - - -As the value of this option simply gets inserted into the HTML header, -you can \"misuse\" it to add arbitrary text to the header." - :group 'org-export-html - :type 'string) - - -(defcustom org-export-html-title-format "

    %s

    \n" - "Format for typesetting the document title in HTML export." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-toplevel-hlevel 2 - "The level for level 1 headings in HTML export." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-link-org-files-as-html t - "Non-nil means, make file links to `file.org' point to `file.html'. -When org-mode is exporting an org-mode file to HTML, links to -non-html files are directly put into a href tag in HTML. -However, links to other Org-mode files (recognized by the -extension `.org.) should become links to the corresponding html -file, assuming that the linked org-mode file will also be -converted to HTML. -When nil, the links still point to the plain `.org' file." - :group 'org-export-html - :type 'boolean) - -(defcustom org-export-html-inline-images 'maybe - "Non-nil means, inline images into exported HTML pages. -This is done using an tag. When nil, an anchor with href is used to -link to the image. If this option is `maybe', then images in links with -an empty description will be inlined, while images with a description will -be linked only." - :group 'org-export-html - :type '(choice (const :tag "Never" nil) - (const :tag "Always" t) - (const :tag "When there is no description" maybe))) - -;; FIXME: rename -(defcustom org-export-html-expand t - "Non-nil means, for HTML export, treat @<...> as HTML tag. -When nil, these tags will be exported as plain text and therefore -not be interpreted by a browser. - -This option can also be set with the +OPTIONS line, e.g. \"@:nil\"." - :group 'org-export-html - :type 'boolean) - -(defcustom org-export-html-table-tag - "" - "The HTML tag that is used to start a table. -This must be a
    tag, but you may change the options like -borders and spacing." - :group 'org-export-html - :type 'string) - -(defcustom org-export-table-header-tags '("") - "The opening tag for table header fields. -This is customizable so that alignment options can be specified." - :group 'org-export-tables - :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) - -(defcustom org-export-table-data-tags '("") - "The opening tag for table data fields. -This is customizable so that alignment options can be specified." - :group 'org-export-tables - :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) - -(defcustom org-export-html-with-timestamp nil - "If non-nil, write `org-export-html-html-helper-timestamp' -into the exported HTML text. Otherwise, the buffer will just be saved -to a file." - :group 'org-export-html - :type 'boolean) - -(defcustom org-export-html-html-helper-timestamp - "

    \n" - "The HTML tag used as timestamp delimiter for HTML-helper-mode." - :group 'org-export-html - :type 'string) - -(defgroup org-export-icalendar nil - "Options specific for iCalendar export of Org-mode files." - :tag "Org Export iCalendar" - :group 'org-export) - -(defcustom org-combined-agenda-icalendar-file "~/org.ics" - "The file name for the iCalendar file covering all agenda files. -This file is created with the command \\[org-export-icalendar-all-agenda-files]. -The file name should be absolute, the file will be overwritten without warning." - :group 'org-export-icalendar - :type 'file) - -(defcustom org-icalendar-include-todo nil - "Non-nil means, export to iCalendar files should also cover TODO items." - :group 'org-export-icalendar - :type '(choice - (const :tag "None" nil) - (const :tag "Unfinished" t) - (const :tag "All" all))) - -(defcustom org-icalendar-include-sexps t - "Non-nil means, export to iCalendar files should also cover sexp entries. -These are entries like in the diary, but directly in an Org-mode file." - :group 'org-export-icalendar - :type 'boolean) - -(defcustom org-icalendar-include-body 100 - "Amount of text below headline to be included in iCalendar export. -This is a number of characters that should maximally be included. -Properties, scheduling and clocking lines will always be removed. -The text will be inserted into the DESCRIPTION field." - :group 'org-export-icalendar - :type '(choice - (const :tag "Nothing" nil) - (const :tag "Everything" t) - (integer :tag "Max characters"))) - -(defcustom org-icalendar-combined-name "OrgMode" - "Calendar name for the combined iCalendar representing all agenda files." - :group 'org-export-icalendar - :type 'string) - -(defgroup org-font-lock nil - "Font-lock settings for highlighting in Org-mode." - :tag "Org Font Lock" - :group 'org) - -(defcustom org-level-color-stars-only nil - "Non-nil means fontify only the stars in each headline. -When nil, the entire headline is fontified. -Changing it requires restart of `font-lock-mode' to become effective -also in regions already fontified." - :group 'org-font-lock - :type 'boolean) - -(defcustom org-hide-leading-stars nil - "Non-nil means, hide the first N-1 stars in a headline. -This works by using the face `org-hide' for these stars. This -face is white for a light background, and black for a dark -background. You may have to customize the face `org-hide' to -make this work. -Changing it requires restart of `font-lock-mode' to become effective -also in regions already fontified. -You may also set this on a per-file basis by adding one of the following -lines to the buffer: - - #+STARTUP: hidestars - #+STARTUP: showstars" - :group 'org-font-lock - :type 'boolean) - -(defcustom org-fontify-done-headline nil - "Non-nil means, change the face of a headline if it is marked DONE. -Normally, only the TODO/DONE keyword indicates the state of a headline. -When this is non-nil, the headline after the keyword is set to the -`org-headline-done' as an additional indication." - :group 'org-font-lock - :type 'boolean) - -(defcustom org-fontify-emphasized-text t - "Non-nil means fontify *bold*, /italic/ and _underlined_ text. -Changing this variable requires a restart of Emacs to take effect." - :group 'org-font-lock - :type 'boolean) - -(defcustom org-highlight-latex-fragments-and-specials nil - "Non-nil means, fontify what is treated specially by the exporters." - :group 'org-font-lock - :type 'boolean) - -(defcustom org-hide-emphasis-markers nil - "Non-nil mean font-lock should hide the emphasis marker characters." - :group 'org-font-lock - :type 'boolean) - -(defvar org-emph-re nil - "Regular expression for matching emphasis.") -(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) - (let* ((e org-emphasis-regexp-components) - (pre (car e)) - (post (nth 1 e)) - (border (nth 2 e)) - (body (nth 3 e)) - (nl (nth 4 e)) - (stacked (and nil (nth 5 e))) ; stacked is no longer allowed, forced to nil - (body1 (concat body "*?")) - (markers (mapconcat 'car org-emphasis-alist "")) - (vmarkers (mapconcat - (lambda (x) (if (eq (nth 4 x) 'verbatim) (car x) "")) - org-emphasis-alist ""))) - ;; make sure special characters appear at the right position in the class - (if (string-match "\\^" markers) - (setq markers (concat (replace-match "" t t markers) "^"))) - (if (string-match "-" markers) - (setq markers (concat (replace-match "" t t markers) "-"))) - (if (string-match "\\^" vmarkers) - (setq vmarkers (concat (replace-match "" t t vmarkers) "^"))) - (if (string-match "-" vmarkers) - (setq vmarkers (concat (replace-match "" t t vmarkers) "-"))) - (if (> nl 0) - (setq body1 (concat body1 "\\(?:\n" body "*?\\)\\{0," - (int-to-string nl) "\\}"))) - ;; Make the regexp - (setq org-emph-re - (concat "\\([" pre (if (and nil stacked) markers) "]\\|^\\)" - "\\(" - "\\([" markers "]\\)" - "\\(" - "[^" border "]\\|" - "[^" border (if (and nil stacked) markers) "]" - body1 - "[^" border (if (and nil stacked) markers) "]" - "\\)" - "\\3\\)" - "\\([" post (if (and nil stacked) markers) "]\\|$\\)")) - (setq org-verbatim-re - (concat "\\([" pre "]\\|^\\)" - "\\(" - "\\([" vmarkers "]\\)" - "\\(" - "[^" border "]\\|" - "[^" border "]" - body1 - "[^" border "]" - "\\)" - "\\3\\)" - "\\([" post "]\\|$\\)"))))) - -(defcustom org-emphasis-regexp-components - '(" \t('\"" "- \t.,:?;'\")" " \t\r\n,\"'" "." 1) - "Components used to build the regular expression for emphasis. -This is a list with 6 entries. Terminology: In an emphasis string -like \" *strong word* \", we call the initial space PREMATCH, the final -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. - -Use customize to modify this, or restart Emacs after changing it." - :group 'org-font-lock - :set 'org-set-emph-re - :type '(list - (sexp :tag "Allowed chars in pre ") - (sexp :tag "Allowed chars in post ") - (sexp :tag "Forbidden chars in border ") - (sexp :tag "Regexp for body ") - (integer :tag "number of newlines allowed") - (option (boolean :tag "Stacking (DISABLED) ")))) - -(defcustom org-emphasis-alist - '(("*" bold "" "") - ("/" italic "" "") - ("_" underline "" "") - ("=" org-code "" "" verbatim) - ("~" org-verbatim "" "" verbatim) - ("+" (:strike-through t) "" "") - ) - "Special syntax for emphasized text. -Text starting and ending with a special character will be emphasized, for -example *bold*, _underlined_ and /italic/. This variable sets the marker -characters, the face to be used by font-lock for highlighting in Org-mode -Emacs buffers, and the HTML tags to be used for this. -Use customize to modify this, or restart Emacs after changing it." - :group 'org-font-lock - :set 'org-set-emph-re - :type '(repeat - (list - (string :tag "Marker character") - (choice - (face :tag "Font-lock-face") - (plist :tag "Face property list")) - (string :tag "HTML start tag") - (string :tag "HTML end tag") - (option (const verbatim))))) - -;;; The faces - -(defgroup org-faces nil - "Faces in Org-mode." - :tag "Org Faces" - :group 'org-font-lock) - -(defun org-compatible-face (inherits specs) - "Make a compatible face specification. -If INHERITS is an existing face and if the Emacs version supports it, -just inherit the face. If not, use SPECS to define the face. -XEmacs and Emacs 21 do not know about the `min-colors' attribute. -For them we convert a (min-colors 8) entry to a `tty' entry and move it -to the top of the list. The `min-colors' attribute will be removed from -any other entries, and any resulting duplicates will be removed entirely." - (cond - ((and inherits (facep inherits) - (not (featurep 'xemacs)) (> emacs-major-version 22)) - ;; In Emacs 23, we use inheritance where possible. - ;; We only do this in Emacs 23, because only there the outline - ;; faces have been changed to the original org-mode-level-faces. - (list (list t :inherit inherits))) - ((or (featurep 'xemacs) (< emacs-major-version 22)) - ;; These do not understand the `min-colors' attribute. - (let (r e a) - (while (setq e (pop specs)) - (cond - ((memq (car e) '(t default)) (push e r)) - ((setq a (member '(min-colors 8) (car e))) - (nconc r (list (cons (cons '(type tty) (delq (car a) (car e))) - (cdr e))))) - ((setq a (assq 'min-colors (car e))) - (setq e (cons (delq a (car e)) (cdr e))) - (or (assoc (car e) r) (push e r))) - (t (or (assoc (car e) r) (push e r))))) - (nreverse r))) - (t specs))) -(put 'org-compatible-face 'lisp-indent-function 1) - -(defface org-hide - '((((background light)) (:foreground "white")) - (((background dark)) (:foreground "black"))) - "Face used to hide leading stars in headlines. -The forground color of this face should be equal to the background -color of the frame." - :group 'org-faces) - -(defface org-level-1 ;; font-lock-function-name-face - (org-compatible-face 'outline-1 - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8)) (:foreground "blue" :bold t)) - (t (:bold t)))) - "Face used for level 1 headlines." - :group 'org-faces) - -(defface org-level-2 ;; font-lock-variable-name-face - (org-compatible-face 'outline-2 - '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) - (((class color) (min-colors 8) (background light)) (:foreground "yellow")) - (((class color) (min-colors 8) (background dark)) (:foreground "yellow" :bold t)) - (t (:bold t)))) - "Face used for level 2 headlines." - :group 'org-faces) - -(defface org-level-3 ;; font-lock-keyword-face - (org-compatible-face 'outline-3 - '((((class color) (min-colors 88) (background light)) (:foreground "Purple")) - (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1")) - (((class color) (min-colors 16) (background light)) (:foreground "Purple")) - (((class color) (min-colors 16) (background dark)) (:foreground "Cyan")) - (((class color) (min-colors 8) (background light)) (:foreground "purple" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "cyan" :bold t)) - (t (:bold t)))) - "Face used for level 3 headlines." - :group 'org-faces) - -(defface org-level-4 ;; font-lock-comment-face - (org-compatible-face 'outline-4 - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 16) (background light)) (:foreground "red")) - (((class color) (min-colors 16) (background dark)) (:foreground "red1")) - (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) - "Face used for level 4 headlines." - :group 'org-faces) - -(defface org-level-5 ;; font-lock-type-face - (org-compatible-face 'outline-5 - '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen")) - (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen")) - (((class color) (min-colors 8)) (:foreground "green")))) - "Face used for level 5 headlines." - :group 'org-faces) - -(defface org-level-6 ;; font-lock-constant-face - (org-compatible-face 'outline-6 - '((((class color) (min-colors 16) (background light)) (:foreground "CadetBlue")) - (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine")) - (((class color) (min-colors 8)) (:foreground "magenta")))) - "Face used for level 6 headlines." - :group 'org-faces) - -(defface org-level-7 ;; font-lock-builtin-face - (org-compatible-face 'outline-7 - '((((class color) (min-colors 16) (background light)) (:foreground "Orchid")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue")) - (((class color) (min-colors 8)) (:foreground "blue")))) - "Face used for level 7 headlines." - :group 'org-faces) - -(defface org-level-8 ;; font-lock-string-face - (org-compatible-face 'outline-8 - '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) - (((class color) (min-colors 8)) (:foreground "green")))) - "Face used for level 8 headlines." - :group 'org-faces) - -(defface org-special-keyword ;; font-lock-string-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) - (t (:italic t)))) - "Face used for special keywords." - :group 'org-faces) - -(defface org-drawer ;; font-lock-function-name-face - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8)) (:foreground "blue" :bold t)) - (t (:bold t)))) - "Face used for drawers." - :group 'org-faces) - -(defface org-property-value nil - "Face used for the value of a property." - :group 'org-faces) - -(defface org-column - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) - (:background "grey90")) - (((class color) (min-colors 16) (background dark)) - (:background "grey30")) - (((class color) (min-colors 8)) - (:background "cyan" :foreground "black")) - (t (:inverse-video t)))) - "Face for column display of entry properties." - :group 'org-faces) - -(when (fboundp 'set-face-attribute) - ;; Make sure that a fixed-width face is used when we have a column table. - (set-face-attribute 'org-column nil - :height (face-attribute 'default :height) - :family (face-attribute 'default :family))) - -(defface org-warning - (org-compatible-face 'font-lock-warning-face - '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) - (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) - (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) - "Face for deadlines and TODO keywords." - :group 'org-faces) - -(defface org-archived ; similar to shadow - (org-compatible-face 'shadow - '((((class color grayscale) (min-colors 88) (background light)) - (:foreground "grey50")) - (((class color grayscale) (min-colors 88) (background dark)) - (:foreground "grey70")) - (((class color) (min-colors 8) (background light)) - (:foreground "green")) - (((class color) (min-colors 8) (background dark)) - (:foreground "yellow")))) - "Face for headline with the ARCHIVE tag." - :group 'org-faces) - -(defface org-link - '((((class color) (background light)) (:foreground "Purple" :underline t)) - (((class color) (background dark)) (:foreground "Cyan" :underline t)) - (t (:underline t))) - "Face for links." - :group 'org-faces) - -(defface org-ellipsis - '((((class color) (background light)) (:foreground "DarkGoldenrod" :underline t)) - (((class color) (background dark)) (:foreground "LightGoldenrod" :underline t)) - (t (:strike-through t))) - "Face for the ellipsis in folded text." - :group 'org-faces) - -(defface org-target - '((((class color) (background light)) (:underline t)) - (((class color) (background dark)) (:underline t)) - (t (:underline t))) - "Face for links." - :group 'org-faces) - -(defface org-date - '((((class color) (background light)) (:foreground "Purple" :underline t)) - (((class color) (background dark)) (:foreground "Cyan" :underline t)) - (t (:underline t))) - "Face for links." - :group 'org-faces) - -(defface org-sexp-date - '((((class color) (background light)) (:foreground "Purple")) - (((class color) (background dark)) (:foreground "Cyan")) - (t (:underline t))) - "Face for links." - :group 'org-faces) - -(defface org-tag - '((t (:bold t))) - "Face for tags." - :group 'org-faces) - -(defface org-todo ; font-lock-warning-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) - (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) - (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:inverse-video t :bold t)))) - "Face for TODO keywords." - :group 'org-faces) - -(defface org-done ;; font-lock-type-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen" :bold t)) - (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :bold t)) - (((class color) (min-colors 8)) (:foreground "green")) - (t (:bold t)))) - "Face used for todo keywords that indicate DONE items." - :group 'org-faces) - -(defface org-headline-done ;; font-lock-string-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) - (((class color) (min-colors 8) (background light)) (:bold nil)))) - "Face used to indicate that a headline is DONE. -This face is only used if `org-fontify-done-headline' is set. If applies -to the part of the headline after the DONE keyword." - :group 'org-faces) - -(defcustom org-todo-keyword-faces nil - "Faces for specific TODO keywords. -This is a list of cons cells, with TODO keywords in the car -and faces in the cdr. The face can be a symbol, or a property -list of attributes, like (:foreground \"blue\" :weight bold :underline t)." - :group 'org-faces - :group 'org-todo - :type '(repeat - (cons - (string :tag "keyword") - (sexp :tag "face")))) - -(defface org-table ;; font-lock-function-name-face - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8) (background light)) (:foreground "blue")) - (((class color) (min-colors 8) (background dark))))) - "Face used for tables." - :group 'org-faces) - -(defface org-formula - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 8) (background light)) (:foreground "red")) - (((class color) (min-colors 8) (background dark)) (:foreground "red")) - (t (:bold t :italic t)))) - "Face for formulas." - :group 'org-faces) - -(defface org-code - (org-compatible-face nil - '((((class color grayscale) (min-colors 88) (background light)) - (:foreground "grey50")) - (((class color grayscale) (min-colors 88) (background dark)) - (:foreground "grey70")) - (((class color) (min-colors 8) (background light)) - (:foreground "green")) - (((class color) (min-colors 8) (background dark)) - (:foreground "yellow")))) - "Face for fixed-with text like code snippets." - :group 'org-faces - :version "22.1") - -(defface org-verbatim - (org-compatible-face nil - '((((class color grayscale) (min-colors 88) (background light)) - (:foreground "grey50" :underline t)) - (((class color grayscale) (min-colors 88) (background dark)) - (:foreground "grey70" :underline t)) - (((class color) (min-colors 8) (background light)) - (:foreground "green" :underline t)) - (((class color) (min-colors 8) (background dark)) - (:foreground "yellow" :underline t)))) - "Face for fixed-with text like code snippets." - :group 'org-faces - :version "22.1") - -(defface org-agenda-structure ;; font-lock-function-name-face - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8)) (:foreground "blue" :bold t)) - (t (:bold t)))) - "Face used in agenda for captions and dates." - :group 'org-faces) - -(defface org-scheduled-today - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen")) - (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen")) - (((class color) (min-colors 8)) (:foreground "green")) - (t (:bold t :italic t)))) - "Face for items scheduled for a certain day." - :group 'org-faces) - -(defface org-scheduled-previously - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 8) (background light)) (:foreground "red")) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) - "Face for items scheduled previously, and not yet done." - :group 'org-faces) - -(defface org-upcoming-deadline - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 8) (background light)) (:foreground "red")) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) - "Face for items scheduled previously, and not yet done." - :group 'org-faces) - -(defcustom org-agenda-deadline-faces - '((1.0 . org-warning) - (0.5 . org-upcoming-deadline) - (0.0 . default)) - "Faces for showing deadlines in the agenda. -This is a list of cons cells. The cdr of each cess is a face to be used, -and it can also just be a like like '(:foreground \"yellow\"). -Each car is a fraction of the head-warning time that must have passed for -this the face in the cdr to be used for display. The numbers must be -given in descending order. The head-warning time is normally taken -from `org-deadline-warning-days', but can also be specified in the deadline -timestamp itself, like this: - - DEADLINE: <2007-08-13 Mon -8d> - -You may use d for days, w for weeks, m for months and y for years. Months -and years will only be treated in an approximate fashion (30.4 days for a -month and 365.24 days for a year)." - :group 'org-faces - :group 'org-agenda-daily/weekly - :type '(repeat - (cons - (number :tag "Fraction of head-warning time passed") - (sexp :tag "Face")))) - -;; FIXME: this is not a good face yet. -(defface org-agenda-restriction-lock - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:background "yellow1")) - (((class color) (min-colors 88) (background dark)) (:background "skyblue4")) - (((class color) (min-colors 16) (background light)) (:background "yellow1")) - (((class color) (min-colors 16) (background dark)) (:background "skyblue4")) - (((class color) (min-colors 8)) (:background "cyan" :foreground "black")) - (t (:inverse-video t)))) - "Face for showing the agenda restriction lock." - :group 'org-faces) - -(defface org-time-grid ;; font-lock-variable-name-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) - (((class color) (min-colors 8)) (:foreground "yellow" :weight light)))) - "Face used for time grids." - :group 'org-faces) - -(defconst org-level-faces - '(org-level-1 org-level-2 org-level-3 org-level-4 - org-level-5 org-level-6 org-level-7 org-level-8 - )) - -(defcustom org-n-level-faces (length org-level-faces) - "The number different faces to be used for headlines. -Org-mode defines 8 different headline faces, so this can be at most 8. -If it is less than 8, the level-1 face gets re-used for level N+1 etc." - :type 'number - :group 'org-faces) - -;;; Functions and variables from ther packages -;; Declared here to avoid compiler warnings - -(eval-and-compile - (unless (fboundp 'declare-function) - (defmacro declare-function (fn file &optional arglist fileonly)))) - -;; XEmacs only -(defvar outline-mode-menu-heading) -(defvar outline-mode-menu-show) -(defvar outline-mode-menu-hide) -(defvar zmacs-regions) ; XEmacs regions - -;; Emacs only -(defvar mark-active) - -;; Various packages -;; FIXME: get the argument lists for the UNKNOWN stuff -(declare-function add-to-diary-list "diary-lib" - (date string specifier &optional marker globcolor literal)) -(declare-function table--at-cell-p "table" (position &optional object at-column)) -(declare-function Info-find-node "info" (filename nodename &optional no-going-back)) -(declare-function Info-goto-node "info" (nodename &optional fork)) -(declare-function bbdb "ext:bbdb-com" (string elidep)) -(declare-function bbdb-company "ext:bbdb-com" (string elidep)) -(declare-function bbdb-current-record "ext:bbdb-com" (&optional planning-on-modifying)) -(declare-function bbdb-name "ext:bbdb-com" (string elidep)) -(declare-function bbdb-record-getprop "ext:bbdb" (record property)) -(declare-function bbdb-record-name "ext:bbdb" (record)) -(declare-function bibtex-beginning-of-entry "bibtex" ()) -(declare-function bibtex-generate-autokey "bibtex" ()) -(declare-function bibtex-parse-entry "bibtex" (&optional content)) -(declare-function bibtex-url "bibtex" (&optional pos no-browse)) -(defvar calc-embedded-close-formula) -(defvar calc-embedded-open-formula) -(declare-function calendar-astro-date-string "cal-julian" (&optional date)) -(declare-function calendar-bahai-date-string "cal-bahai" (&optional date)) -(declare-function calendar-check-holidays "holidays" (date)) -(declare-function calendar-chinese-date-string "cal-china" (&optional date)) -(declare-function calendar-coptic-date-string "cal-coptic" (&optional date)) -(declare-function calendar-ethiopic-date-string "cal-coptic" (&optional date)) -(declare-function calendar-forward-day "cal-move" (arg)) -(declare-function calendar-french-date-string "cal-french" (&optional date)) -(declare-function calendar-goto-date "cal-move" (date)) -(declare-function calendar-goto-today "cal-move" ()) -(declare-function calendar-hebrew-date-string "cal-hebrew" (&optional date)) -(declare-function calendar-islamic-date-string "cal-islam" (&optional date)) -(declare-function calendar-iso-date-string "cal-iso" (&optional date)) -(declare-function calendar-julian-date-string "cal-julian" (&optional date)) -(declare-function calendar-mayan-date-string "cal-mayan" (&optional date)) -(declare-function calendar-persian-date-string "cal-persia" (&optional date)) -(defvar calendar-mode-map) -(defvar original-date) ; dynamically scoped in calendar.el does scope this -(declare-function cdlatex-tab "ext:cdlatex" ()) -(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) -(declare-function elmo-folder-exists-p "ext:elmo" (folder) t) -(declare-function elmo-message-entity-field "ext:elmo-msgdb" (entity field &optional type)) -(declare-function elmo-message-field "ext:elmo" (folder number field &optional type) t) -(declare-function elmo-msgdb-overview-get-entity "ext:elmo" (&rest unknown) t) -(defvar font-lock-unfontify-region-function) -(declare-function gnus-article-show-summary "gnus-art" ()) -(declare-function gnus-summary-last-subject "gnus-sum" ()) -(defvar gnus-other-frame-object) -(defvar gnus-group-name) -(defvar gnus-article-current) -(defvar Info-current-file) -(defvar Info-current-node) -(declare-function mh-display-msg "mh-show" (msg-num folder-name)) -(declare-function mh-find-path "mh-utils" ()) -(declare-function mh-get-header-field "mh-utils" (field)) -(declare-function mh-get-msg-num "mh-utils" (error-if-no-message)) -(declare-function mh-header-display "mh-show" ()) -(declare-function mh-index-previous-folder "mh-search" ()) -(declare-function mh-normalize-folder-name "mh-utils" (folder &optional empty-string-okay dont-remove-trailing-slash return-nil-if-folder-empty)) -(declare-function mh-search "mh-search" (folder search-regexp &optional redo-search-flag window-config)) -(declare-function mh-search-choose "mh-search" (&optional searcher)) -(declare-function mh-show "mh-show" (&optional message redisplay-flag)) -(declare-function mh-show-buffer-message-number "mh-comp" (&optional buffer)) -(declare-function mh-show-header-display "mh-show" t t) -(declare-function mh-show-msg "mh-show" (msg)) -(declare-function mh-show-show "mh-show" t t) -(declare-function mh-visit-folder "mh-folder" (folder &optional range index-data)) -(defvar mh-progs) -(defvar mh-current-folder) -(defvar mh-show-folder-buffer) -(defvar mh-index-folder) -(defvar mh-searcher) -(declare-function org-export-latex-cleaned-string "org-export-latex" (&optional commentsp)) -(declare-function parse-time-string "parse-time" (string)) -(declare-function remember "remember" (&optional initial)) -(declare-function remember-buffer-desc "remember" ()) -(defvar remember-save-after-remembering) -(defvar remember-data-file) -(defvar remember-register) -(defvar remember-buffer) -(defvar remember-handler-functions) -(defvar remember-annotation-functions) -(declare-function rmail-narrow-to-non-pruned-header "rmail" ()) -(declare-function rmail-show-message "rmail" (&optional n no-summary)) -(declare-function rmail-what-message "rmail" ()) -(defvar texmathp-why) -(declare-function vm-beginning-of-message "ext:vm-page" ()) -(declare-function vm-follow-summary-cursor "ext:vm-motion" ()) -(declare-function vm-get-header-contents "ext:vm-summary" (message header-name-regexp &optional clump-sep)) -(declare-function vm-isearch-narrow "ext:vm-search" ()) -(declare-function vm-isearch-update "ext:vm-search" ()) -(declare-function vm-select-folder-buffer "ext:vm-macro" ()) -(declare-function vm-su-message-id "ext:vm-summary" (m)) -(declare-function vm-su-subject "ext:vm-summary" (m)) -(declare-function vm-summarize "ext:vm-summary" (&optional display raise)) -(defvar vm-message-pointer) -(defvar vm-folder-directory) -(defvar w3m-current-url) -(defvar w3m-current-title) -;; backward compatibility to old version of wl -(declare-function wl-summary-buffer-msgdb "ext:wl-folder" (&rest unknown) t) -(declare-function wl-folder-get-elmo-folder "ext:wl-folder" (entity &optional no-cache)) -(declare-function wl-summary-goto-folder-subr "ext:wl-summary" (&optional name scan-type other-window sticky interactive scoring force-exit)) -(declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary" (&optional id)) -(declare-function wl-summary-line-from "ext:wl-summary" ()) -(declare-function wl-summary-line-subject "ext:wl-summary" ()) -(declare-function wl-summary-message-number "ext:wl-summary" ()) -(declare-function wl-summary-redisplay "ext:wl-summary" (&optional arg)) -(defvar wl-summary-buffer-elmo-folder) -(defvar wl-summary-buffer-folder-name) -(declare-function speedbar-line-directory "speedbar" (&optional depth)) - -(defvar org-latex-regexps) -(defvar constants-unit-system) - -;;; Variables for pre-computed regular expressions, all buffer local - -(defvar org-drawer-regexp nil - "Matches first line of a hidden block.") -(make-variable-buffer-local 'org-drawer-regexp) -(defvar org-todo-regexp nil - "Matches any of the TODO state keywords.") -(make-variable-buffer-local 'org-todo-regexp) -(defvar org-not-done-regexp nil - "Matches any of the TODO state keywords except the last one.") -(make-variable-buffer-local 'org-not-done-regexp) -(defvar org-todo-line-regexp nil - "Matches a headline and puts TODO state into group 2 if present.") -(make-variable-buffer-local 'org-todo-line-regexp) -(defvar org-complex-heading-regexp nil - "Matches a headline and puts everything into groups: -group 1: the stars -group 2: The todo keyword, maybe -group 3: Priority cookie -group 4: True headline -group 5: Tags") -(make-variable-buffer-local 'org-complex-heading-regexp) -(defvar org-todo-line-tags-regexp nil - "Matches a headline and puts TODO state into group 2 if present. -Also put tags into group 4 if tags are present.") -(make-variable-buffer-local 'org-todo-line-tags-regexp) -(defvar org-nl-done-regexp nil - "Matches newline followed by a headline with the DONE keyword.") -(make-variable-buffer-local 'org-nl-done-regexp) -(defvar org-looking-at-done-regexp nil - "Matches the DONE keyword a point.") -(make-variable-buffer-local 'org-looking-at-done-regexp) -(defvar org-ds-keyword-length 12 - "Maximum length of the Deadline and SCHEDULED keywords.") -(make-variable-buffer-local 'org-ds-keyword-length) -(defvar org-deadline-regexp nil - "Matches the DEADLINE keyword.") -(make-variable-buffer-local 'org-deadline-regexp) -(defvar org-deadline-time-regexp nil - "Matches the DEADLINE keyword together with a time stamp.") -(make-variable-buffer-local 'org-deadline-time-regexp) -(defvar org-deadline-line-regexp nil - "Matches the DEADLINE keyword and the rest of the line.") -(make-variable-buffer-local 'org-deadline-line-regexp) -(defvar org-scheduled-regexp nil - "Matches the SCHEDULED keyword.") -(make-variable-buffer-local 'org-scheduled-regexp) -(defvar org-scheduled-time-regexp nil - "Matches the SCHEDULED keyword together with a time stamp.") -(make-variable-buffer-local 'org-scheduled-time-regexp) -(defvar org-closed-time-regexp nil - "Matches the CLOSED keyword together with a time stamp.") -(make-variable-buffer-local 'org-closed-time-regexp) - -(defvar org-keyword-time-regexp nil - "Matches any of the 4 keywords, together with the time stamp.") -(make-variable-buffer-local 'org-keyword-time-regexp) -(defvar org-keyword-time-not-clock-regexp nil - "Matches any of the 3 keywords, together with the time stamp.") -(make-variable-buffer-local 'org-keyword-time-not-clock-regexp) -(defvar org-maybe-keyword-time-regexp nil - "Matches a timestamp, possibly preceeded by a keyword.") -(make-variable-buffer-local 'org-maybe-keyword-time-regexp) -(defvar org-planning-or-clock-line-re nil - "Matches a line with planning or clock info.") -(make-variable-buffer-local 'org-planning-or-clock-line-re) - -(defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t - rear-nonsticky t mouse-map t fontified t) - "Properties to remove when a string without properties is wanted.") - -(defsubst org-match-string-no-properties (num &optional string) - (if (featurep 'xemacs) - (let ((s (match-string num string))) - (remove-text-properties 0 (length s) org-rm-props s) - s) - (match-string-no-properties num string))) - -(defsubst org-no-properties (s) - (if (fboundp 'set-text-properties) - (set-text-properties 0 (length s) nil s) - (remove-text-properties 0 (length s) org-rm-props s)) - s) - -(defsubst org-get-alist-option (option key) - (cond ((eq key t) t) - ((eq option t) t) - ((assoc key option) (cdr (assoc key option))) - (t (cdr (assq 'default option))))) - -(defsubst org-inhibit-invisibility () - "Modified `buffer-invisibility-spec' for Emacs 21. -Some ops with invisible text do not work correctly on Emacs 21. For these -we turn off invisibility temporarily. Use this in a `let' form." - (if (< emacs-major-version 22) nil buffer-invisibility-spec)) - -(defsubst org-set-local (var value) - "Make VAR local in current buffer and set it to VALUE." - (set (make-variable-buffer-local var) value)) - -(defsubst org-mode-p () - "Check if the current buffer is in Org-mode." - (eq major-mode 'org-mode)) - -(defsubst org-last (list) - "Return the last element of LIST." - (car (last list))) - -(defun org-let (list &rest body) - (eval (cons 'let (cons list body)))) -(put 'org-let 'lisp-indent-function 1) - -(defun org-let2 (list1 list2 &rest body) - (eval (cons 'let (cons list1 (list (cons 'let (cons list2 body))))))) -(put 'org-let2 'lisp-indent-function 2) -(defconst org-startup-options - '(("fold" org-startup-folded t) - ("overview" org-startup-folded t) - ("nofold" org-startup-folded nil) - ("showall" org-startup-folded nil) - ("content" org-startup-folded content) - ("hidestars" org-hide-leading-stars t) - ("showstars" org-hide-leading-stars nil) - ("odd" org-odd-levels-only t) - ("oddeven" org-odd-levels-only nil) - ("align" org-startup-align-all-tables t) - ("noalign" org-startup-align-all-tables nil) - ("customtime" org-display-custom-times t) - ("logging" org-log-done t) - ("logdone" org-log-done t) - ("nologging" org-log-done nil) - ("lognotedone" org-log-done done push) - ("lognotestate" org-log-done state push) - ("lognoteclock-out" org-log-done clock-out push) - ("logrepeat" org-log-repeat t) - ("nologrepeat" org-log-repeat nil) - ("constcgs" constants-unit-system cgs) - ("constSI" constants-unit-system SI)) - "Variable associated with STARTUP options for org-mode. -Each element is a list of three items: The startup options as written -in the #+STARTUP line, the corresponding variable, and the value to -set this variable to if the option is found. An optional forth element PUSH -means to push this value onto the list in the variable.") - -(defun org-set-regexps-and-options () - "Precompute regular expressions for current buffer." - (when (org-mode-p) - (org-set-local 'org-todo-kwd-alist nil) - (org-set-local 'org-todo-key-alist nil) - (org-set-local 'org-todo-key-trigger nil) - (org-set-local 'org-todo-keywords-1 nil) - (org-set-local 'org-done-keywords nil) - (org-set-local 'org-todo-heads nil) - (org-set-local 'org-todo-sets nil) - (org-set-local 'org-todo-log-states nil) - (let ((re (org-make-options-regexp - '("CATEGORY" "SEQ_TODO" "TYP_TODO" "TODO" "COLUMNS" - "STARTUP" "ARCHIVE" "TAGS" "LINK" "PRIORITIES" - "CONSTANTS" "PROPERTY" "DRAWERS"))) - (splitre "[ \t]+") - kwds kws0 kwsa key value cat arch tags const links hw dws - tail sep kws1 prio props drawers - ex log) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (setq key (match-string 1) value (org-match-string-no-properties 2)) - (cond - ((equal key "CATEGORY") - (if (string-match "[ \t]+$" value) - (setq value (replace-match "" t t value))) - (setq cat value)) - ((member key '("SEQ_TODO" "TODO")) - (push (cons 'sequence (org-split-string value splitre)) kwds)) - ((equal key "TYP_TODO") - (push (cons 'type (org-split-string value splitre)) kwds)) - ((equal key "TAGS") - (setq tags (append tags (org-split-string value splitre)))) - ((equal key "COLUMNS") - (org-set-local 'org-columns-default-format value)) - ((equal key "LINK") - (when (string-match "^\\(\\S-+\\)[ \t]+\\(.+\\)" value) - (push (cons (match-string 1 value) - (org-trim (match-string 2 value))) - links))) - ((equal key "PRIORITIES") - (setq prio (org-split-string value " +"))) - ((equal key "PROPERTY") - (when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value) - (push (cons (match-string 1 value) (match-string 2 value)) - props))) - ((equal key "DRAWERS") - (setq drawers (org-split-string value splitre))) - ((equal key "CONSTANTS") - (setq const (append const (org-split-string value splitre)))) - ((equal key "STARTUP") - (let ((opts (org-split-string value splitre)) - l var val) - (while (setq l (pop opts)) - (when (setq l (assoc l org-startup-options)) - (setq var (nth 1 l) val (nth 2 l)) - (if (not (nth 3 l)) - (set (make-local-variable var) val) - (if (not (listp (symbol-value var))) - (set (make-local-variable var) nil)) - (set (make-local-variable var) (symbol-value var)) - (add-to-list var val)))))) - ((equal key "ARCHIVE") - (string-match " *$" value) - (setq arch (replace-match "" t t value)) - (remove-text-properties 0 (length arch) - '(face t fontified t) arch))) - ))) - (when cat - (org-set-local 'org-category (intern cat)) - (push (cons "CATEGORY" cat) props)) - (when prio - (if (< (length prio) 3) (setq prio '("A" "C" "B"))) - (setq prio (mapcar 'string-to-char prio)) - (org-set-local 'org-highest-priority (nth 0 prio)) - (org-set-local 'org-lowest-priority (nth 1 prio)) - (org-set-local 'org-default-priority (nth 2 prio))) - (and props (org-set-local 'org-local-properties (nreverse props))) - (and drawers (org-set-local 'org-drawers drawers)) - (and arch (org-set-local 'org-archive-location arch)) - (and links (setq org-link-abbrev-alist-local (nreverse links))) - ;; Process the TODO keywords - (unless kwds - ;; Use the global values as if they had been given locally. - (setq kwds (default-value 'org-todo-keywords)) - (if (stringp (car kwds)) - (setq kwds (list (cons org-todo-interpretation - (default-value 'org-todo-keywords))))) - (setq kwds (reverse kwds))) - (setq kwds (nreverse kwds)) - (let (inter kws kw) - (while (setq kws (pop kwds)) - (setq inter (pop kws) sep (member "|" kws) - kws0 (delete "|" (copy-sequence kws)) - kwsa nil - kws1 (mapcar - (lambda (x) - (if (string-match "^\\(.*?\\)\\(?:(\\(..?\\))\\)?$" x) - (progn - (setq kw (match-string 1 x) - ex (and (match-end 2) (match-string 2 x)) - log (and ex (string-match "@" ex)) - key (and ex (substring ex 0 1))) - (if (equal key "@") (setq key nil)) - (push (cons kw (and key (string-to-char key))) kwsa) - (and log (push kw org-todo-log-states)) - kw) - (error "Invalid TODO keyword %s" x))) - kws0) - kwsa (if kwsa (append '((:startgroup)) - (nreverse kwsa) - '((:endgroup)))) - hw (car kws1) - dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1)) - tail (list inter hw (car dws) (org-last dws))) - (add-to-list 'org-todo-heads hw 'append) - (push kws1 org-todo-sets) - (setq org-done-keywords (append org-done-keywords dws nil)) - (setq org-todo-key-alist (append org-todo-key-alist kwsa)) - (mapc (lambda (x) (push (cons x tail) org-todo-kwd-alist)) kws1) - (setq org-todo-keywords-1 (append org-todo-keywords-1 kws1 nil))) - (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))) - ;; Process the constants - (when const - (let (e cst) - (while (setq e (pop const)) - (if (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e) - (push (cons (match-string 1 e) (match-string 2 e)) cst))) - (setq org-table-formula-constants-local cst))) - - ;; Process the tags. - (when tags - (let (e tgs) - (while (setq e (pop tags)) - (cond - ((equal e "{") (push '(:startgroup) tgs)) - ((equal e "}") (push '(:endgroup) tgs)) - ((string-match (org-re "^\\([[:alnum:]_@]+\\)(\\(.\\))$") e) - (push (cons (match-string 1 e) - (string-to-char (match-string 2 e))) - tgs)) - (t (push (list e) tgs)))) - (org-set-local 'org-tag-alist nil) - (while (setq e (pop tgs)) - (or (and (stringp (car e)) - (assoc (car e) org-tag-alist)) - (push e org-tag-alist)))))) - - ;; Compute the regular expressions and other local variables - (if (not org-done-keywords) - (setq org-done-keywords (list (org-last org-todo-keywords-1)))) - (setq org-ds-keyword-length (+ 2 (max (length org-deadline-string) - (length org-scheduled-string))) - org-drawer-regexp - (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") - "\\):[ \t]*$") - org-not-done-keywords - (org-delete-all org-done-keywords (copy-sequence org-todo-keywords-1)) - org-todo-regexp - (concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords-1 - "\\|") "\\)\\>") - org-not-done-regexp - (concat "\\<\\(" - (mapconcat 'regexp-quote org-not-done-keywords "\\|") - "\\)\\>") - org-todo-line-regexp - (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" - (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") - "\\)\\>\\)?[ \t]*\\(.*\\)") - org-complex-heading-regexp - (concat "^\\(\\*+\\)\\(?:[ \t]+\\(" - (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") - "\\)\\>\\)?\\(?:[ \t]*\\(\\[#.\\]\\)\\)?[ \t]*\\(.*?\\)" - "\\(?:[ \t]+\\(:[[:alnum:]_@:]+:\\)\\)?[ \t]*$") - org-nl-done-regexp - (concat "\n\\*+[ \t]+" - "\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|") - "\\)" "\\>") - org-todo-line-tags-regexp - (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" - (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") - (org-re - "\\)\\>\\)? *\\(.*?\\([ \t]:[[:alnum:]:_@]+:[ \t]*\\)?$\\)")) - org-looking-at-done-regexp - (concat "^" "\\(?:" - (mapconcat 'regexp-quote org-done-keywords "\\|") "\\)" - "\\>") - org-deadline-regexp (concat "\\<" org-deadline-string) - org-deadline-time-regexp - (concat "\\<" org-deadline-string " *<\\([^>]+\\)>") - org-deadline-line-regexp - (concat "\\<\\(" org-deadline-string "\\).*") - org-scheduled-regexp - (concat "\\<" org-scheduled-string) - org-scheduled-time-regexp - (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>") - org-closed-time-regexp - (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]") - org-keyword-time-regexp - (concat "\\<\\(" org-scheduled-string - "\\|" org-deadline-string - "\\|" org-closed-string - "\\|" org-clock-string "\\)" - " *[[<]\\([^]>]+\\)[]>]") - org-keyword-time-not-clock-regexp - (concat "\\<\\(" org-scheduled-string - "\\|" org-deadline-string - "\\|" org-closed-string - "\\)" - " *[[<]\\([^]>]+\\)[]>]") - org-maybe-keyword-time-regexp - (concat "\\(\\<\\(" org-scheduled-string - "\\|" org-deadline-string - "\\|" org-closed-string - "\\|" org-clock-string "\\)\\)?" - " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^]\r\n>]*?[]>]\\|<%%([^\r\n>]*>\\)") - org-planning-or-clock-line-re - (concat "\\(?:^[ \t]*\\(" org-scheduled-string - "\\|" org-deadline-string - "\\|" org-closed-string "\\|" org-clock-string - "\\)\\>\\)") - ) - (org-compute-latex-and-specials-regexp) - (org-set-font-lock-defaults))) - -(defun org-remove-keyword-keys (list) - (mapcar (lambda (x) - (if (string-match "(..?)$" x) - (substring x 0 (match-beginning 0)) - x)) - list)) - -;; FIXME: this could be done much better, using second characters etc. -(defun org-assign-fast-keys (alist) - "Assign fast keys to a keyword-key alist. -Respect keys that are already there." - (let (new e k c c1 c2 (char ?a)) - (while (setq e (pop alist)) - (cond - ((equal e '(:startgroup)) (push e new)) - ((equal e '(:endgroup)) (push e new)) - (t - (setq k (car e) c2 nil) - (if (cdr e) - (setq c (cdr e)) - ;; automatically assign a character. - (setq c1 (string-to-char - (downcase (substring - k (if (= (string-to-char k) ?@) 1 0))))) - (if (or (rassoc c1 new) (rassoc c1 alist)) - (while (or (rassoc char new) (rassoc char alist)) - (setq char (1+ char))) - (setq c2 c1)) - (setq c (or c2 char))) - (push (cons k c) new)))) - (nreverse new))) - -;;; Some variables ujsed in various places - -(defvar org-window-configuration nil - "Used in various places to store a window configuration.") -(defvar org-finish-function nil - "Function to be called when `C-c C-c' is used. -This is for getting out of special buffers like remember.") - - -;; FIXME: Occasionally check by commenting these, to make sure -;; no other functions uses these, forgetting to let-bind them. -(defvar entry) -(defvar state) -(defvar last-state) -(defvar date) -(defvar description) - -;; Defined somewhere in this file, but used before definition. -(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized -(defvar org-agenda-buffer-name) -(defvar org-agenda-undo-list) -(defvar org-agenda-pending-undo-list) -(defvar org-agenda-overriding-header) -(defvar orgtbl-mode) -(defvar org-html-entities) -(defvar org-struct-menu) -(defvar org-org-menu) -(defvar org-tbl-menu) -(defvar org-agenda-keymap) - -;;;; Emacs/XEmacs compatibility - -;; Overlay compatibility functions -(defun org-make-overlay (beg end &optional buffer) - (if (featurep 'xemacs) - (make-extent beg end buffer) - (make-overlay beg end buffer))) -(defun org-delete-overlay (ovl) - (if (featurep 'xemacs) (delete-extent ovl) (delete-overlay ovl))) -(defun org-detach-overlay (ovl) - (if (featurep 'xemacs) (detach-extent ovl) (delete-overlay ovl))) -(defun org-move-overlay (ovl beg end &optional buffer) - (if (featurep 'xemacs) - (set-extent-endpoints ovl beg end (or buffer (current-buffer))) - (move-overlay ovl beg end buffer))) -(defun org-overlay-put (ovl prop value) - (if (featurep 'xemacs) - (set-extent-property ovl prop value) - (overlay-put ovl prop value))) -(defun org-overlay-display (ovl text &optional face evap) - "Make overlay OVL display TEXT with face FACE." - (if (featurep 'xemacs) - (let ((gl (make-glyph text))) - (and face (set-glyph-face gl face)) - (set-extent-property ovl 'invisible t) - (set-extent-property ovl 'end-glyph gl)) - (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 (featurep 'xemacs) - (let ((gl (make-glyph text))) - (and face (set-glyph-face gl face)) - (set-extent-property ovl 'begin-glyph gl)) - (if face (org-add-props text nil 'face face)) - (overlay-put ovl 'before-string text) - (if evap (overlay-put ovl 'evaporate t)))) -(defun org-overlay-get (ovl prop) - (if (featurep 'xemacs) - (extent-property ovl prop) - (overlay-get ovl prop))) -(defun org-overlays-at (pos) - (if (featurep 'xemacs) (extents-at pos) (overlays-at pos))) -(defun org-overlays-in (&optional start end) - (if (featurep 'xemacs) - (extent-list nil start end) - (overlays-in start end))) -(defun org-overlay-start (o) - (if (featurep 'xemacs) (extent-start-position o) (overlay-start o))) -(defun org-overlay-end (o) - (if (featurep 'xemacs) (extent-end-position o) (overlay-end o))) -(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 ((overlays (org-overlays-at (or pos (point)))) - ov found) - (while (setq ov (pop overlays)) - (if (org-overlay-get ov prop) - (if delete (org-delete-overlay ov) (push ov found)))) - found)) - -;; Region compatibility - -(defun org-add-hook (hook function &optional append local) - "Add-hook, compatible with both Emacsen." - (if (and local (featurep 'xemacs)) - (add-local-hook hook function append) - (add-hook hook function append local))) - -(defvar org-ignore-region nil - "To temporarily disable the active region.") - -(defun org-region-active-p () - "Is `transient-mark-mode' on and the region active? -Works on both Emacs and XEmacs." - (if org-ignore-region - nil - (if (featurep 'xemacs) - (and zmacs-regions (region-active-p)) - (if (fboundp 'use-region-p) - (use-region-p) - (and transient-mark-mode mark-active))))) ; Emacs 22 and before - -;; Invisibility compatibility - -(defun org-add-to-invisibility-spec (arg) - "Add elements to `buffer-invisibility-spec'. -See documentation for `buffer-invisibility-spec' for the kind of elements -that can be added." - (cond - ((fboundp 'add-to-invisibility-spec) - (add-to-invisibility-spec arg)) - ((or (null buffer-invisibility-spec) (eq buffer-invisibility-spec t)) - (setq buffer-invisibility-spec (list arg))) - (t - (setq buffer-invisibility-spec - (cons arg buffer-invisibility-spec))))) - -(defun org-remove-from-invisibility-spec (arg) - "Remove elements from `buffer-invisibility-spec'." - (if (fboundp 'remove-from-invisibility-spec) - (remove-from-invisibility-spec arg) - (if (consp buffer-invisibility-spec) - (setq buffer-invisibility-spec - (delete arg buffer-invisibility-spec))))) - -(defun org-in-invisibility-spec-p (arg) - "Is ARG a member of `buffer-invisibility-spec'?" - (if (consp buffer-invisibility-spec) - (member arg buffer-invisibility-spec) - nil)) - -;;;; Define the Org-mode - -(if (and (not (keymapp outline-mode-map)) (featurep 'allout)) - (error "Conflict with outdated version of allout.el. Load org.el before allout.el, or ugrade to newer allout, for example by switching to Emacs 22.")) - - -;; We use a before-change function to check if a table might need -;; an update. -(defvar org-table-may-need-update t - "Indicates that a table might need an update. -This variable is set by `org-before-change-function'. -`org-table-align' sets it back to nil.") -(defvar org-mode-map) -(defvar org-mode-hook nil) -(defvar org-inhibit-startup nil) ; Dynamically-scoped param. -(defvar org-agenda-keep-modes nil) ; Dynamically-scoped param. -(defvar org-table-buffer-is-an nil) -(defconst org-outline-regexp "\\*+ ") - -;;;###autoload -(define-derived-mode org-mode outline-mode "Org" - "Outline-based notes management and organizer, alias -\"Carsten's outline-mode for keeping track of everything.\" - -Org-mode develops organizational tasks around a NOTES file which -contains information about projects as plain text. Org-mode is -implemented on top of outline-mode, which is ideal to keep the content -of large files well structured. It supports ToDo items, deadlines and -time stamps, which magically appear in the diary listing of the Emacs -calendar. Tables are easily created with a built-in table editor. -Plain text URL-like links connect to websites, emails (VM), Usenet -messages (Gnus), BBDB entries, and any files related to the project. -For printing and sharing of notes, an Org-mode file (or a part of it) -can be exported as a structured ASCII or HTML file. - -The following commands are available: - -\\{org-mode-map}" - - ;; Get rid of Outline menus, they are not needed - ;; Need to do this here because define-derived-mode sets up - ;; the keymap so late. Still, it is a waste to call this each time - ;; we switch another buffer into org-mode. - (if (featurep 'xemacs) - (when (boundp 'outline-mode-menu-heading) - ;; Assume this is Greg's port, it used easymenu - (easy-menu-remove outline-mode-menu-heading) - (easy-menu-remove outline-mode-menu-show) - (easy-menu-remove outline-mode-menu-hide)) - (define-key org-mode-map [menu-bar headings] 'undefined) - (define-key org-mode-map [menu-bar hide] 'undefined) - (define-key org-mode-map [menu-bar show] 'undefined)) - - (easy-menu-add org-org-menu) - (easy-menu-add org-tbl-menu) - (org-install-agenda-files-menu) - (if org-descriptive-links (org-add-to-invisibility-spec '(org-link))) - (org-add-to-invisibility-spec '(org-cwidth)) - (when (featurep 'xemacs) - (org-set-local 'line-move-ignore-invisible t)) - (org-set-local 'outline-regexp org-outline-regexp) - (org-set-local 'outline-level 'org-outline-level) - (when (and org-ellipsis - (fboundp 'set-display-table-slot) (boundp 'buffer-display-table) - (fboundp 'make-glyph-code)) - (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 (and (not (stringp org-ellipsis)) - org-ellipsis))) - (if (stringp org-ellipsis) org-ellipsis "...")))) - (setq buffer-display-table org-display-table)) - (org-set-regexps-and-options) - ;; Calc embedded - (org-set-local 'calc-embedded-open-mode "# ") - (modify-syntax-entry ?# "<") - (modify-syntax-entry ?@ "w") - (if org-startup-truncated (setq truncate-lines t)) - (org-set-local 'font-lock-unfontify-region-function - 'org-unfontify-region) - ;; Activate before-change-function - (org-set-local 'org-table-may-need-update t) - (org-add-hook 'before-change-functions 'org-before-change-function nil - 'local) - ;; Check for running clock before killing a buffer - (org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) - ;; Paragraphs and auto-filling - (org-set-autofill-regexps) - (setq indent-line-function 'org-indent-line-function) - (org-update-radio-target-regexp) - - ;; Comment characters -; (org-set-local 'comment-start "#") ;; FIXME: this breaks wrapping - (org-set-local 'comment-padding " ") - - ;; Imenu - (org-set-local 'imenu-create-index-function - 'org-imenu-get-tree) - - ;; Make isearch reveal context - (if (or (featurep 'xemacs) - (not (boundp 'outline-isearch-open-invisible-function))) - ;; Emacs 21 and XEmacs make use of the hook - (org-add-hook 'isearch-mode-end-hook 'org-isearch-end 'append 'local) - ;; Emacs 22 deals with this through a special variable - (org-set-local 'outline-isearch-open-invisible-function - (lambda (&rest ignore) (org-show-context 'isearch)))) - - ;; If empty file that did not turn on org-mode automatically, make it to. - (if (and org-insert-mode-line-in-empty-file - (interactive-p) - (= (point-min) (point-max))) - (insert "# -*- mode: org -*-\n\n")) - - (unless org-inhibit-startup - (when org-startup-align-all-tables - (let ((bmp (buffer-modified-p))) - (org-table-map-tables 'org-table-align) - (set-buffer-modified-p bmp))) - (org-cycle-hide-drawers 'all) - (cond - ((eq org-startup-folded t) - (org-cycle '(4))) - ((eq org-startup-folded 'content) - (let ((this-command 'org-cycle) (last-command 'org-cycle)) - (org-cycle '(4)) (org-cycle '(4))))))) - -(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify) - -(defsubst org-call-with-arg (command arg) - "Call COMMAND interactively, but pretend prefix are was ARG." - (let ((current-prefix-arg arg)) (call-interactively command))) - -(defsubst org-current-line (&optional pos) - (save-excursion - (and pos (goto-char pos)) - ;; works also in narrowed buffer, because we start at 1, not point-min - (+ (if (bolp) 1 0) (count-lines 1 (point))))) - -(defun org-current-time () - "Current time, possibly rounded to `org-time-stamp-rounding-minutes'." - (if (> org-time-stamp-rounding-minutes 0) - (let ((r org-time-stamp-rounding-minutes) - (time (decode-time))) - (apply 'encode-time - (append (list 0 (* r (floor (+ .5 (/ (float (nth 1 time)) r))))) - (nthcdr 2 time)))) - (current-time))) - -(defun org-add-props (string plist &rest props) - "Add text properties to entire string, from beginning to end. -PLIST may be a list of properties, PROPS are individual properties and values -that will be added to PLIST. Returns the string that was modified." - (add-text-properties - 0 (length string) (if props (append plist props) plist) string) - string) -(put 'org-add-props 'lisp-indent-function 2) - - -;;;; Font-Lock stuff, including the activators - -(defvar org-mouse-map (make-sparse-keymap)) -(org-defkey org-mouse-map - (if (featurep 'xemacs) [button2] [mouse-2]) 'org-open-at-mouse) -(org-defkey org-mouse-map - (if (featurep 'xemacs) [button3] [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)) -(when org-return-follows-link - (org-defkey org-mouse-map [(return)] 'org-open-at-point) - (org-defkey org-mouse-map "\C-m" 'org-open-at-point)) - -(require 'font-lock) - -(defconst org-non-link-chars "]\t\n\r<>") -(defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news" "bbdb" "vm" - "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp")) -(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-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-any-link-re nil - "Regular expression matching any link.") - -(defun org-make-link-regexps () - "Update the link regular expressions. -This should be called after the variable `org-link-types' has changed." - (setq org-link-re-with-space - (concat - "?") - org-link-re-with-space2 - (concat - "?") - org-angle-link-re - (concat - "<\\(" (mapconcat 'identity org-link-types "\\|") "\\):" - "\\([^" org-non-link-chars " ]" - "[^" org-non-link-chars "]*" - "\\)>") - org-plain-link-re - (concat - "\\<\\(" (mapconcat 'identity org-link-types "\\|") "\\):" - "\\([^]\t\n\r<>,;() ]+\\)") - org-bracket-link-regexp - "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]" - org-bracket-link-analytic-regexp - (concat - "\\[\\[" - "\\(\\(" (mapconcat 'identity org-link-types "\\|") "\\):\\)?" - "\\([^]]+\\)" - "\\]" - "\\(\\[" "\\([^]]+\\)" "\\]\\)?" - "\\]") - org-any-link-re - (concat "\\(" org-bracket-link-regexp "\\)\\|\\(" - org-angle-link-re "\\)\\|\\(" - org-plain-link-re "\\)"))) - -(org-make-link-regexps) - -(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^\r\n>]*?\\)>" - "Regular expression for fast time stamp matching.") -(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^\r\n>]*?\\)[]>]" - "Regular expression for fast time stamp matching.") -(defconst org-ts-regexp0 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\([^]0-9>\r\n]*\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" - "Regular expression matching time strings for analysis. -This one does not require the space after the date.") -(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) \\([^]0-9>\r\n]*\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" - "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.") - -(defvar org-emph-face nil) - -(defun org-do-emphasis-faces (limit) - "Run through the buffer and add overlays to links." - (let (rtn) - (while (and (not rtn) (re-search-forward org-emph-re limit t)) - (if (not (= (char-after (match-beginning 3)) - (char-after (match-beginning 4)))) - (progn - (setq rtn t) - (font-lock-prepend-text-property (match-beginning 2) (match-end 2) - 'face - (nth 1 (assoc (match-string 3) - org-emphasis-alist))) - (add-text-properties (match-beginning 2) (match-end 2) - '(font-lock-multiline 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))))) - (backward-char 1)) - rtn)) - -(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 either the marker character, or the first character of the -HTML tag associated with that emphasis. If CHAR is a space, the 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 ((eal org-emphasis-alist) e det - (erc org-emphasis-regexp-components) - (prompt "") - (string "") beg end move tag c s) - (if (org-region-active-p) - (setq beg (region-beginning) end (region-end) - string (buffer-substring beg end)) - (setq move t)) - - (while (setq e (pop eal)) - (setq tag (car (org-split-string (nth 2 e) "[ <>/]+")) - c (aref tag 0)) - (push (cons c (string-to-char (car e))) det) - (setq prompt (concat prompt (format " [%s%c]%s" (car e) c - (substring tag 1))))) - (unless char - (message "%s" (concat "Emphasis marker or tag:" prompt)) - (setq char (read-char-exclusive))) - (setq char (or (cdr (assoc char det)) char)) - (if (equal char ?\ ) - (setq s "" move nil) - (unless (assoc (char-to-string char) org-emphasis-alist) - (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)) - (if beg (delete-region beg end)) - (unless (or (bolp) - (string-match (concat "[" (nth 0 erc) "\n]") - (char-to-string (char-before (point))))) - (insert " ")) - (unless (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)) - - -(defun org-activate-plain-links (limit) - "Run through the buffer and add overlays to links." - (catch 'exit - (let (f) - (while (re-search-forward org-plain-link-re limit t) - (setq f (get-text-property (match-beginning 0) 'face)) - (if (or (eq f 'org-tag) - (and (listp f) (memq 'org-tag f))) - nil - (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'rear-nonsticky org-nonsticky-props - 'keymap org-mouse-map - )) - (throw 'exit t)))))) - -(defun org-activate-code (limit) - (if (re-search-forward "^[ \t]*\\(:.*\\)" limit t) - (unless (get-text-property (match-beginning 1) 'face) - (remove-text-properties (match-beginning 0) (match-end 0) - '(display t invisible t intangible t)) - t))) - -(defun org-activate-angle-links (limit) - "Run through the buffer and add overlays to links." - (if (re-search-forward org-angle-link-re limit t) - (progn - (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'rear-nonsticky org-nonsticky-props - 'keymap org-mouse-map - )) - t))) - -(defmacro org-maybe-intangible (props) - "Add '(intangigble t) to PROPS if Emacs version is earlier than Emacs 22. -In emacs 21, invisible text is not avoided by the command loop, so the -intangible property is needed to make sure point skips this text. -In Emacs 22, this is not necessary. The intangible text property has -led to problems with flyspell. These problems are fixed in flyspell.el, -but we still avoid setting the property in Emacs 22 and later. -We use a macro so that the test can happen at compilation time." - (if (< emacs-major-version 22) - `(append '(intangible t) ,props) - props)) - -(defun org-activate-bracket-links (limit) - "Run through the buffer and add overlays to bracketed links." - (if (re-search-forward org-bracket-link-regexp limit t) - (let* ((help (concat "LINK: " - (org-match-string-no-properties 1))) - ;; FIXME: above we should remove the escapes. - ;; but that requires another match, protecting match data, - ;; a lot of overhead for font-lock. - (ip (org-maybe-intangible - (list 'invisible 'org-link 'rear-nonsticky org-nonsticky-props - 'keymap org-mouse-map 'mouse-face 'highlight - 'font-lock-multiline t 'help-echo help))) - (vp (list 'rear-nonsticky org-nonsticky-props - 'keymap org-mouse-map 'mouse-face 'highlight - ' font-lock-multiline t 'help-echo help))) - ;; We need to remove the invisible property here. Table narrowing - ;; may have made some of this invisible. - (remove-text-properties (match-beginning 0) (match-end 0) - '(invisible nil)) - (if (match-end 3) - (progn - (add-text-properties (match-beginning 0) (match-beginning 3) ip) - (add-text-properties (match-beginning 3) (match-end 3) vp) - (add-text-properties (match-end 3) (match-end 0) ip)) - (add-text-properties (match-beginning 0) (match-beginning 1) ip) - (add-text-properties (match-beginning 1) (match-end 1) vp) - (add-text-properties (match-end 1) (match-end 0) ip)) - t))) - -(defun org-activate-dates (limit) - "Run through the buffer and add overlays to dates." - (if (re-search-forward org-tsr-regexp-both limit t) - (progn - (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'rear-nonsticky org-nonsticky-props - 'keymap org-mouse-map)) - (when org-display-custom-times - (if (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 org-target-link-regexp nil - "Regular expression matching radio targets in plain text.") -(defvar org-target-regexp "<<\\([^<>\n\r]+\\)>>" - "Regular expression matching a link target.") -(defvar org-radio-target-regexp "<<<\\([^<>\n\r]+\\)>>>" - "Regular expression matching a radio target.") -(defvar org-any-target-regexp "<<\n\r]+\\)>>>?" ; FIXME, not exact, would match <<> as a radio target. - "Regular expression matching any target.") - -(defun org-activate-target-links (limit) - "Run through the buffer and add overlays to target matches." - (when org-target-link-regexp - (let ((case-fold-search t)) - (if (re-search-forward org-target-link-regexp limit t) - (progn - (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'rear-nonsticky org-nonsticky-props - 'keymap org-mouse-map - 'help-echo "Radio target link" - 'org-linked-text t)) - t))))) - -(defun org-update-radio-target-regexp () - "Find all radio targets in this file and update the regular expression." - (interactive) - (when (memq 'radio org-activate-links) - (setq org-target-link-regexp - (org-make-target-link-regexp (org-all-targets 'radio))) - (org-restart-font-lock))) - -(defun org-hide-wide-columns (limit) - (let (s e) - (setq s (text-property-any (point) (or limit (point-max)) - 'org-cwidth t)) - (when s - (setq e (next-single-property-change s 'org-cwidth)) - (add-text-properties s e (org-maybe-intangible '(invisible org-cwidth))) - (goto-char e) - t))) - -(defvar org-latex-and-specials-regexp nil - "Regular expression for highlighting export special stuff.") -(defvar org-match-substring-regexp) -(defvar org-match-substring-with-braces-regexp) -(defvar org-export-html-special-string-regexps) - -(defun org-compute-latex-and-specials-regexp () - "Compute regular expression for stuff treated specially by exporters." - (if (not org-highlight-latex-fragments-and-specials) - (org-set-local 'org-latex-and-specials-regexp nil) - (let* - ((matchers (plist-get org-format-latex-options :matchers)) - (latexs (delq nil (mapcar (lambda (x) (if (member (car x) matchers) x)) - org-latex-regexps))) - (options (org-combine-plists (org-default-export-plist) - (org-infile-export-plist))) - (org-export-with-sub-superscripts (plist-get options :sub-superscript)) - (org-export-with-LaTeX-fragments (plist-get options :LaTeX-fragments)) - (org-export-with-TeX-macros (plist-get options :TeX-macros)) - (org-export-html-expand (plist-get options :expand-quoted-html)) - (org-export-with-special-strings (plist-get options :special-strings)) - (re-sub - (cond - ((equal org-export-with-sub-superscripts '{}) - (list org-match-substring-with-braces-regexp)) - (org-export-with-sub-superscripts - (list org-match-substring-regexp)) - (t nil))) - (re-latex - (if org-export-with-LaTeX-fragments - (mapcar (lambda (x) (nth 1 x)) latexs))) - (re-macros - (if org-export-with-TeX-macros - (list (concat "\\\\" - (regexp-opt - (append (mapcar 'car org-html-entities) - (if (boundp 'org-latex-entities) - org-latex-entities nil)) - 'words))) ; FIXME - )) - ;; (list "\\\\\\(?:[a-zA-Z]+\\)"))) - (re-special (if org-export-with-special-strings - (mapcar (lambda (x) (car x)) - org-export-html-special-string-regexps))) - (re-rest - (delq nil - (list - (if org-export-html-expand "@<[^>\n]+>") - )))) - (org-set-local - 'org-latex-and-specials-regexp - (mapconcat 'identity (append re-latex re-sub re-macros re-special - re-rest) "\\|"))))) - -(defface org-latex-and-export-specials - (let ((font (cond ((assq :inherit custom-face-attributes) - '(:inherit underline)) - (t '(:underline t))))) - `((((class grayscale) (background light)) - (:foreground "DimGray" ,@font)) - (((class grayscale) (background dark)) - (:foreground "LightGray" ,@font)) - (((class color) (background light)) - (:foreground "SaddleBrown")) - (((class color) (background dark)) - (:foreground "burlywood")) - (t (,@font)))) - "Face used to highlight math latex and other special exporter stuff." - :group 'org-faces) - -(defun org-do-latex-and-special-faces (limit) - "Run through the buffer and add overlays to links." - (when org-latex-and-specials-regexp - (let (rtn d) - (while (and (not rtn) (re-search-forward org-latex-and-specials-regexp - limit t)) - (if (not (memq (car-safe (get-text-property (1+ (match-beginning 0)) - 'face)) - '(org-code org-verbatim underline))) - (progn - (setq rtn t - d (cond ((member (char-after (1+ (match-beginning 0))) - '(?_ ?^)) 1) - (t 0))) - (font-lock-prepend-text-property - (+ d (match-beginning 0)) (match-end 0) - 'face 'org-latex-and-export-specials) - (add-text-properties (+ d (match-beginning 0)) (match-end 0) - '(font-lock-multiline t))))) - rtn))) - -(defun org-restart-font-lock () - "Restart font-lock-mode, to force refontification." - (when (and (boundp 'font-lock-mode) font-lock-mode) - (font-lock-mode -1) - (font-lock-mode 1))) - -(defun org-all-targets (&optional radio) - "Return a list of all targets in this file. -With optional argument RADIO, only find radio targets." - (let ((re (if radio org-radio-target-regexp org-target-regexp)) - rtn) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward re nil t) - (add-to-list 'rtn (downcase (org-match-string-no-properties 1)))) - rtn))) - -(defun org-make-target-link-regexp (targets) - "Make regular expression matching all strings in TARGETS. -The regular expression finds the targets also if there is a line break -between words." - (and targets - (concat - "\\<\\(" - (mapconcat - (lambda (x) - (while (string-match " +" x) - (setq x (replace-match "\\s-+" t t x))) - x) - targets - "\\|") - "\\)\\>"))) - -(defun org-activate-tags (limit) - (if (re-search-forward (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \r\n]") limit t) - (progn - (add-text-properties (match-beginning 1) (match-end 1) - (list 'mouse-face 'highlight - 'rear-nonsticky org-nonsticky-props - 'keymap org-mouse-map)) - t))) - -(defun org-outline-level () - (save-excursion - (looking-at outline-regexp) - (if (match-beginning 1) - (+ (org-get-string-indentation (match-string 1)) 1000) - (1- (- (match-end 0) (match-beginning 0)))))) - -(defvar org-font-lock-keywords nil) - -(defconst org-property-re (org-re "^[ \t]*\\(:\\([[:alnum:]_]+\\):\\)[ \t]*\\(\\S-.*\\)") - "Regular expression matching a property line.") - -(defun org-set-font-lock-defaults () - (let* ((em org-fontify-emphasized-text) - (lk org-activate-links) - (org-font-lock-extra-keywords - (list - ;; Headlines - '("^\\(\\**\\)\\(\\* \\)\\(.*\\)" (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)) - ;; Drawers - (list org-drawer-regexp '(0 'org-special-keyword t)) - (list "^[ \t]*:END:" '(0 'org-special-keyword t)) - ;; Properties - (list org-property-re - '(1 'org-special-keyword t) - '(3 'org-property-value t)) - (if org-format-transports-properties-p - '("| *\\(<[0-9]+>\\) *" (1 'org-formula t))) - ;; Links - (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend))) - (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t))) - (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t))) - (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t))) - (if (memq 'radio lk) '(org-activate-target-links (0 'org-link t))) - (if (memq 'date lk) '(org-activate-dates (0 'org-date t))) - '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t)) - '(org-hide-wide-columns (0 nil append)) - ;; TODO lines - (list (concat "^\\*+[ \t]+" org-todo-regexp) - '(1 (org-get-todo-face 1) t)) - ;; DONE - (if org-fontify-done-headline - (list (concat "^[*]+ +\\<\\(" - (mapconcat 'regexp-quote org-done-keywords "\\|") - "\\)\\(.*\\)") - '(2 'org-headline-done t)) - nil) - ;; Priorities - (list (concat "\\[#[A-Z0-9]\\]") '(0 'org-special-keyword t)) - ;; Special keywords - (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t)) - (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t)) - (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t)) - (list (concat "\\<" org-clock-string) '(0 'org-special-keyword t)) - ;; Emphasis - (if em - (if (featurep 'xemacs) - '(org-do-emphasis-faces (0 nil append)) - '(org-do-emphasis-faces))) - ;; Checkboxes - '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)" - 2 'bold prepend) - (if org-provide-checkbox-statistics - '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" - (0 (org-get-checkbox-statistics-face) t))) - (list (concat "^\\*+ \\(.*:" org-archive-tag ":.*\\)") - '(1 'org-archived prepend)) - ;; Specials - '(org-do-latex-and-special-faces) - ;; Code - '(org-activate-code (1 'org-code t)) - ;; COMMENT - (list (concat "^\\*+[ \t]+\\<\\(" org-comment-string - "\\|" org-quote-string "\\)\\>") - '(1 'org-special-keyword t)) - '("^#.*" (0 'font-lock-comment-face t)) - ))) - (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) - ;; Now set the full font-lock-keywords - (org-set-local 'org-font-lock-keywords org-font-lock-extra-keywords) - (org-set-local 'font-lock-defaults - '(org-font-lock-keywords t nil nil backward-paragraph)) - (kill-local-variable 'font-lock-keywords) nil)) - -(defvar org-m nil) -(defvar org-l nil) -(defvar org-f nil) -(defun org-get-level-face (n) - "Get the right face for match N in font-lock matching of healdines." - (setq org-l (- (match-end 2) (match-beginning 1) 1)) - (if org-odd-levels-only (setq org-l (1+ (/ org-l 2)))) - (setq org-f (nth (% (1- 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 (if org-level-color-stars-only nil org-f)))) - -(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." - (if (numberp kwd) (setq kwd (match-string kwd))) - (or (cdr (assoc kwd org-todo-keyword-faces)) - (and (member kwd org-done-keywords) 'org-done) - 'org-todo)) - -(defun org-unfontify-region (beg end &optional maybe_loudly) - "Remove fontification and activation overlays from links." - (font-lock-default-unfontify-region beg end) - (let* ((buffer-undo-list t) - (inhibit-read-only t) (inhibit-point-motion-hooks t) - (inhibit-modification-hooks t) - deactivate-mark buffer-file-name buffer-file-truename) - (remove-text-properties beg end - '(mouse-face t keymap t org-linked-text t - invisible t intangible t)))) - -;;;; Visibility cycling, including org-goto and indirect buffer - -;;; Cycling - -(defvar org-cycle-global-status nil) -(make-variable-buffer-local 'org-cycle-global-status) -(defvar org-cycle-subtree-status nil) -(make-variable-buffer-local 'org-cycle-subtree-status) - -;;;###autoload -(defun org-cycle (&optional arg) - "Visibility cycling for Org-mode. - -- When this function is called with a prefix argument, rotate the entire - buffer through 3 states (global cycling) - 1. OVERVIEW: Show only top-level headlines. - 2. CONTENTS: Show all headlines of all levels, but no body text. - 3. SHOW ALL: Show everything. - -- When point is at the beginning of a headline, rotate the subtree started - by this line through 3 different states (local cycling) - 1. FOLDED: Only the main headline is shown. - 2. CHILDREN: The main headline and the direct children are shown. - From this state, you can move to one of the children - and zoom in further. - 3. SUBTREE: Show the entire subtree, including body text. - -- When there is a numeric prefix, go up to a heading with level ARG, do - a `show-subtree' and return to the previous cursor position. If ARG - is negative, go up that many levels. - -- When point is not at the beginning of a headline, execute - `indent-relative', like TAB normally does. See the option - `org-cycle-emulate-tab' for details. - -- Special case: if point is at the beginning of the buffer and there is - no headline in line 1, this function will act as if called with prefix arg. - But only if also the variable `org-cycle-global-at-bob' is t." - (interactive "P") - (let* ((outline-regexp - (if (and (org-mode-p) org-cycle-include-plain-lists) - "\\(?:\\*+ \\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) \\)" - outline-regexp)) - (bob-special (and org-cycle-global-at-bob (bobp) - (not (looking-at outline-regexp)))) - (org-cycle-hook - (if bob-special - (delq 'org-optimize-window-after-visibility-change - (copy-sequence org-cycle-hook)) - org-cycle-hook)) - (pos (point))) - - (if (or bob-special (equal arg '(4))) - ;; special case: use global cycling - (setq arg t)) - - (cond - - ((org-at-table-p 'any) - ;; Enter the table or move to the next field in the table - (or (org-table-recognize-table.el) - (progn - (if arg (org-table-edit-field t) - (org-table-justify-field-maybe) - (call-interactively 'org-table-next-field))))) - - ((eq arg t) ;; Global cycling - - (cond - ((and (eq last-command this-command) - (eq org-cycle-global-status 'overview)) - ;; We just created the overview - now do table of contents - ;; This can be slow in very large buffers, so indicate action - (message "CONTENTS...") - (org-content) - (message "CONTENTS...done") - (setq org-cycle-global-status 'contents) - (run-hook-with-args 'org-cycle-hook 'contents)) - - ((and (eq last-command this-command) - (eq org-cycle-global-status 'contents)) - ;; We just showed the table of contents - now show everything - (show-all) - (message "SHOW ALL") - (setq org-cycle-global-status 'all) - (run-hook-with-args 'org-cycle-hook 'all)) - - (t - ;; Default action: go to overview - (org-overview) - (message "OVERVIEW") - (setq org-cycle-global-status 'overview) - (run-hook-with-args 'org-cycle-hook 'overview)))) - - ((and org-drawers org-drawer-regexp - (save-excursion - (beginning-of-line 1) - (looking-at org-drawer-regexp))) - ;; Toggle block visibility - (org-flag-drawer - (not (get-char-property (match-end 0) 'invisible)))) - - ((integerp arg) - ;; Show-subtree, ARG levels up from here. - (save-excursion - (org-back-to-heading) - (outline-up-heading (if (< arg 0) (- arg) - (- (funcall outline-level) arg))) - (org-show-subtree))) - - ((and (save-excursion (beginning-of-line 1) (looking-at outline-regexp)) - (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) - ;; At a heading: rotate between three different views - (org-back-to-heading) - (let ((goal-column 0) eoh eol eos) - ;; First, some boundaries - (save-excursion - (org-back-to-heading) - (save-excursion - (beginning-of-line 2) - (while (and (not (eobp)) ;; this is like `next-line' - (get-char-property (1- (point)) 'invisible)) - (beginning-of-line 2)) (setq eol (point))) - (outline-end-of-heading) (setq eoh (point)) - (org-end-of-subtree t) - (unless (eobp) - (skip-chars-forward " \t\n") - (beginning-of-line 1) ; in case this is an item - ) - (setq eos (1- (point)))) - ;; Find out what to do next and set `this-command' - (cond - ((= eos eoh) - ;; Nothing is hidden behind this heading - (message "EMPTY ENTRY") - (setq org-cycle-subtree-status nil) - (save-excursion - (goto-char eos) - (outline-next-heading) - (if (org-invisible-p) (org-flag-heading nil)))) - ((or (>= eol eos) - (not (string-match "\\S-" (buffer-substring eol eos)))) - ;; Entire subtree is hidden in one line: open it - (org-show-entry) - (show-children) - (message "CHILDREN") - (save-excursion - (goto-char eos) - (outline-next-heading) - (if (org-invisible-p) (org-flag-heading nil))) - (setq org-cycle-subtree-status 'children) - (run-hook-with-args 'org-cycle-hook 'children)) - ((and (eq last-command this-command) - (eq org-cycle-subtree-status 'children)) - ;; We just showed the children, now show everything. - (org-show-subtree) - (message "SUBTREE") - (setq org-cycle-subtree-status 'subtree) - (run-hook-with-args 'org-cycle-hook 'subtree)) - (t - ;; Default action: hide the subtree. - (hide-subtree) - (message "FOLDED") - (setq org-cycle-subtree-status 'folded) - (run-hook-with-args 'org-cycle-hook 'folded))))) - - ;; TAB emulation - (buffer-read-only (org-back-to-heading)) - - ((org-try-cdlatex-tab)) - - ((and (eq org-cycle-emulate-tab 'exc-hl-bol) - (or (not (bolp)) - (not (looking-at 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)) -; (if (and (looking-at "[ \n\r\t]") -; (string-match "^[ \t]*$" (buffer-substring -; (point-at-bol) (point)))) -; (progn -; (beginning-of-line 1) -; (and (looking-at "[ \t]+") (replace-match "")))) - (call-interactively (global-key-binding "\t"))) - - (t (save-excursion - (org-back-to-heading) - (org-cycle)))))) - -;;;###autoload -(defun org-global-cycle (&optional arg) - "Cycle the global visibility. For details see `org-cycle'." - (interactive "P") - (let ((org-cycle-include-plain-lists - (if (org-mode-p) org-cycle-include-plain-lists nil))) - (if (integerp arg) - (progn - (show-all) - (hide-sublevels arg) - (setq org-cycle-global-status 'contents)) - (org-cycle '(4))))) - -(defun org-overview () - "Switch to overview mode, shoing only top-level headlines. -Really, this shows all headlines with level equal or greater than the level -of the first headline in the buffer. This is important, because if the -first headline is not level one, then (hide-sublevels 1) gives confusing -results." - (interactive) - (let ((level (save-excursion - (goto-char (point-min)) - (if (re-search-forward (concat "^" outline-regexp) nil t) - (progn - (goto-char (match-beginning 0)) - (funcall outline-level)))))) - (and level (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") - (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 outline-regexp)) - (if (integerp arg) - (show-children (1- arg)) - (show-branches)) - (if (bobp) (throw 'exit nil)))))) - - -(defun org-optimize-window-after-visibility-change (state) - "Adjust the window after a change in outline visibility. -This function is the default value of the hook `org-cycle-hook'." - (when (get-buffer-window (current-buffer)) - (cond -; ((eq state 'overview) (org-first-headline-recenter 1)) -; ((eq state 'overview) (org-beginning-of-line)) - ((eq state 'content) nil) - ((eq state 'all) nil) - ((eq state 'folded) nil) - ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1))) - ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1)))))) - -(defun org-compact-display-after-subtree-move () - (let (beg end) - (save-excursion - (if (org-up-heading-safe) - (progn - (hide-subtree) - (show-entry) - (show-children) - (org-cycle-show-empty-lines 'children) - (org-cycle-hide-drawers 'children)) - (org-overview))))) - -(defun org-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 headeline." - (when (> org-cycle-separator-lines 0) - (save-excursion - (let* ((n 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) - (beginning-of-line 2) - (point))))) - (when beg - (goto-char beg) - (while (re-search-forward re end t) - (if (not (get-char-property (match-end 1) 'invisible)) - (outline-flag-region - (match-beginning 1) (match-end 1) nil))))))) - ;; Never hide empty lines at the end of the file. - (save-excursion - (goto-char (point-max)) - (outline-previous-heading) - (outline-end-of-heading) - (if (and (looking-at "[ \t\n]+") - (= (match-end 0) (point-max))) - (outline-flag-region (point) (match-end 0) nil)))) - -(defun org-subtree-end-visible-p () - "Is the end of the current subtree visible?" - (pos-visible-in-window-p - (save-excursion (org-end-of-subtree t) (point)))) - -(defun org-first-headline-recenter (&optional N) - "Move cursor to the first headline and recenter the headline. -Optional argument N means, put the headline into the Nth line of the window." - (goto-char (point-min)) - (when (re-search-forward (concat "^\\(" outline-regexp "\\)") nil t) - (beginning-of-line) - (recenter (prefix-numeric-value N)))) - -;;; Org-goto - -(defvar org-goto-window-configuration nil) -(defvar org-goto-marker nil) -(defvar 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)) cmd) - (while (setq cmd (pop cmds)) - (substitute-key-definition cmd cmd map global-map))) - (suppress-keymap map) - (org-defkey map "\C-m" 'org-goto-ret) - (org-defkey map [(left)] 'org-goto-left) - (org-defkey map [(right)] 'org-goto-right) - (org-defkey map [(?q)] 'org-goto-quit) - (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) - (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 copy of buffer to find location or copy text. -RET=jump to location [Q]uit 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 () - "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 is will also jump to -the location selected in the indirect buffer and expose the -the headline hierarchy above." - (interactive) - (let* ((org-goto-start-pos (point)) - (selected-point - (car (org-get-location (current-buffer) org-goto-help)))) - (if selected-point - (progn - (org-mark-ring-push org-goto-start-pos) - (goto-char selected-point) - (if (or (org-invisible-p) (org-invisible-p2)) - (org-show-context 'org-goto))) - (message "Quit")))) - -(defvar org-goto-selected-point nil) ; dynamically scoped parameter -(defvar org-goto-exit-command nil) ; dynamically scoped parameter - -(defun org-get-location (buf help) - "Let the user select a location in the Org-mode buffer BUF. -This function uses a recursive edit. It returns the selected position -or nil." - (let (org-goto-selected-point org-goto-exit-command) - (save-excursion - (save-window-excursion - (delete-other-windows) - (and (get-buffer "*org-goto*") (kill-buffer "*org-goto*")) - (switch-to-buffer - (condition-case nil - (make-indirect-buffer (current-buffer) "*org-goto*") - (error (make-indirect-buffer (current-buffer) "*org-goto*")))) - (with-output-to-temp-buffer "*Help*" - (princ help)) - (shrink-window-if-larger-than-buffer (get-buffer-window "*Help*")) - (setq buffer-read-only nil) - (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)) - (let ((org-show-hierarchy-above t) - (org-show-siblings t) - (org-show-following-heading t)) - (goto-char org-goto-start-pos) - (and (org-invisible-p) (org-show-context))) - (goto-char (point-min))) - (org-beginning-of-line) - (message "Select location and press RET") - ;; now we make sure that during selection, ony very few keys work - ;; and that it is impossible to switch to another window. -; (let ((gm (current-global-map)) -; (overriding-local-map org-goto-map)) -; (unwind-protect -; (progn -; (use-global-map org-goto-map) -; (recursive-edit)) -; (use-global-map gm))) - (use-local-map org-goto-map) - (recursive-edit) - )) - (kill-buffer "*org-goto*") - (cons org-goto-selected-point org-goto-exit-command))) - -(defun org-goto-ret (&optional arg) - "Finish `org-goto' by going to the new location." - (interactive "P") - (setq org-goto-selected-point (point) - org-goto-exit-command 'return) - (throw 'exit nil)) - -(defun org-goto-left () - "Finish `org-goto' by going to the new location." - (interactive) - (if (org-on-heading-p) - (progn - (beginning-of-line 1) - (setq org-goto-selected-point (point) - org-goto-exit-command 'left) - (throw 'exit nil)) - (error "Not on a heading"))) - -(defun org-goto-right () - "Finish `org-goto' by going to the new location." - (interactive) - (if (org-on-heading-p) - (progn - (setq org-goto-selected-point (point) - org-goto-exit-command 'right) - (throw 'exit nil)) - (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 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 `C-u' 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 C-u 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)) - (if (< arg 0) (setq arg (+ level arg))) - (while (> (setq level (org-outline-level)) arg) - (outline-up-heading 1 t))) - (setq beg (point) - heading (org-get-heading)) - (org-end-of-subtree t) (setq end (point))) - (if (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) - 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) - (switch-to-buffer 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) - (switch-to-buffer ibuf) - (org-set-frame-title (concat "Indirect: " heading))) - ((eq org-indirect-buffer-display 'current-window) - (switch-to-buffer ibuf)) - ((eq org-indirect-buffer-display 'other-window) - (pop-to-buffer ibuf)) - (t (error "Invalid value."))) - (if (featurep 'xemacs) - (save-excursion (org-mode) (turn-on-font-lock))) - (narrow-to-region beg end) - (show-all) - (goto-char pos) - (and (window-live-p cwin) (select-window cwin)))) - -(defun org-get-indirect-buffer (&optional buffer) - (setq buffer (or buffer (current-buffer))) - (let ((n 1) (base (buffer-name buffer)) bname) - (while (buffer-live-p - (get-buffer (setq bname (concat base "-" (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." - ;; FIXME: how to name a single frame in XEmacs??? - (unless (featurep 'xemacs) - (modify-frame-parameters (selected-frame) (list (cons 'name title))))) - -;;;; Structure editing - -;;; Inserting headlines - -(defun org-insert-heading (&optional force-heading) - "Insert a new heading or item with same depth at point. -If point is in a plain list and FORCE-HEADING is nil, create a new list item. -If point is at the beginning of a headline, insert a sibling before the -current headline. If point is in the middle of a headline, split the headline -at that position and make the rest of the headline part of the sibling below -the current headline." - (interactive "P") - (if (= (buffer-size) 0) - (insert "\n* ") - (when (or force-heading (not (org-insert-item))) - (let* ((head (save-excursion - (condition-case nil - (progn - (org-back-to-heading) - (match-string 0)) - (error "*")))) - (blank (cdr (assq 'heading org-blank-before-new-entry))) - pos) - (cond - ((and (org-on-heading-p) (bolp) - (or (bobp) - (save-excursion (backward-char 1) (not (org-invisible-p))))) - (open-line (if blank 2 1))) - ((and (bolp) - (or (bobp) - (save-excursion - (backward-char 1) (not (org-invisible-p))))) - nil) - (t (newline (if blank 2 1)))) - (insert head) (just-one-space) - (setq pos (point)) - (end-of-line 1) - (unless (= (point) pos) (just-one-space) (backward-delete-char 1)) - (run-hooks 'org-insert-heading-hook))))) - -(defun org-insert-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-todo-heading (arg) - "Insert a new heading with the same level and TODO state as current heading. -If the heading has no TODO state, or if the state is DONE, use the first -state (TODO by default). Also with prefix arg, force first state." - (interactive "P") - (when (not (org-insert-item 'checkbox)) - (org-insert-heading) - (save-excursion - (org-back-to-heading) - (outline-previous-heading) - (looking-at org-todo-line-regexp)) - (if (or arg - (not (match-beginning 2)) - (member (match-string 2) org-done-keywords)) - (insert (car org-todo-keywords-1) " ") - (insert (match-string 2) " ")))) - -(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-on-heading-p) (org-do-demote)) - ((org-at-item-p) (org-indent-item 1)))) - -(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-on-heading-p) (org-do-demote)) - ((org-at-item-p) (org-indent-item 1)))) - -;;; Promotion and Demotion - -(defun org-promote-subtree () - "Promote the entire subtree. -See also `org-promote'." - (interactive) - (save-excursion - (org-map-tree 'org-promote)) - (org-fix-position-after-promote)) - -(defun org-demote-subtree () - "Demote the entire subtree. See `org-demote'. -See also `org-promote'." - (interactive) - (save-excursion - (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 () - "Make sure that after pro/demotion cursor position is right." - (let ((pos (point))) - (when (save-excursion - (beginning-of-line 1) - (looking-at org-todo-line-regexp) - (or (equal pos (match-end 1)) (equal pos (match-end 2)))) - (cond ((eobp) (insert " ")) - ((eolp) (insert " ")) - ((equal (char-after) ?\ ) (forward-char 1)))))) - -(defun org-reduced-level (l) - (if org-odd-levels-only (1+ (floor (/ l 2))) l)) - -(defun org-get-legal-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." - (if org-odd-levels-only - (cond ((or (not change) (= 0 change)) (1+ (* 2 (/ level 2)))) - ((> change 0) (1+ (* 2 (/ (+ level (* 2 change)) 2)))) - ((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2)))))) - (max 1 (+ level change)))) - -(defun org-promote () - "Promote the current heading higher up the tree. -If the region is active in `transient-mark-mode', promote all headings -in the region." - (org-back-to-heading t) - (let* ((level (save-match-data (funcall outline-level))) - (up-head (concat (make-string (org-get-legal-level level -1) ?*) " ")) - (diff (abs (- level (length up-head) -1)))) - (if (= level 1) (error "Cannot promote to level 0. UNDO to recover if necessary")) - (replace-match up-head nil t) - ;; Fixup tag positioning - (and org-auto-align-tags (org-set-tags nil t)) - (if org-adapt-indentation (org-fixup-indentation (- diff))))) - -(defun org-demote () - "Demote the current heading lower down the tree. -If the region is active in `transient-mark-mode', demote all headings -in the region." - (org-back-to-heading t) - (let* ((level (save-match-data (funcall outline-level))) - (down-head (concat (make-string (org-get-legal-level level 1) ?*) " ")) - (diff (abs (- level (length down-head) -1)))) - (replace-match down-head nil t) - ;; Fixup tag positioning - (and org-auto-align-tags (org-set-tags nil t)) - (if org-adapt-indentation (org-fixup-indentation diff)))) - -(defun org-map-tree (fun) - "Call FUN for every heading underneath the current one." - (org-back-to-heading) - (let ((level (funcall outline-level))) - (save-excursion - (funcall fun) - (while (and (progn - (outline-next-heading) - (> (funcall outline-level) level)) - (not (eobp))) - (funcall fun))))) - -(defun org-map-region (fun beg end) - "Call FUN for every heading between BEG and END." - (let ((org-ignore-region t)) - (save-excursion - (setq end (copy-marker end)) - (goto-char beg) - (if (and (re-search-forward (concat "^" outline-regexp) nil t) - (< (point) end)) - (funcall fun)) - (while (and (progn - (outline-next-heading) - (< (point) end)) - (not (eobp))) - (funcall fun))))) - -(defun org-fixup-indentation (diff) - "Change the indentation in the current entry by DIFF -However, if any line in the current entry has no indentation, or if it -would end up with no indentation after the change, nothing at all is done." - (save-excursion - (let ((end (save-excursion (outline-next-heading) - (point-marker))) - (prohibit (if (> diff 0) - "^\\S-" - (concat "^ \\{0," (int-to-string (- diff)) "\\}\\S-"))) - col) - (unless (save-excursion (end-of-line 1) - (re-search-forward prohibit end t)) - (while (and (< (point) end) - (re-search-forward "^[ \t]+" end t)) - (goto-char (match-end 0)) - (setq col (current-column)) - (if (< diff 0) (replace-match "")) - (indent-to (+ diff col)))) - (move-marker end nil)))) - -(defun org-convert-to-odd-levels () - "Convert an org-mode file with all levels allowed to one with odd levels. -This will leave level 1 alone, convert level 2 to level 3, level 3 to -level 5 etc." - (interactive) - (when (yes-or-no-p "Are you sure you want to globally change levels to odd? ") - (let ((org-odd-levels-only nil) n) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "^\\*\\*+ " nil t) - (setq n (- (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-mode file with only odd levels to one with odd and even levels. -This promotes level 3 to level 2, level 5 to level 3 etc. If the file contains a -section with an even level, conversion would destroy the structure of the file. An error -is signaled in this case." - (interactive) - (goto-char (point-min)) - ;; First check if there are no even levels - (when (re-search-forward "^\\(\\*\\*\\)+ " nil t) - (org-show-context t) - (error "Not all levels are odd in this file. Conversion not possible.")) - (when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ") - (let ((org-odd-levels-only nil) n) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "^\\*\\*+ " nil t) - (setq n (/ (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) 'outline-get-next-sibling - 'outline-get-last-sibling)) - (ins-point (make-marker)) - (cnt (abs arg)) - 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))) - (outline-end-of-subtree)) - (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 outline-regexp)) - (progn (goto-char beg0) - (error "Cannot move past superior level or buffer limit"))) - (setq cnt (1- cnt))) - (if (> arg 0) - ;; Moving forward - still need to move over subtree - (progn (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)) - (delete-region beg end) - (outline-flag-region (1- beg) beg nil) - (outline-flag-region (1- (point)) (point) nil) - (insert txt) - (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) - (org-compact-display-after-subtree-move) - (unless folded - (org-show-entry) - (show-children) - (org-cycle-hide-drawers 'children)))) - -(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) - "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 copying it. -If CUT is non-nil, actually cut the subtree." - (interactive "p") - (let (beg end folded (beg0 (point))) - (if (interactive-p) - (org-back-to-heading nil) ; take what looks like a subtree - (org-back-to-heading t)) ; take what is really there - (org-back-over-empty-lines) - (setq beg (point)) - (skip-chars-forward " \t\r\n") - (save-match-data - (save-excursion (outline-end-of-heading) - (setq folded (org-invisible-p))) - (condition-case nil - (outline-forward-same-level (1- n)) - (error nil)) - (org-end-of-subtree t t)) - (org-back-over-empty-lines) - (setq end (point)) - (goto-char beg0) - (when (> end beg) - (setq org-subtree-clip-folded folded) - (if cut (kill-region beg end) (copy-region-as-kill beg end)) - (setq org-subtree-clip (current-kill 0)) - (message "%s: Subtree(s) with %d characters" - (if cut "Cut" "Copied") - (length org-subtree-clip))))) - -(defun org-paste-subtree (&optional level tree) - "Paste the clipboard as a subtree, with modification of headline level. -The entire subtree is promoted or demoted in order to match a new headline -level. By default, the new level is derived from the visible headings -before and after the insertion point, and taken to be the inferior headline -level of the two. So if the previous visible heading is level 3 and the -next is level 4 (or vice versa), level 4 will be used for insertion. -This makes sure that the subtree remains an independent subtree and does -not swallow low level entries. - -You can also force a different level, either by using a numeric prefix -argument, or by inserting the heading marker by hand. For example, if the -cursor is after \"*****\", then the tree will be shifted to level 5. - -If you want to insert the tree as is, just use \\[yank]. - -If optional TREE is given, use this text instead of the kill ring." - (interactive "P") - (unless (org-kill-is-subtree-p tree) - (error "%s" - (substitute-command-keys - "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) - (let* ((txt (or tree (and kill-ring (current-kill 0)))) - (^re (concat "^\\(" outline-regexp "\\)")) - (re (concat "\\(" outline-regexp "\\)")) - (^re_ (concat "\\(\\*+\\)[ \t]*")) - - (old-level (if (string-match ^re txt) - (- (match-end 0) (match-beginning 0) 1) - -1)) - (force-level (cond (level (prefix-numeric-value level)) - ((string-match - ^re_ (buffer-substring (point-at-bol) (point))) - (- (match-end 1) (match-beginning 1))) - (t nil))) - (previous-level (save-excursion - (condition-case nil - (progn - (outline-previous-visible-heading 1) - (if (looking-at re) - (- (match-end 0) (match-beginning 0) 1) - 1)) - (error 1)))) - (next-level (save-excursion - (condition-case nil - (progn - (or (looking-at outline-regexp) - (outline-next-visible-heading 1)) - (if (looking-at re) - (- (match-end 0) (match-beginning 0) 1) - 1)) - (error 1)))) - (new-level (or force-level (max previous-level next-level))) - (shift (if (or (= old-level -1) - (= new-level -1) - (= old-level new-level)) - 0 - (- new-level old-level))) - (delta (if (> shift 0) -1 1)) - (func (if (> shift 0) 'org-demote 'org-promote)) - (org-odd-levels-only nil) - beg end) - ;; Remove the forced level indicator - (if force-level - (delete-region (point-at-bol) (point))) - ;; Paste - (beginning-of-line 1) - (org-back-over-empty-lines) ;; FIXME: correct fix???? - (setq beg (point)) - (insert-before-markers txt) ;; FIXME: correct fix???? - (unless (string-match "\n\\'" txt) (insert "\n")) - (setq end (point)) - (goto-char beg) - (skip-chars-forward " \t\n\r") - (setq beg (point)) - ;; 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)))) - (when (interactive-p) - (message "Clipboard pasted as level %d subtree" new-level)) - (if (and kill-ring - (eq org-subtree-clip (current-kill 0)) - org-subtree-clip-folded) - ;; The tree was folded before it was killed/copied - (hide-subtree)))) - -(defun org-kill-is-subtree-p (&optional txt) - "Check if the current kill is an outline subtree, or a set of trees. -Returns nil if kill does not start with a headline, or if the first -headline level is not the largest headline level in the tree. -So this will actually accept several entries of equal levels as well, -which is OK for `org-paste-subtree'. -If optional TXT is given, check this string instead of the current kill." - (let* ((kill (or txt (and kill-ring (current-kill 0)) "")) - (start-level (and kill - (string-match (concat "\\`\\([ \t\n\r]*?\n\\)?\\(" - org-outline-regexp "\\)") - kill) - (- (match-end 2) (match-beginning 2) 1))) - (re (concat "^" org-outline-regexp)) - (start (1+ (match-beginning 2)))) - (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)))) - -(defun org-narrow-to-subtree () - "Narrow buffer to the current subtree." - (interactive) - (save-excursion - (narrow-to-region - (progn (org-back-to-heading) (point)) - (progn (org-end-of-subtree t t) (point))))) - - -;;; Outline Sorting - -(defun org-sort (with-case) - "Call `org-sort-entries-or-items' or `org-table-sort-lines'. -Optional argument WITH-CASE means sort case-sensitively." - (interactive "P") - (if (org-at-table-p) - (org-call-with-arg 'org-table-sort-lines with-case) - (org-call-with-arg 'org-sort-entries-or-items with-case))) - -(defvar org-priority-regexp) ; defined later in the file - -(defun org-sort-entries-or-items (&optional with-case sorting-type getkey-func property) - "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, and by date/time as given by -the first time stamp in the entry. The command prompts for the sorting -type unless it has been given to the function through the SORTING-TYPE -argument, which needs to a character, any of (?n ?N ?a ?A ?t ?T ?p ?P ?f ?F). -If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be -called with point at the beginning of the record. It must return either -a string or a number that should serve as the sorting key for that record. - -Comparing entries ignores case by default. However, with an optional argument -WITH-CASE, the sorting considers case as well." - (interactive "P") - (let ((case-func (if with-case 'identity 'downcase)) - start beg end stars re re2 - txt what tmp plain-list-p) - ;; 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)) - (if (not (org-on-heading-p)) (outline-next-heading)) - (setq start (point))) - ((org-at-item-p) - ;; we will sort this plain list - (org-beginning-of-item-list) (setq start (point)) - (org-end-of-item-list) (setq end (point)) - (goto-char start) - (setq plain-list-p t - what "plain list")) - ((or (org-on-heading-p) - (condition-case nil (progn (org-back-to-heading) t) (error nil))) - ;; we will sort the children of the current headline - (org-back-to-heading) - (setq start (point) - end (progn (org-end-of-subtree t t) - (org-back-over-empty-lines) - (point)) - what "children") - (goto-char start) - (show-subtree) - (outline-next-heading)) - (t - ;; we will sort the top-level entries in this file - (goto-char (point-min)) - (or (org-on-heading-p) (outline-next-heading)) - (setq start (point) end (point-max) what "top-level") - (goto-char start) - (show-all))) - - (setq beg (point)) - (if (>= beg end) (error "Nothing to sort")) - - (unless plain-list-p - (looking-at "\\(\\*+\\)") - (setq stars (match-string 1) - re (concat "^" (regexp-quote stars) " +") - re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[^*]") - txt (buffer-substring beg end)) - (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n"))) - (if (and (not (equal stars "*")) (string-match re2 txt)) - (error "Region to sort contains a level above the first entry"))) - - (unless sorting-type - (message - (if plain-list-p - "Sort %s: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:" - "Sort %s: [a]lpha [n]umeric [t]ime [p]riority p[r]operty [f]unc A/N/T/P/F means reversed:") - what) - (setq sorting-type (read-char-exclusive)) - - (and (= (downcase sorting-type) ?f) - (setq getkey-func - (completing-read "Sort using function: " - obarray 'fboundp t nil nil)) - (setq getkey-func (intern getkey-func))) - - (and (= (downcase sorting-type) ?r) - (setq property - (completing-read "Property: " - (mapcar 'list (org-buffer-property-keys t)) - nil t)))) - - (message "Sorting entries...") - - (save-restriction - (narrow-to-region start end) - - (let ((dcst (downcase sorting-type)) - (now (current-time))) - (sort-subr - (/= dcst sorting-type) - ;; This function moves to the beginning character of the "record" to - ;; be sorted. - (if plain-list-p - (lambda nil - (if (org-at-item-p) t (goto-char (point-max)))) - (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. - (if plain-list-p - 'org-end-of-item - (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. - (if plain-list-p - (lambda nil - (when (looking-at "[ \t]*[-+*0-9.)]+[ \t]+") - (cond - ((= dcst ?n) - (string-to-number (buffer-substring (match-end 0) - (point-at-eol)))) - ((= dcst ?a) - (buffer-substring (match-end 0) (point-at-eol))) - ((= dcst ?t) - (if (re-search-forward org-ts-regexp - (point-at-eol) t) - (org-time-string-to-time (match-string 0)) - now)) - ((= dcst ?f) - (if getkey-func - (progn - (setq tmp (funcall getkey-func)) - (if (stringp tmp) (setq tmp (funcall case-func tmp))) - tmp) - (error "Invalid key function `%s'" getkey-func))) - (t (error "Invalid sorting type `%c'" sorting-type))))) - (lambda nil - (cond - ((= dcst ?n) - (if (looking-at outline-regexp) - (string-to-number (buffer-substring (match-end 0) - (point-at-eol))) - nil)) - ((= dcst ?a) - (funcall case-func (buffer-substring (point-at-bol) - (point-at-eol)))) - ((= dcst ?t) - (if (re-search-forward org-ts-regexp - (save-excursion - (forward-line 2) - (point)) t) - (org-time-string-to-time (match-string 0)) - now)) - ((= 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 ?f) - (if getkey-func - (progn - (setq tmp (funcall getkey-func)) - (if (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 ?t) 'time-less-p) - (t nil))))) - (message "Sorting entries...done"))) - -(defun org-do-sort (table what &optional with-case sorting-type) - "Sort TABLE of WHAT according to SORTING-TYPE. -The user will be prompted for the SORTING-TYPE if the call to this -function does not specify it. WHAT is only for the prompt, to indicate -what is being sorted. The sorting key will be extracted from -the car of the elements of the table. -If WITH-CASE is non-nil, the sorting will be case-sensitive." - (unless sorting-type - (message - "Sort %s: [a]lphabetic. [n]umeric. [t]ime. A/N/T means reversed:" - what) - (setq sorting-type (read-char-exclusive))) - (let ((dcst (downcase sorting-type)) - extractfun comparefun) - ;; Define the appropriate functions - (cond - ((= dcst ?n) - (setq extractfun 'string-to-number - comparefun (if (= dcst sorting-type) '< '>))) - ((= dcst ?a) - (setq extractfun (if with-case (lambda(x) (org-sort-remove-invisible x)) - (lambda(x) (downcase (org-sort-remove-invisible x)))) - comparefun (if (= dcst sorting-type) - 'string< - (lambda (a b) (and (not (string< a b)) - (not (string= a b))))))) - ((= dcst ?t) - (setq extractfun - (lambda (x) - (if (string-match org-ts-regexp x) - (time-to-seconds - (org-time-string-to-time (match-string 0 x))) - 0)) - comparefun (if (= dcst sorting-type) '< '>))) - (t (error "Invalid sorting type `%c'" sorting-type))) - - (sort (mapcar (lambda (x) (cons (funcall extractfun (car x)) (cdr x))) - table) - (lambda (a b) (funcall comparefun (car a) (car b)))))) - -;;;; Plain list items, including checkboxes - -;;; Plain list items - -(defun org-at-item-p () - "Is point in a line starting a hand-formatted item?" - (let ((llt org-plain-list-ordered-item-terminator)) - (save-excursion - (goto-char (point-at-bol)) - (looking-at - (cond - ((eq llt t) "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") - ((= llt ?.) "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") - ((= llt ?\)) "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") - (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))))))) - -(defun org-in-item-p () - "It the cursor inside a plain list item. -Does not have to be the first line." - (save-excursion - (condition-case nil - (progn - (org-beginning-of-item) - (org-at-item-p) - t) - (error nil)))) - -(defun org-insert-item (&optional checkbox) - "Insert a new item at the current level. -Return t when things worked, nil when we are not in an item." - (when (save-excursion - (condition-case nil - (progn - (org-beginning-of-item) - (org-at-item-p) - (if (org-invisible-p) (error "Invisible item")) - t) - (error nil))) - (let* ((bul (match-string 0)) - (eow (save-excursion (beginning-of-line 1) (looking-at "[ \t]*") - (match-end 0))) - (blank (cdr (assq 'plain-list-item org-blank-before-new-entry))) - pos) - (cond - ((and (org-at-item-p) (<= (point) eow)) - ;; before the bullet - (beginning-of-line 1) - (open-line (if blank 2 1))) - ((<= (point) eow) - (beginning-of-line 1)) - (t (newline (if blank 2 1)))) - (insert bul (if checkbox "[ ]" "")) - (just-one-space) - (setq pos (point)) - (end-of-line 1) - (unless (= (point) pos) (just-one-space) (backward-delete-char 1))) - (org-maybe-renumber-ordered-list) - (and checkbox (org-update-checkbox-count-maybe)) - t)) - -;;; Checkboxes - -(defun org-at-item-checkbox-p () - "Is point at a line starting a plain-list item with a checklet?" - (and (org-at-item-p) - (save-excursion - (goto-char (match-end 0)) - (skip-chars-forward " \t") - (looking-at "\\[[- X]\\]")))) - -(defun org-toggle-checkbox (&optional arg) - "Toggle the checkbox in the current line." - (interactive "P") - (catch 'exit - (let (beg end status (firstnew 'unknown)) - (cond - ((org-region-active-p) - (setq beg (region-beginning) end (region-end))) - ((org-on-heading-p) - (setq beg (point) end (save-excursion (outline-next-heading) (point)))) - ((org-at-item-checkbox-p) - (let ((pos (point))) - (replace-match - (cond (arg "[-]") - ((member (match-string 0) '("[ ]" "[-]")) "[X]") - (t "[ ]")) - t t) - (goto-char pos)) - (throw 'exit t)) - (t (error "Not at a checkbox or heading, and no active region"))) - (save-excursion - (goto-char beg) - (while (< (point) end) - (when (org-at-item-checkbox-p) - (setq status (equal (match-string 0) "[X]")) - (when (eq firstnew 'unknown) - (setq firstnew (not status))) - (replace-match - (if (if arg (not status) firstnew) "[X]" "[ ]") t t)) - (beginning-of-line 2))))) - (org-update-checkbox-count-maybe)) - -(defun org-update-checkbox-count-maybe () - "Update checkbox statistics unless turned off by user." - (when org-provide-checkbox-statistics - (org-update-checkbox-count))) - -(defun org-update-checkbox-count (&optional all) - "Update the checkbox statistics in the current section. -This will find all statistic cookies like [57%] and [6/12] and update them -with the current numbers. With optional prefix argument ALL, do this for -the whole buffer." - (interactive "P") - (save-excursion - (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21 - (beg (condition-case nil - (progn (outline-back-to-heading) (point)) - (error (point-min)))) - (end (move-marker (make-marker) - (progn (outline-next-heading) (point)))) - (re "\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)") - (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)") - b1 e1 f1 c-on c-off lim (cstat 0)) - (when all - (goto-char (point-min)) - (outline-next-heading) - (setq beg (point) end (point-max))) - (goto-char beg) - (while (re-search-forward re end t) - (setq cstat (1+ cstat) - b1 (match-beginning 0) - e1 (match-end 0) - f1 (match-beginning 1) - lim (cond - ((org-on-heading-p) (outline-next-heading) (point)) - ((org-at-item-p) (org-end-of-item) (point)) - (t nil)) - c-on 0 c-off 0) - (goto-char e1) - (when lim - (while (re-search-forward re-box lim t) - (if (member (match-string 2) '("[ ]" "[-]")) - (setq c-off (1+ c-off)) - (setq c-on (1+ c-on)))) -; (delete-region b1 e1) - (goto-char b1) - (insert (if f1 - (format "[%d%%]" (/ (* 100 c-on) (max 1 (+ c-on c-off)))) - (format "[%d/%d]" c-on (+ c-on c-off)))) - (and (looking-at "\\[.*?\\]") - (replace-match "")))) - (when (interactive-p) - (message "Checkbox satistics updated %s (%d places)" - (if all "in entire file" "in current outline entry") cstat))))) - -(defun org-get-checkbox-statistics-face () - "Select the face for checkbox statistics. -The face will be `org-done' when all relevant boxes are checked. Otherwise -it will be `org-todo'." - (if (match-end 1) - (if (equal (match-string 1) "100%") 'org-done 'org-todo) - (if (and (> (match-end 2) (match-beginning 2)) - (equal (match-string 2) (match-string 3))) - 'org-done - 'org-todo))) - -(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 - (if (string-match "^ *" (org-remove-tabs line)) - (match-end 0)) - (save-excursion - (beginning-of-line 1) - (skip-chars-forward " \t") - (current-column)))) - -(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 indenation 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))) - (if (>= i i2) (setq l (substring line i2))) - (if (> i1 0) - (concat (make-string i1 ?\ ) l) - l))) - -(defcustom org-empty-line-terminates-plain-lists nil - "Non-nil means, an empty line ends all plain list levels. -When nil, empty lines are part of the preceeding item." - :group 'org-plain-lists - :type 'boolean) - -(defun org-beginning-of-item () - "Go to the beginning of the current hand-formatted item. -If the cursor is not in an item, throw an error." - (interactive) - (let ((pos (point)) - (limit (save-excursion - (condition-case nil - (progn - (org-back-to-heading) - (beginning-of-line 2) (point)) - (error (point-min))))) - (ind-empty (if org-empty-line-terminates-plain-lists 0 10000)) - ind ind1) - (if (org-at-item-p) - (beginning-of-line 1) - (beginning-of-line 1) - (skip-chars-forward " \t") - (setq ind (current-column)) - (if (catch 'exit - (while t - (beginning-of-line 0) - (if (or (bobp) (< (point) limit)) (throw 'exit nil)) - - (if (looking-at "[ \t]*$") - (setq ind1 ind-empty) - (skip-chars-forward " \t") - (setq ind1 (current-column))) - (if (< ind1 ind) - (progn (beginning-of-line 1) (throw 'exit (org-at-item-p)))))) - nil - (goto-char pos) - (error "Not in an item"))))) - -(defun org-end-of-item () - "Go to the end of the current hand-formatted item. -If the cursor is not in an item, throw an error." - (interactive) - (let* ((pos (point)) - ind1 - (ind-empty (if org-empty-line-terminates-plain-lists 0 10000)) - (limit (save-excursion (outline-next-heading) (point))) - (ind (save-excursion - (org-beginning-of-item) - (skip-chars-forward " \t") - (current-column))) - (end (catch 'exit - (while t - (beginning-of-line 2) - (if (eobp) (throw 'exit (point))) - (if (>= (point) limit) (throw 'exit (point-at-bol))) - (if (looking-at "[ \t]*$") - (setq ind1 ind-empty) - (skip-chars-forward " \t") - (setq ind1 (current-column))) - (if (<= ind1 ind) - (throw 'exit (point-at-bol))))))) - (if end - (goto-char end) - (goto-char pos) - (error "Not in an item")))) - -(defun org-next-item () - "Move to the beginning of the next item in the current plain list. -Error if not at a plain list, or if this is the last item in the list." - (interactive) - (let (ind ind1 (pos (point))) - (org-beginning-of-item) - (setq ind (org-get-indentation)) - (org-end-of-item) - (setq ind1 (org-get-indentation)) - (unless (and (org-at-item-p) (= ind ind1)) - (goto-char pos) - (error "On last item")))) - -(defun org-previous-item () - "Move to the beginning of the previous item in the current plain list. -Error if not at a plain list, or if this is the first item in the list." - (interactive) - (let (beg ind ind1 (pos (point))) - (org-beginning-of-item) - (setq beg (point)) - (setq ind (org-get-indentation)) - (goto-char beg) - (catch 'exit - (while t - (beginning-of-line 0) - (if (looking-at "[ \t]*$") - nil - (if (<= (setq ind1 (org-get-indentation)) ind) - (throw 'exit t))))) - (condition-case nil - (if (or (not (org-at-item-p)) - (< ind1 (1- ind))) - (error "") - (org-beginning-of-item)) - (error (goto-char pos) - (error "On first item"))))) - -(defun org-first-list-item-p () - "Is this heading the item in a plain list?" - (unless (org-at-item-p) - (error "Not at a plain list item")) - (org-beginning-of-item) - (= (point) (save-excursion (org-beginning-of-item-list)))) - -(defun org-move-item-down () - "Move the plain list item at point down, i.e. swap with following item. -Subitems (items with larger indentation) are considered part of the item, -so this really moves item trees." - (interactive) - (let (beg beg0 end end0 ind ind1 (pos (point)) txt ne-end ne-beg) - (org-beginning-of-item) - (setq beg0 (point)) - (save-excursion - (setq ne-beg (org-back-over-empty-lines)) - (setq beg (point))) - (goto-char beg0) - (setq ind (org-get-indentation)) - (org-end-of-item) - (setq end0 (point)) - (setq ind1 (org-get-indentation)) - (setq ne-end (org-back-over-empty-lines)) - (setq end (point)) - (goto-char beg0) - (when (and (org-first-list-item-p) (< ne-end ne-beg)) - ;; include less whitespace - (save-excursion - (goto-char beg) - (forward-line (- ne-beg ne-end)) - (setq beg (point)))) - (goto-char end0) - (if (and (org-at-item-p) (= ind ind1)) - (progn - (org-end-of-item) - (org-back-over-empty-lines) - (setq txt (buffer-substring beg end)) - (save-excursion - (delete-region beg end)) - (setq pos (point)) - (insert txt) - (goto-char pos) (org-skip-whitespace) - (org-maybe-renumber-ordered-list)) - (goto-char pos) - (error "Cannot move this item further down")))) - -(defun org-move-item-up (arg) - "Move the plain list item at point up, i.e. swap with previous item. -Subitems (items with larger indentation) are considered part of the item, -so this really moves item trees." - (interactive "p") - (let (beg beg0 end end0 ind ind1 (pos (point)) txt - ne-beg ne-end ne-ins ins-end) - (org-beginning-of-item) - (setq beg0 (point)) - (setq ind (org-get-indentation)) - (save-excursion - (setq ne-beg (org-back-over-empty-lines)) - (setq beg (point))) - (goto-char beg0) - (org-end-of-item) - (setq ne-end (org-back-over-empty-lines)) - (setq end (point)) - (goto-char beg0) - (catch 'exit - (while t - (beginning-of-line 0) - (if (looking-at "[ \t]*$") - (if org-empty-line-terminates-plain-lists - (progn - (goto-char pos) - (error "Cannot move this item further up")) - nil) - (if (<= (setq ind1 (org-get-indentation)) ind) - (throw 'exit t))))) - (condition-case nil - (org-beginning-of-item) - (error (goto-char beg) - (error "Cannot move this item further up"))) - (setq ind1 (org-get-indentation)) - (if (and (org-at-item-p) (= ind ind1)) - (progn - (setq ne-ins (org-back-over-empty-lines)) - (setq txt (buffer-substring beg end)) - (save-excursion - (delete-region beg end)) - (setq pos (point)) - (insert txt) - (setq ins-end (point)) - (goto-char pos) (org-skip-whitespace) - - (when (and (org-first-list-item-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))) - - (org-maybe-renumber-ordered-list)) - (goto-char pos) - (error "Cannot move this item further up")))) - -(defun org-maybe-renumber-ordered-list () - "Renumber the ordered list at point if setup allows it. -This tests the user option `org-auto-renumber-ordered-lists' before -doing the renumbering." - (interactive) - (when (and org-auto-renumber-ordered-lists - (org-at-item-p)) - (if (match-beginning 3) - (org-renumber-ordered-list 1) - (org-fix-bullet-type)))) - -(defun org-maybe-renumber-ordered-list-safe () - (condition-case nil - (save-excursion - (org-maybe-renumber-ordered-list)) - (error nil))) - -(defun org-cycle-list-bullet (&optional which) - "Cycle through the different itemize/enumerate bullets. -This cycle the entire list level through the sequence: - - `-' -> `+' -> `*' -> `1.' -> `1)' - -If WHICH is a string, use that as the new bullet. If WHICH is an integer, -0 meand `-', 1 means `+' etc." - (interactive "P") - (org-preserve-lc - (org-beginning-of-item-list) - (org-at-item-p) - (beginning-of-line 1) - (let ((current (match-string 0)) - (prevp (eq which 'previous)) - new) - (setq new (cond - ((and (numberp which) - (nth (1- which) '("-" "+" "*" "1." "1)")))) - ((string-match "-" current) (if prevp "1)" "+")) - ((string-match "\\+" current) - (if prevp "-" (if (looking-at "\\S-") "1." "*"))) - ((string-match "\\*" current) (if prevp "+" "1.")) - ((string-match "\\." current) (if prevp "*" "1)")) - ((string-match ")" current) (if prevp "1." "-")) - (t (error "This should not happen")))) - (and (looking-at "\\([ \t]*\\)\\S-+") (replace-match (concat "\\1" new))) - (org-fix-bullet-type) - (org-maybe-renumber-ordered-list)))) - -(defun org-get-string-indentation (s) - "What indentation has S due to SPACE and TAB at the beginning of the string?" - (let ((n -1) (i 0) (w tab-width) c) - (catch 'exit - (while (< (setq n (1+ n)) (length s)) - (setq c (aref s n)) - (cond ((= c ?\ ) (setq i (1+ i))) - ((= c ?\t) (setq i (* (/ (+ w i) w) w))) - (t (throw 'exit t))))) - i)) - -(defun org-renumber-ordered-list (arg) - "Renumber an ordered plain list. -Cursor needs to be in the first line of an item, the line that starts -with something like \"1.\" or \"2)\"." - (interactive "p") - (unless (and (org-at-item-p) - (match-beginning 3)) - (error "This is not an ordered list")) - (let ((line (org-current-line)) - (col (current-column)) - (ind (org-get-string-indentation - (buffer-substring (point-at-bol) (match-beginning 3)))) - ;; (term (substring (match-string 3) -1)) - ind1 (n (1- arg)) - fmt) - ;; find where this list begins - (org-beginning-of-item-list) - (looking-at "[ \t]*[0-9]+\\([.)]\\)") - (setq fmt (concat "%d" (match-string 1))) - (beginning-of-line 0) - ;; walk forward and replace these numbers - (catch 'exit - (while t - (catch 'next - (beginning-of-line 2) - (if (eobp) (throw 'exit nil)) - (if (looking-at "[ \t]*$") (throw 'next nil)) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (if (> ind1 ind) (throw 'next t)) - (if (< ind1 ind) (throw 'exit t)) - (if (not (org-at-item-p)) (throw 'exit nil)) - (delete-region (match-beginning 2) (match-end 2)) - (goto-char (match-beginning 2)) - (insert (format fmt (setq n (1+ n))))))) - (goto-line line) - (move-to-column col))) - -(defun org-fix-bullet-type () - "Make sure all items in this list have the same bullet as the firsst item." - (interactive) - (unless (org-at-item-p) (error "This is not a list")) - (let ((line (org-current-line)) - (col (current-column)) - (ind (current-indentation)) - ind1 bullet) - ;; find where this list begins - (org-beginning-of-item-list) - (beginning-of-line 1) - ;; find out what the bullet type is - (looking-at "[ \t]*\\(\\S-+\\)") - (setq bullet (match-string 1)) - ;; walk forward and replace these numbers - (beginning-of-line 0) - (catch 'exit - (while t - (catch 'next - (beginning-of-line 2) - (if (eobp) (throw 'exit nil)) - (if (looking-at "[ \t]*$") (throw 'next nil)) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (if (> ind1 ind) (throw 'next t)) - (if (< ind1 ind) (throw 'exit t)) - (if (not (org-at-item-p)) (throw 'exit nil)) - (skip-chars-forward " \t") - (looking-at "\\S-+") - (replace-match bullet)))) - (goto-line line) - (move-to-column col) - (if (string-match "[0-9]" bullet) - (org-renumber-ordered-list 1)))) - -(defun org-beginning-of-item-list () - "Go to the beginning of the current item list. -I.e. to the first item in this list." - (interactive) - (org-beginning-of-item) - (let ((pos (point-at-bol)) - (ind (org-get-indentation)) - ind1) - ;; find where this list begins - (catch 'exit - (while t - (catch 'next - (beginning-of-line 0) - (if (looking-at "[ \t]*$") - (throw (if (bobp) 'exit 'next) t)) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (if (or (< ind1 ind) - (and (= ind1 ind) - (not (org-at-item-p))) - (bobp)) - (throw 'exit t) - (when (org-at-item-p) (setq pos (point-at-bol))))))) - (goto-char pos))) - - -(defun org-end-of-item-list () - "Go to the end of the current item list. -I.e. to the text after the last item." - (interactive) - (org-beginning-of-item) - (let ((pos (point-at-bol)) - (ind (org-get-indentation)) - ind1) - ;; find where this list begins - (catch 'exit - (while t - (catch 'next - (beginning-of-line 2) - (if (looking-at "[ \t]*$") - (throw (if (eobp) 'exit 'next) t)) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (if (or (< ind1 ind) - (and (= ind1 ind) - (not (org-at-item-p))) - (eobp)) - (progn - (setq pos (point-at-bol)) - (throw 'exit t)))))) - (goto-char pos))) - - -(defvar org-last-indent-begin-marker (make-marker)) -(defvar org-last-indent-end-marker (make-marker)) - -(defun org-outdent-item (arg) - "Outdent a local list item." - (interactive "p") - (org-indent-item (- arg))) - -(defun org-indent-item (arg) - "Indent a local list item." - (interactive "p") - (unless (org-at-item-p) - (error "Not on an item")) - (save-excursion - (let (beg end ind ind1 tmp delta ind-down ind-up) - (if (memq last-command '(org-shiftmetaright org-shiftmetaleft)) - (setq beg org-last-indent-begin-marker - end org-last-indent-end-marker) - (org-beginning-of-item) - (setq beg (move-marker org-last-indent-begin-marker (point))) - (org-end-of-item) - (setq end (move-marker org-last-indent-end-marker (point)))) - (goto-char beg) - (setq tmp (org-item-indent-positions) - ind (car tmp) - ind-down (nth 2 tmp) - ind-up (nth 1 tmp) - delta (if (> arg 0) - (if ind-down (- ind-down ind) 2) - (if ind-up (- ind-up ind) -2))) - (if (< (+ delta ind) 0) (error "Cannot outdent beyond margin")) - (while (< (point) end) - (beginning-of-line 1) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (delete-region (point-at-bol) (point)) - (or (eolp) (indent-to-column (+ ind1 delta))) - (beginning-of-line 2)))) - (org-fix-bullet-type) - (org-maybe-renumber-ordered-list-safe) - (save-excursion - (beginning-of-line 0) - (condition-case nil (org-beginning-of-item) (error nil)) - (org-maybe-renumber-ordered-list-safe))) - -(defun org-item-indent-positions () - "Return indentation for plain list items. -This returns a list with three values: The current indentation, the -parent indentation and the indentation a child should habe. -Assumes cursor in item line." - (let* ((bolpos (point-at-bol)) - (ind (org-get-indentation)) - ind-down ind-up pos) - (save-excursion - (org-beginning-of-item-list) - (skip-chars-backward "\n\r \t") - (when (org-in-item-p) - (org-beginning-of-item) - (setq ind-up (org-get-indentation)))) - (setq pos (point)) - (save-excursion - (cond - ((and (condition-case nil (progn (org-previous-item) t) - (error nil)) - (or (forward-char 1) t) - (re-search-forward "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)" bolpos t)) - (setq ind-down (org-get-indentation))) - ((and (goto-char pos) - (org-at-item-p)) - (goto-char (match-end 0)) - (skip-chars-forward " \t") - (setq ind-down (current-column))))) - (list ind ind-up ind-down))) - -;;; 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. - -;; Another challenge is that the key binding for TAB can be tab or \C-i, -;; likewise the binding for RET can be return or \C-m. Orgtbl-mode -;; addresses this by checking explicitly for both bindings. - -(defvar orgstruct-mode-map (make-sparse-keymap) - "Keymap for the minor `orgstruct-mode'.") - -(defvar org-local-vars nil - "List of local variables, for use by `orgstruct-mode'") - -;;;###autoload -(define-minor-mode orgstruct-mode - "Toggle the minor more `orgstruct-mode'. -This mode is for using Org-mode structure commands in other modes. -The following key behave as if Org-mode was active, if the cursor -is on a headline, or on a plain list item (both in the definition -of Org-mode). - -M-up Move entry/item up -M-down Move entry/item down -M-left Promote -M-right Demote -M-S-up Move entry/item up -M-S-down Move entry/item down -M-S-left Promote subtree -M-S-right Demote subtree -M-q Fill paragraph and items like in Org-mode -C-c ^ Sort entries -C-c - Cycle list bullet -TAB Cycle item visibility -M-RET Insert new heading/item -S-M-RET Insert new TODO heading / Chekbox item -C-c C-c Set tags / toggle checkbox" - nil " OrgStruct" nil - (and (orgstruct-setup) (defun orgstruct-setup () nil))) - -;;;###autoload -(defun turn-on-orgstruct () - "Unconditionally turn on `orgstruct-mode'." - (orgstruct-mode 1)) - -;;;###autoload -(defun turn-on-orgstruct++ () - "Unconditionally turn on `orgstruct-mode', and force org-mode indentations. -In addition to setting orgstruct-mode, this also exports all indentation and -autofilling variables from org-mode into the buffer. Note that turning -off orgstruct-mode will *not* remove these additonal settings." - (orgstruct-mode 1) - (let (var val) - (mapc - (lambda (x) - (when (string-match - "^\\(paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)" - (symbol-name (car x))) - (setq var (car x) val (nth 1 x)) - (org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val)))) - org-local-vars))) - -(defun orgstruct-error () - "Error when there is no default binding for a structure key." - (interactive) - (error "This key has no function outside structure elements")) - -(defun orgstruct-setup () - "Setup orgstruct keymaps." - (let ((nfunc 0) - (bindings - (list - '([(meta up)] org-metaup) - '([(meta down)] org-metadown) - '([(meta left)] org-metaleft) - '([(meta right)] org-metaright) - '([(meta shift up)] org-shiftmetaup) - '([(meta shift down)] org-shiftmetadown) - '([(meta shift left)] org-shiftmetaleft) - '([(meta shift right)] org-shiftmetaright) - '([(shift up)] org-shiftup) - '([(shift down)] org-shiftdown) - '("\C-c\C-c" org-ctrl-c-ctrl-c) - '("\M-q" fill-paragraph) - '("\C-c^" org-sort) - '("\C-c-" org-cycle-list-bullet))) - elt key fun cmd) - (while (setq elt (pop bindings)) - (setq nfunc (1+ nfunc)) - (setq key (org-key (car elt)) - fun (nth 1 elt) - cmd (orgstruct-make-binding fun nfunc key)) - (org-defkey orgstruct-mode-map key cmd)) - - ;; Special treatment needed for TAB and RET - (org-defkey orgstruct-mode-map [(tab)] - (orgstruct-make-binding 'org-cycle 102 [(tab)] "\C-i")) - (org-defkey orgstruct-mode-map "\C-i" - (orgstruct-make-binding 'org-cycle 103 "\C-i" [(tab)])) - - (org-defkey orgstruct-mode-map "\M-\C-m" - (orgstruct-make-binding 'org-insert-heading 105 - "\M-\C-m" [(meta return)])) - (org-defkey orgstruct-mode-map [(meta return)] - (orgstruct-make-binding 'org-insert-heading 106 - [(meta return)] "\M-\C-m")) - - (org-defkey orgstruct-mode-map [(shift meta return)] - (orgstruct-make-binding 'org-insert-todo-heading 107 - [(meta return)] "\M-\C-m")) - - (unless org-local-vars - (setq org-local-vars (org-get-local-variables))) - - t)) - -(defun orgstruct-make-binding (fun n &rest keys) - "Create a function for binding in the structure minor mode. -FUN is the command to call inside a table. N is used to create a unique -command name. KEYS are keys that should be checked in for a command -to execute outside of tables." - (eval - (list 'defun - (intern (concat "orgstruct-hijacker-command-" (int-to-string n))) - '(arg) - (concat "In Structure, run `" (symbol-name fun) "'.\n" - "Outside of structure, run the binding of `" - (mapconcat (lambda (x) (format "%s" x)) keys "' or `") - "'.") - '(interactive "p") - (list 'if - '(org-context-p 'headline 'item) - (list 'org-run-like-in-org-mode (list 'quote fun)) - (list 'let '(orgstruct-mode) - (list 'call-interactively - (append '(or) - (mapcar (lambda (k) - (list 'key-binding k)) - keys) - '('orgstruct-error)))))))) - -(defun org-context-p (&rest contexts) - "Check if local context is and 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 "\\*+")) - (and (memq 'item contexts) - (looking-at "[ \t]*\\([-+*] \\|[0-9]+[.)] \\)"))) - (goto-char pos)))) - -(defun org-get-local-variables () - "Return a list of all local variables in an org-mode buffer." - (let (varlist) - (with-current-buffer (get-buffer-create "*Org tmp*") - (erase-buffer) - (org-mode) - (setq varlist (buffer-local-variables))) - (kill-buffer "*Org tmp*") - (delq nil - (mapcar - (lambda (x) - (setq x - (if (symbolp x) - (list x) - (list (car x) (list 'quote (cdr x))))) - (if (string-match - "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)" - (symbol-name (car x))) - x nil)) - varlist)))) - -;;;###autoload -(defun org-run-like-in-org-mode (cmd) - (unless org-local-vars - (setq org-local-vars (org-get-local-variables))) - (eval (list 'let org-local-vars - (list 'call-interactively (list 'quote cmd))))) - -;;;; Archiving - -(defalias 'org-advertized-archive-subtree 'org-archive-subtree) - -(defun org-archive-subtree (&optional find-done) - "Move the current subtree to the archive. -The archive can be a certain top-level heading in the current file, or in -a different file. The tree will be moved to that location, the subtree -heading be marked DONE, and the current time will be added. - -When called with prefix argument FIND-DONE, find whole trees without any -open TODO items and archive them (after getting confirmation from the user). -If the cursor is not at a headline when this comand is called, try all level -1 trees. If the cursor is on a headline, only try the direct children of -this heading." - (interactive "P") - (if find-done - (org-archive-all-done) - ;; Save all relevant TODO keyword-relatex variables - - (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler - (tr-org-todo-keywords-1 org-todo-keywords-1) - (tr-org-todo-kwd-alist org-todo-kwd-alist) - (tr-org-done-keywords org-done-keywords) - (tr-org-todo-regexp org-todo-regexp) - (tr-org-todo-line-regexp org-todo-line-regexp) - (tr-org-odd-levels-only org-odd-levels-only) - (this-buffer (current-buffer)) - (org-archive-location org-archive-location) - (re "^#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$") - ;; start of variables that will be used for saving context - ;; The compiler complains about them - keep them anyway! - (file (abbreviate-file-name (buffer-file-name))) - (time (format-time-string - (substring (cdr org-time-stamp-formats) 1 -1) - (current-time))) - afile heading buffer level newfile-p - category todo priority - ;; start of variables that will be used for savind context - ltags itags prop) - - ;; Try to find a local archive location - (save-excursion - (save-restriction - (widen) - (setq prop (org-entry-get nil "ARCHIVE" 'inherit)) - (if (and prop (string-match "\\S-" prop)) - (setq org-archive-location prop) - (if (or (re-search-backward re nil t) - (re-search-forward re nil t)) - (setq org-archive-location (match-string 1)))))) - - (if (string-match "\\(.*\\)::\\(.*\\)" org-archive-location) - (progn - (setq afile (format (match-string 1 org-archive-location) - (file-name-nondirectory buffer-file-name)) - heading (match-string 2 org-archive-location))) - (error "Invalid `org-archive-location'")) - (if (> (length afile) 0) - (setq newfile-p (not (file-exists-p afile)) - buffer (find-file-noselect afile)) - (setq buffer (current-buffer))) - (unless buffer - (error "Cannot access file \"%s\"" afile)) - (if (and (> (length heading) 0) - (string-match "^\\*+" heading)) - (setq level (match-end 0)) - (setq heading nil level 0)) - (save-excursion - (org-back-to-heading t) - ;; Get context information that will be lost by moving the tree - (org-refresh-category-properties) - (setq category (org-get-category) - todo (and (looking-at org-todo-line-regexp) - (match-string 2)) - priority (org-get-priority (if (match-end 3) (match-string 3) "")) - ltags (org-get-tags) - itags (org-delete-all ltags (org-get-tags-at))) - (setq ltags (mapconcat 'identity ltags " ") - itags (mapconcat 'identity itags " ")) - ;; We first only copy, in case something goes wrong - ;; we need to protect this-command, to avoid kill-region sets it, - ;; which would lead to duplication of subtrees - (let (this-command) (org-copy-subtree)) - (set-buffer buffer) - ;; Enforce org-mode for the archive buffer - (if (not (org-mode-p)) - ;; Force the mode for future visits. - (let ((org-insert-mode-line-in-empty-file t) - (org-inhibit-startup t)) - (call-interactively 'org-mode))) - (when newfile-p - (goto-char (point-max)) - (insert (format "\nArchived entries from file %s\n\n" - (buffer-file-name this-buffer)))) - ;; Force the TODO keywords of the original buffer - (let ((org-todo-line-regexp tr-org-todo-line-regexp) - (org-todo-keywords-1 tr-org-todo-keywords-1) - (org-todo-kwd-alist tr-org-todo-kwd-alist) - (org-done-keywords tr-org-done-keywords) - (org-todo-regexp tr-org-todo-regexp) - (org-todo-line-regexp tr-org-todo-line-regexp) - (org-odd-levels-only - (if (local-variable-p 'org-odd-levels-only (current-buffer)) - org-odd-levels-only - tr-org-odd-levels-only))) - (goto-char (point-min)) - (if heading - (progn - (if (re-search-forward - (concat "^" (regexp-quote heading) - (org-re "[ \t]*\\(:[[:alnum:]_@:]+:\\)?[ \t]*\\($\\|\r\\)")) - nil t) - (goto-char (match-end 0)) - ;; Heading not found, just insert it at the end - (goto-char (point-max)) - (or (bolp) (insert "\n")) - (insert "\n" heading "\n") - (end-of-line 0)) - ;; Make the subtree visible - (show-subtree) - (org-end-of-subtree t) - (skip-chars-backward " \t\r\n") - (and (looking-at "[ \t\r\n]*") - (replace-match "\n\n"))) - ;; No specific heading, just go to end of file. - (goto-char (point-max)) (insert "\n")) - ;; Paste - (org-paste-subtree (org-get-legal-level level 1)) - - ;; Mark the entry as done - (when (and org-archive-mark-done - (looking-at org-todo-line-regexp) - (or (not (match-end 2)) - (not (member (match-string 2) org-done-keywords)))) - (let (org-log-done) - (org-todo - (car (or (member org-archive-mark-done org-done-keywords) - org-done-keywords))))) - - ;; Add the context info - (when org-archive-save-context-info - (let ((l org-archive-save-context-info) e n v) - (while (setq e (pop l)) - (when (and (setq v (symbol-value e)) - (stringp v) (string-match "\\S-" v)) - (setq n (concat "ARCHIVE_" (upcase (symbol-name e)))) - (org-entry-put (point) n v))))) - - ;; Save the buffer, if it is not the same buffer. - (if (not (eq this-buffer buffer)) (save-buffer)))) - ;; Here we are back in the original buffer. Everything seems to have - ;; worked. So now cut the tree and finish up. - (let (this-command) (org-cut-subtree)) - (if (and (not (eobp)) (looking-at "[ \t]*$")) (kill-line)) - (message "Subtree archived %s" - (if (eq this-buffer buffer) - (concat "under heading: " heading) - (concat "in file: " (abbreviate-file-name afile))))))) - -(defun org-refresh-category-properties () - "Refresh category text properties in teh buffer." - (let ((def-cat (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))) - beg end cat pos optionp) - (org-unmodified - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (put-text-property (point) (point-max) 'org-category def-cat) - (while (re-search-forward - "^\\(#\\+CATEGORY:\\|[ \t]*:CATEGORY:\\)\\(.*\\)" nil t) - (setq pos (match-end 0) - optionp (equal (char-after (match-beginning 0)) ?#) - cat (org-trim (match-string 2))) - (if optionp - (setq beg (point-at-bol) end (point-max)) - (org-back-to-heading t) - (setq beg (point) end (org-end-of-subtree t t))) - (put-text-property beg end 'org-category cat) - (goto-char pos))))))) - -(defun org-archive-all-done (&optional tag) - "Archive sublevels of the current tree without open TODO items. -If the cursor is not on a headline, try all level 1 trees. If -it is on a headline, try all direct children. -When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag." - (let ((re (concat "^\\*+ +" org-not-done-regexp)) re1 - (rea (concat ".*:" org-archive-tag ":")) - (begm (make-marker)) - (endm (make-marker)) - (question (if tag "Set ARCHIVE tag (no open TODO items)? " - "Move subtree to archive (no open TODO items)? ")) - beg end (cntarch 0)) - (if (org-on-heading-p) - (progn - (setq re1 (concat "^" (regexp-quote - (make-string - (1+ (- (match-end 0) (match-beginning 0))) - ?*)) - " ")) - (move-marker begm (point)) - (move-marker endm (org-end-of-subtree t))) - (setq re1 "^* ") - (move-marker begm (point-min)) - (move-marker endm (point-max))) - (save-excursion - (goto-char begm) - (while (re-search-forward re1 endm t) - (setq beg (match-beginning 0) - end (save-excursion (org-end-of-subtree t) (point))) - (goto-char beg) - (if (re-search-forward re end t) - (goto-char end) - (goto-char beg) - (if (and (or (not tag) (not (looking-at rea))) - (y-or-n-p question)) - (progn - (if tag - (org-toggle-tag org-archive-tag 'on) - (org-archive-subtree)) - (setq cntarch (1+ cntarch))) - (goto-char end))))) - (message "%d trees archived" cntarch))) - -(defun org-cycle-hide-drawers (state) - "Re-hide all drawers after a visibility state change." - (when (and (org-mode-p) - (not (memq state '(overview folded)))) - (save-excursion - (let* ((globalp (memq state '(contents all))) - (beg (if globalp (point-min) (point))) - (end (if globalp (point-max) (org-end-of-subtree t)))) - (goto-char beg) - (while (re-search-forward org-drawer-regexp end t) - (org-flag-drawer t)))))) - -(defun org-flag-drawer (flag) - (save-excursion - (beginning-of-line 1) - (when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:") - (let ((b (match-end 0))) - (if (re-search-forward - "^[ \t]*:END:" - (save-excursion (outline-next-heading) (point)) t) - (outline-flag-region b (point-at-eol) flag) - (error ":END: line missing")))))) - -(defun org-cycle-hide-archived-subtrees (state) - "Re-hide all archived subtrees after a visibility state change." - (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) - (if (looking-at (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." - (save-excursion - (let* ((re (concat ":" org-archive-tag ":"))) - (goto-char beg) - (while (re-search-forward re end t) - (and (org-on-heading-p) (hide-subtree)) - (org-end-of-subtree t))))) - -(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." - (unless (org-on-heading-p t) (error "Not on headling")) - (let (res current) - (save-excursion - (beginning-of-line) - (if (re-search-forward (org-re "[ \t]:\\([[:alnum:]_@:]+\\):[ \t]*$") - (point-at-eol) t) - (progn - (setq current (match-string 1)) - (replace-match "")) - (setq current "")) - (setq current (nreverse (org-split-string current ":"))) - (cond - ((eq onoff 'on) - (setq res t) - (or (member tag current) (push tag current))) - ((eq onoff 'off) - (or (not (member tag current)) (setq current (delete tag current)))) - (t (if (member tag current) - (setq current (delete tag current)) - (setq res t) - (push tag current)))) - (end-of-line 1) - (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-toggle-archive-tag (&optional arg) - "Toggle the archive tag for the current headline. -With prefix ARG, check all children of current headline and offer tagging -the children that do not contain any open TODO items." - (interactive "P") - (if arg - (org-archive-all-done 'tag) - (let (set) - (save-excursion - (org-back-to-heading t) - (setq set (org-toggle-tag org-archive-tag)) - (when set (hide-subtree))) - (and set (beginning-of-line 1)) - (message "Subtree %s" (if set "archived" "unarchived"))))) - - -;;;; Tables - -;;; The table editor - -;; Watch out: Here we are talking about two different kind of tables. -;; Most of the code is for the tables created with the Org-mode table editor. -;; Sometimes, we talk about tables created and edited with the table.el -;; Emacs package. We call the former org-type tables, and the latter -;; table.el-type tables. - -(defun org-before-change-function (beg end) - "Every change indicates that a table might need an update." - (setq org-table-may-need-update t)) - -(defconst org-table-line-regexp "^[ \t]*|" - "Detects an org-type table line.") -(defconst org-table-dataline-regexp "^[ \t]*|[^-]" - "Detects an org-type table line.") -(defconst org-table-auto-recalculate-regexp "^[ \t]*| *# *\\(|\\|$\\)" - "Detects a table line marked for automatic recalculation.") -(defconst org-table-recalculate-regexp "^[ \t]*| *[#*] *\\(|\\|$\\)" - "Detects a table line marked for automatic recalculation.") -(defconst org-table-calculate-mark-regexp "^[ \t]*| *[!$^_#*] *\\(|\\|$\\)" - "Detects a table line marked for automatic recalculation.") -(defconst org-table-hline-regexp "^[ \t]*|-" - "Detects an org-type table hline.") -(defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]" - "Detects a table-type table hline.") -(defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)" - "Detects an org-type or table-type table.") -(defconst org-table-border-regexp "^[ \t]*[^| \t]" - "Searching from within a table (any type) this finds the first line -outside the table.") -(defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]" - "Searching from within a table (any type) this finds the first line -outside the table.") - -(defvar org-table-last-highlighted-reference nil) -(defvar org-table-formula-history nil) - -(defvar org-table-column-names nil - "Alist with column names, derived from the `!' line.") -(defvar org-table-column-name-regexp nil - "Regular expression matching the current column names.") -(defvar org-table-local-parameters nil - "Alist with parameter names, derived from the `$' line.") -(defvar org-table-named-field-locations nil - "Alist with locations of named fields.") - -(defvar org-table-current-line-types nil - "Table row types, non-nil only for the duration of a comand.") -(defvar org-table-current-begin-line nil - "Table begin line, non-nil only for the duration of a comand.") -(defvar org-table-current-begin-pos nil - "Table begin position, non-nil only for the duration of a comand.") -(defvar org-table-dlines nil - "Vector of data line line numbers in the current table.") -(defvar org-table-hlines nil - "Vector of hline line numbers in the current table.") - -(defconst org-table-range-regexp - "@\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\(\\.\\.@?\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\)?" - ;; 1 2 3 4 5 - "Regular expression for matching ranges in formulas.") - -(defconst org-table-range-regexp2 - (concat - "\\(" "@[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)" - "\\.\\." - "\\(" "@?[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)") - "Match a range for reference display.") - -(defconst org-table-translate-regexp - (concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)") - "Match a reference that needs translation, for reference display.") - -(defvar org-inhibit-highlight-removal nil) ; dynamically scoped param - -(defun org-table-create-with-table.el () - "Use the table.el package to insert a new table. -If there is already a table at point, convert between Org-mode tables -and table.el tables." - (interactive) - (require 'table) - (cond - ((org-at-table.el-p) - (if (y-or-n-p "Convert table to Org-mode table? ") - (org-table-convert))) - ((org-at-table-p) - (if (y-or-n-p "Convert table to table.el table? ") - (org-table-convert))) - (t (call-interactively 'table-insert)))) - -(defun org-table-create-or-convert-from-region (arg) - "Convert region to table, or create an empty table. -If there is an active region, convert it to a table, using the function -`org-table-convert-region'. See the documentation of that function -to learn how the prefix argument is interpreted to determine the field -separator. -If there is no such region, create an empty table with `org-table-create'." - (interactive "P") - (if (org-region-active-p) - (org-table-convert-region (region-beginning) (region-end) arg) - (org-table-create arg))) - -(defun org-table-create (&optional size) - "Query for a size and insert a table skeleton. -SIZE is a string Columns x Rows like for example \"3x2\"." - (interactive "P") - (unless size - (setq size (read-string - (concat "Table size Columns x Rows [e.g. " - org-table-default-size "]: ") - "" nil org-table-default-size))) - - (let* ((pos (point)) - (indent (make-string (current-column) ?\ )) - (split (org-split-string size " *x *")) - (rows (string-to-number (nth 1 split))) - (columns (string-to-number (car split))) - (line (concat (apply 'concat indent "|" (make-list columns " |")) - "\n"))) - (if (string-match "^[ \t]*$" (buffer-substring-no-properties - (point-at-bol) (point))) - (beginning-of-line 1) - (newline)) - ;; (mapcar (lambda (x) (insert line)) (make-list rows t)) - (dotimes (i rows) (insert line)) - (goto-char pos) - (if (> rows 1) - ;; Insert a hline after the first row. - (progn - (end-of-line 1) - (insert "\n|-") - (goto-char pos))) - (org-table-align))) - -(defun org-table-convert-region (beg0 end0 &optional separator) - "Convert region to a table. -The region goes from BEG0 to END0, but these borders will be moved -slightly, to make sure a beginning of line in the first line is included. - -SEPARATOR specifies the field separator in the lines. It can have the -following values: - -'(4) Use the comma as a field separator -'(16) Use a TAB as field separator -integer When a number, use that many spaces as field separator -nil When nil, the command tries to be smart and figure out the - separator in the following way: - - when each line contains a TAB, assume TAB-separated material - - when each line contains a comme, assume CSV material - - else, assume one or more SPACE charcters as separator." - (interactive "rP") - (let* ((beg (min beg0 end0)) - (end (max beg0 end0)) - re) - (goto-char beg) - (beginning-of-line 1) - (setq beg (move-marker (make-marker) (point))) - (goto-char end) - (if (bolp) (backward-char 1) (end-of-line 1)) - (setq end (move-marker (make-marker) (point))) - ;; Get the right field separator - (unless separator - (goto-char beg) - (setq separator - (cond - ((not (re-search-forward "^[^\n\t]+$" end t)) '(16)) - ((not (re-search-forward "^[^\n,]+$" end t)) '(4)) - (t 1)))) - (setq re (cond - ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?") - ((equal separator '(16)) "^\\|\t") - ((integerp separator) - (format "^ *\\| *\t *\\| \\{%d,\\}" separator)) - (t (error "This should not happen")))) - (goto-char beg) - (while (re-search-forward re end t) - (replace-match "| " t t)) - (goto-char beg) - (insert " ") - (org-table-align))) - -(defun org-table-import (file arg) - "Import FILE as a table. -The file is assumed to be tab-separated. Such files can be produced by most -spreadsheet and database applications. If no tabs (at least one per line) -are found, lines will be split on whitespace into fields." - (interactive "f\nP") - (or (bolp) (newline)) - (let ((beg (point)) - (pm (point-max))) - (insert-file-contents file) - (org-table-convert-region beg (+ (point) (- (point-max) pm)) arg))) - -(defun org-table-export () - "Export table as a tab-separated file. -Such a file can be imported into a spreadsheet program like Excel." - (interactive) - (let* ((beg (org-table-begin)) - (end (org-table-end)) - (table (buffer-substring beg end)) - (file (read-file-name "Export table to: ")) - buf) - (unless (or (not (file-exists-p file)) - (y-or-n-p (format "Overwrite file %s? " file))) - (error "Abort")) - (with-current-buffer (find-file-noselect file) - (setq buf (current-buffer)) - (erase-buffer) - (fundamental-mode) - (insert table) - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*|[ \t]*" nil t) - (replace-match "" t t) - (end-of-line 1)) - (goto-char (point-min)) - (while (re-search-forward "[ \t]*|[ \t]*$" nil t) - (replace-match "" t t) - (goto-char (min (1+ (point)) (point-max)))) - (goto-char (point-min)) - (while (re-search-forward "^-[-+]*$" nil t) - (replace-match "") - (if (looking-at "\n") - (delete-char 1))) - (goto-char (point-min)) - (while (re-search-forward "[ \t]*|[ \t]*" nil t) - (replace-match "\t" t t)) - (save-buffer)) - (kill-buffer buf))) - -(defvar org-table-aligned-begin-marker (make-marker) - "Marker at the beginning of the table last aligned. -Used to check if cursor still is in that table, to minimize realignment.") -(defvar org-table-aligned-end-marker (make-marker) - "Marker at the end of the table last aligned. -Used to check if cursor still is in that table, to minimize realignment.") -(defvar org-table-last-alignment nil - "List of flags for flushright alignment, from the last re-alignment. -This is being used to correctly align a single field after TAB or RET.") -(defvar org-table-last-column-widths nil - "List of max width of fields in each column. -This is being used to correctly align a single field after TAB or RET.") -(defvar org-table-overlay-coordinates nil - "Overlay coordinates after each align of a table.") -(make-variable-buffer-local 'org-table-overlay-coordinates) - -(defvar org-last-recalc-line nil) -(defconst org-narrow-column-arrow "=>" - "Used as display property in narrowed table columns.") - -(defun org-table-align () - "Align the table at point by aligning all vertical bars." - (interactive) - (let* ( - ;; Limits of table - (beg (org-table-begin)) - (end (org-table-end)) - ;; Current cursor position - (linepos (org-current-line)) - (colpos (org-table-current-column)) - (winstart (window-start)) - (winstartline (org-current-line (min winstart (1- (point-max))))) - lines (new "") lengths l typenums ty fields maxfields i - column - (indent "") cnt frac - rfmt hfmt - (spaces '(1 . 1)) - (sp1 (car spaces)) - (sp2 (cdr spaces)) - (rfmt1 (concat - (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|")) - (hfmt1 (concat - (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+")) - emptystrings links dates emph narrow fmax f1 len c e) - (untabify beg end) - (remove-text-properties beg end '(org-cwidth t org-dwidth t display t)) - ;; Check if we have links or dates - (goto-char beg) - (setq links (re-search-forward org-bracket-link-regexp end t)) - (goto-char beg) - (setq emph (and org-hide-emphasis-markers - (re-search-forward org-emph-re end t))) - (goto-char beg) - (setq dates (and org-display-custom-times - (re-search-forward org-ts-regexp-both end t))) - ;; Make sure the link properties are right - (when links (goto-char beg) (while (org-activate-bracket-links end))) - ;; Make sure the date properties are right - (when dates (goto-char beg) (while (org-activate-dates end))) - (when emph (goto-char beg) (while (org-do-emphasis-faces end))) - - ;; Check if we are narrowing any columns - (goto-char beg) - (setq narrow (and org-format-transports-properties-p - (re-search-forward "<[0-9]+>" end t))) - ;; Get the rows - (setq lines (org-split-string - (buffer-substring beg end) "\n")) - ;; Store the indentation of the first line - (if (string-match "^ *" (car lines)) - (setq indent (make-string (- (match-end 0) (match-beginning 0)) ?\ ))) - ;; Mark the hlines by setting the corresponding element to nil - ;; At the same time, we remove trailing space. - (setq lines (mapcar (lambda (l) - (if (string-match "^ *|-" l) - nil - (if (string-match "[ \t]+$" l) - (substring l 0 (match-beginning 0)) - l))) - lines)) - ;; Get the data fields by splitting the lines. - (setq fields (mapcar - (lambda (l) - (org-split-string l " *| *")) - (delq nil (copy-sequence lines)))) - ;; How many fields in the longest line? - (condition-case nil - (setq maxfields (apply 'max (mapcar 'length fields))) - (error - (kill-region beg end) - (org-table-create org-table-default-size) - (error "Empty table - created default table"))) - ;; A list of empty strings to fill any short rows on output - (setq emptystrings (make-list maxfields "")) - ;; Check for special formatting. - (setq i -1) - (while (< (setq i (1+ i)) maxfields) ;; Loop over all columns - (setq column (mapcar (lambda (x) (or (nth i x) "")) fields)) - ;; Check if there is an explicit width specified - (when narrow - (setq c column fmax nil) - (while c - (setq e (pop c)) - (if (and (stringp e) (string-match "^<\\([0-9]+\\)>$" e)) - (setq fmax (string-to-number (match-string 1 e)) c nil))) - ;; Find fields that are wider than fmax, and shorten them - (when fmax - (loop for xx in column do - (when (and (stringp xx) - (> (org-string-width xx) fmax)) - (org-add-props xx nil - 'help-echo - (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (org-no-properties (copy-sequence xx)))) - (setq f1 (min fmax (or (string-match org-bracket-link-regexp xx) fmax))) - (unless (> f1 1) - (error "Cannot narrow field starting with wide link \"%s\"" - (match-string 0 xx))) - (add-text-properties f1 (length xx) (list 'org-cwidth t) xx) - (add-text-properties (- f1 2) f1 - (list 'display org-narrow-column-arrow) - xx))))) - ;; Get the maximum width for each column - (push (apply 'max 1 (mapcar 'org-string-width column)) lengths) - ;; Get the fraction of numbers, to decide about alignment of the column - (setq cnt 0 frac 0.0) - (loop for x in column do - (if (equal x "") - nil - (setq frac ( / (+ (* frac cnt) - (if (string-match org-table-number-regexp x) 1 0)) - (setq cnt (1+ cnt)))))) - (push (>= frac org-table-number-fraction) typenums)) - (setq lengths (nreverse lengths) typenums (nreverse typenums)) - - ;; Store the alignment of this table, for later editing of single fields - (setq org-table-last-alignment typenums - org-table-last-column-widths lengths) - - ;; With invisible characters, `format' does not get the field width right - ;; So we need to make these fields wide by hand. - (when (or links emph) - (loop for i from 0 upto (1- maxfields) do - (setq len (nth i lengths)) - (loop for j from 0 upto (1- (length fields)) do - (setq c (nthcdr i (car (nthcdr j fields)))) - (if (and (stringp (car c)) - (text-property-any 0 (length (car c)) 'invisible 'org-link (car c)) -; (string-match org-bracket-link-regexp (car c)) - (< (org-string-width (car c)) len)) - (setcar c (concat (car c) (make-string (- len (org-string-width (car c))) ?\ ))))))) - - ;; Compute the formats needed for output of the table - (setq rfmt (concat indent "|") hfmt (concat indent "|")) - (while (setq l (pop lengths)) - (setq ty (if (pop typenums) "" "-")) ; number types flushright - (setq rfmt (concat rfmt (format rfmt1 ty l)) - hfmt (concat hfmt (format hfmt1 (make-string l ?-))))) - (setq rfmt (concat rfmt "\n") - hfmt (concat (substring hfmt 0 -1) "|\n")) - - (setq new (mapconcat - (lambda (l) - (if l (apply 'format rfmt - (append (pop fields) emptystrings)) - hfmt)) - lines "")) - ;; Replace the old one - (delete-region beg end) - (move-marker end nil) - (move-marker org-table-aligned-begin-marker (point)) - (insert new) - (move-marker org-table-aligned-end-marker (point)) - (when (and orgtbl-mode (not (org-mode-p))) - (goto-char org-table-aligned-begin-marker) - (while (org-hide-wide-columns org-table-aligned-end-marker))) - ;; Try to move to the old location - (goto-line winstartline) - (setq winstart (point-at-bol)) - (goto-line linepos) - (set-window-start (selected-window) winstart 'noforce) - (org-table-goto-column colpos) - (and org-table-overlay-coordinates (org-table-overlay-coordinates)) - (setq org-table-may-need-update nil) - )) - -(defun org-string-width (s) - "Compute width of string, ignoring invisible characters. -This ignores character with invisibility property `org-link', and also -characters with property `org-cwidth', because these will become invisible -upon the next fontification round." - (let (b l) - (when (or (eq t buffer-invisibility-spec) - (assq 'org-link buffer-invisibility-spec)) - (while (setq b (text-property-any 0 (length s) - 'invisible 'org-link s)) - (setq s (concat (substring s 0 b) - (substring s (or (next-single-property-change - b 'invisible s) (length s))))))) - (while (setq b (text-property-any 0 (length s) 'org-cwidth t s)) - (setq s (concat (substring s 0 b) - (substring s (or (next-single-property-change - b 'org-cwidth s) (length s)))))) - (setq l (string-width s) b -1) - (while (setq b (text-property-any (1+ b) (length s) 'org-dwidth t s)) - (setq l (- l (get-text-property b 'org-dwidth-n s)))) - l)) - -(defun org-table-begin (&optional table-type) - "Find the beginning of the table and return its position. -With argument TABLE-TYPE, go to the beginning of a table.el-type table." - (save-excursion - (if (not (re-search-backward - (if table-type org-table-any-border-regexp - org-table-border-regexp) - nil t)) - (progn (goto-char (point-min)) (point)) - (goto-char (match-beginning 0)) - (beginning-of-line 2) - (point)))) - -(defun org-table-end (&optional table-type) - "Find the end of the table and return its position. -With argument TABLE-TYPE, go to the end of a table.el-type table." - (save-excursion - (if (not (re-search-forward - (if table-type org-table-any-border-regexp - org-table-border-regexp) - nil t)) - (goto-char (point-max)) - (goto-char (match-beginning 0))) - (point-marker))) - -(defun org-table-justify-field-maybe (&optional new) - "Justify the current field, text to left, number to right. -Optional argument NEW may specify text to replace the current field content." - (cond - ((and (not new) org-table-may-need-update)) ; Realignment will happen anyway - ((org-at-table-hline-p)) - ((and (not new) - (or (not (equal (marker-buffer org-table-aligned-begin-marker) - (current-buffer))) - (< (point) org-table-aligned-begin-marker) - (>= (point) org-table-aligned-end-marker))) - ;; This is not the same table, force a full re-align - (setq org-table-may-need-update t)) - (t ;; realign the current field, based on previous full realign - (let* ((pos (point)) s - (col (org-table-current-column)) - (num (if (> col 0) (nth (1- col) org-table-last-alignment))) - l f n o e) - (when (> col 0) - (skip-chars-backward "^|\n") - (if (looking-at " *\\([^|\n]*?\\) *\\(|\\|$\\)") - (progn - (setq s (match-string 1) - o (match-string 0) - l (max 1 (- (match-end 0) (match-beginning 0) 3)) - e (not (= (match-beginning 2) (match-end 2)))) - (setq f (format (if num " %%%ds %s" " %%-%ds %s") - l (if e "|" (setq org-table-may-need-update t) "")) - n (format f s)) - (if new - (if (<= (length new) l) ;; FIXME: length -> str-width? - (setq n (format f new)) - (setq n (concat new "|") org-table-may-need-update t))) - (or (equal n o) - (let (org-table-may-need-update) - (replace-match n t t)))) - (setq org-table-may-need-update t)) - (goto-char pos)))))) - -(defun org-table-next-field () - "Go to the next field in the current table, creating new lines as needed. -Before doing so, re-align the table if necessary." - (interactive) - (org-table-maybe-eval-formula) - (org-table-maybe-recalculate-line) - (if (and org-table-automatic-realign - org-table-may-need-update) - (org-table-align)) - (let ((end (org-table-end))) - (if (org-at-table-hline-p) - (end-of-line 1)) - (condition-case nil - (progn - (re-search-forward "|" end) - (if (looking-at "[ \t]*$") - (re-search-forward "|" end)) - (if (and (looking-at "-") - org-table-tab-jumps-over-hlines - (re-search-forward "^[ \t]*|\\([^-]\\)" end t)) - (goto-char (match-beginning 1))) - (if (looking-at "-") - (progn - (beginning-of-line 0) - (org-table-insert-row 'below)) - (if (looking-at " ") (forward-char 1)))) - (error - (org-table-insert-row 'below))))) - -(defun org-table-previous-field () - "Go to the previous field in the table. -Before doing so, re-align the table if necessary." - (interactive) - (org-table-justify-field-maybe) - (org-table-maybe-recalculate-line) - (if (and org-table-automatic-realign - org-table-may-need-update) - (org-table-align)) - (if (org-at-table-hline-p) - (end-of-line 1)) - (re-search-backward "|" (org-table-begin)) - (re-search-backward "|" (org-table-begin)) - (while (looking-at "|\\(-\\|[ \t]*$\\)") - (re-search-backward "|" (org-table-begin))) - (if (looking-at "| ?") - (goto-char (match-end 0)))) - -(defun org-table-next-row () - "Go to the next row (same column) in the current table. -Before doing so, re-align the table if necessary." - (interactive) - (org-table-maybe-eval-formula) - (org-table-maybe-recalculate-line) - (if (or (looking-at "[ \t]*$") - (save-excursion (skip-chars-backward " \t") (bolp))) - (newline) - (if (and org-table-automatic-realign - org-table-may-need-update) - (org-table-align)) - (let ((col (org-table-current-column))) - (beginning-of-line 2) - (if (or (not (org-at-table-p)) - (org-at-table-hline-p)) - (progn - (beginning-of-line 0) - (org-table-insert-row 'below))) - (org-table-goto-column col) - (skip-chars-backward "^|\n\r") - (if (looking-at " ") (forward-char 1))))) - -(defun org-table-copy-down (n) - "Copy a field down in the current column. -If the field at the cursor is empty, copy into it the content of the nearest -non-empty field above. With argument N, use the Nth non-empty field. -If the current field is not empty, it is copied down to the next row, and -the cursor is moved with it. Therefore, repeating this command causes the -column to be filled row-by-row. -If the variable `org-table-copy-increment' is non-nil and the field is an -integer or a timestamp, it will be incremented while copying. In the case of -a timestamp, if the cursor is on the year, change the year. If it is on the -month or the day, change that. Point will stay on the current date field -in order to easily repeat the interval." - (interactive "p") - (let* ((colpos (org-table-current-column)) - (col (current-column)) - (field (org-table-get-field)) - (non-empty (string-match "[^ \t]" field)) - (beg (org-table-begin)) - txt) - (org-table-check-inside-data-field) - (if non-empty - (progn - (setq txt (org-trim field)) - (org-table-next-row) - (org-table-blank-field)) - (save-excursion - (setq txt - (catch 'exit - (while (progn (beginning-of-line 1) - (re-search-backward org-table-dataline-regexp - beg t)) - (org-table-goto-column colpos t) - (if (and (looking-at - "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|") - (= (setq n (1- n)) 0)) - (throw 'exit (match-string 1)))))))) - (if txt - (progn - (if (and org-table-copy-increment - (string-match "^[0-9]+$" txt)) - (setq txt (format "%d" (+ (string-to-number txt) 1)))) - (insert txt) - (move-to-column col) - (if (and org-table-copy-increment (org-at-timestamp-p t)) - (org-timestamp-up 1) - (org-table-maybe-recalculate-line)) - (org-table-align) - (move-to-column col)) - (error "No non-empty field found")))) - -(defun org-table-check-inside-data-field () - "Is point inside a table data field? -I.e. not on a hline or before the first or after the last column? -This actually throws an error, so it aborts the current command." - (if (or (not (org-at-table-p)) - (= (org-table-current-column) 0) - (org-at-table-hline-p) - (looking-at "[ \t]*$")) - (error "Not in table data field"))) - -(defvar org-table-clip nil - "Clipboard for table regions.") - -(defun org-table-blank-field () - "Blank the current table field or active region." - (interactive) - (org-table-check-inside-data-field) - (if (and (interactive-p) (org-region-active-p)) - (let (org-table-clip) - (org-table-cut-region (region-beginning) (region-end))) - (skip-chars-backward "^|") - (backward-char 1) - (if (looking-at "|[^|\n]+") - (let* ((pos (match-beginning 0)) - (match (match-string 0)) - (len (org-string-width match))) - (replace-match (concat "|" (make-string (1- len) ?\ ))) - (goto-char (+ 2 pos)) - (substring match 1))))) - -(defun org-table-get-field (&optional n replace) - "Return the value of the field in column N of current row. -N defaults to current field. -If REPLACE is a string, replace field with this value. The return value -is always the old value." - (and n (org-table-goto-column n)) - (skip-chars-backward "^|\n") - (backward-char 1) - (if (looking-at "|[^|\r\n]*") - (let* ((pos (match-beginning 0)) - (val (buffer-substring (1+ pos) (match-end 0)))) - (if replace - (replace-match (concat "|" replace) t t)) - (goto-char (min (point-at-eol) (+ 2 pos))) - val) - (forward-char 1) "")) - -(defun org-table-field-info (arg) - "Show info about the current field, and highlight any reference at point." - (interactive "P") - (org-table-get-specials) - (save-excursion - (let* ((pos (point)) - (col (org-table-current-column)) - (cname (car (rassoc (int-to-string col) org-table-column-names))) - (name (car (rassoc (list (org-current-line) col) - org-table-named-field-locations))) - (eql (org-table-get-stored-formulas)) - (dline (org-table-current-dline)) - (ref (format "@%d$%d" dline col)) - (ref1 (org-table-convert-refs-to-an ref)) - (fequation (or (assoc name eql) (assoc ref eql))) - (cequation (assoc (int-to-string col) eql)) - (eqn (or fequation cequation))) - (goto-char pos) - (condition-case nil - (org-table-show-reference 'local) - (error nil)) - (message "line @%d, col $%s%s, ref @%d$%d or %s%s%s" - dline col - (if cname (concat " or $" cname) "") - dline col ref1 - (if name (concat " or $" name) "") - ;; FIXME: formula info not correct if special table line - (if eqn - (concat ", formula: " - (org-table-formula-to-user - (concat - (if (string-match "^[$@]"(car eqn)) "" "$") - (car eqn) "=" (cdr eqn)))) - ""))))) - -(defun org-table-current-column () - "Find out which column we are in. -When called interactively, column is also displayed in echo area." - (interactive) - (if (interactive-p) (org-table-check-inside-data-field)) - (save-excursion - (let ((cnt 0) (pos (point))) - (beginning-of-line 1) - (while (search-forward "|" pos t) - (setq cnt (1+ cnt))) - (if (interactive-p) (message "This is table column %d" cnt)) - cnt))) - -(defun org-table-current-dline () - "Find out what table data line we are in. -Only datalins count for this." - (interactive) - (if (interactive-p) (org-table-check-inside-data-field)) - (save-excursion - (let ((cnt 0) (pos (point))) - (goto-char (org-table-begin)) - (while (<= (point) pos) - (if (looking-at org-table-dataline-regexp) (setq cnt (1+ cnt))) - (beginning-of-line 2)) - (if (interactive-p) (message "This is table line %d" cnt)) - cnt))) - -(defun org-table-goto-column (n &optional on-delim force) - "Move the cursor to the Nth column in the current table line. -With optional argument ON-DELIM, stop with point before the left delimiter -of the field. -If there are less than N fields, just go to after the last delimiter. -However, when FORCE is non-nil, create new columns if necessary." - (interactive "p") - (let ((pos (point-at-eol))) - (beginning-of-line 1) - (when (> n 0) - (while (and (> (setq n (1- n)) -1) - (or (search-forward "|" pos t) - (and force - (progn (end-of-line 1) - (skip-chars-backward "^|") - (insert " | ")))))) -; (backward-char 2) t))))) - (when (and force (not (looking-at ".*|"))) - (save-excursion (end-of-line 1) (insert " | "))) - (if on-delim - (backward-char 1) - (if (looking-at " ") (forward-char 1)))))) - -(defun org-at-table-p (&optional table-type) - "Return t if the cursor is inside an org-type table. -If TABLE-TYPE is non-nil, also check for table.el-type tables." - (if org-enable-table-editor - (save-excursion - (beginning-of-line 1) - (looking-at (if table-type org-table-any-line-regexp - org-table-line-regexp))) - nil)) - -(defun org-at-table.el-p () - "Return t if and only if we are at a table.el table." - (and (org-at-table-p 'any) - (save-excursion - (goto-char (org-table-begin 'any)) - (looking-at org-table1-hline-regexp)))) - -(defun org-table-recognize-table.el () - "If there is a table.el table nearby, recognize it and move into it." - (if org-table-tab-recognizes-table.el - (if (org-at-table.el-p) - (progn - (beginning-of-line 1) - (if (looking-at org-table-dataline-regexp) - nil - (if (looking-at org-table1-hline-regexp) - (progn - (beginning-of-line 2) - (if (looking-at org-table-any-border-regexp) - (beginning-of-line -1))))) - (if (re-search-forward "|" (org-table-end t) t) - (progn - (require 'table) - (if (table--at-cell-p (point)) - t - (message "recognizing table.el table...") - (table-recognize-table) - (message "recognizing table.el table...done"))) - (error "This should not happen...")) - t) - nil) - nil)) - -(defun org-at-table-hline-p () - "Return t if the cursor is inside a hline in a table." - (if org-enable-table-editor - (save-excursion - (beginning-of-line 1) - (looking-at org-table-hline-regexp)) - nil)) - -(defun org-table-insert-column () - "Insert a new column into the table." - (interactive) - (if (not (org-at-table-p)) - (error "Not at a table")) - (org-table-find-dataline) - (let* ((col (max 1 (org-table-current-column))) - (beg (org-table-begin)) - (end (org-table-end)) - ;; Current cursor position - (linepos (org-current-line)) - (colpos col)) - (goto-char beg) - (while (< (point) end) - (if (org-at-table-hline-p) - nil - (org-table-goto-column col t) - (insert "| ")) - (beginning-of-line 2)) - (move-marker end nil) - (goto-line linepos) - (org-table-goto-column colpos) - (org-table-align) - (org-table-fix-formulas "$" nil (1- col) 1))) - -(defun org-table-find-dataline () - "Find a dataline in the current table, which is needed for column commands." - (if (and (org-at-table-p) - (not (org-at-table-hline-p))) - t - (let ((col (current-column)) - (end (org-table-end))) - (move-to-column col) - (while (and (< (point) end) - (or (not (= (current-column) col)) - (org-at-table-hline-p))) - (beginning-of-line 2) - (move-to-column col)) - (if (and (org-at-table-p) - (not (org-at-table-hline-p))) - t - (error - "Please position cursor in a data line for column operations"))))) - -(defun org-table-delete-column () - "Delete a column from the table." - (interactive) - (if (not (org-at-table-p)) - (error "Not at a table")) - (org-table-find-dataline) - (org-table-check-inside-data-field) - (let* ((col (org-table-current-column)) - (beg (org-table-begin)) - (end (org-table-end)) - ;; Current cursor position - (linepos (org-current-line)) - (colpos col)) - (goto-char beg) - (while (< (point) end) - (if (org-at-table-hline-p) - nil - (org-table-goto-column col t) - (and (looking-at "|[^|\n]+|") - (replace-match "|"))) - (beginning-of-line 2)) - (move-marker end nil) - (goto-line linepos) - (org-table-goto-column colpos) - (org-table-align) - (org-table-fix-formulas "$" (list (cons (number-to-string col) "INVALID")) - col -1 col))) - -(defun org-table-move-column-right () - "Move column to the right." - (interactive) - (org-table-move-column nil)) -(defun org-table-move-column-left () - "Move column to the left." - (interactive) - (org-table-move-column 'left)) - -(defun org-table-move-column (&optional left) - "Move the current column to the right. With arg LEFT, move to the left." - (interactive "P") - (if (not (org-at-table-p)) - (error "Not at a table")) - (org-table-find-dataline) - (org-table-check-inside-data-field) - (let* ((col (org-table-current-column)) - (col1 (if left (1- col) col)) - (beg (org-table-begin)) - (end (org-table-end)) - ;; Current cursor position - (linepos (org-current-line)) - (colpos (if left (1- col) (1+ col)))) - (if (and left (= col 1)) - (error "Cannot move column further left")) - (if (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) - (error "Cannot move column further right")) - (goto-char beg) - (while (< (point) end) - (if (org-at-table-hline-p) - nil - (org-table-goto-column col1 t) - (and (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|") - (replace-match "|\\2|\\1|"))) - (beginning-of-line 2)) - (move-marker end nil) - (goto-line linepos) - (org-table-goto-column colpos) - (org-table-align) - (org-table-fix-formulas - "$" (list (cons (number-to-string col) (number-to-string colpos)) - (cons (number-to-string colpos) (number-to-string col)))))) - -(defun org-table-move-row-down () - "Move table row down." - (interactive) - (org-table-move-row nil)) -(defun org-table-move-row-up () - "Move table row up." - (interactive) - (org-table-move-row 'up)) - -(defun org-table-move-row (&optional up) - "Move the current table line down. With arg UP, move it up." - (interactive "P") - (let* ((col (current-column)) - (pos (point)) - (hline1p (save-excursion (beginning-of-line 1) - (looking-at org-table-hline-regexp))) - (dline1 (org-table-current-dline)) - (dline2 (+ dline1 (if up -1 1))) - (tonew (if up 0 2)) - txt hline2p) - (beginning-of-line tonew) - (unless (org-at-table-p) - (goto-char pos) - (error "Cannot move row further")) - (setq hline2p (looking-at org-table-hline-regexp)) - (goto-char pos) - (beginning-of-line 1) - (setq pos (point)) - (setq txt (buffer-substring (point) (1+ (point-at-eol)))) - (delete-region (point) (1+ (point-at-eol))) - (beginning-of-line tonew) - (insert txt) - (beginning-of-line 0) - (move-to-column col) - (unless (or hline1p hline2p) - (org-table-fix-formulas - "@" (list (cons (number-to-string dline1) (number-to-string dline2)) - (cons (number-to-string dline2) (number-to-string dline1))))))) - -(defun org-table-insert-row (&optional arg) - "Insert a new row above the current line into the table. -With prefix ARG, insert below the current line." - (interactive "P") - (if (not (org-at-table-p)) - (error "Not at a table")) - (let* ((line (buffer-substring (point-at-bol) (point-at-eol))) - (new (org-table-clean-line line))) - ;; Fix the first field if necessary - (if (string-match "^[ \t]*| *[#$] *|" line) - (setq new (replace-match (match-string 0 line) t t new))) - (beginning-of-line (if arg 2 1)) - (let (org-table-may-need-update) (insert-before-markers new "\n")) - (beginning-of-line 0) - (re-search-forward "| ?" (point-at-eol) t) - (and (or org-table-may-need-update org-table-overlay-coordinates) - (org-table-align)) - (org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1))) - -(defun org-table-insert-hline (&optional above) - "Insert a horizontal-line below the current line into the table. -With prefix ABOVE, insert above the current line." - (interactive "P") - (if (not (org-at-table-p)) - (error "Not at a table")) - (let ((line (org-table-clean-line - (buffer-substring (point-at-bol) (point-at-eol)))) - (col (current-column))) - (while (string-match "|\\( +\\)|" line) - (setq line (replace-match - (concat "+" (make-string (- (match-end 1) (match-beginning 1)) - ?-) "|") t t line))) - (and (string-match "\\+" line) (setq line (replace-match "|" t t line))) - (beginning-of-line (if above 1 2)) - (insert line "\n") - (beginning-of-line (if above 1 -1)) - (move-to-column col) - (and org-table-overlay-coordinates (org-table-align)))) - -(defun org-table-hline-and-move (&optional same-column) - "Insert a hline and move to the row below that line." - (interactive "P") - (let ((col (org-table-current-column))) - (org-table-maybe-eval-formula) - (org-table-maybe-recalculate-line) - (org-table-insert-hline) - (end-of-line 2) - (if (looking-at "\n[ \t]*|-") - (progn (insert "\n|") (org-table-align)) - (org-table-next-field)) - (if same-column (org-table-goto-column col)))) - -(defun org-table-clean-line (s) - "Convert a table line S into a string with only \"|\" and space. -In particular, this does handle wide and invisible characters." - (if (string-match "^[ \t]*|-" s) - ;; It's a hline, just map the characters - (setq s (mapconcat (lambda (x) (if (member x '(?| ?+)) "|" " ")) s "")) - (while (string-match "|\\([ \t]*?[^ \t\r\n|][^\r\n|]*\\)|" s) - (setq s (replace-match - (concat "|" (make-string (org-string-width (match-string 1 s)) - ?\ ) "|") - t t s))) - s)) - -(defun org-table-kill-row () - "Delete the current row or horizontal line from the table." - (interactive) - (if (not (org-at-table-p)) - (error "Not at a table")) - (let ((col (current-column)) - (dline (org-table-current-dline))) - (kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))) - (if (not (org-at-table-p)) (beginning-of-line 0)) - (move-to-column col) - (org-table-fix-formulas "@" (list (cons (number-to-string dline) "INVALID")) - dline -1 dline))) - -(defun org-table-sort-lines (with-case &optional sorting-type) - "Sort table lines according to the column at point. - -The position of point indicates the column to be used for -sorting, and the range of lines is the range between the nearest -horizontal separator lines, or the entire table of no such lines -exist. If point is before the first column, you will be prompted -for the sorting column. If there is an active region, the mark -specifies the first line and the sorting column, while point -should be in the last line to be included into the sorting. - -The command then prompts for the sorting type which can be -alphabetically, numerically, or by time (as given in a time stamp -in the field). Sorting in reverse order is also possible. - -With prefix argument WITH-CASE, alphabetic sorting will be case-sensitive. - -If SORTING-TYPE is specified when this function is called from a Lisp -program, no prompting will take place. SORTING-TYPE must be a character, -any of (?a ?A ?n ?N ?t ?T) where the capital letter indicate that sorting -should be done in reverse order." - (interactive "P") - (let* ((thisline (org-current-line)) - (thiscol (org-table-current-column)) - beg end bcol ecol tend tbeg column lns pos) - (when (equal thiscol 0) - (if (interactive-p) - (setq thiscol - (string-to-number - (read-string "Use column N for sorting: "))) - (setq thiscol 1)) - (org-table-goto-column thiscol)) - (org-table-check-inside-data-field) - (if (org-region-active-p) - (progn - (setq beg (region-beginning) end (region-end)) - (goto-char beg) - (setq column (org-table-current-column) - beg (point-at-bol)) - (goto-char end) - (setq end (point-at-bol 2))) - (setq column (org-table-current-column) - pos (point) - tbeg (org-table-begin) - tend (org-table-end)) - (if (re-search-backward org-table-hline-regexp tbeg t) - (setq beg (point-at-bol 2)) - (goto-char tbeg) - (setq beg (point-at-bol 1))) - (goto-char pos) - (if (re-search-forward org-table-hline-regexp tend t) - (setq end (point-at-bol 1)) - (goto-char tend) - (setq end (point-at-bol)))) - (setq beg (move-marker (make-marker) beg) - end (move-marker (make-marker) end)) - (untabify beg end) - (goto-char beg) - (org-table-goto-column column) - (skip-chars-backward "^|") - (setq bcol (current-column)) - (org-table-goto-column (1+ column)) - (skip-chars-backward "^|") - (setq ecol (1- (current-column))) - (org-table-goto-column column) - (setq lns (mapcar (lambda(x) (cons - (org-sort-remove-invisible - (nth (1- column) - (org-split-string x "[ \t]*|[ \t]*"))) - x)) - (org-split-string (buffer-substring beg end) "\n"))) - (setq lns (org-do-sort lns "Table" with-case sorting-type)) - (delete-region beg end) - (move-marker beg nil) - (move-marker end nil) - (insert (mapconcat 'cdr lns "\n") "\n") - (goto-line thisline) - (org-table-goto-column thiscol) - (message "%d lines sorted, based on column %d" (length lns) column))) - -;; FIXME: maybe we will not need this? Table sorting is broken.... -(defun org-sort-remove-invisible (s) - (remove-text-properties 0 (length s) org-rm-props s) - (while (string-match org-bracket-link-regexp s) - (setq s (replace-match (if (match-end 2) - (match-string 3 s) - (match-string 1 s)) t t s))) - s) - -(defun org-table-cut-region (beg end) - "Copy region in table to the clipboard and blank all relevant fields." - (interactive "r") - (org-table-copy-region beg end 'cut)) - -(defun org-table-copy-region (beg end &optional cut) - "Copy rectangular region in table to clipboard. -A special clipboard is used which can only be accessed -with `org-table-paste-rectangle'." - (interactive "rP") - (let* (l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2 - region cols - (rpl (if cut " " nil))) - (goto-char beg) - (org-table-check-inside-data-field) - (setq l01 (org-current-line) - c01 (org-table-current-column)) - (goto-char end) - (org-table-check-inside-data-field) - (setq l02 (org-current-line) - c02 (org-table-current-column)) - (setq l1 (min l01 l02) l2 (max l01 l02) - c1 (min c01 c02) c2 (max c01 c02)) - (catch 'exit - (while t - (catch 'nextline - (if (> l1 l2) (throw 'exit t)) - (goto-line l1) - (if (org-at-table-hline-p) (throw 'nextline (setq l1 (1+ l1)))) - (setq cols nil ic1 c1 ic2 c2) - (while (< ic1 (1+ ic2)) - (push (org-table-get-field ic1 rpl) cols) - (setq ic1 (1+ ic1))) - (push (nreverse cols) region) - (setq l1 (1+ l1))))) - (setq org-table-clip (nreverse region)) - (if cut (org-table-align)) - org-table-clip)) - -(defun org-table-paste-rectangle () - "Paste a rectangular region into a table. -The upper right corner ends up in the current field. All involved fields -will be overwritten. If the rectangle does not fit into the present table, -the table is enlarged as needed. The process ignores horizontal separator -lines." - (interactive) - (unless (and org-table-clip (listp org-table-clip)) - (error "First cut/copy a region to paste!")) - (org-table-check-inside-data-field) - (let* ((clip org-table-clip) - (line (org-current-line)) - (col (org-table-current-column)) - (org-enable-table-editor t) - (org-table-automatic-realign nil) - c cols field) - (while (setq cols (pop clip)) - (while (org-at-table-hline-p) (beginning-of-line 2)) - (if (not (org-at-table-p)) - (progn (end-of-line 0) (org-table-next-field))) - (setq c col) - (while (setq field (pop cols)) - (org-table-goto-column c nil 'force) - (org-table-get-field nil field) - (setq c (1+ c))) - (beginning-of-line 2)) - (goto-line line) - (org-table-goto-column col) - (org-table-align))) - -(defun org-table-convert () - "Convert from `org-mode' table to table.el and back. -Obviously, this only works within limits. When an Org-mode table is -converted to table.el, all horizontal separator lines get lost, because -table.el uses these as cell boundaries and has no notion of horizontal lines. -A table.el table can be converted to an Org-mode table only if it does not -do row or column spanning. Multiline cells will become multiple cells. -Beware, Org-mode does not test if the table can be successfully converted - it -blindly applies a recipe that works for simple tables." - (interactive) - (require 'table) - (if (org-at-table.el-p) - ;; convert to Org-mode table - (let ((beg (move-marker (make-marker) (org-table-begin t))) - (end (move-marker (make-marker) (org-table-end t)))) - (table-unrecognize-region beg end) - (goto-char beg) - (while (re-search-forward "^\\([ \t]*\\)\\+-.*\n" end t) - (replace-match "")) - (goto-char beg)) - (if (org-at-table-p) - ;; convert to table.el table - (let ((beg (move-marker (make-marker) (org-table-begin))) - (end (move-marker (make-marker) (org-table-end)))) - ;; first, get rid of all horizontal lines - (goto-char beg) - (while (re-search-forward "^\\([ \t]*\\)|-.*\n" end t) - (replace-match "")) - ;; insert a hline before first - (goto-char beg) - (org-table-insert-hline 'above) - (beginning-of-line -1) - ;; insert a hline after each line - (while (progn (beginning-of-line 3) (< (point) end)) - (org-table-insert-hline)) - (goto-char beg) - (setq end (move-marker end (org-table-end))) - ;; replace "+" at beginning and ending of hlines - (while (re-search-forward "^\\([ \t]*\\)|-" end t) - (replace-match "\\1+-")) - (goto-char beg) - (while (re-search-forward "-|[ \t]*$" end t) - (replace-match "-+")) - (goto-char beg))))) - -(defun org-table-wrap-region (arg) - "Wrap several fields in a column like a paragraph. -This is useful if you'd like to spread the contents of a field over several -lines, in order to keep the table compact. - -If there is an active region, and both point and mark are in the same column, -the text in the column is wrapped to minimum width for the given number of -lines. Generally, this makes the table more compact. A prefix ARG may be -used to change the number of desired lines. For example, `C-2 \\[org-table-wrap]' -formats the selected text to two lines. If the region was longer than two -lines, the remaining lines remain empty. A negative prefix argument reduces -the current number of lines by that amount. The wrapped text is pasted back -into the table. If you formatted it to more lines than it was before, fields -further down in the table get overwritten - so you might need to make space in -the table first. - -If there is no region, the current field is split at the cursor position and -the text fragment to the right of the cursor is prepended to the field one -line down. - -If there is no region, but you specify a prefix ARG, the current field gets -blank, and the content is appended to the field above." - (interactive "P") - (org-table-check-inside-data-field) - (if (org-region-active-p) - ;; There is a region: fill as a paragraph - (let* ((beg (region-beginning)) - (cline (save-excursion (goto-char beg) (org-current-line))) - (ccol (save-excursion (goto-char beg) (org-table-current-column))) - nlines) - (org-table-cut-region (region-beginning) (region-end)) - (if (> (length (car org-table-clip)) 1) - (error "Region must be limited to single column")) - (setq nlines (if arg - (if (< arg 1) - (+ (length org-table-clip) arg) - arg) - (length org-table-clip))) - (setq org-table-clip - (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ") - nil nlines))) - (goto-line cline) - (org-table-goto-column ccol) - (org-table-paste-rectangle)) - ;; No region, split the current field at point - (if arg - ;; combine with field above - (let ((s (org-table-blank-field)) - (col (org-table-current-column))) - (beginning-of-line 0) - (while (org-at-table-hline-p) (beginning-of-line 0)) - (org-table-goto-column col) - (skip-chars-forward "^|") - (skip-chars-backward " ") - (insert " " (org-trim s)) - (org-table-align)) - ;; split field - (when (looking-at "\\([^|]+\\)+|") - (let ((s (match-string 1))) - (replace-match " |") - (goto-char (match-beginning 0)) - (org-table-next-row) - (insert (org-trim s) " ") - (org-table-align)))))) - -(defvar org-field-marker nil) - -(defun org-table-edit-field (arg) - "Edit table field in a different window. -This is mainly useful for fields that contain hidden parts. -When called with a \\[universal-argument] prefix, just make the full field visible so that -it can be edited in place." - (interactive "P") - (if arg - (let ((b (save-excursion (skip-chars-backward "^|") (point))) - (e (save-excursion (skip-chars-forward "^|\r\n") (point)))) - (remove-text-properties b e '(org-cwidth t invisible t - display t intangible t)) - (if (and (boundp 'font-lock-mode) font-lock-mode) - (font-lock-fontify-block))) - (let ((pos (move-marker (make-marker) (point))) - (field (org-table-get-field)) - (cw (current-window-configuration)) - p) - (org-switch-to-buffer-other-window "*Org tmp*") - (erase-buffer) - (insert "#\n# Edit field and finish with C-c C-c\n#\n") - (let ((org-inhibit-startup t)) (org-mode)) - (goto-char (setq p (point-max))) - (insert (org-trim field)) - (remove-text-properties p (point-max) - '(invisible t org-cwidth t display t - intangible t)) - (goto-char p) - (org-set-local 'org-finish-function 'org-table-finish-edit-field) - (org-set-local 'org-window-configuration cw) - (org-set-local 'org-field-marker pos) - (message "Edit and finish with C-c C-c")))) - -(defun org-table-finish-edit-field () - "Finish editing a table data field. -Remove all newline characters, insert the result into the table, realign -the table and kill the editing buffer." - (let ((pos org-field-marker) - (cw org-window-configuration) - (cb (current-buffer)) - text) - (goto-char (point-min)) - (while (re-search-forward "^#.*\n?" nil t) (replace-match "")) - (while (re-search-forward "\\([ \t]*\n[ \t]*\\)+" nil t) - (replace-match " ")) - (setq text (org-trim (buffer-string))) - (set-window-configuration cw) - (kill-buffer cb) - (select-window (get-buffer-window (marker-buffer pos))) - (goto-char pos) - (move-marker pos nil) - (org-table-check-inside-data-field) - (org-table-get-field nil text) - (org-table-align) - (message "New field value inserted"))) - -(defun org-trim (s) - "Remove whitespace at beginning and end of string." - (if (string-match "\\`[ \t\n\r]+" s) (setq s (replace-match "" t t s))) - (if (string-match "[ \t\n\r]+\\'" s) (setq s (replace-match "" t t s))) - s) - -(defun org-wrap (string &optional width lines) - "Wrap string to either a number of lines, or a width in characters. -If WIDTH is non-nil, the string is wrapped to that width, however many lines -that costs. If there is a word longer than WIDTH, the text is actually -wrapped to the length of that word. -IF WIDTH is nil and LINES is non-nil, the string is forced into at most that -many lines, whatever width that takes. -The return value is a list of lines, without newlines at the end." - (let* ((words (org-split-string string "[ \t\n]+")) - (maxword (apply 'max (mapcar 'org-string-width words))) - w ll) - (cond (width - (org-do-wrap words (max maxword width))) - (lines - (setq w maxword) - (setq ll (org-do-wrap words maxword)) - (if (<= (length ll) lines) - ll - (setq ll words) - (while (> (length ll) lines) - (setq w (1+ w)) - (setq ll (org-do-wrap words w))) - ll)) - (t (error "Cannot wrap this"))))) - - -(defun org-do-wrap (words width) - "Create lines of maximum width WIDTH (in characters) from word list WORDS." - (let (lines line) - (while words - (setq line (pop words)) - (while (and words (< (+ (length line) (length (car words))) width)) - (setq line (concat line " " (pop words)))) - (setq lines (push line lines))) - (nreverse lines))) - -(defun org-split-string (string &optional separators) - "Splits STRING into substrings at SEPARATORS. -No empty strings are returned if there are matches at the beginning -and end of string." - (let ((rexp (or separators "[ \f\t\n\r\v]+")) - (start 0) - notfirst - (list nil)) - (while (and (string-match rexp string - (if (and notfirst - (= start (match-beginning 0)) - (< start (length string))) - (1+ start) start)) - (< (match-beginning 0) (length string))) - (setq notfirst t) - (or (eq (match-beginning 0) 0) - (and (eq (match-beginning 0) (match-end 0)) - (eq (match-beginning 0) start)) - (setq list - (cons (substring string start (match-beginning 0)) - list))) - (setq start (match-end 0))) - (or (eq start (length string)) - (setq list - (cons (substring string start) - list))) - (nreverse list))) - -(defun org-table-map-tables (function) - "Apply FUNCTION to the start of all tables in the buffer." - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward org-table-any-line-regexp nil t) - (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size))) - (beginning-of-line 1) - (if (looking-at org-table-line-regexp) - (save-excursion (funcall function))) - (re-search-forward org-table-any-border-regexp nil 1)))) - (message "Mapping tables: done")) - -(defvar org-timecnt) ; dynamically scoped parameter - -(defun org-table-sum (&optional beg end nlast) - "Sum numbers in region of current table column. -The result will be displayed in the echo area, and will be available -as kill to be inserted with \\[yank]. - -If there is an active region, it is interpreted as a rectangle and all -numbers in that rectangle will be summed. If there is no active -region and point is located in a table column, sum all numbers in that -column. - -If at least one number looks like a time HH:MM or HH:MM:SS, all other -numbers are assumed to be times as well (in decimal hours) and the -numbers are added as such. - -If NLAST is a number, only the NLAST fields will actually be summed." - (interactive) - (save-excursion - (let (col (org-timecnt 0) diff h m s org-table-clip) - (cond - ((and beg end)) ; beg and end given explicitly - ((org-region-active-p) - (setq beg (region-beginning) end (region-end))) - (t - (setq col (org-table-current-column)) - (goto-char (org-table-begin)) - (unless (re-search-forward "^[ \t]*|[^-]" nil t) - (error "No table data")) - (org-table-goto-column col) - (setq beg (point)) - (goto-char (org-table-end)) - (unless (re-search-backward "^[ \t]*|[^-]" nil t) - (error "No table data")) - (org-table-goto-column col) - (setq end (point)))) - (let* ((items (apply 'append (org-table-copy-region beg end))) - (items1 (cond ((not nlast) items) - ((>= nlast (length items)) items) - (t (setq items (reverse items)) - (setcdr (nthcdr (1- nlast) items) nil) - (nreverse items)))) - (numbers (delq nil (mapcar 'org-table-get-number-for-summing - items1))) - (res (apply '+ numbers)) - (sres (if (= org-timecnt 0) - (format "%g" res) - (setq diff (* 3600 res) - h (floor (/ diff 3600)) diff (mod diff 3600) - m (floor (/ diff 60)) diff (mod diff 60) - s diff) - (format "%d:%02d:%02d" h m s)))) - (kill-new sres) - (if (interactive-p) - (message "%s" - (substitute-command-keys - (format "Sum of %d items: %-20s (\\[yank] will insert result into buffer)" - (length numbers) sres)))) - sres)))) - -(defun org-table-get-number-for-summing (s) - (let (n) - (if (string-match "^ *|? *" s) - (setq s (replace-match "" nil nil s))) - (if (string-match " *|? *$" s) - (setq s (replace-match "" nil nil s))) - (setq n (string-to-number s)) - (cond - ((and (string-match "0" s) - (string-match "\\`[-+ \t0.edED]+\\'" s)) 0) - ((string-match "\\`[ \t]+\\'" s) nil) - ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?\\'" s) - (let ((h (string-to-number (or (match-string 1 s) "0"))) - (m (string-to-number (or (match-string 2 s) "0"))) - (s (string-to-number (or (match-string 4 s) "0")))) - (if (boundp 'org-timecnt) (setq org-timecnt (1+ org-timecnt))) - (* 1.0 (+ h (/ m 60.0) (/ s 3600.0))))) - ((equal n 0) nil) - (t n)))) - -(defun org-table-current-field-formula (&optional key noerror) - "Return the formula active for the current field. -Assumes that specials are in place. -If KEY is given, return the key to this formula. -Otherwise return the formula preceeded with \"=\" or \":=\"." - (let* ((name (car (rassoc (list (org-current-line) - (org-table-current-column)) - org-table-named-field-locations))) - (col (org-table-current-column)) - (scol (int-to-string col)) - (ref (format "@%d$%d" (org-table-current-dline) col)) - (stored-list (org-table-get-stored-formulas noerror)) - (ass (or (assoc name stored-list) - (assoc ref stored-list) - (assoc scol stored-list)))) - (if key - (car ass) - (if ass (concat (if (string-match "^[0-9]+$" (car ass)) "=" ":=") - (cdr ass)))))) - -(defun org-table-get-formula (&optional equation named) - "Read a formula from the minibuffer, offer stored formula as default. -When NAMED is non-nil, look for a named equation." - (let* ((stored-list (org-table-get-stored-formulas)) - (name (car (rassoc (list (org-current-line) - (org-table-current-column)) - org-table-named-field-locations))) - (ref (format "@%d$%d" (org-table-current-dline) - (org-table-current-column))) - (refass (assoc ref stored-list)) - (scol (if named - (if name name ref) - (int-to-string (org-table-current-column)))) - (dummy (and (or name refass) (not named) - (not (y-or-n-p "Replace field formula with column formula? " )) - (error "Abort"))) - (name (or name ref)) - (org-table-may-need-update nil) - (stored (cdr (assoc scol stored-list))) - (eq (cond - ((and stored equation (string-match "^ *=? *$" equation)) - stored) - ((stringp equation) - equation) - (t (org-table-formula-from-user - (read-string - (org-table-formula-to-user - (format "%s formula %s%s=" - (if named "Field" "Column") - (if (member (string-to-char scol) '(?$ ?@)) "" "$") - scol)) - (if stored (org-table-formula-to-user stored) "") - 'org-table-formula-history - ))))) - mustsave) - (when (not (string-match "\\S-" eq)) - ;; remove formula - (setq stored-list (delq (assoc scol stored-list) stored-list)) - (org-table-store-formulas stored-list) - (error "Formula removed")) - (if (string-match "^ *=?" eq) (setq eq (replace-match "" t t eq))) - (if (string-match " *$" eq) (setq eq (replace-match "" t t eq))) - (if (and name (not named)) - ;; We set the column equation, delete the named one. - (setq stored-list (delq (assoc name stored-list) stored-list) - mustsave t)) - (if stored - (setcdr (assoc scol stored-list) eq) - (setq stored-list (cons (cons scol eq) stored-list))) - (if (or mustsave (not (equal stored eq))) - (org-table-store-formulas stored-list)) - eq)) - -(defun org-table-store-formulas (alist) - "Store the list of formulas below the current table." - (setq alist (sort alist 'org-table-formula-less-p)) - (save-excursion - (goto-char (org-table-end)) - (if (looking-at "\\([ \t]*\n\\)*#\\+TBLFM:\\(.*\n?\\)") - (progn - ;; don't overwrite TBLFM, we might use text properties to store stuff - (goto-char (match-beginning 2)) - (delete-region (match-beginning 2) (match-end 0))) - (insert "#+TBLFM:")) - (insert " " - (mapconcat (lambda (x) - (concat - (if (equal (string-to-char (car x)) ?@) "" "$") - (car x) "=" (cdr x))) - alist "::") - "\n"))) - -(defsubst org-table-formula-make-cmp-string (a) - (when (string-match "^\\(@\\([0-9]+\\)\\)?\\(\\$?\\([0-9]+\\)\\)?\\(\\$?[a-zA-Z0-9]+\\)?" a) - (concat - (if (match-end 2) (format "@%05d" (string-to-number (match-string 2 a))) "") - (if (match-end 4) (format "$%05d" (string-to-number (match-string 4 a))) "") - (if (match-end 5) (concat "@@" (match-string 5 a)))))) - -(defun org-table-formula-less-p (a b) - "Compare two formulas for sorting." - (let ((as (org-table-formula-make-cmp-string (car a))) - (bs (org-table-formula-make-cmp-string (car b)))) - (and as bs (string< as bs)))) - -(defun org-table-get-stored-formulas (&optional noerror) - "Return an alist with the stored formulas directly after current table." - (interactive) - (let (scol eq eq-alist strings string seen) - (save-excursion - (goto-char (org-table-end)) - (when (looking-at "\\([ \t]*\n\\)*#\\+TBLFM: *\\(.*\\)") - (setq strings (org-split-string (match-string 2) " *:: *")) - (while (setq string (pop strings)) - (when (string-match "\\(@[0-9]+\\$[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*[^ \t]\\)" string) - (setq scol (if (match-end 2) - (match-string 2 string) - (match-string 1 string)) - eq (match-string 3 string) - eq-alist (cons (cons scol eq) eq-alist)) - (if (member scol seen) - (if noerror - (progn - (message "Double definition `$%s=' in TBLFM line, please fix by hand" scol) - (ding) - (sit-for 2)) - (error "Double definition `$%s=' in TBLFM line, please fix by hand" scol)) - (push scol seen)))))) - (nreverse eq-alist))) - -(defun org-table-fix-formulas (key replace &optional limit delta remove) - "Modify the equations after the table structure has been edited. -KEY is \"@\" or \"$\". REPLACE is an alist of numbers to replace. -For all numbers larger than LIMIT, shift them by DELTA." - (save-excursion - (goto-char (org-table-end)) - (when (looking-at "#\\+TBLFM:") - (let ((re (concat key "\\([0-9]+\\)")) - (re2 - (when remove - (if (equal key "$") - (format "\\(@[0-9]+\\)?\\$%d=.*?\\(::\\|$\\)" remove) - (format "@%d\\$[0-9]+=.*?\\(::\\|$\\)" remove)))) - s n a) - (when remove - (while (re-search-forward re2 (point-at-eol) t) - (replace-match ""))) - (while (re-search-forward re (point-at-eol) t) - (setq s (match-string 1) n (string-to-number s)) - (cond - ((setq a (assoc s replace)) - (replace-match (concat key (cdr a)) t t)) - ((and limit (> n limit)) - (replace-match (concat key (int-to-string (+ n delta))) t t)))))))) - -(defun org-table-get-specials () - "Get the column names and local parameters for this table." - (save-excursion - (let ((beg (org-table-begin)) (end (org-table-end)) - names name fields fields1 field cnt - c v l line col types dlines hlines) - (setq org-table-column-names nil - org-table-local-parameters nil - org-table-named-field-locations nil - org-table-current-begin-line nil - org-table-current-begin-pos nil - org-table-current-line-types nil) - (goto-char beg) - (when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t) - (setq names (org-split-string (match-string 1) " *| *") - cnt 1) - (while (setq name (pop names)) - (setq cnt (1+ cnt)) - (if (string-match "^[a-zA-Z][a-zA-Z0-9]*$" name) - (push (cons name (int-to-string cnt)) org-table-column-names)))) - (setq org-table-column-names (nreverse org-table-column-names)) - (setq org-table-column-name-regexp - (concat "\\$\\(" (mapconcat 'car org-table-column-names "\\|") "\\)\\>")) - (goto-char beg) - (while (re-search-forward "^[ \t]*| *\\$ *\\(|.*\\)" end t) - (setq fields (org-split-string (match-string 1) " *| *")) - (while (setq field (pop fields)) - (if (string-match "^\\([a-zA-Z][_a-zA-Z0-9]*\\|%\\) *= *\\(.*\\)" field) - (push (cons (match-string 1 field) (match-string 2 field)) - org-table-local-parameters)))) - (goto-char beg) - (while (re-search-forward "^[ \t]*| *\\([_^]\\) *\\(|.*\\)" end t) - (setq c (match-string 1) - fields (org-split-string (match-string 2) " *| *")) - (save-excursion - (beginning-of-line (if (equal c "_") 2 0)) - (setq line (org-current-line) col 1) - (and (looking-at "^[ \t]*|[^|]*\\(|.*\\)") - (setq fields1 (org-split-string (match-string 1) " *| *")))) - (while (and fields1 (setq field (pop fields))) - (setq v (pop fields1) col (1+ col)) - (when (and (stringp field) (stringp v) - (string-match "^[a-zA-Z][a-zA-Z0-9]*$" field)) - (push (cons field v) org-table-local-parameters) - (push (list field line col) org-table-named-field-locations)))) - ;; Analyse the line types - (goto-char beg) - (setq org-table-current-begin-line (org-current-line) - org-table-current-begin-pos (point) - l org-table-current-begin-line) - (while (looking-at "[ \t]*|\\(-\\)?") - (push (if (match-end 1) 'hline 'dline) types) - (if (match-end 1) (push l hlines) (push l dlines)) - (beginning-of-line 2) - (setq l (1+ l))) - (setq org-table-current-line-types (apply 'vector (nreverse types)) - org-table-dlines (apply 'vector (cons nil (nreverse dlines))) - org-table-hlines (apply 'vector (cons nil (nreverse hlines))))))) - -(defun org-table-maybe-eval-formula () - "Check if the current field starts with \"=\" or \":=\". -If yes, store the formula and apply it." - ;; We already know we are in a table. Get field will only return a formula - ;; when appropriate. It might return a separator line, but no problem. - (when org-table-formula-evaluate-inline - (let* ((field (org-trim (or (org-table-get-field) ""))) - named eq) - (when (string-match "^:?=\\(.*\\)" field) - (setq named (equal (string-to-char field) ?:) - eq (match-string 1 field)) - (if (or (fboundp 'calc-eval) - (equal (substring eq 0 (min 2 (length eq))) "'(")) - (org-table-eval-formula (if named '(4) nil) - (org-table-formula-from-user eq)) - (error "Calc does not seem to be installed, and is needed to evaluate the formula")))))) - -(defvar org-recalc-commands nil - "List of commands triggering the recalculation of a line. -Will be filled automatically during use.") - -(defvar org-recalc-marks - '((" " . "Unmarked: no special line, no automatic recalculation") - ("#" . "Automatically recalculate this line upon TAB, RET, and C-c C-c in the line") - ("*" . "Recalculate only when entire table is recalculated with `C-u C-c *'") - ("!" . "Column name definition line. Reference in formula as $name.") - ("$" . "Parameter definition line name=value. Reference in formula as $name.") - ("_" . "Names for values in row below this one.") - ("^" . "Names for values in row above this one."))) - -(defun org-table-rotate-recalc-marks (&optional newchar) - "Rotate the recalculation mark in the first column. -If in any row, the first field is not consistent with a mark, -insert a new column for the markers. -When there is an active region, change all the lines in the region, -after prompting for the marking character. -After each change, a message will be displayed indicating the meaning -of the new mark." - (interactive) - (unless (org-at-table-p) (error "Not at a table")) - (let* ((marks (append (mapcar 'car org-recalc-marks) '(" "))) - (beg (org-table-begin)) - (end (org-table-end)) - (l (org-current-line)) - (l1 (if (org-region-active-p) (org-current-line (region-beginning)))) - (l2 (if (org-region-active-p) (org-current-line (region-end)))) - (have-col - (save-excursion - (goto-char beg) - (not (re-search-forward "^[ \t]*|[^-|][^|]*[^#!$*_^| \t][^|]*|" end t)))) - (col (org-table-current-column)) - (forcenew (car (assoc newchar org-recalc-marks))) - epos new) - (when l1 - (message "Change region to what mark? Type # * ! $ or SPC: ") - (setq newchar (char-to-string (read-char-exclusive)) - forcenew (car (assoc newchar org-recalc-marks)))) - (if (and newchar (not forcenew)) - (error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'" - newchar)) - (if l1 (goto-line l1)) - (save-excursion - (beginning-of-line 1) - (unless (looking-at org-table-dataline-regexp) - (error "Not at a table data line"))) - (unless have-col - (org-table-goto-column 1) - (org-table-insert-column) - (org-table-goto-column (1+ col))) - (setq epos (point-at-eol)) - (save-excursion - (beginning-of-line 1) - (org-table-get-field - 1 (if (looking-at "^[ \t]*| *\\([#!$*^_ ]\\) *|") - (concat " " - (setq new (or forcenew - (cadr (member (match-string 1) marks)))) - " ") - " # "))) - (if (and l1 l2) - (progn - (goto-line l1) - (while (progn (beginning-of-line 2) (not (= (org-current-line) l2))) - (and (looking-at org-table-dataline-regexp) - (org-table-get-field 1 (concat " " new " ")))) - (goto-line l1))) - (if (not (= epos (point-at-eol))) (org-table-align)) - (goto-line l) - (and (interactive-p) (message "%s" (cdr (assoc new org-recalc-marks)))))) - -(defun org-table-maybe-recalculate-line () - "Recompute the current line if marked for it, and if we haven't just done it." - (interactive) - (and org-table-allow-automatic-line-recalculation - (not (and (memq last-command org-recalc-commands) - (equal org-last-recalc-line (org-current-line)))) - (save-excursion (beginning-of-line 1) - (looking-at org-table-auto-recalculate-regexp)) - (org-table-recalculate) t)) - -(defvar org-table-formula-debug nil - "Non-nil means, debug table formulas. -When nil, simply write \"#ERROR\" in corrupted fields.") -(make-variable-buffer-local 'org-table-formula-debug) - -(defvar modes) -(defsubst org-set-calc-mode (var &optional value) - (if (stringp var) - (setq var (assoc var '(("D" calc-angle-mode deg) - ("R" calc-angle-mode rad) - ("F" calc-prefer-frac t) - ("S" calc-symbolic-mode t))) - value (nth 2 var) var (nth 1 var))) - (if (memq var modes) - (setcar (cdr (memq var modes)) value) - (cons var (cons value modes))) - modes) - -(defun org-table-eval-formula (&optional arg equation - suppress-align suppress-const - suppress-store suppress-analysis) - "Replace the table field value at the cursor by the result of a calculation. - -This function makes use of Dave Gillespie's Calc package, in my view the -most exciting program ever written for GNU Emacs. So you need to have Calc -installed in order to use this function. - -In a table, this command replaces the value in the current field with the -result of a formula. It also installs the formula as the \"current\" column -formula, by storing it in a special line below the table. When called -with a `C-u' prefix, the current field must ba a named field, and the -formula is installed as valid in only this specific field. - -When called with two `C-u' prefixes, insert the active equation -for the field back into the current field, so that it can be -edited there. This is useful in order to use \\[org-table-show-reference] -to check the referenced fields. - -When called, the command first prompts for a formula, which is read in -the minibuffer. Previously entered formulas are available through the -history list, and the last used formula is offered as a default. -These stored formulas are adapted correctly when moving, inserting, or -deleting columns with the corresponding commands. - -The formula can be any algebraic expression understood by the Calc package. -For details, see the Org-mode manual. - -This function can also be called from Lisp programs and offers -additional arguments: EQUATION can be the formula to apply. If this -argument is given, the user will not be prompted. SUPPRESS-ALIGN is -used to speed-up recursive calls by by-passing unnecessary aligns. -SUPPRESS-CONST suppresses the interpretation of constants in the -formula, assuming that this has been done already outside the function. -SUPPRESS-STORE means the formula should not be stored, either because -it is already stored, or because it is a modified equation that should -not overwrite the stored one." - (interactive "P") - (org-table-check-inside-data-field) - (or suppress-analysis (org-table-get-specials)) - (if (equal arg '(16)) - (let ((eq (org-table-current-field-formula))) - (or eq (error "No equation active for current field")) - (org-table-get-field nil eq) - (org-table-align) - (setq org-table-may-need-update t)) - (let* (fields - (ndown (if (integerp arg) arg 1)) - (org-table-automatic-realign nil) - (case-fold-search nil) - (down (> ndown 1)) - (formula (if (and equation suppress-store) - equation - (org-table-get-formula equation (equal arg '(4))))) - (n0 (org-table-current-column)) - (modes (copy-sequence org-calc-default-modes)) - (numbers nil) ; was a variable, now fixed default - (keep-empty nil) - n form form0 bw fmt x ev orig c lispp literal) - ;; Parse the format string. Since we have a lot of modes, this is - ;; a lot of work. However, I think calc still uses most of the time. - (if (string-match ";" formula) - (let ((tmp (org-split-string formula ";"))) - (setq formula (car tmp) - fmt (concat (cdr (assoc "%" org-table-local-parameters)) - (nth 1 tmp))) - (while (string-match "\\([pnfse]\\)\\(-?[0-9]+\\)" fmt) - (setq c (string-to-char (match-string 1 fmt)) - n (string-to-number (match-string 2 fmt))) - (if (= c ?p) - (setq modes (org-set-calc-mode 'calc-internal-prec n)) - (setq modes (org-set-calc-mode - 'calc-float-format - (list (cdr (assoc c '((?n . float) (?f . fix) - (?s . sci) (?e . eng)))) - n)))) - (setq fmt (replace-match "" t t fmt))) - (if (string-match "[NT]" fmt) - (setq numbers (equal (match-string 0 fmt) "N") - fmt (replace-match "" t t fmt))) - (if (string-match "L" fmt) - (setq literal t - fmt (replace-match "" t t fmt))) - (if (string-match "E" fmt) - (setq keep-empty t - fmt (replace-match "" t t fmt))) - (while (string-match "[DRFS]" fmt) - (setq modes (org-set-calc-mode (match-string 0 fmt))) - (setq fmt (replace-match "" t t fmt))) - (unless (string-match "\\S-" fmt) - (setq fmt nil)))) - (if (and (not suppress-const) org-table-formula-use-constants) - (setq formula (org-table-formula-substitute-names formula))) - (setq orig (or (get-text-property 1 :orig-formula formula) "?")) - (while (> ndown 0) - (setq fields (org-split-string - (org-no-properties - (buffer-substring (point-at-bol) (point-at-eol))) - " *| *")) - (if (eq numbers t) - (setq fields (mapcar - (lambda (x) (number-to-string (string-to-number x))) - fields))) - (setq ndown (1- ndown)) - (setq form (copy-sequence formula) - lispp (and (> (length form) 2)(equal (substring form 0 2) "'("))) - (if (and lispp literal) (setq lispp 'literal)) - ;; Check for old vertical references - (setq form (org-rewrite-old-row-references form)) - ;; Insert complex ranges - (while (string-match org-table-range-regexp form) - (setq form - (replace-match - (save-match-data - (org-table-make-reference - (org-table-get-range (match-string 0 form) nil n0) - keep-empty numbers lispp)) - t t form))) - ;; Insert simple ranges - (while (string-match "\\$\\([0-9]+\\)\\.\\.\\$\\([0-9]+\\)" form) - (setq form - (replace-match - (save-match-data - (org-table-make-reference - (org-sublist - fields (string-to-number (match-string 1 form)) - (string-to-number (match-string 2 form))) - keep-empty numbers lispp)) - t t form))) - (setq form0 form) - ;; Insert the references to fields in same row - (while (string-match "\\$\\([0-9]+\\)" form) - (setq n (string-to-number (match-string 1 form)) - x (nth (1- (if (= n 0) n0 n)) fields)) - (unless x (error "Invalid field specifier \"%s\"" - (match-string 0 form))) - (setq form (replace-match - (save-match-data - (org-table-make-reference x nil numbers lispp)) - t t form))) - - (if lispp - (setq ev (condition-case nil - (eval (eval (read form))) - (error "#ERROR")) - ev (if (numberp ev) (number-to-string ev) ev)) - (or (fboundp 'calc-eval) - (error "Calc does not seem to be installed, and is needed to evaluate the formula")) - (setq ev (calc-eval (cons form modes) - (if numbers 'num)))) - - (when org-table-formula-debug - (with-output-to-temp-buffer "*Substitution History*" - (princ (format "Substitution history of formula -Orig: %s -$xyz-> %s -@r$c-> %s -$1-> %s\n" orig formula form0 form)) - (if (listp ev) - (princ (format " %s^\nError: %s" - (make-string (car ev) ?\-) (nth 1 ev))) - (princ (format "Result: %s\nFormat: %s\nFinal: %s" - ev (or fmt "NONE") - (if fmt (format fmt (string-to-number ev)) ev))))) - (setq bw (get-buffer-window "*Substitution History*")) - (shrink-window-if-larger-than-buffer bw) - (unless (and (interactive-p) (not ndown)) - (unless (let (inhibit-redisplay) - (y-or-n-p "Debugging Formula. Continue to next? ")) - (org-table-align) - (error "Abort")) - (delete-window bw) - (message ""))) - (if (listp ev) (setq fmt nil ev "#ERROR")) - (org-table-justify-field-maybe - (if fmt (format fmt (string-to-number ev)) ev)) - (if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]")) - (call-interactively 'org-return) - (setq ndown 0))) - (and down (org-table-maybe-recalculate-line)) - (or suppress-align (and org-table-may-need-update - (org-table-align)))))) - -(defun org-table-put-field-property (prop value) - (save-excursion - (put-text-property (progn (skip-chars-backward "^|") (point)) - (progn (skip-chars-forward "^|") (point)) - prop value))) - -(defun org-table-get-range (desc &optional tbeg col highlight) - "Get a calc vector from a column, accorting to descriptor DESC. -Optional arguments TBEG and COL can give the beginning of the table and -the current column, to avoid unnecessary parsing. -HIGHLIGHT means, just highlight the range." - (if (not (equal (string-to-char desc) ?@)) - (setq desc (concat "@" desc))) - (save-excursion - (or tbeg (setq tbeg (org-table-begin))) - (or col (setq col (org-table-current-column))) - (let ((thisline (org-current-line)) - beg end c1 c2 r1 r2 rangep tmp) - (unless (string-match org-table-range-regexp desc) - (error "Invalid table range specifier `%s'" desc)) - (setq rangep (match-end 3) - r1 (and (match-end 1) (match-string 1 desc)) - r2 (and (match-end 4) (match-string 4 desc)) - c1 (and (match-end 2) (substring (match-string 2 desc) 1)) - c2 (and (match-end 5) (substring (match-string 5 desc) 1))) - - (and c1 (setq c1 (+ (string-to-number c1) - (if (memq (string-to-char c1) '(?- ?+)) col 0)))) - (and c2 (setq c2 (+ (string-to-number c2) - (if (memq (string-to-char c2) '(?- ?+)) col 0)))) - (if (equal r1 "") (setq r1 nil)) - (if (equal r2 "") (setq r2 nil)) - (if r1 (setq r1 (org-table-get-descriptor-line r1))) - (if r2 (setq r2 (org-table-get-descriptor-line r2))) -; (setq r2 (or r2 r1) c2 (or c2 c1)) - (if (not r1) (setq r1 thisline)) - (if (not r2) (setq r2 thisline)) - (if (not c1) (setq c1 col)) - (if (not c2) (setq c2 col)) - (if (or (not rangep) (and (= r1 r2) (= c1 c2))) - ;; just one field - (progn - (goto-line r1) - (while (not (looking-at org-table-dataline-regexp)) - (beginning-of-line 2)) - (prog1 (org-trim (org-table-get-field c1)) - (if highlight (org-table-highlight-rectangle (point) (point))))) - ;; A range, return a vector - ;; First sort the numbers to get a regular ractangle - (if (< r2 r1) (setq tmp r1 r1 r2 r2 tmp)) - (if (< c2 c1) (setq tmp c1 c1 c2 c2 tmp)) - (goto-line r1) - (while (not (looking-at org-table-dataline-regexp)) - (beginning-of-line 2)) - (org-table-goto-column c1) - (setq beg (point)) - (goto-line r2) - (while (not (looking-at org-table-dataline-regexp)) - (beginning-of-line 0)) - (org-table-goto-column c2) - (setq end (point)) - (if highlight - (org-table-highlight-rectangle - beg (progn (skip-chars-forward "^|\n") (point)))) - ;; return string representation of calc vector - (mapcar 'org-trim - (apply 'append (org-table-copy-region beg end))))))) - -(defun org-table-get-descriptor-line (desc &optional cline bline table) - "Analyze descriptor DESC and retrieve the corresponding line number. -The cursor is currently in line CLINE, the table begins in line BLINE, -and TABLE is a vector with line types." - (if (string-match "^[0-9]+$" desc) - (aref org-table-dlines (string-to-number desc)) - (setq cline (or cline (org-current-line)) - bline (or bline org-table-current-begin-line) - table (or table org-table-current-line-types)) - (if (or - (not (string-match "^\\(\\([-+]\\)?\\(I+\\)\\)?\\(\\([-+]\\)?\\([0-9]+\\)\\)?" desc)) - ;; 1 2 3 4 5 6 - (and (not (match-end 3)) (not (match-end 6))) - (and (match-end 3) (match-end 6) (not (match-end 5)))) - (error "invalid row descriptor `%s'" desc)) - (let* ((hdir (and (match-end 2) (match-string 2 desc))) - (hn (if (match-end 3) (- (match-end 3) (match-beginning 3)) nil)) - (odir (and (match-end 5) (match-string 5 desc))) - (on (if (match-end 6) (string-to-number (match-string 6 desc)))) - (i (- cline bline)) - (rel (and (match-end 6) - (or (and (match-end 1) (not (match-end 3))) - (match-end 5))))) - (if (and hn (not hdir)) - (progn - (setq i 0 hdir "+") - (if (eq (aref table 0) 'hline) (setq hn (1- hn))))) - (if (and (not hn) on (not odir)) - (error "should never happen");;(aref org-table-dlines on) - (if (and hn (> hn 0)) - (setq i (org-find-row-type table i 'hline (equal hdir "-") nil hn))) - (if on - (setq i (org-find-row-type table i 'dline (equal odir "-") rel on))) - (+ bline i))))) - -(defun org-find-row-type (table i type backwards relative n) - (let ((l (length table))) - (while (> n 0) - (while (and (setq i (+ i (if backwards -1 1))) - (>= i 0) (< i l) - (not (eq (aref table i) type)) - (if (and relative (eq (aref table i) 'hline)) - (progn (setq i (- i (if backwards -1 1)) n 1) nil) - t))) - (setq n (1- n))) - (if (or (< i 0) (>= i l)) - (error "Row descriptior leads outside table") - i))) - -(defun org-rewrite-old-row-references (s) - (if (string-match "&[-+0-9I]" s) - (error "Formula contains old &row reference, please rewrite using @-syntax") - s)) - -(defun org-table-make-reference (elements keep-empty numbers lispp) - "Convert list ELEMENTS to something appropriate to insert into formula. -KEEP-EMPTY indicated to keep empty fields, default is to skip them. -NUMBERS indicates that everything should be converted to numbers. -LISPP means to return something appropriate for a Lisp list." - (if (stringp elements) ; just a single val - (if lispp - (if (eq lispp 'literal) - elements - (prin1-to-string (if numbers (string-to-number elements) elements))) - (if (equal elements "") (setq elements "0")) - (if numbers (number-to-string (string-to-number elements)) elements)) - (unless keep-empty - (setq elements - (delq nil - (mapcar (lambda (x) (if (string-match "\\S-" x) x nil)) - elements)))) - (setq elements (or elements '("0"))) - (if lispp - (mapconcat - (lambda (x) - (if (eq lispp 'literal) - x - (prin1-to-string (if numbers (string-to-number x) x)))) - elements " ") - (concat "[" (mapconcat - (lambda (x) - (if numbers (number-to-string (string-to-number x)) x)) - elements - ",") "]")))) - -(defun org-table-recalculate (&optional all noalign) - "Recalculate the current table line by applying all stored formulas. -With prefix arg ALL, do this for all lines in the table." - (interactive "P") - (or (memq this-command org-recalc-commands) - (setq org-recalc-commands (cons this-command org-recalc-commands))) - (unless (org-at-table-p) (error "Not at a table")) - (if (equal all '(16)) - (org-table-iterate) - (org-table-get-specials) - (let* ((eqlist (sort (org-table-get-stored-formulas) - (lambda (a b) (string< (car a) (car b))))) - (inhibit-redisplay (not debug-on-error)) - (line-re org-table-dataline-regexp) - (thisline (org-current-line)) - (thiscol (org-table-current-column)) - beg end entry eqlnum eqlname eqlname1 eql (cnt 0) eq a name) - ;; Insert constants in all formulas - (setq eqlist - (mapcar (lambda (x) - (setcdr x (org-table-formula-substitute-names (cdr x))) - x) - eqlist)) - ;; Split the equation list - (while (setq eq (pop eqlist)) - (if (<= (string-to-char (car eq)) ?9) - (push eq eqlnum) - (push eq eqlname))) - (setq eqlnum (nreverse eqlnum) eqlname (nreverse eqlname)) - (if all - (progn - (setq end (move-marker (make-marker) (1+ (org-table-end)))) - (goto-char (setq beg (org-table-begin))) - (if (re-search-forward org-table-calculate-mark-regexp end t) - ;; This is a table with marked lines, compute selected lines - (setq line-re org-table-recalculate-regexp) - ;; Move forward to the first non-header line - (if (and (re-search-forward org-table-dataline-regexp end t) - (re-search-forward org-table-hline-regexp end t) - (re-search-forward org-table-dataline-regexp end t)) - (setq beg (match-beginning 0)) - nil))) ;; just leave beg where it is - (setq beg (point-at-bol) - end (move-marker (make-marker) (1+ (point-at-eol))))) - (goto-char beg) - (and all (message "Re-applying formulas to full table...")) - - ;; First find the named fields, and mark them untouchanble - (remove-text-properties beg end '(org-untouchable t)) - (while (setq eq (pop eqlname)) - (setq name (car eq) - a (assoc name org-table-named-field-locations)) - (and (not a) - (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" name) - (setq a (list name - (aref org-table-dlines - (string-to-number (match-string 1 name))) - (string-to-number (match-string 2 name))))) - (when (and a (or all (equal (nth 1 a) thisline))) - (message "Re-applying formula to field: %s" name) - (goto-line (nth 1 a)) - (org-table-goto-column (nth 2 a)) - (push (append a (list (cdr eq))) eqlname1) - (org-table-put-field-property :org-untouchable t))) - - ;; Now evauluate the column formulas, but skip fields covered by - ;; field formulas - (goto-char beg) - (while (re-search-forward line-re end t) - (unless (string-match "^ *[_^!$/] *$" (org-table-get-field 1)) - ;; Unprotected line, recalculate - (and all (message "Re-applying formulas to full table...(line %d)" - (setq cnt (1+ cnt)))) - (setq org-last-recalc-line (org-current-line)) - (setq eql eqlnum) - (while (setq entry (pop eql)) - (goto-line org-last-recalc-line) - (org-table-goto-column (string-to-number (car entry)) nil 'force) - (unless (get-text-property (point) :org-untouchable) - (org-table-eval-formula nil (cdr entry) - 'noalign 'nocst 'nostore 'noanalysis))))) - - ;; Now evaluate the field formulas - (while (setq eq (pop eqlname1)) - (message "Re-applying formula to field: %s" (car eq)) - (goto-line (nth 1 eq)) - (org-table-goto-column (nth 2 eq)) - (org-table-eval-formula nil (nth 3 eq) 'noalign 'nocst - 'nostore 'noanalysis)) - - (goto-line thisline) - (org-table-goto-column thiscol) - (remove-text-properties (point-min) (point-max) '(org-untouchable t)) - (or noalign (and org-table-may-need-update (org-table-align)) - (and all (message "Re-applying formulas to %d lines...done" cnt))) - - ;; back to initial position - (message "Re-applying formulas...done") - (goto-line thisline) - (org-table-goto-column thiscol) - (or noalign (and org-table-may-need-update (org-table-align)) - (and all (message "Re-applying formulas...done")))))) - -(defun org-table-iterate (&optional arg) - "Recalculate the table until it does not change anymore." - (interactive "P") - (let ((imax (if arg (prefix-numeric-value arg) 10)) - (i 0) - (lasttbl (buffer-substring (org-table-begin) (org-table-end))) - thistbl) - (catch 'exit - (while (< i imax) - (setq i (1+ i)) - (org-table-recalculate 'all) - (setq thistbl (buffer-substring (org-table-begin) (org-table-end))) - (if (not (string= lasttbl thistbl)) - (setq lasttbl thistbl) - (if (> i 1) - (message "Convergence after %d iterations" i) - (message "Table was already stable")) - (throw 'exit t))) - (error "No convergence after %d iterations" i)))) - -(defun org-table-formula-substitute-names (f) - "Replace $const with values in string F." - (let ((start 0) a (f1 f) (pp (/= (string-to-char f) ?'))) - ;; First, check for column names - (while (setq start (string-match org-table-column-name-regexp f start)) - (setq start (1+ start)) - (setq a (assoc (match-string 1 f) org-table-column-names)) - (setq f (replace-match (concat "$" (cdr a)) t t f))) - ;; Parameters and constants - (setq start 0) - (while (setq start (string-match "\\$\\([a-zA-Z][_a-zA-Z0-9]*\\)" f start)) - (setq start (1+ start)) - (if (setq a (save-match-data - (org-table-get-constant (match-string 1 f)))) - (setq f (replace-match - (concat (if pp "(") a (if pp ")")) t t f)))) - (if org-table-formula-debug - (put-text-property 0 (length f) :orig-formula f1 f)) - f)) - -(defun org-table-get-constant (const) - "Find the value for a parameter or constant in a formula. -Parameters get priority." - (or (cdr (assoc const org-table-local-parameters)) - (cdr (assoc const org-table-formula-constants-local)) - (cdr (assoc const org-table-formula-constants)) - (and (fboundp 'constants-get) (constants-get const)) - (and (string= (substring const 0 (min 5 (length const))) "PROP_") - (org-entry-get nil (substring const 5) 'inherit)) - "#UNDEFINED_NAME")) - -(defvar org-table-fedit-map - (let ((map (make-sparse-keymap))) - (org-defkey map "\C-x\C-s" 'org-table-fedit-finish) - (org-defkey map "\C-c\C-s" 'org-table-fedit-finish) - (org-defkey map "\C-c\C-c" 'org-table-fedit-finish) - (org-defkey map "\C-c\C-q" 'org-table-fedit-abort) - (org-defkey map "\C-c?" 'org-table-show-reference) - (org-defkey map [(meta shift up)] 'org-table-fedit-line-up) - (org-defkey map [(meta shift down)] 'org-table-fedit-line-down) - (org-defkey map [(shift up)] 'org-table-fedit-ref-up) - (org-defkey map [(shift down)] 'org-table-fedit-ref-down) - (org-defkey map [(shift left)] 'org-table-fedit-ref-left) - (org-defkey map [(shift right)] 'org-table-fedit-ref-right) - (org-defkey map [(meta up)] 'org-table-fedit-scroll-down) - (org-defkey map [(meta down)] 'org-table-fedit-scroll) - (org-defkey map [(meta tab)] 'lisp-complete-symbol) - (org-defkey map "\M-\C-i" 'lisp-complete-symbol) - (org-defkey map [(tab)] 'org-table-fedit-lisp-indent) - (org-defkey map "\C-i" 'org-table-fedit-lisp-indent) - (org-defkey map "\C-c\C-r" 'org-table-fedit-toggle-ref-type) - (org-defkey map "\C-c}" 'org-table-fedit-toggle-coordinates) - map)) - -(easy-menu-define org-table-fedit-menu org-table-fedit-map "Org Edit Formulas Menu" - '("Edit-Formulas" - ["Finish and Install" org-table-fedit-finish t] - ["Finish, Install, and Apply" (org-table-fedit-finish t) :keys "C-u C-c C-c"] - ["Abort" org-table-fedit-abort t] - "--" - ["Pretty-Print Lisp Formula" org-table-fedit-lisp-indent t] - ["Complete Lisp Symbol" lisp-complete-symbol t] - "--" - "Shift Reference at Point" - ["Up" org-table-fedit-ref-up t] - ["Down" org-table-fedit-ref-down t] - ["Left" org-table-fedit-ref-left t] - ["Right" org-table-fedit-ref-right t] - "-" - "Change Test Row for Column Formulas" - ["Up" org-table-fedit-line-up t] - ["Down" org-table-fedit-line-down t] - "--" - ["Scroll Table Window" org-table-fedit-scroll t] - ["Scroll Table Window down" org-table-fedit-scroll-down t] - ["Show Table Grid" org-table-fedit-toggle-coordinates - :style toggle :selected (with-current-buffer (marker-buffer org-pos) - org-table-overlay-coordinates)] - "--" - ["Standard Refs (B3 instead of @3$2)" org-table-fedit-toggle-ref-type - :style toggle :selected org-table-buffer-is-an])) - -(defvar org-pos) - -(defun org-table-edit-formulas () - "Edit the formulas of the current table in a separate buffer." - (interactive) - (when (save-excursion (beginning-of-line 1) (looking-at "#\\+TBLFM")) - (beginning-of-line 0)) - (unless (org-at-table-p) (error "Not at a table")) - (org-table-get-specials) - (let ((key (org-table-current-field-formula 'key 'noerror)) - (eql (sort (org-table-get-stored-formulas 'noerror) - 'org-table-formula-less-p)) - (pos (move-marker (make-marker) (point))) - (startline 1) - (wc (current-window-configuration)) - (titles '((column . "# Column Formulas\n") - (field . "# Field Formulas\n") - (named . "# Named Field Formulas\n"))) - entry s type title) - (org-switch-to-buffer-other-window "*Edit Formulas*") - (erase-buffer) - ;; Keep global-font-lock-mode from turning on font-lock-mode - (let ((font-lock-global-modes '(not fundamental-mode))) - (fundamental-mode)) - (org-set-local 'font-lock-global-modes (list 'not major-mode)) - (org-set-local 'org-pos pos) - (org-set-local 'org-window-configuration wc) - (use-local-map org-table-fedit-map) - (org-add-hook 'post-command-hook 'org-table-fedit-post-command t t) - (easy-menu-add org-table-fedit-menu) - (setq startline (org-current-line)) - (while (setq entry (pop eql)) - (setq type (cond - ((equal (string-to-char (car entry)) ?@) 'field) - ((string-match "^[0-9]" (car entry)) 'column) - (t 'named))) - (when (setq title (assq type titles)) - (or (bobp) (insert "\n")) - (insert (org-add-props (cdr title) nil 'face font-lock-comment-face)) - (setq titles (delq title titles))) - (if (equal key (car entry)) (setq startline (org-current-line))) - (setq s (concat (if (equal (string-to-char (car entry)) ?@) "" "$") - (car entry) " = " (cdr entry) "\n")) - (remove-text-properties 0 (length s) '(face nil) s) - (insert s)) - (if (eq org-table-use-standard-references t) - (org-table-fedit-toggle-ref-type)) - (goto-line startline) - (message "Edit formulas and finish with `C-c C-c'. See menu for more commands."))) - -(defun org-table-fedit-post-command () - (when (not (memq this-command '(lisp-complete-symbol))) - (let ((win (selected-window))) - (save-excursion - (condition-case nil - (org-table-show-reference) - (error nil)) - (select-window win))))) - -(defun org-table-formula-to-user (s) - "Convert a formula from internal to user representation." - (if (eq org-table-use-standard-references t) - (org-table-convert-refs-to-an s) - s)) - -(defun org-table-formula-from-user (s) - "Convert a formula from user to internal representation." - (if org-table-use-standard-references - (org-table-convert-refs-to-rc s) - s)) - -(defun org-table-convert-refs-to-rc (s) - "Convert spreadsheet references from AB7 to @7$28. -Works for single references, but also for entire formulas and even the -full TBLFM line." - (let ((start 0)) - (while (string-match "\\<\\([a-zA-Z]+\\)\\([0-9]+\\>\\|&\\)\\|\\(;[^\r\n:]+\\)" s start) - (cond - ((match-end 3) - ;; format match, just advance - (setq start (match-end 0))) - ((and (> (match-beginning 0) 0) - (equal ?. (aref s (max (1- (match-beginning 0)) 0))) - (not (equal ?. (aref s (max (- (match-beginning 0) 2) 0))))) - ;; 3.e5 or something like this. - (setq start (match-end 0))) - (t - (setq start (match-beginning 0) - s (replace-match - (if (equal (match-string 2 s) "&") - (format "$%d" (org-letters-to-number (match-string 1 s))) - (format "@%d$%d" - (string-to-number (match-string 2 s)) - (org-letters-to-number (match-string 1 s)))) - t t s))))) - s)) - -(defun org-table-convert-refs-to-an (s) - "Convert spreadsheet references from to @7$28 to AB7. -Works for single references, but also for entire formulas and even the -full TBLFM line." - (while (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" s) - (setq s (replace-match - (format "%s%d" - (org-number-to-letters - (string-to-number (match-string 2 s))) - (string-to-number (match-string 1 s))) - t t s))) - (while (string-match "\\(^\\|[^0-9a-zA-Z]\\)\\$\\([0-9]+\\)" s) - (setq s (replace-match (concat "\\1" - (org-number-to-letters - (string-to-number (match-string 2 s))) "&") - t nil s))) - s) - -(defun org-letters-to-number (s) - "Convert a base 26 number represented by letters into an integer. -For example: AB -> 28." - (let ((n 0)) - (setq s (upcase s)) - (while (> (length s) 0) - (setq n (+ (* n 26) (string-to-char s) (- ?A) 1) - s (substring s 1))) - n)) - -(defun org-number-to-letters (n) - "Convert an integer into a base 26 number represented by letters. -For example: 28 -> AB." - (let ((s "")) - (while (> n 0) - (setq s (concat (char-to-string (+ (mod (1- n) 26) ?A)) s) - n (/ (1- n) 26))) - s)) - -(defun org-table-fedit-convert-buffer (function) - "Convert all references in this buffer, using FUNTION." - (let ((line (org-current-line))) - (goto-char (point-min)) - (while (not (eobp)) - (insert (funcall function (buffer-substring (point) (point-at-eol)))) - (delete-region (point) (point-at-eol)) - (or (eobp) (forward-char 1))) - (goto-line line))) - -(defun org-table-fedit-toggle-ref-type () - "Convert all references in the buffer from B3 to @3$2 and back." - (interactive) - (org-set-local 'org-table-buffer-is-an (not org-table-buffer-is-an)) - (org-table-fedit-convert-buffer - (if org-table-buffer-is-an - 'org-table-convert-refs-to-an 'org-table-convert-refs-to-rc)) - (message "Reference type switched to %s" - (if org-table-buffer-is-an "A1 etc" "@row$column"))) - -(defun org-table-fedit-ref-up () - "Shift the reference at point one row/hline up." - (interactive) - (org-table-fedit-shift-reference 'up)) -(defun org-table-fedit-ref-down () - "Shift the reference at point one row/hline down." - (interactive) - (org-table-fedit-shift-reference 'down)) -(defun org-table-fedit-ref-left () - "Shift the reference at point one field to the left." - (interactive) - (org-table-fedit-shift-reference 'left)) -(defun org-table-fedit-ref-right () - "Shift the reference at point one field to the right." - (interactive) - (org-table-fedit-shift-reference 'right)) - -(defun org-table-fedit-shift-reference (dir) - (cond - ((org-at-regexp-p "\\(\\<[a-zA-Z]\\)&") - (if (memq dir '(left right)) - (org-rematch-and-replace 1 (eq dir 'left)) - (error "Cannot shift reference in this direction"))) - ((org-at-regexp-p "\\(\\<[a-zA-Z]\\{1,2\\}\\)\\([0-9]+\\)") - ;; A B3-like reference - (if (memq dir '(up down)) - (org-rematch-and-replace 2 (eq dir 'up)) - (org-rematch-and-replace 1 (eq dir 'left)))) - ((org-at-regexp-p - "\\(@\\|\\.\\.\\)\\([-+]?\\(I+\\>\\|[0-9]+\\)\\)\\(\\$\\([-+]?[0-9]+\\)\\)?") - ;; An internal reference - (if (memq dir '(up down)) - (org-rematch-and-replace 2 (eq dir 'up) (match-end 3)) - (org-rematch-and-replace 5 (eq dir 'left)))))) - -(defun org-rematch-and-replace (n &optional decr hline) - "Re-match the group N, and replace it with the shifted refrence." - (or (match-end n) (error "Cannot shift reference in this direction")) - (goto-char (match-beginning n)) - (and (looking-at (regexp-quote (match-string n))) - (replace-match (org-shift-refpart (match-string 0) decr hline) - t t))) - -(defun org-shift-refpart (ref &optional decr hline) - "Shift a refrence part REF. -If DECR is set, decrease the references row/column, else increase. -If HLINE is set, this may be a hline reference, it certainly is not -a translation reference." - (save-match-data - (let* ((sign (string-match "^[-+]" ref)) n) - - (if sign (setq sign (substring ref 0 1) ref (substring ref 1))) - (cond - ((and hline (string-match "^I+" ref)) - (setq n (string-to-number (concat sign (number-to-string (length ref))))) - (setq n (+ n (if decr -1 1))) - (if (= n 0) (setq n (+ n (if decr -1 1)))) - (if sign - (setq sign (if (< n 0) "-" "+") n (abs n)) - (setq n (max 1 n))) - (concat sign (make-string n ?I))) - - ((string-match "^[0-9]+" ref) - (setq n (string-to-number (concat sign ref))) - (setq n (+ n (if decr -1 1))) - (if sign - (concat (if (< n 0) "-" "+") (number-to-string (abs n))) - (number-to-string (max 1 n)))) - - ((string-match "^[a-zA-Z]+" ref) - (org-number-to-letters - (max 1 (+ (org-letters-to-number ref) (if decr -1 1))))) - - (t (error "Cannot shift reference")))))) - -(defun org-table-fedit-toggle-coordinates () - "Toggle the display of coordinates in the refrenced table." - (interactive) - (let ((pos (marker-position org-pos))) - (with-current-buffer (marker-buffer org-pos) - (save-excursion - (goto-char pos) - (org-table-toggle-coordinate-overlays))))) - -(defun org-table-fedit-finish (&optional arg) - "Parse the buffer for formula definitions and install them. -With prefix ARG, apply the new formulas to the table." - (interactive "P") - (org-table-remove-rectangle-highlight) - (if org-table-use-standard-references - (progn - (org-table-fedit-convert-buffer 'org-table-convert-refs-to-rc) - (setq org-table-buffer-is-an nil))) - (let ((pos org-pos) eql var form) - (goto-char (point-min)) - (while (re-search-forward - "^\\(@[0-9]+\\$[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)" - nil t) - (setq var (if (match-end 2) (match-string 2) (match-string 1)) - form (match-string 3)) - (setq form (org-trim form)) - (when (not (equal form "")) - (while (string-match "[ \t]*\n[ \t]*" form) - (setq form (replace-match " " t t form))) - (when (assoc var eql) - (error "Double formulas for %s" var)) - (push (cons var form) eql))) - (setq org-pos nil) - (set-window-configuration org-window-configuration) - (select-window (get-buffer-window (marker-buffer pos))) - (goto-char pos) - (unless (org-at-table-p) - (error "Lost table position - cannot install formulae")) - (org-table-store-formulas eql) - (move-marker pos nil) - (kill-buffer "*Edit Formulas*") - (if arg - (org-table-recalculate 'all) - (message "New formulas installed - press C-u C-c C-c to apply.")))) - -(defun org-table-fedit-abort () - "Abort editing formulas, without installing the changes." - (interactive) - (org-table-remove-rectangle-highlight) - (let ((pos org-pos)) - (set-window-configuration org-window-configuration) - (select-window (get-buffer-window (marker-buffer pos))) - (goto-char pos) - (move-marker pos nil) - (message "Formula editing aborted without installing changes"))) - -(defun org-table-fedit-lisp-indent () - "Pretty-print and re-indent Lisp expressions in the Formula Editor." - (interactive) - (let ((pos (point)) beg end ind) - (beginning-of-line 1) - (cond - ((looking-at "[ \t]") - (goto-char pos) - (call-interactively 'lisp-indent-line)) - ((looking-at "[$&@0-9a-zA-Z]+ *= *[^ \t\n']") (goto-char pos)) - ((not (fboundp 'pp-buffer)) - (error "Cannot pretty-print. Command `pp-buffer' is not available.")) - ((looking-at "[$&@0-9a-zA-Z]+ *= *'(") - (goto-char (- (match-end 0) 2)) - (setq beg (point)) - (setq ind (make-string (current-column) ?\ )) - (condition-case nil (forward-sexp 1) - (error - (error "Cannot pretty-print Lisp expression: Unbalanced parenthesis"))) - (setq end (point)) - (save-restriction - (narrow-to-region beg end) - (if (eq last-command this-command) - (progn - (goto-char (point-min)) - (setq this-command nil) - (while (re-search-forward "[ \t]*\n[ \t]*" nil t) - (replace-match " "))) - (pp-buffer) - (untabify (point-min) (point-max)) - (goto-char (1+ (point-min))) - (while (re-search-forward "^." nil t) - (beginning-of-line 1) - (insert ind)) - (goto-char (point-max)) - (backward-delete-char 1))) - (goto-char beg)) - (t nil)))) - -(defvar org-show-positions nil) - -(defun org-table-show-reference (&optional local) - "Show the location/value of the $ expression at point." - (interactive) - (org-table-remove-rectangle-highlight) - (catch 'exit - (let ((pos (if local (point) org-pos)) - (face2 'highlight) - (org-inhibit-highlight-removal t) - (win (selected-window)) - (org-show-positions nil) - var name e what match dest) - (if local (org-table-get-specials)) - (setq what (cond - ((or (org-at-regexp-p org-table-range-regexp2) - (org-at-regexp-p org-table-translate-regexp) - (org-at-regexp-p org-table-range-regexp)) - (setq match - (save-match-data - (org-table-convert-refs-to-rc (match-string 0)))) - 'range) - ((org-at-regexp-p "\\$[a-zA-Z][a-zA-Z0-9]*") 'name) - ((org-at-regexp-p "\\$[0-9]+") 'column) - ((not local) nil) - (t (error "No reference at point"))) - match (and what (or match (match-string 0)))) - (when (and match (not (equal (match-beginning 0) (point-at-bol)))) - (org-table-add-rectangle-overlay (match-beginning 0) (match-end 0) - 'secondary-selection)) - (org-add-hook 'before-change-functions - 'org-table-remove-rectangle-highlight) - (if (eq what 'name) (setq var (substring match 1))) - (when (eq what 'range) - (or (equal (string-to-char match) ?@) (setq match (concat "@" match))) - (setq match (org-table-formula-substitute-names match))) - (unless local - (save-excursion - (end-of-line 1) - (re-search-backward "^\\S-" nil t) - (beginning-of-line 1) - (when (looking-at "\\(\\$[0-9a-zA-Z]+\\|@[0-9]+\\$[0-9]+\\|[a-zA-Z]+\\([0-9]+\\|&\\)\\) *=") - (setq dest - (save-match-data - (org-table-convert-refs-to-rc (match-string 1)))) - (org-table-add-rectangle-overlay - (match-beginning 1) (match-end 1) face2)))) - (if (and (markerp pos) (marker-buffer pos)) - (if (get-buffer-window (marker-buffer pos)) - (select-window (get-buffer-window (marker-buffer pos))) - (org-switch-to-buffer-other-window (get-buffer-window - (marker-buffer pos))))) - (goto-char pos) - (org-table-force-dataline) - (when dest - (setq name (substring dest 1)) - (cond - ((string-match "^\\$[a-zA-Z][a-zA-Z0-9]*" dest) - (setq e (assoc name org-table-named-field-locations)) - (goto-line (nth 1 e)) - (org-table-goto-column (nth 2 e))) - ((string-match "^@\\([0-9]+\\)\\$\\([0-9]+\\)" dest) - (let ((l (string-to-number (match-string 1 dest))) - (c (string-to-number (match-string 2 dest)))) - (goto-line (aref org-table-dlines l)) - (org-table-goto-column c))) - (t (org-table-goto-column (string-to-number name)))) - (move-marker pos (point)) - (org-table-highlight-rectangle nil nil face2)) - (cond - ((equal dest match)) - ((not match)) - ((eq what 'range) - (condition-case nil - (save-excursion - (org-table-get-range match nil nil 'highlight)) - (error nil))) - ((setq e (assoc var org-table-named-field-locations)) - (goto-line (nth 1 e)) - (org-table-goto-column (nth 2 e)) - (org-table-highlight-rectangle (point) (point)) - (message "Named field, column %d of line %d" (nth 2 e) (nth 1 e))) - ((setq e (assoc var org-table-column-names)) - (org-table-goto-column (string-to-number (cdr e))) - (org-table-highlight-rectangle (point) (point)) - (goto-char (org-table-begin)) - (if (re-search-forward (concat "^[ \t]*| *! *.*?| *\\(" var "\\) *|") - (org-table-end) t) - (progn - (goto-char (match-beginning 1)) - (org-table-highlight-rectangle) - (message "Named column (column %s)" (cdr e))) - (error "Column name not found"))) - ((eq what 'column) - ;; column number - (org-table-goto-column (string-to-number (substring match 1))) - (org-table-highlight-rectangle (point) (point)) - (message "Column %s" (substring match 1))) - ((setq e (assoc var org-table-local-parameters)) - (goto-char (org-table-begin)) - (if (re-search-forward (concat "^[ \t]*| *\\$ *.*?| *\\(" var "=\\)") nil t) - (progn - (goto-char (match-beginning 1)) - (org-table-highlight-rectangle) - (message "Local parameter.")) - (error "Parameter not found"))) - (t - (cond - ((not var) (error "No reference at point")) - ((setq e (assoc var org-table-formula-constants-local)) - (message "Local Constant: $%s=%s in #+CONSTANTS line." - var (cdr e))) - ((setq e (assoc var org-table-formula-constants)) - (message "Constant: $%s=%s in `org-table-formula-constants'." - var (cdr e))) - ((setq e (and (fboundp 'constants-get) (constants-get var))) - (message "Constant: $%s=%s, from `constants.el'%s." - var e (format " (%s units)" constants-unit-system))) - (t (error "Undefined name $%s" var))))) - (goto-char pos) - (when (and org-show-positions - (not (memq this-command '(org-table-fedit-scroll - org-table-fedit-scroll-down)))) - (push pos org-show-positions) - (push org-table-current-begin-pos org-show-positions) - (let ((min (apply 'min org-show-positions)) - (max (apply 'max org-show-positions))) - (goto-char min) (recenter 0) - (goto-char max) - (or (pos-visible-in-window-p max) (recenter -1)))) - (select-window win)))) - -(defun org-table-force-dataline () - "Make sure the cursor is in a dataline in a table." - (unless (save-excursion - (beginning-of-line 1) - (looking-at org-table-dataline-regexp)) - (let* ((re org-table-dataline-regexp) - (p1 (save-excursion (re-search-forward re nil 'move))) - (p2 (save-excursion (re-search-backward re nil 'move)))) - (cond ((and p1 p2) - (goto-char (if (< (abs (- p1 (point))) (abs (- p2 (point)))) - p1 p2))) - ((or p1 p2) (goto-char (or p1 p2))) - (t (error "No table dataline around here")))))) - -(defun org-table-fedit-line-up () - "Move cursor one line up in the window showing the table." - (interactive) - (org-table-fedit-move 'previous-line)) - -(defun org-table-fedit-line-down () - "Move cursor one line down in the window showing the table." - (interactive) - (org-table-fedit-move 'next-line)) - -(defun org-table-fedit-move (command) - "Move the cursor in the window shoinw the table. -Use COMMAND to do the motion, repeat if necessary to end up in a data line." - (let ((org-table-allow-automatic-line-recalculation nil) - (pos org-pos) (win (selected-window)) p) - (select-window (get-buffer-window (marker-buffer org-pos))) - (setq p (point)) - (call-interactively command) - (while (and (org-at-table-p) - (org-at-table-hline-p)) - (call-interactively command)) - (or (org-at-table-p) (goto-char p)) - (move-marker pos (point)) - (select-window win))) - -(defun org-table-fedit-scroll (N) - (interactive "p") - (let ((other-window-scroll-buffer (marker-buffer org-pos))) - (scroll-other-window N))) - -(defun org-table-fedit-scroll-down (N) - (interactive "p") - (org-table-fedit-scroll (- N))) - -(defvar org-table-rectangle-overlays nil) - -(defun org-table-add-rectangle-overlay (beg end &optional face) - "Add a new overlay." - (let ((ov (org-make-overlay beg end))) - (org-overlay-put ov 'face (or face 'secondary-selection)) - (push ov org-table-rectangle-overlays))) - -(defun org-table-highlight-rectangle (&optional beg end face) - "Highlight rectangular region in a table." - (setq beg (or beg (point)) end (or end (point))) - (let ((b (min beg end)) - (e (max beg end)) - l1 c1 l2 c2 tmp) - (and (boundp 'org-show-positions) - (setq org-show-positions (cons b (cons e org-show-positions)))) - (goto-char (min beg end)) - (setq l1 (org-current-line) - c1 (org-table-current-column)) - (goto-char (max beg end)) - (setq l2 (org-current-line) - c2 (org-table-current-column)) - (if (> c1 c2) (setq tmp c1 c1 c2 c2 tmp)) - (goto-line l1) - (beginning-of-line 1) - (loop for line from l1 to l2 do - (when (looking-at org-table-dataline-regexp) - (org-table-goto-column c1) - (skip-chars-backward "^|\n") (setq beg (point)) - (org-table-goto-column c2) - (skip-chars-forward "^|\n") (setq end (point)) - (org-table-add-rectangle-overlay beg end face)) - (beginning-of-line 2)) - (goto-char b)) - (add-hook 'before-change-functions 'org-table-remove-rectangle-highlight)) - -(defun org-table-remove-rectangle-highlight (&rest ignore) - "Remove the rectangle overlays." - (unless org-inhibit-highlight-removal - (remove-hook 'before-change-functions 'org-table-remove-rectangle-highlight) - (mapc 'org-delete-overlay org-table-rectangle-overlays) - (setq org-table-rectangle-overlays nil))) - -(defvar org-table-coordinate-overlays nil - "Collects the cooordinate grid overlays, so that they can be removed.") -(make-variable-buffer-local 'org-table-coordinate-overlays) - -(defun org-table-overlay-coordinates () - "Add overlays to the table at point, to show row/column coordinates." - (interactive) - (mapc 'org-delete-overlay org-table-coordinate-overlays) - (setq org-table-coordinate-overlays nil) - (save-excursion - (let ((id 0) (ih 0) hline eol s1 s2 str ic ov beg) - (goto-char (org-table-begin)) - (while (org-at-table-p) - (setq eol (point-at-eol)) - (setq ov (org-make-overlay (point-at-bol) (1+ (point-at-bol)))) - (push ov org-table-coordinate-overlays) - (setq hline (looking-at org-table-hline-regexp)) - (setq str (if hline (format "I*%-2d" (setq ih (1+ ih))) - (format "%4d" (setq id (1+ id))))) - (org-overlay-before-string ov str 'org-special-keyword 'evaporate) - (when hline - (setq ic 0) - (while (re-search-forward "[+|]\\(-+\\)" eol t) - (setq beg (1+ (match-beginning 0)) - ic (1+ ic) - s1 (concat "$" (int-to-string ic)) - s2 (org-number-to-letters ic) - str (if (eq org-table-use-standard-references t) s2 s1)) - (setq ov (org-make-overlay beg (+ beg (length str)))) - (push ov org-table-coordinate-overlays) - (org-overlay-display ov str 'org-special-keyword 'evaporate))) - (beginning-of-line 2))))) - -(defun org-table-toggle-coordinate-overlays () - "Toggle the display of Row/Column numbers in tables." - (interactive) - (setq org-table-overlay-coordinates (not org-table-overlay-coordinates)) - (message "Row/Column number display turned %s" - (if org-table-overlay-coordinates "on" "off")) - (if (and (org-at-table-p) org-table-overlay-coordinates) - (org-table-align)) - (unless org-table-overlay-coordinates - (mapc 'org-delete-overlay org-table-coordinate-overlays) - (setq org-table-coordinate-overlays nil))) - -(defun org-table-toggle-formula-debugger () - "Toggle the formula debugger in tables." - (interactive) - (setq org-table-formula-debug (not org-table-formula-debug)) - (message "Formula debugging has been turned %s" - (if org-table-formula-debug "on" "off"))) - -;;; The orgtbl minor mode - -;; Define a minor mode which can be used in other modes in order to -;; integrate the org-mode table editor. - -;; This is really a hack, because the org-mode table editor uses several -;; keys which normally belong to the major mode, for example the TAB and -;; RET keys. Here is how it works: The minor mode defines all the keys -;; necessary to operate the table editor, but wraps the commands into a -;; function which tests if the cursor is currently inside a table. If that -;; is the case, the table editor command is executed. However, when any of -;; those keys is used outside a table, the function uses `key-binding' to -;; look up if the key has an associated command in another currently active -;; keymap (minor modes, major mode, global), and executes that command. -;; There might be problems if any of the keys used by the table editor is -;; otherwise used as a prefix key. - -;; Another challenge is that the key binding for TAB can be tab or \C-i, -;; likewise the binding for RET can be return or \C-m. Orgtbl-mode -;; addresses this by checking explicitly for both bindings. - -;; The optimized version (see variable `orgtbl-optimized') takes over -;; all keys which are bound to `self-insert-command' in the *global map*. -;; Some modes bind other commands to simple characters, for example -;; AUCTeX binds the double quote to `Tex-insert-quote'. With orgtbl-mode -;; active, this binding is ignored inside tables and replaced with a -;; modified self-insert. - -(defvar orgtbl-mode nil - "Variable controlling `orgtbl-mode', a minor mode enabling the `org-mode' -table editor in arbitrary modes.") -(make-variable-buffer-local 'orgtbl-mode) - -(defvar orgtbl-mode-map (make-keymap) - "Keymap for `orgtbl-mode'.") - -;;;###autoload -(defun turn-on-orgtbl () - "Unconditionally turn on `orgtbl-mode'." - (orgtbl-mode 1)) - -(defvar org-old-auto-fill-inhibit-regexp nil - "Local variable used by `orgtbl-mode'") - -(defconst orgtbl-line-start-regexp "[ \t]*\\(|\\|#\\+\\(TBLFM\\|ORGTBL\\):\\)" - "Matches a line belonging to an orgtbl.") - -(defconst orgtbl-extra-font-lock-keywords - (list (list (concat "^" orgtbl-line-start-regexp ".*") - 0 (quote 'org-table) 'prepend)) - "Extra font-lock-keywords to be added when orgtbl-mode is active.") - -;;;###autoload -(defun orgtbl-mode (&optional arg) - "The `org-mode' table editor as a minor mode for use in other modes." - (interactive) - (if (org-mode-p) - ;; Exit without error, in case some hook functions calls this - ;; by accident in org-mode. - (message "Orgtbl-mode is not useful in org-mode, command ignored") - (setq orgtbl-mode - (if arg (> (prefix-numeric-value arg) 0) (not orgtbl-mode))) - (if orgtbl-mode - (progn - (and (orgtbl-setup) (defun orgtbl-setup () nil)) - ;; Make sure we are first in minor-mode-map-alist - (let ((c (assq 'orgtbl-mode minor-mode-map-alist))) - (and c (setq minor-mode-map-alist - (cons c (delq c minor-mode-map-alist))))) - (org-set-local (quote org-table-may-need-update) t) - (org-add-hook 'before-change-functions 'org-before-change-function - nil 'local) - (org-set-local 'org-old-auto-fill-inhibit-regexp - auto-fill-inhibit-regexp) - (org-set-local 'auto-fill-inhibit-regexp - (if auto-fill-inhibit-regexp - (concat orgtbl-line-start-regexp "\\|" - auto-fill-inhibit-regexp) - orgtbl-line-start-regexp)) - (org-add-to-invisibility-spec '(org-cwidth)) - (when (fboundp 'font-lock-add-keywords) - (font-lock-add-keywords nil orgtbl-extra-font-lock-keywords) - (org-restart-font-lock)) - (easy-menu-add orgtbl-mode-menu) - (run-hooks 'orgtbl-mode-hook)) - (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp) - (org-cleanup-narrow-column-properties) - (org-remove-from-invisibility-spec '(org-cwidth)) - (remove-hook 'before-change-functions 'org-before-change-function t) - (when (fboundp 'font-lock-remove-keywords) - (font-lock-remove-keywords nil orgtbl-extra-font-lock-keywords) - (org-restart-font-lock)) - (easy-menu-remove orgtbl-mode-menu) - (force-mode-line-update 'all)))) - -(defun org-cleanup-narrow-column-properties () - "Remove all properties related to narrow-column invisibility." - (let ((s 1)) - (while (setq s (text-property-any s (point-max) - 'display org-narrow-column-arrow)) - (remove-text-properties s (1+ s) '(display t))) - (setq s 1) - (while (setq s (text-property-any s (point-max) 'org-cwidth 1)) - (remove-text-properties s (1+ s) '(org-cwidth t))) - (setq s 1) - (while (setq s (text-property-any s (point-max) 'invisible 'org-cwidth)) - (remove-text-properties s (1+ s) '(invisible t))))) - -;; Install it as a minor mode. -(put 'orgtbl-mode :included t) -(put 'orgtbl-mode :menu-tag "Org Table Mode") -(add-minor-mode 'orgtbl-mode " OrgTbl" orgtbl-mode-map) - -(defun orgtbl-make-binding (fun n &rest keys) - "Create a function for binding in the table minor mode. -FUN is the command to call inside a table. N is used to create a unique -command name. KEYS are keys that should be checked in for a command -to execute outside of tables." - (eval - (list 'defun - (intern (concat "orgtbl-hijacker-command-" (int-to-string n))) - '(arg) - (concat "In tables, run `" (symbol-name fun) "'.\n" - "Outside of tables, run the binding of `" - (mapconcat (lambda (x) (format "%s" x)) keys "' or `") - "'.") - '(interactive "p") - (list 'if - '(org-at-table-p) - (list 'call-interactively (list 'quote fun)) - (list 'let '(orgtbl-mode) - (list 'call-interactively - (append '(or) - (mapcar (lambda (k) - (list 'key-binding k)) - keys) - '('orgtbl-error)))))))) - -(defun orgtbl-error () - "Error when there is no default binding for a table key." - (interactive) - (error "This key has no function outside tables")) - -(defun orgtbl-setup () - "Setup orgtbl keymaps." - (let ((nfunc 0) - (bindings - (list - '([(meta shift left)] org-table-delete-column) - '([(meta left)] org-table-move-column-left) - '([(meta right)] org-table-move-column-right) - '([(meta shift right)] org-table-insert-column) - '([(meta shift up)] org-table-kill-row) - '([(meta shift down)] org-table-insert-row) - '([(meta up)] org-table-move-row-up) - '([(meta down)] org-table-move-row-down) - '("\C-c\C-w" org-table-cut-region) - '("\C-c\M-w" org-table-copy-region) - '("\C-c\C-y" org-table-paste-rectangle) - '("\C-c-" org-table-insert-hline) - '("\C-c}" org-table-toggle-coordinate-overlays) - '("\C-c{" org-table-toggle-formula-debugger) - '("\C-m" org-table-next-row) - '([(shift return)] org-table-copy-down) - '("\C-c\C-q" org-table-wrap-region) - '("\C-c?" org-table-field-info) - '("\C-c " org-table-blank-field) - '("\C-c+" org-table-sum) - '("\C-c=" org-table-eval-formula) - '("\C-c'" org-table-edit-formulas) - '("\C-c`" org-table-edit-field) - '("\C-c*" org-table-recalculate) - '("\C-c|" org-table-create-or-convert-from-region) - '("\C-c^" org-table-sort-lines) - '([(control ?#)] org-table-rotate-recalc-marks))) - elt key fun cmd) - (while (setq elt (pop bindings)) - (setq nfunc (1+ nfunc)) - (setq key (org-key (car elt)) - fun (nth 1 elt) - cmd (orgtbl-make-binding fun nfunc key)) - (org-defkey orgtbl-mode-map key cmd)) - - ;; Special treatment needed for TAB and RET - (org-defkey orgtbl-mode-map [(return)] - (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m")) - (org-defkey orgtbl-mode-map "\C-m" - (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)])) - - (org-defkey orgtbl-mode-map [(tab)] - (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i")) - (org-defkey orgtbl-mode-map "\C-i" - (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)])) - - (org-defkey orgtbl-mode-map [(shift tab)] - (orgtbl-make-binding 'org-table-previous-field 104 - [(shift tab)] [(tab)] "\C-i")) - - (org-defkey orgtbl-mode-map "\M-\C-m" - (orgtbl-make-binding 'org-table-wrap-region 105 - "\M-\C-m" [(meta return)])) - (org-defkey orgtbl-mode-map [(meta return)] - (orgtbl-make-binding 'org-table-wrap-region 106 - [(meta return)] "\M-\C-m")) - - (org-defkey orgtbl-mode-map "\C-c\C-c" 'orgtbl-ctrl-c-ctrl-c) - (when orgtbl-optimized - ;; If the user wants maximum table support, we need to hijack - ;; some standard editing functions - (org-remap orgtbl-mode-map - 'self-insert-command 'orgtbl-self-insert-command - 'delete-char 'org-delete-char - 'delete-backward-char 'org-delete-backward-char) - (org-defkey orgtbl-mode-map "|" 'org-force-self-insert)) - (easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu" - '("OrgTbl" - ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"] - ["Next Field" org-cycle :active (org-at-table-p) :keys "TAB"] - ["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"] - ["Next Row" org-return :active (org-at-table-p) :keys "RET"] - "--" - ["Blank Field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"] - ["Edit Field" org-table-edit-field :active (org-at-table-p) :keys "C-c ` "] - ["Copy Field from Above" - org-table-copy-down :active (org-at-table-p) :keys "S-RET"] - "--" - ("Column" - ["Move Column Left" org-metaleft :active (org-at-table-p) :keys "M-"] - ["Move Column Right" org-metaright :active (org-at-table-p) :keys "M-"] - ["Delete Column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-"] - ["Insert Column" org-shiftmetaright :active (org-at-table-p) :keys "M-S-"]) - ("Row" - ["Move Row Up" org-metaup :active (org-at-table-p) :keys "M-"] - ["Move Row Down" org-metadown :active (org-at-table-p) :keys "M-"] - ["Delete Row" org-shiftmetaup :active (org-at-table-p) :keys "M-S-"] - ["Insert Row" org-shiftmetadown :active (org-at-table-p) :keys "M-S-"] - ["Sort lines in region" org-table-sort-lines (org-at-table-p) :keys "C-c ^"] - "--" - ["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"]) - ("Rectangle" - ["Copy Rectangle" org-copy-special :active (org-at-table-p)] - ["Cut Rectangle" org-cut-special :active (org-at-table-p)] - ["Paste Rectangle" org-paste-special :active (org-at-table-p)] - ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p)]) - "--" - ("Radio tables" - ["Insert table template" orgtbl-insert-radio-table - (assq major-mode orgtbl-radio-table-templates)] - ["Comment/uncomment table" orgtbl-toggle-comment t]) - "--" - ["Set Column Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="] - ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="] - ["Edit Formulas" org-table-edit-formulas :active (org-at-table-p) :keys "C-c '"] - ["Recalculate line" org-table-recalculate :active (org-at-table-p) :keys "C-c *"] - ["Recalculate all" (org-table-recalculate '(4)) :active (org-at-table-p) :keys "C-u C-c *"] - ["Iterate all" (org-table-recalculate '(16)) :active (org-at-table-p) :keys "C-u C-u C-c *"] - ["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"] - ["Sum Column/Rectangle" org-table-sum - :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"] - ["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"] - ["Debug Formulas" - org-table-toggle-formula-debugger :active (org-at-table-p) - :keys "C-c {" - :style toggle :selected org-table-formula-debug] - ["Show Col/Row Numbers" - org-table-toggle-coordinate-overlays :active (org-at-table-p) - :keys "C-c }" - :style toggle :selected org-table-overlay-coordinates] - )) - t)) - -(defun orgtbl-ctrl-c-ctrl-c (arg) - "If the cursor is inside a table, realign the table. -It it is a table to be sent away to a receiver, do it. -With prefix arg, also recompute table." - (interactive "P") - (let ((pos (point)) action) - (save-excursion - (beginning-of-line 1) - (setq action (cond ((looking-at "#\\+ORGTBL:.*\n[ \t]*|") (match-end 0)) - ((looking-at "[ \t]*|") pos) - ((looking-at "#\\+TBLFM:") 'recalc)))) - (cond - ((integerp action) - (goto-char action) - (org-table-maybe-eval-formula) - (if arg - (call-interactively 'org-table-recalculate) - (org-table-maybe-recalculate-line)) - (call-interactively 'org-table-align) - (orgtbl-send-table 'maybe)) - ((eq action 'recalc) - (save-excursion - (beginning-of-line 1) - (skip-chars-backward " \r\n\t") - (if (org-at-table-p) - (org-call-with-arg 'org-table-recalculate t)))) - (t (let (orgtbl-mode) - (call-interactively (key-binding "\C-c\C-c"))))))) - -(defun orgtbl-tab (arg) - "Justification and field motion for `orgtbl-mode'." - (interactive "P") - (if arg (org-table-edit-field t) - (org-table-justify-field-maybe) - (org-table-next-field))) - -(defun orgtbl-ret () - "Justification and field motion for `orgtbl-mode'." - (interactive) - (org-table-justify-field-maybe) - (org-table-next-row)) - -(defun orgtbl-self-insert-command (N) - "Like `self-insert-command', use overwrite-mode for whitespace in tables. -If the cursor is in a table looking at whitespace, the whitespace is -overwritten, and the table is not marked as requiring realignment." - (interactive "p") - (if (and (org-at-table-p) - (or - (and org-table-auto-blank-field - (member last-command - '(orgtbl-hijacker-command-100 - orgtbl-hijacker-command-101 - orgtbl-hijacker-command-102 - orgtbl-hijacker-command-103 - orgtbl-hijacker-command-104 - orgtbl-hijacker-command-105)) - (org-table-blank-field)) - t) - (eq N 1) - (looking-at "[^|\n]* +|")) - (let (org-table-may-need-update) - (goto-char (1- (match-end 0))) - (delete-backward-char 1) - (goto-char (match-beginning 0)) - (self-insert-command N)) - (setq org-table-may-need-update t) - (let (orgtbl-mode) - (call-interactively (key-binding (vector last-input-event)))))) - -(defun org-force-self-insert (N) - "Needed to enforce self-insert under remapping." - (interactive "p") - (self-insert-command N)) - -(defvar orgtbl-exp-regexp "^\\([-+]?[0-9][0-9.]*\\)[eE]\\([-+]?[0-9]+\\)$" - "Regula expression matching exponentials as produced by calc.") - -(defvar org-table-clean-did-remove-column nil) - -(defun orgtbl-export (table target) - (let ((func (intern (concat "orgtbl-to-" (symbol-name target)))) - (lines (org-split-string table "[ \t]*\n[ \t]*")) - org-table-last-alignment org-table-last-column-widths - maxcol column) - (if (not (fboundp func)) - (error "Cannot export orgtbl table to %s" target)) - (setq lines (org-table-clean-before-export lines)) - (setq table - (mapcar - (lambda (x) - (if (string-match org-table-hline-regexp x) - 'hline - (org-split-string (org-trim x) "\\s-*|\\s-*"))) - lines)) - (setq maxcol (apply 'max (mapcar (lambda (x) (if (listp x) (length x) 0)) - table))) - (loop for i from (1- maxcol) downto 0 do - (setq column (mapcar (lambda (x) (if (listp x) (nth i x) nil)) table)) - (setq column (delq nil column)) - (push (apply 'max (mapcar 'string-width column)) org-table-last-column-widths) - (push (> (/ (apply '+ (mapcar (lambda (x) (if (string-match org-table-number-regexp x) 1 0)) column)) maxcol) org-table-number-fraction) org-table-last-alignment)) - (funcall func table nil))) - -(defun orgtbl-send-table (&optional maybe) - "Send a tranformed version of this table to the receiver position. -With argument MAYBE, fail quietly if no transformation is defined for -this table." - (interactive) - (catch 'exit - (unless (org-at-table-p) (error "Not at a table")) - ;; when non-interactive, we assume align has just happened. - (when (interactive-p) (org-table-align)) - (save-excursion - (goto-char (org-table-begin)) - (beginning-of-line 0) - (unless (looking-at "#\\+ORGTBL: *SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?") - (if maybe - (throw 'exit nil) - (error "Don't know how to transform this table.")))) - (let* ((name (match-string 1)) - beg - (transform (intern (match-string 2))) - (params (if (match-end 3) (read (concat "(" (match-string 3) ")")))) - (skip (plist-get params :skip)) - (skipcols (plist-get params :skipcols)) - (txt (buffer-substring-no-properties - (org-table-begin) (org-table-end))) - (lines (nthcdr (or skip 0) (org-split-string txt "[ \t]*\n[ \t]*"))) - (lines (org-table-clean-before-export lines)) - (i0 (if org-table-clean-did-remove-column 2 1)) - (table (mapcar - (lambda (x) - (if (string-match org-table-hline-regexp x) - 'hline - (org-remove-by-index - (org-split-string (org-trim x) "\\s-*|\\s-*") - skipcols i0))) - lines)) - (fun (if (= i0 2) 'cdr 'identity)) - (org-table-last-alignment - (org-remove-by-index (funcall fun org-table-last-alignment) - skipcols i0)) - (org-table-last-column-widths - (org-remove-by-index (funcall fun org-table-last-column-widths) - skipcols i0))) - - (unless (fboundp transform) - (error "No such transformation function %s" transform)) - (setq txt (funcall transform table params)) - ;; Find the insertion place - (save-excursion - (goto-char (point-min)) - (unless (re-search-forward - (concat "BEGIN RECEIVE ORGTBL +" name "\\([ \t]\\|$\\)") nil t) - (error "Don't know where to insert translated table")) - (goto-char (match-beginning 0)) - (beginning-of-line 2) - (setq beg (point)) - (unless (re-search-forward (concat "END RECEIVE ORGTBL +" name) nil t) - (error "Cannot find end of insertion region")) - (beginning-of-line 1) - (delete-region beg (point)) - (goto-char beg) - (insert txt "\n")) - (message "Table converted and installed at receiver location")))) - -(defun org-remove-by-index (list indices &optional i0) - "Remove the elements in LIST with indices in INDICES. -First element has index 0, or I0 if given." - (if (not indices) - list - (if (integerp indices) (setq indices (list indices))) - (setq i0 (1- (or i0 0))) - (delq :rm (mapcar (lambda (x) - (setq i0 (1+ i0)) - (if (memq i0 indices) :rm x)) - list)))) - -(defun orgtbl-toggle-comment () - "Comment or uncomment the orgtbl at point." - (interactive) - (let* ((re1 (concat "^" (regexp-quote comment-start) orgtbl-line-start-regexp)) - (re2 (concat "^" orgtbl-line-start-regexp)) - (commented (save-excursion (beginning-of-line 1) - (cond ((looking-at re1) t) - ((looking-at re2) nil) - (t (error "Not at an org table"))))) - (re (if commented re1 re2)) - beg end) - (save-excursion - (beginning-of-line 1) - (while (looking-at re) (beginning-of-line 0)) - (beginning-of-line 2) - (setq beg (point)) - (while (looking-at re) (beginning-of-line 2)) - (setq end (point))) - (comment-region beg end (if commented '(4) nil)))) - -(defun orgtbl-insert-radio-table () - "Insert a radio table template appropriate for this major mode." - (interactive) - (let* ((e (assq major-mode orgtbl-radio-table-templates)) - (txt (nth 1 e)) - name pos) - (unless e (error "No radio table setup defined for %s" major-mode)) - (setq name (read-string "Table name: ")) - (while (string-match "%n" txt) - (setq txt (replace-match name t t txt))) - (or (bolp) (insert "\n")) - (setq pos (point)) - (insert txt) - (goto-char pos))) - -(defun org-get-param (params header i sym &optional hsym) - "Get parameter value for symbol SYM. -If this is a header line, actually get the value for the symbol with an -additional \"h\" inserted after the colon. -If the value is a protperty list, get the element for the current column. -Assumes variables VAL, PARAMS, HEAD and I to be scoped into the function." - (let ((val (plist-get params sym))) - (and hsym header (setq val (or (plist-get params hsym) val))) - (if (consp val) (plist-get val i) val))) - -(defun orgtbl-to-generic (table params) - "Convert the orgtbl-mode TABLE to some other format. -This generic routine can be used for many standard cases. -TABLE is a list, each entry either the symbol `hline' for a horizontal -separator line, or a list of fields for that line. -PARAMS is a property list of parameters that can influence the conversion. -For the generic converter, some parameters are obligatory: You need to -specify either :lfmt, or all of (:lstart :lend :sep). If you do not use -:splice, you must have :tstart and :tend. - -Valid parameters are - -:tstart String to start the table. Ignored when :splice is t. -:tend String to end the table. Ignored when :splice is t. - -:splice When set to t, return only table body lines, don't wrap - them into :tstart and :tend. Default is nil. - -:hline String to be inserted on horizontal separation lines. - May be nil to ignore hlines. - -:lstart String to start a new table line. -:lend String to end a table line -:sep Separator between two fields -:lfmt Format for entire line, with enough %s to capture all fields. - If this is present, :lstart, :lend, and :sep are ignored. -:fmt A format to be used to wrap the field, should contain - %s for the original field value. For example, to wrap - everything in dollars, you could use :fmt \"$%s$\". - This may also be a property list with column numbers and - formats. for example :fmt (2 \"$%s$\" 4 \"%s%%\") - -:hlstart :hlend :hlsep :hlfmt :hfmt - Same as above, specific for the header lines in the table. - All lines before the first hline are treated as header. - If any of these is not present, the data line value is used. - -:efmt Use this format to print numbers with exponentials. - The format should have %s twice for inserting mantissa - and exponent, for example \"%s\\\\times10^{%s}\". This - may also be a property list with column numbers and - formats. :fmt will still be applied after :efmt. - -In addition to this, the parameters :skip and :skipcols are always handled -directly by `orgtbl-send-table'. See manual." - (interactive) - (let* ((p params) - (splicep (plist-get p :splice)) - (hline (plist-get p :hline)) - rtn line i fm efm lfmt h) - - ;; Do we have a header? - (if (and (not splicep) (listp (car table)) (memq 'hline table)) - (setq h t)) - - ;; Put header - (unless splicep - (push (or (plist-get p :tstart) "ERROR: no :tstart") rtn)) - - ;; Now loop over all lines - (while (setq line (pop table)) - (if (eq line 'hline) - ;; A horizontal separator line - (progn (if hline (push hline rtn)) - (setq h nil)) ; no longer in header - ;; A normal line. Convert the fields, push line onto the result list - (setq i 0) - (setq line - (mapcar - (lambda (f) - (setq i (1+ i) - fm (org-get-param p h i :fmt :hfmt) - efm (org-get-param p h i :efmt)) - (if (and efm (string-match orgtbl-exp-regexp f)) - (setq f (format - efm (match-string 1 f) (match-string 2 f)))) - (if fm (setq f (format fm f))) - f) - line)) - (if (setq lfmt (org-get-param p h i :lfmt :hlfmt)) - (push (apply 'format lfmt line) rtn) - (push (concat - (org-get-param p h i :lstart :hlstart) - (mapconcat 'identity line (org-get-param p h i :sep :hsep)) - (org-get-param p h i :lend :hlend)) - rtn)))) - - (unless splicep - (push (or (plist-get p :tend) "ERROR: no :tend") rtn)) - - (mapconcat 'identity (nreverse rtn) "\n"))) - -(defun orgtbl-to-latex (table params) - "Convert the orgtbl-mode TABLE to LaTeX. -TABLE is a list, each entry either the symbol `hline' for a horizontal -separator line, or a list of fields for that line. -PARAMS is a property list of parameters that can influence the conversion. -Supports all parameters from `orgtbl-to-generic'. Most important for -LaTeX are: - -:splice When set to t, return only table body lines, don't wrap - them into a tabular environment. Default is nil. - -:fmt A format to be used to wrap the field, should contain %s for the - original field value. For example, to wrap everything in dollars, - use :fmt \"$%s$\". This may also be a property list with column - numbers and formats. for example :fmt (2 \"$%s$\" 4 \"%s%%\") - -:efmt Format for transforming numbers with exponentials. The format - should have %s twice for inserting mantissa and exponent, for - example \"%s\\\\times10^{%s}\". LaTeX default is \"%s\\\\,(%s)\". - This may also be a property list with column numbers and formats. - -The general parameters :skip and :skipcols have already been applied when -this function is called." - (let* ((alignment (mapconcat (lambda (x) (if x "r" "l")) - org-table-last-alignment "")) - (params2 - (list - :tstart (concat "\\begin{tabular}{" alignment "}") - :tend "\\end{tabular}" - :lstart "" :lend " \\\\" :sep " & " - :efmt "%s\\,(%s)" :hline "\\hline"))) - (orgtbl-to-generic table (org-combine-plists params2 params)))) - -(defun orgtbl-to-html (table params) - "Convert the orgtbl-mode TABLE to LaTeX. -TABLE is a list, each entry either the symbol `hline' for a horizontal -separator line, or a list of fields for that line. -PARAMS is a property list of parameters that can influence the conversion. -Currently this function recognizes the following parameters: - -:splice When set to t, return only table body lines, don't wrap - them into a
    " . "" . "
    environment. Default is nil. - -The general parameters :skip and :skipcols have already been applied when -this function is called. The function does *not* use `orgtbl-to-generic', -so you cannot specify parameters for it." - (let* ((splicep (plist-get params :splice)) - html) - ;; Just call the formatter we already have - ;; We need to make text lines for it, so put the fields back together. - (setq html (org-format-org-table-html - (mapcar - (lambda (x) - (if (eq x 'hline) - "|----+----|" - (concat "| " (mapconcat 'identity x " | ") " |"))) - table) - splicep)) - (if (string-match "\n+\\'" html) - (setq html (replace-match "" t t html))) - html)) - -(defun orgtbl-to-texinfo (table params) - "Convert the orgtbl-mode TABLE to TeXInfo. -TABLE is a list, each entry either the symbol `hline' for a horizontal -separator line, or a list of fields for that line. -PARAMS is a property list of parameters that can influence the conversion. -Supports all parameters from `orgtbl-to-generic'. Most important for -TeXInfo are: - -:splice nil/t When set to t, return only table body lines, don't wrap - them into a multitable environment. Default is nil. - -:fmt fmt A format to be used to wrap the field, should contain - %s for the original field value. For example, to wrap - everything in @kbd{}, you could use :fmt \"@kbd{%s}\". - This may also be a property list with column numbers and - formats. for example :fmt (2 \"@kbd{%s}\" 4 \"@code{%s}\"). - -:cf \"f1 f2..\" The column fractions for the table. Bye default these - are computed automatically from the width of the columns - under org-mode. - -The general parameters :skip and :skipcols have already been applied when -this function is called." - (let* ((total (float (apply '+ org-table-last-column-widths))) - (colfrac (or (plist-get params :cf) - (mapconcat - (lambda (x) (format "%.3f" (/ (float x) total))) - org-table-last-column-widths " "))) - (params2 - (list - :tstart (concat "@multitable @columnfractions " colfrac) - :tend "@end multitable" - :lstart "@item " :lend "" :sep " @tab " - :hlstart "@headitem "))) - (orgtbl-to-generic table (org-combine-plists params2 params)))) - -;;;; Link Stuff - -;;; Link abbreviations - -(defun org-link-expand-abbrev (link) - "Apply replacements as defined in `org-link-abbrev-alist." - (if (string-match "^\\([a-zA-Z][-_a-zA-Z0-9]*\\)\\(::?\\(.*\\)\\)?$" link) - (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 "%s" rpl) (replace-match (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'.") - -(defvar org-link-protocols nil - "Link protocols added to Org-mode using `org-add-link-type'.") - -(defvar org-store-link-functions nil - "List of functions that are called to create and store a link. -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 a 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 remember templates.") - -(defun org-add-link-type (type &optional follow publish) - "Add TYPE to the list of `org-link-types'. -Re-compute all regular expressions depending on `org-link-types' -FOLLOW and PUBLISH are two functions. Both take the link path as -an argument. -FOLLOW should do whatever is necessary to follow the link, for example -to find a file or display a mail message. - -PUBLISH takes the path and retuns the string that should be used when -this document is published. FIMXE: This is actually not yet implemented." - (add-to-list 'org-link-types type t) - (org-make-link-regexps) - (add-to-list 'org-link-protocols - (list type follow publish))) - -(defun org-add-agenda-custom-command (entry) - "Replace or add a command in `org-agenda-custom-commands'. -This is mostly for hacking and trying a new command - once the command -works you probably want to add it to `org-agenda-custom-commands' for good." - (let ((ass (assoc (car entry) org-agenda-custom-commands))) - (if ass - (setcdr ass (cdr entry)) - (push entry org-agenda-custom-commands)))) - -;;;###autoload -(defun org-store-link (arg) - "\\Store an org-link to the current location. -This link can later be inserted into an org-buffer with -\\[org-insert-link]. -For some link types, a prefix arg is interpreted: -For links to usenet articles, arg negates `org-usenet-links-prefer-google'. -For file links, arg negates `org-context-in-file-links'." - (interactive "P") - (setq org-store-link-plist nil) ; reset - (let (link cpltxt desc description search txt) - (cond - - ((run-hook-with-args-until-success 'org-store-link-functions) - (setq link (plist-get org-store-link-plist :link) - desc (or (plist-get org-store-link-plist :description) link))) - - ((eq major-mode 'bbdb-mode) - (let ((name (bbdb-record-name (bbdb-current-record))) - (company (bbdb-record-getprop (bbdb-current-record) 'company))) - (setq cpltxt (concat "bbdb:" (or name company)) - link (org-make-link cpltxt)) - (org-store-link-props :type "bbdb" :name name :company company))) - - ((eq major-mode 'Info-mode) - (setq link (org-make-link "info:" - (file-name-nondirectory Info-current-file) - ":" Info-current-node)) - (setq cpltxt (concat (file-name-nondirectory Info-current-file) - ":" Info-current-node)) - (org-store-link-props :type "info" :file Info-current-file - :node Info-current-node)) - - ((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))) - - ((or (eq major-mode 'vm-summary-mode) - (eq major-mode 'vm-presentation-mode)) - (and (eq major-mode 'vm-presentation-mode) (vm-summarize)) - (vm-follow-summary-cursor) - (save-excursion - (vm-select-folder-buffer) - (let* ((message (car vm-message-pointer)) - (folder buffer-file-name) - (subject (vm-su-subject message)) - (to (vm-get-header-contents message "To")) - (from (vm-get-header-contents message "From")) - (message-id (vm-su-message-id message))) - (org-store-link-props :type "vm" :from from :to to :subject subject - :message-id message-id) - (setq message-id (org-remove-angle-brackets message-id)) - (setq folder (abbreviate-file-name folder)) - (if (string-match (concat "^" (regexp-quote vm-folder-directory)) - folder) - (setq folder (replace-match "" t t folder))) - (setq cpltxt (org-email-link-description)) - (setq link (org-make-link "vm:" folder "#" message-id))))) - - ((eq major-mode 'wl-summary-mode) - (let* ((msgnum (wl-summary-message-number)) - (message-id (elmo-message-field wl-summary-buffer-elmo-folder - msgnum 'message-id)) - (wl-message-entity - (if (fboundp 'elmo-message-entity) - (elmo-message-entity - wl-summary-buffer-elmo-folder msgnum) - (elmo-msgdb-overview-get-entity - msgnum (wl-summary-buffer-msgdb)))) - (from (wl-summary-line-from)) - (to (car (elmo-message-entity-field wl-message-entity 'to))) - (subject (let (wl-thr-indent-string wl-parent-message-entity) - (wl-summary-line-subject)))) - (org-store-link-props :type "wl" :from from :to to - :subject subject :message-id message-id) - (setq message-id (org-remove-angle-brackets message-id)) - (setq cpltxt (org-email-link-description)) - (setq link (org-make-link "wl:" wl-summary-buffer-folder-name - "#" message-id)))) - - ((or (equal major-mode 'mh-folder-mode) - (equal major-mode 'mh-show-mode)) - (let ((from (org-mhe-get-header "From:")) - (to (org-mhe-get-header "To:")) - (message-id (org-mhe-get-header "Message-Id:")) - (subject (org-mhe-get-header "Subject:"))) - (org-store-link-props :type "mh" :from from :to to - :subject subject :message-id message-id) - (setq cpltxt (org-email-link-description)) - (setq link (org-make-link "mhe:" (org-mhe-get-message-real-folder) "#" - (org-remove-angle-brackets message-id))))) - - ((eq major-mode 'rmail-mode) - (save-excursion - (save-restriction - (rmail-narrow-to-non-pruned-header) - (let ((folder buffer-file-name) - (message-id (mail-fetch-field "message-id")) - (from (mail-fetch-field "from")) - (to (mail-fetch-field "to")) - (subject (mail-fetch-field "subject"))) - (org-store-link-props - :type "rmail" :from from :to to - :subject subject :message-id message-id) - (setq message-id (org-remove-angle-brackets message-id)) - (setq cpltxt (org-email-link-description)) - (setq link (org-make-link "rmail:" folder "#" message-id)))))) - - ((eq major-mode 'gnus-group-mode) - (let ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus - (gnus-group-group-name)) ; version - ((fboundp 'gnus-group-name) - (gnus-group-name)) - (t "???")))) - (unless group (error "Not on a group")) - (org-store-link-props :type "gnus" :group group) - (setq cpltxt (concat - (if (org-xor arg org-usenet-links-prefer-google) - "http://groups.google.com/groups?group=" - "gnus:") - group) - link (org-make-link cpltxt)))) - - ((memq major-mode '(gnus-summary-mode gnus-article-mode)) - (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary)) - (let* ((group gnus-newsgroup-name) - (article (gnus-summary-article-number)) - (header (gnus-summary-article-header article)) - (from (mail-header-from header)) - (message-id (mail-header-id header)) - (date (mail-header-date header)) - (subject (gnus-summary-subject-string))) - (org-store-link-props :type "gnus" :from from :subject subject - :message-id message-id :group group) - (setq cpltxt (org-email-link-description)) - (if (org-xor arg org-usenet-links-prefer-google) - (setq link - (concat - cpltxt "\n " - (format "http://groups.google.com/groups?as_umsgid=%s" - (org-fixup-message-id-for-http message-id)))) - (setq link (org-make-link "gnus:" group - "#" (number-to-string article)))))) - - ((eq major-mode 'w3-mode) - (setq cpltxt (url-view-url t) - link (org-make-link cpltxt)) - (org-store-link-props :type "w3" :url (url-view-url t))) - - ((eq major-mode 'w3m-mode) - (setq cpltxt (or w3m-current-title w3m-current-url) - link (org-make-link w3m-current-url)) - (org-store-link-props :type "w3m" :url (url-view-url t))) - - ((setq search (run-hook-with-args-until-success - 'org-create-file-search-functions)) - (setq link (concat "file:" (abbreviate-file-name buffer-file-name) - "::" search)) - (setq cpltxt (or description link))) - - ((eq major-mode 'image-mode) - (setq cpltxt (concat "file:" - (abbreviate-file-name buffer-file-name)) - link (org-make-link cpltxt)) - (org-store-link-props :type "image" :file buffer-file-name)) - - ((eq major-mode 'dired-mode) - ;; link to the file in the current line - (setq cpltxt (concat "file:" - (abbreviate-file-name - (expand-file-name - (dired-get-filename nil t)))) - link (org-make-link cpltxt))) - - ((and buffer-file-name (org-mode-p)) - ;; Just link to current headline - (setq cpltxt (concat "file:" - (abbreviate-file-name buffer-file-name))) - ;; Add a context search string - (when (org-xor org-context-in-file-links arg) - ;; Check if we are on a target - (if (org-in-regexp "<<\\(.*?\\)>>") - (setq cpltxt (concat cpltxt "::" (match-string 1))) - (setq txt (cond - ((org-on-heading-p) nil) - ((org-region-active-p) - (buffer-substring (region-beginning) (region-end))) - (t (buffer-substring (point-at-bol) (point-at-eol))))) - (when (or (null txt) (string-match "\\S-" txt)) - (setq cpltxt - (concat cpltxt "::" (org-make-org-heading-search-string txt)) - desc "NONE")))) - (if (string-match "::\\'" cpltxt) - (setq cpltxt (substring cpltxt 0 -2))) - (setq link (org-make-link cpltxt))) - - ((buffer-file-name (buffer-base-buffer)) - ;; Just link to this file here. - (setq cpltxt (concat "file:" - (abbreviate-file-name - (buffer-file-name (buffer-base-buffer))))) - ;; Add a context string - (when (org-xor org-context-in-file-links arg) - (setq txt (if (org-region-active-p) - (buffer-substring (region-beginning) (region-end)) - (buffer-substring (point-at-bol) (point-at-eol)))) - ;; Only use search option if there is some text. - (when (string-match "\\S-" txt) - (setq cpltxt - (concat cpltxt "::" (org-make-org-heading-search-string txt)) - desc "NONE"))) - (setq link (org-make-link cpltxt))) - - ((interactive-p) - (error "Cannot link to a buffer which is not visiting a file")) - - (t (setq link nil))) - - (if (consp link) (setq cpltxt (car link) link (cdr link))) - (setq link (or link cpltxt) - desc (or desc cpltxt)) - (if (equal desc "NONE") (setq desc nil)) - - (if (and (interactive-p) link) - (progn - (setq org-stored-links - (cons (list link desc) org-stored-links)) - (message "Stored: %s" (or desc link))) - (and link (org-make-link-string link desc))))) - -(defun org-store-link-props (&rest plist) - "Store link properties, extract names and addresses." - (let (x adr) - (when (setq x (plist-get plist :from)) - (setq adr (mail-extract-address-components x)) - (plist-put plist :fromname (car adr)) - (plist-put plist :fromaddress (nth 1 adr))) - (when (setq x (plist-get plist :to)) - (setq adr (mail-extract-address-components x)) - (plist-put plist :toname (car adr)) - (plist-put plist :toaddress (nth 1 adr)))) - (let ((from (plist-get plist :from)) - (to (plist-get plist :to))) - (when (and from to org-from-is-user-regexp) - (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-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 "%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 heading) - "Make search string for STRING or current headline." - (interactive) - (let ((s (or string (org-get-heading)))) - (unless (and string (not heading)) - ;; We are using a headline, clean up garbage in there. - (if (string-match org-todo-regexp s) - (setq s (replace-match "" t t s))) - (if (string-match (org-re ":[[:alnum:]_@:]+:[ \t]*$") s) - (setq s (replace-match "" t t s))) - (setq s (org-trim s)) - (if (string-match (concat "^\\(" org-quote-string "\\|" - org-comment-string "\\)") s) - (setq s (replace-match "" t t s))) - (while (string-match org-ts-regexp s) - (setq s (replace-match "" t t s)))) - (while (string-match "[^a-zA-Z_0-9 \t]+" s) - (setq s (replace-match " " t t s))) - (or string (setq s (concat "*" s))) ; Add * for headlines - (mapconcat 'identity (org-split-string s "[ \t]+") " "))) - -(defun org-make-link (&rest strings) - "Concatenate STRINGS." - (apply 'concat strings)) - -(defun org-make-link-string (link &optional description) - "Make a link with brackets, consisting of LINK and DESCRIPTION." - (unless (string-match "\\S-" link) - (error "Empty link")) - (when (stringp description) - ;; Remove brackets from the description, they are fatal. - (while (string-match "\\[" description) - (setq description (replace-match "{" t t description))) - (while (string-match "\\]" description) - (setq description (replace-match "}" t t description)))) - (when (equal (org-link-escape link) description) - ;; No description needed, it is identical - (setq description nil)) - (when (and (not description) - (not (equal link (org-link-escape link)))) - (setq description link)) - (concat "[[" (org-link-escape link) "]" - (if description (concat "[" description "]") "") - "]")) - -(defconst org-link-escape-chars - '((?\ . "%20") - (?\[ . "%5B") - (?\] . "%5D") - (?\340 . "%E0") ; `a - (?\342 . "%E2") ; ^a - (?\347 . "%E7") ; ,c - (?\350 . "%E8") ; `e - (?\351 . "%E9") ; 'e - (?\352 . "%EA") ; ^e - (?\356 . "%EE") ; ^i - (?\364 . "%F4") ; ^o - (?\371 . "%F9") ; `u - (?\373 . "%FB") ; ^u - (?\; . "%3B") - (?? . "%3F") - (?= . "%3D") - (?+ . "%2B") - ) - "Association list of escapes for some characters problematic in links. -This is the list that is used for internal purposes.") - -(defconst org-link-escape-chars-browser - '((?\ . "%20")) ; 32 for the SPC char - "Association list of escapes for some characters problematic in links. -This is the list that is used before handing over to the browser.") - -(defun org-link-escape (text &optional table) - "Escape charaters in TEXT that are problematic for links." - (setq table (or table org-link-escape-chars)) - (when text - (let ((re (mapconcat (lambda (x) (regexp-quote - (char-to-string (car x)))) - table "\\|"))) - (while (string-match re text) - (setq text - (replace-match - (cdr (assoc (string-to-char (match-string 0 text)) - table)) - t t text))) - text))) - -(defun org-link-unescape (text &optional table) - "Reverse the action of `org-link-escape'." - (setq table (or table org-link-escape-chars)) - (when text - (let ((re (mapconcat (lambda (x) (regexp-quote (cdr x))) - table "\\|"))) - (while (string-match re text) - (setq text - (replace-match - (char-to-string (car (rassoc (match-string 0 text) table))) - t t text))) - text))) - -(defun org-xor (a b) - "Exclusive or." - (if a (not b) b)) - -(defun org-get-header (header) - "Find a header field in the current buffer." - (save-excursion - (goto-char (point-min)) - (let ((case-fold-search t) s) - (cond - ((eq header 'from) - (if (re-search-forward "^From:\\s-+\\(.*\\)" nil t) - (setq s (match-string 1))) - (while (string-match "\"" s) - (setq s (replace-match "" t t s))) - (if (string-match "[<(].*" s) - (setq s (replace-match "" t t s)))) - ((eq header 'message-id) - (if (re-search-forward "^message-id:\\s-+\\(.*\\)" nil t) - (setq s (match-string 1)))) - ((eq header 'subject) - (if (re-search-forward "^subject:\\s-+\\(.*\\)" nil t) - (setq s (match-string 1))))) - (if (string-match "\\`[ \t\]+" s) (setq s (replace-match "" t t s))) - (if (string-match "[ \t\]+\\'" s) (setq s (replace-match "" t t s))) - s))) - - -(defun org-fixup-message-id-for-http (s) - "Replace special characters in a message id, so it can be used in an http query." - (while (string-match "<" s) - (setq s (replace-match "%3C" t t s))) - (while (string-match ">" s) - (setq s (replace-match "%3E" t t s))) - (while (string-match "@" s) - (setq s (replace-match "%40" t t s))) - s) - -;;;###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-mode syntax." - (interactive) - (org-run-like-in-org-mode 'org-insert-link)) - -(defun org-insert-link (&optional complete-file) - "Insert a link. At the prompt, enter the link. - -Completion can be used to select a link previously stored with -`org-store-link'. When the empty string is entered (i.e. if you just -press RET at the prompt), the link defaults to the most recently -stored link. As SPC triggers completion in the minibuffer, you need to -use M-SPC or C-q SPC to force the insertion of a space character. - -You will also be prompted for a description, and if one is given, it will -be displayed in the buffer instead of the link. - -If there is already a link at point, this command will allow you to edit link -and description parts. - -With a \\[universal-argument] prefix, prompts for a file to link to. The file name can be -selected using completion. The path to the file will be relative to -the current directory if the file is in the current directory or a -subdirectory. Otherwise, the link will be the absolute path as -completed in the minibuffer (i.e. normally ~/path/to/file). - -With two \\[universal-argument] prefixes, enforce an absolute path even if the file -is in the current directory or below. -With three \\[universal-argument] prefixes, negate the meaning of -`org-keep-stored-link-after-insertion'." - (interactive "P") - (let* ((wcf (current-window-configuration)) - (region (if (org-region-active-p) - (buffer-substring (region-beginning) (region-end)))) - (remove (and region (list (region-beginning) (region-end)))) - (desc region) - tmphist ; byte-compile incorrectly complains about this - link entry file) - (cond - ((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 (if (match-end 3) (org-match-string-no-properties 3))) - (setq link (read-string "Link: " - (org-link-unescape - (org-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-remove-angle-brackets (match-string 0))))) - ((equal complete-file '(4)) - ;; Completing read for file names. - (setq file (read-file-name "File: ")) - (let ((pwd (file-name-as-directory (expand-file-name "."))) - (pwd1 (file-name-as-directory (abbreviate-file-name - (expand-file-name "."))))) - (cond - ((equal complete-file '(16)) - (setq link (org-make-link - "file:" - (abbreviate-file-name (expand-file-name file))))) - ((string-match (concat "^" (regexp-quote pwd1) "\\(.+\\)") file) - (setq link (org-make-link "file:" (match-string 1 file)))) - ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)") - (expand-file-name file)) - (setq link (org-make-link - "file:" (match-string 1 (expand-file-name file))))) - (t (setq link (org-make-link "file:" file)))))) - (t - ;; Read link, with completion for stored links. - (with-output-to-temp-buffer "*Org Links*" - (princ "Insert a link. Use TAB to complete valid link prefixes.\n") - (when org-stored-links - (princ "\nStored links are available with / or M-p/n (most recent with RET):\n\n") - (princ (mapconcat - (lambda (x) - (if (nth 1 x) (concat (car x) " (" (nth 1 x) ")") (car x))) - (reverse org-stored-links) "\n")))) - (let ((cw (selected-window))) - (select-window (get-buffer-window "*Org Links*")) - (shrink-window-if-larger-than-buffer) - (setq truncate-lines t) - (select-window cw)) - ;; Fake a link history, containing the stored links. - (setq tmphist (append (mapcar 'car org-stored-links) - org-insert-link-history)) - (unwind-protect - (setq link (org-completing-read - "Link: " - (append - (mapcar (lambda (x) (list (concat (car x) ":"))) - (append org-link-abbrev-alist-local org-link-abbrev-alist)) - (mapcar (lambda (x) (list (concat x ":"))) - org-link-types)) - nil nil nil - 'tmphist - (or (car (car org-stored-links))))) - (set-window-configuration wcf) - (kill-buffer "*Org Links*")) - (setq entry (assoc link org-stored-links)) - (or entry (push link org-insert-link-history)) - (if (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))) - (setq desc (or desc (nth 1 entry))))) - - (if (string-match org-plain-link-re link) - ;; URL-like link, normalize the use of angular brackets. - (setq link (org-make-link (org-remove-angle-brackets link)))) - - ;; Check if we are linking to the current file with a search option - ;; If yes, simplify the link by using only the search option. - (when (and buffer-file-name - (string-match "\\]+\\)" link)) - (let* ((path (match-string 1 link)) - (case-fold-search nil) - (search (match-string 2 link))) - (save-match-data - (if (equal (file-truename buffer-file-name) (file-truename path)) - ;; We are linking to this same file, with a search option - (setq link search))))) - - ;; Check if we can/should use a relative path. If yes, simplify the link - (when (string-match "\\" "") html)) - (setq tbopen t) - (while (setq line (pop lines)) - (catch 'next-line - (if (string-match "^[ \t]*|-" line) - (progn - (unless splice - (push (if head "" "") html) - (if lines (push "" html) (setq tbopen nil))) - (setq head nil) ;; head ends here, first time around - ;; ignore this line - (throw 'next-line t))) - ;; Break the line into fields - (setq fields (org-split-string line "[ \t]*|[ \t]*")) - (unless fnum (setq fnum (make-vector (length fields) 0))) - (setq nlines (1+ nlines) i -1) - (push (concat "" - (mapconcat - (lambda (x) - (setq i (1+ i)) - (if (and (< i nlines) - (string-match org-table-number-regexp x)) - (incf (aref fnum i))) - (if head - (concat (car org-export-table-header-tags) x - (cdr org-export-table-header-tags)) - (concat (car org-export-table-data-tags) x - (cdr org-export-table-data-tags)))) - fields "") - "") - html))) - (unless splice (if tbopen (push "" html))) - (unless splice (push "
    \n" html)) - (setq html (nreverse html)) - (unless splice - ;; Put in col tags with the alignment (unfortuntely often ignored...) - (push (mapconcat - (lambda (x) - (setq gr (pop org-table-colgroup-info)) - (format "%s%s" - (if (memq gr '(:start :startend)) - (prog1 - (if colgropen "\n" "") - (setq colgropen t)) - "") - (if (> (/ (float x) nlines) org-table-number-fraction) - "right" "left") - (if (memq gr '(:end :startend)) - (progn (setq colgropen nil) "") - ""))) - fnum "") - html) - (if colgropen (setq html (cons (car html) (cons "" (cdr html))))) - (push html-table-tag html)) - (concat (mapconcat 'identity html "\n") "\n"))) - -(defun org-table-clean-before-export (lines) - "Check if the table has a marking column. -If yes remove the column and the special lines." - (setq org-table-colgroup-info nil) - (if (memq nil - (mapcar - (lambda (x) (or (string-match "^[ \t]*|-" x) - (string-match "^[ \t]*| *\\([#!$*_^ /]\\) *|" x))) - lines)) - (progn - (setq org-table-clean-did-remove-column nil) - (delq nil - (mapcar - (lambda (x) - (cond - ((string-match "^[ \t]*| */ *|" x) - (setq org-table-colgroup-info - (mapcar (lambda (x) - (cond ((member x '("<" "<")) :start) - ((member x '(">" ">")) :end) - ((member x '("<>" "<>")) :startend) - (t nil))) - (org-split-string x "[ \t]*|[ \t]*"))) - nil) - (t x))) - lines))) - (setq org-table-clean-did-remove-column t) - (delq nil - (mapcar - (lambda (x) - (cond - ((string-match "^[ \t]*| */ *|" x) - (setq org-table-colgroup-info - (mapcar (lambda (x) - (cond ((member x '("<" "<")) :start) - ((member x '(">" ">")) :end) - ((member x '("<>" "<>")) :startend) - (t nil))) - (cdr (org-split-string x "[ \t]*|[ \t]*")))) - nil) - ((string-match "^[ \t]*| *[!_^/] *|" x) - nil) ; ignore this line - ((or (string-match "^\\([ \t]*\\)|-+\\+" x) - (string-match "^\\([ \t]*\\)|[^|]*|" x)) - ;; remove the first column - (replace-match "\\1|" t nil x)))) - lines)))) - -(defun org-format-table-table-html (lines) - "Format a table generated by table.el into HTML. -This conversion does *not* use `table-generate-source' from table.el. -This has the advantage that Org-mode's HTML conversions can be used. -But it has the disadvantage, that no cell- or row-spanning is allowed." - (let (line field-buffer - (head org-export-highlight-first-table-line) - fields html empty) - (setq html (concat html-table-tag "\n")) - (while (setq line (pop lines)) - (setq empty " ") - (catch 'next-line - (if (string-match "^[ \t]*\\+-" line) - (progn - (if field-buffer - (progn - (setq - html - (concat - html - "" - (mapconcat - (lambda (x) - (if (equal x "") (setq x empty)) - (if head - (concat (car org-export-table-header-tags) x - (cdr org-export-table-header-tags)) - (concat (car org-export-table-data-tags) x - (cdr org-export-table-data-tags)))) - field-buffer "\n") - "\n")) - (setq head nil) - (setq field-buffer nil))) - ;; Ignore this line - (throw 'next-line t))) - ;; Break the line into fields and store the fields - (setq fields (org-split-string line "[ \t]*|[ \t]*")) - (if field-buffer - (setq field-buffer (mapcar - (lambda (x) - (concat x "
    " (pop fields))) - field-buffer)) - (setq field-buffer fields)))) - (setq html (concat html "\n")) - html)) - -(defun org-format-table-table-html-using-table-generate-source (lines) - "Format a table into html, using `table-generate-source' from table.el. -This has the advantage that cell- or row-spanning is allowed. -But it has the disadvantage, that Org-mode's HTML conversions cannot be used." - (require 'table) - (with-current-buffer (get-buffer-create " org-tmp1 ") - (erase-buffer) - (insert (mapconcat 'identity lines "\n")) - (goto-char (point-min)) - (if (not (re-search-forward "|[^+]" nil t)) - (error "Error processing table")) - (table-recognize-table) - (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer)) - (table-generate-source 'html " org-tmp2 ") - (set-buffer " org-tmp2 ") - (buffer-substring (point-min) (point-max)))) - -(defun org-html-handle-time-stamps (s) - "Format time stamps in string S, or remove them." - (catch 'exit - (let (r b) - (while (string-match org-maybe-keyword-time-regexp s) - (if (and (match-end 1) (equal (match-string 1 s) org-clock-string)) - ;; never export CLOCK - (throw 'exit "")) - (or b (setq b (substring s 0 (match-beginning 0)))) - (if (not org-export-with-timestamps) - (setq r (concat r (substring s 0 (match-beginning 0))) - s (substring s (match-end 0))) - (setq r (concat - r (substring s 0 (match-beginning 0)) - (if (match-end 1) - (format "@%s @" - (match-string 1 s))) - (format " @%s@" - (substring - (org-translate-time (match-string 3 s)) 1 -1))) - s (substring s (match-end 0))))) - ;; Line break if line started and ended with time stamp stuff - (if (not r) - s - (setq r (concat r s)) - (unless (string-match "\\S-" (concat b s)) - (setq r (concat r "@
    "))) - r)))) - -(defun org-html-protect (s) - ;; convert & to &, < to < and > to > - (let ((start 0)) - (while (string-match "&" s start) - (setq s (replace-match "&" t t s) - start (1+ (match-beginning 0)))) - (while (string-match "<" s) - (setq s (replace-match "<" t t s))) - (while (string-match ">" s) - (setq s (replace-match ">" t t s)))) - s) - -(defun org-export-cleanup-toc-line (s) - "Remove tags and time staps from lines going into the toc." - (when (memq org-export-with-tags '(not-in-toc nil)) - (if (string-match (org-re " +:[[:alnum:]_@:]+: *$") s) - (setq s (replace-match "" t t s)))) - (when org-export-remove-timestamps-from-toc - (while (string-match org-maybe-keyword-time-regexp s) - (setq s (replace-match "" t t s)))) - (while (string-match org-bracket-link-regexp s) - (setq s (replace-match (match-string (if (match-end 3) 3 1) s) - t t s))) - s) - -(defun org-html-expand (string) - "Prepare STRING for HTML export. Applies all active conversions. -If there are links in the string, don't modify these." - (let* ((re (concat org-bracket-link-regexp "\\|" - (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$"))) - m s l res) - (while (setq m (string-match re string)) - (setq s (substring string 0 m) - l (match-string 0 string) - string (substring string (match-end 0))) - (push (org-html-do-expand s) res) - (push l res)) - (push (org-html-do-expand string) res) - (apply 'concat (nreverse res)))) - -(defun org-html-do-expand (s) - "Apply all active conversions to translate special ASCII to HTML." - (setq s (org-html-protect s)) - (if org-export-html-expand - (let ((start 0)) - (while (string-match "@<\\([^&]*\\)>" s) - (setq s (replace-match "<\\1>" t nil s))))) - (if org-export-with-emphasize - (setq s (org-export-html-convert-emphasize s))) - (if org-export-with-special-strings - (setq s (org-export-html-convert-special-strings s))) - (if org-export-with-sub-superscripts - (setq s (org-export-html-convert-sub-super s))) - (if org-export-with-TeX-macros - (let ((start 0) wd ass) - (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)" s start)) - (if (get-text-property (match-beginning 0) 'org-protected s) - (setq start (match-end 0)) - (setq wd (match-string 1 s)) - (if (setq ass (assoc wd org-html-entities)) - (setq s (replace-match (or (cdr ass) - (concat "&" (car ass) ";")) - t t s)) - (setq start (+ start (length wd)))))))) - s) - -(defun org-create-multibrace-regexp (left right n) - "Create a regular expression which will match a balanced sexp. -Opening delimiter is LEFT, and closing delimiter is RIGHT, both given -as single character strings. -The regexp returned will match the entire expression including the -delimiters. It will also define a single group which contains the -match except for the outermost delimiters. The maximum depth of -stacked delimiters is N. Escaping delimiters is not possible." - (let* ((nothing (concat "[^" "\\" left "\\" right "]*?")) - (or "\\|") - (re nothing) - (next (concat "\\(?:" nothing left nothing right "\\)+" nothing))) - (while (> n 1) - (setq n (1- n) - re (concat re or next) - next (concat "\\(?:" nothing left next right "\\)+" nothing))) - (concat left "\\(" re "\\)" right))) - -(defvar org-match-substring-regexp - (concat - "\\([^\\]\\)\\([_^]\\)\\(" - "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" - "\\|" - "\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)" - "\\|" - "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)") - "The regular expression matching a sub- or superscript.") - -(defvar org-match-substring-with-braces-regexp - (concat - "\\([^\\]\\)\\([_^]\\)\\(" - "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" - "\\)") - "The regular expression matching a sub- or superscript, forcing braces.") - -(defconst org-export-html-special-string-regexps - '(("\\\\-" . "­") - ("---\\([^-]\\)" . "—\\1") - ("--\\([^-]\\)" . "–\\1") - ("\\.\\.\\." . "…")) - "Regular expressions for special string conversion.") - -(defun org-export-html-convert-special-strings (string) - "Convert special characters in STRING to HTML." - (let ((all org-export-html-special-string-regexps) - e a re rpl start) - (while (setq a (pop all)) - (setq re (car a) rpl (cdr a) start 0) - (while (string-match re string start) - (if (get-text-property (match-beginning 0) 'org-protected string) - (setq start (match-end 0)) - (setq string (replace-match rpl t nil string))))) - string)) - -(defun org-export-html-convert-sub-super (string) - "Convert sub- and superscripts in STRING to HTML." - (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{}))) - (while (string-match org-match-substring-regexp string s) - (cond - ((and requireb (match-end 8)) (setq s (match-end 2))) - ((get-text-property (match-beginning 2) 'org-protected string) - (setq s (match-end 2))) - (t - (setq s (match-end 1) - key (if (string= (match-string 2 string) "_") "sub" "sup") - c (or (match-string 8 string) - (match-string 6 string) - (match-string 5 string)) - string (replace-match - (concat (match-string 1 string) - "<" key ">" c "") - t t string))))) - (while (string-match "\\\\\\([_^]\\)" string) - (setq string (replace-match (match-string 1 string) t t string))) - string)) - -(defun org-export-html-convert-emphasize (string) - "Apply emphasis." - (let ((s 0) rpl) - (while (string-match org-emph-re string s) - (if (not (equal - (substring string (match-beginning 3) (1+ (match-beginning 3))) - (substring string (match-beginning 4) (1+ (match-beginning 4))))) - (setq s (match-beginning 0) - rpl - (concat - (match-string 1 string) - (nth 2 (assoc (match-string 3 string) org-emphasis-alist)) - (match-string 4 string) - (nth 3 (assoc (match-string 3 string) - org-emphasis-alist)) - (match-string 5 string)) - string (replace-match rpl t t string) - s (+ s (- (length rpl) 2))) - (setq s (1+ s)))) - string)) - -(defvar org-par-open nil) -(defun org-open-par () - "Insert

    , but first close previous paragraph if any." - (org-close-par-maybe) - (insert "\n

    ") - (setq org-par-open t)) -(defun org-close-par-maybe () - "Close paragraph if there is one open." - (when org-par-open - (insert "

    ") - (setq org-par-open nil))) -(defun org-close-li () - "Close
  • if necessary." - (org-close-par-maybe) - (insert "
    • \n")) - -(defvar body-only) ; dynamically scoped into this. -(defun org-html-level-start (level title umax with-toc head-count) - "Insert a new level in HTML export. -When TITLE is nil, just close all open levels." - (org-close-par-maybe) - (let ((l org-level-max)) - (while (>= l level) - (if (aref org-levels-open (1- l)) - (progn - (org-html-level-close l umax) - (aset org-levels-open (1- l) nil))) - (setq l (1- l))) - (when title - ;; If title is nil, this means this function is called to close - ;; all levels, so the rest is done only if title is given - (when (string-match (org-re "\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title) - (setq title (replace-match - (if org-export-with-tags - (save-match-data - (concat - "   " - (mapconcat 'identity (org-split-string - (match-string 1 title) ":") - " ") - "")) - "") - t t title))) - (if (> level umax) - (progn - (if (aref org-levels-open (1- level)) - (progn - (org-close-li) - (insert "
  • " title "
    \n")) - (aset org-levels-open (1- level) t) - (org-close-par-maybe) - (insert "
      \n
    • " title "
      \n"))) - (aset org-levels-open (1- level) t) - (if (and org-export-with-section-numbers (not body-only)) - (setq title (concat (org-section-number level) " " title))) - (setq level (+ level org-export-html-toplevel-hlevel -1)) - (if with-toc - (insert (format "\n
      \n%s\n" - level level head-count title level)) - (insert (format "\n
      \n%s\n" level level title level))) - (org-open-par))))) - -(defun org-html-level-close (level max-outline-level) - "Terminate one level in HTML export." - (if (<= level max-outline-level) - (insert "
      \n") - (org-close-li) - (insert "
    \n"))) - -;;; iCalendar export - -;;;###autoload -(defun org-export-icalendar-this-file () - "Export current file as an iCalendar file. -The iCalendar file will be located in the same directory as the Org-mode -file, but with extension `.ics'." - (interactive) - (org-export-icalendar nil buffer-file-name)) - -;;;###autoload -(defun org-export-icalendar-all-agenda-files () - "Export all files in `org-agenda-files' to iCalendar .ics files. -Each iCalendar file will be located in the same directory as the Org-mode -file, but with extension `.ics'." - (interactive) - (apply 'org-export-icalendar nil (org-agenda-files t))) - -;;;###autoload -(defun org-export-icalendar-combine-agenda-files () - "Export all files in `org-agenda-files' to a single combined iCalendar file. -The file is stored under the name `org-combined-agenda-icalendar-file'." - (interactive) - (apply 'org-export-icalendar t (org-agenda-files t))) - -(defun org-export-icalendar (combine &rest files) - "Create iCalendar files for all elements of FILES. -If COMBINE is non-nil, combine all calendar entries into a single large -file and store it under the name `org-combined-agenda-icalendar-file'." - (save-excursion - (org-prepare-agenda-buffers files) - (let* ((dir (org-export-directory - :ical (list :publishing-directory - org-export-publishing-directory))) - file ical-file ical-buffer category started org-agenda-new-buffers) - - (and (get-buffer "*ical-tmp*") (kill-buffer "*ical-tmp*")) - (when combine - (setq ical-file - (if (file-name-absolute-p org-combined-agenda-icalendar-file) - org-combined-agenda-icalendar-file - (expand-file-name org-combined-agenda-icalendar-file dir)) - ical-buffer (org-get-agenda-file-buffer ical-file)) - (set-buffer ical-buffer) (erase-buffer)) - (while (setq file (pop files)) - (catch 'nextfile - (org-check-agenda-file file) - (set-buffer (org-get-agenda-file-buffer file)) - (unless combine - (setq ical-file (concat (file-name-as-directory dir) - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) - ".ics")) - (setq ical-buffer (org-get-agenda-file-buffer ical-file)) - (with-current-buffer ical-buffer (erase-buffer))) - (setq category (or org-category - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)))) - (if (symbolp category) (setq category (symbol-name category))) - (let ((standard-output ical-buffer)) - (if combine - (and (not started) (setq started t) - (org-start-icalendar-file org-icalendar-combined-name)) - (org-start-icalendar-file category)) - (org-print-icalendar-entries combine) - (when (or (and combine (not files)) (not combine)) - (org-finish-icalendar-file) - (set-buffer ical-buffer) - (save-buffer) - (run-hooks 'org-after-save-iCalendar-file-hook))))) - (org-release-buffers org-agenda-new-buffers)))) - -(defvar org-after-save-iCalendar-file-hook nil - "Hook run after an iCalendar file has been saved. -The iCalendar buffer is still current when this hook is run. -A good way to use this is to tell a desktop calenndar application to re-read -the iCalendar file.") - -(defun org-print-icalendar-entries (&optional combine) - "Print iCalendar entries for the current Org-mode file to `standard-output'. -When COMBINE is non nil, add the category to each line." - (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>")) - (re2 (concat "--?-?\\(" org-ts-regexp "\\)")) - (dts (org-ical-ts-to-string - (format-time-string (cdr org-time-stamp-formats) (current-time)) - "DTSTART")) - hd ts ts2 state status (inc t) pos b sexp rrule - scheduledp deadlinep tmp pri category entry location summary desc - (sexp-buffer (get-buffer-create "*ical-tmp*"))) - (org-refresh-category-properties) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward re1 nil t) - (catch :skip - (org-agenda-skip) - (setq pos (match-beginning 0) - ts (match-string 0) - inc t - hd (org-get-heading) - summary (org-icalendar-cleanup-string - (org-entry-get nil "SUMMARY")) - desc (org-icalendar-cleanup-string - (or (org-entry-get nil "DESCRIPTION") - (and org-icalendar-include-body (org-get-entry))) - t org-icalendar-include-body) - location (org-icalendar-cleanup-string - (org-entry-get nil "LOCATION")) - category (org-get-category)) - (if (looking-at re2) - (progn - (goto-char (match-end 0)) - (setq ts2 (match-string 1) inc nil)) - (setq tmp (buffer-substring (max (point-min) - (- pos org-ds-keyword-length)) - pos) - ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts) - (progn - (setq inc nil) - (replace-match "\\1" t nil ts)) - ts) - deadlinep (string-match org-deadline-regexp tmp) - scheduledp (string-match org-scheduled-regexp tmp) - ;; donep (org-entry-is-done-p) - )) - (if (or (string-match org-tr-regexp hd) - (string-match org-ts-regexp hd)) - (setq hd (replace-match "" t t hd))) - (if (string-match "\\+\\([0-9]+\\)\\([dwmy]\\)>" ts) - (setq rrule - (concat "\nRRULE:FREQ=" - (cdr (assoc - (match-string 2 ts) - '(("d" . "DAILY")("w" . "WEEKLY") - ("m" . "MONTHLY")("y" . "YEARLY")))) - ";INTERVAL=" (match-string 1 ts))) - (setq rrule "")) - (setq summary (or summary hd)) - (if (string-match org-bracket-link-regexp summary) - (setq summary - (replace-match (if (match-end 3) - (match-string 3 summary) - (match-string 1 summary)) - t t summary))) - (if deadlinep (setq summary (concat "DL: " summary))) - (if scheduledp (setq summary (concat "S: " summary))) - (if (string-match "\\`<%%" ts) - (with-current-buffer sexp-buffer - (insert (substring ts 1 -1) " " summary "\n")) - (princ (format "BEGIN:VEVENT -%s -%s%s -SUMMARY:%s%s%s -CATEGORIES:%s -END:VEVENT\n" - (org-ical-ts-to-string ts "DTSTART") - (org-ical-ts-to-string ts2 "DTEND" inc) - rrule summary - (if (and desc (string-match "\\S-" desc)) - (concat "\nDESCRIPTION: " desc) "") - (if (and location (string-match "\\S-" location)) - (concat "\nLOCATION: " location) "") - category))))) - - (when (and org-icalendar-include-sexps - (condition-case nil (require 'icalendar) (error nil)) - (fboundp 'icalendar-export-region)) - ;; Get all the literal sexps - (goto-char (point-min)) - (while (re-search-forward "^&?%%(" nil t) - (catch :skip - (org-agenda-skip) - (setq b (match-beginning 0)) - (goto-char (1- (match-end 0))) - (forward-sexp 1) - (end-of-line 1) - (setq sexp (buffer-substring b (point))) - (with-current-buffer sexp-buffer - (insert sexp "\n")) - (princ (org-diary-to-ical-string sexp-buffer))))) - - (when org-icalendar-include-todo - (goto-char (point-min)) - (while (re-search-forward org-todo-line-regexp nil t) - (catch :skip - (org-agenda-skip) - (setq state (match-string 2)) - (setq status (if (member state org-done-keywords) - "COMPLETED" "NEEDS-ACTION")) - (when (and state - (or (not (member state org-done-keywords)) - (eq org-icalendar-include-todo 'all)) - (not (member org-archive-tag (org-get-tags-at))) - ) - (setq hd (match-string 3) - summary (org-icalendar-cleanup-string - (org-entry-get nil "SUMMARY")) - desc (org-icalendar-cleanup-string - (or (org-entry-get nil "DESCRIPTION") - (and org-icalendar-include-body (org-get-entry))) - t org-icalendar-include-body) - location (org-icalendar-cleanup-string - (org-entry-get nil "LOCATION"))) - (if (string-match org-bracket-link-regexp hd) - (setq hd (replace-match (if (match-end 3) (match-string 3 hd) - (match-string 1 hd)) - t t hd))) - (if (string-match org-priority-regexp hd) - (setq pri (string-to-char (match-string 2 hd)) - hd (concat (substring hd 0 (match-beginning 1)) - (substring hd (match-end 1)))) - (setq pri org-default-priority)) - (setq pri (floor (1+ (* 8. (/ (float (- org-lowest-priority pri)) - (- org-lowest-priority org-highest-priority)))))) - - (princ (format "BEGIN:VTODO -%s -SUMMARY:%s%s%s -CATEGORIES:%s -SEQUENCE:1 -PRIORITY:%d -STATUS:%s -END:VTODO\n" - dts - (or summary hd) - (if (and location (string-match "\\S-" location)) - (concat "\nLOCATION: " location) "") - (if (and desc (string-match "\\S-" desc)) - (concat "\nDESCRIPTION: " desc) "") - category pri status))))))))) - -(defun org-icalendar-cleanup-string (s &optional is-body maxlength) - "Take out stuff and quote what needs to be quoted. -When IS-BODY is non-nil, assume that this is the body of an item, clean up -whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH -characters." - (if (not s) - nil - (when is-body - (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?")) - (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) - (while (string-match re s) (setq s (replace-match "" t t s))) - (while (string-match re2 s) (setq s (replace-match "" t t s))))) - (let ((start 0)) - (while (string-match "\\([,;\\]\\)" s start) - (setq start (+ (match-beginning 0) 2) - s (replace-match "\\\\\\1" nil nil s)))) - (when is-body - (while (string-match "[ \t]*\n[ \t]*" s) - (setq s (replace-match "\\n" t t s)))) - (setq s (org-trim s)) - (if is-body - (if maxlength - (if (and (numberp maxlength) - (> (length s) maxlength)) - (setq s (substring s 0 maxlength))))) - s)) - -(defun org-get-entry () - "Clean-up description string." - (save-excursion - (org-back-to-heading t) - (buffer-substring (point-at-bol 2) (org-end-of-subtree t)))) - -(defun org-start-icalendar-file (name) - "Start an iCalendar file by inserting the header." - (let ((user user-full-name) - (name (or name "unknown")) - (timezone (cadr (current-time-zone)))) - (princ - (format "BEGIN:VCALENDAR -VERSION:2.0 -X-WR-CALNAME:%s -PRODID:-//%s//Emacs with Org-mode//EN -X-WR-TIMEZONE:%s -CALSCALE:GREGORIAN\n" name user timezone)))) - -(defun org-finish-icalendar-file () - "Finish an iCalendar file by inserting the END statement." - (princ "END:VCALENDAR\n")) - -(defun org-ical-ts-to-string (s keyword &optional inc) - "Take a time string S and convert it to iCalendar format. -KEYWORD is added in front, to make a complete line like DTSTART.... -When INC is non-nil, increase the hour by two (if time string contains -a time), or the day by one (if it does not contain a time)." - (let ((t1 (org-parse-time-string s 'nodefault)) - t2 fmt have-time time) - (if (and (car t1) (nth 1 t1) (nth 2 t1)) - (setq t2 t1 have-time t) - (setq t2 (org-parse-time-string s))) - (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2)) - (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2))) - (when inc - (if have-time - (if org-agenda-default-appointment-duration - (setq mi (+ org-agenda-default-appointment-duration mi)) - (setq h (+ 2 h))) - (setq d (1+ d)))) - (setq time (encode-time s mi h d m y))) - (setq fmt (if have-time ":%Y%m%dT%H%M%S" ";VALUE=DATE:%Y%m%d")) - (concat keyword (format-time-string fmt time)))) - -;;; XOXO export - -(defun org-export-as-xoxo-insert-into (buffer &rest output) - (with-current-buffer buffer - (apply 'insert output))) -(put 'org-export-as-xoxo-insert-into 'lisp-indent-function 1) - -(defun org-export-as-xoxo (&optional buffer) - "Export the org buffer as XOXO. -The XOXO buffer is named *xoxo-*" - (interactive (list (current-buffer))) - ;; A quickie abstraction - - ;; Output everything as XOXO - (with-current-buffer (get-buffer buffer) - (let* ((pos (point)) - (opt-plist (org-combine-plists (org-default-export-plist) - (org-infile-export-plist))) - (filename (concat (file-name-as-directory - (org-export-directory :xoxo opt-plist)) - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) - ".html")) - (out (find-file-noselect filename)) - (last-level 1) - (hanging-li nil)) - (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed. - ;; Check the output buffer is empty. - (with-current-buffer out (erase-buffer)) - ;; Kick off the output - (org-export-as-xoxo-insert-into out "
      \n") - (while (re-search-forward "^\\(\\*+\\)[ \t]+\\(.+\\)" (point-max) 't) - (let* ((hd (match-string-no-properties 1)) - (level (length hd)) - (text (concat - (match-string-no-properties 2) - (save-excursion - (goto-char (match-end 0)) - (let ((str "")) - (catch 'loop - (while 't - (forward-line) - (if (looking-at "^[ \t]\\(.*\\)") - (setq str (concat str (match-string-no-properties 1))) - (throw 'loop str))))))))) - - ;; Handle level rendering - (cond - ((> level last-level) - (org-export-as-xoxo-insert-into out "\n
        \n")) - - ((< level last-level) - (dotimes (- (- last-level level) 1) - (if hanging-li - (org-export-as-xoxo-insert-into out "\n")) - (org-export-as-xoxo-insert-into out "
      \n")) - (when hanging-li - (org-export-as-xoxo-insert-into out "\n") - (setq hanging-li nil))) - - ((equal level last-level) - (if hanging-li - (org-export-as-xoxo-insert-into out "\n"))) - ) - - (setq last-level level) - - ;; And output the new li - (setq hanging-li 't) - (if (equal ?+ (elt text 0)) - (org-export-as-xoxo-insert-into out "
    1. ") - (org-export-as-xoxo-insert-into out "
    2. " text)))) - - ;; Finally finish off the ol - (dotimes (- last-level 1) - (if hanging-li - (org-export-as-xoxo-insert-into out "
      3. \n")) - (org-export-as-xoxo-insert-into out "
    \n")) - - (goto-char pos) - ;; Finish the buffer off and clean it up. - (switch-to-buffer-other-window out) - (indent-region (point-min) (point-max) nil) - (save-buffer) - (goto-char (point-min)) - ))) - - -;;;; Key bindings - -;; 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 [(meta tab)] 'org-complete) -(org-defkey org-mode-map "\M-\t" 'org-complete) -(org-defkey org-mode-map "\M-\C-i" 'org-complete) -;; The following line is necessary under Suse GNU/Linux -(unless (featurep 'xemacs) - (org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab)) -(org-defkey org-mode-map [(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 [(meta return)] '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 [(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) - -;;; Extra keys for tty access. -;; We only set them when really needed because otherwise the -;; menus don't show the simple keys - -(when (or (featurep 'xemacs) ;; because XEmacs supports multi-device stuff - (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)) - - ;; All the other keys - -(org-defkey org-mode-map "\C-c\C-a" 'show-all) ; in case allout messed up. -(org-defkey org-mode-map "\C-c\C-r" 'org-reveal) -(org-defkey org-mode-map "\C-xns" 'org-narrow-to-subtree) -(org-defkey org-mode-map "\C-c$" 'org-archive-subtree) -(org-defkey org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree) -(org-defkey org-mode-map "\C-c\C-x\C-a" 'org-toggle-archive-tag) -(org-defkey org-mode-map "\C-c\C-xb" 'org-tree-to-indirect-buffer) -(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-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-v" 'org-show-todo-tree) -(org-defkey org-mode-map "\C-c\C-w" 'org-refile) -(org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved -(org-defkey org-mode-map "\C-c\\" 'org-tags-sparse-tree) ; Minor-mode res. -(org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret) -(org-defkey org-mode-map "\M-\C-m" 'org-insert-heading) -(org-defkey org-mode-map [(control return)] 'org-insert-heading-after-current) -(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\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-time-stamp) ; 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-sort) -(org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) -(org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches) -(org-defkey org-mode-map "\C-c#" 'org-update-checkbox-count) -(org-defkey org-mode-map "\C-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-table-edit-formulas) -(org-defkey org-mode-map "\C-c`" 'org-table-edit-field) -(org-defkey org-mode-map "\C-c|" 'org-table-create-or-convert-from-region) -(org-defkey org-mode-map "\C-c*" 'org-table-recalculate) -(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-q" 'org-table-wrap-region) -(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) -(org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width-section) -(org-defkey org-mode-map "\C-c\C-x\C-f" 'org-emphasize) - -(org-defkey org-mode-map "\C-c\C-x\C-k" 'org-cut-special) -(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-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-x" '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-preview-latex-fragment) -(org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox) -(org-defkey org-mode-map "\C-c\C-xp" 'org-set-property) -(org-defkey org-mode-map "\C-c\C-xr" 'org-insert-columns-dblock) - -(define-key org-mode-map "\C-c\C-x\C-c" 'org-columns) - -(when (featurep 'xemacs) - (org-defkey org-mode-map 'button3 'popup-mode-menu)) - -(defsubst org-table-p () (org-at-table-p)) - -(defun org-self-insert-command (N) - "Like `self-insert-command', use overwrite-mode for whitespace in tables. -If the cursor is in a table looking at whitespace, the whitespace is -overwritten, and the table is not marked as requiring realignment." - (interactive "p") - (if (and (org-table-p) - (progn - ;; check if we blank the field, and if that triggers align - (and org-table-auto-blank-field - (member last-command - '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c)) - (if (or (equal (char-after) ?\ ) (looking-at "[^|\n]* |")) - ;; got extra space, this field does not determine column width - (let (org-table-may-need-update) (org-table-blank-field)) - ;; no extra space, this field may determine column width - (org-table-blank-field))) - t) - (eq N 1) - (looking-at "[^|\n]* |")) - (let (org-table-may-need-update) - (goto-char (1- (match-end 0))) - (delete-backward-char 1) - (goto-char (match-beginning 0)) - (self-insert-command N)) - (setq org-table-may-need-update t) - (self-insert-command N) - (org-fix-tags-on-the-fly))) - -(defun org-fix-tags-on-the-fly () - (when (and (equal (char-after (point-at-bol)) ?*) - (org-on-heading-p)) - (org-align-tags-here org-tags-column))) - -(defun org-delete-backward-char (N) - "Like `delete-backward-char', insert whitespace at field end in tables. -When deleting backwards, in tables this function will insert whitespace in -front of the next \"|\" separator, to keep the table aligned. The table will -still be marked for re-alignment if the field did fill the entire column, -because, in this case the deletion might narrow the column." - (interactive "p") - (if (and (org-table-p) - (eq N 1) - (string-match "|" (buffer-substring (point-at-bol) (point))) - (looking-at ".*?|")) - (let ((pos (point)) - (noalign (looking-at "[^|\n\r]* |")) - (c org-table-may-need-update)) - (backward-delete-char N) - (skip-chars-forward "^|") - (insert " ") - (goto-char (1- pos)) - ;; noalign: if there were two spaces at the end, this field - ;; does not determine the width of the column. - (if noalign (setq org-table-may-need-update c))) - (backward-delete-char N) - (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") - (if (and (org-table-p) - (not (bolp)) - (not (= (char-after) ?|)) - (eq N 1)) - (if (looking-at ".*?|") - (let ((pos (point)) - (noalign (looking-at "[^|\n\r]* |")) - (c org-table-may-need-update)) - (replace-match (concat - (substring (match-string 0) 1 -1) - " |")) - (goto-char pos) - ;; noalign: if there were two spaces at the end, this field - ;; does not determine the width of the column. - (if noalign (setq org-table-may-need-update c))) - (delete-char N)) - (delete-char N) - (org-fix-tags-on-the-fly))) - -;; Make `delete-selection-mode' work with org-mode and orgtbl-mode -(put 'org-self-insert-command 'delete-selection t) -(put 'orgtbl-self-insert-command 'delete-selection t) -(put 'org-delete-char 'delete-selection 'supersede) -(put 'org-delete-backward-char 'delete-selection 'supersede) - -;; 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 'orgybl-self-insert-command 'pabbrev-expand-after-command t) - -;; How to do this: Measure non-white length of current string -;; If equal to column width, we should realign. - -(defun org-remap (map &rest commands) - "In MAP, remap the functions given in COMMANDS. -COMMANDS is a list of alternating OLDDEF NEWDEF command names." - (let (new old) - (while commands - (setq old (pop commands) new (pop commands)) - (if (fboundp 'command-remapping) - (org-defkey map (vector 'remap old) new) - (substitute-key-definition old new map global-map))))) - -(when (eq org-enable-table-editor 'optimized) - ;; If the user wants maximum table support, we need to hijack - ;; some standard editing functions - (org-remap org-mode-map - 'self-insert-command 'org-self-insert-command - 'delete-char 'org-delete-char - 'delete-backward-char 'org-delete-backward-char) - (org-defkey org-mode-map "|" 'org-force-self-insert)) - -(defun org-shiftcursor-error () - "Throw an error because Shift-Cursor command was applied in wrong context." - (error "This command is active in special context like tables, headlines or timestamps")) - -(defun org-shifttab (&optional arg) - "Global visibility cycling or move to previous table field. -Calls `org-cycle' with argument t, or `org-table-previous-field', depending -on context. -See the individual commands for more information." - (interactive "P") - (cond - ((org-at-table-p) (call-interactively 'org-table-previous-field)) - (arg (message "Content view to level: ") - (org-content (prefix-numeric-value arg)) - (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', -or `org-table-delete-column', depending on context. -See the individual commands for more information." - (interactive) - (cond - ((org-at-table-p) (call-interactively 'org-table-delete-column)) - ((org-on-heading-p) (call-interactively 'org-promote-subtree)) - ((org-at-item-p) (call-interactively 'org-outdent-item)) - (t (org-shiftcursor-error)))) - -(defun org-shiftmetaright () - "Demote subtree or insert table column. -Calls `org-demote-subtree', `org-indent-item', -or `org-table-insert-column', depending on context. -See the individual commands for more information." - (interactive) - (cond - ((org-at-table-p) (call-interactively 'org-table-insert-column)) - ((org-on-heading-p) (call-interactively 'org-demote-subtree)) - ((org-at-item-p) (call-interactively 'org-indent-item)) - (t (org-shiftcursor-error)))) - -(defun org-shiftmetaup (&optional arg) - "Move subtree up or kill table row. -Calls `org-move-subtree-up' or `org-table-kill-row' or -`org-move-item-up' depending on context. See the individual commands -for more information." - (interactive "P") - (cond - ((org-at-table-p) (call-interactively 'org-table-kill-row)) - ((org-on-heading-p) (call-interactively 'org-move-subtree-up)) - ((org-at-item-p) (call-interactively 'org-move-item-up)) - (t (org-shiftcursor-error)))) -(defun org-shiftmetadown (&optional arg) - "Move subtree down or insert table row. -Calls `org-move-subtree-down' or `org-table-insert-row' or -`org-move-item-down', depending on context. See the individual -commands for more information." - (interactive "P") - (cond - ((org-at-table-p) (call-interactively 'org-table-insert-row)) - ((org-on-heading-p) (call-interactively 'org-move-subtree-down)) - ((org-at-item-p) (call-interactively 'org-move-item-down)) - (t (org-shiftcursor-error)))) - -(defun org-metaleft (&optional arg) - "Promote heading or move table column to left. -Calls `org-do-promote' or `org-table-move-column', depending on context. -With no specific context, calls the Emacs default `backward-word'. -See the individual commands for more information." - (interactive "P") - (cond - ((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left)) - ((or (org-on-heading-p) (org-region-active-p)) - (call-interactively 'org-do-promote)) - ((org-at-item-p) (call-interactively 'org-outdent-item)) - (t (call-interactively 'backward-word)))) - -(defun org-metaright (&optional arg) - "Demote subtree or move table column to right. -Calls `org-do-demote' or `org-table-move-column', depending on context. -With no specific context, calls the Emacs default `forward-word'. -See the individual commands for more information." - (interactive "P") - (cond - ((org-at-table-p) (call-interactively 'org-table-move-column)) - ((or (org-on-heading-p) (org-region-active-p)) - (call-interactively 'org-do-demote)) - ((org-at-item-p) (call-interactively 'org-indent-item)) - (t (call-interactively 'forward-word)))) - -(defun org-metaup (&optional arg) - "Move subtree up or move table row up. -Calls `org-move-subtree-up' or `org-table-move-row' or -`org-move-item-up', depending on context. See the individual commands -for more information." - (interactive "P") - (cond - ((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up)) - ((org-on-heading-p) (call-interactively 'org-move-subtree-up)) - ((org-at-item-p) (call-interactively 'org-move-item-up)) - (t (transpose-lines 1) (beginning-of-line -1)))) - -(defun org-metadown (&optional arg) - "Move subtree down or move table row down. -Calls `org-move-subtree-down' or `org-table-move-row' or -`org-move-item-down', depending on context. See the individual -commands for more information." - (interactive "P") - (cond - ((org-at-table-p) (call-interactively 'org-table-move-row)) - ((org-on-heading-p) (call-interactively 'org-move-subtree-down)) - ((org-at-item-p) (call-interactively 'org-move-item-down)) - (t (beginning-of-line 2) (transpose-lines 1) (beginning-of-line 0)))) - -(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 - ((org-at-timestamp-p t) - (call-interactively (if org-edit-timestamp-down-means-later - 'org-timestamp-down 'org-timestamp-up))) - ((org-on-heading-p) (call-interactively 'org-priority-up)) - ((org-at-item-p) (call-interactively 'org-previous-item)) - (t (call-interactively 'org-beginning-of-item) (beginning-of-line 1)))) - -(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 - ((org-at-timestamp-p t) - (call-interactively (if org-edit-timestamp-down-means-later - 'org-timestamp-up 'org-timestamp-down))) - ((org-on-heading-p) (call-interactively 'org-priority-down)) - (t (call-interactively 'org-next-item)))) - -(defun org-shiftright () - "Next TODO keyword or timestamp one day later, depending on context." - (interactive) - (cond - ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day)) - ((org-on-heading-p) (org-call-with-arg 'org-todo 'right)) - ((org-at-item-p) (org-call-with-arg 'org-cycle-list-bullet nil)) - ((org-at-property-p) (call-interactively 'org-property-next-allowed-value)) - (t (org-shiftcursor-error)))) - -(defun org-shiftleft () - "Previous TODO keyword or timestamp one day earlier, depending on context." - (interactive) - (cond - ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day)) - ((org-on-heading-p) (org-call-with-arg 'org-todo 'left)) - ((org-at-item-p) (org-call-with-arg 'org-cycle-list-bullet 'previous)) - ((org-at-property-p) - (call-interactively 'org-property-previous-allowed-value)) - (t (org-shiftcursor-error)))) - -(defun org-shiftcontrolright () - "Switch to next TODO set." - (interactive) - (cond - ((org-on-heading-p) (org-call-with-arg 'org-todo 'nextset)) - (t (org-shiftcursor-error)))) - -(defun org-shiftcontrolleft () - "Switch to previous TODO set." - (interactive) - (cond - ((org-on-heading-p) (org-call-with-arg 'org-todo 'previousset)) - (t (org-shiftcursor-error)))) - -(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-copy-special () - "Copy region in table or copy current subtree. -Calls `org-table-copy' or `org-copy-subtree', depending on context. -See the individual commands for more information." - (interactive) - (call-interactively - (if (org-at-table-p) 'org-table-copy-region 'org-copy-subtree))) - -(defun org-cut-special () - "Cut region in table or cut current subtree. -Calls `org-table-copy' or `org-cut-subtree', depending on context. -See the individual commands for more information." - (interactive) - (call-interactively - (if (org-at-table-p) 'org-table-cut-region 'org-cut-subtree))) - -(defun org-paste-special (arg) - "Paste rectangular region into table, or past subtree relative to level. -Calls `org-table-paste-rectangle' or `org-paste-subtree', depending on context. -See the individual commands for more information." - (interactive "P") - (if (org-at-table-p) - (org-table-paste-rectangle) - (org-paste-subtree arg))) - -(defun org-ctrl-c-ctrl-c (&optional arg) - "Set tags in headline, or update according to changed information at point. - -This command does many different things, depending on context: - -- If the cursor is in a headline, prompt for tags and insert them - into the current line, aligned to `org-tags-column'. When called - with prefix arg, realign all tags in the current buffer. - -- If the cursor is in one of the special #+KEYWORD lines, this - triggers scanning the buffer for these lines and updating the - information. - -- If the cursor is inside a table, realign the table. This command - works even if the automatic table editor has been turned off. - -- If the cursor is on a #+TBLFM line, re-apply the formulas to - the entire table. - -- If the cursor is a the beginning of a dynamic block, update it. - -- If the cursor is inside a table created by the table.el package, - activate that table. - -- If the current buffer is a remember buffer, close note and file it. - with a prefix argument, file it without further interaction to the default - location. - -- If the cursor is on a <<>>, 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." - (interactive "P") - (let ((org-enable-table-editor t)) - (cond - ((or org-clock-overlays - org-occur-highlights - org-latex-fragment-image-overlays) - (org-remove-clock-overlays) - (org-remove-occur-highlights) - (org-remove-latex-fragment-image-overlays) - (message "Temporary highlights/overlays removed from current buffer")) - ((and (local-variable-p 'org-finish-function (current-buffer)) - (fboundp org-finish-function)) - (funcall org-finish-function)) - ((org-at-property-p) - (call-interactively 'org-property-action)) - ((org-on-target-p) (call-interactively 'org-update-radio-target-regexp)) - ((org-on-heading-p) (call-interactively 'org-set-tags)) - ((org-at-table.el-p) - (require 'table) - (beginning-of-line 1) - (re-search-forward "|" (save-excursion (end-of-line 2) (point))) - (call-interactively 'table-recognize-table)) - ((org-at-table-p) - (org-table-maybe-eval-formula) - (if arg - (call-interactively 'org-table-recalculate) - (org-table-maybe-recalculate-line)) - (call-interactively 'org-table-align)) - ((org-at-item-checkbox-p) - (call-interactively 'org-toggle-checkbox)) - ((org-at-item-p) - (call-interactively 'org-maybe-renumber-ordered-list)) - ((save-excursion (beginning-of-line 1) (looking-at "#\\+BEGIN:")) - ;; Dynamic block - (beginning-of-line 1) - (org-update-dblock)) - ((save-excursion (beginning-of-line 1) (looking-at "#\\+\\([A-Z]+\\)")) - (cond - ((equal (match-string 1) "TBLFM") - ;; Recalculate the table before this line - (save-excursion - (beginning-of-line 1) - (skip-chars-backward " \r\n\t") - (if (org-at-table-p) - (org-call-with-arg 'org-table-recalculate t)))) - (t - (call-interactively 'org-mode-restart)))) - (t (error "C-c C-c can do nothing useful at this location."))))) - -(defun org-mode-restart () - "Restart Org-mode, to scan again for special lines. -Also updates the keyword regular expressions." - (interactive) - (let ((org-inhibit-startup t)) (org-mode)) - (message "Org-mode restarted to refresh keyword and special line setup")) - -(defun org-kill-note-or-show-branches () - "If this is a Note buffer, abort storing the note. Else call `show-branches'." - (interactive) - (if (not org-finish-function) - (call-interactively 'show-branches) - (let ((org-note-abort t)) - (funcall org-finish-function)))) - -(defun org-return (&optional indent) - "Goto next table row or insert a newline. -Calls `org-table-next-row' or `newline', depending on context. -See the individual commands for more information." - (interactive) - (cond - ((bobp) (if indent (newline-and-indent) (newline))) - ((org-at-table-p) - (org-table-justify-field-maybe) - (call-interactively 'org-table-next-row)) - (t (if indent (newline-and-indent) (newline))))) - -(defun org-return-indent () - (interactive) - "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." - (org-return t)) - -(defun org-ctrl-c-minus () - "Insert separator line in table or modify bullet type in list. -Calls `org-table-insert-hline' or `org-cycle-list-bullet', -depending on context." - (interactive) - (cond - ((org-at-table-p) - (call-interactively 'org-table-insert-hline)) - ((org-on-heading-p) - ;; Convert to item - (save-excursion - (beginning-of-line 1) - (if (looking-at "\\*+ ") - (replace-match (concat (make-string (- (match-end 0) (point)) ?\ ) "- "))))) - ((org-in-item-p) - (call-interactively 'org-cycle-list-bullet)) - (t (error "`C-c -' does have no function here.")))) - -(defun org-meta-return (&optional arg) - "Insert a new heading or wrap a region in a table. -Calls `org-insert-heading' or `org-table-wrap-region', depending on context. -See the individual commands for more information." - (interactive "P") - (cond - ((org-at-table-p) - (call-interactively 'org-table-wrap-region)) - (t (call-interactively 'org-insert-heading)))) - -;;; Menu entries - -;; Define the Org-mode menus -(easy-menu-define org-tbl-menu org-mode-map "Tbl menu" - '("Tbl" - ["Align" org-ctrl-c-ctrl-c (org-at-table-p)] - ["Next Field" org-cycle (org-at-table-p)] - ["Previous Field" org-shifttab (org-at-table-p)] - ["Next Row" org-return (org-at-table-p)] - "--" - ["Blank Field" org-table-blank-field (org-at-table-p)] - ["Edit Field" org-table-edit-field (org-at-table-p)] - ["Copy Field from Above" org-table-copy-down (org-at-table-p)] - "--" - ("Column" - ["Move Column Left" org-metaleft (org-at-table-p)] - ["Move Column Right" org-metaright (org-at-table-p)] - ["Delete Column" org-shiftmetaleft (org-at-table-p)] - ["Insert Column" org-shiftmetaright (org-at-table-p)]) - ("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-table-edit-formulas (org-at-table-p)] - "--" - ["Recalculate line" org-table-recalculate (org-at-table-p)] - ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"] - ["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 org-table-formula-debug] - ["Show Col/Row Numbers" - org-table-toggle-coordinate-overlays - :style toggle :selected org-table-overlay-coordinates] - "--" - ["Create" org-table-create (and (not (org-at-table-p)) - org-enable-table-editor)] - ["Convert Region" org-table-convert-region (not (org-at-table-p 'any))] - ["Import from File" org-table-import (not (org-at-table-p))] - ["Export to File" org-table-export (org-at-table-p)] - "--" - ["Create/Convert from/to table.el" org-table-create-with-table.el t])) - -(easy-menu-define org-org-menu org-mode-map "Org menu" - '("Org" - ("Show/Hide" - ["Cycle Visibility" org-cycle (or (bobp) (outline-on-heading-p))] - ["Cycle Global Visibility" org-shifttab (not (org-at-table-p))] - ["Sparse Tree" org-occur t] - ["Reveal Context" org-reveal t] - ["Show All" 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" - ["Move Subtree Up" org-shiftmetaup (not (org-at-table-p))] - ["Move Subtree Down" org-shiftmetadown (not (org-at-table-p))] - "--" - ["Copy Subtree" org-copy-special (not (org-at-table-p))] - ["Cut Subtree" org-cut-special (not (org-at-table-p))] - ["Paste Subtree" org-paste-special (not (org-at-table-p))] - "--" - ["Promote Heading" org-metaleft (not (org-at-table-p))] - ["Promote Subtree" org-shiftmetaleft (not (org-at-table-p))] - ["Demote Heading" org-metaright (not (org-at-table-p))] - ["Demote Subtree" org-shiftmetaright (not (org-at-table-p))] - "--" - ["Sort Region/Children" org-sort (not (org-at-table-p))] - "--" - ["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]) - ("Archive" - ["Toggle ARCHIVE tag" org-toggle-archive-tag t] -; ["Check and Tag Children" (org-toggle-archive-tag (4)) -; :active t :keys "C-u C-c C-x C-a"] - ["Sparse trees open ARCHIVE trees" - (setq org-sparse-tree-open-archived-trees - (not org-sparse-tree-open-archived-trees)) - :style toggle :selected org-sparse-tree-open-archived-trees] - ["Cycling opens ARCHIVE trees" - (setq org-cycle-open-archived-trees (not org-cycle-open-archived-trees)) - :style toggle :selected org-cycle-open-archived-trees] - ["Agenda includes ARCHIVE trees" - (setq org-agenda-skip-archived-trees (not org-agenda-skip-archived-trees)) - :style toggle :selected (not org-agenda-skip-archived-trees)] - "--" - ["Move Subtree to Archive" org-advertized-archive-subtree t] - ; ["Check and Move Children" (org-archive-subtree '(4)) - ; :active t :keys "C-u C-c C-x C-s"] - ) - "--" - ("TODO Lists" - ["TODO/DONE/-" org-todo t] - ("Select keyword" - ["Next keyword" org-shiftright (org-on-heading-p)] - ["Previous keyword" org-shiftleft (org-on-heading-p)] - ["Complete Keyword" org-complete (assq :todo-keyword (org-context))] - ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))] - ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))]) - ["Show TODO Tree" org-show-todo-tree t] - ["Global TODO list" org-todo-list t] - "--" - ["Set Priority" org-priority t] - ["Priority Up" org-shiftup t] - ["Priority Down" org-shiftdown t]) - ("TAGS and Properties" - ["Set Tags" 'org-ctrl-c-ctrl-c (org-at-heading-p)] - ["Change tag in region" 'org-change-tag-in-region (org-region-active-p)] - "--" - ["Set property" 'org-set-property t] - ["Column view of properties" org-columns t] - ["Insert Column View DBlock" org-insert-columns-dblock t]) - ("Dates and Scheduling" - ["Timestamp" org-time-stamp t] - ["Timestamp (inactive)" org-time-stamp-inactive t] - ("Change Date" - ["1 Day Later" org-shiftright t] - ["1 Day Earlier" org-shiftleft t] - ["1 ... Later" org-shiftup t] - ["1 ... Earlier" org-shiftdown t]) - ["Compute Time Range" org-evaluate-time-range t] - ["Schedule Item" org-schedule t] - ["Deadline" org-deadline t] - "--" - ["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]) - ("Logging work" - ["Clock in" org-clock-in t] - ["Clock out" org-clock-out t] - ["Clock cancel" org-clock-cancel t] - ["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] - ["Timeline" org-timeline t] - ["Tags Tree" org-tags-sparse-tree t]) - "--" - ("Hyperlinks" - ["Store Link (Global)" org-store-link t] - ["Insert Link" org-insert-link t] - ["Follow Link" org-open-at-point t] - "--" - ["Next link" org-next-link t] - ["Previous link" org-previous-link t] - "--" - ["Descriptive Links" - (progn (org-add-to-invisibility-spec '(org-link)) (org-restart-font-lock)) - :style radio :selected (member '(org-link) buffer-invisibility-spec)] - ["Literal Links" - (progn - (org-remove-from-invisibility-spec '(org-link)) (org-restart-font-lock)) - :style radio :selected (not (member '(org-link) buffer-invisibility-spec))]) - "--" - ["Export/Publish..." org-export t] - ("LaTeX" - ["Org CDLaTeX mode" org-cdlatex-mode :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)] - ["Export LaTeX fragments as images" - (setq org-export-with-LaTeX-fragments (not org-export-with-LaTeX-fragments)) - :style toggle :selected org-export-with-LaTeX-fragments]) - "--" - ("Documentation" - ["Show Version" org-version t] - ["Info Documentation" org-info t]) - ("Customize" - ["Browse Org Group" org-customize t] - "--" - ["Expand This Menu" org-create-customize-menu - (fboundp 'customize-menu-create)]) - "--" - ["Refresh setup" org-mode-restart t] - )) - -(defun org-info (&optional node) - "Read documentation for Org-mode in the info system. -With optional NODE, go directly to that node." - (interactive) - (require 'info) - (Info-goto-node (format "(org)%s" (or node "")))) - -(defun org-install-agenda-files-menu () - (let ((bl (buffer-list))) - (save-excursion - (while bl - (set-buffer (pop bl)) - (if (org-mode-p) (setq bl nil))) - (when (org-mode-p) - (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 (org-agenda-files t)))))))) - -;;;; Documentation - -(defun org-customize () - "Call the customize function with org as argument." - (interactive) - (customize-browse 'org)) - -(defun org-create-customize-menu () - "Create a full customization menu for Org-mode, insert it into the menu." - (interactive) - (if (fboundp 'customize-menu-create) - (progn - (easy-menu-change - '("Org") "Customize" - `(["Browse Org group" org-customize t] - "--" - ,(customize-menu-create 'org) - ["Set" Custom-set t] - ["Save" Custom-save t] - ["Reset to Current" Custom-reset-current t] - ["Reset to Saved" Custom-reset-saved t] - ["Reset to Standard Settings" Custom-reset-standard t])) - (message "\"Org\"-menu now contains full customization menu")) - (error "Cannot expand menu (outdated version of cus-edit.el)"))) - -;;;; Miscellaneous stuff - - -;;; Generally useful functions - -(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-mode table -:table-special on a special filed in a table -:table-table in a table.el table -:link on a hyperlink -:keyword on a keyword: SCHEDULED, DEADLINE, CLOSE,COMMENT, QUOTE. -:target on a <> -:radio-target on a <<>> -:latex-fragment on a LaTeX fragment -:latex-preview on a LaTeX fragment with overlayed 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))) - (p (point)) clist o) - ;; First the large context - (cond - ((org-on-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 (eobp) (backward-char 1)) - (if (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) - (if (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) - - ;; 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-on-target-p) - (push (org-point-in-group p 0 :target) clist) - (goto-char (1- (match-beginning 0))) - (if (looking-at org-radio-target-regexp) - (push (org-point-in-group p 0 :radio-target) clist)) - (goto-char p)) - ((setq o (car (delq nil - (mapcar - (lambda (x) - (if (memq x org-latex-fragment-image-overlays) x)) - (org-overlays-at (point)))))) - (push (list :latex-fragment - (org-overlay-start o) (org-overlay-end o)) clist) - (push (list :latex-preview - (org-overlay-start o) (org-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)) - -;; FIXME: Compare with at-regexp-p Do we need both? -(defun org-in-regexp (re &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 both before and after 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." - (catch 'exit - (let ((pos (point)) - (eol (point-at-eol (+ 1 (or nlines 0)))) - (inc (if visually 1 0))) - (save-excursion - (beginning-of-line (- 1 (or nlines 0))) - (while (re-search-forward re eol t) - (if (and (<= (match-beginning 0) pos) - (>= (+ inc (match-end 0)) pos)) - (throw 'exit (cons (match-beginning 0) (match-end 0))))))))) - -(defun org-at-regexp-p (regexp) - "Is point inside a match of REGEXP in the current line?" - (catch 'exit - (save-excursion - (let ((pos (point)) (end (point-at-eol))) - (beginning-of-line 1) - (while (re-search-forward regexp end t) - (if (and (<= (match-beginning 0) pos) - (>= (match-end 0) pos)) - (throw 'exit t))) - nil)))) - -(defun org-occur-in-agenda-files (regexp &optional nlines) - "Call `multi-occur' with buffers for all agenda files." - (interactive "sOrg-files matching: \np") - (let* ((files (org-agenda-files)) - (tnames (mapcar 'file-truename files)) - (extra org-agenda-multi-occur-extra-files) - f) - (while (setq f (pop extra)) - (unless (member (file-truename f) tnames) - (add-to-list 'files f 'append) - (add-to-list 'tnames (file-truename f) 'append))) - (multi-occur - (mapcar (lambda (x) (or (get-file-buffer x) (find-file-noselect x))) files) - regexp))) - -(defun org-uniquify (list) - "Remove duplicate elements from LIST." - (let (res) - (mapc (lambda (x) (add-to-list 'res x 'append)) list) - res)) - -(defun org-delete-all (elts list) - "Remove all elements in ELTS from LIST." - (while elts - (setq list (delete (pop elts) list))) - list) - -(defun org-back-over-empty-lines () - "Move backwards over witespace, to the beginning of the first empty line. -Returns the number o empty lines passed." - (let ((pos (point))) - (skip-chars-backward " \t\n\r") - (beginning-of-line 2) - (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 ot 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." - (let (pop-up-frames special-display-buffer-names special-display-regexps - special-display-function) - (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-move-line-down (arg) - "Move the current line down. With prefix argument, move it past ARG lines." - (interactive "p") - (let ((col (current-column)) - beg end pos) - (beginning-of-line 1) (setq beg (point)) - (beginning-of-line 2) (setq end (point)) - (beginning-of-line (+ 1 arg)) - (setq pos (move-marker (make-marker) (point))) - (insert (delete-and-extract-region beg end)) - (goto-char pos) - (move-to-column col))) - -(defun org-move-line-up (arg) - "Move the current line up. With prefix argument, move it past ARG lines." - (interactive "p") - (let ((col (current-column)) - beg end pos) - (beginning-of-line 1) (setq beg (point)) - (beginning-of-line 2) (setq end (point)) - (beginning-of-line (- arg)) - (setq pos (move-marker (make-marker) (point))) - (insert (delete-and-extract-region beg end)) - (goto-char pos) - (move-to-column col))) - -(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 ((case-fold-search nil) - e re rpl) - (while (setq e (pop table)) - (setq re (concat "%-?[0-9.]*" (substring (car e) 1))) - (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)))) - string)) - - -(defun org-sublist (list start end) - "Return a section of LIST, from START to END. -Counting starts at 1." - (let (rtn (c start)) - (setq list (nthcdr (1- start) list)) - (while (and list (<= c end)) - (push (pop list) rtn) - (setq c (1+ c))) - (nreverse rtn))) - -(defun org-find-base-buffer-visiting (file) - "Like `find-buffer-visiting' but alway return the base buffer and -not an indirect buffer" - (let ((buf (find-buffer-visiting file))) - (if buf - (or (buffer-base-buffer buf) buf) - nil))) - -(defun org-image-file-name-regexp () - "Return regexp matching the file names of images." - (if (fboundp 'image-file-name-regexp) - (image-file-name-regexp) - (let ((image-file-name-extensions - '("png" "jpeg" "jpg" "gif" "tiff" "tif" - "xbm" "xpm" "pbm" "pgm" "ppm"))) - (concat "\\." - (regexp-opt (nconc (mapcar 'upcase - image-file-name-extensions) - image-file-name-extensions) - t) - "\\'")))) - -(defun org-file-image-p (file) - "Return non-nil if FILE is an image." - (save-match-data - (string-match (org-image-file-name-regexp) file))) - -;;; Paragraph filling stuff. -;; We want this to be just right, so use the full arsenal. - -(defun org-indent-line-function () - "Indent line like previous, but further if previous was headline or item." - (interactive) - (let* ((pos (point)) - (itemp (org-at-item-p)) - column bpos bcol tpos tcol bullet btype bullet-type) - ;; Find the previous relevant line - (beginning-of-line 1) - (cond - ((looking-at "#") (setq column 0)) - ((looking-at "\\*+ ") (setq column 0)) - (t - (beginning-of-line 0) - (while (and (not (bobp)) (looking-at "[ \t]*[\n:#|]")) - (beginning-of-line 0)) - (cond - ((looking-at "\\*+[ \t]+") - (goto-char (match-end 0)) - (setq column (current-column))) - ((org-in-item-p) - (org-beginning-of-item) -; (looking-at "[ \t]*\\(\\S-+\\)[ \t]*") - (looking-at "[ \t]*\\(\\S-+\\)[ \t]*\\(\\[[- X]\\][ \t]*\\)?") - (setq bpos (match-beginning 1) tpos (match-end 0) - bcol (progn (goto-char bpos) (current-column)) - tcol (progn (goto-char tpos) (current-column)) - bullet (match-string 1) - bullet-type (if (string-match "[0-9]" bullet) "n" bullet)) - (if (not itemp) - (setq column tcol) - (goto-char pos) - (beginning-of-line 1) - (if (looking-at "\\S-") - (progn - (looking-at "[ \t]*\\(\\S-+\\)[ \t]*") - (setq bullet (match-string 1) - btype (if (string-match "[0-9]" bullet) "n" bullet)) - (setq column (if (equal btype bullet-type) bcol tcol))) - (setq column (org-get-indentation))))) - (t (setq column (org-get-indentation)))))) - (goto-char pos) - (if (<= (current-column) (current-indentation)) - (indent-line-to column) - (save-excursion (indent-line-to column))) - (setq column (current-column)) - (beginning-of-line 1) - (if (looking-at - "\\([ \t]+\\)\\(:[-_0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)") - (replace-match (concat "\\1" (format org-property-format - (match-string 2) (match-string 3))) - t nil)) - (move-to-column column))) - -(defun org-set-autofill-regexps () - (interactive) - ;; In the paragraph separator we include headlines, because filling - ;; text in a line directly attached to a headline would otherwise - ;; fill the headline as well. - (org-set-local 'comment-start-skip "^#+[ \t]*") - (org-set-local 'paragraph-separate "\f\\|\\*+ \\|[ ]*$\\|[ \t]*[:|]") - ;; The paragraph starter includes hand-formatted lists. - (org-set-local 'paragraph-start - "\f\\|[ ]*$\\|\\*+ \\|\f\\|[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)\\|[ \t]*[:|]") - ;; Inhibit auto-fill for headers, tables and fixed-width lines. - ;; But only if the user has not turned off tables or fixed-width regions - (org-set-local - 'auto-fill-inhibit-regexp - (concat "\\*+ \\|#\\+" - "\\|[ \t]*" org-keyword-time-regexp - (if (or org-enable-table-editor org-enable-fixed-width-editor) - (concat - "\\|[ \t]*[" - (if org-enable-table-editor "|" "") - (if org-enable-fixed-width-editor ":" "") - "]")))) - ;; We use our own fill-paragraph function, to make sure that tables - ;; and fixed-width regions are not wrapped. That function will pass - ;; through to `fill-paragraph' when appropriate. - (org-set-local 'fill-paragraph-function 'org-fill-paragraph) - ; Adaptive filling: To get full control, first make sure that - ;; `adaptive-fill-regexp' never matches. Then install our own matcher. - (org-set-local 'adaptive-fill-regexp "\000") - (org-set-local 'adaptive-fill-function - 'org-adaptive-fill-function)) - -(defun org-fill-paragraph (&optional justify) - "Re-align a table, pass through to fill-paragraph if no table." - (let ((table-p (org-at-table-p)) - (table.el-p (org-at-table.el-p))) - (cond ((and (equal (char-after (point-at-bol)) ?*) - (save-excursion (goto-char (point-at-bol)) - (looking-at outline-regexp))) - t) ; skip headlines - (table.el-p t) ; skip table.el tables - (table-p (org-table-align) t) ; align org-mode tables - (t nil)))) ; call paragraph-fill - -;; For reference, this is the default value of adaptive-fill-regexp -;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*" - -(defun org-adaptive-fill-function () - "Return a fill prefix for org-mode files. -In particular, this makes sure hanging paragraphs for hand-formatted lists -work correctly." - (cond ((looking-at "#[ \t]+") - (match-string 0)) - ((looking-at "[ \t]*\\([-*+] \\|[0-9]+[.)] \\)?") - (save-excursion - (goto-char (match-end 0)) - (make-string (current-column) ?\ ))) - (t nil))) - -;;;; Functions extending outline functionality - -(defun org-beginning-of-line (&optional arg) - "Go to the beginning of the current line. If that is invisible, continue -to a visible line beginning. This makes the function of C-a more intuitive. -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." - (interactive "P") - (let ((pos (point))) - (beginning-of-line 1) - (if (bobp) - nil - (backward-char 1) - (if (org-invisible-p) - (while (and (not (bobp)) (org-invisible-p)) - (backward-char 1) - (beginning-of-line 1)) - (forward-char 1))) - (when org-special-ctrl-a/e - (cond - ((and (looking-at org-todo-line-regexp) - (= (char-after (match-end 1)) ?\ )) - (goto-char - (if (eq org-special-ctrl-a/e t) - (cond ((> pos (match-beginning 3)) (match-beginning 3)) - ((= pos (point)) (match-beginning 3)) - (t (point))) - (cond ((> pos (point)) (point)) - ((not (eq last-command this-command)) (point)) - (t (match-beginning 3)))))) - ((org-at-item-p) - (goto-char - (if (eq org-special-ctrl-a/e t) - (cond ((> pos (match-end 4)) (match-end 4)) - ((= pos (point)) (match-end 4)) - (t (point))) - (cond ((> pos (point)) (point)) - ((not (eq last-command this-command)) (point)) - (t (match-end 4)))))))))) - -(defun org-end-of-line (&optional arg) - "Go to the end of the 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." - (interactive "P") - (if (or (not org-special-ctrl-a/e) - (not (org-on-heading-p))) - (end-of-line arg) - (let ((pos (point))) - (beginning-of-line 1) - (if (looking-at (org-re ".*?\\([ \t]*\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) - (if (eq org-special-ctrl-a/e t) - (if (or (< pos (match-beginning 1)) - (= pos (match-end 0))) - (goto-char (match-beginning 1)) - (goto-char (match-end 0))) - (if (or (< pos (match-end 0)) (not (eq this-command last-command))) - (goto-char (match-end 0)) - (goto-char (match-beginning 1)))) - (end-of-line arg))))) - -(define-key org-mode-map "\C-a" 'org-beginning-of-line) -(define-key org-mode-map "\C-e" 'org-end-of-line) - -(defun org-invisible-p () - "Check if point is at a character currently not visible." - ;; Early versions of noutline don't have `outline-invisible-p'. - (if (fboundp 'outline-invisible-p) - (outline-invisible-p) - (get-char-property (point) 'invisible))) - -(defun org-invisible-p2 () - "Check if point is at a character currently not visible." - (save-excursion - (if (and (eolp) (not (bobp))) (backward-char 1)) - ;; Early versions of noutline don't have `outline-invisible-p'. - (if (fboundp 'outline-invisible-p) - (outline-invisible-p) - (get-char-property (point) 'invisible)))) - -(defalias 'org-back-to-heading 'outline-back-to-heading) -(defalias 'org-on-heading-p 'outline-on-heading-p) -(defalias 'org-at-heading-p 'outline-on-heading-p) -(defun org-at-heading-or-item-p () - (or (org-on-heading-p) (org-at-item-p))) - -(defun org-on-target-p () - (or (org-in-regexp org-radio-target-regexp) - (org-in-regexp org-target-regexp))) - -(defun org-up-heading-all (arg) - "Move to the heading line of which the present line is a subheading. -This function considers both visible and invisible heading lines. -With argument, move up ARG levels." - (if (fboundp 'outline-up-heading-all) - (outline-up-heading-all arg) ; emacs 21 version of outline.el - (outline-up-heading arg t))) ; emacs 22 version of outline.el - -(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." - (let ((pos (point)) start-level level - (re (concat "^" outline-regexp))) - (catch 'exit - (outline-back-to-heading t) - (setq start-level (funcall outline-level)) - (if (equal start-level 1) (throw 'exit nil)) - (while (re-search-backward re nil t) - (setq level (funcall outline-level)) - (if (< level start-level) (throw 'exit level))) - nil))) - -(defun org-first-sibling-p () - "Is this heading the first child of its parents?" - (interactive) - (let ((re (concat "^" outline-regexp)) - level l) - (unless (org-at-heading-p t) - (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 (concat "^" outline-regexp)) - level l) - (when (condition-case nil (org-back-to-heading t) (error nil)) - (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-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-end-of-subtree (&optional invisible-OK to-heading) - ;; This is an exact copy of the original function, but it uses - ;; `org-back-to-heading', to make it work also in invisible - ;; trees. And is uses an invisible-OK argument. - ;; Under Emacs this is not needed, but the old outline.el needs this fix. - (org-back-to-heading invisible-OK) - (let ((first t) - (level (funcall outline-level))) - (while (and (not (eobp)) - (or first (> (funcall outline-level) level))) - (setq first nil) - (outline-next-heading)) - (unless to-heading - (if (memq (preceding-char) '(?\n ?\^M)) - (progn - ;; Go to end of line before heading - (forward-char -1) - (if (memq (preceding-char) '(?\n ?\^M)) - ;; leave blank line before heading - (forward-char -1)))))) - (point)) - -(defun org-show-subtree () - "Show everything after this heading at deeper levels." - (outline-flag-region - (point) - (save-excursion - (outline-end-of-subtree) (outline-next-heading) (point)) - nil)) - -(defun org-show-entry () - "Show the body directly following this heading. -Show the heading too, if it is currently invisible." - (interactive) - (save-excursion - (condition-case nil - (progn - (org-back-to-heading t) - (outline-flag-region - (max (point-min) (1- (point))) - (save-excursion - (re-search-forward - (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move) - (or (match-beginning 1) (point-max))) - nil)) - (error nil)))) - -(defun org-make-options-regexp (kwds) - "Make a regular expression for keyword lines." - (concat - "^" - "#?[ \t]*\\+\\(" - (mapconcat 'regexp-quote kwds "\\|") - "\\):[ \t]*" - "\\(.+\\)")) - -;; Make isearch reveal the necessary context -(defun org-isearch-end () - "Reveal context after isearch exits." - (when isearch-success ; only if search was successful - (if (featurep 'xemacs) - ;; Under XEmacs, the hook is run in the correct place, - ;; we directly show the context. - (org-show-context 'isearch) - ;; In Emacs the hook runs *before* restoring the overlays. - ;; So we have to use a one-time post-command-hook to do this. - ;; (Emacs 22 has a special variable, see function `org-mode') - (unless (and (boundp 'isearch-mode-end-hook-quit) - isearch-mode-end-hook-quit) - ;; Only when the isearch was not quitted. - (org-add-hook 'post-command-hook 'org-isearch-post-command - 'append 'local))))) - -(defun org-isearch-post-command () - "Remove self from hook, and show context." - (remove-hook 'post-command-hook 'org-isearch-post-command 'local) - (org-show-context 'isearch)) - - -;;;; Integration with and fixes for other packages - -;;; Imenu support - -(defvar org-imenu-markers nil - "All markers currently used by Imenu.") -(make-variable-buffer-local 'org-imenu-markers) - -(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." - (mapc (lambda (x) (move-marker x nil)) org-imenu-markers) - (setq org-imenu-markers nil) - (let* ((n org-imenu-depth) - (re (concat "^" outline-regexp)) - (subs (make-vector (1+ n) nil)) - (last-level 0) - m tree level head) - (save-excursion - (save-restriction - (widen) - (goto-char (point-max)) - (while (re-search-backward re nil t) - (setq level (org-reduced-level (funcall outline-level))) - (when (<= level n) - (looking-at org-complex-heading-regexp) - (setq head (org-match-string-no-properties 4) - 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)) - (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 () (org-show-context 'org-goto))))) - -;; Speedbar support - -(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) - (let (p m tp np dir txt w) - (cond - ((setq p (text-property-any (point-at-bol) (point-at-eol) - 'org-imenu t)) - (setq m (get-text-property p 'org-imenu-marker)) - (save-excursion - (save-restriction - (set-buffer (marker-buffer m)) - (goto-char m) - (org-agenda-set-restriction-lock 'subtree)))) - ((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)))) - (save-excursion - (save-restriction - (set-buffer (find-file-noselect - (let ((default-directory dir)) - (expand-file-name txt)))) - (unless (org-mode-p) - (error "Cannot restrict to non-Org-mode file")) - (org-agenda-set-restriction-lock 'file)))) - (t (error "Don't know how to restrict Org-mode's agenda"))) - (org-move-overlay org-speedbar-restriction-lock-overlay - (point-at-bol) (point-at-eol)) - (setq current-prefix-arg nil) - (org-agenda-maybe-redo))) - -(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 () (org-show-context 'org-goto))))) - - -;;; Fixes and Hacks - -;; Make flyspell not check words in links, to not mess up our keymap -(defun org-mode-flyspell-verify () - "Don't let flyspell put overlays at active buttons." - (not (get-text-property (point) 'keymap))) - -;; Make `bookmark-jump' show the jump location if it was hidden. -(eval-after-load "bookmark" - '(if (boundp 'bookmark-after-jump-hook) - ;; We can use the hook - (add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide) - ;; Hook not available, use advice - (defadvice bookmark-jump (after org-make-visible activate) - "Make the position visible." - (org-bookmark-jump-unhide)))) - -(defun org-bookmark-jump-unhide () - "Unhide the current position, to show the bookmark location." - (and (org-mode-p) - (or (org-invisible-p) - (save-excursion (goto-char (max (point-min) (1- (point)))) - (org-invisible-p))) - (org-show-context 'bookmark-jump))) - -;; Fix a bug in htmlize where there are text properties (face nil) -(eval-after-load "htmlize" - '(progn - (defadvice htmlize-faces-in-buffer (after org-no-nil-faces activate) - "Make sure there are no nil faces" - (setq ad-return-value (delq nil ad-return-value))))) - -;; Make session.el ignore our circular variable -(eval-after-load "session" - '(add-to-list 'session-globals-exclude 'org-mark-ring)) - -;;;; Experimental code - -(defun org-closed-in-range () - "Sparse tree of items closed in a certain time range. -Still experimental, may disappear in the future." - (interactive) - ;; Get the time interval from the user. - (let* ((time1 (time-to-seconds - (org-read-date nil 'to-time nil "Starting date: "))) - (time2 (time-to-seconds - (org-read-date nil 'to-time nil "End date:"))) - ;; callback function - (callback (lambda () - (let ((time - (time-to-seconds - (apply 'encode-time - (org-parse-time-string - (match-string 1)))))) - ;; check if time in interval - (and (>= time time1) (<= time time2)))))) - ;; make tree, check each match with the callback - (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback))) - -;;;; Finish up - -(provide 'org) - -(run-hooks 'org-load-hook) - -;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd -;;; org.el ends here - diff --git a/org.el b/org.el index 722adc65b..0ac934188 100644 --- a/org.el +++ b/org.el @@ -21245,9 +21245,10 @@ The prefix arg TODO-ONLY limits the search to TODO entries." (setq matcher (org-make-tags-matcher match) match (car matcher) matcher (cdr matcher)) (org-prepare-agenda (concat "TAGS " match)) + (setq org-agenda-query-string match) (setq org-agenda-redo-command (list 'org-tags-view (list 'quote todo-only) - (list 'if 'current-prefix-arg nil match))) + (list 'if 'current-prefix-arg nil 'org-agenda-query-string))) (setq files (org-agenda-files) rtnall nil) (while (setq file (pop files))