all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* orgstruct-mode with custom headline prefix
@ 2013-01-28 17:15 Christopher Schmidt
  2013-01-28 23:22 ` Samuel Wales
  2013-01-31  7:35 ` Christopher Schmidt
  0 siblings, 2 replies; 26+ messages in thread
From: Christopher Schmidt @ 2013-01-28 17:15 UTC (permalink / raw)
  To: emacs-orgmode

[-- Attachment #1: Type: text/plain, Size: 1277 bytes --]

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  <christopher@ch.ristopher.com>

            * 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.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: orgstruct.diff --]
[-- Type: text/x-diff, Size: 28806 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
@@ -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>" . "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 ((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.

[-- Attachment #3: Type: text/plain, Size: 1360 bytes --]


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 <tab>, S-<tab>, M-<ret>, 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-<tab> in any prog mode - how cool is that? ;)

        Christopher

^ permalink raw reply	[flat|nested] 26+ messages in thread

end of thread, other threads:[~2013-02-26 18:10 UTC | newest]

Thread overview: 26+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
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
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

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.