aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKen Manheimer2011-03-09 15:48:56 -0500
committerKen Manheimer2011-03-09 15:48:56 -0500
commitb6a5875b6a758190dfae68bbe3746914510c9462 (patch)
treed8ff6e9a84188e4c9a5e2e8f001b751d9b964f85
parent5baee236626c096eb0eddbf5fc12193805db9525 (diff)
downloademacs-b6a5875b6a758190dfae68bbe3746914510c9462.tar.gz
emacs-b6a5875b6a758190dfae68bbe3746914510c9462.zip
* allout.el Summary: Change so yank of distinctive-bullet items preserves
the existing header prefix, rebulleting it if necessary, rather than replacing it. This is necessary for proper operation of cooperative addons like allout-widgets. (allout-make-topic-prefix) (allout-rebullet-heading): Change SOLICIT arg to INSTEAD, and interpret additionally a string value as alternate bullet to be used, instead of prompting the user for a bullet character.
-rw-r--r--lisp/ChangeLog11
-rw-r--r--lisp/allout.el92
2 files changed, 54 insertions, 49 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index df4834a27c6..15bf0da861c 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,14 @@
12011-03-09 Ken Manheimer <ken.manheimer@gmail.com>
2
3 * allout.el Summary: Change so yank of distinctive-bullet items
4 preserves the existing header prefix, rebulleting it if necessary,
5 rather than replacing it. This is necessary for proper operation
6 of cooperative addons like allout-widgets.
7 (allout-make-topic-prefix) (allout-rebullet-heading): Change
8 SOLICIT arg to INSTEAD, and interpret additionally a string value
9 as alternate bullet to be used, instead of prompting the user for
10 a bullet character.
11
12011-03-09 Michael Albinus <michael.albinus@gmx.de> 122011-03-09 Michael Albinus <michael.albinus@gmx.de>
2 13
3 * net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band): Do 14 * net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band): Do
diff --git a/lisp/allout.el b/lisp/allout.el
index c75b7a22f9a..91eaa28fdaf 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -3465,13 +3465,13 @@ Offer one suitable for current depth DEPTH as default."
3465(defun allout-make-topic-prefix (&optional prior-bullet 3465(defun allout-make-topic-prefix (&optional prior-bullet
3466 new 3466 new
3467 depth 3467 depth
3468 solicit 3468 instead
3469 number-control 3469 number-control
3470 index) 3470 index)
3471 ;; Depth null means use current depth, non-null means we're either 3471 ;; Depth null means use current depth, non-null means we're either
3472 ;; opening a new topic after current topic, lower or higher, or we're 3472 ;; opening a new topic after current topic, lower or higher, or we're
3473 ;; changing level of current topic. 3473 ;; changing level of current topic.
3474 ;; Solicit dominates specified bullet-char. 3474 ;; Instead dominates specified bullet-char.
3475;;;_ . Doc string: 3475;;;_ . Doc string:
3476 "Generate a topic prefix suitable for optional arg DEPTH, or current depth. 3476 "Generate a topic prefix suitable for optional arg DEPTH, or current depth.
3477 3477
@@ -3492,15 +3492,18 @@ bullet or previous sibling.
3492Third arg DEPTH forces the topic prefix to that depth, regardless of 3492Third arg DEPTH forces the topic prefix to that depth, regardless of
3493the current topics' depth. 3493the current topics' depth.
3494 3494
3495If SOLICIT is non-nil, then the choice of bullet is solicited from 3495If INSTEAD is:
3496user. If it's a character, then that character is offered as the 3496
3497default, otherwise the one suited to the context (according to 3497- nil, then the bullet char for the context is used, per distinction or depth
3498distinction or depth) is offered. (This overrides other options, 3498- a string, then the first character of the string will be used
3499including, eg, a distinctive PRIOR-BULLET.) If non-nil, then the 3499- a character, then the user is solicited for bullet, with that char as default
3500context-specific bullet is used. 3500- anything else, the user is solicited with bullet char per context as default
3501
3502\(INSTEAD overrides other options, including, eg, a distinctive
3503PRIOR-BULLET.)
3501 3504
3502Fifth arg, NUMBER-CONTROL, matters only if `allout-numbered-bullet' 3505Fifth arg, NUMBER-CONTROL, matters only if `allout-numbered-bullet'
3503is non-nil *and* soliciting was not explicitly invoked. Then 3506is non-nil *and* no specific INSTEAD was specified. Then
3504NUMBER-CONTROL non-nil forces prefix to either numbered or 3507NUMBER-CONTROL non-nil forces prefix to either numbered or
3505denumbered format, depending on the value of the sixth arg, INDEX. 3508denumbered format, depending on the value of the sixth arg, INDEX.
3506 3509
@@ -3549,8 +3552,11 @@ index for each successive sibling)."
3549 ;; Solicitation overrides numbering and other cases: 3552 ;; Solicitation overrides numbering and other cases:
3550 ((progn (setq body (make-string (- depth 2) ?\ )) 3553 ((progn (setq body (make-string (- depth 2) ?\ ))
3551 ;; The actual condition: 3554 ;; The actual condition:
3552 solicit) 3555 instead)
3553 (let* ((got (allout-solicit-alternate-bullet depth solicit))) 3556 (let* ((got
3557 (if (and (stringp instead)(> (length instead) 0))
3558 (substring instead 0 1)
3559 (allout-solicit-alternate-bullet depth instead))))
3554 ;; Gotta check whether we're numbering and got a numbered bullet: 3560 ;; Gotta check whether we're numbering and got a numbered bullet:
3555 (setq numbering (and allout-numbered-bullet 3561 (setq numbering (and allout-numbered-bullet
3556 (not (and number-control (not index))) 3562 (not (and number-control (not index)))
@@ -3913,7 +3919,7 @@ Note that refill of indented paragraphs is not done."
3913 (allout-end-of-prefix) 3919 (allout-end-of-prefix)
3914 (setq from allout-recent-prefix-beginning 3920 (setq from allout-recent-prefix-beginning
3915 to allout-recent-prefix-end) 3921 to allout-recent-prefix-end)
3916 (allout-rebullet-heading t ;;; solicit 3922 (allout-rebullet-heading t ;;; instead
3917 nil ;;; depth 3923 nil ;;; depth
3918 nil ;;; number-control 3924 nil ;;; number-control
3919 nil ;;; index 3925 nil ;;; index
@@ -3931,8 +3937,8 @@ Note that refill of indented paragraphs is not done."
3931 (message "Done.") 3937 (message "Done.")
3932 (cond (on-bullet (goto-char (allout-current-bullet-pos))) 3938 (cond (on-bullet (goto-char (allout-current-bullet-pos)))
3933 (initial-col (move-to-column initial-col))))) 3939 (initial-col (move-to-column initial-col)))))
3934;;;_ > allout-rebullet-heading (&optional solicit ...) 3940;;;_ > allout-rebullet-heading (&optional instead ...)
3935(defun allout-rebullet-heading (&optional solicit 3941(defun allout-rebullet-heading (&optional instead
3936 new-depth 3942 new-depth
3937 number-control 3943 number-control
3938 index 3944 index
@@ -3942,11 +3948,11 @@ Note that refill of indented paragraphs is not done."
3942 3948
3943All args are optional. 3949All args are optional.
3944 3950
3945If SOLICIT is non-nil, then the choice of bullet is solicited from 3951If INSTEAD is:
3946user. If it's a character, then that character is offered as the 3952- nil, then the bullet char for the context is used, per distinction or depth
3947default, otherwise the one suited to the context (according to 3953- a string, then the first character of the string will be used
3948distinction or depth) is offered. If non-nil, then the 3954- a character, then the user is solicited for bullet, with that char as default
3949context-specific bullet is just used. 3955- anything else, the user is solicited with bullet char per context as default
3950 3956
3951Second arg DEPTH forces the topic prefix to that depth, regardless 3957Second arg DEPTH forces the topic prefix to that depth, regardless
3952of the topic's current depth. 3958of the topic's current depth.
@@ -3981,7 +3987,7 @@ this function."
3981 (new-prefix (allout-make-topic-prefix current-bullet 3987 (new-prefix (allout-make-topic-prefix current-bullet
3982 nil 3988 nil
3983 new-depth 3989 new-depth
3984 solicit 3990 instead
3985 number-control 3991 number-control
3986 index))) 3992 index)))
3987 3993
@@ -4028,7 +4034,7 @@ this function."
4028 (cond ((numberp index) (1+ index)) 4034 (cond ((numberp index) (1+ index))
4029 ((not number-control) (allout-sibling-index)))) 4035 ((not number-control) (allout-sibling-index))))
4030 (if (allout-numbered-type-prefix) 4036 (if (allout-numbered-type-prefix)
4031 (allout-rebullet-heading nil ;;; solicit 4037 (allout-rebullet-heading nil ;;; instead
4032 new-depth ;;; new-depth 4038 new-depth ;;; new-depth
4033 number-control;;; number-control 4039 number-control;;; number-control
4034 index ;;; index 4040 index ;;; index
@@ -4145,7 +4151,7 @@ a topic and its immediate offspring is greater than one.)"
4145 (when (< relative-depth 0) 4151 (when (< relative-depth 0)
4146 (save-excursion 4152 (save-excursion
4147 (goto-char local-point) 4153 (goto-char local-point)
4148 (allout-rebullet-heading nil ;;; solicit 4154 (allout-rebullet-heading nil ;;; instead
4149 (+ starting-depth relative-depth) 4155 (+ starting-depth relative-depth)
4150 nil ;;; number 4156 nil ;;; number
4151 starting-index 4157 starting-index
@@ -4203,7 +4209,7 @@ Returns final depth."
4203 ; Prime ascender for ascension: 4209 ; Prime ascender for ascension:
4204 (setq ascender (1- allout-recent-depth)) 4210 (setq ascender (1- allout-recent-depth))
4205 (if (>= allout-recent-depth depth) 4211 (if (>= allout-recent-depth depth)
4206 (allout-rebullet-heading nil ;;; solicit 4212 (allout-rebullet-heading nil ;;; instead
4207 nil ;;; depth 4213 nil ;;; depth
4208 nil ;;; number-control 4214 nil ;;; number-control
4209 nil ;;; index 4215 nil ;;; index
@@ -4230,7 +4236,7 @@ rebulleting each topic at this level."
4230 (use-bullet (equal '(16) denumber)) 4236 (use-bullet (equal '(16) denumber))
4231 (more t)) 4237 (more t))
4232 (while more 4238 (while more
4233 (allout-rebullet-heading use-bullet ;;; solicit 4239 (allout-rebullet-heading use-bullet ;;; instead
4234 depth ;;; depth 4240 depth ;;; depth
4235 t ;;; number-control 4241 t ;;; number-control
4236 index ;;; index 4242 index ;;; index
@@ -4577,32 +4583,20 @@ however, are left exactly like normal, non-allout-specific yanks."
4577 (progn (widen) 4583 (progn (widen)
4578 (forward-char -1) 4584 (forward-char -1)
4579 (narrow-to-region subj-beg (point)))))) 4585 (narrow-to-region subj-beg (point))))))
4580 ;; Preserve new bullet if it's a distinctive one, otherwise 4586 ;; Remove new heading prefix:
4581 ;; use old one: 4587 (allout-unprotected
4582 (if (string-match (regexp-quote prefix-bullet) 4588 (progn
4583 allout-distinctive-bullets-string) 4589 (delete-region (point) (+ (point)
4584 ; Delete from bullet of old to 4590 prefix-len
4585 ; before bullet of new: 4591 (- adjust-to-depth
4586 (progn 4592 subj-depth)))
4587 (beginning-of-line)
4588 (allout-unprotected
4589 (delete-region (point) subj-beg))
4590 (set-marker (allout-mark-marker t) subj-end)
4591 (goto-char subj-beg)
4592 (allout-end-of-prefix))
4593 ; Delete base subj prefix,
4594 ; leaving old one:
4595 (allout-unprotected
4596 (progn
4597 (delete-region (point) (+ (point)
4598 prefix-len
4599 (- adjust-to-depth
4600 subj-depth)))
4601 ; and delete residual subj 4593 ; and delete residual subj
4602 ; prefix digits and space: 4594 ; prefix digits and space:
4603 (while (looking-at "[0-9]") (delete-char 1)) 4595 (while (looking-at "[0-9]") (delete-char 1))
4604 (if (looking-at " ") 4596 (if (looking-at " ")
4605 (delete-char 1)))))) 4597 (delete-char 1))))
4598 ;; Assert new topic's bullet - minimal effort if unchanged:
4599 (allout-rebullet-heading prefix-bullet))
4606 (exchange-point-and-mark)))) 4600 (exchange-point-and-mark))))
4607 (if rectify-numbering 4601 (if rectify-numbering
4608 (progn 4602 (progn
@@ -4613,7 +4607,7 @@ however, are left exactly like normal, non-allout-specific yanks."
4613 (goto-char subj-beg) 4607 (goto-char subj-beg)
4614 (if (allout-goto-prefix-doublechecked) 4608 (if (allout-goto-prefix-doublechecked)
4615 (allout-unprotected 4609 (allout-unprotected
4616 (allout-rebullet-heading nil ;;; solicit 4610 (allout-rebullet-heading nil ;;; instead
4617 (allout-depth) ;;; depth 4611 (allout-depth) ;;; depth
4618 nil ;;; number-control 4612 nil ;;; number-control
4619 nil ;;; index 4613 nil ;;; index