Changeset 4148 for trunk/lisp/allout.el

Timestamp:

08/18/06 08:35:31 (2 years ago)

Author:

miyoshi

Message:

Sync up with Emacs CVS HEAD.

Files:

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

trunk/lisp/allout.el

@@ -214 +214 @@
-     (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil)))))
-
+;;;_  = allout-beginning-of-line-cycles
+(defcustom allout-beginning-of-line-cycles t
+  "*If non-nil, \\[allout-beginning-of-line] will cycle through smart-placement options.
+
+Cycling only happens on when the command is repeated, not when it
+follows a different command.
+
+Smart-placement means that repeated calls to this function will
+advance as follows:
+
+ - if the cursor is on a non-headline body line and not on the first column:
+   then it goes to the first column
+ - if the cursor is on the first column of a non-headline body line:
+   then it goes to the start of the headline within the item body
+ - if the cursor is on the headline and not the start of the headline:
+   then it goes to the start of the headline
+ - if the cursor is on the start of the headline:
+   then it goes to the bullet character \(for hotspot navigation\)
+ - if the cursor is on the bullet character:
+   then it goes to the first column of that line \(the headline\)
+ - if the cursor is on the first column of the headline:
+   then it goes to the start of the headline within the item body.
+
+In this fashion, you can use the beginning-of-line command to do
+its normal job and then, when repeated, advance through the
+entry, cycling back to start.
+
+If this configuration variable is nil, then the cursor is just
+advanced to the beginning of the line and remains there on
+repeated calls."
+  :type 'boolean :group 'allout)
+;;;_  = allout-end-of-line-cycles
+(defcustom allout-end-of-line-cycles t
+  "*If non-nil, \\[allout-end-of-line] will cycle through smart-placement options.
+
+Cycling only happens on when the command is repeated, not when it
+follows a different command.
+
+Smart-placement means that repeated calls to this function will
+advance as follows:
+
+ - if the cursor is not on the end-of-line,
+   then it goes to the end-of-line
+ - if the cursor is on the end-of-line but not the end-of-entry,
+   then it goes to the end-of-entry, exposing it if necessary
+ - if the cursor is on the end-of-entry,
+   then it goes to the end of the head line
+
+In this fashion, you can use the end-of-line command to do its
+normal job and then, when repeated, advance through the entry,
+cycling back to start.
+
+If this configuration variable is nil, then the cursor is just
+advanced to the end of the line and remains there on repeated
+calls."
+  :type 'boolean :group 'allout)
+
-;;;_  = allout-header-prefix
-(defcustom allout-header-prefix "."
+;; this string is treated as literal match.  it will be `regexp-quote'd, so
+;; one cannot use regular expressions to match varying header prefixes.
-  "*Leading string which helps distinguish topic headers.
-
-Outline topic header lines are identified by a leading topic
-header prefix, which mostly have the value of this var at their front.
-
-
-
+
+
-  :type 'string
-  :group 'allout)
@@ -301 +359 @@
-  "*When non-nil, use mode-specific topic-header prefixes.
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-Value t means to first check for assoc value in `allout-mode-leaders'
@@ -314 +374 @@
-`comment-start' to use only one of them, respectively.
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-  :type '(choice (const t) (const nil) string
-                 (const allout-mode-leaders)
@@ -335 +397 @@
-  "Specific allout-prefix leading strings per major modes.
-
-
-
+
+
+
-
-If you're constructing a string that will comment-out outline
-structuring so it can be included in program code, append an extra
-character, like an \"_\" underscore, to distinguish the lead string
-bol
+the beginning-of-line
-
-;;;_  = allout-old-style-prefixes
@@ -829 +892 @@
-  (allout-reset-header-lead header-lead)
-  header-lead)
-
-
-
+-and-primary-bullet
+-and-primary-bullet
+ and `allout-primary-bullet'
-
-Works according to settings of:
@@ -875 +938 @@
-    (if (not leader)
-        nil
-
-
-
-
+
+
+
+
+
+
+
+
-;;;_   > allout-infer-body-reindent ()
-(defun allout-infer-body-reindent ()
@@ -931 +998 @@
-  (setq allout-header-subtraction (1- (length allout-header-prefix)))
-  ;; Produce the new allout-regexp:
-\\
- allout-header-prefix
- 
- 
- "]\\)\\|\\
- allout-primary-bullet
- 
+
+(regexp-quote allout-header-prefix)
+
+
+"]\\)\\|
+(regexp-quote allout-primary-bullet)
+
-  (setq allout-line-boundary-regexp
-        (concat "\\(\n\\)\\(" allout-regexp "\\)"))
@@ -966 +1033 @@
-            keymap-list)
-    map))
-;;;_   = allout-prior-bindings - being deprecated.
-(defvar allout-prior-bindings nil
-  "Variable for use in V18, with allout-added-bindings, for
-resurrecting, on mode deactivation, bindings that existed before
-activation.  Being deprecated.")
-;;;_   = allout-added-bindings - being deprecated
-(defvar allout-added-bindings nil
-  "Variable for use in V18, with allout-prior-bindings, for
-resurrecting, on mode deactivation, bindings that existed before
-activation.  Being deprecated.")
-;;;_  : Menu bar
-(defvar allout-mode-exposure-menu)
@@ -1051 +1108 @@
-;;;_   > allout-add-resumptions (&rest pairs)
-(defun allout-add-resumptions (&rest pairs)
-pairs
+PAIRS
-
-Old settings are preserved for later resumption using `allout-do-resumptions'.
-
+The new values are set as a buffer local.  On resumption, the prior buffer
+scope of the variable is restored along with its value.  If it was a void
+buffer-local value, then it is left as nil on resumption.
+
-The pairs are lists whose car is the name of the variable and car of the
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-The settings are stored on `allout-mode-prior-settings'."
@@ -1071 +1136 @@
-    (let* ((pair (pop pairs))
-           (name (car pair))
-
+
+
+
+
-      (if (not (symbolp name))
-          (error "Pair's name, %S, must be a symbol, not %s"
-                 name (type-of name)))
+      (setq prior-value (condition-case err
+                            (symbol-value name)
+                          (void-variable nil)))
-      (when (not (assoc name allout-mode-prior-settings))
-        ;; Not already added as a resumption, create the prior setting entry.
-        (if (local-variable-p name)
-            ;; is already local variable - preserve the prior value:
-
-
-
-
+
-          ;; wasn't local variable, indicate so for resumption by killing
-          ;; local value, and make it local:
-          (push (list name) allout-mode-prior-settings)
-          (make-local-variable name)))
-
+
+
+
+
+
+
+
+
+
+
+
+
-;;;_   > allout-do-resumptions ()
-(defun allout-do-resumptions ()
@@ -1122 +1201 @@
-;;;_   x allout-view-change-hook
-(defvar allout-view-change-hook nil
-
-
-
-
-
+
+
+
+
+
+
-;;;_   = allout-exposure-change-hook
-(defvar allout-exposure-change-hook nil
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-;;;_   = allout-outside-normal-auto-fill-function
-(defvar allout-outside-normal-auto-fill-function nil
@@ -1187 +1315 @@
-was encrypted automatically as part of a file write or autosave.")
-(make-variable-buffer-local 'allout-after-save-decrypt)
+;;;_   = allout-encryption-plaintext-sanitization-regexps
+(defvar allout-encryption-plaintext-sanitization-regexps nil
+  "List of regexps whose matches are removed from plaintext before encryption.
+
+This is for the sake of removing artifacts, like escapes, that are added on
+and not actually part of the original plaintext.  The removal is done just
+prior to encryption.
+
+Entries must be symbols that are bound to the desired values.
+
+Each value can be a regexp or a list with a regexp followed by a
+substitution string.  If it's just a regexp, all its matches are removed
+before the text is encrypted.  If it's a regexp and a substitution, the
+substition is used against the regexp matches, a la `replace-match'.")
+(make-variable-buffer-local 'allout-encryption-text-removal-regexps)
+;;;_   = allout-encryption-ciphertext-rejection-regexps
+(defvar allout-encryption-ciphertext-rejection-regexps nil
+  "Variable for regexps matching plaintext to remove before encryption.
+
+This is for the sake of redoing encryption in cases where the ciphertext
+incidentally contains strings that would disrupt mode operation -
+for example, a line that happens to look like an allout-mode topic prefix.
+
+Entries must be symbols that are bound to the desired regexp values.
+
+The encryption will be retried up to
+`allout-encryption-ciphertext-rejection-limit' times, after which an error
+is raised.")
+
+(make-variable-buffer-local 'allout-encryption-ciphertext-rejection-regexps)
+;;;_   = allout-encryption-ciphertext-rejection-ceiling
+(defvar allout-encryption-ciphertext-rejection-ceiling 5
+  "Limit on number of times encryption ciphertext is rejected.
+
+See `allout-encryption-ciphertext-rejection-regexps' for rejection reasons.")
+(make-variable-buffer-local 'allout-encryption-ciphertext-rejection-ceiling)
-;;;_   > allout-mode-p ()
-;; Must define this macro above any uses, or byte compilation will lack
@@ -1638 +1802 @@
-                       'category 'allout-exposure-category)
-
-run-hooks 'allout-mode-deactivate-hook
-setq allout-mode nil
+setq allout-mode nil
+run-hooks 'allout-mode-deactivate-hook
-
-     ;; Activation:
@@ -1646 +1810 @@
-      (if allout-old-style-prefixes
-          ;; Inhibit all the fancy formatting:
-
-
+
-
-      (allout-overlay-preparations)     ; Doesn't hurt to redo this.
@@ -1655 +1818 @@
-
-      (set-allout-regexp)
+      (allout-add-resumptions
+       '(allout-encryption-ciphertext-rejection-regexps
+         allout-line-boundary-regexp
+         extend)
+       '(allout-encryption-ciphertext-rejection-regexps
+         allout-bob-regexp
+         extend))
-
-      ;; Produce map from current version of allout-keybindings-list:
@@ -1660 +1830 @@
-            (produce-allout-mode-map allout-keybindings-list))
-      (substitute-key-definition 'beginning-of-line
-
+
+
+
+
-                                 allout-mode-map global-map)
-      (substitute-key-definition 'end-of-line
-
+
+
+
+
-                                 allout-mode-map global-map)
-      (produce-allout-mode-menubar-entries)
@@ -1718 +1894 @@
-          (setq do-layout t))
-
-run-hooks 'allout-mode-hook
-setq allout-mode t
+setq allout-mode t
+run-hooks 'allout-mode-hook
-
-     ;; Reactivation:
@@ -2045 +2221 @@
-      (end-of-line)
-      (if (allout-hidden-p) (forward-char 1)))))
+;;;_   > allout-beginning-of-line ()
+(defun allout-beginning-of-line ()
+  "Beginning-of-line with `allout-beginning-of-line-cycles' behavior, if set."
+
+  (interactive)
+
+  (if (or (not allout-beginning-of-line-cycles)
+          (not (equal last-command this-command)))
+      (move-beginning-of-line 1)
+    (let ((beginning-of-body (save-excursion
+                               (allout-beginning-of-current-entry)
+                               (point))))
+      (cond ((= (current-column) 0)
+             (allout-beginning-of-current-entry))
+            ((< (point) beginning-of-body)
+             (allout-beginning-of-current-line))
+            ((= (point) beginning-of-body)
+             (goto-char (allout-current-bullet-pos)))
+            (t (allout-beginning-of-current-line)
+               (if (< (point) beginning-of-body)
+                   ;; we were on the headline after its start:
+                   (allout-beginning-of-current-entry)))))))
+;;;_   > allout-end-of-line ()
+(defun allout-end-of-line ()
+  "End-of-line with `allout-end-of-line-cycles' behavior, if set."
+
+  (interactive)
+
+  (if (or (not allout-end-of-line-cycles)
+          (not (equal last-command this-command)))
+      (allout-end-of-current-line)
+    (let ((end-of-entry (save-excursion
+                          (allout-end-of-entry)
+                          (point))))
+      (cond ((not (eolp))
+             (allout-end-of-current-line))
+            ((or (allout-hidden-p) (save-excursion
+                                     (forward-char -1)
+                                     (allout-hidden-p)))
+             (allout-back-to-current-heading)
+             (allout-show-current-entry)
+             (allout-end-of-entry))
+            ((>= (point) end-of-entry)
+             (allout-back-to-current-heading)
+             (allout-end-of-current-line))
+            (t (allout-end-of-entry))))))
-;;;_   > allout-next-heading ()
-(defsubst allout-next-heading ()
@@ -2109 +2331 @@
-;;; traversal of the structure.
-
-
-
+visible 
+visible 
-  "Produce a location \"chart\" of subtopics of the containing topic.
-
-Optional argument LEVELS specifies the depth \(relative to start
-
-
+
+
+
+
+
+
-
-Point is left at the end of the subtree.
@@ -2142 +2368 @@
-        (progn (setq orig-depth (allout-depth))
-               (or prev-depth (setq prev-depth (1+ orig-depth)))
-
+
+
+
-
-    ;; Loop over the current levels' siblings.  Besides being more
@@ -2164 +2392 @@
-                               (while (and (<= curr-depth
-                                               (allout-recent-depth))
-
-
+
+
+
+
+
+
-
-                      ((and (< prev-depth curr-depth)
@@ -2174 +2406 @@
-                             (cons (allout-chart-subtree (and levels
-                                                               (1- levels))
-
-
+
+
+
-                                   chart))
-                       ;; ... then continue with this one.
@@ -2370 +2603 @@
-                (> (allout-recent-depth) level))
-      (allout-next-heading))
-
+
+
+
-    (if (and (not include-trailing-blank) (= ?\n (preceding-char)))
-         (forward-char -1))
@@ -2676 +2911 @@
-`allout-mode-map'.")
-(make-variable-buffer-local 'allout-post-goto-bullet)
+;;;_   = allout-command-counter
+(defvar allout-command-counter 0
+  "Counter that monotonically increases in allout-mode buffers.
+
+Set by `allout-pre-command-business', to support allout addons in
+coordinating with allout activity.")
+(make-variable-buffer-local 'allout-command-counter)
-;;;_   > allout-post-command-business ()
-(defun allout-post-command-business ()
@@ -2693 +2935 @@
-        (allout-after-saves-handler))
-
-
+allout
-    (if (and allout-post-goto-bullet
-             (allout-current-bullet-pos))
@@ -2702 +2944 @@
-(defun allout-pre-command-business ()
-  "Outline `pre-command-hook' function for outline buffers.
-
+
+
+
-
-When the cursor is on the bullet character, self-insert characters are
@@ -2710 +2954 @@
-positioned on the bullet character of the destination topic.
-
-(ie, unmodified
+\(ie, unmodified\
-outline maneuvering operations by positioning the cursor on the bullet
-char.  When in this mode you can use regular cursor-positioning
@@ -2718 +2962 @@
-  (if (not (allout-mode-p))
-      nil
+    ;; Increment allout-command-counter
+    (setq allout-command-counter (1+ allout-command-counter))
+    ;; Do hot-spot navigation.
-    (if (and (eq this-command 'self-insert-command)
-             (eq (point)(allout-current-bullet-pos)))
@@ -2991 +3238 @@
-If OFFER-RECENT-BULLET is true, offer to use the bullet of the prior sibling.
-
+Runs 
+
-Nuances:
-
@@ -3041 +3290 @@
-                      (point)))
-         dbl-space
-
+
+
-
-    (if (not opening-on-blank)
@@ -3142 +3392 @@
-                         (forward-char 1))))
-          ))
+    (setq start (point))
-    (insert (concat (allout-make-topic-prefix opening-numbered t depth)
-                    " "))
+    (setq end (1+ (point)))
-
-    (allout-rebullet-heading (and offer-recent-bullet ref-bullet)
@@ -3151 +3403 @@
-                        (allout-show-children)))
-    (end-of-line)
+
+    (run-hook-with-args 'allout-structure-added-hook start end)
-    )
-  )
@@ -3549 +3803 @@
-  (interactive "p")
-  (if (> arg 0)
+      ;; refuse to create a containment discontinuity:
-      (save-excursion
-        (allout-back-to-current-heading)
@@ -3565 +3820 @@
-                  (error (concat "Disallowed shift deeper than"
-                                 " containing topic's children.")))))))
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-;;;_    > allout-shift-out (arg)
-(defun allout-shift-out (arg)
@@ -3575 +3843 @@
-depth, however."
-  (interactive "p")
-
-
-
+
-;;;_   : Surgery (kill-ring) functions with special provisions for outlines:
-;;;_    > allout-kill-line (&optional arg)
@@ -3611 +3877 @@
-            (if (not (looking-at allout-regexp))
-                (allout-next-heading))
-
+
+
-;;;_    > allout-kill-topic ()
-(defun allout-kill-topic ()
@@ -3657 +3924 @@
-    (sit-for 0)
-    (save-excursion
-
+
+
-;;;_    > allout-yank-processing ()
-(defun allout-yank-processing (&optional arg)
@@ -3684 +3952 @@
-  (if (< (allout-mark-marker t) (point))
-      (exchange-point-and-mark))
-let* ((inhibit-field-text-motion t)
-      
-
-       
-
-       
-       
-                       
-                       
+allout-unprotected
+(let* (
+ 
+         
+ 
+         
+         
+                         
+                         
-                                              (match-end 1))))
-       
-       
-       
-                               
-
+         
+         
+         
+                                 
+ 
-                                        ; The yanked stuff is a topic:
-       
-       
-       
-       
-               
-               
-               
-               
-               
-               
-               
-                       
-                       
-                       
-                       
-                       
+         
+         
+         
+         
+                 
+                 
+                 
+                 
+                 
+                 
+                 
+                         
+                         
+                         
+                         
+                         
-                                                 (match-end 0)))
-               
-       
-       
-       
+                 
+         
+         
+         
-                                        ; Do the adjustment:
-       
-               
-               
-               
+         
+                 
+                 
+                 
-                                        ; Trim off excessive blank
-                                        ; line at end, if any:
-               
-               
-               
+                 
+                 
+                 
-                                        ; Work backwards, with each
-                                        ; shallowest level,
@@ -3736 +4004 @@
-                                        ; last processed topic from
-                                        ; the narrow region:
-               
-               
+                 
+                 
-                                        ; go as high as we can in each bunch:
-               
-               
-               
+                 
+                 
+                 
-                                                       subj-depth))
-               
-               
-                       
-                       
-                       
-               
-               
-               
-               
-                               
+                 
+                 
+                         
+                         
+                         
+                 
+                 
+                 
+                 
+                                 
-                                        ; Delete from bullet of old to
-                                        ; before bullet of new:
-               
-               
-               
-               
-               
-               
+                 
+                 
+                 
+                 
+                 
+                 
-                                        ; Delete base subj prefix,
-                                        ; leaving old one:
-               
-                                       
-                                       
+                 
+                                         
+                                         
-                                        ; and delete residual subj
-                                        ; prefix digits and space:
-               
-               
-       
-
-       
-       
+                 
+                 
+         
+ 
+         
+         
-                                        ; Give some preliminary feedback:
-       
+         
-                                        ; ... and renumber, in case necessary:
-       
-       
-               (allout-rebullet-heading nil    
+         
+         
+                 (allout-rebullet-heading nil            
-                                          (allout-depth) ;;; depth
-  
-