From mboxrd@z Thu Jan 1 00:00:00 1970 From: Carsten Dominik Subject: Re: orgstruct-mode with custom headline prefix Date: Fri, 1 Feb 2013 17:20:29 +0100 Message-ID: <81950160-87A0-4BE9-8CC3-3EA1DC3484AF@gmail.com> References: <87vcah6xf5@ch.ristopher.com> <8738xh4xfr@ch.ristopher.com> <87y5f994ni.fsf@bzg.ath.cx> <87pq0l3gr2@ch.ristopher.com> <878v79925v.fsf@bzg.ath.cx> <87k3qt3exu@ch.ristopher.com> <87a9rplhue.fsf@bzg.ath.cx> <87622d5d8e@ch.ristopher.com> Mime-Version: 1.0 (Mac OS X Mail 6.2 \(1499\)) Content-Type: text/plain; charset=us-ascii Content-Transfer-Encoding: quoted-printable Return-path: Received: from eggs.gnu.org ([208.118.235.92]:60604) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1U1JM1-0000QY-K6 for emacs-orgmode@gnu.org; Fri, 01 Feb 2013 11:20:45 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1U1JLt-0001Sx-Jg for emacs-orgmode@gnu.org; Fri, 01 Feb 2013 11:20:41 -0500 Received: from mail-ee0-f46.google.com ([74.125.83.46]:36427) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1U1JLt-0001SX-6J for emacs-orgmode@gnu.org; Fri, 01 Feb 2013 11:20:33 -0500 Received: by mail-ee0-f46.google.com with SMTP id e49so2126538eek.5 for ; Fri, 01 Feb 2013 08:20:31 -0800 (PST) In-Reply-To: <87622d5d8e@ch.ristopher.com> 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: Christopher Schmidt Cc: emacs-orgmode@gnu.org Hi Christopher, I have trouble applying it, can you please send the patch as an = attachments instead of inline, and make sure it is agains the current = master? Thanks. - Carsten On 31 jan. 2013, at 21:06, Christopher Schmidt = wrote: > Bastien writes: >> PS: To make things clear: I'm confident the patch is good, but I will >> put it higher on my patch review process if I know the agenda does = not >> slow down :) >=20 > Here is the patch. Now one just needs >=20 > ;; Local Variables: > ;; eval: (orgstruct-mode 1) > ;; orgstruct-heading-prefix-regexp: ";;; " > ;; End: >=20 > It cannot get any easier than this. >=20 > 2013-01-31 Christopher Schmidt >=20 > * org.el (org-cycle-global-status, = org-cycle-subtree-status): Set > state property. > (org-heading-components): Use org-heading-regexp in > orgstruct-mode. > (orgstruct-heading-prefix-regexp, orgstruct-setup-hook): = New > options. > (orgstruct-initialized): New variable. > (orgstruct-mode): Simplify implementation. > (orgstruct-setup): Simplify implementation. Translate keys = to > their most general equivalent. > (orgstruct-make-binding): Generate index on the fly. = Discard > alternative keys. Bind variables according to > orgstruct-heading-prefix-regexp. > (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): Do not skip to headlines = on > another level. Handle negative prefix argument correctly. > (org-backward-heading-same-level): Use > org-forward-heading-same-level. > --- a/lisp/org.el > +++ b/lisp/org.el > @@ -6223,8 +6223,10 @@ and subscripts." >=20 > (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) >=20 > (defvar org-inlinetask-min-level) >=20 > @@ -7403,13 +7405,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)))))) >=20 > (defun org-get-entry () > "Get the entry text, after heading, entire subtree." > @@ -8482,12 +8495,19 @@ 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. >=20 > -;; 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-heading-prefix-regexp "" > + "Regexp that matches the custom prefix of Org headlines in > +orgstruct(++)-mode." > + :group 'org > + :type 'string) > +;;;###autoload(put 'orgstruct-heading-prefix-regexp = 'safe-local-variable 'stringp) > + > +(defcustom orgstruct-setup-hook nil > + "Hook run after orgstruct-mode-map is filled." > + :group 'org > + :type 'hook) >=20 > -(defvar orgstruct-mode-map (make-sparse-keymap) > - "Keymap for the minor `orgstruct-mode'.") > +(defvar orgstruct-initialized nil) >=20 > (defvar org-local-vars nil > "List of local variables, for use by `orgstruct-mode'.") > @@ -8498,26 +8518,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)))) >=20 > ;;;###autoload > (defun turn-on-orgstruct () > @@ -8568,104 +8575,96 @@ buffer. It will also recognize item context = in multiline items." > (error "This key has no function outside structure elements")) >=20 > (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* ((org-heading-regexp > + (concat "^" > + orgstruct-heading-prefix-regexp > + "\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ ]*$")) > + (org-outline-regexp > + (concat orgstruct-heading-prefix-regexp "\\*+ ")) > + (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)) >=20 > (defun org-contextualize-keys (alist contexts) > "Return valid elements in ALIST depending on CONTEXTS. > @@ -8766,17 +8765,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\\|norma= l-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\\|norma= l-auto-fill\\|fill-paragraph\\|indent-\\)" > + (symbol-name (car x)))) > + x nil)) > + varlist)))) >=20 > (defun org-clone-local-variables (from-buffer &optional regexp) > "Clone local variables from FROM-BUFFER. > @@ -8799,8 +8799,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)))) >=20 > ;;;; Archiving >=20 > @@ -22602,46 +22608,43 @@ clocking lines, and drawers." > (point))) >=20 > (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)) > - (=3D 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 (=3D 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))) >=20 > (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)) > - (=3D 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)) >=20 > (defun org-forward-element () > "Move forward by one element. >=20 > set -e > git show-ref HEAD > git stash > make &> /dev/null > emacs -q --batch --eval "(progn (add-to-list 'load-path = \"~/.emacs.d/apps/org-mode/lisp\") (find-file \"~/test-agenda.org\") = (org-agenda-file-to-front) (profiler-start 'cpu+mem) (let ((f = (float-time))) (org-agenda-list) (profiler-report) (message = \"=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D\n%s\n\n\" (- = (float-time) f))) (princ (buffer-string)))" > git stash pop > make &> /dev/null > emacs -q --batch --eval "(progn (add-to-list 'load-path = \"~/.emacs.d/apps/org-mode/lisp\") (find-file \"~/test-agenda.org\") = (org-agenda-file-to-front) (profiler-start 'cpu+mem) (let ((f = (float-time))) (org-agenda-list) (profiler-report) (message = \"=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D\n%s\n\n\" (- = (float-time) f))) (princ (buffer-string)))" >=20 > a2febd210182d9e1a37b0d7fd9ee007a10abc4bc refs/remotes/origin/HEAD > Saved working directory and index state WIP on master: a2febd2 = Merge branch 'maint' > HEAD is now at a2febd2 Merge branch 'maint' > OVERVIEW > Setting `org-agenda-files' temporarily since "emacs -q" would = overwrite customizations > File added to front of agenda file list > CPU and memory profiler started > =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D > 12.207549810409546 >=20 >=20 > + normal-top-level = 46,533,611 74% > + command-line-1 = 6,385,759 10% > + command-line = 5,800,077 9% > + eval = 2,639,778 4% > + progn = 690,611 1% > + let = 70,947 0% > + apply = 20,536 0% > + org-agenda-get-sexps = 12,332 0% > + load-with-code-conversion = 8,188 0% > + profiler-calltree-walk = 8,188 0% > + org-agenda-prepare = 6,482 0% > + byte-code = 4,272 0% > + diary-font-lock-keywords = 4,144 0% > + org-agenda-list = 1,114 0% > + file-truename = 1,100 0% > + load = 1,040 0% > # On branch master > # Changes not staged for commit: > # (use "git add ..." to update what will be committed) > # (use "git checkout -- ..." to discard changes in working = directory) > # > # modified: lisp/org.el > # > no changes added to commit (use "git add" and/or "git commit -a") > Dropped refs/stash@{0} (a8007c5e99e8481d82ec8303c75069e150a81874) > OVERVIEW > Setting `org-agenda-files' temporarily since "emacs -q" would = overwrite customizations > File added to front of agenda file list > CPU and memory profiler started > =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D > 12.091503858566284 >=20 >=20 > + normal-top-level = 45,399,311 73% > + command-line-1 = 6,522,990 10% > + command-line = 5,875,736 9% > + eval = 3,803,175 6% > + progn = 316,014 0% > + let = 84,388 0% > + apply = 16,376 0% > + org-agenda-get-sexps = 8,188 0% > + load-with-code-conversion = 8,188 0% > + profiler-calltree-walk = 8,188 0% > + profiler-report-setup-buffer = 8,188 0% > + org-agenda-list = 4,296 0% > + diary-font-lock-keywords = 4,144 0% > + org-agenda-get-day-entries = 4,144 0% > + require = 3,120 0% > + org-agenda-prepare = 2,338 0% > + file-truename = 2,156 0% > + tramp-completion-file-name-handler = 1,040 0% > + byte-code = 104 0% >=20 > I generated test-agenda.org using this snippet: >=20 > > Christopher --=20 There is no unscripted life. Only a badly scripted one. -- Brothers = Bloom