80 |
(define-key map "\C-k" 'show-branches) |
(define-key map "\C-k" 'show-branches) |
81 |
(define-key map "\C-q" 'hide-sublevels) |
(define-key map "\C-q" 'hide-sublevels) |
82 |
(define-key map "\C-o" 'hide-other) |
(define-key map "\C-o" 'hide-other) |
83 |
(define-key map "\C-^" 'outline-promote) |
(define-key map "\C-^" 'outline-move-subtree-up) |
84 |
(define-key map "\C-v" 'outline-demote) |
(define-key map "\C-v" 'outline-move-subtree-down) |
85 |
;; Where to bind toggle and insert-heading ? |
(define-key map [(control ?<)] 'outline-promote) |
86 |
|
(define-key map [(control ?>)] 'outline-demote) |
87 |
|
(define-key map "\C-m" 'outline-insert-heading) |
88 |
|
;; Where to bind outline-cycle ? |
89 |
map)) |
map)) |
90 |
|
|
91 |
(defvar outline-mode-menu-bar-map |
(defvar outline-mode-menu-bar-map |
111 |
(define-key map [headings] |
(define-key map [headings] |
112 |
(cons "Headings" (make-sparse-keymap "Headings"))) |
(cons "Headings" (make-sparse-keymap "Headings"))) |
113 |
|
|
114 |
|
(define-key map [headings demote-subtree] |
115 |
|
'(menu-item "Demote subtree" outline-demote)) |
116 |
|
(define-key map [headings promote-subtree] |
117 |
|
'(menu-item "Promote subtree" outline-promote)) |
118 |
|
(define-key map [headings move-subtree-down] |
119 |
|
'(menu-item "Move subtree down" outline-move-subtree-down)) |
120 |
|
(define-key map [headings move-subtree-up] |
121 |
|
'(menu-item "Move subtree up" outline-move-subtree-up)) |
122 |
(define-key map [headings copy] |
(define-key map [headings copy] |
123 |
'(menu-item "Copy to kill ring" outline-headers-as-kill |
'(menu-item "Copy to kill ring" outline-headers-as-kill |
124 |
:enable mark-active)) |
:enable mark-active)) |
125 |
|
(define-key map [headings outline-insert-heading] |
126 |
|
'("New heading" . outline-insert-heading)) |
127 |
(define-key map [headings outline-backward-same-level] |
(define-key map [headings outline-backward-same-level] |
128 |
'("Previous Same Level" . outline-backward-same-level)) |
'("Previous Same Level" . outline-backward-same-level)) |
129 |
(define-key map [headings outline-forward-same-level] |
(define-key map [headings outline-forward-same-level] |
163 |
(defvar outline-font-lock-keywords |
(defvar outline-font-lock-keywords |
164 |
'(;; |
'(;; |
165 |
;; Highlight headings according to the level. |
;; Highlight headings according to the level. |
166 |
(eval . (list (concat "^" outline-regexp ".+") |
(eval . (list (concat "^\\(?:" outline-regexp "\\).+") |
167 |
0 '(or (cdr (assq (outline-font-lock-level) |
0 '(outline-font-lock-face) nil t))) |
|
;; FIXME: this is silly! |
|
|
'((1 . font-lock-function-name-face) |
|
|
(2 . font-lock-variable-name-face) |
|
|
(3 . font-lock-keyword-face) |
|
|
(4 . font-lock-builtin-face) |
|
|
(5 . font-lock-comment-face) |
|
|
(6 . font-lock-constant-face) |
|
|
(7 . font-lock-type-face) |
|
|
(8 . font-lock-string-face)))) |
|
|
font-lock-warning-face) |
|
|
nil t))) |
|
168 |
"Additional expressions to highlight in Outline mode.") |
"Additional expressions to highlight in Outline mode.") |
169 |
|
|
170 |
(defun outline-font-lock-level () |
(defface outline-1 '((t :inherit font-lock-function-name-face)) "Level 1.") |
171 |
(let ((count 1)) |
(defface outline-2 '((t :inherit font-lock-variable-name-face)) "Level 2.") |
172 |
(save-excursion |
(defface outline-3 '((t :inherit font-lock-keyword-face)) "Level 3.") |
173 |
(outline-back-to-heading t) |
(defface outline-4 '((t :inherit font-lock-builtin-face)) "Level 4.") |
174 |
(while (and (not (bobp)) |
(defface outline-5 '((t :inherit font-lock-comment-face)) "Level 5.") |
175 |
(not (eq (funcall outline-level) 1))) |
(defface outline-6 '((t :inherit font-lock-constant-face)) "Level 6.") |
176 |
(outline-up-heading 1 t) |
(defface outline-7 '((t :inherit font-lock-type-face)) "Level 7.") |
177 |
(setq count (1+ count))) |
(defface outline-8 '((t :inherit font-lock-string-face)) "Level 8.") |
178 |
count))) |
|
179 |
|
(defvar outline-font-lock-faces |
180 |
|
[outline-1 outline-2 outline-3 outline-4 |
181 |
|
outline-5 outline-6 outline-7 outline-8]) |
182 |
|
|
183 |
|
(defvar outline-font-lock-levels nil) |
184 |
|
(make-variable-buffer-local 'outline-font-lock-levels) |
185 |
|
|
186 |
|
(defun outline-font-lock-face () |
187 |
|
;; (save-excursion |
188 |
|
;; (outline-back-to-heading t) |
189 |
|
;; (let* ((count 0) |
190 |
|
;; (start-level (funcall outline-level)) |
191 |
|
;; (level start-level) |
192 |
|
;; face-level) |
193 |
|
;; (while (not (setq face-level |
194 |
|
;; (if (or (bobp) (eq level 1)) 0 |
195 |
|
;; (cdr (assq level outline-font-lock-levels))))) |
196 |
|
;; (outline-up-heading 1 t) |
197 |
|
;; (setq count (1+ count)) |
198 |
|
;; (setq level (funcall outline-level))) |
199 |
|
;; ;; Remember for later. |
200 |
|
;; (unless (zerop count) |
201 |
|
;; (setq face-level (+ face-level count)) |
202 |
|
;; (push (cons start-level face-level) outline-font-lock-levels)) |
203 |
|
;; (condition-case nil |
204 |
|
;; (aref outline-font-lock-faces face-level) |
205 |
|
;; (error font-lock-warning-face)))) |
206 |
|
(save-excursion |
207 |
|
(goto-char (match-beginning 0)) |
208 |
|
(looking-at outline-regexp) |
209 |
|
(condition-case nil |
210 |
|
(aref outline-font-lock-faces (1- (funcall outline-level))) |
211 |
|
(error font-lock-warning-face)))) |
212 |
|
|
213 |
(defvar outline-view-change-hook nil |
(defvar outline-view-change-hook nil |
214 |
"Normal hook to be run after outline visibility changes.") |
"Normal hook to be run after outline visibility changes.") |
233 |
|
|
234 |
\\[hide-body] make all text invisible (not headings). |
\\[hide-body] make all text invisible (not headings). |
235 |
\\[show-all] make everything in buffer visible. |
\\[show-all] make everything in buffer visible. |
236 |
|
\\[hide-sublevels] make only the first N levels of headers visible. |
237 |
|
|
238 |
The remaining commands are used when point is on a heading line. |
The remaining commands are used when point is on a heading line. |
239 |
They apply to some of the body or subheadings of that heading. |
They apply to some of the body or subheadings of that heading. |
259 |
;; Cause use of ellipses for invisible text. |
;; Cause use of ellipses for invisible text. |
260 |
(add-to-invisibility-spec '(outline . t)) |
(add-to-invisibility-spec '(outline . t)) |
261 |
(set (make-local-variable 'paragraph-start) |
(set (make-local-variable 'paragraph-start) |
262 |
(concat paragraph-start "\\|\\(" outline-regexp "\\)")) |
(concat paragraph-start "\\|\\(?:" outline-regexp "\\)")) |
263 |
;; Inhibit auto-filling of header lines. |
;; Inhibit auto-filling of header lines. |
264 |
(set (make-local-variable 'auto-fill-inhibit-regexp) outline-regexp) |
(set (make-local-variable 'auto-fill-inhibit-regexp) outline-regexp) |
265 |
(set (make-local-variable 'paragraph-separate) |
(set (make-local-variable 'paragraph-separate) |
266 |
(concat paragraph-separate "\\|\\(" outline-regexp "\\)")) |
(concat paragraph-separate "\\|\\(?:" outline-regexp "\\)")) |
267 |
(set (make-local-variable 'font-lock-defaults) |
(set (make-local-variable 'font-lock-defaults) |
268 |
'(outline-font-lock-keywords t nil nil backward-paragraph)) |
'(outline-font-lock-keywords t nil nil backward-paragraph)) |
269 |
(setq imenu-generic-expression |
(setq imenu-generic-expression |
284 |
See the command `outline-mode' for more information on this mode." |
See the command `outline-mode' for more information on this mode." |
285 |
nil " Outl" (list (cons [menu-bar] outline-minor-mode-menu-bar-map) |
nil " Outl" (list (cons [menu-bar] outline-minor-mode-menu-bar-map) |
286 |
(cons outline-minor-mode-prefix outline-mode-prefix-map)) |
(cons outline-minor-mode-prefix outline-mode-prefix-map)) |
287 |
|
:group 'outlines |
288 |
(if outline-minor-mode |
(if outline-minor-mode |
289 |
(progn |
(progn |
290 |
;; Turn off this mode if we change major modes. |
;; Turn off this mode if we change major modes. |
300 |
;; When turning off outline mode, get rid of any outline hiding. |
;; When turning off outline mode, get rid of any outline hiding. |
301 |
(show-all))) |
(show-all))) |
302 |
|
|
303 |
(defcustom outline-level 'outline-level |
(defvar outline-level 'outline-level |
304 |
"*Function of no args to compute a header's nesting level in an outline. |
"*Function of no args to compute a header's nesting level in an outline. |
305 |
It can assume point is at the beginning of a header line." |
It can assume point is at the beginning of a header line and that the match |
306 |
:type 'function |
data reflects the `outline-regexp'.") |
|
:group 'outlines) |
|
307 |
|
|
308 |
(defvar outline-heading-alist () |
(defvar outline-heading-alist () |
309 |
"Alist associating a heading for every possible level. |
"Alist associating a heading for every possible level. |
310 |
Each entry is of the form (HEADING . LEVEL). |
Each entry is of the form (HEADING . LEVEL). |
311 |
This alist is used both to find the heading corresponding to |
This alist is used two ways: to find the heading corresponding to |
312 |
a given level and to find the level of a given heading.") |
a given level and to find the level of a given heading. |
313 |
|
If a mode or document needs several sets of outline headings (for example |
314 |
|
numbered and unnumbered sections), list them set by set and sorted by level |
315 |
|
within each set. For example in texinfo mode: |
316 |
|
|
317 |
|
(setq outline-heading-alist |
318 |
|
'((\"@chapter\" . 2) (\"@section\" . 3) (\"@subsection\" . 4) |
319 |
|
(\"@subsubsection\" . 5) |
320 |
|
(\"@unnumbered\" . 2) (\"@unnumberedsec\" . 3) |
321 |
|
(\"@unnumberedsubsec\" . 4) (\"@unnumberedsubsubsec\" . 5) |
322 |
|
(\"@appendix\" . 2) (\"@appendixsec\" . 3)... |
323 |
|
(\"@appendixsubsec\" . 4) (\"@appendixsubsubsec\" . 5) ..)) |
324 |
|
|
325 |
|
Instead of sorting the entries in each set, you can also separate the |
326 |
|
sets with nil.") |
327 |
(make-variable-buffer-local 'outline-heading-alist) |
(make-variable-buffer-local 'outline-heading-alist) |
328 |
|
|
329 |
;; This used to count columns rather than characters, but that made ^L |
;; This used to count columns rather than characters, but that made ^L |
336 |
Point must be at the beginning of a header line. |
Point must be at the beginning of a header line. |
337 |
This is actually either the level specified in `outline-heading-alist' |
This is actually either the level specified in `outline-heading-alist' |
338 |
or else the number of characters matched by `outline-regexp'." |
or else the number of characters matched by `outline-regexp'." |
339 |
(save-excursion |
(or (cdr (assoc (match-string 0) outline-heading-alist)) |
340 |
(if (not (looking-at outline-regexp)) |
(- (match-end 0) (match-beginning 0)))) |
|
;; This should never happen |
|
|
1000 |
|
|
(or (cdr (assoc (match-string 0) outline-heading-alist)) |
|
|
(- (match-end 0) (match-beginning 0)))))) |
|
341 |
|
|
342 |
(defun outline-next-preface () |
(defun outline-next-preface () |
343 |
"Skip forward to just before the next heading line. |
"Skip forward to just before the next heading line. |
344 |
If there's no following heading line, stop before the newline |
If there's no following heading line, stop before the newline |
345 |
at the end of the buffer." |
at the end of the buffer." |
346 |
(if (re-search-forward (concat "\n\\(" outline-regexp "\\)") |
(if (re-search-forward (concat "\n\\(?:" outline-regexp "\\)") |
347 |
nil 'move) |
nil 'move) |
348 |
(goto-char (match-beginning 0))) |
(goto-char (match-beginning 0))) |
349 |
(if (and (bolp) (not (bobp))) |
(if (and (bolp) (not (bobp))) |
352 |
(defun outline-next-heading () |
(defun outline-next-heading () |
353 |
"Move to the next (possibly invisible) heading line." |
"Move to the next (possibly invisible) heading line." |
354 |
(interactive) |
(interactive) |
355 |
(if (re-search-forward (concat "\n\\(" outline-regexp "\\)") |
;; Make sure we don't match the heading we're at. |
356 |
|
(if (and (bolp) (not (eobp))) (forward-char 1)) |
357 |
|
(if (re-search-forward (concat "^\\(?:" outline-regexp "\\)") |
358 |
nil 'move) |
nil 'move) |
359 |
(goto-char (1+ (match-beginning 0))))) |
(goto-char (match-beginning 0)))) |
360 |
|
|
361 |
(defun outline-previous-heading () |
(defun outline-previous-heading () |
362 |
"Move to the previous (possibly invisible) heading line." |
"Move to the previous (possibly invisible) heading line." |
363 |
(interactive) |
(interactive) |
364 |
(re-search-backward (concat "^\\(" outline-regexp "\\)") |
(re-search-backward (concat "^\\(?:" outline-regexp "\\)") |
365 |
nil 'move)) |
nil 'move)) |
366 |
|
|
367 |
(defsubst outline-invisible-p () |
(defsubst outline-invisible-p (&optional pos) |
368 |
"Non-nil if the character after point is invisible." |
"Non-nil if the character after point is invisible." |
369 |
(get-char-property (point) 'invisible)) |
(get-char-property (or pos (point)) 'invisible)) |
370 |
|
|
371 |
(defun outline-visible () |
(defun outline-visible () |
|
"Obsolete. Use `outline-invisible-p'." |
|
372 |
(not (outline-invisible-p))) |
(not (outline-invisible-p))) |
373 |
|
(make-obsolete 'outline-visible 'outline-invisible-p) |
374 |
|
|
375 |
(defun outline-back-to-heading (&optional invisible-ok) |
(defun outline-back-to-heading (&optional invisible-ok) |
376 |
"Move to previous heading line, or beg of this line if it's a heading. |
"Move to previous heading line, or beg of this line if it's a heading. |
380 |
(let (found) |
(let (found) |
381 |
(save-excursion |
(save-excursion |
382 |
(while (not found) |
(while (not found) |
383 |
(or (re-search-backward (concat "^\\(" outline-regexp "\\)") |
(or (re-search-backward (concat "^\\(?:" outline-regexp "\\)") |
384 |
nil t) |
nil t) |
385 |
(error "before first heading")) |
(error "before first heading")) |
386 |
(setq found (and (or invisible-ok (not (outline-invisible-p))) |
(setq found (and (or invisible-ok (not (outline-invisible-p))) |
416 |
(run-hooks 'outline-insert-heading-hook))) |
(run-hooks 'outline-insert-heading-hook))) |
417 |
|
|
418 |
(defun outline-promote (&optional children) |
(defun outline-promote (&optional children) |
419 |
"Promote the current heading higher up the tree. |
"Promote headings higher up the tree. |
420 |
If prefix argument CHILDREN is given, promote also all the children." |
If prefix argument CHILDREN is given, promote also all the children. |
421 |
(interactive "P") |
If the region is active in `transient-mark-mode', promote all headings |
422 |
(outline-back-to-heading) |
in the region." |
423 |
(let* ((head (match-string 0)) |
(interactive |
424 |
(level (save-match-data (funcall outline-level))) |
(list (if (and transient-mark-mode mark-active) 'region |
425 |
(up-head (or (car (rassoc (1- level) outline-heading-alist)) |
(outline-back-to-heading) |
426 |
(save-excursion |
(if current-prefix-arg nil 'subtree)))) |
427 |
(save-match-data |
(cond |
428 |
(outline-up-heading 1 t) |
((eq children 'region) |
429 |
(match-string 0)))))) |
(outline-map-region 'outline-promote (region-beginning) (region-end))) |
430 |
|
(children |
431 |
(unless (rassoc level outline-heading-alist) |
(outline-map-region 'outline-promote |
432 |
(push (cons head level) outline-heading-alist)) |
(point) |
433 |
|
(save-excursion (outline-get-next-sibling) (point)))) |
434 |
(replace-match up-head nil t) |
(t |
435 |
(when children |
(outline-back-to-heading t) |
436 |
(outline-map-tree 'outline-promote level)))) |
(let* ((head (match-string 0)) |
437 |
|
(level (save-match-data (funcall outline-level))) |
438 |
|
(up-head (or (outline-head-from-level (1- level) head) |
439 |
|
(save-excursion |
440 |
|
(save-match-data |
441 |
|
(outline-up-heading 1 t) |
442 |
|
(match-string 0)))))) |
443 |
|
|
444 |
|
(unless (rassoc level outline-heading-alist) |
445 |
|
(push (cons head level) outline-heading-alist)) |
446 |
|
|
447 |
|
(replace-match up-head nil t))))) |
448 |
|
|
449 |
(defun outline-demote (&optional children) |
(defun outline-demote (&optional children) |
450 |
"Demote the current heading lower down the tree. |
"Demote headings lower down the tree. |
451 |
If prefix argument CHILDREN is given, demote also all the children." |
If prefix argument CHILDREN is given, demote also all the children. |
452 |
(interactive "P") |
If the region is active in `transient-mark-mode', demote all headings |
453 |
(outline-back-to-heading) |
in the region." |
454 |
(let* ((head (match-string 0)) |
(interactive |
455 |
(level (save-match-data (funcall outline-level))) |
(list (if (and transient-mark-mode mark-active) 'region |
456 |
(down-head |
(outline-back-to-heading) |
457 |
(or (car (rassoc (1+ level) outline-heading-alist)) |
(if current-prefix-arg nil 'subtree)))) |
458 |
(save-excursion |
(cond |
459 |
|
((eq children 'region) |
460 |
|
(outline-map-region 'outline-demote (region-beginning) (region-end))) |
461 |
|
(children |
462 |
|
(outline-map-region 'outline-demote |
463 |
|
(point) |
464 |
|
(save-excursion (outline-get-next-sibling) (point)))) |
465 |
|
(t |
466 |
|
(let* ((head (match-string 0)) |
467 |
|
(level (save-match-data (funcall outline-level))) |
468 |
|
(down-head |
469 |
|
(or (outline-head-from-level (1+ level) head) |
470 |
|
(save-excursion |
471 |
|
(save-match-data |
472 |
|
(while (and (progn (outline-next-heading) (not (eobp))) |
473 |
|
(<= (funcall outline-level) level))) |
474 |
|
(when (eobp) |
475 |
|
;; Try again from the beginning of the buffer. |
476 |
|
(goto-char (point-min)) |
477 |
|
(while (and (progn (outline-next-heading) (not (eobp))) |
478 |
|
(<= (funcall outline-level) level)))) |
479 |
|
(unless (eobp) |
480 |
|
(looking-at outline-regexp) |
481 |
|
(match-string 0)))) |
482 |
(save-match-data |
(save-match-data |
483 |
(while (and (not (eobp)) |
;; Bummer!! There is no lower heading in the buffer. |
484 |
(progn |
;; Let's try to invent one by repeating the first char. |
485 |
(outline-next-heading) |
(let ((new-head (concat (substring head 0 1) head))) |
486 |
(<= (funcall outline-level) level)))) |
(if (string-match (concat "\\`" outline-regexp) new-head) |
487 |
(when (eobp) |
;; Why bother checking that it is indeed lower level ? |
488 |
;; Try again from the beginning of the buffer. |
new-head |
489 |
(goto-char (point-min)) |
;; Didn't work: keep it as is so it's still a heading. |
490 |
(while (and (not (eobp)) |
head)))))) |
|
(progn |
|
|
(outline-next-heading) |
|
|
(<= (funcall outline-level) level))))) |
|
|
(unless (eobp) (match-string 0)))) |
|
|
(save-match-data |
|
|
;; Bummer!! There is no lower heading in the buffer. |
|
|
;; Let's try to invent one by repeating the first char. |
|
|
(let ((new-head (concat (substring head 0 1) head))) |
|
|
(if (string-match (concat "\\`" outline-regexp) new-head) |
|
|
;; Why bother checking that it is indeed of lower level ? |
|
|
new-head |
|
|
;; Didn't work: keep it as is so it's still a heading. |
|
|
head)))))) |
|
491 |
|
|
492 |
(unless (rassoc level outline-heading-alist) |
(unless (rassoc level outline-heading-alist) |
493 |
(push (cons head level) outline-heading-alist)) |
(push (cons head level) outline-heading-alist)) |
494 |
|
(replace-match down-head nil t))))) |
|
(replace-match down-head nil t) |
|
|
(when children |
|
|
(outline-map-tree 'outline-demote level)))) |
|
495 |
|
|
496 |
(defun outline-map-tree (fun level) |
(defun outline-head-from-level (level head &optional alist) |
497 |
"Call FUN for every heading underneath the current one." |
"Get new heading with level LEVEL from ALIST. |
498 |
|
If there are no such entries, return nil. |
499 |
|
ALIST defaults to `outline-heading-alist'. |
500 |
|
Similar to (car (rassoc LEVEL ALIST)). |
501 |
|
If there are several different entries with same new level, choose |
502 |
|
the one with the smallest distance to the assocation of HEAD in the alist. |
503 |
|
This makes it possible for promotion to work in modes with several |
504 |
|
independent sets of headings (numbered, unnumbered, appendix...)" |
505 |
|
(unless alist (setq alist outline-heading-alist)) |
506 |
|
(let ((l (rassoc level alist)) |
507 |
|
ll h hl l2 l2l) |
508 |
|
(cond |
509 |
|
((null l) nil) |
510 |
|
;; If there's no HEAD after L, any other entry for LEVEL after L |
511 |
|
;; can't be much better than L. |
512 |
|
((null (setq h (assoc head (setq ll (memq l alist))))) (car l)) |
513 |
|
;; If there's no other entry for LEVEL, just keep L. |
514 |
|
((null (setq l2 (rassoc level (cdr ll)))) (car l)) |
515 |
|
;; Now we have L, L2, and H: see if L2 seems better than L. |
516 |
|
;; If H is after L2, L2 is better. |
517 |
|
((memq h (setq l2l (memq l2 (cdr ll)))) |
518 |
|
(outline-head-from-level level head l2l)) |
519 |
|
;; Now we have H between L and L2. |
520 |
|
;; If there's a separator between L and H, prefer L2. |
521 |
|
((memq h (memq nil ll)) |
522 |
|
(outline-head-from-level level head l2l)) |
523 |
|
;; If there's a separator between L2 and H, prefer L. |
524 |
|
((memq l2 (memq nil (setq hl (memq h ll)))) (car l)) |
525 |
|
;; No separator between L and L2, check the distance. |
526 |
|
((< (* 2 (length hl)) (+ (length ll) (length l2l))) |
527 |
|
(outline-head-from-level level head l2l)) |
528 |
|
;; If all else fails, just keep L. |
529 |
|
(t (car l))))) |
530 |
|
|
531 |
|
(defun outline-map-region (fun beg end) |
532 |
|
"Call FUN for every heading between BEG and END. |
533 |
|
When FUN is called, point is at the beginning of the heading and |
534 |
|
the match data is set appropriately." |
535 |
(save-excursion |
(save-excursion |
536 |
(while (and (progn |
(setq end (copy-marker end)) |
537 |
(outline-next-heading) |
(goto-char beg) |
538 |
(> (funcall outline-level) level)) |
(when (re-search-forward (concat "^\\(?:" outline-regexp "\\)") end t) |
539 |
(not (eobp))) |
(goto-char (match-beginning 0)) |
540 |
(funcall fun)))) |
(funcall fun) |
541 |
|
(while (and (progn |
542 |
|
(outline-next-heading) |
543 |
|
(< (point) end)) |
544 |
|
(not (eobp))) |
545 |
|
(funcall fun))))) |
546 |
|
|
547 |
|
;; Vertical tree motion |
548 |
|
|
549 |
|
(defun outline-move-subtree-up (&optional arg) |
550 |
|
"Move the currrent subtree up past ARG headlines of the same level." |
551 |
|
(interactive "p") |
552 |
|
(outline-move-subtree-down (- arg))) |
553 |
|
|
554 |
|
(defun outline-move-subtree-down (&optional arg) |
555 |
|
"Move the currrent subtree down past ARG headlines of the same level." |
556 |
|
(interactive "p") |
557 |
|
(let ((re (concat "^" outline-regexp)) |
558 |
|
(movfunc (if (> arg 0) 'outline-get-next-sibling |
559 |
|
'outline-get-last-sibling)) |
560 |
|
(ins-point (make-marker)) |
561 |
|
(cnt (abs arg)) |
562 |
|
beg end txt folded) |
563 |
|
;; Select the tree |
564 |
|
(outline-back-to-heading) |
565 |
|
(setq beg (point)) |
566 |
|
(save-match-data |
567 |
|
(save-excursion (outline-end-of-heading) |
568 |
|
(setq folded (outline-invisible-p))) |
569 |
|
(outline-end-of-subtree)) |
570 |
|
(if (= (char-after) ?\n) (forward-char 1)) |
571 |
|
(setq end (point)) |
572 |
|
;; Find insertion point, with error handling |
573 |
|
(goto-char beg) |
574 |
|
(while (> cnt 0) |
575 |
|
(or (funcall movfunc) |
576 |
|
(progn (goto-char beg) |
577 |
|
(error "Cannot move past superior level"))) |
578 |
|
(setq cnt (1- cnt))) |
579 |
|
(if (> arg 0) |
580 |
|
;; Moving forward - still need to move over subtree |
581 |
|
(progn (outline-end-of-subtree) |
582 |
|
(if (= (char-after) ?\n) (forward-char 1)))) |
583 |
|
(move-marker ins-point (point)) |
584 |
|
(insert (delete-and-extract-region beg end)) |
585 |
|
(goto-char ins-point) |
586 |
|
(if folded (hide-subtree)) |
587 |
|
(move-marker ins-point nil))) |
588 |
|
|
589 |
(defun outline-end-of-heading () |
(defun outline-end-of-heading () |
590 |
(if (re-search-forward outline-heading-end-regexp nil 'move) |
(if (re-search-forward outline-heading-end-regexp nil 'move) |
601 |
(end-of-line)) |
(end-of-line)) |
602 |
(while (and (not (bobp)) (< arg 0)) |
(while (and (not (bobp)) (< arg 0)) |
603 |
(while (and (not (bobp)) |
(while (and (not (bobp)) |
604 |
(re-search-backward (concat "^\\(" outline-regexp "\\)") |
(re-search-backward (concat "^\\(?:" outline-regexp "\\)") |
605 |
nil 'move) |
nil 'move) |
606 |
(outline-invisible-p))) |
(outline-invisible-p))) |
607 |
(setq arg (1+ arg))) |
(setq arg (1+ arg))) |
608 |
(while (and (not (eobp)) (> arg 0)) |
(while (and (not (eobp)) (> arg 0)) |
609 |
(while (and (not (eobp)) |
(while (and (not (eobp)) |
610 |
(re-search-forward (concat "^\\(" outline-regexp "\\)") |
(re-search-forward (concat "^\\(?:" outline-regexp "\\)") |
611 |
nil 'move) |
nil 'move) |
612 |
(outline-invisible-p))) |
(outline-invisible-p (match-beginning 0)))) |
613 |
(setq arg (1- arg))) |
(setq arg (1- arg))) |
614 |
(beginning-of-line)) |
(beginning-of-line)) |
615 |
|
|
762 |
(interactive) |
(interactive) |
763 |
(outline-flag-subtree nil)) |
(outline-flag-subtree nil)) |
764 |
|
|
765 |
|
(defun outline-show-heading () |
766 |
|
"Show the current heading and move to its end." |
767 |
|
(outline-flag-region (- (point) |
768 |
|
(if (bobp) 0 |
769 |
|
(if (eq (char-before (1- (point))) ?\n) |
770 |
|
2 1))) |
771 |
|
(progn (outline-end-of-heading) (point)) |
772 |
|
nil)) |
773 |
|
|
774 |
(defun hide-sublevels (levels) |
(defun hide-sublevels (levels) |
775 |
"Hide everything but the top LEVELS levels of headers, in whole buffer." |
"Hide everything but the top LEVELS levels of headers, in whole buffer." |
776 |
(interactive "p") |
(interactive "p") |
777 |
(if (< levels 1) |
(if (< levels 1) |
778 |
(error "Must keep at least one level of headers")) |
(error "Must keep at least one level of headers")) |
|
(setq levels (1- levels)) |
|
779 |
(let (outline-view-change-hook) |
(let (outline-view-change-hook) |
780 |
(save-excursion |
(save-excursion |
781 |
(goto-char (point-min)) |
(goto-char (point-min)) |
782 |
;; Keep advancing to the next top-level heading. |
;; Skip the prelude, if any. |
783 |
(while (or (and (bobp) (outline-on-heading-p)) |
(unless (outline-on-heading-p t) (outline-next-heading)) |
784 |
(outline-next-heading)) |
;; First hide everything. |
785 |
(let ((end (save-excursion (outline-end-of-subtree) (point)))) |
(outline-flag-region (point) (point-max) t) |
786 |
;; Hide everything under that. |
;; Then unhide the top level headers. |
787 |
(outline-end-of-heading) |
(outline-map-region |
788 |
(outline-flag-region (point) end t) |
(lambda () |
789 |
;; Show the first LEVELS levels under that. |
(if (<= (funcall outline-level) levels) |
790 |
(if (> levels 0) |
(outline-show-heading))) |
791 |
(show-children levels)) |
(point) (point-max)))) |
|
;; Move to the next, since we already found it. |
|
|
(goto-char end))))) |
|
792 |
(run-hooks 'outline-view-change-hook)) |
(run-hooks 'outline-view-change-hook)) |
793 |
|
|
794 |
(defun hide-other () |
(defun hide-other () |
810 |
"Show or hide the current subtree depending on its current state." |
"Show or hide the current subtree depending on its current state." |
811 |
(interactive) |
(interactive) |
812 |
(outline-back-to-heading) |
(outline-back-to-heading) |
813 |
(if (save-excursion |
(if (not (outline-invisible-p (line-end-position))) |
|
(end-of-line) |
|
|
(not (outline-invisible-p))) |
|
814 |
(hide-subtree) |
(hide-subtree) |
815 |
(show-children) |
(show-children) |
816 |
(show-entry))) |
(show-entry))) |
861 |
(max 1 (- (funcall outline-level) start-level))))))) |
(max 1 (- (funcall outline-level) start-level))))))) |
862 |
(let (outline-view-change-hook) |
(let (outline-view-change-hook) |
863 |
(save-excursion |
(save-excursion |
864 |
(save-restriction |
(outline-back-to-heading) |
865 |
(outline-back-to-heading) |
(setq level (+ level (funcall outline-level))) |
866 |
(setq level (+ level (funcall outline-level))) |
(outline-map-region |
867 |
(narrow-to-region (point) |
(lambda () |
868 |
(progn (outline-end-of-subtree) |
(if (<= (funcall outline-level) level) |
869 |
(if (eobp) (point-max) (1+ (point))))) |
(outline-show-heading))) |
870 |
(goto-char (point-min)) |
(point) |
871 |
(while (and (not (eobp)) |
(progn (outline-end-of-subtree) |
872 |
(progn |
(if (eobp) (point-max) (1+ (point))))))) |
|
(outline-next-heading) |
|
|
(not (eobp)))) |
|
|
(if (<= (funcall outline-level) level) |
|
|
(save-excursion |
|
|
(outline-flag-region (save-excursion |
|
|
(forward-char -1) |
|
|
(if (bolp) |
|
|
(forward-char -1)) |
|
|
(point)) |
|
|
(progn (outline-end-of-heading) (point)) |
|
|
nil))))))) |
|
873 |
(run-hooks 'outline-view-change-hook)) |
(run-hooks 'outline-view-change-hook)) |
874 |
|
|
875 |
|
|
880 |
If INVISIBLE-OK is non-nil, also consider invisible lines." |
If INVISIBLE-OK is non-nil, also consider invisible lines." |
881 |
(interactive "p") |
(interactive "p") |
882 |
(outline-back-to-heading invisible-ok) |
(outline-back-to-heading invisible-ok) |
883 |
(if (eq (funcall outline-level) 1) |
(let ((start-level (funcall outline-level))) |
884 |
(error "Already at top level of the outline")) |
(if (eq start-level 1) |
885 |
(while (and (> (funcall outline-level) 1) |
(error "Already at top level of the outline")) |
886 |
(> arg 0) |
(while (and (> start-level 1) (> arg 0) (not (bobp))) |
887 |
(not (bobp))) |
(let ((level start-level)) |
888 |
(let ((present-level (funcall outline-level))) |
(while (not (or (< level start-level) (bobp))) |
889 |
(while (and (not (< (funcall outline-level) present-level)) |
(if invisible-ok |
890 |
(not (bobp))) |
(outline-previous-heading) |
891 |
(if invisible-ok |
(outline-previous-visible-heading 1)) |
892 |
(outline-previous-heading) |
(setq level (funcall outline-level))) |
893 |
(outline-previous-visible-heading 1))) |
(setq start-level level)) |
894 |
(setq arg (- arg 1))))) |
(setq arg (- arg 1)))) |
895 |
|
(looking-at outline-regexp)) |
896 |
|
|
897 |
(defun outline-forward-same-level (arg) |
(defun outline-forward-same-level (arg) |
898 |
"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. |
914 |
"Move to next heading of the same level, and return point or nil if none." |
"Move to next heading of the same level, and return point or nil if none." |
915 |
(let ((level (funcall outline-level))) |
(let ((level (funcall outline-level))) |
916 |
(outline-next-visible-heading 1) |
(outline-next-visible-heading 1) |
917 |
(while (and (> (funcall outline-level) level) |
(while (and (not (eobp)) (> (funcall outline-level) level)) |
|
(not (eobp))) |
|
918 |
(outline-next-visible-heading 1)) |
(outline-next-visible-heading 1)) |
919 |
(if (< (funcall outline-level) level) |
(if (or (eobp) (< (funcall outline-level) level)) |
920 |
nil |
nil |
921 |
(point)))) |
(point)))) |
922 |
|
|