996 |
(message nil) |
(message nil) |
997 |
(or pass default "")))) |
(or pass default "")))) |
998 |
|
|
999 |
|
(defmacro atomic-change-group (&rest body) |
1000 |
|
"Perform BODY as an atomic change group. |
1001 |
|
This means that if BODY exits abnormally, |
1002 |
|
all of its changes to the current buffer are undone. |
1003 |
|
This works regadless of whether undo is enabled in the buffer. |
1004 |
|
|
1005 |
|
This mechanism is transparent to ordinary use of undo; |
1006 |
|
if undo is enabled in the buffer and BODY succeeds, the |
1007 |
|
user can undo the change normally." |
1008 |
|
(let ((handle (make-symbol "--change-group-handle--")) |
1009 |
|
(success (make-symbol "--change-group-success--"))) |
1010 |
|
`(let ((,handle (prepare-change-group)) |
1011 |
|
(,success nil)) |
1012 |
|
(unwind-protect |
1013 |
|
(progn |
1014 |
|
;; This is inside the unwind-protect because |
1015 |
|
;; it enables undo if that was disabled; we need |
1016 |
|
;; to make sure that it gets disabled again. |
1017 |
|
(activate-change-group ,handle) |
1018 |
|
,@body |
1019 |
|
(setq ,success t)) |
1020 |
|
;; Either of these functions will disable undo |
1021 |
|
;; if it was disabled before. |
1022 |
|
(if ,success |
1023 |
|
(accept-change-group ,handle) |
1024 |
|
(cancel-change-group ,handle)))))) |
1025 |
|
|
1026 |
|
(defun prepare-change-group (&optional buffer) |
1027 |
|
"Return a handle for the current buffer's state, for a change group. |
1028 |
|
If you specify BUFFER, make a handle for BUFFER's state instead. |
1029 |
|
|
1030 |
|
Pass the handle to `activate-change-group' afterward to initiate |
1031 |
|
the actual changes of the change group. |
1032 |
|
|
1033 |
|
To finish the change group, call either `accept-change-group' or |
1034 |
|
`cancel-change-group' passing the same handle as argument. Call |
1035 |
|
`accept-change-group' to accept the changes in the group as final; |
1036 |
|
call `cancel-change-group' to undo them all. You should use |
1037 |
|
`unwind-protect' to make sure the group is always finished. The call |
1038 |
|
to `activate-change-group' should be inside the `unwind-protect'. |
1039 |
|
Once you finish the group, don't use the handle again--don't try to |
1040 |
|
finish the same group twice. For a simple example of correct use, see |
1041 |
|
the source code of `atomic-change-group'. |
1042 |
|
|
1043 |
|
The handle records only the specified buffer. To make a multibuffer |
1044 |
|
change group, call this function once for each buffer you want to |
1045 |
|
cover, then use `nconc' to combine the returned values, like this: |
1046 |
|
|
1047 |
|
(nconc (prepare-change-group buffer-1) |
1048 |
|
(prepare-change-group buffer-2)) |
1049 |
|
|
1050 |
|
You can then activate that multibuffer change group with a single |
1051 |
|
call to `activate-change-group' and finish it with a single call |
1052 |
|
to `accept-change-group' or `cancel-change-group'." |
1053 |
|
|
1054 |
|
(list (cons (current-buffer) buffer-undo-list))) |
1055 |
|
|
1056 |
|
(defun activate-change-group (handle) |
1057 |
|
"Activate a change group made with `prepare-change-group' (which see)." |
1058 |
|
(dolist (elt handle) |
1059 |
|
(with-current-buffer (car elt) |
1060 |
|
(if (eq buffer-undo-list t) |
1061 |
|
(setq buffer-undo-list nil))))) |
1062 |
|
|
1063 |
|
(defun accept-change-group (handle) |
1064 |
|
"Finish a change group made with `prepare-change-group' (which see). |
1065 |
|
This finishes the change group by accepting its changes as final." |
1066 |
|
(dolist (elt handle) |
1067 |
|
(with-current-buffer (car elt) |
1068 |
|
(if (eq elt t) |
1069 |
|
(setq buffer-undo-list t))))) |
1070 |
|
|
1071 |
|
(defun cancel-change-group (handle) |
1072 |
|
"Finish a change group made with `prepare-change-group' (which see). |
1073 |
|
This finishes the change group by reverting all of its changes." |
1074 |
|
(dolist (elt handle) |
1075 |
|
(with-current-buffer (car elt) |
1076 |
|
(setq elt (cdr elt)) |
1077 |
|
(let ((old-car |
1078 |
|
(if (consp elt) (car elt))) |
1079 |
|
(old-cdr |
1080 |
|
(if (consp elt) (cdr elt)))) |
1081 |
|
;; Temporarily truncate the undo log at ELT. |
1082 |
|
(when (consp elt) |
1083 |
|
(setcar elt nil) (setcdr elt nil)) |
1084 |
|
(unless (eq last-command 'undo) (undo-start)) |
1085 |
|
;; Make sure there's no confusion. |
1086 |
|
(when (and (consp elt) (not (eq elt (last pending-undo-list)))) |
1087 |
|
(error "Undoing to some unrelated state")) |
1088 |
|
;; Undo it all. |
1089 |
|
(while pending-undo-list (undo-more 1)) |
1090 |
|
;; Reset the modified cons cell ELT to its original content. |
1091 |
|
(when (consp elt) |
1092 |
|
(setcar elt old-car) |
1093 |
|
(setcdr elt old-cdr)) |
1094 |
|
;; Revert the undo info to what it was when we grabbed the state. |
1095 |
|
(setq buffer-undo-list elt))))) |
1096 |
|
|
1097 |
(defun force-mode-line-update (&optional all) |
(defun force-mode-line-update (&optional all) |
1098 |
"Force the mode-line of the current buffer to be redisplayed. |
"Force the mode-line of the current buffer to be redisplayed. |
1099 |
With optional non-nil ALL, force redisplay of all mode-lines." |
With optional non-nil ALL, force redisplay of all mode-lines." |
1805 |
included in the mode-line minor mode menu. |
included in the mode-line minor mode menu. |
1806 |
If TOGGLE has a `:menu-tag', that is used for the menu item's label." |
If TOGGLE has a `:menu-tag', that is used for the menu item's label." |
1807 |
(unless toggle-fun (setq toggle-fun toggle)) |
(unless toggle-fun (setq toggle-fun toggle)) |
|
;; Add the toggle to the minor-modes menu if requested. |
|
|
(when (get toggle :included) |
|
|
(define-key mode-line-mode-menu |
|
|
(vector toggle) |
|
|
(list 'menu-item |
|
|
(or (get toggle :menu-tag) |
|
|
(if (stringp name) name (symbol-name toggle))) |
|
|
toggle-fun |
|
|
:button (cons :toggle toggle)))) |
|
1808 |
;; Add the name to the minor-mode-alist. |
;; Add the name to the minor-mode-alist. |
1809 |
(when name |
(when name |
1810 |
(let ((existing (assq toggle minor-mode-alist))) |
(let ((existing (assq toggle minor-mode-alist))) |
1826 |
(nconc found (list (list toggle name)) rest)) |
(nconc found (list (list toggle name)) rest)) |
1827 |
(setq minor-mode-alist (cons (list toggle name) |
(setq minor-mode-alist (cons (list toggle name) |
1828 |
minor-mode-alist))))))) |
minor-mode-alist))))))) |
1829 |
|
;; Add the toggle to the minor-modes menu if requested. |
1830 |
|
(when (get toggle :included) |
1831 |
|
(define-key mode-line-mode-menu |
1832 |
|
(vector toggle) |
1833 |
|
(list 'menu-item |
1834 |
|
(concat |
1835 |
|
(or (get toggle :menu-tag) |
1836 |
|
(if (stringp name) name (symbol-name toggle))) |
1837 |
|
(let ((mode-name (if (stringp name) name |
1838 |
|
(if (symbolp name) (symbol-value name))))) |
1839 |
|
(if mode-name |
1840 |
|
(concat " (" mode-name ")")))) |
1841 |
|
toggle-fun |
1842 |
|
:button (cons :toggle toggle)))) |
1843 |
|
|
1844 |
;; Add the map to the minor-mode-map-alist. |
;; Add the map to the minor-mode-map-alist. |
1845 |
(when keymap |
(when keymap |
1846 |
(let ((existing (assq toggle minor-mode-map-alist))) |
(let ((existing (assq toggle minor-mode-map-alist))) |