Changeset 4166 for trunk/lisp/allout.el

Timestamp:

09/18/06 20:48:14 (2 years ago)

Author:

miyoshi

Message:

Sync up with Emacs CVS HEAD.

Files:

• trunk/lisp/allout.el (modified) (110 diffs)

trunk/lisp/allout.el

@@ -848 +848 @@
-  "Length of current buffers' `allout-plain-bullets-string'.")
-(make-variable-buffer-local 'allout-bullets-string-len)
+;;;_   = allout-depth-specific-regexp
+(defvar allout-depth-specific-regexp ""
+  "*Regular expression to match a heading line prefix for a particular depth.
+
+This expression is used to search for depth-specific topic
+headers at depth 2 and greater.  Use `allout-depth-one-regexp'
+for to seek topics at depth one.
+
+This var is set according to the user configuration vars by
+`set-allout-regexp'.  It is prepared with format strings for two
+decimal numbers, which should each be one less than the depth of the
+topic prefix to be matched.")
+(make-variable-buffer-local 'allout-depth-specific-regexp)
+;;;_   = allout-depth-one-regexp
+(defvar allout-depth-one-regexp ""
+  "*Regular expression to match a heading line prefix for depth one.
+
+This var is set according to the user configuration vars by
+`set-allout-regexp'.  It is prepared with format strings for two
+decimal numbers, which should each be one less than the depth of the
+topic prefix to be matched.")
+(make-variable-buffer-local 'allout-depth-one-regexp)
-;;;_   = allout-line-boundary-regexp
-(defvar allout-line-boundary-regexp ()
-  "`allout-regexp' with outline style beginning-of-line anchor.
-
-
-
-
+
-(make-variable-buffer-local 'allout-line-boundary-regexp)
-;;;_   = allout-bob-regexp
-(defvar allout-bob-regexp ()
-
-
+
-(make-variable-buffer-local 'allout-bob-regexp)
-;;;_   = allout-header-subtraction
@@ -870 +889 @@
-(make-variable-buffer-local 'allout-plain-bullets-string-len)
-
-
+
+
+
+
+
+
+
+
-;;;_   X allout-reset-header-lead (header-lead)
-(defun allout-reset-header-lead (header-lead)
@@ -962 +988 @@
-
-Works with respect to `allout-plain-bullets-string' and
-
+
+
+
-
-  (interactive)
@@ -997 +1025 @@
-  (setq allout-plain-bullets-string-len (length allout-plain-bullets-string))
-  (setq allout-header-subtraction (1- (length allout-header-prefix)))
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-;;;_  : Key bindings
-;;;_   = allout-mode-map
@@ -1143 +1236 @@
-          (error "Pair's name, %S, must be a symbol, not %s"
-                 name (type-of name)))
-err
+nil
-                            (symbol-value name)
-                          (void-variable nil)))
@@ -1793 +1886 @@
-      (remove-hook 'pre-command-hook 'allout-pre-command-business t)
-      (remove-hook 'post-command-hook 'allout-post-command-business t)
-
-
+
-      (remove-hook 'isearch-mode-end-hook 'allout-isearch-end-handler t)
-      (remove-hook write-file-hook-var-name 'allout-write-file-hook-handler t)
@@ -1814 +1906 @@
-      (allout-overlay-preparations)     ; Doesn't hurt to redo this.
-
-
+-and-primary-bullet
-      (allout-infer-body-reindent)
-
@@ -1855 +1947 @@
-      (add-hook 'pre-command-hook 'allout-pre-command-business nil t)
-      (add-hook 'post-command-hook 'allout-post-command-business nil t)
-
-
-
+
+
-      (add-hook 'isearch-mode-end-hook 'allout-isearch-end-handler nil t)
-      (add-hook write-file-hook-var-name 'allout-write-file-hook-handler
@@ -2001 +2092 @@
-This before-change handler is used only where modification-hooks
-overlay property is not supported."
+
+  (if (and (allout-mode-p) undo-in-progress (allout-hidden-p))
+      (allout-show-to-offshoot))
+
-  ;; allout-overlay-interior-modification-handler on an overlay handles
-  ;; this in other emacs, via `allout-exposure-category's 'modification-hooks.
-  (when (and (featurep 'xemacs) (allout-mode-p))
-    ;; process all of the pending overlays:
-
-
-
-
+
+
+
+
+
-;;;_  > allout-isearch-end-handler (&optional overlay)
-(defun allout-isearch-end-handler (&optional overlay)
@@ -2036 +2132 @@
-  "Buffer point of the end of the last topic prefix encountered.")
-(make-variable-buffer-local 'allout-recent-prefix-end)
+;;;_  = allout-recent-depth
+(defvar allout-recent-depth 0
+  "Depth of the last topic prefix encountered.")
+(make-variable-buffer-local 'allout-recent-depth)
-;;;_  = allout-recent-end-of-subtree
-(defvar allout-recent-end-of-subtree 0
-  "Buffer point last returned by `allout-end-of-current-subtree'.")
-(make-variable-buffer-local 'allout-recent-end-of-subtree)
-beg end
-macro allout-prefix-data (beg end
- - BEGINNING and END of prefix
+
+subst allout-prefix-data (
+
-
-For reference by `allout-recent' funcs.  Returns BEGINNING."
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-;;;_  > allout-recent-depth ()
-macro
+subst
-  "Return depth of last heading encountered by an outline maneuvering function.
-
@@ -2056 +2168 @@
-to return the current depth."
-
-
-
-
+
-;;;_  > allout-recent-prefix ()
-macro
+subst
-  "Like `allout-recent-depth', but returns text of last encountered prefix.
-
@@ -2066 +2176 @@
-headings set the variables `allout-recent-prefix-beginning' and
-`allout-recent-prefix-end' if successful.  This function uses those settings
-depth
-'(buffer-substring
-               
+prefix
+(buffer-substring-no-properties
+                             
-;;;_  > allout-recent-bullet ()
-(defmacro allout-recent-bullet ()
@@ -2077 +2187 @@
-`allout-recent-prefix-end' if successful.  This function uses those settings
-to return the current depth of the most recently matched topic."
-
-               
+-no-properties
+                              
-
-;;;_ #4 Navigation
@@ -2092 +2202 @@
-    (allout-beginning-of-current-line)
-    (and (looking-at allout-regexp)
-
+
+
-;;;_    > allout-on-heading-p ()
-(defalias 'allout-on-heading-p 'allout-on-current-heading-p)
@@ -2102 +2213 @@
-                       (looking-at allout-regexp))
-       (= (point)(save-excursion (allout-end-of-prefix)(point)))))
+;;;_    > allout-aberrant-container-p ()
+(defun allout-aberrant-container-p ()
+  "True if topic, or next sibling with children, contains them discontinuously.
+
+Discontinuous means an immediate offspring that is nested more
+than one level deeper than the topic.
+
+If topic has no offspring, then the next sibling with offspring will
+determine whether or not this one is determined to be aberrant.
+
+If true, then the allout-recent-* settings are calibrated on the
+offspring that qaulifies it as aberrant, ie with depth that
+exceeds the topic by more than one."
+
+  ;; This is most clearly understood when considering standard-prefix-leader
+  ;; low-level topics, which can all too easily match text not intended as
+  ;; headers.  For example, any line with a leading '.' or '*' and lacking a
+  ;; following bullet qualifies without this protection.  (A sequence of
+  ;; them can occur naturally, eg a typical textual bullet list.)  We
+  ;; disqualify such low-level sequences when they are followed by a
+  ;; discontinuously contained child, inferring that the sequences are not
+  ;; actually connected with their prospective context.
+
+  (let ((depth (allout-depth))
+        (start-point (point))
+        done aberrant)
+    (save-excursion
+      (while (and (not done)
+                  (re-search-forward allout-line-boundary-regexp nil 0))
+        (allout-prefix-data)
+        (goto-char allout-recent-prefix-beginning)
+        (cond
+         ;; sibling - continue:
+         ((eq allout-recent-depth depth)) 
+         ;; first offspring is excessive - aberrant:
+         ((> allout-recent-depth (1+ depth))
+          (setq done t aberrant t))
+         ;; next non-sibling is lower-depth - not aberrant:
+         (t (setq done t)))))
+    (if aberrant
+        aberrant
+      (goto-char start-point)
+      ;; recalibrate allout-recent-*
+      (allout-depth)
+      nil)))
-;;;_   : Location attributes
-;;;_    > allout-depth ()
@@ -2114 +2270 @@
-      (if (and (allout-goto-prefix)
-               (not (< start-point (point))))
-(allout-recent-depth)
+allout-recent-depth
-        (progn
-zero prefix data
-allout-prefix-data (point)(point)
+nullify it
+nullify-allout-prefix-data
-          ;; ... and return 0:
-          0)))))
@@ -2150 +2306 @@
-      (save-excursion
-        (allout-back-to-current-heading)
-
-                       
+-no-properties
+                                      
-    ;; Quick and dirty provision, ostensibly for missing bullet:
-'
+
-  )
-;;;_    > allout-get-prefix-bullet (prefix)
@@ -2161 +2317 @@
-  ;; oughtn't be called then, so forget about it...
-  (if (string-match allout-regexp prefix)
-0)) (match-end 0
+2)) (match-end 2
-;;;_    > allout-sibling-index (&optional depth)
-(defun allout-sibling-index (&optional depth)
@@ -2175 +2331 @@
-          ((or (not depth) (= depth (allout-depth)))
-           (let ((index 1))
-(allout-recent-depth)
+allout-recent-depth
-               (setq index (1+ index)))
-             index))
-(allout-recent-depth)
+allout-recent-depth
-           (allout-ascend-to-depth depth)
-           (allout-sibling-index))
@@ -2230 +2386 @@
-          (not (equal last-command this-command)))
-      (move-beginning-of-line 1)
-
-
-
+
+
+
+
+
+
+
+
+
-      (cond ((= (current-column) 0)
-allout-beginning-of-current-entr
+goto-char beginning-of-bod
-            ((< (point) beginning-of-body)
-             (allout-beginning-of-current-line))
@@ -2242 +2404 @@
-               (if (< (point) beginning-of-body)
-                   ;; we were on the headline after its start:
-allout-beginning-of-current-entr
+goto-char beginning-of-bod
-;;;_   > allout-end-of-line ()
-(defun allout-end-of-line ()
@@ -2262 +2424 @@
-             (allout-back-to-current-heading)
-             (allout-show-current-entry)
+             (allout-show-children)
-             (allout-end-of-entry))
-            ((>= (point) end-of-entry)
@@ -2271 +2434 @@
-  "Move to the heading for the topic \(possibly invisible) after this one.
-
-
-
-
+
+
+
+
-      (forward-char 1))
-
-
-
-
-
-
+
+
+
+
+
+
+
-;;;_   > allout-this-or-next-heading
-(defun allout-this-or-next-heading ()
@@ -2286 +2452 @@
-  ;; A throwaway non-macro that is defined after allout-next-heading
-  ;; and usable by allout-mode.
-
+-doublechecked
-;;;_   > allout-previous-heading ()
-macro
+un
-  "Move to the prior \(possibly invisible) heading line.
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-;;;_   > allout-get-invisibility-overlay ()
-(defun allout-get-invisibility-overlay ()
@@ -2312 +2484 @@
-    (while (and overlays (not got))
-      (if (equal (overlay-get (car overlays) 'invisible) 'allout)
-
+
+
-    got))
-;;;_   > allout-back-to-visible-text ()
@@ -2325 +2498 @@
-;;; nested lists of the locations of topics within a subtree.
-;;;
-
-
-
-
-
+
+
-
-;;;_   > allout-chart-subtree (&optional levels visible orig-depth prev-depth)
@@ -2349 +2519 @@
-for their elaborate manipulations.
-
-opics are entered in the chart so the last one is at the car.
-
-t the beginning of the topic.  Charts for offspring consists of a
-
-
-
+he chart entries for the topics are in reverse order, so the
+
+n integer indicating the point at the beginning of the topic
+
+
+for a topics' offspring precedes the entry for the topic 
-
-The other function parameters are for internal recursion, and should
@@ -2381 +2551 @@
-    (while (and (not (eobp))
-                                        ; Still within original topic?
-(allout-recent-depth)
+allout-recent-depth
-                (cond ((= prev-depth curr-depth)
-                       ;; Register this one and move on:
-(point)
+allout-recent-prefix-beginning
-                       (if (and levels (<= levels 1))
-                           ;; At depth limit - skip sublevels:
@@ -2391 +2561 @@
-                               ;; next heading at lesser depth:
-                               (while (and (<= curr-depth
-(allout-recent-depth)
+allout-recent-depth
-                                           (if visible
-                                               (allout-next-visible-heading 1)
@@ -2438 +2608 @@
-for an explanation of charts."
-  (save-excursion
-if (allout-goto-prefix
-       
-       
-       
-       
+when (allout-goto-prefix-doublechecked
+      
+      
+      
+      
-;;;_   > allout-chart-to-reveal (chart depth)
-(defun allout-chart-to-reveal (chart depth)
@@ -2515 +2685 @@
-      (forward-char 1)
-      (if (looking-at allout-regexp)
-
-
+
-        (forward-char -1)))
-    (if (bobp)
-        (cond ((looking-at allout-regexp)
- (match-beginning 0)(match-end 0)
+
-              ((allout-next-heading))
-              (done))
-      done)))
+;;;_   > allout-goto-prefix-doublechecked ()
+(defun allout-goto-prefix-doublechecked ()
+  "Put point at beginning of immediately containing outline topic.
+
+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'."
+  (allout-goto-prefix)
+  (if (and (<= allout-recent-depth allout-doublecheck-at-and-shallower)
+           (allout-aberrant-container-p))
+      (allout-previous-heading)
+    (point)))
+
-;;;_   > allout-end-of-prefix ()
-(defun allout-end-of-prefix (&optional ignore-decorations)
@@ -2531 +2711 @@
-otherwise skip white space between bullet and ensuing text."
-
-
+-doublechecked
-      nil
-
-
-
-
-
-
-
+
+
+
+
+
-    ;; Reestablish where we are:
-    (allout-current-depth)))
@@ -2546 +2724 @@
-  "Return position of current \(visible) topic's bullet."
-
-
+ 
-      nil
-(1- (match-end 0)
+ (1- allout-recent-prefix-end
-;;;_   > allout-back-to-current-heading ()
-(defun allout-back-to-current-heading ()
@@ -2563 +2741 @@
-                        (allout-beginning-of-current-line)
-                        (if (not (looking-at allout-regexp))
-
-
+
-                                                nil 'move)))
-
-
+
-      (if (interactive-p)
-          (allout-end-of-prefix)
@@ -2579 +2755 @@
-Returns that character position."
-
-
-
-
+
+
-;;;_   > allout-end-of-subtree (&optional current include-trailing-blank)
-(defun allout-end-of-subtree (&optional current include-trailing-blank)
@@ -2597 +2772 @@
-  (if current
-      (allout-back-to-current-heading)
-
-(allout-recent-depth)
+-doublechecked
+allout-recent-depth
-    (allout-next-heading)
-    (while (and (not (eobp))
-(allout-recent-depth)
+allout-recent-depth
-      (allout-next-heading))
-    (if (eobp)
@@ -2630 +2805 @@
-  (let ((start-point (point)))
-    (move-beginning-of-line 1)
+    (if (< 0 (allout-current-depth))
+        (goto-char allout-recent-prefix-end)
+      (goto-char (point-min)))
-    (allout-end-of-prefix)
-    (if (and (interactive-p)
@@ -2677 +2855 @@
-  "Ascend to depth DEPTH, returning depth if successful, nil if not."
-  (if (and (> depth 0)(<= depth (allout-depth)))
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-;;;_   > allout-ascend ()
-(defun allout-ascend ()
@@ -2693 +2866 @@
-  (prog1
-      (if (allout-beginning-of-level)
-       
+        
-    (if (interactive-p) (allout-end-of-prefix))))
-;;;_   > allout-descend-to-depth (depth)
@@ -2704 +2877 @@
-    (while
-        (and (> (allout-depth) 0)
-(allout-recent-depth)
+allout-recent-depth
-             (allout-next-heading)     ; ... go further
-(allout-recent-depth)
+allout-recent-depth
-    (if (and (> (allout-depth) 0)
-(allout-recent-depth)
+allout-recent-depth
-        depth
-      (goto-char start-point)
-      nil))
-  )
-
-
-
-
-
-
-
+
+
+
-  (interactive "p")
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
-      (if (interactive-p) (allout-end-of-prefix))
-      allout-recent-prefix-beginning)))
@@ -2757 +2907 @@
-Go backward if optional arg BACKWARD is non-nil.
-
-depth
-
-and backward (b
+the start point of the new topic
+
+if backward (bobp) (e
-      nil
-star
+targe
-          (start-point (point))
+          (count 0)
+          leaping
-          last-depth)
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-;;;_   > allout-previous-sibling (&optional depth backward)
-(defun allout-previous-sibling (&optional depth backward)
@@ -2808 +3035 @@
-  (let ((depth (allout-depth)))
-    (while (allout-previous-sibling depth nil))
-(allout-recent-depth)
+allout-recent-depth
-      (if (interactive-p) (allout-end-of-prefix)))))
-;;;_   > allout-next-visible-heading (arg)
@@ -2822 +3049 @@
-         prev got)
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+