Commit 9b70a748 authored by Michael Kifer's avatar Michael Kifer
Browse files

new version

parent cec36122
;;; viper-ex.el --- functions implementing the Ex commands for Viper
;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
......@@ -19,14 +19,35 @@
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;; Code
(require 'viper-util)
(provide 'viper-ex)
;; Compiler pacifier
(defvar read-file-name-map)
;; end compiler pacifier
(defvar vip-use-register)
(defvar vip-s-string)
(defvar vip-shift-width)
(defvar vip-ex-history)
(defvar vip-related-files-and-buffers-ring)
(defvar vip-local-search-start-marker)
(defvar vip-expert-level)
(defvar vip-custom-file-name)
(defvar vip-case-fold-search)
(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)
(load "viper.el" nil nil 'nosuffix))
))
;; end pacifier
(require 'viper-util)
;;; Variables
......@@ -637,7 +658,8 @@ reversed.")
;; Get an ex-address as a marker and set ex-flag if a flag is found
(defun vip-get-ex-address ()
(let ((address (point-marker)) (cont t))
(let ((address (point-marker))
(cont t))
(setq ex-token "")
(setq ex-flag nil)
(while cont
......@@ -1852,7 +1874,12 @@ Please contact your system administrator. "
(defun ex-write (q-flag)
(vip-default-ex-addresses t)
(vip-get-ex-file)
(let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))
(let ((end (car ex-addresses))
(beg (car (cdr ex-addresses)))
(orig-buf (current-buffer))
(orig-buf-file-name (buffer-file-name))
(orig-buf-name (buffer-name))
(buff-changed-p (buffer-modified-p))
temp-buf writing-same-file region
file-exists writing-whole-file)
(if (> beg end) (error vip-FirstAddrExceedsSecond))
......@@ -1875,8 +1902,9 @@ Please contact your system administrator. "
buffer-file-name
(not (file-directory-p buffer-file-name)))
(setq ex-file
(concat ex-file (file-name-nondirectory buffer-file-name))))
(concat (file-name-as-directory ex-file)
(file-name-nondirectory buffer-file-name))))
(setq file-exists (file-exists-p ex-file)
writing-same-file (string= ex-file (buffer-file-name)))
......@@ -1884,35 +1912,58 @@ Please contact your system administrator. "
(if (not (buffer-modified-p))
(message "(No changes need to be saved)")
(save-buffer)
(ex-write-info file-exists ex-file beg end))
;; writing some other file or portion of the currents
;; file---create temp buffer for it
;; disable undo in that buffer, for efficiency
(buffer-disable-undo (setq temp-buf (create-file-buffer ex-file)))
(unwind-protect
(save-excursion
(if (and file-exists
(not writing-same-file)
(not (yes-or-no-p
(format "File %s exists. Overwrite? " ex-file))))
(error "Quit")
(vip-enlarge-region beg end)
(setq region (buffer-substring (point) (mark t)))
(set-buffer temp-buf)
(set-visited-file-name ex-file)
(erase-buffer)
(if (and file-exists ex-append)
(insert-file-contents ex-file))
(goto-char (point-max))
(insert region)
(save-buffer)
(ex-write-info file-exists ex-file (point-min) (point-max))
)
(set-buffer temp-buf)
(set-buffer-modified-p nil)
(kill-buffer temp-buf)
(save-restriction
(widen)
(ex-write-info file-exists ex-file (point-min) (point-max))
))
;; writing some other file or portion of the current file
(cond ((and file-exists
(not writing-same-file)
(not (yes-or-no-p
(format "File %s exists. Overwrite? " ex-file))))
(error "Quit"))
((and writing-whole-file (not ex-append))
(unwind-protect
(progn
(set-visited-file-name ex-file)
(set-buffer-modified-p t)
(save-buffer))
;; restore the buffer file name
(set-visited-file-name orig-buf-file-name)
(set-buffer-modified-p buff-changed-p)
;; If the buffer wasn't visiting a file, restore buffer name.
;; Name could've been changed by packages such as uniquify.
(or orig-buf-file-name
(progn
(unlock-buffer)
(rename-buffer orig-buf-name))))
(save-restriction
(widen)
(ex-write-info
file-exists ex-file (point-min) (point-max))))
(t ; writing a region
(unwind-protect
(save-excursion
(vip-enlarge-region beg end)
(setq region (buffer-substring (point) (mark t)))
;; create temp buffer for the region
(setq temp-buf (get-buffer-create " *ex-write*"))
(set-buffer temp-buf)
(set-visited-file-name ex-file 'noquerry)
(erase-buffer)
(if (and file-exists ex-append)
(insert-file-contents ex-file))
(goto-char (point-max))
(insert region)
(save-buffer)
(ex-write-info
file-exists ex-file (point-min) (point-max))
))
(set-buffer temp-buf)
(set-buffer-modified-p nil)
(kill-buffer temp-buf))
))
)
(set-buffer orig-buf)
;; this prevents the loss of data if writing part of the buffer
(if (and (buffer-file-name) writing-same-file)
(set-visited-file-modtime))
......@@ -2024,6 +2075,4 @@ Please contact your system administrator. "
))
(provide 'viper-ex)
;;; viper-ex.el ends here
This diff is collapsed.
;;; viper-keym.el --- Viper keymaps
;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
......@@ -21,8 +21,26 @@
;; Code
(provide 'viper-keym)
;; compiler pacifier
(defvar vip-always)
(defvar vip-current-state)
(defvar vip-mode-string)
(defvar vip-expert-level)
(defvar vip-ex-style-editing-in-insert)
(defvar vip-ex-style-motion)
(eval-when-compile
(let ((load-path (cons (expand-file-name ".") load-path)))
(or (featurep 'viper-util)
(load "viper-util.el" nil nil 'nosuffix))
))
;; end pacifier
(require 'viper-util)
;;; Variables
(defvar vip-toggle-key "\C-z"
......@@ -35,6 +53,29 @@ This setting cannot be changed interactively.")
"Key used to ESC.
Must be set in .vip file or prior to loading Viper.
This setting cannot be changed interactively.")
;;; Emacs keys in other states.
(defvar vip-want-emacs-keys-in-insert t
"*Set to nil if you want complete Vi compatibility in insert mode.
Complete compatibility with Vi is not recommended for power use of Viper.")
(defvar vip-want-emacs-keys-in-vi t
"*Set to nil if you want complete Vi compatibility in Vi mode.
Full Vi compatibility is not recommended for power use of Viper.")
(defvar vip-no-multiple-ESC t
"*If true, multiple ESC in Vi mode will cause bell to ring.
This is set to t on a windowing terminal and to 'twice on a dumb
terminal (unless the user level is 1, 2, or 5). On a dumb terminal, this
enables cursor keys and is generally more convenient, as terminals usually
don't have a convenient Meta key.
Setting vip-no-multiple-ESC to nil will allow as many multiple ESC,
as is allowed by the major mode in effect.")
(defvar vip-want-ctl-h-help nil
"*If t then C-h is bound to help-command in insert mode, if nil then it is
bound to delete-backward-char.")
;;; Keymaps
......@@ -199,8 +240,8 @@ vip-insert-basic-map. Not recommended, except for novice users.")
;; Replace keymap
(define-key vip-replace-map "\C-t" 'vip-forward-indent)
(define-key vip-replace-map "\C-j" 'vip-replace-state-exit-cmd)
(define-key vip-replace-map "\C-m" 'vip-replace-state-exit-cmd)
(define-key vip-replace-map "\C-j" 'vip-replace-state-carriage-return)
(define-key vip-replace-map "\C-m" 'vip-replace-state-carriage-return)
(define-key vip-replace-map "\C-?" 'vip-del-backward-char-in-replace)
......@@ -400,6 +441,10 @@ Useful in some modes, such as Gnus, MH, etc.")
(define-key vip-dired-modifier-map ":" 'vip-ex)
(define-key vip-dired-modifier-map "/" 'vip-search-forward)
(defvar vip-help-modifier-map (make-sparse-keymap)
"This map modifies Help mode behavior.")
(define-key vip-help-modifier-map "q" (if vip-xemacs-p 'help-mode-quit))
;;; Code
......@@ -579,6 +624,4 @@ form ((key . function) (key . function) ... )."
alist))
(provide 'viper-keym)
;;; viper-keym.el ends here
;;; viper-macs.el --- functions implementing keyboard macros for Viper
;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
......@@ -21,6 +21,26 @@
;; Code
(provide 'viper-macs)
;; compiler pacifier
(defvar vip-ex-work-buf)
(defvar vip-custom-file-name)
(defvar vip-current-state)
(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-mous)
(load "viper-mous.el" nil nil 'nosuffix))
(or (featurep 'viper)
(load "viper.el" nil nil 'nosuffix))
))
;; end pacifier
(require 'viper-util)
(require 'viper-keym)
......@@ -938,6 +958,4 @@ there."
(call-last-kbd-macro)))
(provide 'viper-macs)
;;; viper-macs.el ends here
;;; viper-mous.el --- mouse support for Viper
;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
......@@ -21,12 +21,28 @@
;; Code
(require 'viper-util)
(provide 'viper-mous)
;; compiler pacifier
(defvar double-click-time)
(defvar mouse-track-multi-click-time)
;; end compiler pacifier
(defvar vip-search-start-marker)
(defvar vip-local-search-start-marker)
(defvar vip-search-history)
(defvar vip-s-string)
(defvar vip-re-search)
(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)
(load "viper.el" nil nil 'nosuffix))
))
;; end pacifier
(require 'viper-util)
;;; Variables
......@@ -453,7 +469,4 @@ bindings in viper.el and in the Viper manual."
)))
(provide 'viper-mous)
;;; viper-mous.el ends here
;;; viper-util.el --- Utilities used by viper.el
;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
......@@ -22,141 +22,45 @@
;; Code
(require 'ring)
;; Compiler pacifier
(defvar vip-overriding-map)
(defvar pm-color-alist)
(defvar zmacs-region-stays)
(defvar vip-search-face)
(defvar vip-minibuffer-current-face)
(defvar vip-minibuffer-insert-face)
(defvar vip-minibuffer-vi-face)
(defvar vip-minibuffer-emacs-face)
(defvar vip-replace-overlay-face)
(defvar vip-minibuffer-overlay)
(defvar vip-replace-overlay)
(defvar vip-search-overlay)
(defvar vip-replace-overlay-cursor-color)
(defvar vip-intermediate-command)
(defvar vip-use-replace-region-delimiters)
(defvar vip-fast-keyseq-timeout)
(defvar vip-related-files-and-buffers-ring)
;; end compiler pacifier
;; Is it XEmacs?
(defconst vip-xemacs-p (string-match "\\(Lucid\\|XEmacs\\)" emacs-version))
;; Is it Emacs?
(defconst vip-emacs-p (not vip-xemacs-p))
;; Tell whether we are running as a window application or on a TTY
(defsubst vip-device-type ()
(if vip-emacs-p
window-system
(device-type (selected-device))))
;; in XEmacs: device-type is tty on tty and stream in batch.
(defun vip-window-display-p ()
(and (vip-device-type) (not (memq (vip-device-type) '(tty stream pc)))))
(defvar vip-ms-style-os-p (memq system-type '(ms-dos windows-nt windows-95))
"Tells if Emacs is running under an MS-style OS: ms-dos, windows-nt, W95.")
(defvar vip-vms-os-p (memq system-type '(vax-vms axp-vms))
"Tells if Emacs is running under VMS.")
(defvar vip-force-faces nil
"If t, Viper will think that it is running on a display that supports faces.
This is provided as a temporary relief for users of face-capable displays
that Viper doesn't know about.")
(defun vip-has-face-support-p ()
(cond ((vip-window-display-p))
(vip-force-faces)
(vip-emacs-p (memq (vip-device-type) '(pc)))
(vip-xemacs-p (memq (vip-device-type) '(tty pc)))))
(defvar ex-unix-type-shell)
(defvar ex-unix-type-shell-options)
(defvar vip-ex-tmp-buf-name)
(require 'cl)
(require 'ring)
(and noninteractive
(eval-when-compile
(let ((load-path (cons (expand-file-name ".") load-path)))
(or (featurep 'viper-init)
(load "viper-init.el" nil nil 'nosuffix))
)))
;; end pacifier
(require 'viper-init)
;;; Macros
(defmacro vip-deflocalvar (var default-value &optional documentation)
(` (progn
(defvar (, var) (, default-value)
(, (format "%s\n\(buffer local\)" documentation)))
(make-variable-buffer-local '(, var))
)))
(defmacro vip-loop (count body)
"(vip-loop COUNT BODY) Execute BODY COUNT times."
(list 'let (list (list 'count count))
(list 'while '(> count 0)
body
'(setq count (1- count))
)))
(defmacro vip-buffer-live-p (buf)
(` (and (, buf) (get-buffer (, buf)) (buffer-name (get-buffer (, buf))))))
;; return buffer-specific macro definition, given a full macro definition
(defmacro vip-kbd-buf-alist (macro-elt)
(` (nth 1 (, macro-elt))))
;; get a pair: (curr-buffer . macro-definition)
(defmacro vip-kbd-buf-pair (macro-elt)
(` (assoc (buffer-name) (vip-kbd-buf-alist (, macro-elt)))))
;; get macro definition for current buffer
(defmacro vip-kbd-buf-definition (macro-elt)
(` (cdr (vip-kbd-buf-pair (, macro-elt)))))
;; return mode-specific macro definitions, given a full macro definition
(defmacro vip-kbd-mode-alist (macro-elt)
(` (nth 2 (, macro-elt))))
;; get a pair: (major-mode . macro-definition)
(defmacro vip-kbd-mode-pair (macro-elt)
(` (assoc major-mode (vip-kbd-mode-alist (, macro-elt)))))
;; get macro definition for the current major mode
(defmacro vip-kbd-mode-definition (macro-elt)
(` (cdr (vip-kbd-mode-pair (, macro-elt)))))
;; return global macro definition, given a full macro definition
(defmacro vip-kbd-global-pair (macro-elt)
(` (nth 3 (, macro-elt))))
;; get global macro definition from an elt of macro-alist
(defmacro vip-kbd-global-definition (macro-elt)
(` (cdr (vip-kbd-global-pair (, macro-elt)))))
;; last elt of a sequence
(defsubst vip-seq-last-elt (seq)
(elt seq (1- (length seq))))
;; Check if arg is a valid character for register
;; TYPE is a list that can contain `letter', `Letter', and `digit'.
;; Letter means lowercase letters, Letter means uppercase letters, and
;; digit means digits from 1 to 9.
;; If TYPE is nil, then down/uppercase letters and digits are allowed.
(defun vip-valid-register (reg &optional type)
(or type (setq type '(letter Letter digit)))
(or (if (memq 'letter type)
(and (<= ?a reg) (<= reg ?z)))
(if (memq 'digit type)
(and (<= ?1 reg) (<= reg ?9)))
(if (memq 'Letter type)
(and (<= ?A reg) (<= reg ?Z)))
))
;; checks if object is a marker, has a buffer, and points to within that buffer
(defun vip-valid-marker (marker)
(if (and (markerp marker) (marker-buffer marker))
(let ((buf (marker-buffer marker))
(pos (marker-position marker)))
(save-excursion
(set-buffer buf)
(and (<= pos (point-max)) (<= (point-min) pos))))))
(defvar vip-minibuffer-overlay-priority 300)
(defvar vip-replace-overlay-priority 400)
(defvar vip-search-overlay-priority 500)
;;; XEmacs support
;; A fix for NeXT Step
;; Should probably be eliminated in later versions.
(if (and (vip-window-display-p) (eq (vip-device-type) 'ns))
(progn
(fset 'x-display-color-p (symbol-function 'ns-display-color-p))
(fset 'x-color-defined-p (symbol-function 'ns-color-defined-p))
))
(if vip-xemacs-p
(progn
(fset 'vip-read-event (symbol-function 'next-command-event))
......@@ -189,6 +93,7 @@ that Viper doesn't know about.")
(fset 'vip-color-defined-p (symbol-function 'x-color-defined-p))
)))
(fset 'vip-characterp
(symbol-function
(if vip-xemacs-p 'characterp 'integerp)))
......@@ -242,7 +147,7 @@ that Viper doesn't know about.")
(modify-frame-parameters
(selected-frame) (list (cons 'cursor-color new-color)))))
(defsubst vip-save-cursor-color ()
(defun vip-save-cursor-color ()
(if (and (vip-window-display-p) (vip-color-display-p))
(let ((color (vip-get-cursor-color)))
(if (and (stringp color) (vip-color-defined-p color)
......@@ -256,6 +161,115 @@ that Viper doesn't know about.")
(defsubst vip-restore-cursor-color-after-insert ()
(vip-change-cursor-color vip-saved-cursor-color))
;; Face-saving tricks
(defvar vip-search-face
(if (vip-has-face-support-p)
(progn
(make-face 'vip-search-face)
(vip-hide-face 'vip-search-face)
(or (face-differs-from-default-p 'vip-search-face)
;; face wasn't set in .vip or .Xdefaults
(if (vip-can-use-colors "Black" "khaki")
(progn
(set-face-background 'vip-search-face "khaki")
(set-face-foreground 'vip-search-face "Black"))
(set-face-underline-p 'vip-search-face t)
(vip-set-face-pixmap 'vip-search-face vip-search-face-pixmap)))
'vip-search-face))
"*Face used to flash out the search pattern.")
(defvar vip-replace-overlay-face
(if (vip-has-face-support-p)
(progn
(make-face 'vip-replace-overlay-face)
(vip-hide-face 'vip-replace-overlay-face)
(or (face-differs-from-default-p 'vip-replace-overlay-face)
(progn
(if (vip-can-use-colors "darkseagreen2" "Black")
(progn
(set-face-background
'vip-replace-overlay-face "darkseagreen2")
(set-face-foreground 'vip-replace-overlay-face "Black")))
(set-face-underline-p 'vip-replace-overlay-face t)
(vip-set-face-pixmap
'vip-replace-overlay-face vip-replace-overlay-pixmap)))
'vip-replace-overlay-face))
"*Face for highlighting replace regions on a window display.")
(defvar vip-minibuffer-emacs-face
(if (vip-has-face-support-p)
(progn
(make-face 'vip-minibuffer-emacs-face)
(vip-hide-face 'vip-minibuffer-emacs-face)
(or (face-differs-from-default-p 'vip-minibuffer-emacs-face)
;; face wasn't set in .vip or .Xdefaults
(if vip-vi-style-in-minibuffer
;; emacs state is an exception in the minibuffer
(if (vip-can-use-colors "darkseagreen2" "Black")
(progn
(set-face-background
'vip-minibuffer-emacs-face "darkseagreen2")
(set-face-foreground
'vip-minibuffer-emacs-face "Black"))
(copy-face 'modeline 'vip-minibuffer-emacs-face))
;; emacs state is the main state in the minibuffer
(if (vip-can-use-colors "Black" "pink")
(progn
(set-face-background 'vip-minibuffer-emacs-face "pink")
(set-face-foreground
'vip-minibuffer-emacs-face "Black"))
(copy-face 'italic 'vip-minibuffer-emacs-face))
))
'vip-minibuffer-emacs-face))
"Face used in the Minibuffer when it is in Emacs state.")
(defvar vip-minibuffer-insert-face
(if (vip-has-face-support-p)
(progn
(make-face 'vip-minibuffer-insert-face)
(vip-hide-face 'vip-minibuffer-insert-face)
(or (face-differs-from-default-p 'vip-minibuffer-insert-face)
(if vip-vi-style-in-minibuffer
(if (vip-can-use-colors "Black" "pink")
(progn
(set-face-background 'vip-minibuffer-insert-face "pink")
(set-face-foreground
'vip-minibuffer-insert-face "Black"))
(copy-face 'italic 'vip-minibuffer-insert-face))
;; If Insert state is an exception
</