From 0eaf3cce4d8eae4cc7322d225a5d981b5580c02d Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Thu, 23 Jul 2009 08:30:14 +0200 Subject: [PATCH] Speed-up cycling in buffers with *many* siblings, and *many* drawers For this we took another look at when drawers actually have to be hidden again and found that CONTENTS view does not need it, and that CHILDREN view only needs it before the first child. The second speed-up comes from advising outline-end-of-subtree to use the Org version when in org-mode. The third speed-up comes from using a better way to find the next visible line, using `next-single-char-property-change'. Finally, `org-forward-same-level' and `org-backward-same-level' are faster versions of their outline equivalents and are now bound to `C-c C-f' and `C-c C-b'. --- lisp/ChangeLog | 12 +++++++++ lisp/org.el | 84 +++++++++++++++++++++++++++++++++++++++++++--------------- 2 files changed, 74 insertions(+), 22 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2e8bbb37a..fac1828f6 100755 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,15 @@ +2009-07-23 Carsten Dominik + + * org.el (org-cycle-internal-local): Improved version of finding + next visible line. + (org-cycle-hide-drawers): Only hide drawers if this is really + necessary. + (outline-end-of-subtree): Make `outline-end-of-subtree' use the + org-version of this function in Org-mode. We use advice to + implement this change, so that future changes to this function in + outline.el wil be handled properly. + (org-forward-same-level, org-backward-same-level): New commands. + 2009-07-21 Carsten Dominik * org.el (org-remove-empty-overlays-at) diff --git a/lisp/org.el b/lisp/org.el index 80ff0c224..b20431149 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -4877,9 +4877,17 @@ in special contexts. (org-back-to-heading) (save-excursion (beginning-of-line 2) - (while (and (not (eobp)) ;; this is like `next-line' - (get-char-property (1- (point)) 'invisible)) - (beginning-of-line 2)) (setq eol (point))) + (if (or (featurep 'xemacs) (<= emacs-major-version 21)) + ; XEmacs does not have `next-single-char-property-change' + ; I'm not sure about Emacs 21. + (while (and (not (eobp)) ;; this is like `next-line' + (get-char-property (1- (point)) 'invisible)) + (beginning-of-line 2)) + (while (and (not (eobp)) ;; this is like `next-line' + (get-char-property (1- (point)) 'invisible)) + (goto-char (next-single-char-property-change (point) 'invisible)) + (or (bolp) (beginning-of-line 2)))) + (setq eol (point))) (outline-end-of-heading) (setq eoh (point)) (org-end-of-subtree t) (unless (eobp) @@ -5137,11 +5145,14 @@ are at least `org-cycle-separator-lines' empty lines before the headline." (defun org-cycle-hide-drawers (state) "Re-hide all drawers after a visibility state change." (when (and (org-mode-p) - (not (memq state '(overview folded)))) + (not (memq state '(overview folded contents)))) (save-excursion (let* ((globalp (memq state '(contents all))) (beg (if globalp (point-min) (point))) - (end (if globalp (point-max) (org-end-of-subtree t)))) + (end (if globalp (point-max) + (if (eq state 'children) + (save-excursion (outline-next-heading) (point)) + (org-end-of-subtree t))))) (goto-char beg) (while (re-search-forward org-drawer-regexp end t) (org-flag-drawer t)))))) @@ -13928,6 +13939,8 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (if (boundp 'narrow-map) (org-defkey narrow-map "s" 'org-narrow-to-subtree) (org-defkey org-mode-map "\C-xns" 'org-narrow-to-subtree)) +(org-defkey org-mode-map "\C-c\C-f" 'org-forward-same-level) +(org-defkey org-mode-map "\C-c\C-b" 'org-backward-same-level) (org-defkey org-mode-map "\C-c$" 'org-archive-subtree) (org-defkey org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree) (org-defkey org-mode-map "\C-c\C-x\C-a" 'org-toggle-archive-tag) @@ -16371,23 +16384,6 @@ When ENTRY is non-nil, show the entire entry." (save-excursion (outline-end-of-heading) (point)) flag)))) -(defun org-forward-same-level (arg) - "Move forward to the ARG'th subheading at same level as this one. -Stop at the first and last subheadings of a superior heading. -This is like outline-forward-same-level, but invisible headings are ok." - (interactive "p") - (org-back-to-heading t) - (while (> arg 0) - (let ((point-to-move-to (save-excursion - (org-get-next-sibling)))) - (if point-to-move-to - (progn - (goto-char point-to-move-to) - (setq arg (1- arg))) - (progn - (setq arg 0) - (error "No following same-level heading")))))) - (defun org-get-next-sibling () "Move to next heading of the same level, and return point. If there is no such heading, return nil. @@ -16434,6 +16430,50 @@ This is like outline-next-sibling, but invisible headings are ok." (forward-char -1)))))) (point)) +(defadvice outline-end-of-subtree (around prefer-org-version activate compile) + "Use Org version in org-mode, for dramatic speed-up." + (if (eq major-mode 'org-mode) + (org-end-of-subtree) + ad-do-it)) + +(defun org-forward-same-level (arg &optional invisible-ok) + "Move forward to the arg'th subheading at same level as this one. +Stop at the first and last subheadings of a superior heading." + (interactive "p") + (org-back-to-heading) + (org-on-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) + (org-invisible-p)) + (if (< l level) (setq arg 1))) + (setq arg (1- arg))) + (beginning-of-line 1))) + +(defun org-backward-same-level (arg &optional invisible-ok) + "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") + (org-back-to-heading) + (org-on-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) + (org-invisible-p)) + (if (< l level) (setq arg 1))) + (setq arg (1- arg))))) + (defun org-show-subtree () "Show everything after this heading at deeper levels." (outline-flag-region -- 2.11.4.GIT