Mercurial > hg > xemacs-beta
annotate lisp/undo-stack.el @ 5773:94a6b8fbd56e
Use a face, show more context around open parenthesis, #'blink-matching-open
lisp/ChangeLog addition:
2013-12-17 Aidan Kehoe <kehoea@parhasard.net>
* simple.el (blink-matching-open):
When showing the opening parenthesis in the minibiffer, use the
isearch face for it, in case there are multiple parentheses in the
text shown.
When writing moderately involved macros, it's often not enough
just to show the backquote context before the parenthesis
(e.g. @,.`). Skip over that when searching for useful context in
the same way we skip over space and tab.
* simple.el (message):
* simple.el (lmessage):
If there are no ARGS, don't call #'format. This allows extent
information to be passed through to the minibuffer.
It's probably better still to update #'format to preserve extent
info.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Tue, 17 Dec 2013 20:49:52 +0200 |
| parents | 308d34e9f07d |
| children |
| rev | line source |
|---|---|
| 428 | 1 ;;; undo-stack.el --- An "undoable stack" object. |
| 2 | |
| 3 ;; Copyright (C) 1997 Free Software Foundation, Inc. | |
| 4 ;; Copyright (C) 1996 Ben Wing. | |
| 5 | |
| 6 ;; Maintainer: XEmacs Development Team | |
| 7 ;; Keywords: extensions, dumped | |
| 8 | |
| 9 ;; This file is part of XEmacs. | |
| 10 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
428
diff
changeset
|
11 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
428
diff
changeset
|
12 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
428
diff
changeset
|
13 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
428
diff
changeset
|
14 ;; option) any later version. |
| 428 | 15 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
428
diff
changeset
|
16 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
428
diff
changeset
|
17 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
428
diff
changeset
|
18 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
428
diff
changeset
|
19 ;; for more details. |
| 428 | 20 |
| 21 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
428
diff
changeset
|
22 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 23 |
| 24 ;;; Synched up with: Not in FSF. | |
| 25 | |
| 26 ;;; Commentary: | |
| 27 | |
| 28 ;; This file is dumped with XEmacs. | |
| 29 | |
| 30 ;; An "undoable stack" is an object that can be used to implement | |
| 31 ;; a history of positions, with undo and redo. Conceptually, it | |
| 32 ;; is the kind of data structure used to keep track of (e.g.) | |
| 33 ;; visited Web pages, so that the "Back" and "Forward" operations | |
| 34 ;; in the browser work. Basically, I can successively visit a | |
| 35 ;; number of Web pages through links, and then hit "Back" a | |
| 36 ;; few times to go to previous positions, and then "Forward" a | |
| 37 ;; few times to reverse this process. This is similar to an | |
| 38 ;; "undo" and "redo" mechanism. | |
| 39 | |
| 40 ;; Note that Emacs does not standardly contain structures like | |
| 41 ;; this. Instead, it implements history using either a ring | |
| 42 ;; (the kill ring, the mark ring), or something like the undo | |
| 43 ;; stack, where successive "undo" operations get recorded as | |
| 44 ;; normal modifications, so that if you do a bunch of successive | |
| 45 ;; undo's, then something else, then start undoing, you will | |
| 46 ;; be redoing all your undo's back to the point before you did | |
| 47 ;; the undo's, and then further undo's will act like the previous | |
| 48 ;; round of undo's. I think that both of these paradigms are | |
| 49 ;; inferior to the "undoable-stack" paradigm because they're | |
| 50 ;; confusing and difficult to keep track of. | |
| 51 | |
| 52 ;; Conceptually, imagine a position history like this: | |
| 53 | |
| 54 ;; 1 -> 2 -> 3 -> 4 -> 5 -> 6 | |
| 55 ;; ^^ | |
| 56 | |
| 57 ;; where the arrow indicates where you currently are. "Going back" | |
| 58 ;; and "going forward" just amount to moving the arrow. However, | |
| 59 ;; what happens if the history state is this: | |
| 60 | |
| 61 ;; 1 -> 2 -> 3 -> 4 -> 5 -> 6 | |
| 62 ;; ^^ | |
| 63 | |
| 64 ;; and then I visit new positions (7) and (8)? In the most general | |
| 65 ;; implementation, you've just caused a new branch like this: | |
| 66 | |
| 67 ;; 1 -> 2 -> 3 -> 4 -> 5 -> 6 | |
| 68 ;; | | |
| 69 ;; | | |
| 70 ;; 7 -> 8 | |
| 71 ;; ^^ | |
| 72 | |
| 73 ;; But then you can end up with a whole big tree, and you need | |
| 74 ;; more sophisticated ways of navigating ("Forward" might involve | |
| 75 ;; a choice of paths to follow) and managing its size (if you don't | |
| 76 ;; want to keep unlimited history, you have to truncate at some point, | |
| 77 ;; and how do you truncate a tree?) | |
| 78 | |
| 79 ;; My solution to this is just to insert the new positions like | |
| 80 ;; this: | |
| 81 | |
| 82 ;; 1 -> 2 -> 3 -> 4 -> 7 -> 8 -> 5 -> 6 | |
| 83 ;; ^^ | |
| 84 | |
| 85 ;; (Netscape, I think, would just truncate 5 and 6 completely, | |
| 86 ;; but that seems a bit drastic. In the Emacs-standard "ring" | |
| 87 ;; structure, this problem is avoided by simply moving 5 and 6 | |
| 88 ;; to the beginning of the ring. However, it doesn't seem | |
| 89 ;; logical to me to have "going back past 1" get you to 6.) | |
| 90 | |
| 91 ;; Now what if we have a "maximum" size of (say) 7 elements? | |
| 92 ;; When we add 8, we could truncate either 1 or 6. Since 5 and | |
| 93 ;; 6 are "undone" positions, we should presumably truncate | |
| 94 ;; them before 1. So, adding 8 truncates 6, adding 9 truncates | |
| 95 ;; 5, and adding 10 truncates 1 because there is nothing more | |
| 96 ;; that is forward of the insertion point. | |
| 97 | |
| 98 ;; Interestingly, this method of truncation is almost like | |
| 99 ;; how a ring would truncate. A ring would move 5 and 6 | |
| 100 ;; around to the back, like this: | |
| 101 | |
| 102 ;; 5 -> 6 -> 1 -> 2 -> 3 -> 4 -> 7 -> 8 | |
| 103 ;; ^^ | |
| 104 | |
| 105 ;; However, when 8 is added, the ring truncates 5 instead of | |
| 106 ;; 6, which is less than optimal. | |
| 107 | |
| 108 ;; Conceptually, we can implement the "undoable stack" using | |
| 109 ;; two stacks of a sort called "truncatable stack", which are | |
| 110 ;; just simple stacks, but where you can truncate elements | |
| 111 ;; off of the bottom of the stack. Then, the undoable stack | |
| 112 | |
| 113 ;; 1 -> 2 -> 3 -> 4 -> 5 -> 6 | |
| 114 ;; ^^ | |
| 115 | |
| 116 ;; is equivalent to two truncatable stacks: | |
| 117 | |
| 118 ;; 4 <- 3 <- 2 <- 1 | |
| 119 ;; 5 <- 6 | |
| 120 | |
| 121 ;; where I reversed the direction to accord with the probable | |
| 122 ;; implementation of a standard list. To do another undo, | |
| 123 ;; I pop 4 off of the first stack and move it to the top of | |
| 124 ;; the second stack. A redo operation does the opposite. | |
| 125 ;; To truncate to the proper size, first chop off 6, then 5, | |
| 126 ;; then 1 -- in all cases, truncating off the bottom. | |
| 127 | |
| 128 ;;; Code: | |
| 129 | |
| 130 (define-error 'trunc-stack-bottom "Bottom of stack reached") | |
| 131 | |
| 132 (defsubst trunc-stack-stack (stack) | |
| 133 ;; return the list representing the trunc-stack's elements. | |
| 134 ;; the head of the list is the most recent element. | |
| 135 (aref stack 1)) | |
| 136 | |
| 137 (defsubst trunc-stack-length (stack) | |
| 138 ;; return the number of elements in the trunc-stack. | |
| 139 (aref stack 2)) | |
| 140 | |
| 141 (defsubst set-trunc-stack-stack (stack new) | |
| 142 ;; set the list representing the trunc-stack's elements. | |
| 143 (aset stack 1 new)) | |
| 144 | |
| 145 (defsubst set-trunc-stack-length (stack new) | |
| 146 ;; set the length of the trunc-stack. | |
| 147 (aset stack 2 new)) | |
| 148 | |
| 149 ;; public functions: | |
| 150 | |
| 151 (defun make-trunc-stack () | |
| 152 ;; make an empty trunc-stack. | |
| 153 (vector 'trunc-stack nil 0)) | |
| 154 | |
| 155 (defun trunc-stack-push (stack el) | |
| 156 ;; push a new element onto the head of the trunc-stack. | |
| 157 (set-trunc-stack-stack stack (cons el (trunc-stack-stack stack))) | |
| 158 (set-trunc-stack-length stack (1+ (trunc-stack-length stack)))) | |
| 159 | |
| 160 (defun trunc-stack-top (stack &optional n) | |
| 161 ;; return the nth topmost element from the trunc-stack. | |
| 162 ;; signal an error if the stack doesn't have that many elements. | |
| 163 (or n (setq n 0)) | |
| 164 (if (>= n (trunc-stack-length stack)) | |
| 165 (signal-error 'trunc-stack-bottom (list stack)) | |
| 166 (nth n (trunc-stack-stack stack)))) | |
| 167 | |
| 168 (defun trunc-stack-pop (stack) | |
| 169 ;; pop and return the topmost element from the stack. | |
| 170 (prog1 (trunc-stack-top stack) | |
| 171 (set-trunc-stack-stack stack (cdr (trunc-stack-stack stack))) | |
| 172 (set-trunc-stack-length stack (1- (trunc-stack-length stack))))) | |
| 173 | |
| 174 (defun trunc-stack-truncate (stack &optional n) | |
| 175 ;; truncate N items off the bottom of the stack. If the stack is | |
| 176 ;; not that big, it just becomes empty. | |
| 177 (or n (setq n 1)) | |
| 178 (if (> n 0) | |
| 179 (let ((len (trunc-stack-length stack))) | |
| 180 (if (>= n len) | |
| 181 (progn | |
| 182 (set-trunc-stack-length stack 0) | |
| 183 (set-trunc-stack-stack stack nil)) | |
| 184 (setcdr (nthcdr (1- (- len n)) (trunc-stack-stack stack)) nil) | |
| 185 (set-trunc-stack-length stack (- len n)))))) | |
| 186 | |
| 187 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 188 | |
| 189 ;;; FMH! FMH! FMH! This object-oriented stuff doesn't really work | |
| 190 ;;; properly without built-in structures (vectors suck) and without | |
| 191 ;;; public and private functions and fields. | |
| 192 | |
| 193 (defsubst undoable-stack-max (stack) | |
| 194 (aref stack 1)) | |
| 195 | |
| 196 (defsubst undoable-stack-a (stack) | |
| 197 (aref stack 2)) | |
| 198 | |
| 199 (defsubst undoable-stack-b (stack) | |
| 200 (aref stack 3)) | |
| 201 | |
| 202 ;; public functions: | |
| 203 | |
| 204 (defun make-undoable-stack (max) | |
| 205 ;; make an empty undoable stack of max size MAX. | |
| 206 (vector 'undoable-stack max (make-trunc-stack) (make-trunc-stack))) | |
| 207 | |
| 208 (defsubst set-undoable-stack-max (stack new) | |
| 209 ;; change the max size of an undoable stack. | |
| 210 (aset stack 1 new)) | |
| 211 | |
| 212 (defun undoable-stack-a-top (stack) | |
| 213 ;; return the topmost element off the "A" stack of an undoable stack. | |
| 214 ;; this is the most recent position pushed on the undoable stack. | |
| 215 (trunc-stack-top (undoable-stack-a stack))) | |
| 216 | |
| 217 (defun undoable-stack-a-length (stack) | |
| 218 (trunc-stack-length (undoable-stack-a stack))) | |
| 219 | |
| 220 (defun undoable-stack-b-top (stack) | |
| 221 ;; return the topmost element off the "B" stack of an undoable stack. | |
| 222 ;; this is the position that will become the most recent position, | |
| 223 ;; after a redo operation. | |
| 224 (trunc-stack-top (undoable-stack-b stack))) | |
| 225 | |
| 226 (defun undoable-stack-b-length (stack) | |
| 227 (trunc-stack-length (undoable-stack-b stack))) | |
| 228 | |
| 229 (defun undoable-stack-push (stack el) | |
| 230 ;; push an element onto the stack. | |
| 231 (let* | |
| 232 ((lena (trunc-stack-length (undoable-stack-a stack))) | |
| 233 (lenb (trunc-stack-length (undoable-stack-b stack))) | |
| 234 (max (undoable-stack-max stack)) | |
| 235 (len (+ lena lenb))) | |
| 236 ;; maybe truncate some elements. We have to deal with the | |
| 237 ;; possibility that we have more elements than our max | |
| 238 ;; (someone might have reduced the max). | |
| 239 (if (>= len max) | |
| 240 (let ((must-nuke (1+ (- len max)))) | |
| 241 ;; chop off must-nuke elements from the B stack. | |
| 242 (trunc-stack-truncate (undoable-stack-b stack) must-nuke) | |
| 243 ;; but if there weren't that many elements to chop, | |
| 244 ;; take the rest off the A stack. | |
| 245 (if (< lenb must-nuke) | |
| 246 (trunc-stack-truncate (undoable-stack-a stack) | |
| 247 (- must-nuke lenb))))) | |
| 248 (trunc-stack-push (undoable-stack-a stack) el))) | |
| 249 | |
| 250 (defun undoable-stack-pop (stack) | |
| 251 ;; pop an element off the stack. | |
| 252 (trunc-stack-pop (undoable-stack-a stack))) | |
| 253 | |
| 254 (defun undoable-stack-undo (stack) | |
| 255 ;; transfer an element from the top of A to the top of B. | |
| 256 ;; return value is undefined. | |
| 257 (trunc-stack-push (undoable-stack-b stack) | |
| 258 (trunc-stack-pop (undoable-stack-a stack)))) | |
| 259 | |
| 260 (defun undoable-stack-redo (stack) | |
| 261 ;; transfer an element from the top of B to the top of A. | |
| 262 ;; return value is undefined. | |
| 263 (trunc-stack-push (undoable-stack-a stack) | |
| 264 (trunc-stack-pop (undoable-stack-b stack)))) | |
| 265 | |
| 266 | |
| 267 ;;; undo-stack.el ends here |