From mboxrd@z Thu Jan 1 00:00:00 1970 From: Christopher Schmidt Subject: Re: orgstruct-mode with custom headline prefix (was: ...) Date: Thu, 31 Jan 2013 16:02:09 +0000 (GMT) Message-ID: <87zjzp8hof@ch.ristopher.com> References: <877gmt3dzq@ch.ristopher.com> <871ud13dkp@ch.ristopher.com> <6C559BF7-BACF-48AF-AB06-383D6AC14BDE@gmail.com> <87622dlhqm.fsf@bzg.ath.cx> <874nhxjx66.fsf@bzg.ath.cx> <16F8E2C8-5CAD-42F2-8146-42AEEF49D73A@gmail.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([208.118.235.92]:37120) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1U0wae-0008Nq-Fe for emacs-orgmode@gnu.org; Thu, 31 Jan 2013 11:02:20 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1U0waa-0007lp-IO for emacs-orgmode@gnu.org; Thu, 31 Jan 2013 11:02:16 -0500 Received: from ristopher.com ([146.185.21.93]:52580 helo=saturn.ch.ristopher.com) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1U0waa-0007ld-2u for emacs-orgmode@gnu.org; Thu, 31 Jan 2013 11:02:12 -0500 In-Reply-To: <16F8E2C8-5CAD-42F2-8146-42AEEF49D73A@gmail.com> (Carsten Dominik's message of "Thu, 31 Jan 2013 15:32:29 +0100") List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: emacs-orgmode@gnu.org --=-=-= Content-Type: text/plain Carsten Dominik writes: > I was just thinking, if you are setting up two local variables, you > could set up three and include org-outline-regexp-bol as well. Or, > you could just set up org-outline-regexp', and make the function > org-struct-mode set up the other two as additional local variables. > This would simplify things. In fact, I think this would make for a > more compact and better patch, Christopher, what do you think? I agree. I am not sure how to deduce org-heading-regexp from org-outline-regexp, though. Maybe we can use a buffer-local orgstruct-heading-prefix and setup org-heading-regexp/org-outline-regexp(-bol) from this one? Here is my patch with org-outline-regexp-bol being a variable and being set up by the hijacker commands using org-outline-regexp. --=-=-= Content-Type: text/x-diff Content-Disposition: inline --- a/lisp/org.el +++ b/lisp/org.el @@ -92,6 +92,7 @@ ;; 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. @@ -101,6 +102,7 @@ sure that we are at the beginning of the line.") (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) @@ -6223,8 +6225,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 +7407,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." @@ -8482,12 +8497,12 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive." ;; command. There might be problems if any of the keys is otherwise ;; used as a prefix key. -;; Another challenge is that the key binding for TAB can be tab or \C-i, -;; likewise the binding for RET can be return or \C-m. Orgtbl-mode -;; addresses this by checking explicitly for both bindings. +(defcustom orgstruct-setup-hook nil + "Hook run after orgstruct-mode-map is filled." + :group 'org + :type 'hook) -(defvar orgstruct-mode-map (make-sparse-keymap) - "Keymap for the minor `orgstruct-mode'.") +(defvar orgstruct-initialized nil) (defvar org-local-vars nil "List of local variables, for use by `orgstruct-mode'.") @@ -8498,26 +8513,13 @@ 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" - nil " OrgStruct" nil - (org-load-modules-maybe) - (and (orgstruct-setup) (defun orgstruct-setup () nil))) +defined by Org-mode)." + nil " OrgStruct" (make-sparse-keymap) + (when orgstruct-mode + (org-load-modules-maybe) + (unless orgstruct-initialized + (orgstruct-setup) + (setq orgstruct-initialized t)))) ;;;###autoload (defun turn-on-orgstruct () @@ -8568,104 +8570,90 @@ buffer. It will also recognize item context in multiline items." (error "This key has no function outside structure elements")) (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) + "Setup orgstruct keymap." + (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)) + (dolist (f (if (stringp f) + (let ((flist)) + (dolist (postfix + '("-return" "tab" "left" "right" "up" "down") + flist) + (let ((f (intern (concat f postfix)))) + (when (fboundp f) + (push f flist))))) + (list f))) + (dolist (binding (nconc (where-is-internal f org-mode-map) + (where-is-internal f outline-mode-map))) + (dolist (rep '(("" . "TAB") + ("" . "RET") + ("" . "ESC") + ("" . "DEL"))) + (setq binding (kbd (replace-regexp-in-string + (regexp-quote (car rep)) + (cdr rep) + (key-description binding))))) + (let ((key (lookup-key orgstruct-mode-map binding))) + (when (or (not key) (numberp key)) + (org-defkey orgstruct-mode-map + binding + (orgstruct-make-binding f binding))))))) + (run-hooks 'orgstruct-setup-hook)) + +(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" - "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)))))))) +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 `" + (key-description key) "'.") + (interactive "p") + (unless + (let ((outline-regexp org-outline-regexp) + (org-outline-regexp-bol + (concat "^" org-outline-regexp))) + (when (org-context-p 'headline 'item + ,(when (memq fun '(org-insert-heading)) + '(when orgstruct-is-++ + 'item-body))) + (org-run-like-in-org-mode ',fun) + t)) + (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. @@ -8762,17 +8750,18 @@ Possible values in the list of contexts are `table', `headline', and `item'." (setq varlist (buffer-local-variables))) (kill-buffer "*Org tmp*") (delq nil - (mapcar - (lambda (x) - (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)) - varlist)))) + (mapcar + (lambda (x) + (setq x + (if (symbolp x) + (list x) + (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) "Clone local variables from FROM-BUFFER. @@ -8795,8 +8784,14 @@ 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 + (call-interactively cmd)))) ;;;; Archiving @@ -22598,46 +22593,43 @@ clocking lines, and drawers." (point))) (defun org-forward-heading-same-level (arg &optional invisible-ok) - "Move forward to the arg'th subheading at same level as this one. + "Move forward to the ARG'th subheading at same level as this one. Stop at the first and last subheadings of a superior heading. Normally this only looks at visible headings, but when INVISIBLE-OK is non-nil it will also look at invisible ones." (interactive "p") (if (not (ignore-errors (org-back-to-heading invisible-ok))) - (outline-next-heading) + (if (and arg (< arg 0)) + (goto-char (point-min)) + (outline-next-heading)) (org-at-heading-p) - (let* ((level (- (match-end 0) (match-beginning 0) 1)) - (re (format "^\\*\\{1,%d\\} " level)) - l) - (forward-char 1) - (while (> arg 0) - (while (and (re-search-forward re nil 'move) - (setq l (- (match-end 0) (match-beginning 0) 1)) - (= l level) - (not invisible-ok) - (progn (backward-char 1) (outline-invisible-p))) - (if (< l level) (setq arg 1))) - (setq arg (1- arg))) - (beginning-of-line 1)))) + (let ((level (- (match-end 0) (match-beginning 0) 1)) + (f (if (and arg (< arg 0)) + 're-search-backward + 're-search-forward)) + (count (if arg (abs arg) 1)) + (result (point))) + (forward-char (if (and arg (< arg 0)) -1 1)) + (while (and (> count 0) + (funcall f org-outline-regexp-bol nil 'move)) + (let ((l (- (match-end 0) (match-beginning 0) 1))) + (cond ((< l level) (setq count 0)) + ((and (= l level) + (or invisible-ok + (progn + (goto-char (line-beginning-position)) + (not (outline-invisible-p))))) + (setq count (1- count)) + (when (eq l level) + (setq result (point))))))) + (goto-char result)) + (beginning-of-line 1))) (defun org-backward-heading-same-level (arg &optional invisible-ok) - "Move backward to the arg'th subheading at same level as this one. + "Move backward to the ARG'th subheading at same level as this one. Stop at the first and last subheadings of a superior heading." (interactive "p") - (if (not (ignore-errors (org-back-to-heading))) - (goto-char (point-min)) - (org-at-heading-p) - (let* ((level (- (match-end 0) (match-beginning 0) 1)) - (re (format "^\\*\\{1,%d\\} " level)) - l) - (while (> arg 0) - (while (and (re-search-backward re nil 'move) - (setq l (- (match-end 0) (match-beginning 0) 1)) - (= l level) - (not invisible-ok) - (outline-invisible-p)) - (if (< l level) (setq arg 1))) - (setq arg (1- arg)))))) + (org-forward-heading-same-level (if arg (- arg) -1) invisible-ok)) (defun org-forward-element () "Move forward by one element. --=-=-= Content-Type: text/plain Christopher --=-=-=--