From mboxrd@z Thu Jan 1 00:00:00 1970 From: Christopher Schmidt Subject: orgstruct-mode with custom headline prefix Date: Mon, 28 Jan 2013 17:15:59 +0000 (GMT) Message-ID: <87vcah6xf5@ch.ristopher.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([208.118.235.92]:41484) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1TztnE-0007uU-Hy for emacs-orgmode@gnu.org; Mon, 28 Jan 2013 13:51:01 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1TzsJP-0003Dl-DR for emacs-orgmode@gnu.org; Mon, 28 Jan 2013 12:16:51 -0500 Received: from ristopher.com ([146.185.21.93]:55532 helo=saturn.ch.ristopher.com) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1TzsJO-0003DR-Nm for emacs-orgmode@gnu.org; Mon, 28 Jan 2013 12:16:03 -0500 List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: emacs-orgmode@gnu.org --=-=-= Content-Type: text/plain Hi Org, here is a patch for master that enables the use of a custom headline prefix file locally in conjunction with orgstruct-mode. 2013-01-28 Christopher Schmidt * org.el (org-outline-regexp, org-heading-regexp): Make them safe local variables. (org-outline-regexp-bol): Remove variable, new function. All users of org-outline-regexp-bol changed. (org-cycle-global-status, org-cycle-subtree-status): Set state property. (org-heading-components): Use org-heading-regexp in orgstruct-mode. (orgstruct-mode): Simplify docstring. (orgstruct-setup): Simplify implementation. Translate keys to their most general equivalent. (orgstruct-make-binding): Generate index on the fly, discard alternative keys. (org-get-local-variables): Honour state property. (org-run-like-in-org-mode): Do not override variables with non-default values. (org-forward-heading-same-level): Use org-outline-regexp-bol. Do not skip to parent heading. (org-backward-heading-same-level): Use org-forward-heading-same-level. --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=orgstruct.diff --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -4437,9 +4437,9 @@ in `org-agenda-text-search-extra-files'." regexps+)) (setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b))))) (if (not regexps+) - (setq regexp org-outline-regexp-bol) + (setq regexp (org-outline-regexp-bol)) (setq regexp (pop regexps+)) - (if hdl-only (setq regexp (concat org-outline-regexp-bol ".*?" + (if hdl-only (setq regexp (concat (org-outline-regexp-bol) ".*?" regexp)))) (setq files (org-agenda-files nil 'ifmode)) (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives) @@ -5018,10 +5018,10 @@ of what a project is and how to check if it stuck, customize the variable "\\)\\>")) (tags (nth 2 org-stuck-projects)) (tags-re (if (member "*" tags) - (concat org-outline-regexp-bol + (concat (org-outline-regexp-bol) (org-re ".*:[[:alnum:]_@#%]+:[ \t]*$")) (if tags - (concat org-outline-regexp-bol + (concat (org-outline-regexp-bol) ".*:\\(" (mapconcat 'identity tags "\\|") (org-re "\\):[[:alnum:]_@#%:]*[ \t]*$"))))) @@ -5547,7 +5547,7 @@ Do we have a reason to ignore this TODO entry because it has a time stamp? category (org-get-category b0) category-pos (get-text-property b0 'org-category-position)) (save-excursion - (if (not (re-search-backward org-outline-regexp-bol nil t)) + (if (not (re-search-backward (org-outline-regexp-bol) nil t)) (throw :skip nil) (goto-char (match-beginning 0)) (if (and (eq t org-agenda-skip-timestamp-if-deadline-is-shown) @@ -5785,7 +5785,7 @@ please use `org-class' instead." (clockp (and (looking-at ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$") (match-string 1))))) - (if (not (re-search-backward org-outline-regexp-bol nil t)) + (if (not (re-search-backward (org-outline-regexp-bol) nil t)) (throw :skip nil) (goto-char (match-beginning 0)) (setq hdmarker (org-agenda-new-marker) @@ -6249,7 +6249,7 @@ FRACTION is what fraction of the head-warning time has passed." (setq marker (org-agenda-new-marker (point))) (setq category (org-get-category) category-pos (get-text-property (point) 'org-category-position)) - (if (not (re-search-backward org-outline-regexp-bol nil t)) + (if (not (re-search-backward (org-outline-regexp-bol) nil t)) (throw :skip nil) (goto-char (match-beginning 0)) (setq hdmarker (org-agenda-new-marker (point)) --- a/lisp/org-ascii.el +++ b/lisp/org-ascii.el @@ -422,7 +422,7 @@ publishing directory." (org-init-section-numbers) (while (setq line (pop lines)) - (when (and link-buffer (string-match org-outline-regexp-bol line)) + (when (and link-buffer (string-match (org-outline-regexp-bol) line)) (org-export-ascii-push-links (nreverse link-buffer)) (setq link-buffer nil)) (setq wrap nil) --- a/lisp/org-colview-xemacs.el +++ b/lisp/org-colview-xemacs.el @@ -858,7 +858,7 @@ around it." (save-restriction (narrow-to-region beg end) (org-clock-sum)))) - (while (re-search-forward org-outline-regexp-bol end t) + (while (re-search-forward (org-outline-regexp-bol) end t) (if (and org-columns-skip-archived-trees (looking-at (concat ".*:" org-archive-tag ":"))) (org-end-of-subtree t) @@ -1093,7 +1093,7 @@ Don't set this, this is meant for dynamic scoping.") (defun org-columns-compute (property) "Sum the values of property PROPERTY hierarchically, for the entire buffer." (interactive) - (let* ((re org-outline-regexp-bol) + (let* ((re (org-outline-regexp-bol)) (lmax 30) ; Does anyone use deeper levels??? (lvals (make-vector lmax nil)) (lflag (make-vector lmax nil)) --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -717,7 +717,7 @@ When COLUMNS-FMT-STRING is non-nil, use it as the column format." (save-restriction (narrow-to-region beg end) (org-clock-sum-today)))) - (while (re-search-forward org-outline-regexp-bol end t) + (while (re-search-forward (org-outline-regexp-bol) end t) (if (and org-columns-skip-archived-trees (looking-at (concat ".*:" org-archive-tag ":"))) (org-end-of-subtree t) @@ -952,7 +952,7 @@ Don't set this, this is meant for dynamic scoping.") (defun org-columns-compute (property) "Sum the values of property PROPERTY hierarchically, for the entire buffer." (interactive) - (let* ((re org-outline-regexp-bol) + (let* ((re (org-outline-regexp-bol)) (lmax 30) ; Does anyone use deeper levels??? (lvals (make-vector lmax nil)) (lflag (make-vector lmax nil)) --- a/lisp/org-docbook.el +++ b/lisp/org-docbook.el @@ -652,7 +652,7 @@ publishing directory." (catch 'nextline ;; End of quote section? - (when (and inquote (string-match org-outline-regexp-bol line)) + (when (and inquote (string-match (org-outline-regexp-bol) line)) (insert "]]>\n") (org-export-docbook-open-para) (setq inquote nil)) --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -691,7 +691,7 @@ Assume point is at the beginning of the footnote definition." (if (progn (end-of-line) (re-search-forward - (concat org-outline-regexp-bol "\\|" + (concat (org-outline-regexp-bol) "\\|" org-footnote-definition-re "\\|" "^[ \t]*$") limit 'move)) (match-beginning 0) --- a/lisp/org-footnote.el +++ b/lisp/org-footnote.el @@ -38,6 +38,7 @@ (require 'org-compat) (declare-function message-point-in-header-p "message" ()) +(declare-function org-outline-regexp-bol "org" ()) (declare-function org-back-over-empty-lines "org" ()) (declare-function org-back-to-heading "org" (&optional invisible-ok)) (declare-function org-combine-plists "org" (&rest plists)) @@ -61,7 +62,6 @@ (declare-function outline-next-heading "outline") (declare-function org-skip-whitespace "org" ()) -(defvar org-outline-regexp-bol) ; defined in org.el (defvar org-odd-levels-only) ; defined in org.el (defvar org-bracket-link-regexp) ; defined in org.el (defvar message-cite-prefix-regexp) ; defined in message.el @@ -260,7 +260,7 @@ otherwise." ;; Footnotes definitions are separated by new headlines or blank ;; lines. (let ((lim (save-excursion (re-search-backward - (concat org-outline-regexp-bol + (concat (org-outline-regexp-bol) "\\|^[ \t]*$") nil t)))) (when (re-search-backward org-footnote-definition-re lim t) (let ((label (org-match-string-no-properties 1)) @@ -275,7 +275,7 @@ otherwise." (if (progn (end-of-line) (re-search-forward - (concat org-outline-regexp-bol "\\|" + (concat (org-outline-regexp-bol) "\\|" org-footnote-definition-re "\\|" "^[ \t]*$") bound 'move)) (match-beginning 0) --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -1588,7 +1588,7 @@ PUB-DIR is set, use this as the publishing directory." (catch 'nextline ;; end of quote section? - (when (and inquote (string-match org-outline-regexp-bol org-line)) + (when (and inquote (string-match (org-outline-regexp-bol) org-line)) (insert "\n") (org-open-par) (setq inquote nil)) --- a/lisp/org-indent.el +++ b/lisp/org-indent.el @@ -403,7 +403,7 @@ headline." (goto-char beg) (save-match-data (or (and (org-at-heading-p) (< beg (match-end 0))) - (re-search-forward org-outline-regexp-bol end t))))))) + (re-search-forward (org-outline-regexp-bol) end t))))))) (defun org-indent-refresh-maybe (beg end dummy) "Refresh indentation properties in an adequate portion of buffer. @@ -419,7 +419,7 @@ This function is meant to be called by `after-change-functions'." (save-excursion (goto-char beg) (beginning-of-line) - (re-search-forward org-outline-regexp-bol end t))) + (re-search-forward (org-outline-regexp-bol) end t))) (let ((end (save-excursion (goto-char end) (org-with-limited-levels (outline-next-heading)) --- a/lisp/org-lparse.el +++ b/lisp/org-lparse.el @@ -834,7 +834,7 @@ version." (while (setq line (pop lines) origline line) (catch 'nextline (when (and (org-lparse-current-environment-p 'quote) - (string-match org-outline-regexp-bol line)) + (string-match (org-outline-regexp-bol) line)) (org-lparse-end-environment 'quote)) (when (org-lparse-current-environment-p 'quote) --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -389,8 +389,7 @@ point nowhere." "Execute BODY with limited number of outline levels." `(let* ((org-called-with-limited-levels t) (org-outline-regexp (org-get-limited-outline-regexp)) - (outline-regexp org-outline-regexp) - (org-outline-regexp-bol (concat "^" org-outline-regexp))) + (outline-regexp org-outline-regexp)) ,@body)) (def-edebug-spec org-with-limited-levels (body)) --- a/lisp/org-remember.el +++ b/lisp/org-remember.el @@ -1072,7 +1072,7 @@ See also the variable `org-reverse-note-order'." (save-restriction (widen) (goto-char (point-min)) - (re-search-forward org-outline-regexp-bol nil t) + (re-search-forward (org-outline-regexp-bol) nil t) (beginning-of-line 1) (org-paste-subtree 1 txt) (and org-auto-align-tags (org-set-tags nil t)) --- a/lisp/org.el +++ b/lisp/org.el @@ -92,15 +92,18 @@ ;; job when `orgstruct-mode' is active. (defvar org-outline-regexp "\\*+ " "Regexp to match Org headlines.") +;;;###autoload(put 'org-outline-regexp 'safe-local-variable 'stringp) -(defvar org-outline-regexp-bol "^\\*+ " - "Regexp to match Org headlines. +(defun org-outline-regexp-bol () + "Returns regexp to match Org headlines. This is similar to `org-outline-regexp' but additionally makes -sure that we are at the beginning of the line.") +sure that we are at the beginning of the line." + (concat "^" org-outline-regexp)) (defvar org-heading-regexp "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" "Matches an headline, putting stars and text into groups. Stars are put in group 1 and the trimmed body in group 2.") +;;;###autoload(put 'org-heading-regexp 'safe-local-variable 'stringp) ;; Emacs 22 calendar compatibility: Make sure the new variables are available (when (fboundp 'defvaralias) @@ -5988,7 +5991,7 @@ needs to be inserted at a specific position in the font-lock sequence.") 1 'org-list-dt prepend) ;; ARCHIVEd headings (list (concat - org-outline-regexp-bol + (org-outline-regexp-bol) "\\(.*:" org-archive-tag ":.*\\)") '(1 'org-archived prepend)) ;; Specials @@ -6225,8 +6228,10 @@ and subscripts." (defvar org-cycle-global-status nil) (make-variable-buffer-local 'org-cycle-global-status) +(put 'org-cycle-global-status 'org-state t) (defvar org-cycle-subtree-status nil) (make-variable-buffer-local 'org-cycle-subtree-status) +(put 'org-cycle-subtree-status 'org-state t) (defvar org-inlinetask-min-level) @@ -7405,13 +7410,24 @@ This is a list with the following elements: - the tags string, or nil." (save-excursion (org-back-to-heading t) - (if (let (case-fold-search) (looking-at org-complex-heading-regexp)) - (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))))) + (if (let (case-fold-search) + (looking-at + (if orgstruct-mode + org-heading-regexp + org-complex-heading-regexp))) + (if orgstruct-mode + (list (length (match-string 1)) + (org-reduced-level (length (match-string 1))) + nil + nil + (match-string 2) + nil) + (list (length (match-string 1)) + (org-reduced-level (length (match-string 1))) + (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)))))) (defun org-get-entry () "Get the entry text, after heading, entire subtree." @@ -7697,7 +7713,7 @@ After top level, it switches back to sibling level." (save-excursion (setq end (copy-marker end)) (goto-char beg) - (if (and (re-search-forward org-outline-regexp-bol nil t) + (if (and (re-search-forward (org-outline-regexp-bol) nil t) (< (point) end)) (funcall fun)) (while (and (progn @@ -7941,7 +7957,7 @@ the inserted text when done." (let* ((visp (not (outline-invisible-p))) (txt tree) (^re_ "\\(\\*+\\)[ \t]*") - (old-level (if (string-match org-outline-regexp-bol txt) + (old-level (if (string-match (org-outline-regexp-bol) txt) (- (match-end 0) (match-beginning 0) 1) -1)) (force-level (cond (level (prefix-numeric-value level)) @@ -8500,23 +8516,7 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive." 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). - -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 / Checkbox item -C-c C-c Set tags / toggle checkbox" +defined by Org-mode)." nil " OrgStruct" nil (org-load-modules-maybe) (and (orgstruct-setup) (defun orgstruct-setup () nil))) @@ -8571,103 +8571,80 @@ buffer. It will also recognize item context in multiline items." (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) - '([?\e (up)] org-metaup) - '([?\e (down)] org-metadown) - '([?\e (left)] org-metaleft) - '([?\e (right)] org-metaright) - '([?\e (shift up)] org-shiftmetaup) - '([?\e (shift down)] org-shiftmetadown) - '([?\e (shift left)] org-shiftmetaleft) - '([?\e (shift right)] org-shiftmetaright) - '([(shift up)] org-shiftup) - '([(shift down)] org-shiftdown) - '([(shift left)] org-shiftleft) - '([(shift right)] org-shiftright) - '("\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)) - - ;; Prevent an error for users who forgot to make autoloads - (require 'org-element) - - ;; 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")) - - (org-defkey orgstruct-mode-map "\e\C-m" - (orgstruct-make-binding 'org-insert-heading 108 - "\e\C-m" [?\e (return)])) - (org-defkey orgstruct-mode-map [?\e (return)] - (orgstruct-make-binding 'org-insert-heading 109 - [?\e (return)] "\e\C-m")) - (org-defkey orgstruct-mode-map [?\e (shift return)] - (orgstruct-make-binding 'org-insert-todo-heading 110 - [?\e (return)] "\e\C-m")) - - (unless org-local-vars - (setq org-local-vars (org-get-local-variables))) - - t)) - -(defun orgstruct-make-binding (fun n &rest keys) + (dolist (f + '("org-meta" + "org-shiftmeta" + org-shifttab + org-backward-element + org-backward-heading-same-level + org-ctrl-c-ret + 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-narrow-to-subtree + org-promote-subtree + org-reveal + 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) + t) + (dolist (f (if (stringp f) + (let ((flist)) + (dolist (postfix + '("-return" "tab" "left" "right" "up" "down") + flist) + (let ((f (intern (concat f postfix)))) + (when (fboundp f) + (push f flist))))) + (list f))) + (dolist (binding (nconc (where-is-internal f org-mode-map) + (where-is-internal f outline-mode-map))) + (dolist (rep '(("" . "TAB") + ("" . "RET") + ("" . "ESC") + ("" . "DEL"))) + (setq binding (kbd (replace-regexp-in-string + (regexp-quote (car rep)) + (cdr rep) + (key-description binding))))) + (org-defkey orgstruct-mode-map + binding + (orgstruct-make-binding f binding)))))) + +(defun orgstruct-make-binding (fun key) "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" +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." + (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 + `(defun ,name (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 - (and orgstruct-is-++ - ,(and (memq fun '(org-insert-heading org-insert-todo-heading)) t) - 'item-body)) - (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)))))))) + (key-description key) "'.") + (interactive "p") + (if (org-context-p 'headline 'item + ,(when (memq fun '(org-insert-heading)) + '(when orgstruct-is-++ + 'item-body))) + (org-run-like-in-org-mode ',fun) + (let ((orgstruct-mode)) + (call-interactively (or (key-binding ,key) 'orgstruct-error)))))) + name)) (defun org-contextualize-keys (alist contexts) "Return valid elements in ALIST depending on CONTEXTS. @@ -8769,11 +8746,12 @@ Possible values in the list of contexts are `table', `headline', and `item'." (setq x (if (symbolp x) (list x) - (list (car x) (list 'quote (cdr x))))) - (if (string-match - "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)" - (symbol-name (car x))) - x nil)) + (list (car x) (cdr x)))) + (if (and (not (get (car x) 'org-state)) + (string-match + "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)" + (symbol-name (car x)))) + x nil)) varlist)))) (defun org-clone-local-variables (from-buffer &optional regexp) @@ -8797,8 +8775,15 @@ call CMD." (org-load-modules-maybe) (unless org-local-vars (setq org-local-vars (org-get-local-variables))) - (eval (list 'let org-local-vars - (list 'call-interactively (list 'quote cmd))))) + (let (symbols values) + (dolist (var org-local-vars) + (when (eq (symbol-value (car var)) + (default-value (car var))) + (push (car var) symbols) + (push (cadr var) values))) + (progv symbols values + (let ((outline-regexp org-outline-regexp)) + (call-interactively cmd))))) ;;;; Archiving @@ -13919,7 +13904,7 @@ With prefix ARG, realign all tags in headings in the current buffer." `(org-set-tags) org-loop-over-headlines-in-active-region cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) - (let* ((re org-outline-regexp-bol) + (let* ((re (org-outline-regexp-bol)) (current (unless arg (org-get-tags-string))) (col (current-column)) (org-setting-tags t) @@ -15106,7 +15091,7 @@ Point is left between drawer's boundaries." (goto-char rbeg) (beginning-of-line) (when (save-excursion - (re-search-forward org-outline-regexp-bol rend t)) + (re-search-forward (org-outline-regexp-bol) rend t)) (error "Drawers cannot contain headlines")) ;; Position point at the beginning of the first ;; non-blank line in region. Insert drawer's opening @@ -17637,7 +17622,7 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (cond ((or (equal subtree '(16)) (not (save-excursion - (re-search-backward org-outline-regexp-bol nil t)))) + (re-search-backward (org-outline-regexp-bol) nil t)))) (setq beg (point-min) end (point-max) msg "Creating images for buffer...%s")) ((equal subtree '(4)) @@ -19182,7 +19167,7 @@ WHAT can be either `headlines' or `items'. If the current line is an outline or item heading and it has a folded subtree below it, this function returns t, nil otherwise." (let ((re (cond - ((eq what 'headlines) org-outline-regexp-bol) + ((eq what 'headlines) (org-outline-regexp-bol)) ((eq what 'items) (org-item-beginning-re)) (t (error "This should not happen")))) beg end) @@ -19838,7 +19823,7 @@ argument ARG, change each line in region into an item." (cond ;; Skip blank lines and inline tasks. ((looking-at "^[ \t]*$")) - ((looking-at org-outline-regexp-bol)) + ((looking-at (org-outline-regexp-bol))) ;; We can't find less than 0 indentation. ((zerop i) (throw 'exit (setq min-i 0))) ((< i min-i) (setq min-i i)))) @@ -19849,7 +19834,7 @@ argument ARG, change each line in region into an item." (let ((delta (- ind min-i))) (while (< (point) end) (unless (or (looking-at "^[ \t]*$") - (looking-at org-outline-regexp-bol)) + (looking-at (org-outline-regexp-bol))) (org-indent-line-to (+ (org-get-indentation) delta))) (forward-line))))))) (skip-blanks @@ -22297,7 +22282,7 @@ interactive command with similar behavior." (org-yank-folding-would-swallow-text beg end)))) (org-with-limited-levels (or (looking-at org-outline-regexp) - (re-search-forward org-outline-regexp-bol end t)) + (re-search-forward (org-outline-regexp-bol) end t)) (while (and (< (point) end) (looking-at org-outline-regexp)) (hide-subtree) (org-cycle-show-empty-lines 'folded) @@ -22326,7 +22311,7 @@ interactive command with similar behavior." (save-excursion (goto-char beg) (when (or (looking-at org-outline-regexp) - (re-search-forward org-outline-regexp-bol end t)) + (re-search-forward (org-outline-regexp-bol) end t)) (setq level (org-outline-level))) (goto-char end) (skip-chars-forward " \t\r\n\v\f") @@ -22365,7 +22350,7 @@ This version does not only check the character property, but also "Before first heading?" (save-excursion (end-of-line) - (null (re-search-backward org-outline-regexp-bol nil t)))) + (null (re-search-backward (org-outline-regexp-bol) nil t)))) (defun org-at-heading-p (&optional ignored) (outline-on-heading-p t)) @@ -22439,7 +22424,7 @@ make a significant difference in outlines with very many siblings." (defun org-first-sibling-p () "Is this heading the first child of its parents?" (interactive) - (let ((re org-outline-regexp-bol) + (let ((re (org-outline-regexp-bol)) level l) (unless (org-at-heading-p t) (error "Not at a heading")) @@ -22457,7 +22442,7 @@ when a sibling was found. When none is found, return nil and don't move point." (let ((fun (if previous 're-search-backward 're-search-forward)) (pos (point)) - (re org-outline-regexp-bol) + (re (org-outline-regexp-bol)) level l) (when (condition-case nil (org-back-to-heading t) (error nil)) (setq level (funcall outline-level)) @@ -22482,7 +22467,7 @@ move point." "Goto the first child, even if it is invisible. Return t when a child was found. Otherwise don't move point and return nil." - (let (level (pos (point)) (re org-outline-regexp-bol)) + (let (level (pos (point)) (re (org-outline-regexp-bol))) (when (condition-case nil (org-back-to-heading t) (error nil)) (setq level (outline-level)) (forward-char 1) @@ -22600,46 +22585,40 @@ clocking lines, and drawers." (point))) (defun org-forward-heading-same-level (arg &optional invisible-ok) - "Move forward to the arg'th subheading at same level as this one. + "Move forward to the ARG'th subheading at same level as this one. Stop at the first and last subheadings of a superior heading. Normally this only looks at visible headings, but when INVISIBLE-OK is non-nil it will also look at invisible ones." (interactive "p") - (if (not (ignore-errors (org-back-to-heading invisible-ok))) - (outline-next-heading) - (org-at-heading-p) - (let* ((level (- (match-end 0) (match-beginning 0) 1)) - (re (format "^\\*\\{1,%d\\} " level)) - l) - (forward-char 1) - (while (> arg 0) - (while (and (re-search-forward re nil 'move) - (setq l (- (match-end 0) (match-beginning 0) 1)) - (= l level) - (not invisible-ok) - (progn (backward-char 1) (outline-invisible-p))) - (if (< l level) (setq arg 1))) - (setq arg (1- arg))) - (beginning-of-line 1)))) + (org-back-to-heading invisible-ok) + (org-at-heading-p) + (let ((level (- (match-end 0) (match-beginning 0) 1)) + (f (if (and arg (< arg 0)) + 're-search-backward + 're-search-forward)) + (count (if arg (abs arg) 1)) + (result (point))) + (forward-char (if (and arg (< arg 0)) -1 1)) + (while (and (> count 0) + (funcall f (org-outline-regexp-bol) nil 'move)) + (let ((l (- (match-end 0) (match-beginning 0) 1))) + (cond ((< l level) (setq count 0)) + ((and (= l level) + (or invisible-ok + (progn + (goto-char (line-beginning-position)) + (not (outline-invisible-p))))) + (setq count (1- count)) + (when (eq l level) + (setq result (point))))))) + (goto-char result)) + (beginning-of-line 1)) (defun org-backward-heading-same-level (arg &optional invisible-ok) - "Move backward to the arg'th subheading at same level as this one. + "Move backward to the ARG'th subheading at same level as this one. Stop at the first and last subheadings of a superior heading." (interactive "p") - (if (not (ignore-errors (org-back-to-heading))) - (goto-char (point-min)) - (org-at-heading-p) - (let* ((level (- (match-end 0) (match-beginning 0) 1)) - (re (format "^\\*\\{1,%d\\} " level)) - l) - (while (> arg 0) - (while (and (re-search-backward re nil 'move) - (setq l (- (match-end 0) (match-beginning 0) 1)) - (= l level) - (not invisible-ok) - (outline-invisible-p)) - (if (< l level) (setq arg 1))) - (setq arg (1- arg)))))) + (org-forward-heading-same-level (if arg (- arg) -1) invisible-ok)) (defun org-forward-element () "Move forward by one element. --=-=-= Content-Type: text/plain For example, this allows one to add ;; Local Variables: ;; eval: (orgstruct-mode 1) ;; org-outline-regexp: ";;; \\*+" ;; org-heading-regexp: "^;;; \\(\\*+\\)\\(.+\\)$" ;; End: to an (e)lisp file. It will make , S-, M-, C-c C-n, C-c C-f, C-c C-u etc. DTRT in terms of orgstruct-mode in that file's buffer. The patch itself is simple. In a nutshell: - Make org-heading-regexp and org-outline-regexp safe local variables. - Change orgstruct-setup to grab the key bindings of all related commands from org-mode-map and outline-mode-map. - Fix some bugs. I also changed org-(forward\|backward)-heading-same-level to DTRT. These functions did non operate on the same level - now they do. This change should not cause any bugs in agenda generation because Org does not use these functions non-interactively. Unfortunately there are many places where Org uses hard-coded regular expressions for headline detection and manipulation. Fortunately all basic outline-related commands except org-demote and org-promote seem to work fine. It would be great if this patch was applied to master. It should not break anything and it should bring Org nearer to achieving world domation, that is to supersede outline-(minor-)mode in all vanilla Emacsen. Also, S- in any prog mode - how cool is that? ;) Christopher --=-=-=--