Mercurial > emacs

comparison lisp/emulation/viper-ex.el @ 36857:f6386773ce30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
2001-03-17 Michael Kifer <kifer@cs.sunysb.edu> * ediff-util.el: Copyright years. (ediff-choose-syntax-table): New function. (ediff-setup): Use ediff-choose-syntax-table. * ediff-init.el (ediff-with-syntax-table): New macro, uses with-syntax-table. * ediff.el: Date of last update, copyright years. * ediff-wind (ediff-setup-control-frame): Nill->nil. * viper-ex.el (ex-token-list,ex-cmd-execute): Revamped, courtesy of Scott Bronson. (ex-cmd-assoc,ex-cmd-one-letr): New functions. (viper-check-sub,viper-get-ex-command,viper-execute-ex-command): Deleted functions. (viper-get-ex-com-subr,viper-ex,ex-mark): Changed to use the new ex-token-list. * viper-util.el: Spaces, indentation. * viper.el: Changed version, modification time.
author Michael Kifer <kifer@cs.stonybrook.edu>
date Sat, 17 Mar 2001 18:59:39 +0000
parents f5af79327a46
children 67b464da13ec
comparison
equal deleted inserted replaced
36856:e11fd97820c0 36857:f6386773ce30
64 (defconst viper-ex-work-buf-name " *ex-working-space*") 64 (defconst viper-ex-work-buf-name " *ex-working-space*")
65 (defconst viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name)) 65 (defconst viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
66 (defconst viper-ex-tmp-buf-name " *ex-tmp*") 66 (defconst viper-ex-tmp-buf-name " *ex-tmp*")
67 67
68 68
69 ;;; Variable completion in :set command 69 ;;; ex-commands...
70 70
71 ;; The list of Ex commands. Used for completing command names. 71 (defun ex-cmd-obsolete (name)
72 (defconst ex-token-alist 72 (error "`%s': Obsolete command, not supported by Viper" name))
73 '(("!") ("=") (">") ("&") ("~") 73
74 ("yank") ("xit") ("WWrite") ("Write") ("write") ("wq") ("visual") 74 (defun ex-cmd-not-yet (name)
75 ("version") ("vglobal") ("unmap") ("undo") ("tag") ("transfer") ("suspend") 75 (error "`%s': Command not implemented in Viper" name))
76 ("substitute") ("submitReport") ("stop") ("sr") ("source") ("shell") 76
77 ("set") ("rewind") ("recover") ("read") ("quit") ("pwd") 77 ;; alist entries: name (in any order), command, cont(??)
78 ("put") ("preserve") ("PreviousRelatedFile") ("RelatedFile") 78 ;; If command is a string, then that is an alias to the real command
79 ("next") ("Next") ("move") ("mark") ("map") ("kmark") ("join") 79 ;; to execute (for instance, ":m" -> ":move").
80 ("help") ("goto") ("global") ("file") ("edit") ("delete") ("customize") 80 ;; command attributes:
81 ("copy") ("chdir") ("cd") ("Buffer") ("buffer") ("args")) ) 81 ;; is-mashed: the command's args may be jammed right up against the command
82 ;; one-letter: this is a one-letter token. Any text appearing after
83 ;; the name gets appended as an argument for the command
84 ;; i.e. ":kabc" gets turned into (ex-mark "abc")
85 (defconst ex-token-alist '(
86 ("!" (ex-command))
87 ("&" (ex-substitute t))
88 ("=" (ex-line-no))
89 (">" (ex-line "right"))
90 ("<" (ex-line "left"))
91 ("Buffer" (if ex-cycle-other-window
92 (viper-switch-to-buffer)
93 (viper-switch-to-buffer-other-window)))
94 ("Next" (ex-next (not ex-cycle-other-window)))
95 ("PreviousRelatedFile" (ex-next-related-buffer -1))
96 ("RelatedFile" (ex-next-related-buffer 1))
97 ("W" "Write")
98 ("WWrite" (save-some-buffers t))
99 ("Write" (save-some-buffers))
100 ("a" "append")
101 ("args" (ex-args))
102 ("buffer" (if ex-cycle-other-window
103 (viper-switch-to-buffer-other-window)
104 (viper-switch-to-buffer)))
105 ("c" "change")
106 ;; ch should be "change" but maintain old viper compatibility
107 ("ch" "chdir")
108 ("cd" (ex-cd))
109 ("chdir" (ex-cd))
110 ("copy" (ex-copy nil))
111 ("customize" (customize-group "viper"))
112 ("delete" (ex-delete))
113 ("edit" (ex-edit))
114 ("file" (viper-info-on-file))
115 ("g" "global")
116 ("global" (ex-global nil) is-mashed)
117 ("goto" (ex-goto))
118 ("help" (ex-help))
119 ("join" (ex-line "join"))
120 ("k" (ex-mark) one-letter)
121 ("kmark" (ex-mark))
122 ("m" "move")
123 ; old viper doesn't specify a default for "ma" so leave it undefined
124 ("map" (ex-map))
125 ("mark" (ex-mark))
126 ("move" (ex-copy t))
127 ("next" (ex-next ex-cycle-other-window))
128 ("p" "print")
129 ("preserve" (ex-preserve))
130 ("put" (ex-put))
131 ("pwd" (ex-pwd))
132 ("quit" (ex-quit))
133 ("r" "read")
134 ("re" "read")
135 ("read" (ex-read))
136 ("recover" (ex-recover))
137 ("rewind" (ex-rewind))
138 ("s" "substitute")
139 ("su" "substitute")
140 ("sub" "substitute")
141 ("set" (ex-set))
142 ("shell" (ex-shell))
143 ("source" (ex-source))
144 ("stop" (suspend-emacs))
145 ("sr" (ex-substitute t t))
146 ("submitReport" (viper-submit-report))
147 ("substitute" (ex-substitute) is-mashed)
148 ("suspend" (suspend-emacs))
149 ("t" "transfer")
150 ("tag" (ex-tag))
151 ("transfer" (ex-copy nil))
152 ("u" "undo")
153 ("un" "undo")
154 ("undo" (viper-undo))
155 ("unmap" (ex-unmap))
156 ("v" "vglobal")
157 ("version" (viper-version))
158 ("vglobal" (ex-global t) is-mashed)
159 ("visual" (ex-edit))
160 ("w" "write")
161 ("wq" (ex-write t))
162 ("write" (ex-write nil))
163 ("xit" (ex-write t))
164 ("yank" (ex-yank))
165 ("~" (ex-substitute t t))
166
167 ("append" (ex-cmd-obsolete "append"))
168 ("change" (ex-cmd-obsolete "change"))
169 ("insert" (ex-cmd-obsolete "insert"))
170 ("open" (ex-cmd-obsolete "open"))
171
172 ("list" (ex-cmd-not-yet "list"))
173 ("print" (ex-cmd-not-yet "print"))
174 ("z" (ex-cmd-not-yet "z"))
175 ("#" (ex-cmd-not-yet "#"))
176
177 ("abbreviate" (error "`%s': Vi abbreviations are obsolete. Use the more powerful Emacs abbrevs" ex-token))
178 ("unabbreviate" (error "`%s': Vi abbreviations are obsolete. Use the more powerful Emacs abbrevs" ex-token))
179 ))
180
181 ;; No code should touch anything in the alist entry! (other than the name,
182 ;; "car entry", of course) This way, changing this data structure
183 ;; requires changing only the following ex-cmd functions...
184
185 ;; Returns cmd if the command may be jammed right up against its
186 ;; arguments, nil if there must be a space.
187 ;; examples of mashable commands: g// g!// v// s// sno// sm//
188 (defun ex-cmd-is-mashed-with-args (cmd)
189 (if (eq 'is-mashed (car (nthcdr 2 cmd))) cmd))
190
191 ;; Returns true if this is a one-letter command that may be followed
192 ;; by anything, no whitespace needed. This is a special-case for ":k".
193 (defun ex-cmd-is-one-letter (cmd)
194 (if (eq 'one-letter (car (nthcdr 2 cmd))) cmd))
195
196 ;; Executes the function associated with the command
197 (defun ex-cmd-execute (cmd)
198 (eval (cadr cmd)))
199
200 ;; If this is a one-letter magic command, splice in args.
201 (defun ex-splice-args-in-1-letr-cmd (key list)
202 (let ((onelet (ex-cmd-is-one-letter (assoc (substring key 0 1) list))))
203 (if onelet
204 (list key
205 (append (cadr onelet)
206 (if (< 1 (length key)) (list (substring key 1))))
207 (caddr onelet)))
208 ))
209
210
211 ;; Returns the alist entry for the appropriate key.
212 ;; Tries to complete the key before using it in the alist.
213 ;; If there is no appropriate key (no match or duplicate matches) return nil
214 (defun ex-cmd-assoc (key list)
215 (let ((entry (try-completion key list))
216 result onelet)
217 (setq result (cond
218 ((eq entry t) (assoc key list))
219 ((stringp entry) (or (ex-splice-args-in-1-letr-cmd key list)
220 (assoc entry list)))
221 ((eq entry nil) (ex-splice-args-in-1-letr-cmd key list))
222 (t nil)
223 ))
224 ;; If we end up with an alias, look up the alias...
225 (if (stringp (cadr result))
226 (setq result (ex-cmd-assoc (cadr result) list)))
227 ;; and return the corresponding alist entry
228 result
229 ))
230
82 231
83 ;; A-list of Ex variables that can be set using the :set command. 232 ;; A-list of Ex variables that can be set using the :set command.
84 (defconst ex-variable-alist 233 (defconst ex-variable-alist
85 '(("wrapscan") ("ws") ("wrapmargin") ("wm") 234 '(("wrapscan") ("ws") ("wrapmargin") ("wm")
86 ("tabstop-global") ("ts-g") ("tabstop") ("ts") 235 ("tabstop-global") ("ts-g") ("tabstop") ("ts")
231 380
232 ;; Remembers the last ex-command prompt. 381 ;; Remembers the last ex-command prompt.
233 (defvar viper-last-ex-prompt "") 382 (defvar viper-last-ex-prompt "")
234 383
235 384
236 ;;; Code
237
238 ;; Check if ex-token is an initial segment of STR
239 (defun viper-check-sub (str)
240 (let ((length (length ex-token)))
241 (if (and (<= length (length str))
242 (string= ex-token (substring str 0 length)))
243 (setq ex-token str)
244 (setq ex-token-type 'non-command))))
245
246 ;; Get a complete ex command 385 ;; Get a complete ex command
247 (defun viper-get-ex-com-subr () 386 (defun viper-get-ex-com-subr ()
248 (let (case-fold-search) 387 (let (cmd case-fold-search)
249 (set-mark (point)) 388 (set-mark (point))
250 (re-search-forward "[a-zA-Z][a-zA-Z]*") 389 (re-search-forward "[a-zA-Z][a-zA-Z]*")
251 (setq ex-token-type 'command) 390 (setq ex-token-type 'command)
252 (setq ex-token (buffer-substring (point) (mark t))) 391 (setq ex-token (buffer-substring (point) (mark t)))
253 (exchange-point-and-mark) 392 (setq cmd (ex-cmd-assoc ex-token ex-token-alist))
254 (cond ((looking-at "a") 393 (if cmd
255 (cond ((looking-at "ab") (viper-check-sub "abbreviate")) 394 (setq ex-token (car cmd))
256 ((looking-at "ar") (viper-check-sub "args")) 395 (setq ex-token-type 'non-command))
257 (t (viper-check-sub "append"))))
258 ((looking-at "h") (viper-check-sub "help"))
259 ((looking-at "c")
260 (cond ((looking-at "cd") (viper-check-sub "cd"))
261 ((looking-at "ch") (viper-check-sub "chdir"))
262 ((looking-at "co") (viper-check-sub "copy"))
263 ((looking-at "cu") (viper-check-sub "customize"))
264 (t (viper-check-sub "change"))))
265 ((looking-at "d") (viper-check-sub "delete"))
266 ((looking-at "b") (viper-check-sub "buffer"))
267 ((looking-at "B") (viper-check-sub "Buffer"))
268 ((looking-at "e")
269 (if (looking-at "ex") (viper-check-sub "ex")
270 (viper-check-sub "edit")))
271 ((looking-at "f") (viper-check-sub "file"))
272 ((looking-at "g") (viper-check-sub "global"))
273 ((looking-at "i") (viper-check-sub "insert"))
274 ((looking-at "j") (viper-check-sub "join"))
275 ((looking-at "l") (viper-check-sub "list"))
276 ((looking-at "m")
277 (cond ((looking-at "map") (viper-check-sub "map"))
278 ((looking-at "mar") (viper-check-sub "mark"))
279 (t (viper-check-sub "move"))))
280 ((looking-at "k[a-z][^a-z]")
281 (setq ex-token "kmark")
282 (forward-char 1)
283 (exchange-point-and-mark)) ; this is canceled out by another
284 ; exchange-point-and-mark at the end
285 ((looking-at "k") (viper-check-sub "kmark"))
286 ((looking-at "n") (if (looking-at "nu")
287 (viper-check-sub "number")
288 (viper-check-sub "next")))
289 ((looking-at "N") (viper-check-sub "Next"))
290 ((looking-at "o") (viper-check-sub "open"))
291 ((looking-at "p")
292 (cond ((looking-at "pre") (viper-check-sub "preserve"))
293 ((looking-at "pu") (viper-check-sub "put"))
294 ((looking-at "pw") (viper-check-sub "pwd"))
295 (t (viper-check-sub "print"))))
296 ((looking-at "P") (viper-check-sub "PreviousRelatedFile"))
297 ((looking-at "R") (viper-check-sub "RelatedFile"))
298 ((looking-at "q") (viper-check-sub "quit"))
299 ((looking-at "r")
300 (cond ((looking-at "rec") (viper-check-sub "recover"))
301 ((looking-at "rew") (viper-check-sub "rewind"))
302 (t (viper-check-sub "read"))))
303 ((looking-at "s")
304 (cond ((looking-at "se") (viper-check-sub "set"))
305 ((looking-at "sh") (viper-check-sub "shell"))
306 ((looking-at "so") (viper-check-sub "source"))
307 ((looking-at "sr") (viper-check-sub "sr"))
308 ((looking-at "st") (viper-check-sub "stop"))
309 ((looking-at "sus") (viper-check-sub "suspend"))
310 ((looking-at "subm") (viper-check-sub "submitReport"))
311 (t (viper-check-sub "substitute"))))
312 ((looking-at "t")
313 (if (looking-at "ta") (viper-check-sub "tag")
314 (viper-check-sub "transfer")))
315 ((looking-at "u")
316 (cond ((looking-at "una") (viper-check-sub "unabbreviate"))
317 ((looking-at "unm") (viper-check-sub "unmap"))
318 (t (viper-check-sub "undo"))))
319 ((looking-at "v")
320 (cond ((looking-at "ve") (viper-check-sub "version"))
321 ((looking-at "vi") (viper-check-sub "visual"))
322 (t (viper-check-sub "vglobal"))))
323 ((looking-at "w")
324 (if (looking-at "wq") (viper-check-sub "wq")
325 (viper-check-sub "write")))
326 ((looking-at "W")
327 (if (looking-at "WW")
328 (viper-check-sub "WWrite")
329 (viper-check-sub "Write")))
330 ((looking-at "x") (viper-check-sub "xit"))
331 ((looking-at "y") (viper-check-sub "yank"))
332 ((looking-at "z") (viper-check-sub "z")))
333 (exchange-point-and-mark)
334 )) 396 ))
335 397
336 ;; Get an ex-token which is either an address or a command. 398 ;; Get an ex-token which is either an address or a command.
337 ;; A token has a type, \(command, address, end-mark\), and a value 399 ;; A token has a type, \(command, address, end-mark\), and a value
338 (defun viper-get-ex-token () 400 (defun viper-get-ex-token ()
595 ex-addresses nil) 657 ex-addresses nil)
596 (while cont 658 (while cont
597 (viper-get-ex-token) 659 (viper-get-ex-token)
598 (cond ((memq ex-token-type '(command end-mark)) 660 (cond ((memq ex-token-type '(command end-mark))
599 (if address (setq ex-addresses (cons address ex-addresses))) 661 (if address (setq ex-addresses (cons address ex-addresses)))
600 (cond ((string= ex-token "global") 662 (viper-deactivate-mark)
601 (ex-global nil) 663 (let ((cmd (ex-cmd-assoc ex-token ex-token-alist)))
602 (setq cont nil)) 664 (if (null cmd)
603 ((string= ex-token "vglobal") 665 (error "`%s': %s" ex-token viper-BadExCommand))
604 (ex-global t) 666 (ex-cmd-execute cmd)
605 (setq cont nil)) 667 (if (or (ex-cmd-is-mashed-with-args cmd)
606 (t 668 (ex-cmd-is-one-letter cmd))
607 (viper-execute-ex-command) 669 (setq cont nil)
608 (save-excursion 670 (save-excursion
609 (save-window-excursion 671 (save-window-excursion
610 (setq viper-ex-work-buf 672 (setq viper-ex-work-buf
611 (get-buffer-create viper-ex-work-buf-name)) 673 (get-buffer-create viper-ex-work-buf-name))
612 (set-buffer viper-ex-work-buf) 674 (set-buffer viper-ex-work-buf)
613 (skip-chars-forward " \t") 675 (skip-chars-forward " \t")
614 (cond ((looking-at "|") 676 (cond ((looking-at "|")
615 (forward-char 1)) 677 (forward-char 1))
616 ((looking-at "\n") 678 ((looking-at "\n")
617 (setq cont nil)) 679 (setq cont nil))
618 (t (error 680 (t (error
619 "`%s': %s" ex-token viper-SpuriousText))) 681 "`%s': %s" ex-token viper-SpuriousText)))
620 ))) 682 )))
621 )) 683 ))
622 ((eq ex-token-type 'non-command) 684 ((eq ex-token-type 'non-command)
623 (error "`%s': %s" ex-token viper-BadExCommand)) 685 (error "`%s': %s" ex-token viper-BadExCommand))
624 ((eq ex-token-type 'whole) 686 ((eq ex-token-type 'whole)
625 (setq address nil) 687 (setq address nil)
626 (setq ex-addresses 688 (setq ex-addresses
698 (insert c) 760 (insert c)
699 (backward-char 1))) 761 (backward-char 1)))
700 ) 762 )
701 (setq ex-token nil)) 763 (setq ex-token nil))
702 c))) 764 c)))
703
704 ;; get an ex command
705 (defun viper-get-ex-command ()
706 (save-window-excursion
707 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
708 (set-buffer viper-ex-work-buf)
709 (if (looking-at "/") (forward-char 1))
710 (skip-chars-forward " \t")
711 (cond ((looking-at "[a-z]")
712 (viper-get-ex-com-subr)
713 (if (eq ex-token-type 'non-command)
714 (error "`%s': %s" ex-token viper-BadExCommand)))
715 ((looking-at "[!=><&~]")
716 (setq ex-token (char-to-string (following-char)))
717 (forward-char 1))
718 (t (error viper-BadExCommand)))))
719 765
720 ;; Get an Ex option g or c 766 ;; Get an Ex option g or c
721 (defun viper-get-ex-opt-gc (c) 767 (defun viper-get-ex-opt-gc (c)
722 (save-window-excursion 768 (save-window-excursion
723 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name)) 769 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
1065 (setq beg (1+ beg)) 1111 (setq beg (1+ beg))
1066 (setq viper-last-ex-prompt 1112 (setq viper-last-ex-prompt
1067 (concat viper-last-ex-prompt " !"))))) 1113 (concat viper-last-ex-prompt " !")))))
1068 (substring str (or beg 0) end))) 1114 (substring str (or beg 0) end)))
1069 1115
1070 ;; Execute ex command using the value of addresses
1071 (defun viper-execute-ex-command ()
1072 (viper-deactivate-mark)
1073 (cond ((string= ex-token "args") (ex-args))
1074 ((string= ex-token "copy") (ex-copy nil))
1075 ((string= ex-token "cd") (ex-cd))
1076 ((string= ex-token "customize") (customize-group "viper"))
1077 ((string= ex-token "chdir") (ex-cd))
1078 ((string= ex-token "delete") (ex-delete))
1079 ((string= ex-token "edit") (ex-edit))
1080 ((string= ex-token "file") (viper-info-on-file))
1081 ((string= ex-token "goto") (ex-goto))
1082 ((string= ex-token "help") (ex-help))
1083 ((string= ex-token "join") (ex-line "join"))
1084 ((string= ex-token "kmark") (ex-mark))
1085 ((string= ex-token "mark") (ex-mark))
1086 ((string= ex-token "map") (ex-map))
1087 ((string= ex-token "move") (ex-copy t))
1088 ((string= ex-token "next") (ex-next ex-cycle-other-window))
1089 ((string= ex-token "Next") (ex-next (not ex-cycle-other-window)))
1090 ((string= ex-token "RelatedFile") (ex-next-related-buffer 1))
1091 ((string= ex-token "put") (ex-put))
1092 ((string= ex-token "pwd") (ex-pwd))
1093 ((string= ex-token "preserve") (ex-preserve))
1094 ((string= ex-token "PreviousRelatedFile") (ex-next-related-buffer -1))
1095 ((string= ex-token "quit") (ex-quit))
1096 ((string= ex-token "read") (ex-read))
1097 ((string= ex-token "recover") (ex-recover))
1098 ((string= ex-token "rewind") (ex-rewind))
1099 ((string= ex-token "submitReport") (viper-submit-report))
1100 ((string= ex-token "set") (ex-set))
1101 ((string= ex-token "shell") (ex-shell))
1102 ((string= ex-token "source") (ex-source))
1103 ((string= ex-token "sr") (ex-substitute t t))
1104 ((string= ex-token "substitute") (ex-substitute))
1105 ((string= ex-token "suspend") (suspend-emacs))
1106 ((string= ex-token "stop") (suspend-emacs))
1107 ((string= ex-token "transfer") (ex-copy nil))
1108 ((string= ex-token "buffer") (if ex-cycle-other-window
1109 (viper-switch-to-buffer-other-window)
1110 (viper-switch-to-buffer)))
1111 ((string= ex-token "Buffer") (if ex-cycle-other-window
1112 (viper-switch-to-buffer)
1113 (viper-switch-to-buffer-other-window)))
1114 ((string= ex-token "tag") (ex-tag))
1115 ((string= ex-token "undo") (viper-undo))
1116 ((string= ex-token "unmap") (ex-unmap))
1117 ((string= ex-token "version") (viper-version))
1118 ((string= ex-token "visual") (ex-edit))
1119 ((string= ex-token "write") (ex-write nil))
1120 ((string= ex-token "Write") (save-some-buffers))
1121 ((string= ex-token "wq") (ex-write t))
1122 ((string= ex-token "WWrite") (save-some-buffers t)) ; don't ask
1123 ((string= ex-token "xit") (ex-write t))
1124 ((string= ex-token "yank") (ex-yank))
1125 ((string= ex-token "!") (ex-command))
1126 ((string= ex-token "=") (ex-line-no))
1127 ((string= ex-token ">") (ex-line "right"))
1128 ((string= ex-token "<") (ex-line "left"))
1129 ((string= ex-token "&") (ex-substitute t))
1130 ((string= ex-token "~") (ex-substitute t t))
1131 ((or (string= ex-token "append")
1132 (string= ex-token "change")
1133 (string= ex-token "insert")
1134 (string= ex-token "open"))
1135 (error "`%s': Obsolete command, not supported by Viper" ex-token))
1136 ((or (string= ex-token "abbreviate")
1137 (string= ex-token "unabbreviate"))
1138 (error
1139 "`%s': Vi abbrevs are obsolete. Use the more powerful Emacs abbrevs"
1140 ex-token))
1141 ((or (string= ex-token "list")
1142 (string= ex-token "print")
1143 (string= ex-token "z")
1144 (string= ex-token "#"))
1145 (error "`%s': Command not implemented in Viper" ex-token))
1146 (t (error "`%s': %s" ex-token viper-BadExCommand))))
1147 1116
1148 (defun viper-undisplayed-files () 1117 (defun viper-undisplayed-files ()
1149 (mapcar 1118 (mapcar
1150 (lambda (b) 1119 (lambda (b)
1151 (if (null (get-buffer-window b)) 1120 (if (null (get-buffer-window b))
1455 (end-of-line) 1424 (end-of-line)
1456 (viper-forward-char-carefully)))) 1425 (viper-forward-char-carefully))))
1457 1426
1458 1427
1459 ;; Ex mark command 1428 ;; Ex mark command
1460 (defun ex-mark () 1429 ;; Sets the mark to the current point.
1430 ;; If name is omitted, get the name straight from the work buffer."
1431 (defun ex-mark (&optional name)
1461 (let (char) 1432 (let (char)
1462 (if (null ex-addresses) 1433 (if (null ex-addresses)
1463 (setq ex-addresses 1434 (setq ex-addresses
1464 (cons (point) nil))) 1435 (cons (point) nil)))
1436 (if name
1437 (if (eq 1 (length name))
1438 (setq char (string-to-char name))
1439 (error "`%s': Spurious text \"%s\" after mark name."
1440 name (substring name 1) viper-SpuriousText))
1465 (save-window-excursion 1441 (save-window-excursion
1466 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name)) 1442 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
1467 (set-buffer viper-ex-work-buf) 1443 (set-buffer viper-ex-work-buf)
1468 (skip-chars-forward " \t") 1444 (skip-chars-forward " \t")
1469 (if (looking-at "[a-z]") 1445 (if (looking-at "[a-z]")
1471 (setq char (following-char)) 1447 (setq char (following-char))
1472 (forward-char 1) 1448 (forward-char 1)
1473 (skip-chars-forward " \t") 1449 (skip-chars-forward " \t")
1474 (if (not (looking-at "[\n|]")) 1450 (if (not (looking-at "[\n|]"))
1475 (error "`%s': %s" ex-token viper-SpuriousText))) 1451 (error "`%s': %s" ex-token viper-SpuriousText)))
1476 (error "`%s' requires a following letter" ex-token))) 1452 (error "`%s' requires a following letter" ex-token))))
1477 (save-excursion 1453 (save-excursion
1478 (goto-char (car ex-addresses)) 1454 (goto-char (car ex-addresses))
1479 (point-to-register (1+ (- char ?a)))))) 1455 (point-to-register (1+ (- char ?a))))))
1480 1456
1481 1457