[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/allout.el,v
|
From: |
Dan Nicolaescu |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/allout.el,v |
|
Date: |
Mon, 29 Oct 2007 23:10:11 +0000 |
CVSROOT: /cvsroot/emacs
Module name: emacs
Changes by: Dan Nicolaescu <dann> 07/10/29 23:10:10
Index: allout.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/allout.el,v
retrieving revision 1.98
retrieving revision 1.99
diff -u -b -r1.98 -r1.99
--- allout.el 9 Oct 2007 08:52:48 -0000 1.98
+++ allout.el 29 Oct 2007 23:10:09 -0000 1.99
@@ -109,6 +109,65 @@
;;;_ + Layout, Mode, and Topic Header Configuration
+;;;_ = allout-command-prefix
+(defcustom allout-command-prefix "\C-c "
+ "*Key sequence to be used as prefix for outline mode command key bindings.
+
+Default is '\C-c<space>'; just '\C-c' is more short-and-sweet, if you're
+willing to let allout use a bunch of \C-c keybindings."
+ :type 'string
+ :group 'allout)
+;;;_ = allout-keybindings-list
+;;; You have to reactivate allout-mode - `(allout-mode t)' - to
+;;; institute changes to this var.
+(defvar allout-keybindings-list ()
+ "*List of `allout-mode' key / function bindings, for `allout-mode-map'.
+
+String or vector key will be prefaced with `allout-command-prefix',
+unless optional third, non-nil element is present.")
+(setq allout-keybindings-list
+ '(
+ ; Motion commands:
+ ("\C-n" allout-next-visible-heading)
+ ("\C-p" allout-previous-visible-heading)
+ ("\C-u" allout-up-current-level)
+ ("\C-f" allout-forward-current-level)
+ ("\C-b" allout-backward-current-level)
+ ("\C-a" allout-beginning-of-current-entry)
+ ("\C-e" allout-end-of-entry)
+ ; Exposure commands:
+ ("\C-i" allout-show-children)
+ ("\C-s" allout-show-current-subtree)
+ ("\C-h" allout-hide-current-subtree)
+ ("\C-t" allout-toggle-current-subtree-exposure)
+ ("h" allout-hide-current-subtree)
+ ("\C-o" allout-show-current-entry)
+ ("!" allout-show-all)
+ ("x" allout-toggle-current-subtree-encryption)
+ ; Alteration commands:
+ (" " allout-open-sibtopic)
+ ("." allout-open-subtopic)
+ ("," allout-open-supertopic)
+ ("'" allout-shift-in)
+ (">" allout-shift-in)
+ ("<" allout-shift-out)
+ ("\C-m" allout-rebullet-topic)
+ ("*" allout-rebullet-current-heading)
+ ("#" allout-number-siblings)
+ ("\C-k" allout-kill-line t)
+ ("\M-k" allout-copy-line-as-kill t)
+ ("\C-y" allout-yank t)
+ ("\M-y" allout-yank-pop t)
+ ("\C-k" allout-kill-topic)
+ ("\M-k" allout-copy-topic-as-kill)
+ ; Miscellaneous commands:
+ ;([?\C-\ ] allout-mark-topic)
+ ("@" allout-resolve-xref)
+ ("=c" allout-copy-exposed-to-buffer)
+ ("=i" allout-indented-exposed-to-buffer)
+ ("=t" allout-latexify-exposed)
+ ("=p" allout-flatten-exposed-to-buffer)))
+
;;;_ = allout-auto-activation
(defcustom allout-auto-activation nil
"*Regulates auto-activation modality of allout outlines - see `allout-init'.
@@ -204,6 +263,54 @@
(const :tag "- (expose topic body but not offspring)" -)
(allout-layout-type :tag "<Nested layout>"))))
+;;;_ = allout-inhibit-auto-fill
+(defcustom allout-inhibit-auto-fill nil
+ "*If non-nil, auto-fill will be inhibited in the allout buffers.
+
+You can customize this setting to set it for all allout buffers, or set it
+in individual buffers if you want to inhibit auto-fill only in particular
+buffers. (You could use a function on `allout-mode-hook' to inhibit
+auto-fill according, eg, to the major mode.)
+
+If you don't set this and auto-fill-mode is enabled, allout will use the
+value that `normal-auto-fill-function', if any, when allout mode starts, or
+else allout's special hanging-indent maintaining auto-fill function,
+`allout-auto-fill'."
+ :type 'boolean
+ :group 'allout)
+(make-variable-buffer-local 'allout-inhibit-auto-fill)
+;;;_ = allout-use-hanging-indents
+(defcustom allout-use-hanging-indents t
+ "*If non-nil, topic body text auto-indent defaults to indent of the header.
+Ie, it is indented to be just past the header prefix. This is
+relevant mostly for use with indented-text-mode, or other situations
+where auto-fill occurs."
+ :type 'boolean
+ :group 'allout)
+(make-variable-buffer-local 'allout-use-hanging-indents)
+;;;###autoload
+(put 'allout-use-hanging-indents 'safe-local-variable
+ (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil)))))
+;;;_ = allout-reindent-bodies
+(defcustom allout-reindent-bodies (if allout-use-hanging-indents
+ 'text)
+ "*Non-nil enables auto-adjust of topic body hanging indent with depth shifts.
+
+When active, topic body lines that are indented even with or beyond
+their topic header are reindented to correspond with depth shifts of
+the header.
+
+A value of t enables reindent in non-programming-code buffers, ie
+those that do not have the variable `comment-start' set. A value of
+`force' enables reindent whether or not `comment-start' is set."
+ :type '(choice (const nil) (const t) (const text) (const force))
+ :group 'allout)
+
+(make-variable-buffer-local 'allout-reindent-bodies)
+;;;###autoload
+(put 'allout-reindent-bodies 'safe-local-variable
+ '(lambda (x) (memq x '(nil t text force))))
+
;;;_ = allout-show-bodies
(defcustom allout-show-bodies nil
"*If non-nil, show entire body when exposing a topic, rather than
@@ -667,115 +774,6 @@
;;;_ + Miscellaneous customization
-;;;_ = allout-command-prefix
-(defcustom allout-command-prefix "\C-c "
- "*Key sequence to be used as prefix for outline mode command key bindings.
-
-Default is '\C-c<space>'; just '\C-c' is more short-and-sweet, if you're
-willing to let allout use a bunch of \C-c keybindings."
- :type 'string
- :group 'allout)
-
-;;;_ = allout-keybindings-list
-;;; You have to reactivate allout-mode - `(allout-mode t)' - to
-;;; institute changes to this var.
-(defvar allout-keybindings-list ()
- "*List of `allout-mode' key / function bindings, for `allout-mode-map'.
-
-String or vector key will be prefaced with `allout-command-prefix',
-unless optional third, non-nil element is present.")
-(setq allout-keybindings-list
- '(
- ; Motion commands:
- ("\C-n" allout-next-visible-heading)
- ("\C-p" allout-previous-visible-heading)
- ("\C-u" allout-up-current-level)
- ("\C-f" allout-forward-current-level)
- ("\C-b" allout-backward-current-level)
- ("\C-a" allout-beginning-of-current-entry)
- ("\C-e" allout-end-of-entry)
- ; Exposure commands:
- ("\C-i" allout-show-children)
- ("\C-s" allout-show-current-subtree)
- ("\C-h" allout-hide-current-subtree)
- ("h" allout-hide-current-subtree)
- ("\C-o" allout-show-current-entry)
- ("!" allout-show-all)
- ("x" allout-toggle-current-subtree-encryption)
- ; Alteration commands:
- (" " allout-open-sibtopic)
- ("." allout-open-subtopic)
- ("," allout-open-supertopic)
- ("'" allout-shift-in)
- (">" allout-shift-in)
- ("<" allout-shift-out)
- ("\C-m" allout-rebullet-topic)
- ("*" allout-rebullet-current-heading)
- ("#" allout-number-siblings)
- ("\C-k" allout-kill-line t)
- ("\M-k" allout-copy-line-as-kill t)
- ("\C-y" allout-yank t)
- ("\M-y" allout-yank-pop t)
- ("\C-k" allout-kill-topic)
- ("\M-k" allout-copy-topic-as-kill)
- ; Miscellaneous commands:
- ;([?\C-\ ] allout-mark-topic)
- ("@" allout-resolve-xref)
- ("=c" allout-copy-exposed-to-buffer)
- ("=i" allout-indented-exposed-to-buffer)
- ("=t" allout-latexify-exposed)
- ("=p" allout-flatten-exposed-to-buffer)))
-
-;;;_ = allout-inhibit-auto-fill
-(defcustom allout-inhibit-auto-fill nil
- "*If non-nil, auto-fill will be inhibited in the allout buffers.
-
-You can customize this setting to set it for all allout buffers, or set it
-in individual buffers if you want to inhibit auto-fill only in particular
-buffers. (You could use a function on `allout-mode-hook' to inhibit
-auto-fill according, eg, to the major mode.)
-
-If you don't set this and auto-fill-mode is enabled, allout will use the
-value that `normal-auto-fill-function', if any, when allout mode starts, or
-else allout's special hanging-indent maintaining auto-fill function,
-`allout-auto-fill'."
- :type 'boolean
- :group 'allout)
-(make-variable-buffer-local 'allout-inhibit-auto-fill)
-
-;;;_ = allout-use-hanging-indents
-(defcustom allout-use-hanging-indents t
- "*If non-nil, topic body text auto-indent defaults to indent of the header.
-Ie, it is indented to be just past the header prefix. This is
-relevant mostly for use with indented-text-mode, or other situations
-where auto-fill occurs."
- :type 'boolean
- :group 'allout)
-(make-variable-buffer-local 'allout-use-hanging-indents)
-;;;###autoload
-(put 'allout-use-hanging-indents 'safe-local-variable
- (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil)))))
-
-;;;_ = allout-reindent-bodies
-(defcustom allout-reindent-bodies (if allout-use-hanging-indents
- 'text)
- "*Non-nil enables auto-adjust of topic body hanging indent with depth shifts.
-
-When active, topic body lines that are indented even with or beyond
-their topic header are reindented to correspond with depth shifts of
-the header.
-
-A value of t enables reindent in non-programming-code buffers, ie
-those that do not have the variable `comment-start' set. A value of
-`force' enables reindent whether or not `comment-start' is set."
- :type '(choice (const nil) (const t) (const text) (const force))
- :group 'allout)
-
-(make-variable-buffer-local 'allout-reindent-bodies)
-;;;###autoload
-(put 'allout-reindent-bodies 'safe-local-variable
- '(lambda (x) (memq x '(nil t text force))))
-
;;;_ = allout-enable-file-variable-adjustment
(defcustom allout-enable-file-variable-adjustment t
"*If non-nil, some allout outline actions edit Emacs local file var text.
@@ -906,13 +904,31 @@
(make-variable-buffer-local 'allout-plain-bullets-string-len)
;;;_ = allout-doublecheck-at-and-shallower
-(defconst allout-doublecheck-at-and-shallower 2
+(defconst allout-doublecheck-at-and-shallower 3
"Validate apparent topics of this depth and shallower as being non-aberrant.
-Verified with `allout-aberrant-container-p'. This check's usefulness is
-limited to shallow depths, because the determination of aberrance
-is according to the mistaken item being followed by a legitimate item of
-excessively greater depth.")
+Verified with `allout-aberrant-container-p'. The usefulness of
+this check is limited to shallow depths, because the
+determination of aberrance is according to the mistaken item
+being followed by a legitimate item of excessively greater depth.
+
+The classic example of a mistaken item, for a standard allout
+outline configuration, is a body line that begins with an '...'
+ellipsis. This happens to contain a legitimate depth-2 header
+prefix, constituted by two '..' dots at the beginning of the
+line. The only thing that can distinguish it *in principle* from
+a legitimate one is if the following real header is at a depth
+that is discontinuous from the depth of 2 implied by the
+ellipsis, ie depth 4 or more. As the depth being tested gets
+greater, the likelihood of this kind of disqualification is
+lower, and the usefulness of this test is lower.
+
+Extending the depth of the doublecheck increases the amount it is
+applied, increasing the cost of the test - on casual estimation,
+for outlines with many deep topics, geometrically (O(n)?).
+Taken together with decreasing likelihood that the test will be
+useful at greater depths, more modest doublecheck limits are more
+suitably economical.")
;;;_ X allout-reset-header-lead (header-lead)
(defun allout-reset-header-lead (header-lead)
"*Reset the leading string used to identify topic headers."
@@ -1136,7 +1152,7 @@
(key-suff (list (car cell))))
(apply 'define-key
(list map
- (apply 'concat (if add-pref
+ (apply 'vconcat (if add-pref
(append pref key-suff)
key-suff))
(car (cdr cell)))))))
@@ -2130,8 +2146,10 @@
;;; &optional prelen)
(defun allout-overlay-insert-in-front-handler (ol after beg end
&optional prelen)
- "Shift the overlay so stuff inserted in front of it are excluded."
+ "Shift the overlay so stuff inserted in front of it is excluded."
(if after
+ ;; XXX Shouldn't moving the overlay should be unnecessary, if overlay
+ ;; front-advance on the overlay worked as it should?
(move-overlay ol (1+ beg) (overlay-end ol))))
;;;_ > allout-overlay-interior-modification-handler (ol after beg end
;;; &optional prelen)
@@ -2319,6 +2337,7 @@
(let ((depth (allout-depth))
(start-point (point))
done aberrant)
+ (save-match-data
(save-excursion
(while (and (not done)
(re-search-forward allout-line-boundary-regexp nil 0))
@@ -2331,7 +2350,7 @@
((> allout-recent-depth (1+ depth))
(setq done t aberrant t))
;; next non-sibling is lower-depth - not aberrant:
- (t (setq done t)))))
+ (t (setq done t))))))
(if aberrant
aberrant
(goto-char start-point)
@@ -2345,19 +2364,21 @@
Actually, returns prefix beginning point."
(save-excursion
(allout-beginning-of-current-line)
+ (save-match-data
(and (looking-at allout-regexp)
(allout-prefix-data)
(or (not (allout-do-doublecheck))
- (not (allout-aberrant-container-p))))))
+ (not (allout-aberrant-container-p)))))))
;;;_ > allout-on-heading-p ()
(defalias 'allout-on-heading-p 'allout-on-current-heading-p)
;;;_ > allout-e-o-prefix-p ()
(defun allout-e-o-prefix-p ()
"True if point is located where current topic prefix ends, heading begins."
- (and (save-excursion (let ((inhibit-field-text-motion t))
+ (and (save-match-data
+ (save-excursion (let ((inhibit-field-text-motion t))
(beginning-of-line))
(looking-at allout-regexp))
- (= (point)(save-excursion (allout-end-of-prefix)(point)))))
+ (= (point) (save-excursion (allout-end-of-prefix)(point))))))
;;;_ : Location attributes
;;;_ > allout-depth ()
(defun allout-depth ()
@@ -2485,7 +2506,12 @@
(if (or (not allout-beginning-of-line-cycles)
(not (equal last-command this-command)))
- (move-beginning-of-line 1)
+ (progn
+ (if (and (not (bolp))
+ (allout-hidden-p (1- (point))))
+ (goto-char (previous-single-char-property-change
+ (1- (point)) 'invisible)))
+ (move-beginning-of-line 1))
(allout-depth)
(let ((beginning-of-body
(save-excursion
@@ -2528,7 +2554,10 @@
((>= (point) end-of-entry)
(allout-back-to-current-heading)
(allout-end-of-current-line))
- (t (allout-end-of-entry))))))
+ (t
+ (if (not (and transient-mark-mode mark-active))
+ (push-mark))
+ (allout-end-of-entry))))))
;;;_ > allout-next-heading ()
(defsubst allout-next-heading ()
"Move to the heading for the topic (possibly invisible) after this one.
@@ -2536,6 +2565,8 @@
Returns the location of the heading, or nil if none found.
We skip anomolous low-level topics, a la `allout-aberrant-container-p'."
+ (save-match-data
+
(if (looking-at allout-regexp)
(forward-char 1))
@@ -2545,7 +2576,7 @@
;; this will set allout-recent-* on the first non-aberrant topic,
;; whether it's the current one or one that disqualifies it:
(allout-aberrant-container-p))
- (goto-char allout-recent-prefix-beginning)))
+ (goto-char allout-recent-prefix-beginning))))
;;;_ > allout-this-or-next-heading
(defun allout-this-or-next-heading ()
"Position cursor on current or next heading."
@@ -2565,6 +2596,7 @@
(let ((start-point (point)))
;; allout-goto-prefix-doublechecked calls us, so we can't use it here.
(allout-goto-prefix)
+ (save-match-data
(when (or (re-search-backward allout-line-boundary-regexp nil 0)
(looking-at allout-bob-regexp))
(goto-char (allout-prefix-data))
@@ -2575,7 +2607,7 @@
;; recalibrate allout-recent-*:
(allout-depth)
nil))
- (point))))))
+ (point)))))))
;;;_ > allout-get-invisibility-overlay ()
(defun allout-get-invisibility-overlay ()
"Return the overlay at point that dictates allout invisibility."
@@ -2782,6 +2814,7 @@
Returns the point at the beginning of the prefix, or nil if none."
+ (save-match-data
(let (done)
(while (and (not done)
(search-backward "\n" nil 1))
@@ -2794,7 +2827,7 @@
(allout-prefix-data))
((allout-next-heading))
(done))
- done)))
+ done))))
;;;_ > allout-goto-prefix-doublechecked ()
(defun allout-goto-prefix-doublechecked ()
"Put point at beginning of immediately containing outline topic.
@@ -2819,10 +2852,11 @@
(if (not (allout-goto-prefix-doublechecked))
nil
(goto-char allout-recent-prefix-end)
+ (save-match-data
(if ignore-decorations
t
(while (looking-at "[0-9]") (forward-char 1))
- (if (and (not (eolp)) (looking-at "\\s-")) (forward-char 1)))
+ (if (and (not (eolp)) (looking-at "\\s-")) (forward-char 1))))
;; Reestablish where we are:
(allout-current-depth)))
;;;_ > allout-current-bullet-pos ()
@@ -3104,10 +3138,11 @@
found
done)
(while (not done)
- (setq found (if backward
+ (setq found (save-match-data
+ (if backward
(re-search-backward expression nil 'to-limit)
(forward-char 1)
- (re-search-forward expression nil 'to-limit)))
+ (re-search-forward expression nil 'to-limit))))
(if (and found (allout-aberrant-container-p))
(setq found nil))
(setq done (or found (if backward (bobp) (eobp)))))
@@ -3184,6 +3219,7 @@
(error nil))
(allout-beginning-of-current-line))
;; Deal with apparent header line:
+ (save-match-data
(if (not (looking-at allout-regexp))
;; not a header line, keep looking:
t
@@ -3195,7 +3231,7 @@
;; this prospective headerline qualifies - register:
(setq got allout-recent-prefix-beginning)
;; and break the loop:
- nil))))
+ nil)))))
;; Register this got, it may be the last:
(if got (setq prev got))
(setq arg (1- arg)))
@@ -3354,7 +3390,7 @@
;; translate literal membership on list:
(cadr (assoc key-string allout-keybindings-list)))
;; translate as a keybinding:
- (key-binding (concat allout-command-prefix
+ (key-binding (vconcat allout-command-prefix
(char-to-string
(if (and (<= 97 key-num) ; "a"
(>= 122 key-num)) ; "z"
@@ -3623,6 +3659,7 @@
from there."
(allout-beginning-of-current-line)
+ (save-match-data
(let* ((inhibit-field-text-motion t)
(depth (+ (allout-current-depth) relative-depth))
(opening-on-blank (if (looking-at "^\$")
@@ -3773,6 +3810,7 @@
(run-hook-with-args 'allout-structure-added-hook start end)
)
)
+ )
;;;_ > allout-open-subtopic (arg)
(defun allout-open-subtopic (arg)
"Open new topic header at deeper level than the current one.
@@ -3816,6 +3854,7 @@
(when (not allout-inhibit-auto-fill)
(let ((fill-prefix (if allout-use-hanging-indents
;; Check for topic header indentation:
+ (save-match-data
(save-excursion
(beginning-of-line)
(if (looking-at allout-regexp)
@@ -3823,7 +3862,7 @@
;; length of topic prefix:
(make-string (progn (allout-end-of-prefix)
(current-column))
- ?\ )))))
+ ?\ ))))))
(use-auto-fill-function (or allout-outside-normal-auto-fill-function
auto-fill-function
'do-auto-fill)))
@@ -3967,11 +4006,12 @@
(goto-char mb)
; Dispense with number if
; numbered-bullet prefix:
+ (save-match-data
(if (and allout-numbered-bullet
(string= allout-numbered-bullet current-bullet)
(looking-at "[0-9]+"))
(allout-unprotected
- (delete-region (match-beginning 0)(match-end 0))))
+ (delete-region (match-beginning 0)(match-end 0)))))
;; convey 'allout-was-hidden annotation, if original had it:
(if has-annotation
@@ -4297,7 +4337,7 @@
(if (or (not (allout-mode-p))
(not (bolp))
- (not (looking-at allout-regexp)))
+ (not (save-match-data (looking-at allout-regexp))))
;; Just do a regular kill:
(kill-line arg)
;; Ah, have to watch out for adjustments:
@@ -4317,7 +4357,7 @@
(if allout-numbered-bullet
(save-excursion ; Renumber subsequent topics if needed:
- (if (not (looking-at allout-regexp))
+ (if (not (save-match-data (looking-at allout-regexp)))
(allout-next-heading))
(allout-renumber-to-depth depth)))
(run-hook-with-args 'allout-structure-deleted-hook depth (point)))))
@@ -4352,7 +4392,7 @@
(if (and (/= (current-column) 0) (not (eobp)))
(forward-char 1))
(if (not (eobp))
- (if (and (looking-at "\n")
+ (if (and (save-match-data (looking-at "\n"))
(or (save-excursion
(or (not (allout-next-heading))
(= depth allout-recent-depth)))
@@ -4449,7 +4489,7 @@
(setq next (next-single-char-property-change (point)
'allout-was-hidden
nil end))
- (overlay-put (make-overlay prev next)
+ (overlay-put (make-overlay prev next nil 'front-advance)
'category 'allout-exposure-category)
(allout-deannotate-hidden prev next)
(setq prev next)
@@ -4481,6 +4521,7 @@
; region around subject:
(if (< (allout-mark-marker t) (point))
(exchange-point-and-mark))
+ (save-match-data
(let* ((subj-beg (point))
(into-bol (bolp))
(subj-end (allout-mark-marker t))
@@ -4492,7 +4533,8 @@
;; `rectify-numbering' if resituating (where several topics may
;; be resituating) or yanking a topic into a topic slot (bol):
(rectify-numbering (or resituate
- (and into-bol (looking-at allout-regexp)))))
+ (and into-bol
+ (looking-at allout-regexp)))))
(if resituate
;; Yanking a topic into the start of a topic - reconcile to fit:
(let* ((inhibit-field-text-motion t)
@@ -4569,7 +4611,8 @@
; and delete residual subj
; prefix digits and space:
(while (looking-at "[0-9]") (delete-char 1))
- (if (looking-at " ") (delete-char 1))))))
+ (if (looking-at " ")
+ (delete-char 1))))))
(exchange-point-and-mark))))
(if rectify-numbering
(progn
@@ -4591,7 +4634,7 @@
(allout-deannotate-hidden (allout-mark-marker t) (point)))
(if (not resituate)
(exchange-point-and-mark))
- (run-hook-with-args 'allout-structure-added-hook subj-beg subj-end)))
+ (run-hook-with-args 'allout-structure-added-hook subj-beg subj-end))))
;;;_ > allout-yank (&optional arg)
(defun allout-yank (&optional arg)
"`allout-mode' yank, with depth and numbering adjustment of yanked topics.
@@ -4658,13 +4701,15 @@
allout-file-xref-bullet)
(let ((inhibit-field-text-motion t)
file-name)
+ (save-match-data
(save-excursion
(let* ((text-start allout-recent-prefix-end)
(heading-end (progn (end-of-line) (point))))
(goto-char text-start)
(setq file-name
(if (re-search-forward "\\s-\\(\\S-*\\)" heading-end t)
- (buffer-substring (match-beginning 1) (match-end 1))))))
+ (buffer-substring (match-beginning 1)
+ (match-end 1)))))))
(setq file-name (expand-file-name file-name))
(if (or (file-exists-p file-name)
(if (file-writable-p file-name)
@@ -4695,7 +4740,7 @@
;; We use outline invisibility spec.
(remove-overlays from to 'category 'allout-exposure-category)
(when flag
- (let ((o (make-overlay from to)))
+ (let ((o (make-overlay from to nil 'front-advance)))
(overlay-put o 'category 'allout-exposure-category)
(when (featurep 'xemacs)
(let ((props (symbol-plist 'allout-exposure-category)))
@@ -4898,6 +4943,7 @@
collapsed and uncollapsed. If optional INCLUDE-SINGLE-LINERS is
true, then single-line topics are considered to be collapsed. By
default, they are treated as being uncollapsed."
+ (save-match-data
(save-excursion
(and
;; Is the topic all on one line (allowing for trailing blank line)?
@@ -4907,7 +4953,7 @@
(allout-end-of-current-subtree (not (looking-at "\n\n"))))
(or include-single-liners
- (progn (backward-char 1) (allout-hidden-p))))))
+ (progn (backward-char 1) (allout-hidden-p)))))))
;;;_ > allout-hide-current-subtree (&optional just-close)
(defun allout-hide-current-subtree (&optional just-close)
"Close the current topic, or containing topic if this one is already closed.
@@ -4931,6 +4977,16 @@
(allout-expose-topic '(0 :))
(message (concat sibs-msg " Done."))))
(goto-char from)))
+;;;_ > allout-toggle-current-subtree-exposure
+(defun allout-toggle-current-subtree-exposure ()
+ "Show or hide the current subtree depending on its current state."
+ ;; thanks to tassilo for suggesting this.
+ (interactive)
+ (save-excursion
+ (allout-back-to-heading)
+ (if (allout-hidden-p (point-at-eol))
+ (allout-show-current-subtree)
+ (allout-hide-current-subtree))))
;;;_ > allout-show-current-branches ()
(defun allout-show-current-branches ()
"Show all subheadings of this heading, but not their bodies."
@@ -4962,6 +5018,7 @@
;;;_ > allout-hide-region-body (start end)
(defun allout-hide-region-body (start end)
"Hide all body lines in the region, but not headings."
+ (save-match-data
(save-excursion
(save-restriction
(narrow-to-region start end)
@@ -4973,7 +5030,7 @@
(if (not (eobp))
(forward-char
(if (looking-at "\n\n")
- 2 1))))))))
+ 2 1)))))))))
;;;_ > allout-expose-topic (spec)
(defun allout-expose-topic (spec)
@@ -5596,6 +5653,7 @@
(let ((beg (point))
(end (progn (end-of-line)(point))))
(goto-char beg)
+ (save-match-data
(while (re-search-forward "\\\\"
;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#"
end ; bounded by end-of-line
@@ -5603,7 +5661,7 @@
(goto-char (match-beginning 2))
(insert "\\")
(setq end (1+ end))
- (goto-char (1+ (match-end 2)))))))
+ (goto-char (1+ (match-end 2))))))))
;;;_ > allout-insert-latex-header (buffer)
(defun allout-insert-latex-header (buffer)
"Insert initial LaTeX commands at point in BUFFER."
@@ -6050,8 +6108,9 @@
(let ((re (if (listp re) (car re) re))
(replacement (if (listp re) (cadr re) "")))
(goto-char (point-min))
+ (save-match-data
(while (re-search-forward re nil t)
- (replace-match replacement nil nil)))))
+ (replace-match replacement nil nil))))))
(cond
@@ -6282,7 +6341,7 @@
(allout-end-of-prefix t)
(and (string= (buffer-substring-no-properties (1- (point)) (point))
allout-topic-encryption-bullet)
- (looking-at "\\*"))
+ (save-match-data (looking-at "\\*")))
)
)
;;;_ > allout-encrypted-key-info (text)
@@ -6420,6 +6479,7 @@
immediately following '*' that would mark the topic as being encrypted. It
must also have content."
(let (done got content-beg)
+ (save-match-data
(while (not done)
(if (not (re-search-forward
@@ -6430,7 +6490,7 @@
(setq got nil
done t)
(goto-char (setq got (match-beginning 0)))
- (if (looking-at "\n")
+ (if (save-match-data (looking-at "\n"))
(forward-char 1))
(setq got (point)))
@@ -6463,6 +6523,7 @@
(goto-char got))
)
)
+ )
;;;_ > allout-encrypt-decrypted (&optional except-mark)
(defun allout-encrypt-decrypted (&optional except-mark)
"Encrypt topics pending encryption except those containing exemption point.
@@ -6478,6 +6539,7 @@
save. See `allout-encrypt-unencrypted-on-saves' for more info."
(interactive "p")
+ (save-match-data
(save-excursion
(let* ((current-mark (point-marker))
(current-mark-position (marker-position current-mark))
@@ -6511,6 +6573,7 @@
)
)
)
+ )
;;;_ #9 miscellaneous
;;;_ : Mode:
@@ -6725,13 +6788,14 @@
If BEG is bigger than END we return 0."
(if (> beg end)
0
+ (save-match-data
(save-excursion
(goto-char beg)
(let ((count 0))
(while (re-search-forward "[ ][ ]*$" end t)
(goto-char (1+ (match-beginning 2)))
(setq count (1+ count)))
- count))))
+ count)))))
;;;_ > allout-format-quote (string)
(defun allout-format-quote (string)
"Return a copy of string with all \"%\" characters doubled."
@@ -6844,7 +6908,13 @@
;; Move to beginning-of-line, ignoring fields and invisibles.
(skip-chars-backward "^\n")
- (while (and (not (bobp)) (line-move-invisible-p (1- (point))))
+ (while (and (not (bobp))
+ (let ((prop
+ (get-char-property (1- (point)) 'invisible)))
+ (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec)))))
(goto-char (if (featurep 'xemacs)
(previous-property-change (point))
(previous-char-property-change (point))))
@@ -6873,8 +6943,18 @@
(error nil))
(not (bobp))
(progn
- (while (and (not (bobp))
- (line-move-invisible-p (1- (point))))
+ (while
+ (and
+ (not (bobp))
+ (let ((prop
+ (get-char-property (1- (point))
+ 'invisible)))
+ (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop
+ buffer-invisibility-spec)
+ (assq prop
+ buffer-invisibility-spec)))))
(goto-char
(previous-char-property-change (point))))
(backward-char 1)))
@@ -6891,16 +6971,6 @@
(setq arg 1)
(setq done t)))))))
)
-;;;_ > line-move-invisible-p if necessary
-(if (not (fboundp 'line-move-invisible-p))
- (defun line-move-invisible-p (pos)
- "Return non-nil if the character after POS is currently invisible."
- (let ((prop
- (get-char-property pos 'invisible)))
- (if (eq buffer-invisibility-spec t)
- prop
- (or (memq prop buffer-invisibility-spec)
- (assq prop buffer-invisibility-spec))))))
;;;_ #10 Unfinished
;;;_ > allout-bullet-isearch (&optional bullet)