Mercurial > emacs
comparison lisp/allout.el @ 73201:16a7031b0447
(allout-expose-topic): Rectify implementation of "+" spec, so that bodies are
not exposed with headlines.
(allout-current-depth): Do aberrent check only at or below doublecheck depth.
(allout-chart-subtree): Make it explicit that LEVELS being nil means unlimited
depth. Drop undocumented support for LEVELS value t meaning unlimited depth.
(This is consistent with allout-chart-to-reveal, but contrary to
allout-show-children, which needs to use nil to default to depth of 1.)
(allout-goto-prefix-doublechecked): Wrap long docstring line.
(allout-chart-to-reveal): Be explicit in docstring about meaning of nil LEVELS,
and drop support for LEVELS value t.
(allout-show-children): Translate the level spec used by this routine to that
used by allout-chart-subtree and allout-chart-to-reveal.
(allout-show-to-offshoot): Retry once when stuck, after opening subtree -
improvements in discontinuity handling likely will enable progress.
| author | Eli Zaretskii <eliz@gnu.org> |
|---|---|
| date | Sun, 01 Oct 2006 16:48:11 +0000 |
| parents | ec72ab6f5541 |
| children | df3186ae0953 bb0e318b7c53 |
comparison
equal
deleted
inserted
replaced
| 73200:f16075a82800 | 73201:16a7031b0447 |
|---|---|
| 2200 | 2200 |
| 2201 Actually, returns prefix beginning point." | 2201 Actually, returns prefix beginning point." |
| 2202 (save-excursion | 2202 (save-excursion |
| 2203 (allout-beginning-of-current-line) | 2203 (allout-beginning-of-current-line) |
| 2204 (and (looking-at allout-regexp) | 2204 (and (looking-at allout-regexp) |
| 2205 (not (allout-aberrant-container-p)) | 2205 (allout-prefix-data) |
| 2206 (allout-prefix-data)))) | 2206 (or (> allout-recent-depth allout-doublecheck-at-and-shallower) |
| 2207 (not (allout-aberrant-container-p)))))) | |
| 2207 ;;;_ > allout-on-heading-p () | 2208 ;;;_ > allout-on-heading-p () |
| 2208 (defalias 'allout-on-heading-p 'allout-on-current-heading-p) | 2209 (defalias 'allout-on-heading-p 'allout-on-current-heading-p) |
| 2209 ;;;_ > allout-e-o-prefix-p () | 2210 ;;;_ > allout-e-o-prefix-p () |
| 2210 (defun allout-e-o-prefix-p () | 2211 (defun allout-e-o-prefix-p () |
| 2211 "True if point is located where current topic prefix ends, heading begins." | 2212 "True if point is located where current topic prefix ends, heading begins." |
| 2327 | 2328 |
| 2328 If less than this depth, ascend to that depth and count..." | 2329 If less than this depth, ascend to that depth and count..." |
| 2329 | 2330 |
| 2330 (save-excursion | 2331 (save-excursion |
| 2331 (cond ((and depth (<= depth 0) 0)) | 2332 (cond ((and depth (<= depth 0) 0)) |
| 2332 ((or (not depth) (= depth (allout-depth))) | 2333 ((or (null depth) (= depth (allout-depth))) |
| 2333 (let ((index 1)) | 2334 (let ((index 1)) |
| 2334 (while (allout-previous-sibling allout-recent-depth nil) | 2335 (while (allout-previous-sibling allout-recent-depth nil) |
| 2335 (setq index (1+ index))) | 2336 (setq index (1+ index))) |
| 2336 index)) | 2337 index)) |
| 2337 ((< depth allout-recent-depth) | 2338 ((< depth allout-recent-depth) |
| 2503 | 2504 |
| 2504 ;;;_ > allout-chart-subtree (&optional levels visible orig-depth prev-depth) | 2505 ;;;_ > allout-chart-subtree (&optional levels visible orig-depth prev-depth) |
| 2505 (defun allout-chart-subtree (&optional levels visible orig-depth prev-depth) | 2506 (defun allout-chart-subtree (&optional levels visible orig-depth prev-depth) |
| 2506 "Produce a location \"chart\" of subtopics of the containing topic. | 2507 "Produce a location \"chart\" of subtopics of the containing topic. |
| 2507 | 2508 |
| 2508 Optional argument LEVELS specifies the depth \(relative to start | 2509 Optional argument LEVELS specifies a depth limit \(relative to start |
| 2509 depth) for the chart. | 2510 depth) for the chart. Null LEVELS means no limit. |
| 2510 | 2511 |
| 2511 When optional argument VISIBLE is non-nil, the chart includes | 2512 When optional argument VISIBLE is non-nil, the chart includes |
| 2512 only the visible subelements of the charted subjects. | 2513 only the visible subelements of the charted subjects. |
| 2513 | 2514 |
| 2514 The remaining optional args are not for internal use by the function. | 2515 The remaining optional args are for internal use by the function. |
| 2515 | 2516 |
| 2516 Point is left at the end of the subtree. | 2517 Point is left at the end of the subtree. |
| 2517 | 2518 |
| 2518 Charts are used to capture outline structure, so that outline-altering | 2519 Charts are used to capture outline structure, so that outline-altering |
| 2519 routines need assess the structure only once, and then use the chart | 2520 routines need assess the structure only once, and then use the chart |
| 2616 ;;;_ > allout-chart-to-reveal (chart depth) | 2617 ;;;_ > allout-chart-to-reveal (chart depth) |
| 2617 (defun allout-chart-to-reveal (chart depth) | 2618 (defun allout-chart-to-reveal (chart depth) |
| 2618 | 2619 |
| 2619 "Return a flat list of hidden points in subtree CHART, up to DEPTH. | 2620 "Return a flat list of hidden points in subtree CHART, up to DEPTH. |
| 2620 | 2621 |
| 2622 If DEPTH is nil, include hidden points at any depth. | |
| 2623 | |
| 2621 Note that point can be left at any of the points on chart, or at the | 2624 Note that point can be left at any of the points on chart, or at the |
| 2622 start point." | 2625 start point." |
| 2623 | 2626 |
| 2624 (let (result here) | 2627 (let (result here) |
| 2625 (while (and (or (eq depth t) (> depth 0)) | 2628 (while (and (or (null depth) (> depth 0)) |
| 2626 chart) | 2629 chart) |
| 2627 (setq here (car chart)) | 2630 (setq here (car chart)) |
| 2628 (if (listp here) | 2631 (if (listp here) |
| 2629 (let ((further (allout-chart-to-reveal here (or (eq depth t) | 2632 (let ((further (allout-chart-to-reveal here (if (null depth) |
| 2630 (1- depth))))) | 2633 depth |
| 2634 (1- depth))))) | |
| 2631 ;; We're on the start of a subtree - recurse with it, if there's | 2635 ;; We're on the start of a subtree - recurse with it, if there's |
| 2632 ;; more depth to go: | 2636 ;; more depth to go: |
| 2633 (if further (setq result (append further result))) | 2637 (if further (setq result (append further result))) |
| 2634 (setq chart (cdr chart))) | 2638 (setq chart (cdr chart))) |
| 2635 (goto-char here) | 2639 (goto-char here) |
| 2695 done))) | 2699 done))) |
| 2696 ;;;_ > allout-goto-prefix-doublechecked () | 2700 ;;;_ > allout-goto-prefix-doublechecked () |
| 2697 (defun allout-goto-prefix-doublechecked () | 2701 (defun allout-goto-prefix-doublechecked () |
| 2698 "Put point at beginning of immediately containing outline topic. | 2702 "Put point at beginning of immediately containing outline topic. |
| 2699 | 2703 |
| 2700 Like `allout-goto-prefix', but shallow topics \(according to `allout-doublecheck-at-and-shallower') are checked and disqualified for child containment discontinuity, according to `allout-aberrant-container-p'." | 2704 Like `allout-goto-prefix', but shallow topics \(according to |
| 2705 `allout-doublecheck-at-and-shallower') are checked and | |
| 2706 disqualified for child containment discontinuity, according to | |
| 2707 `allout-aberrant-container-p'." | |
| 2701 (allout-goto-prefix) | 2708 (allout-goto-prefix) |
| 2702 (if (and (<= allout-recent-depth allout-doublecheck-at-and-shallower) | 2709 (if (and (<= allout-recent-depth allout-doublecheck-at-and-shallower) |
| 2703 (allout-aberrant-container-p)) | 2710 (allout-aberrant-container-p)) |
| 2704 (allout-previous-heading) | 2711 (allout-previous-heading) |
| 2705 (point))) | 2712 (point))) |
| 4618 | 4625 |
| 4619 (save-excursion | 4626 (save-excursion |
| 4620 (allout-beginning-of-current-line) | 4627 (allout-beginning-of-current-line) |
| 4621 (save-restriction | 4628 (save-restriction |
| 4622 (let* (depth | 4629 (let* (depth |
| 4623 (chart (allout-chart-subtree (or level 1))) | 4630 ;; translate the level spec for this routine to the ones |
| 4624 (to-reveal (or (allout-chart-to-reveal chart (or level 1)) | 4631 ;; used by -chart-subtree and -chart-to-reveal: |
| 4632 (chart-level (cond ((not level) 1) | |
| 4633 ((eq level t) nil) | |
| 4634 (t level))) | |
| 4635 (chart (allout-chart-subtree chart-level)) | |
| 4636 (to-reveal (or (allout-chart-to-reveal chart chart-level) | |
| 4625 ;; interactive, show discontinuous children: | 4637 ;; interactive, show discontinuous children: |
| 4626 (and chart | 4638 (and chart |
| 4627 (interactive-p) | 4639 (interactive-p) |
| 4628 (save-excursion | 4640 (save-excursion |
| 4629 (allout-back-to-current-heading) | 4641 (allout-back-to-current-heading) |
| 4670 (save-excursion | 4682 (save-excursion |
| 4671 (let ((inhibit-field-text-motion t) | 4683 (let ((inhibit-field-text-motion t) |
| 4672 (orig-pt (point)) | 4684 (orig-pt (point)) |
| 4673 (orig-pref (allout-goto-prefix-doublechecked)) | 4685 (orig-pref (allout-goto-prefix-doublechecked)) |
| 4674 (last-at (point)) | 4686 (last-at (point)) |
| 4675 bag-it) | 4687 (bag-it 0)) |
| 4676 (while (or bag-it (allout-hidden-p)) | 4688 (while (or (> bag-it 1) (allout-hidden-p)) |
| 4677 (while (allout-hidden-p) | 4689 (while (allout-hidden-p) |
| 4678 (move-beginning-of-line 1) | 4690 (move-beginning-of-line 1) |
| 4679 (if (allout-hidden-p) (forward-char -1))) | 4691 (if (allout-hidden-p) (forward-char -1))) |
| 4680 (if (= last-at (setq last-at (point))) | 4692 (if (= last-at (setq last-at (point))) |
| 4681 ;; Oops, we're not making any progress! Show the current | 4693 ;; Oops, we're not making any progress! Show the current topic |
| 4682 ;; topic completely, and bag this try. | 4694 ;; completely, and try one more time here, if we haven't already. |
| 4683 (progn (beginning-of-line) | 4695 (progn (beginning-of-line) |
| 4684 (allout-show-current-subtree) | 4696 (allout-show-current-subtree) |
| 4685 (goto-char orig-pt) | 4697 (goto-char orig-pt) |
| 4686 (setq bag-it t) | 4698 (setq bag-it (1+ bag-it)) |
| 4687 (beep) | 4699 (if (> bag-it 1) |
| 4688 (message "%s: %s" | 4700 (error "allout-show-to-offshoot: %s" |
| 4689 "allout-show-to-offshoot: " | 4701 "Stumped by aberrant nesting."))) |
| 4690 "Aberrant nesting encountered.")) | 4702 (if (> bag-it 0) (setq bag-it 0)) |
| 4691 (allout-show-children) | 4703 (allout-show-children) |
| 4692 (goto-char orig-pref))) | 4704 (goto-char orig-pref))) |
| 4693 (goto-char orig-pt))) | 4705 (goto-char orig-pt))) |
| 4694 (if (allout-hidden-p) | 4706 (if (allout-hidden-p) |
| 4695 (allout-show-entry))) | 4707 (allout-show-entry))) |
| 4893 ((null curr-elem) nil) | 4905 ((null curr-elem) nil) |
| 4894 ((symbolp curr-elem) | 4906 ((symbolp curr-elem) |
| 4895 (cond ((eq curr-elem '*) (allout-show-current-subtree) | 4907 (cond ((eq curr-elem '*) (allout-show-current-subtree) |
| 4896 (if (> allout-recent-end-of-subtree max-pos) | 4908 (if (> allout-recent-end-of-subtree max-pos) |
| 4897 (setq max-pos allout-recent-end-of-subtree))) | 4909 (setq max-pos allout-recent-end-of-subtree))) |
| 4898 ((eq curr-elem '+) (allout-show-current-branches) | 4910 ((eq curr-elem '+) |
| 4911 (if (not (allout-hidden-p)) | |
| 4912 (save-excursion (allout-hide-current-subtree t))) | |
| 4913 (allout-show-current-branches) | |
| 4899 (if (> allout-recent-end-of-subtree max-pos) | 4914 (if (> allout-recent-end-of-subtree max-pos) |
| 4900 (setq max-pos allout-recent-end-of-subtree))) | 4915 (setq max-pos allout-recent-end-of-subtree))) |
| 4901 ((eq curr-elem '-) (allout-show-current-entry)) | 4916 ((eq curr-elem '-) (allout-show-current-entry)) |
| 4902 ((eq curr-elem ':) | 4917 ((eq curr-elem ':) |
| 4903 (setq stay t) | 4918 (setq stay t) |