emacs-orgmode
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [O] orgstruct-mode with custom headline prefix


From: Christopher Schmidt
Subject: Re: [O] orgstruct-mode with custom headline prefix
Date: Thu, 31 Jan 2013 07:35:21 +0000 (GMT)

Christopher Schmidt <address@hidden> 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.
--- 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:address@hidden:[ \t]*$"))
                    (if tags
-                       (concat org-outline-regexp-bol
+                       (concat (org-outline-regexp-bol)
                                ".*:\\("
                                (mapconcat 'identity tags "\\|")
                                (org-re "\\):[[:alnum:address@hidden:]*[ 
\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 "]]></programlisting>\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 "</pre>\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>" . "TAB")
+                      ("<ret>" . "RET")
+                      ("<esc>" . "ESC")
+                      ("<del>" . "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.
FWIW if that's helpful, I am willing to maintain
org\(struct\(++\)?\|tbl\)-mode.

        Christopher

reply via email to

[Prev in Thread] Current Thread [Next in Thread]