From mboxrd@z Thu Jan 1 00:00:00 1970 From: Christopher Schmidt Subject: Re: orgstruct-mode with custom headline prefix Date: Thu, 31 Jan 2013 07:35:21 +0000 (GMT) Message-ID: <8738xh4xfr@ch.ristopher.com> References: <87vcah6xf5@ch.ristopher.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([208.118.235.92]:49835) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1U0ogD-0006tA-S2 for emacs-orgmode@gnu.org; Thu, 31 Jan 2013 02:35:36 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1U0og8-0001MA-7Q for emacs-orgmode@gnu.org; Thu, 31 Jan 2013 02:35:29 -0500 Received: from ristopher.com ([146.185.21.93]:52471 helo=saturn.ch.ristopher.com) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1U0og7-0001KQ-P0 for emacs-orgmode@gnu.org; Thu, 31 Jan 2013 02:35:24 -0500 In-Reply-To: <87vcah6xf5@ch.ristopher.com> (Christopher Schmidt's message of "Mon, 28 Jan 2013 17:15:59 +0000 (GMT)") 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 Christopher Schmidt writes: > here is a patch for master that enables the use of a custom headline > prefix file locally in conjunction with orgstruct-mode. Here is the patch, now applying cleanly on master again. --=-=-= Content-Type: text/x-diff Content-Disposition: inline --- 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 @@ -402,7 +402,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. @@ -418,7 +418,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) @@ -5986,7 +5989,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 @@ -6223,8 +6226,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) @@ -7403,13 +7408,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." @@ -7695,7 +7711,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 @@ -7939,7 +7955,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)) @@ -8498,23 +8514,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))) @@ -8569,103 +8569,83 @@ 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 ((binding (let ((orgstruct-mode)) (key-binding ,key)))) + (if (keymapp binding) + (set-temporary-overlay-map binding) + (call-interactively + (or binding 'orgstruct-error))))))) + name)) (defun org-contextualize-keys (alist contexts) "Return valid elements in ALIST depending on CONTEXTS. @@ -8767,11 +8747,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) @@ -8795,8 +8776,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 @@ -13917,7 +13905,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) @@ -15104,7 +15092,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 @@ -17635,7 +17623,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)) @@ -19180,7 +19168,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) @@ -19836,7 +19824,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)))) @@ -19847,7 +19835,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 @@ -22295,7 +22283,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) @@ -22324,7 +22312,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") @@ -22363,7 +22351,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)) @@ -22437,7 +22425,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")) @@ -22455,7 +22443,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)) @@ -22480,7 +22468,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) @@ -22598,46 +22586,43 @@ 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) + (if (and arg (< arg 0)) + (goto-char (point-min)) + (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)))) + (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 FWIW if that's helpful, I am willing to maintain org\(struct\(++\)?\|tbl\)-mode. Christopher --=-=-=--