Mercurial > hg > mercurial-crew-with-dirclash

comparison contrib/mercurial.el @ 4433:ba22e867cb23

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
mercurial.el: fix error on hg-read-rev() with small tip, and cleanups * Fix error if tip revision is smaller than hg-rev-completion-limit If tip revision is 10, "hg log -r -100:tip" fails. * Remove dependencies on cl package at runtime Quote from GNU Emacs Lisp Reference Manual, Emacs Lisp Coding Conventions: > * Please don't require the `cl' package of Common Lisp extensions at > run time. Use of this package is optional, and it is not part of > the standard Emacs namespace. If your package loads `cl' at run > time, that could cause name clashes for users who don't use that > package. * Check XEmacs at compile time Since byte-compiled file is not portable between GNU Emacs and XEmacs, checking type of emacs can be done at compile time. This reduces byte-compiler warnings. * Defvar variables binded dynamically and used across functions * Combine status output string to state symbol alist into a variable, and use char instead of string for key of state alist * Make hg-view-mode as minor-mode * Define keymaps as conventions
author NIIMI Satoshi <sa2c@sa2c.net>
date Mon, 07 May 2007 21:44:11 +0900
parents b008deae9910
children 3f484688c702
comparison
equal deleted inserted replaced
4432:905397be7688 4433:ba22e867cb23
41 ;; Please send problem reports and suggestions to bos@serpentine.com. 41 ;; Please send problem reports and suggestions to bos@serpentine.com.
42 42
43 43
44 ;;; Code: 44 ;;; Code:
45 45
46 (require 'advice) 46 (eval-when-compile (require 'cl))
47 (require 'cl)
48 (require 'diff-mode) 47 (require 'diff-mode)
49 (require 'easymenu) 48 (require 'easymenu)
50 (require 'executable) 49 (require 'executable)
51 (require 'vc) 50 (require 'vc)
52 51
52 (defmacro hg-feature-cond (&rest clauses)
53 "Test CLAUSES for feature at compile time.
54 Each clause is (FEATURE BODY...)."
55 (dolist (x clauses)
56 (let ((feature (car x))
57 (body (cdr x)))
58 (when (or (eq feature t)
59 (featurep feature))
60 (return (cons 'progn body))))))
61
53 62
54 ;;; XEmacs has view-less, while GNU Emacs has view. Joy. 63 ;;; XEmacs has view-less, while GNU Emacs has view. Joy.
55 64
56 (condition-case nil 65 (hg-feature-cond
57 (require 'view-less) 66 (xemacs (require 'view-less))
58 (error nil)) 67 (t (require 'view)))
59 (condition-case nil
60 (require 'view)
61 (error nil))
62 68
63 69
64 ;;; Variables accessible through the custom system. 70 ;;; Variables accessible through the custom system.
65 71
66 (defgroup mercurial nil 72 (defgroup mercurial nil
145 :group 'mercurial) 151 :group 'mercurial)
146 152
147 153
148 ;;; Other variables. 154 ;;; Other variables.
149 155
150 (defconst hg-running-xemacs (string-match "XEmacs" emacs-version)
151 "Is mercurial.el running under XEmacs?")
152
153 (defvar hg-mode nil 156 (defvar hg-mode nil
154 "Is this file managed by Mercurial?") 157 "Is this file managed by Mercurial?")
155 (make-variable-buffer-local 'hg-mode) 158 (make-variable-buffer-local 'hg-mode)
156 (put 'hg-mode 'permanent-local t) 159 (put 'hg-mode 'permanent-local t)
157 160
165 168
166 (defvar hg-root nil) 169 (defvar hg-root nil)
167 (make-variable-buffer-local 'hg-root) 170 (make-variable-buffer-local 'hg-root)
168 (put 'hg-root 'permanent-local t) 171 (put 'hg-root 'permanent-local t)
169 172
173 (defvar hg-view-mode nil)
174 (make-variable-buffer-local 'hg-view-mode)
175 (put 'hg-view-mode 'permanent-local t)
176
177 (defvar hg-view-file-name nil)
178 (make-variable-buffer-local 'hg-view-file-name)
179 (put 'hg-view-file-name 'permanent-local t)
180
170 (defvar hg-output-buffer-name "*Hg*" 181 (defvar hg-output-buffer-name "*Hg*"
171 "The name to use for Mercurial output buffers.") 182 "The name to use for Mercurial output buffers.")
172 183
173 (defvar hg-file-history nil) 184 (defvar hg-file-history nil)
174 (defvar hg-repo-history nil) 185 (defvar hg-repo-history nil)
175 (defvar hg-rev-history nil) 186 (defvar hg-rev-history nil)
187 (defvar hg-repo-completion-table nil) ; shut up warnings
176 188
177 189
178 ;;; Random constants. 190 ;;; Random constants.
179 191
180 (defconst hg-commit-message-start 192 (defconst hg-commit-message-start
181 "--- Enter your commit message. Type `C-c C-c' to commit. ---\n") 193 "--- Enter your commit message. Type `C-c C-c' to commit. ---\n")
182 194
183 (defconst hg-commit-message-end 195 (defconst hg-commit-message-end
184 "--- Files in bold will be committed. Click to toggle selection. ---\n") 196 "--- Files in bold will be committed. Click to toggle selection. ---\n")
185 197
198 (defconst hg-state-alist
199 '((?M . modified)
200 (?A . added)
201 (?R . removed)
202 (?! . deleted)
203 (?C . normal)
204 (?I . ignored)
205 (?? . nil)))
186 206
187 ;;; hg-mode keymap. 207 ;;; hg-mode keymap.
188 208
189 (defvar hg-mode-map (make-sparse-keymap))
190 (define-key hg-mode-map "\C-xv" 'hg-prefix-map)
191
192 (defvar hg-prefix-map 209 (defvar hg-prefix-map
193 (let ((map (copy-keymap vc-prefix-map))) 210 (let ((map (make-sparse-keymap)))
194 (if (functionp 'set-keymap-name) 211 (hg-feature-cond (xemacs (set-keymap-name map 'hg-prefix-map))) ; XEmacs
195 (set-keymap-name map 'hg-prefix-map)); XEmacs 212 (set-keymap-parent map vc-prefix-map)
213 (define-key map "=" 'hg-diff)
214 (define-key map "c" 'hg-undo)
215 (define-key map "g" 'hg-annotate)
216 (define-key map "i" 'hg-add)
217 (define-key map "l" 'hg-log)
218 (define-key map "n" 'hg-commit-start)
219 ;; (define-key map "r" 'hg-update)
220 (define-key map "u" 'hg-revert-buffer)
221 (define-key map "~" 'hg-version-other-window)
196 map) 222 map)
197 "This keymap overrides some default vc-mode bindings.") 223 "This keymap overrides some default vc-mode bindings.")
198 (fset 'hg-prefix-map hg-prefix-map) 224
199 (define-key hg-prefix-map "=" 'hg-diff) 225 (defvar hg-mode-map
200 (define-key hg-prefix-map "c" 'hg-undo) 226 (let ((map (make-sparse-keymap)))
201 (define-key hg-prefix-map "g" 'hg-annotate) 227 (define-key map "\C-xv" hg-prefix-map)
202 (define-key hg-prefix-map "l" 'hg-log) 228 map))
203 (define-key hg-prefix-map "n" 'hg-commit-start)
204 ;; (define-key hg-prefix-map "r" 'hg-update)
205 (define-key hg-prefix-map "u" 'hg-revert-buffer)
206 (define-key hg-prefix-map "~" 'hg-version-other-window)
207 229
208 (add-minor-mode 'hg-mode 'hg-mode hg-mode-map) 230 (add-minor-mode 'hg-mode 'hg-mode hg-mode-map)
209 231
210 232
211 ;;; Global keymap. 233 ;;; Global keymap.
212 234
213 (global-set-key "\C-xvi" 'hg-add) 235 (defvar hg-global-map
214 236 (let ((map (make-sparse-keymap)))
215 (defvar hg-global-map (make-sparse-keymap)) 237 (define-key map "," 'hg-incoming)
216 (fset 'hg-global-map hg-global-map) 238 (define-key map "." 'hg-outgoing)
217 (global-set-key hg-global-prefix 'hg-global-map) 239 (define-key map "<" 'hg-pull)
218 (define-key hg-global-map "," 'hg-incoming) 240 (define-key map "=" 'hg-diff-repo)
219 (define-key hg-global-map "." 'hg-outgoing) 241 (define-key map ">" 'hg-push)
220 (define-key hg-global-map "<" 'hg-pull) 242 (define-key map "?" 'hg-help-overview)
221 (define-key hg-global-map "=" 'hg-diff-repo) 243 (define-key map "A" 'hg-addremove)
222 (define-key hg-global-map ">" 'hg-push) 244 (define-key map "U" 'hg-revert)
223 (define-key hg-global-map "?" 'hg-help-overview) 245 (define-key map "a" 'hg-add)
224 (define-key hg-global-map "A" 'hg-addremove) 246 (define-key map "c" 'hg-commit-start)
225 (define-key hg-global-map "U" 'hg-revert) 247 (define-key map "f" 'hg-forget)
226 (define-key hg-global-map "a" 'hg-add) 248 (define-key map "h" 'hg-help-overview)
227 (define-key hg-global-map "c" 'hg-commit-start) 249 (define-key map "i" 'hg-init)
228 (define-key hg-global-map "f" 'hg-forget) 250 (define-key map "l" 'hg-log-repo)
229 (define-key hg-global-map "h" 'hg-help-overview) 251 (define-key map "r" 'hg-root)
230 (define-key hg-global-map "i" 'hg-init) 252 (define-key map "s" 'hg-status)
231 (define-key hg-global-map "l" 'hg-log-repo) 253 (define-key map "u" 'hg-update)
232 (define-key hg-global-map "r" 'hg-root) 254 map))
233 (define-key hg-global-map "s" 'hg-status) 255
234 (define-key hg-global-map "u" 'hg-update) 256 (global-set-key hg-global-prefix hg-global-map)
235
236 257
237 ;;; View mode keymap. 258 ;;; View mode keymap.
238 259
239 (defvar hg-view-mode-map 260 (defvar hg-view-mode-map
240 (let ((map (copy-keymap (if (boundp 'view-minor-mode-map) 261 (let ((map (make-sparse-keymap)))
241 view-minor-mode-map 262 (hg-feature-cond (xemacs (set-keymap-name map 'hg-view-mode-map))) ; XEmacs
242 view-mode-map)))) 263 (define-key map (hg-feature-cond (xemacs [button2])
243 (if (functionp 'set-keymap-name) 264 (t [mouse-2]))
244 (set-keymap-name map 'hg-view-mode-map)); XEmacs 265 'hg-buffer-mouse-clicked)
245 map)) 266 map))
246 (fset 'hg-view-mode-map hg-view-mode-map) 267
247 (define-key hg-view-mode-map 268 (add-minor-mode 'hg-view-mode "" hg-view-mode-map)
248 (if hg-running-xemacs [button2] [mouse-2])
249 'hg-buffer-mouse-clicked)
250 269
251 270
252 ;;; Commit mode keymaps. 271 ;;; Commit mode keymaps.
253 272
254 (defvar hg-commit-mode-map (make-sparse-keymap)) 273 (defvar hg-commit-mode-map
255 (define-key hg-commit-mode-map "\C-c\C-c" 'hg-commit-finish) 274 (let ((map (make-sparse-keymap)))
256 (define-key hg-commit-mode-map "\C-c\C-k" 'hg-commit-kill) 275 (define-key map "\C-c\C-c" 'hg-commit-finish)
257 (define-key hg-commit-mode-map "\C-xv=" 'hg-diff-repo) 276 (define-key map "\C-c\C-k" 'hg-commit-kill)
258 277 (define-key map "\C-xv=" 'hg-diff-repo)
259 (defvar hg-commit-mode-file-map (make-sparse-keymap)) 278 map))
260 (define-key hg-commit-mode-file-map 279
261 (if hg-running-xemacs [button2] [mouse-2]) 280 (defvar hg-commit-mode-file-map
262 'hg-commit-mouse-clicked) 281 (let ((map (make-sparse-keymap)))
263 (define-key hg-commit-mode-file-map " " 'hg-commit-toggle-file) 282 (define-key map (hg-feature-cond (xemacs [button2])
264 (define-key hg-commit-mode-file-map "\r" 'hg-commit-toggle-file) 283 (t [mouse-2]))
284 'hg-commit-mouse-clicked)
285 (define-key map " " 'hg-commit-toggle-file)
286 (define-key map "\r" 'hg-commit-toggle-file)
287 map))
265 288
266 289
267 ;;; Convenience functions. 290 ;;; Convenience functions.
268 291
269 (defsubst hg-binary () 292 (defsubst hg-binary ()
276 Return the new string. Optional LITERAL non-nil means do a literal 299 Return the new string. Optional LITERAL non-nil means do a literal
277 replacement. 300 replacement.
278 301
279 This function bridges yet another pointless impedance gap between 302 This function bridges yet another pointless impedance gap between
280 XEmacs and GNU Emacs." 303 XEmacs and GNU Emacs."
281 (if (fboundp 'replace-in-string) 304 (hg-feature-cond
282 (replace-in-string str regexp newtext literal) 305 (xemacs (replace-in-string str regexp newtext literal))
283 (replace-regexp-in-string regexp newtext str nil literal))) 306 (t (replace-regexp-in-string regexp newtext str nil literal))))
284 307
285 (defsubst hg-strip (str) 308 (defsubst hg-strip (str)
286 "Strip leading and trailing blank lines from a string." 309 "Strip leading and trailing blank lines from a string."
287 (hg-replace-in-string (hg-replace-in-string str "[\r\n][ \t\r\n]*\\'" "") 310 (hg-replace-in-string (hg-replace-in-string str "[\r\n][ \t\r\n]*\\'" "")
288 "\\`[ \t\r\n]*[\r\n]" "")) 311 "\\`[ \t\r\n]*[\r\n]" ""))
316 (cons command args) 339 (cons command args)
317 (car res)) 340 (car res))
318 (cdr res)))) 341 (cdr res))))
319 342
320 (defmacro hg-do-across-repo (path &rest body) 343 (defmacro hg-do-across-repo (path &rest body)
321 (let ((root-name (gensym "root-")) 344 (let ((root-name (make-symbol "root-"))
322 (buf-name (gensym "buf-"))) 345 (buf-name (make-symbol "buf-")))
323 `(let ((,root-name (hg-root ,path))) 346 `(let ((,root-name (hg-root ,path)))
324 (save-excursion 347 (save-excursion
325 (dolist (,buf-name (buffer-list)) 348 (dolist (,buf-name (buffer-list))
326 (set-buffer ,buf-name) 349 (set-buffer ,buf-name)
327 (when (and hg-status (equal (hg-root buffer-file-name) ,root-name)) 350 (when (and hg-status (equal (hg-root buffer-file-name) ,root-name))
342 365
343 (defun hg-buffer-commands (pnt) 366 (defun hg-buffer-commands (pnt)
344 "Use the properties of a character to do something sensible." 367 "Use the properties of a character to do something sensible."
345 (interactive "d") 368 (interactive "d")
346 (let ((rev (get-char-property pnt 'rev)) 369 (let ((rev (get-char-property pnt 'rev))
347 (file (get-char-property pnt 'file)) 370 (file (get-char-property pnt 'file)))
348 (date (get-char-property pnt 'date))
349 (user (get-char-property pnt 'user))
350 (host (get-char-property pnt 'host))
351 (prev-buf (current-buffer)))
352 (cond 371 (cond
353 (file 372 (file
354 (find-file-other-window file)) 373 (find-file-other-window file))
355 (rev 374 (rev
356 (hg-diff hg-view-file-name rev rev prev-buf)) 375 (hg-diff hg-view-file-name rev rev))
357 ((message "I don't know how to do that yet"))))) 376 ((message "I don't know how to do that yet")))))
358 377
359 (defsubst hg-event-point (event) 378 (defsubst hg-event-point (event)
360 "Return the character position of the mouse event EVENT." 379 "Return the character position of the mouse event EVENT."
361 (if hg-running-xemacs 380 (hg-feature-cond (xemacs (event-point event))
362 (event-point event) 381 (t (posn-point (event-start event)))))
363 (posn-point (event-start event))))
364 382
365 (defsubst hg-event-window (event) 383 (defsubst hg-event-window (event)
366 "Return the window over which mouse event EVENT occurred." 384 "Return the window over which mouse event EVENT occurred."
367 (if hg-running-xemacs 385 (hg-feature-cond (xemacs (event-window event))
368 (event-window event) 386 (t (posn-window (event-start event)))))
369 (posn-window (event-start event))))
370 387
371 (defun hg-buffer-mouse-clicked (event) 388 (defun hg-buffer-mouse-clicked (event)
372 "Translate the mouse clicks in a HG log buffer to character events. 389 "Translate the mouse clicks in a HG log buffer to character events.
373 These are then handed off to `hg-buffer-commands'. 390 These are then handed off to `hg-buffer-commands'.
374 391
375 Handle frickin' frackin' gratuitous event-related incompatibilities." 392 Handle frickin' frackin' gratuitous event-related incompatibilities."
376 (interactive "e") 393 (interactive "e")
377 (select-window (hg-event-window event)) 394 (select-window (hg-event-window event))
378 (hg-buffer-commands (hg-event-point event))) 395 (hg-buffer-commands (hg-event-point event)))
379 396
380 (unless (fboundp 'view-minor-mode)
381 (defun view-minor-mode (prev-buffer exit-func)
382 (view-mode)))
383
384 (defsubst hg-abbrev-file-name (file) 397 (defsubst hg-abbrev-file-name (file)
385 "Portable wrapper around abbreviate-file-name." 398 "Portable wrapper around abbreviate-file-name."
386 (if hg-running-xemacs 399 (hg-feature-cond (xemacs (abbreviate-file-name file t))
387 (abbreviate-file-name file t) 400 (t (abbreviate-file-name file))))
388 (abbreviate-file-name file)))
389 401
390 (defun hg-read-file-name (&optional prompt default) 402 (defun hg-read-file-name (&optional prompt default)
391 "Read a file or directory name, or a pattern, to use with a command." 403 "Read a file or directory name, or a pattern, to use with a command."
392 (save-excursion 404 (save-excursion
393 (while hg-prev-buffer 405 (while hg-prev-buffer
401 (format "File, directory or pattern%s: " 413 (format "File, directory or pattern%s: "
402 (or prompt "")) 414 (or prompt ""))
403 (and path (file-name-directory path)) 415 (and path (file-name-directory path))
404 nil nil 416 nil nil
405 (and path (file-name-nondirectory path)) 417 (and path (file-name-nondirectory path))
406 (if hg-running-xemacs 418 (hg-feature-cond
407 (cons (quote 'hg-file-history) nil) 419 (xemacs (cons (quote 'hg-file-history) nil))
408 nil)))) 420 (t nil)))))
409 path)))) 421 path))))
410 422
411 (defun hg-read-number (&optional prompt default) 423 (defun hg-read-number (&optional prompt default)
412 "Read a integer value." 424 "Read a integer value."
413 (save-excursion 425 (save-excursion
475 (if current-prefix-arg 487 (if current-prefix-arg
476 (progn 488 (progn
477 (dolist (path (hg-config-section "paths" (hg-read-config))) 489 (dolist (path (hg-config-section "paths" (hg-read-config)))
478 (setq hg-repo-completion-table 490 (setq hg-repo-completion-table
479 (cons (cons (car path) t) hg-repo-completion-table)) 491 (cons (cons (car path) t) hg-repo-completion-table))
480 (unless (hg-string-starts-with directory-sep-char (cdr path)) 492 (unless (hg-string-starts-with (hg-feature-cond
493 (xemacs directory-sep-char)
494 (t ?/))
495 (cdr path))
481 (setq hg-repo-completion-table 496 (setq hg-repo-completion-table
482 (cons (cons (cdr path) t) hg-repo-completion-table)))) 497 (cons (cons (cdr path) t) hg-repo-completion-table))))
483 (completing-read (format "Repository%s: " (or prompt "")) 498 (completing-read (format "Repository%s: " (or prompt ""))
484 'hg-complete-repo 499 'hg-complete-repo
485 nil 500 nil
496 (set-buffer hg-prev-buffer)) 511 (set-buffer hg-prev-buffer))
497 (let ((rev (or default "tip"))) 512 (let ((rev (or default "tip")))
498 (if current-prefix-arg 513 (if current-prefix-arg
499 (let ((revs (split-string 514 (let ((revs (split-string
500 (hg-chomp 515 (hg-chomp
501 (hg-run0 "-q" "log" "-r" 516 (hg-run0 "-q" "log" "-l"
502 (format "-%d:tip" hg-rev-completion-limit))) 517 (format "%d" hg-rev-completion-limit)))
503 "[\n:]"))) 518 "[\n:]")))
504 (dolist (line (split-string (hg-chomp (hg-run0 "tags")) "\n")) 519 (dolist (line (split-string (hg-chomp (hg-run0 "tags")) "\n"))
505 (setq revs (cons (car (split-string line "\\s-")) revs))) 520 (setq revs (cons (car (split-string line "\\s-")) revs)))
506 (completing-read (format "Revision%s (%s): " 521 (completing-read (format "Revision%s (%s): "
507 (or prompt "") 522 (or prompt "")
566 581
567 (defun hg-view-mode (prev-buffer &optional file-name) 582 (defun hg-view-mode (prev-buffer &optional file-name)
568 (goto-char (point-min)) 583 (goto-char (point-min))
569 (set-buffer-modified-p nil) 584 (set-buffer-modified-p nil)
570 (toggle-read-only t) 585 (toggle-read-only t)
571 (view-minor-mode prev-buffer 'hg-exit-view-mode) 586 (hg-feature-cond (xemacs (view-minor-mode prev-buffer 'hg-exit-view-mode))
572 (use-local-map hg-view-mode-map) 587 (t (view-mode-enter nil 'hg-exit-view-mode)))
588 (setq hg-view-mode t)
573 (setq truncate-lines t) 589 (setq truncate-lines t)
574 (when file-name 590 (when file-name
575 (set (make-local-variable 'hg-view-file-name) 591 (setq hg-view-file-name
576 (hg-abbrev-file-name file-name)))) 592 (hg-abbrev-file-name file-name))))
577 593
578 (defun hg-file-status (file) 594 (defun hg-file-status (file)
579 "Return status of FILE, or nil if FILE does not exist or is unmanaged." 595 "Return status of FILE, or nil if FILE does not exist or is unmanaged."
580 (let* ((s (hg-run "status" file)) 596 (let* ((s (hg-run "status" file))
581 (exit (car s)) 597 (exit (car s))
582 (output (cdr s))) 598 (output (cdr s)))
583 (if (= exit 0) 599 (if (= exit 0)
584 (let ((state (assoc (substring output 0 (min (length output) 2)) 600 (let ((state (and (>= (length output) 2)
585 '(("M " . modified) 601 (= (aref output 1) ? )
586 ("A " . added) 602 (assq (aref output 0) hg-state-alist))))
587 ("R " . removed)
588 ("! " . deleted)
589 ("? " . nil)))))
590 (if state 603 (if state
591 (cdr state) 604 (cdr state)
592 'normal))))) 605 'normal)))))
593 606
594 (defun hg-path-status (root paths) 607 (defun hg-path-status (root paths)
596 Each entry is a pair (FILE-NAME . STATUS)." 609 Each entry is a pair (FILE-NAME . STATUS)."
597 (let ((s (apply 'hg-run "--cwd" root "status" "-marduc" paths)) 610 (let ((s (apply 'hg-run "--cwd" root "status" "-marduc" paths))
598 result) 611 result)
599 (dolist (entry (split-string (hg-chomp (cdr s)) "\n") (nreverse result)) 612 (dolist (entry (split-string (hg-chomp (cdr s)) "\n") (nreverse result))
600 (let (state name) 613 (let (state name)
601 (if (equal (substring entry 1 2) " ") 614 (cond ((= (aref entry 1) ? )
602 (setq state (cdr (assoc (substring entry 0 2) 615 (setq state (assq (aref entry 0) hg-state-alist)
603 '(("M " . modified) 616 name (substring entry 2)))
604 ("A " . added) 617 ((string-match "\\(.*\\): " entry)
605 ("R " . removed) 618 (setq name (match-string 1 entry))))
606 ("! " . deleted)
607 ("C " . normal)
608 ("I " . ignored)
609 ("? " . nil))))
610 name (substring entry 2))
611 (setq name (substring entry 0 (search ": " entry :from-end t))))
612 (setq result (cons (cons name state) result)))))) 619 (setq result (cons (cons name state) result))))))
613 620
614 (defmacro hg-view-output (args &rest body) 621 (defmacro hg-view-output (args &rest body)
615 "Execute BODY in a clean buffer, then quickly display that buffer. 622 "Execute BODY in a clean buffer, then quickly display that buffer.
616 If the buffer contains one line, its contents are displayed in the 623 If the buffer contains one line, its contents are displayed in the
617 minibuffer. Otherwise, the buffer is displayed in view-mode. 624 minibuffer. Otherwise, the buffer is displayed in view-mode.
618 ARGS is of the form (BUFFER-NAME &optional FILE), where BUFFER-NAME is 625 ARGS is of the form (BUFFER-NAME &optional FILE), where BUFFER-NAME is
619 the name of the buffer to create, and FILE is the name of the file 626 the name of the buffer to create, and FILE is the name of the file
620 being viewed." 627 being viewed."
621 (let ((prev-buf (gensym "prev-buf-")) 628 (let ((prev-buf (make-symbol "prev-buf-"))
622 (v-b-name (car args)) 629 (v-b-name (car args))
623 (v-m-rest (cdr args))) 630 (v-m-rest (cdr args)))
624 `(let ((view-buf-name ,v-b-name) 631 `(let ((view-buf-name ,v-b-name)
625 (,prev-buf (current-buffer))) 632 (,prev-buf (current-buffer)))
626 (get-buffer-create view-buf-name) 633 (get-buffer-create view-buf-name)