[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: |
Kim F. Storm |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/allout.el,v |
|
Date: |
Sat, 04 Nov 2006 00:48:32 +0000 |
CVSROOT: /cvsroot/emacs
Module name: emacs
Changes by: Kim F. Storm <kfstorm> 06/11/04 00:48:31
Index: allout.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/allout.el,v
retrieving revision 1.86
retrieving revision 1.87
diff -u -b -r1.86 -r1.87
--- allout.el 9 Oct 2006 23:34:11 -0000 1.86
+++ allout.el 4 Nov 2006 00:48:31 -0000 1.87
@@ -891,13 +891,18 @@
(make-variable-buffer-local 'allout-plain-bullets-string-len)
;;;_ = allout-doublecheck-at-and-shallower
-(defconst allout-doublecheck-at-and-shallower 3
- "Verify apparent topics of this depth and shallower as being non-aberrant.
+(defconst allout-doublecheck-at-and-shallower 2
+ "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 prospects, because the determination of aberrance
depends on the mistaken item being followed by a legitimate item of
-excessively greater depth.")
+excessively greater depth.
+
+A level of 2 is safest, so that yanks, which must ignore
+aberrance while rectifying the yanked text to their new location,
+is least likely to be fooled by aberrant topics in the yanked
+text.")
;;;_ X allout-reset-header-lead (header-lead)
(defun allout-reset-header-lead (header-lead)
"*Reset the leading string used to identify topic headers."
@@ -1506,6 +1511,13 @@
(goto-char (cadr allout-after-save-decrypt))
(setq allout-after-save-decrypt nil))
)
+;;;_ = allout-during-yank-processing nil
+;; XXX allout yanks adjust the level of the topic being pasted to that of
+;; their target location. aberrance must be inhibited to allow that
+;; reconciliation. (this means that actually aberrant topics won't be
+;; treated specially while being pasted.)
+(defvar allout-during-yank-processing nil
+ "Internal state, inhibits aberrance doublecheck while adjusting yanks.")
;;;_ #2 Mode activation
;;;_ = allout-explicitly-deactivated
@@ -2194,26 +2206,15 @@
;;;_ - Position Assessment
;;;_ : Location Predicates
-;;;_ > allout-on-current-heading-p ()
-(defun allout-on-current-heading-p ()
- "Return non-nil if point is on current visible topics' header line.
-
-Actually, returns prefix beginning point."
- (save-excursion
- (allout-beginning-of-current-line)
- (and (looking-at allout-regexp)
- (allout-prefix-data)
- (or (> allout-recent-depth allout-doublecheck-at-and-shallower)
- (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))
- (beginning-of-line))
- (looking-at allout-regexp))
- (= (point)(save-excursion (allout-end-of-prefix)(point)))))
+;;;_ > allout-do-doublecheck ()
+(defsubst allout-do-doublecheck ()
+ "True if current item conditions qualify for checking on topic aberrance."
+ (and
+ ;; presume integrity of outline and yanked content during yank - necessary,
+ ;; to allow for level disparity of yank location and yanked text:
+ (not allout-during-yank-processing)
+ ;; allout-doublecheck-at-and-shallower is ceiling for doublecheck:
+ (<= allout-recent-depth allout-doublecheck-at-and-shallower)))
;;;_ > allout-aberrant-container-p ()
(defun allout-aberrant-container-p ()
"True if topic, or next sibling with children, contains them discontinuously.
@@ -2259,6 +2260,26 @@
;; recalibrate allout-recent-*
(allout-depth)
nil)))
+;;;_ > allout-on-current-heading-p ()
+(defun allout-on-current-heading-p ()
+ "Return non-nil if point is on current visible topics' header line.
+
+Actually, returns prefix beginning point."
+ (save-excursion
+ (allout-beginning-of-current-line)
+ (and (looking-at allout-regexp)
+ (allout-prefix-data)
+ (or (not (allout-do-doublecheck))
+ (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))
+ (beginning-of-line))
+ (looking-at allout-regexp))
+ (= (point)(save-excursion (allout-end-of-prefix)(point)))))
;;;_ : Location attributes
;;;_ > allout-depth ()
(defun allout-depth ()
@@ -2390,8 +2411,7 @@
(allout-depth)
(let ((beginning-of-body
(save-excursion
- (while (and (<= allout-recent-depth
- allout-doublecheck-at-and-shallower)
+ (while (and (allout-do-doublecheck)
(allout-aberrant-container-p)
(allout-previous-visible-heading 1)))
(allout-beginning-of-current-entry)
@@ -2443,7 +2463,7 @@
(when (re-search-forward allout-line-boundary-regexp nil 0)
(allout-prefix-data)
- (and (<= allout-recent-depth allout-doublecheck-at-and-shallower)
+ (and (allout-do-doublecheck)
;; 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))
@@ -2464,13 +2484,13 @@
(if (bobp)
nil
- ;; allout-goto-prefix-doublechecked calls us, so we can't use it here.
(let ((start-point (point)))
+ ;; allout-goto-prefix-doublechecked calls us, so we can't use it here.
(allout-goto-prefix)
(when (or (re-search-backward allout-line-boundary-regexp nil 0)
(looking-at allout-bob-regexp))
(goto-char (allout-prefix-data))
- (if (and (<= allout-recent-depth allout-doublecheck-at-and-shallower)
+ (if (and (allout-do-doublecheck)
(allout-aberrant-container-p))
(or (allout-previous-heading)
(and (goto-char start-point)
@@ -2705,11 +2725,11 @@
`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)
+ (if (allout-goto-prefix)
+ (if (and (allout-do-doublecheck)
(allout-aberrant-container-p))
(allout-previous-heading)
- (point)))
+ (point))))
;;;_ > allout-end-of-prefix ()
(defun allout-end-of-prefix (&optional ignore-decorations)
@@ -2745,13 +2765,13 @@
(allout-beginning-of-current-line)
(let ((bol-point (point)))
- (allout-goto-prefix-doublechecked)
+ (if (allout-goto-prefix-doublechecked)
(if (<= (point) bol-point)
(if (interactive-p)
(allout-end-of-prefix)
(point))
(goto-char (point-min))
- nil)))
+ nil))))
;;;_ > allout-back-to-heading ()
(defalias 'allout-back-to-heading 'allout-back-to-current-heading)
;;;_ > allout-pre-next-prefix ()
@@ -2918,6 +2938,7 @@
nil
(let ((target-depth (or depth (allout-depth)))
(start-point (point))
+ (start-prefix-beginning allout-recent-prefix-beginning)
(count 0)
leaping
last-depth)
@@ -2941,7 +2962,9 @@
nil)))
((and (not (eobp))
(and (> (or last-depth (allout-depth)) 0)
- (= allout-recent-depth target-depth)))
+ (= allout-recent-depth target-depth))
+ (not (= start-prefix-beginning
+ allout-recent-prefix-beginning)))
allout-recent-prefix-beginning)
(t
(goto-char start-point)
@@ -3067,8 +3090,7 @@
;; not a header line, keep looking:
t
(allout-prefix-data)
- (if (and (<= allout-recent-depth
- allout-doublecheck-at-and-shallower)
+ (if (and (allout-do-doublecheck)
(allout-aberrant-container-p))
;; skip this aberrant prospective header line:
t
@@ -3828,6 +3850,7 @@
(mb allout-recent-prefix-beginning)
(me allout-recent-prefix-end)
(current-bullet (buffer-substring-no-properties (- me 1) me))
+ (has-annotation (get-text-property mb 'allout-was-hidden))
(new-prefix (allout-make-topic-prefix current-bullet
nil
new-depth
@@ -3854,6 +3877,11 @@
(allout-unprotected
(delete-region (match-beginning 0)(match-end 0))))
+ ;; convey 'allout-was-hidden annotation, if original had it:
+ (if has-annotation
+ (put-text-property 0 (length new-prefix) 'allout-was-hidden t
+ new-prefix))
+
; Put in new prefix:
(allout-unprotected (insert new-prefix))
@@ -4183,10 +4211,11 @@
(depth (allout-depth)))
(allout-annotate-hidden beg end)
-
(if (and (not beg-hidden) (not end-hidden))
(allout-unprotected (kill-line arg))
(kill-line arg))
+ (allout-deannotate-hidden beg end)
+
(if allout-numbered-bullet
(save-excursion ; Renumber subsequent topics if needed:
(if (not (looking-at allout-regexp))
@@ -4218,6 +4247,7 @@
(interactive)
(let* ((inhibit-field-text-motion t)
(beg (prog1 (allout-back-to-current-heading) (beginning-of-line)))
+ end
(depth allout-recent-depth))
(allout-end-of-current-subtree)
(if (and (/= (current-column) 0) (not (eobp)))
@@ -4231,9 +4261,13 @@
(string= (buffer-substring (- beg 2) beg) "\n\n"))))
(forward-char 1)))
- (allout-annotate-hidden beg (point))
+ (allout-annotate-hidden beg (setq end (point)))
+ (unwind-protect
+ (allout-unprotected (kill-region beg end))
+ (if buffer-read-only
+ ;; eg, during copy-as-kill.
+ (allout-deannotate-hidden beg end)))
- (allout-unprotected (kill-region beg (point)))
(save-excursion
(allout-renumber-to-depth depth))
(run-hook-with-args 'allout-structure-deleted-hook depth (point))))
@@ -4251,8 +4285,7 @@
(let ((was-modified (buffer-modified-p))
(buffer-read-only nil))
- (allout-unprotected
- (remove-text-properties begin end '(allout-was-hidden t)))
+ (allout-deannotate-hidden begin end)
(save-excursion
(goto-char begin)
(let (done next prev overlay)
@@ -4279,9 +4312,19 @@
(when next
(goto-char next)
(allout-unprotected
+ (let ((buffer-undo-list t))
(put-text-property (overlay-start overlay) next
- 'allout-was-hidden t))))))))
+ 'allout-was-hidden t)))))))))
(set-buffer-modified-p was-modified)))
+;;;_ > allout-deannotate-hidden (begin end)
+(defun allout-deannotate-hidden (begin end)
+ "Remove allout hidden-text annotation between BEGIN and END."
+
+ (allout-unprotected
+ (let ((inhibit-read-only t)
+ (buffer-undo-list t))
+ ;(remove-text-properties begin end '(allout-was-hidden t))
+ )))
;;;_ > allout-hide-by-annotation (begin end)
(defun allout-hide-by-annotation (begin end)
"Translate text properties indicating exposure status into actual exposure."
@@ -4309,16 +4352,10 @@
nil end))
(overlay-put (make-overlay prev next)
'category 'allout-exposure-category)
- (allout-unprotected
- (remove-text-properties prev next '(allout-was-hidden t)))
+ (allout-deannotate-hidden prev next)
(setq prev next)
(if next (goto-char next)))))
(set-buffer-modified-p was-modified))))
-;;;_ > allout-remove-exposure-annotation (begin end)
-(defun allout-remove-exposure-annotation (begin end)
- "Remove text properties indicating exposure status."
- (remove-text-properties begin end '(allout-was-hidden t)))
-
;;;_ > allout-yank-processing ()
(defun allout-yank-processing (&optional arg)
@@ -4345,8 +4382,9 @@
; region around subject:
(if (< (allout-mark-marker t) (point))
(exchange-point-and-mark))
- (allout-unprotected
- (let* ((subj-beg (point))
+ (let* ( ;; inhibit aberrance doublecheck while reconciling disparate pastes:
+ (allout-during-yank-processing t)
+ (subj-beg (point))
(into-bol (bolp))
(subj-end (allout-mark-marker t))
;; 'resituate' if yanking an entire topic into topic header:
@@ -4359,7 +4397,10 @@
(and into-bol (looking-at allout-regexp)))))
(if resituate
; The yanked stuff is a topic:
- (let* ((prefix-len (- (match-end 1) subj-beg))
+ (let* ((inhibit-field-text-motion t)
+ (prefix-len (if (not (match-end 1))
+ 1
+ (- (match-end 1) subj-beg)))
(subj-depth allout-recent-depth)
(prefix-bullet (allout-recent-bullet))
(adjust-to-depth
@@ -4398,8 +4439,9 @@
; go as high as we can in each bunch:
(while (allout-ascend))
(save-excursion
+ (allout-unprotected
(allout-rebullet-topic-grunt (- adjust-to-depth
- subj-depth))
+ subj-depth)))
(allout-depth))
(if (setq more (not (bobp)))
(progn (widen)
@@ -4413,19 +4455,22 @@
; before bullet of new:
(progn
(beginning-of-line)
- (delete-region (point) subj-beg)
+ (allout-unprotected
+ (delete-region (point) subj-beg))
(set-marker (allout-mark-marker t) subj-end)
(goto-char subj-beg)
(allout-end-of-prefix))
; Delete base subj prefix,
; leaving old one:
+ (allout-unprotected
+ (progn
(delete-region (point) (+ (point)
prefix-len
(- adjust-to-depth subj-depth)))
; 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
@@ -4435,18 +4480,19 @@
; ... and renumber, in case necessary:
(goto-char subj-beg)
(if (allout-goto-prefix-doublechecked)
+ (allout-unprotected
(allout-rebullet-heading nil ;;; solicit
(allout-depth) ;;; depth
nil ;;; number-control
nil ;;; index
- t))
+ t)))
(message ""))))
(if (or into-bol resituate)
(allout-hide-by-annotation (point) (allout-mark-marker t))
- (allout-remove-exposure-annotation (allout-mark-marker t) (point)))
+ (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.
@@ -6356,7 +6402,7 @@
(save-excursion
(goto-char (point-min))
- (if (looking-at allout-regexp)
+ (if (allout-goto-prefix)
t
(allout-open-topic 2)
(insert (concat "Dummy outline topic header - see"
- [Emacs-diffs] Changes to emacs/lisp/allout.el,v,
Kim F. Storm <=