Merge from emacs-24, up to 2012-04-10T02:06:19Z!larsi@gnus.org

[gnu-emacs] / lisp / emulation / viper-ex.el

diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el
index 627d2ff181475ed40be416137f9167d7b0531da4..acaedde3004b297183eccadebf340bdfc553475e 100644 (file)
--- a/lisp/emulation/viper-ex.el
+++ b/lisp/emulation/viper-ex.el
@@ -1,16 +1,16 @@
 ;;; viper-ex.el --- functions implementing the Ex commands for Viper
 
 ;;; viper-ex.el --- functions implementing the Ex commands for Viper
 

-;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003,
-;;   2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1998, 2000-2012 Free Software Foundation, Inc.

 
 ;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
 
 ;; Author: Michael Kifer <kifer@cs.stonybrook.edu>

+;; Package: viper

 
 ;; This file is part of GNU Emacs.
 
 
 ;; This file is part of GNU Emacs.
 

-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify

 ;; it under the terms of the GNU General Public License as published by
 ;; it under the terms of the GNU General Public License as published by

-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.

 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of


@@ -18,9 +18,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License

-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

 
 ;;; Commentary:
 
 
 ;;; Commentary:
 


@@ -46,14 +44,9 @@
 ;; in order to spare non-viperized emacs from being viperized
 (if noninteractive
     (eval-when-compile
 ;; in order to spare non-viperized emacs from being viperized
 (if noninteractive
     (eval-when-compile

-      (let ((load-path (cons (expand-file-name ".") load-path)))
-       (or (featurep 'viper-util)
-           (load "viper-util.el" nil nil 'nosuffix))
-       (or (featurep 'viper-keym)
-           (load "viper-keym.el" nil nil 'nosuffix))
-       (or (featurep 'viper-cmd)
-           (load "viper-cmd.el" nil nil 'nosuffix))
-       )))
+      (if (not (featurep 'viper-cmd))
+         (require 'viper-cmd))
+      ))

 ;; end pacifier
 
 (require 'viper-util)
 ;; end pacifier
 
 (require 'viper-util)


@@ -266,7 +259,7 @@
 (defvar ex-addresses nil)
 
 ;; This flag is supposed to be set only by `#', `print', and `list',
 (defvar ex-addresses nil)
 
 ;; This flag is supposed to be set only by `#', `print', and `list',

-;; none of which is implemented.  So, it and the pices of the code it
+;; none of which is implemented.  So, it and the pieces of the code it

 ;; controls are dead weight.  We keep it just in case this might be
 ;; needed in the future.
 (defvar ex-flag nil)
 ;; controls are dead weight.  We keep it just in case this might be
 ;; needed in the future.
 (defvar ex-flag nil)


@@ -336,14 +329,12 @@ Don't put `-c' here, as it is added automatically."
 
 (defcustom viper-glob-function
   (cond (ex-unix-type-shell 'viper-glob-unix-files)
 
 (defcustom viper-glob-function
   (cond (ex-unix-type-shell 'viper-glob-unix-files)

-       ((eq system-type 'emx) 'viper-glob-mswindows-files) ; OS/2

        (viper-ms-style-os-p 'viper-glob-mswindows-files) ; Microsoft OS
        (viper-ms-style-os-p 'viper-glob-mswindows-files) ; Microsoft OS

-       (viper-vms-os-p 'viper-glob-unix-files) ; VMS

        (t  'viper-glob-unix-files) ; presumably UNIX
        )
   "Expand the file spec containing wildcard symbols.
 The default tries to set this variable to work with Unix, Windows,
        (t  'viper-glob-unix-files) ; presumably UNIX
        )
   "Expand the file spec containing wildcard symbols.
 The default tries to set this variable to work with Unix, Windows,

-OS/2, and VMS.
+and OS/2.

 
 However, if it doesn't work right for some types of Unix shells or some OS,
 the user should supply the appropriate function and set this variable to the
 
 However, if it doesn't work right for some types of Unix shells or some OS,
 the user should supply the appropriate function and set this variable to the


@@ -377,14 +368,14 @@ corresponding function symbol."
 (defvar viper-keep-reading-filename nil)
 
 (defcustom ex-cycle-other-window t
 (defvar viper-keep-reading-filename nil)
 
 (defcustom ex-cycle-other-window t

-  "*If t, :n and :b cycles through files and buffers in other window.
+  "If t, :n and :b cycles through files and buffers in other window.

 Then :N and :B cycles in the current window.  If nil, this behavior is
 reversed."
   :type 'boolean
   :group 'viper-ex)
 
 (defcustom ex-cycle-through-non-files nil
 Then :N and :B cycles in the current window.  If nil, this behavior is
 reversed."
   :type 'boolean
   :group 'viper-ex)
 
 (defcustom ex-cycle-through-non-files nil

-  "*Cycle through *scratch* and other buffers that don't visit any file."
+  "Cycle through *scratch* and other buffers that don't visit any file."

   :type 'boolean
   :group 'viper-ex)
 
   :type 'boolean
   :group 'viper-ex)
 


@@ -651,17 +642,19 @@ reversed."
        (setq initial-str (format "%d,%d" reg-beg-line reg-end-line)))
 
     (setq com-str
        (setq initial-str (format "%d,%d" reg-beg-line reg-end-line)))
 
     (setq com-str

-         (or string (viper-read-string-with-history
-                     ":"
-                     initial-str
-                     'viper-ex-history
-                     ;; no default when working on region
-                     (if initial-str
-                         nil
-                       (car viper-ex-history))
-                     map
-                     (if initial-str
-                         " [Type command to execute on current region]"))))
+         (if string
+             (concat initial-str string)
+           (viper-read-string-with-history
+            ":"
+            initial-str
+            'viper-ex-history
+            ;; no default when working on region
+            (if initial-str
+                nil
+              (car viper-ex-history))
+            map
+            (if initial-str
+                " [Type command to execute on current region]"))))

     (save-window-excursion
       ;; just a precaution
       (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
     (save-window-excursion
       ;; just a precaution
       (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))


@@ -757,7 +750,7 @@ reversed."
                          (format "[^\\\\]\\(\\\\\\\\\\)*\\\\%c" c)))
                    (setq cont nil)
                  ;; we are at an escaped delimiter: unescape it and continue
                          (format "[^\\\\]\\(\\\\\\\\\\)*\\\\%c" c)))
                    (setq cont nil)
                  ;; we are at an escaped delimiter: unescape it and continue

-                 (delete-backward-char 2)
+                 (delete-char -2)

                  (insert c)
                  (if (eolp)
                      ;; if at eol, exit loop and go to next line
                  (insert c)
                  (if (eolp)
                      ;; if at eol, exit loop and go to next line


@@ -953,16 +946,14 @@ reversed."
 ;; Expand \% and \# in ex command
 (defun ex-expand-filsyms (cmd buf)
   (let (cf pf ret)
 ;; Expand \% and \# in ex command
 (defun ex-expand-filsyms (cmd buf)
   (let (cf pf ret)

-    (save-excursion
-      (set-buffer buf)
+    (with-current-buffer buf

       (setq cf buffer-file-name)
       (setq pf (ex-next nil t))) ; this finds alternative file name
     (if (and (null cf) (string-match "[^\\]%\\|\\`%" cmd))
        (error "No current file to substitute for `%%'"))
     (if (and (null pf) (string-match "[^\\]#\\|\\`#" cmd))
        (error "No alternate file to substitute for `#'"))
       (setq cf buffer-file-name)
       (setq pf (ex-next nil t))) ; this finds alternative file name
     (if (and (null cf) (string-match "[^\\]%\\|\\`%" cmd))
        (error "No current file to substitute for `%%'"))
     (if (and (null pf) (string-match "[^\\]#\\|\\`#" cmd))
        (error "No alternate file to substitute for `#'"))

-    (save-excursion
-      (set-buffer (get-buffer-create viper-ex-tmp-buf-name))
+    (with-current-buffer (get-buffer-create viper-ex-tmp-buf-name)

       (erase-buffer)
       (insert cmd)
       (goto-char (point-min))
       (erase-buffer)
       (insert cmd)
       (goto-char (point-min))


@@ -991,9 +982,8 @@ reversed."
          ex-cmdfile nil
          ex-cmdfile-args "")
     (save-excursion
          ex-cmdfile nil
          ex-cmdfile-args "")
     (save-excursion

-      (save-window-excursion
-       (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
-       (set-buffer viper-ex-work-buf)
+      (with-current-buffer (setq viper-ex-work-buf
+                                 (get-buffer-create viper-ex-work-buf-name))

        (skip-chars-forward " \t")
        (if (looking-at "!")
            (if (and (not (viper-looking-back "[ \t]"))
        (skip-chars-forward " \t")
        (if (looking-at "!")
            (if (and (not (viper-looking-back "[ \t]"))


@@ -1101,7 +1091,7 @@ reversed."
         beg end cont val)
 
     (viper-add-keymap ex-read-filename-map
         beg end cont val)
 
     (viper-add-keymap ex-read-filename-map

-                   (if viper-emacs-p
+                   (if (featurep 'emacs)

                        minibuffer-local-completion-map
                      read-file-name-map))
 
                        minibuffer-local-completion-map
                      read-file-name-map))
 


@@ -1296,9 +1286,8 @@ reversed."
     (switch-to-buffer file))
   (if ex-offset
       (progn
     (switch-to-buffer file))
   (if ex-offset
       (progn

-       (save-window-excursion
-         (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
-         (set-buffer viper-ex-work-buf)
+       (with-current-buffer (setq viper-ex-work-buf
+                                   (get-buffer-create viper-ex-work-buf-name))

          (delete-region (point-min) (point-max))
          (insert ex-offset "\n")
          (goto-char (point-min)))
          (delete-region (point-min) (point-max))
          (insert ex-offset "\n")
          (goto-char (point-min)))


@@ -1379,9 +1368,8 @@ reversed."
          (if (bobp) (setq cont nil)
            (forward-line -1)
            (end-of-line)))))
          (if (bobp) (setq cont nil)
            (forward-line -1)
            (end-of-line)))))

-    (save-window-excursion
-      (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
-      (set-buffer viper-ex-work-buf)
+    (with-current-buffer (setq viper-ex-work-buf
+                               (get-buffer-create viper-ex-work-buf-name))

       ;; com-str is the command string, i.e., g/pattern/ or v/pattern'
       (setq com-str (buffer-substring (1+ (point)) (1- (point-max)))))
     (while ex-g-marks
       ;; com-str is the command string, i.e., g/pattern/ or v/pattern'
       (setq com-str (buffer-substring (1+ (point)) (1- (point-max)))))
     (while ex-g-marks


@@ -1460,18 +1448,17 @@ reversed."
            (setq char (string-to-char name))
          (error "`%s': Spurious text \"%s\" after mark name"
                 name (substring name 1)))
            (setq char (string-to-char name))
          (error "`%s': Spurious text \"%s\" after mark name"
                 name (substring name 1)))

-    (save-window-excursion
-      (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
-      (set-buffer viper-ex-work-buf)
-      (skip-chars-forward " \t")
-      (if (looking-at "[a-z]")
-         (progn
-           (setq char (following-char))
-           (forward-char 1)
-           (skip-chars-forward " \t")
-           (if (not (looking-at "[\n|]"))
-               (error "`%s': %s" ex-token viper-SpuriousText)))
-       (error "`%s' requires a following letter" ex-token))))
+      (with-current-buffer (setq viper-ex-work-buf
+                                 (get-buffer-create viper-ex-work-buf-name))
+        (skip-chars-forward " \t")
+        (if (looking-at "[a-z]")
+            (progn
+              (setq char (following-char))
+              (forward-char 1)
+              (skip-chars-forward " \t")
+              (if (not (looking-at "[\n|]"))
+                  (error "`%s': %s" ex-token viper-SpuriousText)))
+          (error "`%s' requires a following letter" ex-token))))

     (save-excursion
       (goto-char (car ex-addresses))
       (point-to-register (viper-int-to-char (1+ (- char ?a)))))))
     (save-excursion
       (goto-char (car ex-addresses))
       (point-to-register (viper-int-to-char (1+ (- char ?a)))))))


@@ -1556,7 +1543,7 @@ reversed."
       ;; setup buffer
       (if (setq wind (viper-get-visible-buffer-window buf))
          ()
       ;; setup buffer
       (if (setq wind (viper-get-visible-buffer-window buf))
          ()

-       (setq wind (get-lru-window (if viper-xemacs-p nil 'visible)))
+       (setq wind (get-lru-window (if (featurep 'xemacs) nil 'visible)))

        (set-window-buffer wind buf))
 
       (if (viper-window-display-p)
        (set-window-buffer wind buf))
 
       (if (viper-window-display-p)


@@ -1567,8 +1554,7 @@ reversed."
              (select-window wind)))
        (save-window-excursion (select-window wind) (sit-for 1)))
 
              (select-window wind)))
        (save-window-excursion (select-window wind) (sit-for 1)))
 

-      (save-excursion
-       (set-buffer buf)
+      (with-current-buffer buf

        (setq viper-related-files-and-buffers-ring old-ring))
 
       (setq viper-local-search-start-marker (point-marker))
        (setq viper-related-files-and-buffers-ring old-ring))
 
       (setq viper-local-search-start-marker (point-marker))


@@ -1595,9 +1581,8 @@ reversed."
 ;; Ex quit command
 (defun ex-quit ()
   ;; skip "!", if it is q!.  In Viper q!, w!, etc., behave as q, w, etc.
 ;; Ex quit command
 (defun ex-quit ()
   ;; skip "!", if it is q!.  In Viper q!, w!, etc., behave as q, w, etc.

-  (save-excursion
-    (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
-    (set-buffer viper-ex-work-buf)
+  (with-current-buffer (setq viper-ex-work-buf
+                             (get-buffer-create viper-ex-work-buf-name))

     (if (looking-at "!") (forward-char 1)))
   (if (< viper-expert-level 3)
       (save-buffers-kill-emacs)
     (if (looking-at "!") (forward-char 1)))
   (if (< viper-expert-level 3)
       (save-buffers-kill-emacs)


@@ -1745,10 +1730,10 @@ reversed."
           (setq var "blink-matching-paren"
                 val "nil"))
          ((member var '("ws" "wrapscan"))
           (setq var "blink-matching-paren"
                 val "nil"))
          ((member var '("ws" "wrapscan"))

-          (setq var "viper-search-wrap-around-t"
+          (setq var "viper-search-wrap-around"

                 val "t"))
          ((member var '("nows" "nowrapscan"))
                 val "t"))
          ((member var '("nows" "nowrapscan"))

-          (setq var "viper-search-wrap-around-t"
+          (setq var "viper-search-wrap-around"

                 val "nil")))
     (if (and set-cmd (eq val 0)) ; value must be set by the user
        (let ((cursor-in-echo-area t))
                 val "nil")))
     (if (and set-cmd (eq val 0)) ; value must be set by the user
        (let ((cursor-in-echo-area t))


@@ -1844,9 +1829,8 @@ reversed."
 ;; Optional 3d arg is a string that should replace ' ' to prevent its
 ;; special meaning
 (defun ex-get-inline-cmd-args (regex-forw &optional chars-back replace-str)
 ;; Optional 3d arg is a string that should replace ' ' to prevent its
 ;; special meaning
 (defun ex-get-inline-cmd-args (regex-forw &optional chars-back replace-str)

-  (save-excursion
-    (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
-    (set-buffer viper-ex-work-buf)
+  (with-current-buffer (setq viper-ex-work-buf
+                             (get-buffer-create viper-ex-work-buf-name))

     (goto-char (point-min))
     (re-search-forward regex-forw nil t)
     (let ((beg (point))
     (goto-char (point-min))
     (re-search-forward regex-forw nil t)
     (let ((beg (point))


@@ -1876,7 +1860,7 @@ reversed."
   (condition-case nil
       (progn
        (pop-to-buffer (get-buffer-create "*info*"))
   (condition-case nil
       (progn
        (pop-to-buffer (get-buffer-create "*info*"))

-       (info (if viper-xemacs-p "viper.info" "viper"))
+       (info (if (featurep 'xemacs) "viper.info" "viper"))

        (message "Type `i' to search for a specific topic"))
     (error (beep 1)
           (with-output-to-temp-buffer " *viper-info*"
        (message "Type `i' to search for a specific topic"))
     (error (beep 1)
           (with-output-to-temp-buffer " *viper-info*"


@@ -1885,7 +1869,7 @@ The Info file for Viper does not seem to be installed.
 
 This file is part of the standard distribution of %sEmacs.
 Please contact your system administrator. "
 
 This file is part of the standard distribution of %sEmacs.
 Please contact your system administrator. "

-                           (if viper-xemacs-p "X" "")
+                           (if (featurep 'xemacs) "X" "")

                            ))))))
 
 ;; Ex source command.  Loads the file specified as argument or `~/.viper'
                            ))))))
 
 ;; Ex source command.  Loads the file specified as argument or `~/.viper'


@@ -1994,9 +1978,8 @@ Please contact your system administrator. "
 ;; Ex tag command
 (defun ex-tag ()
   (let (tag)
 ;; Ex tag command
 (defun ex-tag ()
   (let (tag)

-    (save-window-excursion
-      (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
-      (set-buffer viper-ex-work-buf)
+    (with-current-buffer (setq viper-ex-work-buf
+                               (get-buffer-create viper-ex-work-buf-name))

       (skip-chars-forward " \t")
       (set-mark (point))
       (skip-chars-forward "^ |\t\n")
       (skip-chars-forward " \t")
       (set-mark (point))
       (skip-chars-forward "^ |\t\n")


@@ -2079,10 +2062,9 @@ Please contact your system administrator. "
              ;; create temp buffer for the region
              (setq temp-buf (get-buffer-create " *ex-write*"))
              (set-buffer temp-buf)
              ;; create temp buffer for the region
              (setq temp-buf (get-buffer-create " *ex-write*"))
              (set-buffer temp-buf)

-             (viper-cond-compile-for-xemacs-or-emacs
-              (set-visited-file-name ex-file) ; xemacs
-              (set-visited-file-name ex-file 'noquerry) ; emacs
-              )
+             (if (featurep 'xemacs)
+                 (set-visited-file-name ex-file)
+               (set-visited-file-name ex-file 'noquery))

              (erase-buffer)
              (if (and file-exists ex-append)
                  (insert-file-contents ex-file))
              (erase-buffer)
              (if (and file-exists ex-append)
                  (insert-file-contents ex-file))


@@ -2156,9 +2138,8 @@ Please contact your system administrator. "
 ;; Execute shell command
 (defun ex-command ()
   (let (command)
 ;; Execute shell command
 (defun ex-command ()
   (let (command)

-    (save-window-excursion
-      (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
-      (set-buffer viper-ex-work-buf)
+    (with-current-buffer (setq viper-ex-work-buf
+                               (get-buffer-create viper-ex-work-buf-name))

       (skip-chars-forward " \t")
       (setq command (buffer-substring (point) (point-max)))
       (end-of-line))
       (skip-chars-forward " \t")
       (setq command (buffer-substring (point) (point-max)))
       (end-of-line))


@@ -2186,9 +2167,8 @@ Please contact your system administrator. "
 If no args are given, then it runs the last compile command.
 Type 'mak ' (including the space) to run make with no args."
   (let (args)
 If no args are given, then it runs the last compile command.
 Type 'mak ' (including the space) to run make with no args."
   (let (args)

-    (save-window-excursion
-      (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
-      (set-buffer viper-ex-work-buf)
+    (with-current-buffer (setq viper-ex-work-buf
+                               (get-buffer-create viper-ex-work-buf-name))

       (setq args (buffer-substring (point) (point-max)))
       (end-of-line))
     ;; Remove the newline that may (will?) be at the end of the args
       (setq args (buffer-substring (point) (point-max)))
       (end-of-line))
     ;; Remove the newline that may (will?) be at the end of the args


@@ -2218,9 +2198,11 @@ Type 'mak ' (including the space) to run make with no args."
        (pos2 (viper-line-pos 'end))
        lines file info)
     (setq lines (count-lines (point-min) (viper-line-pos 'end))
        (pos2 (viper-line-pos 'end))
        lines file info)
     (setq lines (count-lines (point-min) (viper-line-pos 'end))

-         file (if (buffer-file-name)
-                  (concat (viper-abbreviate-file-name (buffer-file-name)) ":")
-                (concat (buffer-name) " [Not visiting any file]:"))
+         file (cond ((buffer-file-name)
+                     (concat (viper-abbreviate-file-name (buffer-file-name)) ":"))
+                    ((buffer-file-name (buffer-base-buffer))
+                     (concat (viper-abbreviate-file-name (buffer-file-name (buffer-base-buffer))) " (indirect buffer):"))
+                    (t (concat (buffer-name) " [Not visiting any file]:")))

          info (format "line=%d/%d pos=%d/%d col=%d %s"
                       (if (= pos1 pos2)
                           (1+ lines)
          info (format "line=%d/%d pos=%d/%d col=%d %s"
                       (if (= pos1 pos2)
                           (1+ lines)


@@ -2270,7 +2252,7 @@ Type 'mak ' (including the space) to run make with no args."
     (princ (if viper-re-search "magic\n" "nomagic\n"))
     (princ (if buffer-read-only "readonly\n" "noreadonly\n"))
     (princ (if blink-matching-paren "showmatch\n" "noshowmatch\n"))
     (princ (if viper-re-search "magic\n" "nomagic\n"))
     (princ (if buffer-read-only "readonly\n" "noreadonly\n"))
     (princ (if blink-matching-paren "showmatch\n" "noshowmatch\n"))

-    (princ (if viper-search-wrap-around-t "wrapscan\n" "nowrapscan\n"))
+    (princ (if viper-search-wrap-around "wrapscan\n" "nowrapscan\n"))

     (princ (format "shiftwidth \t\t= %S\n" viper-shift-width))
     (princ (format "tabstop (local) \t= %S\n" tab-width))
     (princ (format "tabstop (global) \t= %S\n" (default-value 'tab-width)))
     (princ (format "shiftwidth \t\t= %S\n" viper-shift-width))
     (princ (format "tabstop (local) \t= %S\n" tab-width))
     (princ (format "tabstop (global) \t= %S\n" (default-value 'tab-width)))


@@ -2320,5 +2302,4 @@ Type 'mak ' (including the space) to run make with no args."
 
 
 
 
 
 

-;;; arch-tag: 56b80d36-f880-4d10-bd66-85ad91a295db

 ;;; viper-ex.el ends here
 ;;; viper-ex.el ends here