diff options
Diffstat (limited to 'lisp/org/org.el')
| -rw-r--r-- | lisp/org/org.el | 787 |
1 files changed, 427 insertions, 360 deletions
diff --git a/lisp/org/org.el b/lisp/org/org.el index d4120b4224e..32ed13fc1a3 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -1219,7 +1219,15 @@ See also the QUOTE keyword." :type 'boolean) (defcustom org-goto-auto-isearch t - "Non-nil means typing characters in `org-goto' starts incremental search." + "Non-nil means typing characters in `org-goto' starts incremental search. +When nil, you can use these keybindings to navigate the buffer: + + q Quit the org-goto interface + n Go to the next visible heading + p Go to the previous visible heading + f Go one heading forward on same level + b Go one heading backward on same level + u Go one heading up" :group 'org-edit-structure :type 'boolean) @@ -2236,8 +2244,9 @@ Lisp variable `org-state'." (defvar org-blocker-hook nil "Hook for functions that are allowed to block a state change. -Each function gets as its single argument a property list, see -`org-trigger-hook' for more information about this list. +Functions in this hook should not modify the buffer. +Each function gets as its single argument a property list, +see `org-trigger-hook' for more information about this list. If any of the functions in this hook returns nil, the state change is blocked.") @@ -2245,8 +2254,8 @@ is blocked.") (defvar org-trigger-hook nil "Hook for functions that are triggered by a state change. -Each function gets as its single argument a property list with at least -the following elements: +Each function gets as its single argument a property list with at +least the following elements: (:type type-of-change :position pos-at-entry-start :from old-state :to new-state) @@ -2979,7 +2988,7 @@ When nil, only the tags directly given in a specific line apply there. This may also be a list of tags that should be inherited, or a regexp that matches tags that should be inherited. Additional control is possible with the variable `org-tags-exclude-from-inheritance' which gives an -explicit list of tags to be excluded from inheritance., even if the value of +explicit list of tags to be excluded from inheritance, even if the value of `org-use-tag-inheritance' would select it for inheritance. If this option is t, a match early-on in a tree can lead to a large @@ -3952,7 +3961,7 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (beginning-of-line 1) (when (and (looking-at org-table-line-regexp) ;; Exclude tables in src/example/verbatim/clocktable blocks - (not (org-in-block-p '("src" "example")))) + (not (org-in-block-p '("src" "example" "verbatim" "clocktable")))) (save-excursion (funcall function)) (or (looking-at org-table-line-regexp) (forward-char 1))) @@ -5007,13 +5016,15 @@ The following commands are available: (defun org-find-invisible-foreground () (let ((candidates (remove "unspecified-bg" - (list - (face-background 'default) - (face-background 'org-default) - (cdr (assoc 'background-color default-frame-alist)) - (cdr (assoc 'background-color initial-frame-alist)) - (cdr (assoc 'background-color window-system-default-frame-alist)) - (face-foreground 'org-hide))))) + (nconc + (list (face-background 'default) + (face-background 'org-default)) + (mapcar + (lambda (alist) + (when (boundp alist) + (cdr (assoc 'background-color (symbol-value alist))))) + '(default-frame-alist initial-frame-alist window-system-default-frame-alist)) + (list (face-foreground 'org-hide)))))) (car (remove nil candidates)))) (defun org-current-time () @@ -5284,7 +5295,7 @@ will be prompted for." (and move (backward-char 1)))) (defconst org-nonsticky-props - '(mouse-face highlight keymap invisible intangible help-echo org-linked-text)) + '(mouse-face highlight keymap invisible intangible help-echo org-linked-text htmlize-link)) (defsubst org-rear-nonsticky-at (pos) (add-text-properties (1- pos) pos (list 'rear-nonsticky org-nonsticky-props))) @@ -5293,12 +5304,13 @@ will be prompted for." "Run through the buffer and add overlays to links." (catch 'exit (let (f) - (when (re-search-forward (concat org-plain-link-re) limit t) + (when (and (re-search-forward (concat org-plain-link-re) limit t) + (not (org-in-src-block-p))) (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) (setq f (get-text-property (match-beginning 0) 'face)) - (if (or (eq f 'org-tag) - (and (listp f) (memq 'org-tag f))) - nil + (unless (or (org-in-src-block-p) + (eq f 'org-tag) + (and (listp f) (memq 'org-tag f))) (add-text-properties (match-beginning 0) (match-end 0) (list 'mouse-face 'highlight 'face 'org-link @@ -5410,9 +5422,9 @@ by a #." '(font-lock-fontified t invisible t) '(font-lock-fontified t face org-document-info-keyword))) (add-text-properties - (match-beginning 6) (match-end 6) + (match-beginning 6) (1+ (match-end 6)) (if (string-equal dc1 "+title:") - '(font-lock-fontified t face org-document-title) + '(font-lock-fontified t face org-document-title) '(font-lock-fontified t face org-document-info)))) ((or (equal dc1 "+results") (member dc1 '("+begin:" "+end:" "+caption:" "+label:" @@ -5437,7 +5449,8 @@ by a #." (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) + (if (and (re-search-forward org-angle-link-re limit t) + (not (org-in-src-block-p))) (progn (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) (add-text-properties (match-beginning 0) (match-end 0) @@ -5465,7 +5478,8 @@ by a #." (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) + (if (and (re-search-forward org-bracket-link-regexp limit t) + (not (org-in-src-block-p))) (let* ((help (concat "LINK: " (org-match-string-no-properties 1))) ;; FIXME: above we should remove the escapes. @@ -6254,11 +6268,7 @@ in special contexts. (setq has-children (org-list-has-child-p (point) struct))) (org-back-to-heading) (setq eoh (save-excursion (outline-end-of-heading) (point))) - (setq eos (save-excursion - (org-end-of-subtree t) - (unless (eobp) - (skip-chars-forward " \t\n")) - (if (eobp) (point) (1- (point))))) + (setq eos (save-excursion (1- (org-end-of-subtree t t)))) (setq has-children (or (save-excursion (let ((level (funcall outline-level))) @@ -6283,7 +6293,8 @@ in special contexts. (cond ((= eos eoh) ;; Nothing is hidden behind this heading - (run-hook-with-args 'org-pre-cycle-hook 'empty) + (unless (org-before-first-heading-p) + (run-hook-with-args 'org-pre-cycle-hook 'empty)) (message "EMPTY ENTRY") (setq org-cycle-subtree-status nil) (save-excursion @@ -6296,7 +6307,8 @@ in special contexts. (not (setq children-skipped org-cycle-skip-children-state-if-no-children)))) ;; Entire subtree is hidden in one line: children view - (run-hook-with-args 'org-pre-cycle-hook 'children) + (unless (org-before-first-heading-p) + (run-hook-with-args 'org-pre-cycle-hook 'children)) (if (org-at-item-p) (org-list-set-item-visibility (point-at-bol) struct 'children) (org-show-entry) @@ -6324,24 +6336,28 @@ in special contexts. (outline-next-heading) (if (outline-invisible-p) (org-flag-heading nil))) (setq org-cycle-subtree-status 'children) - (run-hook-with-args 'org-cycle-hook 'children)) + (unless (org-before-first-heading-p) + (run-hook-with-args 'org-cycle-hook 'children))) ((or children-skipped (and (eq last-command this-command) (eq org-cycle-subtree-status 'children))) ;; We just showed the children, or no children are there, ;; now show everything. - (run-hook-with-args 'org-pre-cycle-hook 'subtree) + (unless (org-before-first-heading-p) + (run-hook-with-args 'org-pre-cycle-hook 'subtree)) (outline-flag-region eoh eos nil) (message (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE")) (setq org-cycle-subtree-status 'subtree) - (run-hook-with-args 'org-cycle-hook 'subtree)) + (unless (org-before-first-heading-p) + (run-hook-with-args 'org-cycle-hook 'subtree))) (t ;; Default action: hide the subtree. (run-hook-with-args 'org-pre-cycle-hook 'folded) (outline-flag-region eoh eos t) (message "FOLDED") (setq org-cycle-subtree-status 'folded) - (run-hook-with-args 'org-cycle-hook 'folded))))) + (unless (org-before-first-heading-p) + (run-hook-with-args 'org-cycle-hook 'folded)))))) ;;;###autoload (defun org-global-cycle (&optional arg) @@ -6745,42 +6761,47 @@ Optional arguments START and END can be used to limit the range." (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 [(return)] 'org-goto-ret) - (org-defkey map [(left)] 'org-goto-left) - (org-defkey map [(right)] 'org-goto-right) - (org-defkey map [(control ?g)] 'org-goto-quit) - (org-defkey map "\C-i" 'org-cycle) - (org-defkey map [(tab)] 'org-cycle) - (org-defkey map [(down)] 'outline-next-visible-heading) - (org-defkey map [(up)] 'outline-previous-visible-heading) - (if org-goto-auto-isearch - (if (fboundp 'define-key-after) - (define-key-after map [t] 'org-goto-local-auto-isearch) - nil) - (org-defkey map "q" 'org-goto-quit) - (org-defkey map "n" 'outline-next-visible-heading) - (org-defkey map "p" 'outline-previous-visible-heading) - (org-defkey map "f" 'outline-forward-same-level) - (org-defkey map "b" 'outline-backward-same-level) - (org-defkey map "u" 'outline-up-heading)) - (org-defkey map "/" 'org-occur) - (org-defkey map "\C-c\C-n" 'outline-next-visible-heading) - (org-defkey map "\C-c\C-p" 'outline-previous-visible-heading) - (org-defkey map "\C-c\C-f" 'outline-forward-same-level) - (org-defkey map "\C-c\C-b" 'outline-backward-same-level) - (org-defkey map "\C-c\C-u" 'outline-up-heading) - map)) +(defvar org-goto-map) +(defun org-goto-map () + "Set the keymap `org-goto'." + (setq org-goto-map + (let ((map (make-sparse-keymap))) + (let ((cmds '(isearch-forward isearch-backward kill-ring-save set-mark-command + mouse-drag-region universal-argument org-occur)) + 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 [(return)] 'org-goto-ret) + (org-defkey map [(left)] 'org-goto-left) + (org-defkey map [(right)] 'org-goto-right) + (org-defkey map [(control ?g)] 'org-goto-quit) + (org-defkey map "\C-i" 'org-cycle) + (org-defkey map [(tab)] 'org-cycle) + (org-defkey map [(down)] 'outline-next-visible-heading) + (org-defkey map [(up)] 'outline-previous-visible-heading) + (if org-goto-auto-isearch + (if (fboundp 'define-key-after) + (define-key-after map [t] 'org-goto-local-auto-isearch) + nil) + (org-defkey map "q" 'org-goto-quit) + (org-defkey map "n" 'outline-next-visible-heading) + (org-defkey map "p" 'outline-previous-visible-heading) + (org-defkey map "f" 'outline-forward-same-level) + (org-defkey map "b" 'outline-backward-same-level) + (org-defkey map "u" 'outline-up-heading)) + (org-defkey map "/" 'org-occur) + (org-defkey map "\C-c\C-n" 'outline-next-visible-heading) + (org-defkey map "\C-c\C-p" 'outline-previous-visible-heading) + (org-defkey map "\C-c\C-f" 'outline-forward-same-level) + (org-defkey map "\C-c\C-b" 'outline-backward-same-level) + (org-defkey map "\C-c\C-u" 'outline-up-heading) + map))) (defconst org-goto-help - "Browse buffer copy, to find location or copy text. Just type for auto-isearch. -RET=jump to location [Q]uit and return to previous location + "Browse buffer copy, to find location or copy text.%s +RET=jump to location C-g=quit and return to previous location \[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur") (defvar org-goto-start-pos) ; dynamically scoped parameter @@ -6806,6 +6827,7 @@ in the indirect buffer and expose the headline hierarchy above. With a prefix argument, use the alternative interface: e.g. if `org-goto-interface' is 'outline use 'outline-path-completion." (interactive "P") + (org-goto-map) (let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level)))) (org-refile-use-outline-path t) (org-refile-target-verify-function nil) @@ -6838,48 +6860,46 @@ With a prefix argument, use the alternative interface: e.g. if "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 ((isearch-mode-map org-goto-local-auto-isearch-map) - (isearch-hide-immediately nil) - (isearch-search-fun-function - (lambda () 'org-goto-local-search-headings)) - (org-goto-selected-point org-goto-exit-command) - (pop-up-frames nil) - (special-display-buffer-names nil) - (special-display-regexps nil) - (special-display-function nil)) - (save-excursion - (save-window-excursion - (delete-other-windows) - (and (get-buffer "*org-goto*") (kill-buffer "*org-goto*")) - (org-pop-to-buffer-same-window - (condition-case nil - (make-indirect-buffer (current-buffer) "*org-goto*") - (error (make-indirect-buffer (current-buffer) "*org-goto*")))) - (with-output-to-temp-buffer "*Help*" - (princ help)) - (org-fit-window-to-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 (outline-invisible-p) (org-show-context))) - (goto-char (point-min))) - (let (org-special-ctrl-a/e) (org-beginning-of-line)) - (message "Select location and press RET") - (use-local-map org-goto-map) - (recursive-edit) - )) - (kill-buffer "*org-goto*") - (cons org-goto-selected-point org-goto-exit-command))) + (org-no-popups + (let ((isearch-mode-map org-goto-local-auto-isearch-map) + (isearch-hide-immediately nil) + (isearch-search-fun-function + (lambda () 'org-goto-local-search-headings)) + (org-goto-selected-point org-goto-exit-command)) + (save-excursion + (save-window-excursion + (delete-other-windows) + (and (get-buffer "*org-goto*") (kill-buffer "*org-goto*")) + (org-pop-to-buffer-same-window + (condition-case nil + (make-indirect-buffer (current-buffer) "*org-goto*") + (error (make-indirect-buffer (current-buffer) "*org-goto*")))) + (with-output-to-temp-buffer "*Org Help*" + (princ (format help (if org-goto-auto-isearch + " Just type for auto-isearch." + " n/p/f/b/u to navigate, q to quit.")))) + (org-fit-window-to-buffer (get-buffer-window "*Org Help*")) + (setq buffer-read-only nil) + (let ((org-startup-truncated t) + (org-startup-folded nil) + (org-startup-align-all-tables nil)) + (org-mode) + (org-overview)) + (setq buffer-read-only t) + (if (and (boundp 'org-goto-start-pos) + (integer-or-marker-p org-goto-start-pos)) + (let ((org-show-hierarchy-above t) + (org-show-siblings t) + (org-show-following-heading t)) + (goto-char org-goto-start-pos) + (and (outline-invisible-p) (org-show-context))) + (goto-char (point-min))) + (let (org-special-ctrl-a/e) (org-beginning-of-line)) + (message "Select location and press RET") + (use-local-map org-goto-map) + (recursive-edit))) + (kill-buffer "*org-goto*") + (cons org-goto-selected-point org-goto-exit-command)))) (defvar org-goto-local-auto-isearch-map (make-sparse-keymap)) (set-keymap-parent org-goto-local-auto-isearch-map isearch-mode-map) @@ -7382,12 +7402,7 @@ even level numbers will become the next higher odd number." ((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2)))))) (max 1 (+ level (or change 0))))) -(if (boundp 'define-obsolete-function-alias) - (if (or (featurep 'xemacs) (< emacs-major-version 23)) - (define-obsolete-function-alias 'org-get-legal-level - 'org-get-valid-level) - (define-obsolete-function-alias 'org-get-legal-level - 'org-get-valid-level "23.1"))) +(org-define-obsolete-function-alias 'org-get-legal-level 'org-get-valid-level "23.1") (defvar org-called-with-limited-levels nil) ;; Dynamically bound in ;; ̀org-with-limited-levels' @@ -7672,7 +7687,6 @@ useful if the caller implements cut-and-paste as copy-then-paste-then-cut." (if (org-called-interactively-p 'any) (org-back-to-heading nil) ; take what looks like a subtree (org-back-to-heading t)) ; take what is really there - (org-back-over-empty-lines) (setq beg (point)) (skip-chars-forward " \t\r\n") (save-match-data @@ -7682,7 +7696,6 @@ useful if the caller implements cut-and-paste as copy-then-paste-then-cut." (org-forward-heading-same-level (1- n) t) (error nil)) (org-end-of-subtree t t)) - (org-back-over-empty-lines) (setq end (point)) (goto-char beg0) (when (> end beg) @@ -7773,7 +7786,6 @@ the inserted text when done." (delete-region (point-at-bol) (point))) ;; Paste (beginning-of-line (if (bolp) 1 2)) - (unless for-yank (org-back-over-empty-lines)) (setq beg (point)) (and (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt)) (insert-before-markers txt) @@ -8630,6 +8642,24 @@ call CMD." (put-text-property beg end 'org-category-position beg) (goto-char pos))))))) +(defun org-refresh-properties (dprop tprop) + "Refresh buffer text properties. +DPROP is the drawer property and TPROP is the corresponding text +property to set." + (let ((case-fold-search t) + (inhibit-read-only t) p) + (org-unmodified + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward (concat "^[ \t]*:" dprop ": +\\(.*\\)[ \t]*$") nil t) + (setq p (org-match-string-no-properties 1)) + (save-excursion + (org-back-to-heading t) + (put-text-property + (point-at-bol) (point-at-eol) tprop p)))))))) + ;;;; Link Stuff @@ -8723,7 +8753,7 @@ type. For a simple example of an export function, see `org-bbdb.el'." (push (list type follow export) org-link-protocols))) (defvar org-agenda-buffer-name) ; Defined in org-agenda.el -(defvar org-link-to-org-use-id) ; Defined in org-id.el +(defvar org-id-link-to-org-use-id) ; Defined in org-id.el ;;;###autoload (defun org-store-link (arg) @@ -8839,13 +8869,13 @@ For file links, arg negates `org-context-in-file-links'." "::" (match-string 1)) link cpltxt)) ((and (featurep 'org-id) - (or (eq org-link-to-org-use-id t) + (or (eq org-id-link-to-org-use-id t) (and (org-called-interactively-p 'any) - (or (eq org-link-to-org-use-id 'create-if-interactive) - (and (eq org-link-to-org-use-id + (or (eq org-id-link-to-org-use-id 'create-if-interactive) + (and (eq org-id-link-to-org-use-id 'create-if-interactive-and-no-custom-id) (not custom-id)))) - (and org-link-to-org-use-id (org-entry-get nil "ID")))) + (and org-id-link-to-org-use-id (org-entry-get nil "ID")))) ;; We can make a link using the ID. (setq link (condition-case nil (prog1 (org-id-store-link) @@ -9318,10 +9348,11 @@ Use TAB to complete link prefixes, then RET for type-specific completion support ;; URL-like link, normalize the use of angular brackets. (setq 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. + ;; 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 "^file:\\(.+?\\)::\\([^>]+\\)" link)) + (string-match "^file:\\(.+?\\)::\\(.+\\)" link)) (let* ((path (match-string 1 link)) (case-fold-search nil) (search (match-string 2 link))) @@ -9652,7 +9683,13 @@ application the system uses for this file type." org-angle-link-re "\\|" "[ \t]:[^ \t\n]+:[ \t]*$"))) (not (get-text-property (point) 'org-linked-text))) - (or (org-offer-links-in-entry arg) + (or (let* ((lkall (org-offer-links-in-entry (current-buffer) (point) arg)) + (lk (car lkall)) + (lkend (cdr lkall))) + (when lk + (prog1 (search-forward lk nil lkend) + (goto-char (match-beginning 0)) + (org-open-at-point)))) (progn (require 'org-attach) (org-attach-reveal 'if-exists)))) ((run-hook-with-args-until-success 'org-open-at-point-functions)) ((and (org-at-timestamp-p t) @@ -9695,12 +9732,13 @@ application the system uses for this file type." (throw 'match t)) (save-excursion - (when (or (org-in-regexp org-angle-link-re) - (and (goto-char (car (org-in-regexp org-plain-link-re))) - (save-match-data (not (looking-back "\\[\\["))))) - (setq type (match-string 1) - path (org-link-unescape (match-string 2))) - (throw 'match t))) + (let ((plinkpos (org-in-regexp org-plain-link-re))) + (when (or (org-in-regexp org-angle-link-re) + (and plinkpos (goto-char (car plinkpos)) + (save-match-data (not (looking-back "\\[\\["))))) + (setq type (match-string 1) + path (org-link-unescape (match-string 2))) + (throw 'match t)))) (save-excursion (when (org-in-regexp (org-re "\\(:[[:alnum:]_@#%:]+\\):[ \t]*$")) (setq type "tags" @@ -9713,7 +9751,7 @@ application the system uses for this file type." path (match-string 1)) (throw 'match t))) (unless path - (error "No link found")) + (user-error "No link found")) ;; switch back to reference buffer ;; needed when if called in a temporary buffer through @@ -9847,68 +9885,67 @@ application the system uses for this file type." (move-marker org-open-link-marker nil) (run-hook-with-args 'org-follow-link-hook))) -(defun org-offer-links-in-entry (&optional nth zero) - "Offer links in the current entry and follow the selected link. -If there is only one link, follow it immediately as well. -If NTH is an integer, immediately pick the NTH link found. +(defun org-offer-links-in-entry (buffer marker &optional nth zero) + "Offer links in the current entry and return the selected link. +If there is only one link, return it. +If NTH is an integer, return the NTH link found. If ZERO is a string, check also this string for a link, and if -there is one, offer it as link number zero." - (let ((re (concat "\\(" org-bracket-link-regexp "\\)\\|" - "\\(" org-angle-link-re "\\)\\|" - "\\(" org-plain-link-re "\\)")) - (cnt ?0) - (in-emacs (if (integerp nth) nil nth)) - have-zero end links link c) - (when (and (stringp zero) (string-match org-bracket-link-regexp zero)) - (push (match-string 0 zero) links) - (setq cnt (1- cnt) have-zero t)) +there is one, return it." + (with-current-buffer buffer (save-excursion - (org-back-to-heading t) - (setq end (save-excursion (outline-next-heading) (point))) - (while (re-search-forward re end t) - (push (match-string 0) links)) - (setq links (org-uniquify (reverse links)))) - - (cond - ((null links) - (message "No links")) - ((equal (length links) 1) - (setq link (list (car links)))) - ((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth))) - (setq link (list (nth (if have-zero nth (1- nth)) links)))) - (t ; we have to select a link - (save-excursion - (save-window-excursion - (delete-other-windows) - (with-output-to-temp-buffer "*Select Link*" - (mapc (lambda (l) - (if (not (string-match org-bracket-link-regexp l)) - (princ (format "[%c] %s\n" (incf cnt) - (org-remove-angle-brackets l))) - (if (match-end 3) - (princ (format "[%c] %s (%s)\n" (incf cnt) - (match-string 3 l) (match-string 1 l))) - (princ (format "[%c] %s\n" (incf cnt) - (match-string 1 l)))))) - links)) - (org-fit-window-to-buffer (get-buffer-window "*Select Link*")) - (message "Select link to open, RET to open all:") - (setq c (read-char-exclusive)) - (and (get-buffer "*Select Link*") (kill-buffer "*Select Link*")))) - (when (equal c ?q) (error "Abort")) - (if (equal c ?\C-m) - (setq link links) - (setq nth (- c ?0)) - (if have-zero (setq nth (1+ nth))) - (unless (and (integerp nth) (>= (length links) nth)) - (error "Invalid link selection")) - (setq link (list (nth (1- nth) links)))))) - (if link - (let ((buf (current-buffer))) - (dolist (l link) - (org-open-link-from-string l in-emacs buf)) - t) - nil))) + (save-restriction + (widen) + (goto-char marker) + (let ((re (concat "\\(" org-bracket-link-regexp "\\)\\|" + "\\(" org-angle-link-re "\\)\\|" + "\\(" org-plain-link-re "\\)")) + (cnt ?0) + (in-emacs (if (integerp nth) nil nth)) + have-zero end links link c) + (when (and (stringp zero) (string-match org-bracket-link-regexp zero)) + (push (match-string 0 zero) links) + (setq cnt (1- cnt) have-zero t)) + (save-excursion + (org-back-to-heading t) + (setq end (save-excursion (outline-next-heading) (point))) + (while (re-search-forward re end t) + (push (match-string 0) links)) + (setq links (org-uniquify (reverse links)))) + (cond + ((null links) + (message "No links")) + ((equal (length links) 1) + (setq link (car links))) + ((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth))) + (setq link (nth (if have-zero nth (1- nth)) links))) + (t ; we have to select a link + (save-excursion + (save-window-excursion + (delete-other-windows) + (with-output-to-temp-buffer "*Select Link*" + (mapc (lambda (l) + (if (not (string-match org-bracket-link-regexp l)) + (princ (format "[%c] %s\n" (incf cnt) + (org-remove-angle-brackets l))) + (if (match-end 3) + (princ (format "[%c] %s (%s)\n" (incf cnt) + (match-string 3 l) (match-string 1 l))) + (princ (format "[%c] %s\n" (incf cnt) + (match-string 1 l)))))) + links)) + (org-fit-window-to-buffer (get-buffer-window "*Select Link*")) + (message "Select link to open, RET to open all:") + (setq c (read-char-exclusive)) + (and (get-buffer "*Select Link*") (kill-buffer "*Select Link*")))) + (when (equal c ?q) (error "Abort")) + (if (equal c ?\C-m) + (setq link links) + (setq nth (- c ?0)) + (if have-zero (setq nth (1+ nth))) + (unless (and (integerp nth) (>= (length links) nth)) + (error "Invalid link selection")) + (setq link (nth (1- nth) links))))) + (cons link end)))))) ;; Add special file links that specify the way of opening @@ -9930,12 +9967,6 @@ there is one, offer it as link number zero." '(add-hook 'org-export-preprocess-before-normalizing-links-hook 'org-remove-file-link-modifiers)) -;;;; Time estimates - -(defun org-get-effort (&optional pom) - "Get the effort estimate for the current entry." - (org-entry-get pom org-effort-property)) - ;;; File search (defvar org-create-file-search-functions nil @@ -11259,8 +11290,7 @@ This function can be used in a hook." " +" t))) (defcustom org-structure-template-alist - '( - ("s" "#+BEGIN_SRC ?\n\n#+END_SRC" + '(("s" "#+BEGIN_SRC ?\n\n#+END_SRC" "<src lang=\"?\">\n\n</src>") ("e" "#+BEGIN_EXAMPLE\n?\n#+END_EXAMPLE" "<example>\n?\n</example>") @@ -11268,6 +11298,8 @@ This function can be used in a hook." "<quote>\n?\n</quote>") ("v" "#+BEGIN_VERSE\n?\n#+END_VERSE" "<verse>\n?\n</verse>") + ("V" "#+BEGIN_VERBATIM\n?\n#+END_VERBATIM" + "<verbatim>\n?\n</verbatim>") ("c" "#+BEGIN_CENTER\n?\n#+END_CENTER" "<center>\n?\n</center>") ("l" "#+BEGIN_LaTeX\n?\n#+END_LaTeX" @@ -11283,8 +11315,7 @@ This function can be used in a hook." ("i" "#+INDEX: ?" "#+INDEX: ?") ("I" "#+INCLUDE: %file ?" - "<include file=%file markup=\"?\">") - ) + "<include file=%file markup=\"?\">")) "Structure completion elements. This is a list of abbreviation keys and values. The value gets inserted if you type `<' followed by the key and then press the completion key, @@ -11439,7 +11470,8 @@ For calling through lisp, arg is also interpreted in the following way: cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) (if (equal arg '(16)) (setq arg 'nextset)) (let ((org-blocker-hook org-blocker-hook) - (case-fold-search nil)) + commentp + case-fold-search) (when (equal arg '(64)) (setq arg nil org-blocker-hook nil)) (when (and org-blocker-hook @@ -11449,6 +11481,9 @@ For calling through lisp, arg is also interpreted in the following way: (save-excursion (catch 'exit (org-back-to-heading t) + (when (looking-at (concat "^\\*+ " org-comment-string)) + (org-toggle-comment) + (setq commentp t)) (if (looking-at org-outline-regexp) (goto-char (1- (match-end 0)))) (or (looking-at (concat " +" org-todo-regexp "\\( +\\|[ \t]*$\\)")) (looking-at "\\(?: *\\|[ \t]*$\\)")) @@ -11624,7 +11659,8 @@ For calling through lisp, arg is also interpreted in the following way: (and (looking-at " ") (just-one-space)))) (when org-trigger-hook (save-excursion - (run-hook-with-args 'org-trigger-hook change-plist))))))))) + (run-hook-with-args 'org-trigger-hook change-plist))) + (when commentp (org-toggle-comment)))))))) (defun org-block-todo-from-children-or-siblings-or-parent (change-plist) "Block turning an entry into a TODO, using the hierarchy. @@ -11765,15 +11801,16 @@ changes because there are unchecked boxes in this entry." (defun org-entry-blocked-p () "Is the current entry blocked?" - (if (org-entry-get nil "NOBLOCKING") - nil ;; Never block this entry - (not - (run-hook-with-args-until-failure - 'org-blocker-hook - (list :type 'todo-state-change - :position (point) - :from 'todo - :to 'done))))) + (org-with-buffer-modified-unmodified + (if (org-entry-get nil "NOBLOCKING") + nil ;; Never block this entry + (not + (run-hook-with-args-until-failure + 'org-blocker-hook + (list :type 'todo-state-change + :position (point) + :from 'todo + :to 'done)))))) (defun org-update-statistics-cookies (all) "Update the statistics cookie, either from TODO or from checkboxes. @@ -11785,7 +11822,7 @@ This should be called with the cursor in a line with a statistics cookie." (org-map-entries 'org-update-parent-todo-statistics)) (if (not (org-at-heading-p)) (org-update-checkbox-count) - (let ((pos (move-marker (make-marker) (point))) + (let ((pos (point-marker)) end l1 l2) (ignore-errors (org-back-to-heading t)) (if (not (org-at-heading-p)) @@ -12666,7 +12703,7 @@ D Show deadlines and scheduled items between a date range." (let (ans kwd value ts-type) (setq type (or type org-sparse-tree-default-date-type)) (setq org-ts-type type) - (message "Sparse tree: [r]egexp [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty\n [d]eadlines [b]efore-date [a]fter-date [D]ates range\n [c]ycle through date types: %s" + (message "Sparse tree: [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty\n [d]eadlines [b]efore-date [a]fter-date [D]ates range\n [c]ycle through date types: %s" (cond ((eq type 'all) "all timestamps") ((eq type 'scheduled) "only scheduled") ((eq type 'deadline) "only deadline") @@ -12981,9 +13018,9 @@ and by additional input from the age of a schedules or deadline entry." (defun org-get-priority (s) "Find priority cookie and return priority." - (if (functionp org-get-priority-function) - (funcall org-get-priority-function) - (save-match-data + (save-match-data + (if (functionp org-get-priority-function) + (funcall org-get-priority-function) (if (not (string-match org-priority-regexp s)) (* 1000 (- org-lowest-priority org-default-priority)) (* 1000 (- org-lowest-priority @@ -13113,18 +13150,9 @@ headlines matching this string." (or (not todo-only) (and (member todo org-not-done-keywords) (or (not org-agenda-tags-todo-honor-ignore-options) - (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item))))) - - ;; Extra check for the archive tag - ;; FIXME: Does the skipper already do this???? - (or - (not (member org-archive-tag tags-list)) - ;; we have an archive tag, should we use this anyway? - (or (not org-agenda-skip-archived-trees) - (and (eq action 'agenda) org-agenda-archives-mode)))) + (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item)))))) ;; select this headline - (cond ((eq action 'sparse-tree) (and org-highlight-sparse-tree-matches @@ -14276,6 +14304,9 @@ When INCREMENT is non-nil, set the property to the next allowed value." existing nil nil "" nil cur)))))) (unless (equal (org-entry-get nil prop) val) (org-entry-put nil prop val)) + (save-excursion + (org-back-to-heading t) + (put-text-property (point-at-bol) (point-at-eol) 'org-effort val)) (message "%s is now %s" prop val))) (defun org-at-property-p () @@ -14454,26 +14485,27 @@ when a \"nil\" value can supersede a non-nil value higher up the hierarchy." ;; We need a special property. Use `org-entry-properties' to ;; retrieve it, but specify the wanted property (cdr (assoc property (org-entry-properties nil 'special property))) - (let* ((range (org-get-property-block)) - (props (list (or (assoc property org-file-properties) - (assoc property org-global-properties) - (assoc property org-global-properties-fixed)))) - (ap (lambda (key) - (when (re-search-forward - (org-re-property key) (cdr range) t) - (setq props - (org-update-property-plist - key - (if (match-end 1) - (org-match-string-no-properties 1) "") - props))))) - val) - (when (and range (goto-char (car range))) - (funcall ap property) - (goto-char (car range)) - (while (funcall ap (concat property "+"))) - (setq val (cdr (assoc property props))) - (when val (if literal-nil val (org-not-nil val))))))))) + (let ((range (org-get-property-block))) + (when (and range (not (eq (car range) (cdr range)))) + (let* ((props (list (or (assoc property org-file-properties) + (assoc property org-global-properties) + (assoc property org-global-properties-fixed)))) + (ap (lambda (key) + (when (re-search-forward + (org-re-property key) (cdr range) t) + (setq props + (org-update-property-plist + key + (if (match-end 1) + (org-match-string-no-properties 1) "") + props))))) + val) + (goto-char (car range)) + (funcall ap property) + (goto-char (car range)) + (while (funcall ap (concat property "+"))) + (setq val (cdr (assoc property props))) + (when val (if literal-nil val (org-not-nil val)))))))))) (defun org-property-or-variable-value (var &optional inherit) "Check if there is a property fixing the value of VAR. @@ -14996,7 +15028,8 @@ completion." (interactive) (unless (org-at-property-p) (error "Not at a property")) - (let* ((key (match-string 2)) + (let* ((prop (car (save-match-data (org-split-string (match-string 1) ":")))) + (key (match-string 2)) (value (match-string 3)) (allowed (or (org-property-get-allowed-values (point) key) (and (member value '("[ ]" "[-]" "[X]")) @@ -15015,6 +15048,10 @@ completion." (org-indent-line) (beginning-of-line 1) (skip-chars-forward " \t") + (when (equal prop org-effort-property) + (save-excursion + (org-back-to-heading t) + (put-text-property (point-at-bol) (point-at-eol) 'org-effort nval))) (run-hook-with-args 'org-property-changed-functions key nval))) (defun org-find-olp (path &optional this-buffer) @@ -15060,7 +15097,7 @@ only headings." (setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0))) (setq end (save-excursion (org-end-of-subtree t t)))) (when (org-at-heading-p) - (move-marker (make-marker) (point)))))))) + (point-marker))))))) (defun org-find-exact-headline-in-buffer (heading &optional buffer pos-only) "Find node HEADING in BUFFER. @@ -15307,6 +15344,7 @@ user." (setcar (nthcdr 1 org-defdecode) 59) (setq org-def (apply 'encode-time org-defdecode) org-defdecode (decode-time org-def))))) + (mouse-autoselect-window nil) ; Don't let the mouse jump (calendar-frame-setup nil) (calendar-setup nil) (calendar-move-hook nil) @@ -16966,6 +17004,8 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (widen) (setq bmp (buffer-modified-p)) (org-refresh-category-properties) + (org-refresh-properties org-effort-property 'org-effort) + (org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime) (setq org-todo-keywords-for-agenda (append org-todo-keywords-for-agenda org-todo-keywords-1)) (setq org-done-keywords-for-agenda @@ -17758,7 +17798,7 @@ BEG and END default to the buffer boundaries." (list 'org-display-inline-remove-overlay)) (push ov org-inline-image-overlays))))))))) -(define-obsolete-function-alias +(org-define-obsolete-function-alias 'org-display-inline-modification-hook 'org-display-inline-remove-overlay "24.3") (defun org-display-inline-remove-overlay (ov after beg end &optional len) @@ -18053,7 +18093,7 @@ BEG and END default to the buffer boundaries." ("c" . org-cycle) ("C" . org-shifttab) (" " . org-display-outline-path) - (":" . org-columns) + ("=" . org-columns) ("Outline Structure Editing") ("U" . org-shiftmetaup) ("D" . org-shiftmetadown) @@ -18078,7 +18118,7 @@ BEG and END default to the buffer boundaries." ("1" . (org-priority ?A)) ("2" . (org-priority ?B)) ("3" . (org-priority ?C)) - (";" . org-set-tags-command) + (":" . org-set-tags-command) ("e" . org-set-effort) ("E" . org-inc-effort) ("W" . (lambda(m) (interactive "sMinutes before warning: ") @@ -18138,7 +18178,7 @@ If not, return to the original position and throw an error." (defvar org-table-auto-blank-field) ; defined in org-table.el (defvar org-speed-command nil) -(define-obsolete-function-alias +(org-define-obsolete-function-alias 'org-speed-command-default-hook 'org-speed-command-activate "24.3") (defun org-speed-command-activate (keys) @@ -18151,7 +18191,7 @@ Use `org-speed-commands-user' for further customization." (cdr (assoc keys (append org-speed-commands-user org-speed-commands-default))))) -(define-obsolete-function-alias +(org-define-obsolete-function-alias 'org-babel-speed-command-hook 'org-babel-speed-command-activate "24.3") (defun org-babel-speed-command-activate (keys) @@ -18296,25 +18336,26 @@ 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") - (org-check-before-invisible-edit 'delete-backward) - (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) - (if (not overwrite-mode) - (progn - (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))) + (save-match-data + (org-check-before-invisible-edit 'delete-backward) + (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) + (if (not overwrite-mode) + (progn + (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. @@ -18323,25 +18364,26 @@ 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") - (org-check-before-invisible-edit 'delete) - (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))) + (save-match-data + (org-check-before-invisible-edit 'delete) + (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) @@ -18956,15 +18998,22 @@ See the individual commands for more information." (org-table-paste-rectangle) (org-paste-subtree arg))) +(defsubst org-in-fixed-width-region-p () + "Is point in a fixed-width region?" + (save-match-data + (eq 'fixed-width (org-element-type (org-element-at-point))))) + (defun org-edit-special (&optional arg) "Call a special editor for the stuff at point. When at a table, call the formula editor with `org-table-edit-formulas'. -When at the first line of an src example, call `org-edit-src-code'. -When in an #+include line, visit the include file. Otherwise call -`ffap' to visit the file at point." +When in a source code block, call `org-edit-src-code'. +When in a fixed-width region, call `org-edit-fixed-width-region'. +When in an #+include line, visit the included file. +On a link, call `ffap' to visit the link at point. +Otherwise, return a user error." (interactive) ;; possibly prep session before editing source - (when arg + (when (and (org-in-src-block-p) arg) (let* ((info (org-babel-get-src-block-info)) (lang (nth 0 info)) (params (nth 2 info)) @@ -18977,16 +19026,17 @@ When in an #+include line, visit the include file. Otherwise call (beginning-of-line 1) (looking-at "\\(?:#\\+\\(?:setupfile\\|include\\):?[ \t]+\"?\\|[ \t]*<include\\>.*?file=\"\\)\\([^\"\n>]+\\)")) (find-file (org-trim (match-string 1)))) - ((org-edit-src-code)) - ((org-edit-fixed-width-region)) - ((org-at-table.el-p) - (org-edit-src-code)) ((or (org-at-table-p) (save-excursion (beginning-of-line 1) (let ((case-fold-search )) (looking-at "[ \t]*#\\+tblfm:")))) (call-interactively 'org-table-edit-formulas)) - (t (call-interactively 'ffap)))) + ((or (org-in-block-p '("src" "example" "latex" "html")) + (org-at-table.el-p)) + (org-edit-src-code)) + ((org-in-fixed-width-region-p) (org-edit-fixed-width-region)) + ((org-at-regexp-p org-any-link-re) (call-interactively 'ffap)) + (t (user-error "No special environment to edit here")))) (defvar org-table-coordinate-overlays) ; defined in org-table.el (defun org-ctrl-c-ctrl-c (&optional arg) @@ -19103,8 +19153,10 @@ This command does many different things, depending on context: (org-list-struct-fix-ind struct parents) (setq block-item (org-list-struct-fix-box struct parents prevs orderedp))) - (org-list-struct-apply-struct struct old-struct) - (org-update-checkbox-count-maybe) + (if (equal struct old-struct) + (user-error "Cannot toggle this checkbox (unchecked subitems?)") + (org-list-struct-apply-struct struct old-struct) + (org-update-checkbox-count-maybe)) (when block-item (message "Checkboxes were removed due to unchecked box at line %d" @@ -20238,13 +20290,19 @@ and end of string." "Is S an ID created by UUIDGEN?" (string-match "\\`[0-9a-f]\\{8\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{12\\}\\'" (downcase s))) -(defun org-in-src-block-p nil - "Whether point is in a code source block." - (let (ov) - (when (setq ov (overlays-at (point))) - (memq 'org-block-background - (overlay-properties - (car ov)))))) +(defun org-in-src-block-p (&optional inside) + "Whether point is in a code source block. +When INSIDE is non-nil, don't consider we are within a src block +when point is at #+BEGIN_SRC or #+END_SRC." + (let ((case-fold-search t) ov) + (or (and (setq ov (overlays-at (point))) + (memq 'org-block-background + (overlay-properties (car ov)))) + (and (not inside) + (save-match-data + (save-excursion + (beginning-of-line) + (looking-at ".*#\\+\\(begin\\|end\\)_src"))))))) (defun org-context () "Return a list of contexts of the current cursor position. @@ -20587,9 +20645,8 @@ return nil." "Switch to buffer in a second window on the current frame. In particular, do not allow pop-up frames. Returns the newly created buffer." - (let (pop-up-frames special-display-buffer-names special-display-regexps - special-display-function) - (apply 'switch-to-buffer-other-window args))) + (org-no-popups + (apply 'switch-to-buffer-other-window args))) (defun org-combine-plists (&rest plists) "Create a single property list from all plists in PLISTS. @@ -20768,6 +20825,7 @@ hierarchy of headlines by UP levels before marking the subtree." (t (beginning-of-line 0) (while (and (not (bobp)) + (not (looking-at org-table-line-regexp)) (not (looking-at org-drawer-regexp)) ;; When point started in an inline task, do not move ;; above task starting line. @@ -20898,6 +20956,7 @@ hierarchy of headlines by UP levels before marking the subtree." '(org-fill-paragraph-separate-nobreak-p org-fill-line-break-nobreak-p))))) (org-set-local 'fill-paragraph-function 'org-fill-paragraph) + (org-set-local 'auto-fill-inhibit-regexp nil) (org-set-local 'adaptive-fill-function 'org-adaptive-fill-function) (org-set-local 'normal-auto-fill-function 'org-auto-fill-function) (org-set-local 'comment-line-break-function 'org-comment-line-break-function)) @@ -20920,48 +20979,54 @@ hierarchy of headlines by UP levels before marking the subtree." "Compute a fill prefix for the current line. Return fill prefix, as a string, or nil if current line isn't meant to be filled." - (org-with-wide-buffer - (unless (and (derived-mode-p 'message-mode) (not (message-in-body-p))) - ;; FIXME: This is really the job of orgstruct++-mode - (let* ((p (line-beginning-position)) - (element (save-excursion (beginning-of-line) - (org-element-at-point))) - (type (org-element-type element)) - (post-affiliated - (save-excursion - (goto-char (org-element-property :begin element)) - (while (looking-at org-element--affiliated-re) (forward-line)) - (point)))) - (unless (< p post-affiliated) - (case type - (comment (looking-at "[ \t]*# ?") (match-string 0)) - (footnote-definition "") - ((item plain-list) - (make-string (org-list-item-body-column post-affiliated) ? )) - (paragraph - ;; Fill prefix is usually the same as the current line, - ;; except if the paragraph is at the beginning of an item. - (let ((parent (org-element-property :parent element))) - (cond ((eq (org-element-type parent) 'item) - (make-string (org-list-item-body-column - (org-element-property :begin parent)) - ? )) - ((save-excursion (beginning-of-line) (looking-at "[ \t]+")) - (match-string 0)) - (t "")))) - (comment-block - ;; Only fill contents if P is within block boundaries. - (let* ((cbeg (save-excursion (goto-char post-affiliated) - (forward-line) - (point))) - (cend (save-excursion - (goto-char (org-element-property :end element)) - (skip-chars-backward " \r\t\n") - (line-beginning-position)))) - (when (and (>= p cbeg) (< p cend)) - (if (save-excursion (beginning-of-line) (looking-at "[ \t]+")) - (match-string 0) - "")))))))))) + (let (prefix) + (when (and (derived-mode-p 'message-mode) (message-in-body-p)) + (save-excursion + (beginning-of-line) + (cond ((looking-at message-cite-prefix-regexp) + (setq prefix (match-string-no-properties 0))) + ((looking-at org-outline-regexp) + (setq prefix ""))))) + (or prefix + (org-with-wide-buffer + (let* ((p (line-beginning-position)) + (element (save-excursion (beginning-of-line) (org-element-at-point))) + (type (org-element-type element)) + (post-affiliated + (save-excursion + (goto-char (org-element-property :begin element)) + (while (looking-at org-element--affiliated-re) (forward-line)) + (point)))) + (unless (< p post-affiliated) + (case type + (comment (looking-at "[ \t]*# ?") (match-string 0)) + (footnote-definition "") + ((item plain-list) + (make-string (org-list-item-body-column post-affiliated) ? )) + (paragraph + ;; Fill prefix is usually the same as the current line, + ;; except if the paragraph is at the beginning of an item. + (let ((parent (org-element-property :parent element))) + (cond ((eq (org-element-type parent) 'item) + (make-string (org-list-item-body-column + (org-element-property :begin parent)) + ? )) + ((save-excursion (beginning-of-line) (looking-at "[ \t]+")) + (match-string 0)) + (t "")))) + (comment-block + ;; Only fill contents if P is within block boundaries. + (let* ((cbeg (save-excursion (goto-char post-affiliated) + (forward-line) + (point))) + (cend (save-excursion + (goto-char (org-element-property :end element)) + (skip-chars-backward " \r\t\n") + (line-beginning-position)))) + (when (and (>= p cbeg) (< p cend)) + (if (save-excursion (beginning-of-line) (looking-at "[ \t]+")) + (match-string 0) + ""))))))))))) (declare-function message-goto-body "message" ()) (defvar message-cite-prefix-regexp) ; From message.el @@ -20981,12 +21046,12 @@ width for filling. For convenience, when point is at a plain list, an item or a footnote definition, try to fill the first paragraph within." - ;; Falls back on message-fill-paragraph when necessary (interactive) (if (and (derived-mode-p 'message-mode) (or (not (message-in-body-p)) (save-excursion (move-beginning-of-line 1) (looking-at message-cite-prefix-regexp)))) + ;; First ensure filling is correct in message-mode. (let ((fill-paragraph-function (cadadr (assoc 'fill-paragraph-function org-fb-vars))) (fill-prefix (cadadr (assoc 'fill-prefix org-fb-vars))) @@ -21003,6 +21068,8 @@ a footnote definition, try to fill the first paragraph within." ;; the buffer. In that case, ignore filling. (if (< (point) (org-element-property :begin element)) t (case (org-element-type element) + ;; Use major mode filling function is src blocks. + (src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q"))) ;; Align Org tables, leave table.el tables as-is. (table-row (org-table-align) t) (table |