diff options
| author | Ken Manheimer | 2011-03-09 15:48:56 -0500 |
|---|---|---|
| committer | Ken Manheimer | 2011-03-09 15:48:56 -0500 |
| commit | b6a5875b6a758190dfae68bbe3746914510c9462 (patch) | |
| tree | d8ff6e9a84188e4c9a5e2e8f001b751d9b964f85 | |
| parent | 5baee236626c096eb0eddbf5fc12193805db9525 (diff) | |
| download | emacs-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/ChangeLog | 11 | ||||
| -rw-r--r-- | lisp/allout.el | 92 |
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 @@ | |||
| 1 | 2011-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 | |||
| 1 | 2011-03-09 Michael Albinus <michael.albinus@gmx.de> | 12 | 2011-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. | |||
| 3492 | Third arg DEPTH forces the topic prefix to that depth, regardless of | 3492 | Third arg DEPTH forces the topic prefix to that depth, regardless of |
| 3493 | the current topics' depth. | 3493 | the current topics' depth. |
| 3494 | 3494 | ||
| 3495 | If SOLICIT is non-nil, then the choice of bullet is solicited from | 3495 | If INSTEAD is: |
| 3496 | user. If it's a character, then that character is offered as the | 3496 | |
| 3497 | default, otherwise the one suited to the context (according to | 3497 | - nil, then the bullet char for the context is used, per distinction or depth |
| 3498 | distinction or depth) is offered. (This overrides other options, | 3498 | - a string, then the first character of the string will be used |
| 3499 | including, 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 |
| 3500 | context-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 | ||
| 3503 | PRIOR-BULLET.) | ||
| 3501 | 3504 | ||
| 3502 | Fifth arg, NUMBER-CONTROL, matters only if `allout-numbered-bullet' | 3505 | Fifth arg, NUMBER-CONTROL, matters only if `allout-numbered-bullet' |
| 3503 | is non-nil *and* soliciting was not explicitly invoked. Then | 3506 | is non-nil *and* no specific INSTEAD was specified. Then |
| 3504 | NUMBER-CONTROL non-nil forces prefix to either numbered or | 3507 | NUMBER-CONTROL non-nil forces prefix to either numbered or |
| 3505 | denumbered format, depending on the value of the sixth arg, INDEX. | 3508 | denumbered 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 | ||
| 3943 | All args are optional. | 3949 | All args are optional. |
| 3944 | 3950 | ||
| 3945 | If SOLICIT is non-nil, then the choice of bullet is solicited from | 3951 | If INSTEAD is: |
| 3946 | user. 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 |
| 3947 | default, otherwise the one suited to the context (according to | 3953 | - a string, then the first character of the string will be used |
| 3948 | distinction or depth) is offered. If non-nil, then the | 3954 | - a character, then the user is solicited for bullet, with that char as default |
| 3949 | context-specific bullet is just used. | 3955 | - anything else, the user is solicited with bullet char per context as default |
| 3950 | 3956 | ||
| 3951 | Second arg DEPTH forces the topic prefix to that depth, regardless | 3957 | Second arg DEPTH forces the topic prefix to that depth, regardless |
| 3952 | of the topic's current depth. | 3958 | of 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 |