From c93dc652d998978a070d7ea39bbd5ee14041f531 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Wed, 11 Mar 2015 18:48:52 +0800 Subject: [PATCH] First stab at independent orgstruct mode --- lisp/org-element.el | 2 + lisp/org-struct.el | 364 ++++++++++++++++++++++++++++++ lisp/org.el | 632 ++++++++++++++-------------------------------------- 3 files changed, 531 insertions(+), 467 deletions(-) create mode 100644 lisp/org-struct.el diff --git a/lisp/org-element.el b/lisp/org-element.el index b0e4e5c..8c95bcc 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -4856,6 +4856,8 @@ This function assumes `org-element--cache' is a valid AVL tree." ;;;; Tools +(defvar orgstruct-mode nil) + (defsubst org-element--cache-active-p () "Non-nil when cache is active in current buffer." (and org-element-use-cache diff --git a/lisp/org-struct.el b/lisp/org-struct.el new file mode 100644 index 0000000..3acfbc0 --- /dev/null +++ b/lisp/org-struct.el @@ -0,0 +1,364 @@ +;;; org-struct.el --- Org-style editing in non-Org buffers -*- lexical-binding: t; -*- + +;; Copyright (C) 2015 Free Software Foundation, Inc. + +;; Author: Carsten Dominik +;; Keywords: outlines + +;; 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 of the License, 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, see . + +;;; Commentary: + +;; This file provides two minor modes for using Org-style editing +;; commands in buffers that aren't in Org mode. The first mode, +;; orgstruct-mode, defines key-bindings for structural editing +;; commands like inserting headings and manipulating list items. The +;; second minor mode, orgstruct++-mode, builds on the first, adding +;; functions to handle filling and indentation. + +;; The basic orgstruct-mode is a bit of a hack: it hijacks all the +;; keys it needs for structure editing, and wraps them in a function +;; (`orgstruct-make-binding') that checks the context around point. +;; If the text around point looks like Org text, the relevant Org +;; command is run. If it doesn't, the function checks to see if the +;; currently-active major or minor modes have commands bound to those +;; keys, and, if so, calls those commands. + +;; The second minor mode, orgstruct++, special-cases various major +;; modes, such as message-mode, to make sure that Org text structures +;; are filled and indented properly. + +;; in orgstruct++ mode, we need to set custom values for +;; indent-line-function, adaptive-fill-function, +;; normal-auto-fill-function, and fill-paragraph-function + +;;; Code: + +(require 'org) + +(declare-function message-goto-body "message" ()) + +(defvar message-cite-prefix-regexp) ; From message.el + +(defcustom orgstruct-heading-prefix-regexp "" + "Regexp that matches the custom prefix of Org headlines in +orgstruct(++)-mode." + :group 'org + :version "24.4" + :package-version '(Org . "8.3") + :type 'regexp) +;;;###autoload(put 'orgstruct-heading-prefix-regexp 'safe-local-variable 'stringp) + +(defcustom orgstruct-setup-hook nil + "Hook run after orgstruct-mode-map is filled." + :group 'org + :version "24.4" + :package-version '(Org . "8.0") + :type 'hook) + +(defvar orgstruct-initialized nil) + +;;;###autoload +(define-minor-mode orgstruct-mode + "Toggle the minor mode `orgstruct-mode'. +This mode is for using Org-mode structure commands in other +modes. The following keys behave as if Org-mode were active, if +the cursor is on a headline, or on a plain list item (both as +defined by Org-mode)." + nil " OrgStruct" (make-sparse-keymap) + (funcall (if orgstruct-mode + 'add-to-invisibility-spec + 'remove-from-invisibility-spec) + '(outline . t)) + (when orgstruct-mode + (org-load-modules-maybe) + (unless orgstruct-initialized + (orgstruct-setup) + (setq orgstruct-initialized t)))) + +;;;###autoload +(defun turn-on-orgstruct () + "Unconditionally turn on `orgstruct-mode'." + (orgstruct-mode 1)) + +(defvar org-fb-vars nil) +(make-variable-buffer-local 'org-fb-vars) + +(defun orgstruct-error () + "Error when there is no default binding for a structure key." + (interactive) + (funcall (if (fboundp 'user-error) + 'user-error + 'error) + "This key has no function outside structure elements")) + +(defun orgstruct-setup () + "Setup orgstruct keymap." + (dolist (cell '((org-demote . t) + (org-metaleft . t) + (org-metaright . t) + (org-promote . t) + (org-shiftmetaleft . t) + (org-shiftmetaright . t) + org-backward-element + org-backward-heading-same-level + org-ctrl-c-ret + org-ctrl-c-minus + org-ctrl-c-star + org-cycle + org-forward-heading-same-level + org-insert-heading + org-insert-heading-respect-content + org-kill-note-or-show-branches + org-mark-subtree + org-meta-return + org-metadown + org-metaup + org-narrow-to-subtree + org-promote-subtree + org-reveal + org-shiftdown + org-shiftleft + org-shiftmetadown + org-shiftmetaup + org-shiftright + org-shifttab + org-shifttab + org-shiftup + org-show-subtree + org-sort + org-up-element + outline-demote + outline-next-visible-heading + outline-previous-visible-heading + outline-promote + outline-up-heading + show-children)) + (let ((f (or (car-safe cell) cell)) + (disable-when-heading-prefix (cdr-safe cell))) + (when (fboundp f) + (let ((new-bindings)) + (dolist (binding (nconc (where-is-internal f org-mode-map) + (where-is-internal f outline-mode-map))) + (push binding new-bindings) + ;; TODO use local-function-key-map + (dolist (rep '(("" . "TAB") + ("" . "RET") + ("" . "ESC") + ("" . "DEL"))) + (setq binding (read-kbd-macro + (let ((case-fold-search)) + (replace-regexp-in-string + (regexp-quote (cdr rep)) + (car rep) + (key-description binding))))) + (pushnew binding new-bindings :test 'equal))) + (dolist (binding new-bindings) + (let ((key (lookup-key orgstruct-mode-map binding))) + (when (or (not key) (numberp key)) + (ignore-errors + (org-defkey orgstruct-mode-map + binding + (orgstruct-make-binding + f binding disable-when-heading-prefix)))))))))) + (run-hooks 'orgstruct-setup-hook)) + +(defun orgstruct-make-binding (fun key disable-when-heading-prefix) + "Create a function for binding in the structure minor mode. +FUN is the command to call inside a table. KEY is the key that +should be checked in for a command to execute outside of tables. +Non-nil `disable-when-heading-prefix' means to disable the command +if `orgstruct-heading-prefix-regexp' is not empty." + (let ((name (concat "orgstruct-hijacker-" (symbol-name fun)))) + (let ((nname name) + (i 0)) + (while (fboundp (intern nname)) + (setq nname (format "%s-%d" name (setq i (1+ i))))) + (setq name (intern nname))) + (eval + (let ((bindings '((org-heading-regexp + (concat "^" + orgstruct-heading-prefix-regexp + "\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ ]*$")) + (org-outline-regexp + (concat orgstruct-heading-prefix-regexp "\\*+ ")) + (org-outline-regexp-bol + (concat "^" org-outline-regexp)) + (outline-regexp org-outline-regexp) + (outline-heading-end-regexp "\n") + (outline-level 'org-outline-level) + (outline-heading-alist)))) + `(defun ,name (arg) + ,(concat "In Structure, run `" (symbol-name fun) "'.\n" + "Outside of structure, run the binding of `" + (key-description key) "'." + (when disable-when-heading-prefix + (concat + "\nIf `orgstruct-heading-prefix-regexp' is not empty, this command will always fall\n" + "back to the default binding due to limitations of Org's implementation of\n" + "`" (symbol-name fun) "'."))) + (interactive "p") + (let* ((disable + ,(and disable-when-heading-prefix + '(not (string= orgstruct-heading-prefix-regexp "")))) + (fallback + (or disable + (not + (let* ,bindings + (org-context-p 'headline 'item + ,(when (memq fun + '(org-insert-heading + org-insert-heading-respect-content + org-meta-return)) + '(when orgstruct-is-++ + 'item-body)))))))) + (if fallback + (let* ((orgstruct-mode) + (binding + (let ((key ,key)) + (catch 'exit + (dolist + (rep + '(nil + ("<\\([^>]*\\)tab>" . "\\1TAB") + ("<\\([^>]*\\)return>" . "\\1RET") + ("<\\([^>]*\\)escape>" . "\\1ESC") + ("<\\([^>]*\\)delete>" . "\\1DEL")) + nil) + (when rep + (setq key (read-kbd-macro + (let ((case-fold-search)) + (replace-regexp-in-string + (car rep) + (cdr rep) + (key-description key)))))) + (when (key-binding key) + (throw 'exit (key-binding key)))))))) + (if (keymapp binding) + (org-set-transient-map binding) + (let ((func (or binding + (unless disable + 'orgstruct-error)))) + (when func + (call-interactively func))))) + (org-run-like-in-org-mode + (lambda () + (interactive) + (let* ,bindings + (call-interactively ',fun))))))))) + name)) + +(defun orgstruct++-mode (&optional arg) + "Toggle `orgstruct-mode', the enhanced version of it. +In addition to setting orgstruct-mode, this also exports all +indentation and autofilling variables from org-mode into the +buffer. It will also recognize item context in multiline items." + (interactive "P") + (setq arg (prefix-numeric-value (or arg (if orgstruct-mode -1 1)))) + (if (< arg 1) + (progn (orgstruct-mode -1) + (mapc (lambda(v) + (org-set-local (car v) + (if (eq (car-safe (cadr v)) 'quote) (cadadr v) (cadr v)))) + org-fb-vars)) + (orgstruct-mode 1) + (setq org-fb-vars nil) + (unless org-local-vars + (setq org-local-vars (org-get-local-variables))) + (let (var val) + (mapc + (lambda (x) + (when (string-match + "^\\(paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|fill-prefix\\|indent-\\)" + (symbol-name (car x))) + (setq var (car x) val (nth 1 x)) + (push (list var `(quote ,(eval var))) org-fb-vars) + (org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val)))) + org-local-vars) + (org-set-local 'fill-paragraph-function 'orgstruct-fill-paragraph) + (org-set-local 'adaptive-fill-function 'orgstruct-adaptive-fill-function) + (org-set-local 'auto-fill-function 'orgstruct-auto-fill-function) + (org-set-local 'indent-line-function 'orgstruct-indent-line-function) + (org-set-local 'orgstruct-is-++ t)))) + +(defvar orgstruct-is-++ nil + "Is `orgstruct-mode' in ++ version in the current-buffer?") +(make-variable-buffer-local 'orgstruct-is-++) + +;;;###autoload +(defun turn-on-orgstruct++ () + "Unconditionally turn on `orgstruct++-mode'." + (orgstruct++-mode 1)) + +(defun orgstruct-fill-paragraph (&optional justify) + (interactive) + (cond + ((and (derived-mode-p 'message-mode) + (or (not (message-in-body-p)) + (save-excursion (move-beginning-of-line 1) + (looking-at message-cite-prefix-regexp)))) + ;; Set appropriate variables for message-mode + (let ((fill-paragraph-function + (cadadr (assoc 'fill-paragraph-function org-fb-vars))) + (fill-prefix (cadadr (assoc 'fill-prefix org-fb-vars))) + (paragraph-start (cadadr (assoc 'paragraph-start org-fb-vars))) + (paragraph-separate (cadadr (assoc 'paragraph-separate org-fb-vars))) + (org-element-paragraph-separate (cadadr (assoc 'paragraph-separate org-fb-vars)))) + (org-fill-paragraph))) + (t + (org-fill-paragraph)))) + +(defun orgstruct-adaptive-fill-function () + "Find the appropriate fill prefix for the current major mode." + (cond ((derived-mode-p 'message-mode) + (save-excursion + (beginning-of-line) + (cond ((not (message-in-body-p)) nil) + ((org-looking-at-p org-table-line-regexp) nil) + ((looking-at message-cite-prefix-regexp) + (match-string-no-properties 0)) + ((looking-at org-outline-regexp) + (make-string (length (match-string 0)) ?\s)) + ((message-in-body-p) + (let ((fill-paragraph-function + (cadadr (assoc 'fill-paragraph-function org-fb-vars))) + (fill-prefix (cadadr (assoc 'fill-prefix org-fb-vars))) + (paragraph-start (cadadr (assoc 'paragraph-start org-fb-vars))) + (paragraph-separate (cadadr (assoc 'paragraph-separate org-fb-vars))) + (org-element-paragraph-separate (cadadr (assoc 'paragraph-separate org-fb-vars)))) + (org-adaptive-fill-function)))))) + (t + (org-adaptive-fill-function)))) + +(defun orgstruct-auto-fill-function () + (let ((fc (current-fill-column))) + (when (and fc (> (current-column) fc)) + (let* ((fill-prefix (orgstruct-adaptive-fill-function)) + ;; Enforce empty fill prefix, if required. Otherwise, it + ;; will be computed again. + (adaptive-fill-mode (not (equal fill-prefix "")))) + (when fill-prefix (do-auto-fill)))))) + +(defun orgstruct-indent-line-function () + (interactive) + (cond + (orgstruct-is-++ + (let ((indent-line-function + (cadadr (assq 'indent-line-function org-fb-vars)))) + (indent-according-to-mode))) + (t + (org-indent-line)))) + +(provide 'org-struct) +;;; org-struct.el ends here diff --git a/lisp/org.el b/lisp/org.el index 72be8ee..90f2207 100755 --- a/lisp/org.el +++ b/lisp/org.el @@ -7924,8 +7924,6 @@ When NO-TODO is non-nil, don't include TODO keywords." (t (looking-at org-heading-regexp) (match-string 2))))) -(defvar orgstruct-mode) ; defined below - (defun org-heading-components () "Return the components of the current heading. This is a list with the following elements: @@ -7939,22 +7937,22 @@ This is a list with the following elements: (org-back-to-heading t) (if (let (case-fold-search) (looking-at - (if orgstruct-mode - org-heading-regexp - org-complex-heading-regexp))) - (if orgstruct-mode + (if (derived-mode-p 'org-mode) + org-complex-heading-regexp + org-heading-regexp))) + (if (derived-mode-p 'org-mode) (list (length (match-string 1)) - (org-reduced-level (length (match-string 1))) - nil - nil - (match-string 2) - nil) + (org-reduced-level (length (match-string 1))) + (org-match-string-no-properties 2) + (and (match-end 3) (aref (match-string 3) 2)) + (org-match-string-no-properties 4) + (org-match-string-no-properties 5)) (list (length (match-string 1)) - (org-reduced-level (length (match-string 1))) - (org-match-string-no-properties 2) - (and (match-end 3) (aref (match-string 3) 2)) - (org-match-string-no-properties 4) - (org-match-string-no-properties 5)))))) + (org-reduced-level (length (match-string 1))) + nil + nil + (match-string 2) + nil))))) (defun org-get-entry () "Get the entry text, after heading, entire subtree." @@ -9071,273 +9069,6 @@ When sorting is done, call `org-after-sorting-entries-or-items-hook'." (move-marker org-clock-marker (point)))) (message "Sorting entries...done"))) -;;; The orgstruct minor mode - -;; Define a minor mode which can be used in other modes in order to -;; integrate the org-mode structure editing commands. - -;; This is really a hack, because the org-mode structure commands use -;; keys which normally belong to the major mode. Here is how it -;; works: The minor mode defines all the keys necessary to operate the -;; structure commands, but wraps the commands into a function which -;; tests if the cursor is currently at a headline or a plain list -;; item. If that is the case, the structure command is used, -;; temporarily setting many Org-mode variables like regular -;; expressions for filling etc. However, when any of those keys is -;; used at a different location, function uses `key-binding' to look -;; up if the key has an associated command in another currently active -;; keymap (minor modes, major mode, global), and executes that -;; command. There might be problems if any of the keys is otherwise -;; used as a prefix key. - -(defcustom orgstruct-heading-prefix-regexp "" - "Regexp that matches the custom prefix of Org headlines in -orgstruct(++)-mode." - :group 'org - :version "24.4" - :package-version '(Org . "8.3") - :type 'regexp) -;;;###autoload(put 'orgstruct-heading-prefix-regexp 'safe-local-variable 'stringp) - -(defcustom orgstruct-setup-hook nil - "Hook run after orgstruct-mode-map is filled." - :group 'org - :version "24.4" - :package-version '(Org . "8.0") - :type 'hook) - -(defvar orgstruct-initialized nil) - -(defvar org-local-vars nil - "List of local variables, for use by `orgstruct-mode'.") - -;;;###autoload -(define-minor-mode orgstruct-mode - "Toggle the minor mode `orgstruct-mode'. -This mode is for using Org-mode structure commands in other -modes. The following keys behave as if Org-mode were active, if -the cursor is on a headline, or on a plain list item (both as -defined by Org-mode)." - nil " OrgStruct" (make-sparse-keymap) - (funcall (if orgstruct-mode - 'add-to-invisibility-spec - 'remove-from-invisibility-spec) - '(outline . t)) - (when orgstruct-mode - (org-load-modules-maybe) - (unless orgstruct-initialized - (orgstruct-setup) - (setq orgstruct-initialized t)))) - -;;;###autoload -(defun turn-on-orgstruct () - "Unconditionally turn on `orgstruct-mode'." - (orgstruct-mode 1)) - -(defvar org-fb-vars nil) -(make-variable-buffer-local 'org-fb-vars) -(defun orgstruct++-mode (&optional arg) - "Toggle `orgstruct-mode', the enhanced version of it. -In addition to setting orgstruct-mode, this also exports all -indentation and autofilling variables from org-mode into the -buffer. It will also recognize item context in multiline items." - (interactive "P") - (setq arg (prefix-numeric-value (or arg (if orgstruct-mode -1 1)))) - (if (< arg 1) - (progn (orgstruct-mode -1) - (mapc (lambda(v) - (org-set-local (car v) - (if (eq (car-safe (cadr v)) 'quote) (cadadr v) (cadr v)))) - org-fb-vars)) - (orgstruct-mode 1) - (setq org-fb-vars nil) - (unless org-local-vars - (setq org-local-vars (org-get-local-variables))) - (let (var val) - (mapc - (lambda (x) - (when (string-match - "^\\(paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|fill-prefix\\|indent-\\)" - (symbol-name (car x))) - (setq var (car x) val (nth 1 x)) - (push (list var `(quote ,(eval var))) org-fb-vars) - (org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val)))) - org-local-vars) - (org-set-local 'orgstruct-is-++ t)))) - -(defvar orgstruct-is-++ nil - "Is `orgstruct-mode' in ++ version in the current-buffer?") -(make-variable-buffer-local 'orgstruct-is-++) - -;;;###autoload -(defun turn-on-orgstruct++ () - "Unconditionally turn on `orgstruct++-mode'." - (orgstruct++-mode 1)) - -(defun orgstruct-error () - "Error when there is no default binding for a structure key." - (interactive) - (funcall (if (fboundp 'user-error) - 'user-error - 'error) - "This key has no function outside structure elements")) - -(defun orgstruct-setup () - "Setup orgstruct keymap." - (dolist (cell '((org-demote . t) - (org-metaleft . t) - (org-metaright . t) - (org-promote . t) - (org-shiftmetaleft . t) - (org-shiftmetaright . t) - org-backward-element - org-backward-heading-same-level - org-ctrl-c-ret - org-ctrl-c-minus - org-ctrl-c-star - org-cycle - org-forward-heading-same-level - org-insert-heading - org-insert-heading-respect-content - org-kill-note-or-show-branches - org-mark-subtree - org-meta-return - org-metadown - org-metaup - org-narrow-to-subtree - org-promote-subtree - org-reveal - org-shiftdown - org-shiftleft - org-shiftmetadown - org-shiftmetaup - org-shiftright - org-shifttab - org-shifttab - org-shiftup - org-show-subtree - org-sort - org-up-element - outline-demote - outline-next-visible-heading - outline-previous-visible-heading - outline-promote - outline-up-heading - show-children)) - (let ((f (or (car-safe cell) cell)) - (disable-when-heading-prefix (cdr-safe cell))) - (when (fboundp f) - (let ((new-bindings)) - (dolist (binding (nconc (where-is-internal f org-mode-map) - (where-is-internal f outline-mode-map))) - (push binding new-bindings) - ;; TODO use local-function-key-map - (dolist (rep '(("" . "TAB") - ("" . "RET") - ("" . "ESC") - ("" . "DEL"))) - (setq binding (read-kbd-macro - (let ((case-fold-search)) - (replace-regexp-in-string - (regexp-quote (cdr rep)) - (car rep) - (key-description binding))))) - (pushnew binding new-bindings :test 'equal))) - (dolist (binding new-bindings) - (let ((key (lookup-key orgstruct-mode-map binding))) - (when (or (not key) (numberp key)) - (ignore-errors - (org-defkey orgstruct-mode-map - binding - (orgstruct-make-binding - f binding disable-when-heading-prefix)))))))))) - (run-hooks 'orgstruct-setup-hook)) - -(defun orgstruct-make-binding (fun key disable-when-heading-prefix) - "Create a function for binding in the structure minor mode. -FUN is the command to call inside a table. KEY is the key that -should be checked in for a command to execute outside of tables. -Non-nil `disable-when-heading-prefix' means to disable the command -if `orgstruct-heading-prefix-regexp' is not empty." - (let ((name (concat "orgstruct-hijacker-" (symbol-name fun)))) - (let ((nname name) - (i 0)) - (while (fboundp (intern nname)) - (setq nname (format "%s-%d" name (setq i (1+ i))))) - (setq name (intern nname))) - (eval - (let ((bindings '((org-heading-regexp - (concat "^" - orgstruct-heading-prefix-regexp - "\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ ]*$")) - (org-outline-regexp - (concat orgstruct-heading-prefix-regexp "\\*+ ")) - (org-outline-regexp-bol - (concat "^" org-outline-regexp)) - (outline-regexp org-outline-regexp) - (outline-heading-end-regexp "\n") - (outline-level 'org-outline-level) - (outline-heading-alist)))) - `(defun ,name (arg) - ,(concat "In Structure, run `" (symbol-name fun) "'.\n" - "Outside of structure, run the binding of `" - (key-description key) "'." - (when disable-when-heading-prefix - (concat - "\nIf `orgstruct-heading-prefix-regexp' is not empty, this command will always fall\n" - "back to the default binding due to limitations of Org's implementation of\n" - "`" (symbol-name fun) "'."))) - (interactive "p") - (let* ((disable - ,(and disable-when-heading-prefix - '(not (string= orgstruct-heading-prefix-regexp "")))) - (fallback - (or disable - (not - (let* ,bindings - (org-context-p 'headline 'item - ,(when (memq fun - '(org-insert-heading - org-insert-heading-respect-content - org-meta-return)) - '(when orgstruct-is-++ - 'item-body)))))))) - (if fallback - (let* ((orgstruct-mode) - (binding - (let ((key ,key)) - (catch 'exit - (dolist - (rep - '(nil - ("<\\([^>]*\\)tab>" . "\\1TAB") - ("<\\([^>]*\\)return>" . "\\1RET") - ("<\\([^>]*\\)escape>" . "\\1ESC") - ("<\\([^>]*\\)delete>" . "\\1DEL")) - nil) - (when rep - (setq key (read-kbd-macro - (let ((case-fold-search)) - (replace-regexp-in-string - (car rep) - (cdr rep) - (key-description key)))))) - (when (key-binding key) - (throw 'exit (key-binding key)))))))) - (if (keymapp binding) - (org-set-transient-map binding) - (let ((func (or binding - (unless disable - 'orgstruct-error)))) - (when func - (call-interactively func))))) - (org-run-like-in-org-mode - (lambda () - (interactive) - (let* ,bindings - (call-interactively ',fun))))))))) - name)) - (defun org-contextualize-keys (alist contexts) "Return valid elements in ALIST depending on CONTEXTS. @@ -9462,6 +9193,10 @@ Optional argument REGEXP selects variables to clone." (cdr pair)))) (buffer-local-variables from-buffer))) +(defvar org-local-vars nil + "List of Org-mode local variables, for using Org commands in + non-org-mode buffers.") + ;;;###autoload (defun org-run-like-in-org-mode (cmd) "Run a command, pretending that the current buffer is in Org-mode. @@ -22891,10 +22626,6 @@ list structure. Instead, use \\\\[org-shiftmetaleft] or \ Also align node properties according to `org-property-format'." (interactive) (cond - (orgstruct-is-++ - (let ((indent-line-function - (cadadr (assq 'indent-line-function org-fb-vars)))) - (indent-according-to-mode))) ((org-at-heading-p) 'noindent) (t (let* ((element (save-excursion (beginning-of-line) (org-element-at-point))) @@ -23122,71 +22853,59 @@ assumed to be significant there." Return fill prefix, as a string, or nil if current line isn't meant to be filled. For convenience, if `adaptive-fill-regexp' matches in paragraphs or comments, use it." - (catch 'exit - (when (derived-mode-p 'message-mode) - (save-excursion - (beginning-of-line) - (cond ((not (message-in-body-p)) (throw 'exit nil)) - ((org-looking-at-p org-table-line-regexp) (throw 'exit nil)) - ((looking-at message-cite-prefix-regexp) - (throw 'exit (match-string-no-properties 0))) - ((looking-at org-outline-regexp) - (throw 'exit (make-string (length (match-string 0)) ?\s)))))) - (org-with-wide-buffer - (unless (org-at-heading-p) - (let* ((p (line-beginning-position)) - (element (save-excursion - (beginning-of-line) - (org-element-at-point))) - (type (org-element-type element)) - (post-affiliated (org-element-property :post-affiliated element))) - (unless (< p post-affiliated) - (case type - (comment + (org-with-wide-buffer + (unless (org-at-heading-p) + (let* ((p (line-beginning-position)) + (element (save-excursion + (beginning-of-line) + (org-element-at-point))) + (type (org-element-type element)) + (post-affiliated (org-element-property :post-affiliated element))) + (unless (< p post-affiliated) + (case type + (comment + (save-excursion + (beginning-of-line) + (looking-at "[ \t]*") + (concat (match-string 0) "# "))) + (footnote-definition "") + ((item plain-list) + (make-string (org-list-item-body-column post-affiliated) ?\s)) + (paragraph + ;; Fill prefix is usually the same as the current line, + ;; unless the paragraph is at the beginning of an item. + (let ((parent (org-element-property :parent element))) (save-excursion (beginning-of-line) - (looking-at "[ \t]*") - (concat (match-string 0) "# "))) - (footnote-definition "") - ((item plain-list) - (make-string (org-list-item-body-column post-affiliated) ?\s)) - (paragraph - ;; Fill prefix is usually the same as the current line, - ;; unless the paragraph is at the beginning of an item. - (let ((parent (org-element-property :parent element))) - (save-excursion - (beginning-of-line) - (cond ((eq (org-element-type parent) 'item) - (make-string (org-list-item-body-column - (org-element-property :begin parent)) - ?\s)) - ((and adaptive-fill-regexp - ;; Locally disable - ;; `adaptive-fill-function' to let - ;; `fill-context-prefix' handle - ;; `adaptive-fill-regexp' variable. - (let (adaptive-fill-function) - (fill-context-prefix - post-affiliated - (org-element-property :end element))))) - ((looking-at "[ \t]+") (match-string 0)) - (t ""))))) - (comment-block - ;; Only fill contents if P is within block boundaries. - (let* ((cbeg (save-excursion (goto-char post-affiliated) - (forward-line) - (point))) - (cend (save-excursion - (goto-char (org-element-property :end element)) - (skip-chars-backward " \r\t\n") - (line-beginning-position)))) - (when (and (>= p cbeg) (< p cend)) - (if (save-excursion (beginning-of-line) (looking-at "[ \t]+")) - (match-string 0) - ""))))))))))) - -(declare-function message-goto-body "message" ()) -(defvar message-cite-prefix-regexp) ; From message.el + (cond ((eq (org-element-type parent) 'item) + (make-string (org-list-item-body-column + (org-element-property :begin parent)) + ?\s)) + ((and adaptive-fill-regexp + ;; Locally disable + ;; `adaptive-fill-function' to let + ;; `fill-context-prefix' handle + ;; `adaptive-fill-regexp' variable. + (let (adaptive-fill-function) + (fill-context-prefix + post-affiliated + (org-element-property :end element))))) + ((looking-at "[ \t]+") (match-string 0)) + (t ""))))) + (comment-block + ;; Only fill contents if P is within block boundaries. + (let* ((cbeg (save-excursion (goto-char post-affiliated) + (forward-line) + (point))) + (cend (save-excursion + (goto-char (org-element-property :end element)) + (skip-chars-backward " \r\t\n") + (line-beginning-position)))) + (when (and (>= p cbeg) (< p cend)) + (if (save-excursion (beginning-of-line) (looking-at "[ \t]+")) + (match-string 0) + "")))))))))) + (defun org-fill-paragraph (&optional justify) "Fill element at point, when applicable. @@ -23203,125 +22922,104 @@ 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." (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))) - (paragraph-start (cadadr (assoc 'paragraph-start org-fb-vars))) - (paragraph-separate - (cadadr (assoc 'paragraph-separate org-fb-vars)))) - (fill-paragraph nil)) - (with-syntax-table org-mode-transpose-word-syntax-table - ;; Move to end of line in order to get the first paragraph - ;; within a plain list or a footnote definition. - (let ((element (save-excursion - (end-of-line) - (or (ignore-errors (org-element-at-point)) - (user-error "An element cannot be parsed line %d" - (line-number-at-pos (point))))))) - ;; First check if point is in a blank line at the beginning of - ;; the buffer. In that case, ignore filling. - (case (org-element-type element) - ;; Use major mode filling function is src blocks. - (src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q"))) - ;; Align Org tables, leave table.el tables as-is. - (table-row (org-table-align) t) - (table - (when (eq (org-element-property :type element) 'org) + (with-syntax-table org-mode-transpose-word-syntax-table + ;; Move to end of line in order to get the first paragraph + ;; within a plain list or a footnote definition. + (let ((element (save-excursion + (end-of-line) + (or (ignore-errors (org-element-at-point)) + (user-error "An element cannot be parsed line %d" + (line-number-at-pos (point))))))) + ;; First check if point is in a blank line at the beginning of + ;; the buffer. In that case, ignore filling. + (case (org-element-type element) + ;; Use major mode filling function is src blocks. + (src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q"))) + ;; Align Org tables, leave table.el tables as-is. + (table-row (org-table-align) t) + (table + (when (eq (org-element-property :type element) 'org) + (save-excursion + (goto-char (org-element-property :post-affiliated element)) + (org-table-align))) + t) + (paragraph + ;; Paragraphs may contain `line-break' type objects. + (let ((beg (max (point-min) + (org-element-property :contents-begin element))) + (end (min (point-max) + (org-element-property :contents-end element)))) + ;; Do nothing if point is at an affiliated keyword. + (if (< (line-end-position) beg) t + ;; Fill paragraph, taking line breaks into account. (save-excursion - (goto-char (org-element-property :post-affiliated element)) - (org-table-align))) - t) - (paragraph - ;; Paragraphs may contain `line-break' type objects. - (let ((beg (max (point-min) - (org-element-property :contents-begin element))) - (end (min (point-max) - (org-element-property :contents-end element)))) - ;; Do nothing if point is at an affiliated keyword. - (if (< (line-end-position) beg) t - (when (derived-mode-p 'message-mode) - ;; In `message-mode', do not fill following citation - ;; in current paragraph nor text before message body. - (let ((body-start (save-excursion (message-goto-body)))) - (when body-start (setq beg (max body-start beg)))) - (when (save-excursion - (re-search-forward - (concat "^" message-cite-prefix-regexp) end t)) - (setq end (match-beginning 0)))) - ;; Fill paragraph, taking line breaks into account. - (save-excursion - (goto-char beg) - (let ((cuts (list beg))) - (while (re-search-forward "\\\\\\\\[ \t]*\n" end t) - (when (eq 'line-break - (org-element-type - (save-excursion (backward-char) - (org-element-context)))) - (push (point) cuts))) - (dolist (c (delq end cuts)) - (fill-region-as-paragraph c end justify) - (setq end c)))) - t))) - ;; Contents of `comment-block' type elements should be - ;; filled as plain text, but only if point is within block - ;; markers. - (comment-block - (let* ((case-fold-search t) - (beg (save-excursion - (goto-char (org-element-property :begin element)) - (re-search-forward "^[ \t]*#\\+begin_comment" nil t) - (forward-line) - (point))) - (end (save-excursion - (goto-char (org-element-property :end element)) - (re-search-backward "^[ \t]*#\\+end_comment" nil t) - (line-beginning-position)))) - (if (or (< (point) beg) (> (point) end)) t - (fill-region-as-paragraph - (save-excursion (end-of-line) - (re-search-backward "^[ \t]*$" beg 'move) - (line-beginning-position)) - (save-excursion (beginning-of-line) - (re-search-forward "^[ \t]*$" end 'move) - (line-beginning-position)) - justify)))) - ;; Fill comments. - (comment - (let ((begin (org-element-property :post-affiliated element)) - (end (org-element-property :end element))) - (when (and (>= (point) begin) (<= (point) end)) - (let ((begin (save-excursion - (end-of-line) - (if (re-search-backward "^[ \t]*#[ \t]*$" begin t) - (progn (forward-line) (point)) - begin))) - (end (save-excursion + (goto-char beg) + (let ((cuts (list beg))) + (while (re-search-forward "\\\\\\\\[ \t]*\n" end t) + (when (eq 'line-break + (org-element-type + (save-excursion (backward-char) + (org-element-context)))) + (push (point) cuts))) + (dolist (c (delq end cuts)) + (fill-region-as-paragraph c end justify) + (setq end c)))) + t))) + ;; Contents of `comment-block' type elements should be + ;; filled as plain text, but only if point is within block + ;; markers. + (comment-block + (let* ((case-fold-search t) + (beg (save-excursion + (goto-char (org-element-property :begin element)) + (re-search-forward "^[ \t]*#\\+begin_comment" nil t) + (forward-line) + (point))) + (end (save-excursion + (goto-char (org-element-property :end element)) + (re-search-backward "^[ \t]*#\\+end_comment" nil t) + (line-beginning-position)))) + (if (or (< (point) beg) (> (point) end)) t + (fill-region-as-paragraph + (save-excursion (end-of-line) + (re-search-backward "^[ \t]*$" beg 'move) + (line-beginning-position)) + (save-excursion (beginning-of-line) + (re-search-forward "^[ \t]*$" end 'move) + (line-beginning-position)) + justify)))) + ;; Fill comments. + (comment + (let ((begin (org-element-property :post-affiliated element)) + (end (org-element-property :end element))) + (when (and (>= (point) begin) (<= (point) end)) + (let ((begin (save-excursion (end-of-line) - (if (re-search-forward "^[ \t]*#[ \t]*$" end 'move) - (1- (line-beginning-position)) - (skip-chars-backward " \r\t\n") - (line-end-position))))) - ;; Do not fill comments when at a blank line. - (when (> end begin) - (let ((fill-prefix - (save-excursion - (beginning-of-line) - (looking-at "[ \t]*#") - (let ((comment-prefix (match-string 0))) - (goto-char (match-end 0)) - (if (looking-at adaptive-fill-regexp) - (concat comment-prefix (match-string 0)) - (concat comment-prefix " ")))))) - (save-excursion - (fill-region-as-paragraph begin end justify)))))) - t)) - ;; Ignore every other element. - (otherwise t)))))) + (if (re-search-backward "^[ \t]*#[ \t]*$" begin t) + (progn (forward-line) (point)) + begin))) + (end (save-excursion + (end-of-line) + (if (re-search-forward "^[ \t]*#[ \t]*$" end 'move) + (1- (line-beginning-position)) + (skip-chars-backward " \r\t\n") + (line-end-position))))) + ;; Do not fill comments when at a blank line. + (when (> end begin) + (let ((fill-prefix + (save-excursion + (beginning-of-line) + (looking-at "[ \t]*#") + (let ((comment-prefix (match-string 0))) + (goto-char (match-end 0)) + (if (looking-at adaptive-fill-regexp) + (concat comment-prefix (match-string 0)) + (concat comment-prefix " ")))))) + (save-excursion + (fill-region-as-paragraph begin end justify)))))) + t)) + ;; Ignore every other element. + (otherwise t))))) (defun org-auto-fill-function () "Auto-fill function." -- 2.3.3