From: Christopher Schmidt <christopher@ch.ristopher.com>
To: emacs-orgmode@gnu.org
Subject: Re: orgstruct-mode with custom headline prefix
Date: Thu, 31 Jan 2013 07:35:21 +0000 (GMT) [thread overview]
Message-ID: <8738xh4xfr@ch.ristopher.com> (raw)
In-Reply-To: <87vcah6xf5@ch.ristopher.com> (Christopher Schmidt's message of "Mon, 28 Jan 2013 17:15:59 +0000 (GMT)")
[-- Attachment #1: Type: text/plain, Size: 246 bytes --]
Christopher Schmidt <christopher@ch.ristopher.com> 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.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-diff, Size: 28936 bytes --]
--- 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 "]]></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.
[-- Attachment #3: Type: text/plain, Size: 103 bytes --]
FWIW if that's helpful, I am willing to maintain
org\(struct\(++\)?\|tbl\)-mode.
Christopher
next prev parent reply other threads:[~2013-01-31 7:35 UTC|newest]
Thread overview: 26+ messages / expand[flat|nested] mbox.gz Atom feed top
2013-01-28 17:15 orgstruct-mode with custom headline prefix Christopher Schmidt
2013-01-28 23:22 ` Samuel Wales
2013-01-31 7:35 ` Christopher Schmidt [this message]
2013-01-31 7:45 ` Bastien
2013-01-31 8:21 ` Christopher Schmidt
2013-01-31 8:39 ` Bastien
2013-01-31 9:00 ` Christopher Schmidt
2013-01-31 11:20 ` Bastien
2013-01-31 20:06 ` Christopher Schmidt
2013-01-31 20:12 ` Christopher Schmidt
2013-01-31 20:24 ` Thorsten Jolitz
2013-02-01 16:20 ` Carsten Dominik
2013-02-10 19:11 ` Christopher Schmidt
2013-02-11 15:28 ` Bastien
2013-02-12 19:04 ` Achim Gratz
2013-02-12 20:47 ` Christopher Schmidt
2013-02-12 21:32 ` Bastien
2013-02-13 9:10 ` Christopher Schmidt
2013-02-13 9:43 ` Sebastien Vauban
2013-02-13 20:03 ` Achim Gratz
2013-02-19 10:18 ` Dr Stephen J Eglen
2013-02-22 13:51 ` Bastien
2013-02-26 14:59 ` Stephen Eglen
2013-02-26 16:02 ` Bastien
2013-02-26 18:10 ` Stephen Eglen
2013-02-26 16:55 ` Christopher Schmidt
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=8738xh4xfr@ch.ristopher.com \
--to=christopher@ch.ristopher.com \
--cc=emacs-orgmode@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).