diff options
Diffstat (limited to 'lisp/emulation')
| -rw-r--r-- | lisp/emulation/edt-lk201.el | 55 | ||||
| -rw-r--r-- | lisp/emulation/edt-mapper.el | 405 | ||||
| -rw-r--r-- | lisp/emulation/edt-pc.el | 85 | ||||
| -rw-r--r-- | lisp/emulation/edt-vt100.el | 44 | ||||
| -rw-r--r-- | lisp/emulation/edt.el | 2018 | ||||
| -rw-r--r-- | lisp/emulation/mlconvert.el | 288 | ||||
| -rw-r--r-- | lisp/emulation/mlsupport.el | 435 | ||||
| -rw-r--r-- | lisp/emulation/pc-mode.el | 52 | ||||
| -rw-r--r-- | lisp/emulation/pc-select.el | 689 | ||||
| -rw-r--r-- | lisp/emulation/tpu-edt.el | 2490 | ||||
| -rw-r--r-- | lisp/emulation/tpu-extras.el | 477 | ||||
| -rw-r--r-- | lisp/emulation/tpu-mapper.el | 395 | ||||
| -rw-r--r-- | lisp/emulation/vi.el | 1467 | ||||
| -rw-r--r-- | lisp/emulation/vip.el | 3045 | ||||
| -rw-r--r-- | lisp/emulation/viper-ex.el | 2029 | ||||
| -rw-r--r-- | lisp/emulation/viper-keym.el | 584 | ||||
| -rw-r--r-- | lisp/emulation/viper-macs.el | 943 | ||||
| -rw-r--r-- | lisp/emulation/viper-mous.el | 459 | ||||
| -rw-r--r-- | lisp/emulation/viper-util.el | 1269 | ||||
| -rw-r--r-- | lisp/emulation/viper.el | 5892 | ||||
| -rw-r--r-- | lisp/emulation/ws-mode.el | 753 |
21 files changed, 0 insertions, 23874 deletions
diff --git a/lisp/emulation/edt-lk201.el b/lisp/emulation/edt-lk201.el deleted file mode 100644 index 8695914579a..00000000000 --- a/lisp/emulation/edt-lk201.el +++ /dev/null @@ -1,55 +0,0 @@ -;;; edt-lk201.el --- Enhanced EDT Keypad Mode Emulation for LK-201 Keyboards - -;; Copyright (C) 1986, 1992, 1993, 1995 Free Software Foundation, Inc. - -;; Author: Kevin Gallagher <kgallagh@spd.dsccc.com> -;; Maintainer: Kevin Gallagher <kgallagh@spd.dsccc.com> -;; Keywords: emulations - -;; This file is part of GNU Emacs. - -;; 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 -;; the Free Software Foundation; either version 2, 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 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Usage: - -;; See edt-user.doc in the Emacs etc directory. - -;; ==================================================================== - -;;;; -;;;; KEY TRANSLATIONS -;;;; - -;; Associate EDT keynames with Emacs terminal function vector names. -;; (Function key vector names for LK-201 are found in lisp/term/lk201.el.) -;; -;; F1 - F5 are not available on many DEC VT series terminals. -;; However, this is not always the case. So support for F1 - F5 is -;; provided here and in lisp/term/lk201.el. -(defconst *EDT-keys* - '(("KP0" . [kp-0]) ("KP1" . [kp-1]) ("KP2" . [kp-2]) ("KP3" . [kp-3]) - ("KP4" . [kp-4]) ("KP5" . [kp-5]) ("KP6" . [kp-6]) ("KP7" . [kp-7]) - ("KP8" . [kp-8]) ("KP9" . [kp-9]) ("KP," . [kp-separator]) - ("KP-" . [kp-subtract]) ("KPP" . [kp-decimal]) ("KPE" . [kp-enter]) - ("PF1" . [kp-f1]) ("PF2" . [kp-f2]) ("PF3" . [kp-f3]) ("PF4" . [kp-f4]) - ("UP" . [up]) ("DOWN" . [down]) ("RIGHT" . [right]) ("LEFT" . [left]) - ("FIND" . [find]) ("INSERT" . [insert]) ("REMOVE" . [delete]) - ("SELECT" . [select]) ("PREVIOUS" . [prior]) ("NEXT" . [next]) - ("F1" . [f1]) ("F2" . [f2]) ("F3" . [f3]) ("F4" . [f4]) ("F5" . [f5]) - ("F6" . [f6]) ("F7" . [f7]) ("F8" . [f8]) ("F9" . [f9]) ("F10" . [f10]) - ("F11" . [f11]) ("F12" . [f12]) ("F13" . [f13]) ("F14" . [f14]) - ("HELP" . [help]) ("DO" . [menu]) ("F17" . [f17]) ("F18" . [f18]) - ("F19" . [f19]) ("F20" . [f20]))) diff --git a/lisp/emulation/edt-mapper.el b/lisp/emulation/edt-mapper.el deleted file mode 100644 index ebebb92ad25..00000000000 --- a/lisp/emulation/edt-mapper.el +++ /dev/null @@ -1,405 +0,0 @@ -;;; edt-mapper.el --- Create an EDT LK-201 Map File for X-Windows Emacs - -;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. - -;; Author: Kevin Gallagher <kgallagh@spd.dsccc.com> -;; Maintainer: Kevin Gallagher <kgallagh@spd.dsccc.com> -;; Keywords: emulations - -;; This file is part of GNU Emacs. - -;; 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 -;; the Free Software Foundation; either version 2, 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 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This emacs lisp program can be used to create an emacs lisp file -;; that defines the mapping of the user's keyboard under X-Windows to -;; the LK-201 keyboard function keys and keypad keys (around which -;; EDT has been designed). Please read the "Usage" AND "Known -;; Problems" sections before attempting to run this program. (The -;; design of this file, edt-mapper.el, was heavily influenced by -;; tpu-mapper.el.) - -;;; Usage: - -;; Simply load this file into the X-Windows version of emacs (version 19) -;; using the following command. - -;; emacs -q -l edt-mapper.el - -;; The "-q" option prevents loading of your .emacs file (commands therein -;; might confuse this program). - -;; An instruction screen showing the typical LK-201 terminal functions keys -;; will be displayed, and you will be prompted to press the keys on your -;; keyboard which you want to emulate the corresponding LK-201 keys. - -;; Finally, you will be prompted for the name of the file to store -;; the key definitions. If you chose the default, it will be found -;; and loaded automatically when the EDT emulation is started. If -;; you specify a different file name, you will need to set the -;; variable "edt-xkeys-file" before starting the EDT emulation. -;; Here's how you might go about doing that in your .emacs file. - -;; (setq edt-xkeys-file (expand-file-name "~/.my-emacs-x-keys")) - -;;; Known Problems: - -;; Sometimes, edt-mapper will ignore a key you press, and just continue to -;; prompt for the same key. This can happen when your window manager sucks -;; up the key and doesn't pass it on to emacs, or it could be an emacs bug. -;; Either way, there's nothing that edt-mapper can do about it. You must -;; press RETURN, to skip the current key and continue. Later, you and/or -;; your local X guru can try to figure out why the key is being ignored. - -;; ==================================================================== - -;;; -;;; Make sure we're running X-windows and Emacs version 19 -;;; -(cond - ((not (and window-system (not (string-lessp emacs-version "19")))) - (insert " - - Whoa! This isn't going to work... - - You must run edt-mapper.el under X-windows and Emacs version 19. - - Press any key to exit. ") - (sit-for 600) - (kill-emacs t))) - - -;;; -;;; Decide whether we're running GNU or Lucid emacs. -;;; -(defconst edt-lucid-emacs19-p (string-match "Lucid" emacs-version) - "Non-NIL if we are running Lucid Emacs version 19.") - - -;;; -;;; Key variables -;;; -(defvar edt-key nil) -(defvar edt-enter nil) -(defvar edt-return nil) -(defvar edt-key-seq nil) -(defvar edt-enter-seq nil) -(defvar edt-return-seq nil) - - -;;; -;;; Make sure the window is big enough to display the instructions -;;; -(if edt-lucid-emacs19-p (set-screen-size nil 80 36) - (set-frame-size (selected-frame) 80 36)) - - -;;; -;;; Create buffers - Directions and Keys -;;; -(if (not (get-buffer "Directions")) (generate-new-buffer "Directions")) -(if (not (get-buffer "Keys")) (generate-new-buffer "Keys")) - -;;; -;;; Put header in the Keys buffer -;;; -(set-buffer "Keys") -(insert "\ -;; -;; Key definitions for the EDT emulation within GNU Emacs -;; - -(defconst *EDT-keys* - '( -") - -;;; -;;; Display directions -;;; -(switch-to-buffer "Directions") -(insert " - EDT MAPPER - - You will be asked to press keys to create a custom mapping (under - X-Windows) of your keypad keys and function keys so that they can emulate - the LK-201 keypad and function keys or the subset of keys found on a - VT-100 series terminal keyboard. (The LK-201 keyboard is the standard - keyboard attached to VT-200 series terminals, and above.) - - Sometimes, edt-mapper will ignore a key you press, and just continue to - prompt for the same key. This can happen when your window manager sucks - up the key and doesn't pass it on to emacs, or it could be an emacs bug. - Either way, there's nothing that edt-mapper can do about it. You must - press RETURN, to skip the current key and continue. Later, you and/or - your local X guru can try to figure out why the key is being ignored. - - Start by pressing the RETURN key, and continue by pressing the keys - specified in the mini-buffer. If you want to entirely omit a key, - because your keyboard does not have a corresponding key, for example, - just press RETURN at the prompt. - -") -(delete-other-windows) - -;;; -;;; Save <CR> for future reference -;;; -(cond - (edt-lucid-emacs19-p - (setq edt-return-seq (read-key-sequence "Hit carriage-return <CR> to continue ")) - (setq edt-return (concat "[" (format "%s" (event-key (aref edt-return-seq 0))) "]"))) - (t - (message "Hit carriage-return <CR> to continue ") - (setq edt-return-seq (read-event)) - (setq edt-return (concat "[" (format "%s" edt-return-seq) "]")))) - -;;; -;;; Display Keypad Diagram and Begin Prompting for Keys -;;; -(set-buffer "Directions") -(delete-region (point-min) (point-max)) -(insert " - - - - PRESS THE KEY SPECIFIED IN THE MINIBUFFER BELOW. - - - - - Here's a picture of the standard LK-201 keypad for reference: - - _______________________ _______________________________ - | HELP | DO | | F17 | F18 | F19 | F20 | - | | | | | | | | - |_______|_______________| |_______|_______|_______|_______| - _______________________ _______________________________ - | FIND |INSERT |REMOVE | | PF1 | PF2 | PF3 | PF4 | - | | | | | | | | | - |_______|_______|_______| |_______|_______|_______|_______| - |SELECT |PREVIOU| NEXT | | KP7 | KP8 | KP9 | KP- | - | | | | | | | | | - |_______|_______|_______| |_______|_______|_______|_______| - | UP | | KP4 | KP5 | KP6 | KP, | - | | | | | | | - _______|_______|_______ |_______|_______|_______|_______| - | LEFT | DOWN | RIGHT | | KP1 | KP2 | KP3 | | - | | | | | | | | | - |_______|_______|_______| |_______|_______|_______| KPE | - | KP0 | KPP | | - | | | | - |_______________|_______|_______| - -") - -;;; -;;; Key mapping functions -;;; -(defun edt-lucid-map-key (ident descrip func gold-func) - (interactive) - (setq edt-key-seq (read-key-sequence (format "Press %s%s: " ident descrip))) - (setq edt-key (concat "[" (format "%s" (event-key (aref edt-key-seq 0))) "]")) - (cond ((not (equal edt-key edt-return)) - (set-buffer "Keys") - (insert (format " (\"%s\" . %s)\n" ident edt-key)) - (set-buffer "Directions")) - ;; bogosity to get next prompt to come up, if the user hits <CR>! - ;; check periodically to see if this is still needed... - (t - (format "%s" edt-key))) - edt-key) - -(defun edt-gnu-map-key (ident descrip) - (interactive) - (message "Press %s%s: " ident descrip) - (setq edt-key-seq (read-event)) - (setq edt-key (concat "[" (format "%s" edt-key-seq) "]")) - (cond ((not (equal edt-key edt-return)) - (set-buffer "Keys") - (insert (format " (\"%s\" . %s)\n" ident edt-key)) - (set-buffer "Directions")) - ;; bogosity to get next prompt to come up, if the user hits <CR>! - ;; check periodically to see if this is still needed... - (t - (set-buffer "Keys") - (insert (format " (\"%s\" . \"\" )\n" ident)) - (set-buffer "Directions"))) - edt-key) - -(fset 'edt-map-key (if edt-lucid-emacs19-p 'edt-lucid-map-key 'edt-gnu-map-key)) -(set-buffer "Keys") -(insert " -;; -;; Arrows -;; -") -(set-buffer "Directions") - -(edt-map-key "UP" " - The Up Arrow Key") -(edt-map-key "DOWN" " - The Down Arrow Key") -(edt-map-key "LEFT" " - The Left Arrow Key") -(edt-map-key "RIGHT" " - The Right Arrow Key") - - -(set-buffer "Keys") -(insert " -;; -;; PF keys -;; -") -(set-buffer "Directions") - -(edt-map-key "PF1" " - The PF1 (GOLD) Key") -(edt-map-key "PF2" " - The Keypad PF2 Key") -(edt-map-key "PF3" " - The Keypad PF3 Key") -(edt-map-key "PF4" " - The Keypad PF4 Key") - -(set-buffer "Keys") -(insert " -;; -;; KP0-9 KP- KP, KPP and KPE -;; -") -(set-buffer "Directions") - -(edt-map-key "KP0" " - The Keypad 0 Key") -(edt-map-key "KP1" " - The Keypad 1 Key") -(edt-map-key "KP2" " - The Keypad 2 Key") -(edt-map-key "KP3" " - The Keypad 3 Key") -(edt-map-key "KP4" " - The Keypad 4 Key") -(edt-map-key "KP5" " - The Keypad 5 Key") -(edt-map-key "KP6" " - The Keypad 6 Key") -(edt-map-key "KP7" " - The Keypad 7 Key") -(edt-map-key "KP8" " - The Keypad 8 Key") -(edt-map-key "KP9" " - The Keypad 9 Key") -(edt-map-key "KP-" " - The Keypad - Key") -(edt-map-key "KP," " - The Keypad , Key") -(edt-map-key "KPP" " - The Keypad . Key") -(edt-map-key "KPE" " - The Keypad Enter Key") -;; Save the enter key -(setq edt-enter edt-key) -(setq edt-enter-seq edt-key-seq) - - -(set-buffer "Keys") -(insert " -;; -;; Editing keypad (FIND, INSERT, REMOVE) -;; (SELECT, PREVIOUS, NEXT) -;; -") -(set-buffer "Directions") - -(edt-map-key "FIND" " - The Find key on the editing keypad") -(edt-map-key "INSERT" " - The Insert key on the editing keypad") -(edt-map-key "REMOVE" " - The Remove key on the editing keypad") -(edt-map-key "SELECT" " - The Select key on the editing keypad") -(edt-map-key "PREVIOUS" " - The Prev Scr key on the editing keypad") -(edt-map-key "NEXT" " - The Next Scr key on the editing keypad") - -(set-buffer "Keys") -(insert " -;; -;; F1-14 Help Do F17-F20 -;; -") -(set-buffer "Directions") - -(edt-map-key "F1" " - F1 Function Key") -(edt-map-key "F2" " - F2 Function Key") -(edt-map-key "F3" " - F3 Function Key") -(edt-map-key "F4" " - F4 Function Key") -(edt-map-key "F5" " - F5 Function Key") -(edt-map-key "F6" " - F6 Function Key") -(edt-map-key "F7" " - F7 Function Key") -(edt-map-key "F8" " - F8 Function Key") -(edt-map-key "F9" " - F9 Function Key") -(edt-map-key "F10" " - F10 Function Key") -(edt-map-key "F11" " - F11 Function Key") -(edt-map-key "F12" " - F12 Function Key") -(edt-map-key "F13" " - F13 Function Key") -(edt-map-key "F14" " - F14 Function Key") -(edt-map-key "HELP" " - HELP Function Key") -(edt-map-key "DO" " - DO Function Key") -(edt-map-key "F17" " - F17 Function Key") -(edt-map-key "F18" " - F18 Function Key") -(edt-map-key "F19" " - F19 Function Key") -(edt-map-key "F20" " - F20 Function Key") - -(set-buffer "Directions") -(delete-region (point-min) (point-max)) -(insert " - ADDITIONAL FUNCTION KEYS - - Your keyboard may have additional function keys which do not - correspond to any LK-201 keys. The EDT Emulation can be - configured to recognize those keys, since you may wish to add your - own key bindings to those keys. - - For example, suppose your keyboard has a keycap marked \"Line Del\" - and you wish to add it to the list of keys which can be customized - by the EDT Emulation. First, assign a unique single-word name to - the key for use by the EDT Emulation, let's say \"linedel\", in this - example. Then, at the \"EDT Key Name:\" prompt, enter \"linedel\", - followed by a press of the RETURN key. Finally, when prompted, - press the \"Line Del\" key. You now will be able to bind functions - to \"linedel\" and \"Gold-linedel\" in edt-user.el in just the same way - you can customize bindings of the standard LK-201 keys. - - When you have no additional function keys to specify, just press - RETURN at the \"EDT Key Name:\" prompt. (If you change your mind - AFTER you enter an EDT Key Name and before you press a key at the - \"Press\" prompt, you may omit the key by simply pressing RETURN at - the prompt.) -") -(switch-to-buffer "Directions") -;;; -;;; Add support for extras keys -;;; -(set-buffer "Keys") -(insert "\ -;; -;; Extra Keys -;; -") -(setq EDT-key-name "") -(while (not - (string-equal (setq EDT-key-name (read-string "EDT Key Name: ")) "")) - (edt-map-key EDT-key-name "")) - -; -; No more keys to add, so wrap up. -; -(set-buffer "Keys") -(insert "\ - ) - ) -") - -;;; -;;; Save the key mapping program and blow this pop stand -;;; -(let ((file (if edt-lucid-emacs19-p "~/.edt-lucid-keys" "~/.edt-gnu-keys"))) - (set-visited-file-name - (read-file-name (format "Save key mapping to file (default %s): " file) nil file))) -(save-buffer) - -(message "That's it! Press any key to exit") -(sit-for 600) -(kill-emacs t) - -;;; edt-mapper.el ends here diff --git a/lisp/emulation/edt-pc.el b/lisp/emulation/edt-pc.el deleted file mode 100644 index 0130c98919c..00000000000 --- a/lisp/emulation/edt-pc.el +++ /dev/null @@ -1,85 +0,0 @@ -;;; edt-pc.el --- Enhanced EDT Keypad Mode Emulation for PC 101 Keyboards - -;; Copyright (C) 1986, 1994, 1995 Free Software Foundation, Inc. - -;; Author: Kevin Gallagher <kgallagh@spd.dsccc.com> -;; Maintainer: Kevin Gallagher <kgallagh@spd.dsccc.com> -;; Keywords: emulations - -;; This file is part of GNU Emacs. - -;; 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 -;; the Free Software Foundation; either version 2, 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 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Usage: - -;; See edt-user.doc in the Emacs etc directory. - -;; ==================================================================== - -;;;; -;;;; KEY TRANSLATIONS -;;;; - -;; Associate EDT keynames with Emacs terminal function vector names. -;; -;; To emulate the DEC LK-201 keypad keys on the PC 101 keyboard, -;; NumLock must be ON. -;; -;; The PC keypad keys are mapped to the corresponding DEC LK-201 -;; keypad keys according to the corresponding physical position on -;; the keyboard. Thus, the physical position of the PC keypad key -;; determines its function, not the PC keycap name. -;; -;; There are two LK-201 keypad keys needing special handling: PF1 and -;; the keypad comma key. -;; -;; PF1: -;; Most PC software does not see a press of the NumLock key. A TSR -;; program distributed with MS-Kermit to support its VT-100 emulation -;; solves this problem. The TSR, called GOLD, causes a press of the -;; keypad NumLock key to look as if the PC F1 key were pressed. So -;; the PC F1 key is mapped here to behave as the PF1 (GOLD) key. -;; Then with GOLD loaded, the NumLock key will behave as the GOLD key. -;; -;; By the way, with GOLD loaded, you can still toggle numlock on/off. -;; GOLD binds this to Shift-NumLock. -;; -;; Keypad Comma: -;; There is no physical PC keypad key to correspond to the LK-201 -;; keypad comma key. So, the EDT Emulation is configured below to -;; ignore attempts to bind functions to the keypad comma key. -;; -;; Finally, F2 through F12 are also available for making key bindings -;; in the EDT Emulation on the PC. F1 is reserved for the GOLD key, -;; so don't attempt to bind anything to it. Also, F13, F14, HELP, DO, -;; and F17 through F20 do not exist on the PC, so the EDT emulation is -;; configured below to ignore attempts to bind functions to those keys. -;; -(defconst *EDT-keys* - '(("KP0" . [kp-0]) ("KP1" . [kp-1]) ("KP2" . [kp-2]) ("KP3" . [kp-3]) - ("KP4" . [kp-4]) ("KP5" . [kp-5]) ("KP6" . [kp-6]) ("KP7" . [kp-7]) - ("KP8" . [kp-8]) ("KP9" . [kp-9]) ("KP," . "" ) - ("KP-" . [kp-add]) ("KPP" . [kp-decimal]) ("KPE" . [kp-enter]) - ("PF1" . [f1]) ("PF2" . [kp-divide]) ("PF3" . [kp-multiply]) - ("PF4" . [kp-subtract]) - ("UP" . [up]) ("DOWN" . [down]) ("RIGHT" . [right]) ("LEFT" . [left]) - ("FIND" . [insert]) ("INSERT" . [home]) ("REMOVE" . [prior]) - ("SELECT" . [delete]) ("PREVIOUS" . [end]) ("NEXT" . [next]) - ("F1" . "" ) ("F2" . [f2]) ("F3" . [f3]) ("F4" . [f4]) ("F5" . [f5]) - ("F6" . [f6]) ("F7" . [f7]) ("F8" . [f8]) ("F9" . [f9]) ("F10" . [f10]) - ("F11" . [f11]) ("F12" . [f12]) ("F13" . "" ) ("F14" . "" ) - ("HELP" . "" ) ("DO" . "" ) ("F17" . "" ) ("F18" . "" ) - ("F19" . "" ) ("F20" . "" ))) diff --git a/lisp/emulation/edt-vt100.el b/lisp/emulation/edt-vt100.el deleted file mode 100644 index 4c2d225127b..00000000000 --- a/lisp/emulation/edt-vt100.el +++ /dev/null @@ -1,44 +0,0 @@ -;;; edt-vt100.el --- Enhanced EDT Keypad Mode Emulation for VT Series Terminals - -;; Copyright (C) 1986, 1992, 1993, 1995 Free Software Foundation, Inc. - -;; Author: Kevin Gallagher <kgallagh@spd.dsccc.com> -;; Maintainer: Kevin Gallagher <kgallagh@spd.dsccc.com> -;; Keywords: emulations - -;; This file is part of GNU Emacs. - -;; 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 -;; the Free Software Foundation; either version 2, 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 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Usage: - -;; See edt-user.doc in the Emacs etc directory. - -;; ==================================================================== - -;; Get keyboard function key mapping to EDT keys. -(load "edt-lk201" nil t) - -;; The following functions are called by the EDT screen width commands defined -;; in edt.el. - -(defun edt-set-term-width-80 () - "Set terminal width to 80 columns." - (vt100-wide-mode -1)) - -(defun edt-set-term-width-132 () - "Set terminal width to 132 columns." - (vt100-wide-mode 1)) diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el deleted file mode 100644 index 6ec3dbc3f1e..00000000000 --- a/lisp/emulation/edt.el +++ /dev/null @@ -1,2018 +0,0 @@ -;;; edt.el --- Enhanced EDT Keypad Mode Emulation for GNU Emacs 19 - -;; Copyright (C) 1986, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. - -;; Author: Kevin Gallagher <kgallagh@spd.dsccc.com> -;; Maintainer: Kevin Gallagher <kgallagh@spd.dsccc.com> -;; Keywords: emulations - -;; This file is part of GNU Emacs. - -;; 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 -;; the Free Software Foundation; either version 2, 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 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Usage: - -;; See edt-user.doc in the Emacs etc directory. - -;; ==================================================================== - -;;; Electric Help functions are used for keypad help displays. A few -;;; picture functions are used in rectangular cut and paste commands. -(require 'ehelp) -(require 'picture) - -;;;; -;;;; VARIABLES and CONSTANTS -;;;; - -(defvar edt-last-deleted-lines "" - "Last text deleted by an EDT emulation line delete command.") - -(defvar edt-last-deleted-words "" - "Last text deleted by an EDT emulation word delete command.") - -(defvar edt-last-deleted-chars "" - "Last text deleted by an EDT emulation character delete command.") - -(defvar edt-last-replaced-key-definition "" - "Key definition replaced with edt-define-key or edt-learn command.") - -(defvar edt-direction-string "" - "String indicating current direction of movement.") - -(defvar edt-select-mode nil - "Non-nil means select mode is active.") - -(defvar edt-select-mode-text "" - "Text displayed in mode line when select mode is active.") - -(defconst edt-select-mode-string " Select" - "String to indicate select mode is active.") - -(defconst edt-forward-string " ADVANCE" - "Direction string in mode line to indicate forward movement.") - -(defconst edt-backward-string " BACKUP" - "Direction string in mode line to indicate backward movement.") - -(defvar edt-default-map-active nil - "Non-nil indicates that default EDT emulation key bindings are active. -Nil means user-defined custom bindings are active.") - -(defvar edt-user-map-configured nil - "Non-nil indicates that user custom EDT key bindings are configured. -This means that an edt-user.el file was found in the user's load-path.") - -(defvar edt-keep-current-page-delimiter nil - "Non-nil leaves current value of page-delimiter unchanged. -Nil causes the page-delimiter variable to be set to to \"\\f\" -when edt-emulation-on is first invoked. Original value is restored -when edt-emulation-off is called.") - -(defvar edt-use-EDT-control-key-bindings nil - "Non-nil causes the control key bindings to be replaced with EDT bindings. -Nil (the default) means EDT control key bindings are not used and the current -control key bindings are retained for use in the EDT emulation.") - -(defvar edt-word-entities '(?\t) - "*Specifies the list of EDT word entity characters.") - -;;; -;;; Emacs version identifiers - currently referenced by -;;; -;;; o edt-emulation-on o edt-load-xkeys -;;; -(defconst edt-emacs19-p (not (string-lessp emacs-version "19")) - "Non-nil if we are running Lucid or GNU Emacs version 19.") - -(defconst edt-lucid-emacs19-p - (and edt-emacs19-p (string-match "Lucid" emacs-version)) - "Non-nil if we are running Lucid Emacs version 19.") - -(defconst edt-gnu-emacs19-p (and edt-emacs19-p (not edt-lucid-emacs19-p)) - "Non-nil if we are running GNU Emacs version 19.") - -(defvar edt-xkeys-file nil - "File mapping X function keys to LK-201 keyboard function and keypad keys.") - -;;;; -;;;; EDT Emulation Commands -;;;; - -;;; Almost all of EDT's keypad mode commands have equivalent -;;; counterparts in Emacs. Some behave the same way in Emacs as they -;;; do in EDT, but most do not. -;;; -;;; The following Emacs functions emulate, where practical, the exact -;;; behavior of the corresponding EDT keypad mode commands. In a few -;;; cases, the emulation is not exact, but it is close enough for most -;;; EDT die-hards. -;;; -;;; In a very few cases, we chose to use the superior Emacs way of -;;; handling things. For example, we do not emulate the EDT SUBS -;;; command. Instead, we chose to use the superior Emacs -;;; query-replace function. -;;; - -;;; -;;; PAGE -;;; -;;; Emacs uses the regexp assigned to page-delimiter to determine what -;;; marks a page break. This is normally "^\f", which causes the -;;; edt-page command to ignore form feeds not located at the beginning -;;; of a line. To emulate the EDT PAGE command exactly, -;;; page-delimiter is set to "\f" when EDT emulation is turned on, and -;;; restored to its original value when EDT emulation is turned off. -;;; But this can be overridden if the EDT definition is not desired by -;;; placing -;;; -;;; (setq edt-keep-current-page-delimiter t) -;;; -;;; in your .emacs file. - -(defun edt-page-forward (num) - "Move forward to just after next page delimiter. -Accepts a positive prefix argument for the number of page delimiters to move." - (interactive "p") - (edt-check-prefix num) - (if (eobp) - (error "End of buffer") - (progn - (forward-page num) - (if (eobp) - (edt-line-to-bottom-of-window) - (edt-line-to-top-of-window))))) - -(defun edt-page-backward (num) - "Move backward to just after previous page delimiter. -Accepts a positive prefix argument for the number of page delimiters to move." - (interactive "p") - (edt-check-prefix num) - (if (bobp) - (error "Beginning of buffer") - (progn - (backward-page num) - (edt-line-to-top-of-window)))) - -(defun edt-page (num) - "Move in current direction to next page delimiter. -Accepts a positive prefix argument for the number of page delimiters to move." - (interactive "p") - (if (equal edt-direction-string edt-forward-string) - (edt-page-forward num) - (edt-page-backward num))) - -;;; -;;; SECT -;;; -;;; EDT defaults a section size to be 16 lines of its one and only -;;; 24-line window. That's two-thirds of the window at a time. The -;;; EDT SECT commands moves the cursor, not the window. -;;; -;;; This emulation of EDT's SECT moves the cursor approximately two-thirds -;;; of the current window at a time. - -(defun edt-sect-forward (num) - "Move cursor forward two-thirds of a window. -Accepts a positive prefix argument for the number of sections to move." - (interactive "p") - (edt-check-prefix num) - (edt-line-forward (* (* (/ (- (window-height) 1) 3) 2) num))) - -(defun edt-sect-backward (num) - "Move cursor backward two-thirds of a window. -Accepts a positive prefix argument for the number of sections to move." - (interactive "p") - (edt-check-prefix num) - (edt-line-backward (* (* (/ (- (window-height) 1) 3) 2) num))) - -(defun edt-sect (num) - "Move in current direction a full window. -Accepts a positive prefix argument for the number windows to move." - (interactive "p") - (if (equal edt-direction-string edt-forward-string) - (edt-sect-forward num) - (edt-sect-backward num))) - -;;; -;;; BEGINNING OF LINE -;;; -;;; EDT's beginning-of-line command is not affected by current -;;; direction, for some unknown reason. - -(defun edt-beginning-of-line (num) - "Move backward to next beginning of line mark. -Accepts a positive prefix argument for the number of BOL marks to move." - (interactive "p") - (edt-check-prefix num) - (if (bolp) - (forward-line (* -1 num)) - (progn - (setq num (1- num)) - (forward-line (* -1 num))))) - -;;; -;;; EOL (End of Line) -;;; - -(defun edt-end-of-line-forward (num) - "Move forward to next end of line mark. -Accepts a positive prefix argument for the number of EOL marks to move." - (interactive "p") - (edt-check-prefix num) - (forward-char) - (end-of-line num)) - -(defun edt-end-of-line-backward (num) - "Move backward to next end of line mark. -Accepts a positive prefix argument for the number of EOL marks to move." - (interactive "p") - (edt-check-prefix num) - (end-of-line (1- num))) - -(defun edt-end-of-line (num) - "Move in current direction to next end of line mark. -Accepts a positive prefix argument for the number of EOL marks to move." - (interactive "p") - (if (equal edt-direction-string edt-forward-string) - (edt-end-of-line-forward num) - (edt-end-of-line-backward num))) - -;;; -;;; WORD -;;; -;;; This one is a tad messy. To emulate EDT's behavior everywhere in -;;; the file (beginning of file, end of file, beginning of line, end -;;; of line, etc.) it takes a bit of special handling. -;;; -;;; The variable edt-word-entities contains a list of characters which -;;; are to be viewed as distinct words where ever they appear in the -;;; buffer. This emulates the EDT line mode command SET ENTITY WORD. - - -(defun edt-one-word-forward () - "Move forward to first character of next word." - (interactive) - (if (eobp) - (error "End of buffer")) - (if (eolp) - (forward-char) - (progn - (if (memq (following-char) edt-word-entities) - (forward-char) - (while (and - (not (eolp)) - (not (eobp)) - (not (eq ?\ (char-syntax (following-char)))) - (not (memq (following-char) edt-word-entities))) - (forward-char))) - (while (and - (not (eolp)) - (not (eobp)) - (eq ?\ (char-syntax (following-char))) - (not (memq (following-char) edt-word-entities))) - (forward-char))))) - -(defun edt-one-word-backward () - "Move backward to first character of previous word." - (interactive) - (if (bobp) - (error "Beginning of buffer")) - (if (bolp) - (backward-char) - (progn - (backward-char) - (while (and - (not (bolp)) - (not (bobp)) - (eq ?\ (char-syntax (following-char))) - (not (memq (following-char) edt-word-entities))) - (backward-char)) - (if (not (memq (following-char) edt-word-entities)) - (while (and - (not (bolp)) - (not (bobp)) - (not (eq ?\ (char-syntax (preceding-char)))) - (not (memq (preceding-char) edt-word-entities))) - (backward-char)))))) - -(defun edt-word-forward (num) - "Move forward to first character of next word. -Accepts a positive prefix argument for the number of words to move." - (interactive "p") - (edt-check-prefix num) - (while (> num 0) - (edt-one-word-forward) - (setq num (1- num)))) - -(defun edt-word-backward (num) - "Move backward to first character of previous word. -Accepts a positive prefix argument for the number of words to move." - (interactive "p") - (edt-check-prefix num) - (while (> num 0) - (edt-one-word-backward) - (setq num (1- num)))) - -(defun edt-word (num) - "Move in current direction to first character of next word. -Accepts a positive prefix argument for the number of words to move." - (interactive "p") - (if (equal edt-direction-string edt-forward-string) - (edt-word-forward num) - (edt-word-backward num))) - -;;; -;;; CHAR -;;; - -(defun edt-character (num) - "Move in current direction to next character. -Accepts a positive prefix argument for the number of characters to move." - (interactive "p") - (edt-check-prefix num) - (if (equal edt-direction-string edt-forward-string) - (forward-char num) - (backward-char num))) - -;;; -;;; LINE -;;; -;;; When direction is set to BACKUP, LINE behaves just like BEGINNING -;;; OF LINE in EDT. So edt-line-backward is not really needed as a -;;; separate function. - -(defun edt-line-backward (num) - "Move backward to next beginning of line mark. -Accepts a positive prefix argument for the number of BOL marks to move." - (interactive "p") - (edt-beginning-of-line num)) - -(defun edt-line-forward (num) - "Move forward to next beginning of line mark. -Accepts a positive prefix argument for the number of BOL marks to move." - (interactive "p") - (edt-check-prefix num) - (forward-line num)) - -(defun edt-line (num) - "Move in current direction to next beginning of line mark. -Accepts a positive prefix argument for the number of BOL marks to move." - (interactive "p") - (if (equal edt-direction-string edt-forward-string) - (edt-line-forward num) - (edt-line-backward num))) - -;;; -;;; TOP -;;; - -(defun edt-top () - "Move cursor to the beginning of buffer." - (interactive) - (goto-char (point-min))) - -;;; -;;; BOTTOM -;;; - -(defun edt-bottom () - "Move cursor to the end of buffer." - (interactive) - (goto-char (point-max)) - (edt-line-to-bottom-of-window)) - -;;; -;;; FIND -;;; - -(defun edt-find-forward (&optional find) - "Find first occurrence of a string in forward direction and save it." - (interactive) - (if (not find) - (set 'search-last-string (read-string "Search forward: "))) - (if (search-forward search-last-string) - (search-backward search-last-string))) - -(defun edt-find-backward (&optional find) - "Find first occurrence of a string in the backward direction and save it." - (interactive) - (if (not find) - (set 'search-last-string (read-string "Search backward: "))) - (search-backward search-last-string)) - -(defun edt-find () - "Find first occurrence of string in current direction and save it." - (interactive) - (set 'search-last-string (read-string "Search: ")) - (if (equal edt-direction-string edt-forward-string) - (edt-find-forward t) - (edt-find-backward t))) - - -;;; -;;; FNDNXT -;;; - -(defun edt-find-next-forward () - "Find next occurrence of a string in forward direction." - (interactive) - (forward-char 1) - (if (search-forward search-last-string nil t) - (search-backward search-last-string) - (progn - (backward-char 1) - (error "Search failed: \"%s\"." search-last-string)))) - -(defun edt-find-next-backward () - "Find next occurrence of a string in backward direction." - (interactive) - (if (eq (search-backward search-last-string nil t) nil) - (progn - (error "Search failed: \"%s\"." search-last-string)))) - -(defun edt-find-next () - "Find next occurrence of a string in current direction." - (interactive) - (if (equal edt-direction-string edt-forward-string) - (edt-find-next-forward) - (edt-find-next-backward))) - -;;; -;;; APPEND -;;; - -(defun edt-append () - "Append this kill region to last killed region." - (interactive "*") - (edt-check-selection) - (append-next-kill) - (kill-region (mark) (point)) - (message "Selected text APPENDED to kill ring")) - -;;; -;;; DEL L -;;; - -(defun edt-delete-line (num) - "Delete from cursor up to and including the end of line mark. -Accepts a positive prefix argument for the number of lines to delete." - (interactive "*p") - (edt-check-prefix num) - (let ((beg (point))) - (forward-line num) - (if (not (eq (preceding-char) ?\n)) - (insert "\n")) - (setq edt-last-deleted-lines - (buffer-substring beg (point))) - (delete-region beg (point)))) - -;;; -;;; DEL EOL -;;; - -(defun edt-delete-to-end-of-line (num) - "Delete from cursor up to but excluding the end of line mark. -Accepts a positive prefix argument for the number of lines to delete." - (interactive "*p") - (edt-check-prefix num) - (let ((beg (point))) - (forward-char 1) - (end-of-line num) - (setq edt-last-deleted-lines - (buffer-substring beg (point))) - (delete-region beg (point)))) - -;;; -;;; SELECT -;;; - -(defun edt-select-mode (arg) - "Turn EDT select mode off if ARG is nil; otherwise, turn EDT select mode on. -In select mode, selected text is highlighted." - (if arg - (progn - (make-local-variable 'edt-select-mode) - (setq edt-select-mode 'edt-select-mode-text) - (setq rect-start-point (window-point))) - (progn - (kill-local-variable 'edt-select-mode))) - (force-mode-line-update)) - -(defun edt-select () - "Set mark at cursor and start text selection." - (interactive) - (set-mark-command nil)) - -(defun edt-reset () - "Cancel text selection." - (interactive) - (deactivate-mark)) - -;;; -;;; CUT -;;; - -(defun edt-cut () - "Deletes selected text but copies to kill ring." - (interactive "*") - (edt-check-selection) - (kill-region (mark) (point)) - (message "Selected text CUT to kill ring")) - -;;; -;;; DELETE TO BEGINNING OF LINE -;;; - -(defun edt-delete-to-beginning-of-line (num) - "Delete from cursor to beginning of line. -Accepts a positive prefix argument for the number of lines to delete." - (interactive "*p") - (edt-check-prefix num) - (let ((beg (point))) - (edt-beginning-of-line num) - (setq edt-last-deleted-lines - (buffer-substring (point) beg)) - (delete-region beg (point)))) - -;;; -;;; DEL W -;;; - -(defun edt-delete-word (num) - "Delete from cursor up to but excluding first character of next word. -Accepts a positive prefix argument for the number of words to delete." - (interactive "*p") - (edt-check-prefix num) - (let ((beg (point))) - (edt-word-forward num) - (setq edt-last-deleted-words (buffer-substring beg (point))) - (delete-region beg (point)))) - -;;; -;;; DELETE TO BEGINNING OF WORD -;;; - -(defun edt-delete-to-beginning-of-word (num) - "Delete from cursor to beginning of word. -Accepts a positive prefix argument for the number of words to delete." - (interactive "*p") - (edt-check-prefix num) - (let ((beg (point))) - (edt-word-backward num) - (setq edt-last-deleted-words (buffer-substring (point) beg)) - (delete-region beg (point)))) - -;;; -;;; DEL C -;;; - -(defun edt-delete-character (num) - "Delete character under cursor. -Accepts a positive prefix argument for the number of characters to delete." - (interactive "*p") - (edt-check-prefix num) - (setq edt-last-deleted-chars - (buffer-substring (point) (min (point-max) (+ (point) num)))) - (delete-region (point) (min (point-max) (+ (point) num)))) - -;;; -;;; DELETE CHAR -;;; - -(defun edt-delete-previous-character (num) - "Delete character in front of cursor. -Accepts a positive prefix argument for the number of characters to delete." - (interactive "*p") - (edt-check-prefix num) - (setq edt-last-deleted-chars - (buffer-substring (max (point-min) (- (point) num)) (point))) - (delete-region (max (point-min) (- (point) num)) (point))) - -;;; -;;; UND L -;;; - -(defun edt-undelete-line () - "Undelete previous deleted line(s)." - (interactive "*") - (point-to-register 1) - (insert edt-last-deleted-lines) - (register-to-point 1)) - -;;; -;;; UND W -;;; - -(defun edt-undelete-word () - "Undelete previous deleted word(s)." - (interactive "*") - (point-to-register 1) - (insert edt-last-deleted-words) - (register-to-point 1)) - -;;; -;;; UND C -;;; - -(defun edt-undelete-character () - "Undelete previous deleted character(s)." - (interactive "*") - (point-to-register 1) - (insert edt-last-deleted-chars) - (register-to-point 1)) - -;;; -;;; REPLACE -;;; - -(defun edt-replace () - "Replace marked section with last CUT (killed) text." - (interactive "*") - (exchange-point-and-mark) - (let ((beg (point))) - (exchange-point-and-mark) - (delete-region beg (point))) - (yank)) - -;;; -;;; ADVANCE -;;; - -(defun edt-advance () - "Set movement direction forward. -Also, execute command specified if in Minibuffer." - (interactive) - (setq edt-direction-string edt-forward-string) - (force-mode-line-update) - (if (string-equal " *Minibuf" - (substring (buffer-name) 0 (min (length (buffer-name)) 9))) - (exit-minibuffer))) - -;;; -;;; BACKUP -;;; - -(defun edt-backup () - "Set movement direction backward. -Also, execute command specified if in Minibuffer." - (interactive) - (setq edt-direction-string edt-backward-string) - (force-mode-line-update) - (if (string-equal " *Minibuf" - (substring (buffer-name) 0 (min (length (buffer-name)) 9))) - (exit-minibuffer))) - -;;; -;;; CHNGCASE -;;; -;; This function is based upon Jeff Kowalski's case-flip function in his -;; tpu.el. - -(defun edt-change-case (num) - "Change the case of specified characters. -If text selection IS active, then characters between the cursor and mark are -changed. If text selection is NOT active, there are two cases. First, if the -current direction is ADVANCE, then the prefix number of character(s) under and -following cursor are changed. Second, if the current direction is BACKUP, then -the prefix number of character(s) before the cursor are changed. Accepts a -positive prefix for the number of characters to change, but the prefix is -ignored if text selection is active." - (interactive "*p") - (edt-check-prefix num) - (if edt-select-mode - (let ((end (max (mark) (point))) - (point-save (point))) - (goto-char (min (point) (mark))) - (while (not (eq (point) end)) - (funcall (if (<= ?a (following-char)) - 'upcase-region 'downcase-region) - (point) (1+ (point))) - (forward-char 1)) - (goto-char point-save)) - (progn - (if (string= edt-direction-string edt-backward-string) - (backward-char num)) - (while (> num 0) - (funcall (if (<= ?a (following-char)) - 'upcase-region 'downcase-region) - (point) (1+ (point))) - (forward-char 1) - (setq num (1- num)))))) - -;;; -;;; DEFINE KEY -;;; - -(defun edt-define-key () - "Assign an interactively-callable function to a specified key sequence. -The current key definition is saved in edt-last-replaced-key-definition. -Use edt-restore-key to restore last replaced key definition." - (interactive) - (let (edt-function - edt-key-definition-string) - (setq edt-key-definition-string - (read-key-sequence "Press the key to be defined: ")) - (if (string-equal "\C-m" edt-key-definition-string) - (message "Key not defined") - (progn - (setq edt-function (read-command "Enter command name: ")) - (if (string-equal "" edt-function) - (message "Key not defined") - (progn - (setq edt-last-replaced-key-definition - (lookup-key (current-global-map) edt-key-definition-string)) - (define-key (current-global-map) - edt-key-definition-string edt-function))))))) - -;;; -;;; FORM FEED INSERT -;;; - -(defun edt-form-feed-insert (num) - "Insert form feed character at cursor position. -Accepts a positive prefix argument for the number of form feeds to insert." - (interactive "*p") - (edt-check-prefix num) - (while (> num 0) - (insert ?\f) - (setq num (1- num)))) - -;;; -;;; TAB INSERT -;;; - -(defun edt-tab-insert (num) - "Insert tab character at cursor position. -Accepts a positive prefix argument for the number of tabs to insert." - (interactive "*p") - (edt-check-prefix num) - (while (> num 0) - (insert ?\t) - (setq num (1- num)))) - -;;; -;;; Check Prefix -;;; - -(defun edt-check-prefix (num) - "Indicate error if prefix is not positive." - (if (<= num 0) - (error "Prefix must be positive"))) - -;;; -;;; Check Selection -;;; - -(defun edt-check-selection () - "Indicate error if EDT selection is not active." - (if (not edt-select-mode) - (error "Selection NOT active"))) - -;;;; -;;;; ENHANCEMENTS AND ADDITIONS FOR EDT KEYPAD MODE -;;;; - -;;; -;;; Several enhancements and additions to EDT keypad mode commands are -;;; provided here. Some of these have been motivated by similar -;;; TPU/EVE and EVE-Plus commands. Others are new. - -;;; -;;; CHANGE DIRECTION -;;; - -(defun edt-change-direction () - "Toggle movement direction." - (interactive) - (if (equal edt-direction-string edt-forward-string) - (edt-backup) - (edt-advance))) - -;;; -;;; TOGGLE SELECT -;;; - -(defun edt-toggle-select () - "Toggle to start (or cancel) text selection." - (interactive) - (if edt-select-mode - (edt-reset) - (edt-select))) - -;;; -;;; SENTENCE -;;; - -(defun edt-sentence-forward (num) - "Move forward to start of next sentence. -Accepts a positive prefix argument for the number of sentences to move." - (interactive "p") - (edt-check-prefix num) - (if (eobp) - (progn - (error "End of buffer")) - (progn - (forward-sentence num) - (edt-one-word-forward)))) - -(defun edt-sentence-backward (num) - "Move backward to next sentence beginning. -Accepts a positive prefix argument for the number of sentences to move." - (interactive "p") - (edt-check-prefix num) - (if (eobp) - (progn - (error "End of buffer")) - (backward-sentence num))) - -(defun edt-sentence (num) - "Move in current direction to next sentence. -Accepts a positive prefix argument for the number of sentences to move." - (interactive "p") - (if (equal edt-direction-string edt-forward-string) - (edt-sentence-forward num) - (edt-sentence-backward num))) - -;;; -;;; PARAGRAPH -;;; - -(defun edt-paragraph-forward (num) - "Move forward to beginning of paragraph. -Accepts a positive prefix argument for the number of paragraphs to move." - (interactive "p") - (edt-check-prefix num) - (while (> num 0) - (next-line 1) - (forward-paragraph) - (previous-line 1) - (if (eolp) - (next-line 1)) - (setq num (1- num)))) - -(defun edt-paragraph-backward (num) - "Move backward to beginning of paragraph. -Accepts a positive prefix argument for the number of paragraphs to move." - (interactive "p") - (edt-check-prefix num) - (while (> num 0) - (backward-paragraph) - (previous-line 1) - (if (eolp) (next-line 1)) - (setq num (1- num)))) - -(defun edt-paragraph (num) - "Move in current direction to next paragraph. -Accepts a positive prefix argument for the number of paragraph to move." - (interactive "p") - (if (equal edt-direction-string edt-forward-string) - (edt-paragraph-forward num) - (edt-paragraph-backward num))) - -;;; -;;; RESTORE KEY -;;; - -(defun edt-restore-key () - "Restore last replaced key definition. -Definition is stored in edt-last-replaced-key-definition." - (interactive) - (if edt-last-replaced-key-definition - (progn - (let (edt-key-definition-string) - (set 'edt-key-definition-string - (read-key-sequence "Press the key to be restored: ")) - (if (string-equal "\C-m" edt-key-definition-string) - (message "Key not restored") - (define-key (current-global-map) - edt-key-definition-string edt-last-replaced-key-definition)))) - (error "No replaced key definition to restore!"))) - -;;; -;;; WINDOW TOP -;;; - -(defun edt-window-top () - "Move the cursor to the top of the window." - (interactive) - (let ((start-column (current-column))) - (move-to-window-line 0) - (move-to-column start-column))) - -;;; -;;; WINDOW BOTTOM -;;; - -(defun edt-window-bottom () - "Move the cursor to the bottom of the window." - (interactive) - (let ((start-column (current-column))) - (move-to-window-line (- (window-height) 2)) - (move-to-column start-column))) - -;;; -;;; SCROLL WINDOW LINE -;;; - -(defun edt-scroll-window-forward-line () - "Move window forward one line leaving cursor at position in window." - (interactive) - (scroll-up 1)) - -(defun edt-scroll-window-backward-line () - "Move window backward one line leaving cursor at position in window." - (interactive) - (scroll-down 1)) - -(defun edt-scroll-line () - "Move window one line in current direction." - (interactive) - (if (equal edt-direction-string edt-forward-string) - (edt-scroll-window-forward-line) - (edt-scroll-window-backward-line))) - -;;; -;;; SCROLL WINDOW -;;; -;;; Scroll a window (less one line) at a time. Leave cursor in center of -;;; window. - -(defun edt-scroll-window-forward (num) - "Scroll forward one window in buffer, less one line. -Accepts a positive prefix argument for the number of windows to move." - (interactive "p") - (edt-check-prefix num) - (scroll-up (- (* (window-height) num) 2)) - (edt-line-forward (/ (- (window-height) 1) 2))) - -(defun edt-scroll-window-backward (num) - "Scroll backward one window in buffer, less one line. -Accepts a positive prefix argument for the number of windows to move." - (interactive "p") - (edt-check-prefix num) - (scroll-down (- (* (window-height) num) 2)) - (edt-line-backward (/ (- (window-height) 1) 2))) - -(defun edt-scroll-window (num) - "Scroll one window in buffer, less one line, in current direction. -Accepts a positive prefix argument for the number windows to move." - (interactive "p") - (if (equal edt-direction-string edt-forward-string) - (edt-scroll-window-forward num) - (edt-scroll-window-backward num))) - -;;; -;;; LINE TO BOTTOM OF WINDOW -;;; - -(defun edt-line-to-bottom-of-window () - "Move the current line to the bottom of the window." - (interactive) - (recenter -1)) - -;;; -;;; LINE TO TOP OF WINDOW -;;; - -(defun edt-line-to-top-of-window () - "Move the current line to the top of the window." - (interactive) - (recenter 0)) - -;;; -;;; LINE TO MIDDLE OF WINDOW -;;; - -(defun edt-line-to-middle-of-window () - "Move window so line with cursor is in the middle of the window." - (interactive) - (recenter '(4))) - -;;; -;;; GOTO PERCENTAGE -;;; - -(defun edt-goto-percentage (num) - "Move to specified percentage in buffer from top of buffer." - (interactive "NGoto-percentage: ") - (if (or (> num 100) (< num 0)) - (error "Percentage %d out of range 0 < percent < 100" num) - (goto-char (/ (* (point-max) num) 100)))) - -;;; -;;; FILL REGION -;;; - -(defun edt-fill-region () - "Fill selected text." - (interactive "*") - (edt-check-selection) - (fill-region (point) (mark))) - -;;; -;;; INDENT OR FILL REGION -;;; - -(defun edt-indent-or-fill-region () - "Fill region in text modes, indent region in programming language modes." - (interactive "*") - (if (string= paragraph-start "$\\|\f") - (indent-region (point) (mark) nil) - (fill-region (point) (mark)))) - -;;; -;;; MARK SECTION WISELY -;;; - -(defun edt-mark-section-wisely () - "Mark the section in a manner consistent with the major-mode. -Uses mark-defun for emacs-lisp and lisp, -mark-c-function for C, -mark-fortran-subsystem for fortran, -and mark-paragraph for other modes." - (interactive) - (if edt-select-mode - (progn - (edt-reset)) - (progn - (cond ((or (eq major-mode 'emacs-lisp-mode) - (eq major-mode 'lisp-mode)) - (mark-defun) - (message "Lisp defun selected")) - ((eq major-mode 'c-mode) - (mark-c-function) - (message "C function selected")) - ((eq major-mode 'fortran-mode) - (mark-fortran-subprogram) - (message "Fortran subprogram selected")) - (t (mark-paragraph) - (message "Paragraph selected")))))) - -;;; -;;; COPY -;;; - -(defun edt-copy () - "Copy selected region to kill ring, but don't delete it!" - (interactive) - (edt-check-selection) - (copy-region-as-kill (mark) (point)) - (edt-reset) - (message "Selected text COPIED to kill ring")) - -;;; -;;; CUT or COPY -;;; - -(defun edt-cut-or-copy () - "Cuts (or copies) selected text to kill ring. -Cuts selected text if buffer-read-only is nil. -Copies selected text if buffer-read-only is t." - (interactive) - (if buffer-read-only - (edt-copy) - (edt-cut))) - -;;; -;;; DELETE ENTIRE LINE -;;; - -(defun edt-delete-entire-line () - "Delete entire line regardless of cursor position in the line." - (interactive "*") - (beginning-of-line) - (edt-delete-line 1)) - -;;; -;;; DUPLICATE LINE -;;; - -(defun edt-duplicate-line (num) - "Duplicate a line of text. -Accepts a positive prefix argument for the number times to duplicate the line." - (interactive "*p") - (edt-check-prefix num) - (let ((old-column (current-column)) - (count num)) - (edt-delete-entire-line) - (edt-undelete-line) - (while (> count 0) - (edt-undelete-line) - (setq count (1- count))) - (edt-line-forward num) - (move-to-column old-column))) - -;;; -;;; DUPLICATE WORD -;;; - -(defun edt-duplicate-word() - "Duplicate word (or rest of word) found directly above cursor, if any." - (interactive "*") - (let ((start (point)) - (start-column (current-column))) - (forward-line -1) - (move-to-column start-column) - (if (and (not (equal start (point))) - (not (eolp))) - (progn - (if (and (equal ?\t (preceding-char)) - (< start-column (current-column))) - (backward-char)) - (let ((beg (point))) - (edt-one-word-forward) - (setq edt-last-copied-word (buffer-substring beg (point)))) - (forward-line) - (move-to-column start-column) - (insert edt-last-copied-word)) - (progn - (if (not (equal start (point))) - (forward-line)) - (move-to-column start-column) - (error "Nothing to duplicate!"))))) - -;;; -;;; KEY NOT ASSIGNED -;;; - -(defun edt-key-not-assigned () - "Displays message that key has not been assigned to a function." - (interactive) - (error "Key not assigned")) - -;;; -;;; TOGGLE CAPITALIZATION OF WORD -;;; - -(defun edt-toggle-capitalization-of-word () - "Toggle the capitalization of the current word and move forward to next." - (interactive "*") - (edt-one-word-forward) - (edt-one-word-backward) - (edt-change-case 1) - (edt-one-word-backward) - (edt-one-word-forward)) - -;;; -;;; ELIMINATE ALL TABS -;;; - -(defun edt-eliminate-all-tabs () - "Convert all tabs to spaces in the entire buffer." - (interactive "*") - (untabify (point-min) (point-max)) - (message "TABS converted to SPACES")) - -;;; -;;; DISPLAY THE TIME -;;; - -(defun edt-display-the-time () - "Display the current time." - (interactive) - (set 'time-string (current-time-string)) - (message "%s" time-string)) - -;;; -;;; LEARN -;;; - -(defun edt-learn () - "Learn a sequence of key strokes to bind to a key." - (interactive) - (if (eq defining-kbd-macro t) - (edt-remember) - (start-kbd-macro nil))) - -;;; -;;; REMEMBER -;;; - -(defun edt-remember () - "Store the sequence of key strokes started by edt-learn to a key." - (interactive) - (if (eq defining-kbd-macro nil) - (error "Nothing to remember!") - (progn - (end-kbd-macro nil) - (let (edt-key-definition-string) - (set 'edt-key-definition-string - (read-key-sequence "Enter key for binding: ")) - (if (string-equal "\C-m" edt-key-definition-string) - (message "Key sequence not remembered") - (progn - (set 'edt-learn-macro-count (+ edt-learn-macro-count 1)) - (setq edt-last-replaced-key-definition - (lookup-key (current-global-map) - edt-key-definition-string)) - (define-key (current-global-map) edt-key-definition-string - (name-last-kbd-macro - (intern (concat "last-learned-sequence-" - (int-to-string edt-learn-macro-count))))))))))) - -;;; -;;; EXIT -;;; - -(defun edt-exit () - "Save current buffer, ask to save other buffers, and then exit Emacs." - (interactive) - (save-buffer) - (save-buffers-kill-emacs)) - -;;; -;;; QUIT -;;; - -(defun edt-quit () - "Quit Emacs without saving changes." - (interactive) - (kill-emacs)) - -;;; -;;; SPLIT WINDOW -;;; - -(defun edt-split-window () - "Split current window and place cursor in the new window." - (interactive) - (split-window) - (other-window 1)) - -;;; -;;; COPY RECTANGLE -;;; - -(defun edt-copy-rectangle () - "Copy a rectangle of text between mark and cursor to register." - (interactive) - (edt-check-selection) - (copy-rectangle-to-register 3 (region-beginning) (region-end) nil) - (edt-reset) - (message "Selected rectangle COPIED to register")) - -;;; -;;; CUT RECTANGLE -;;; - -(defun edt-cut-rectangle-overstrike-mode () - "Cut a rectangle of text between mark and cursor to register. -Replace cut characters with spaces and moving cursor back to -upper left corner." - (interactive "*") - (edt-check-selection) - (setq edt-rect-start-point (region-beginning)) - (picture-clear-rectangle-to-register (region-beginning) (region-end) 3) - (set-window-point (get-buffer-window (window-buffer)) edt-rect-start-point) - (message "Selected rectangle CUT to register")) - -(defun edt-cut-rectangle-insert-mode () - "Cut a rectangle of text between mark and cursor to register. -Move cursor back to upper left corner." - (interactive "*") - (edt-check-selection) - (setq edt-rect-start-point (region-beginning)) - (picture-clear-rectangle-to-register (region-beginning) (region-end) 3 t) - (fixup-whitespace) - (set-window-point (get-buffer-window (window-buffer)) edt-rect-start-point) - (message "Selected rectangle CUT to register")) - -(defun edt-cut-rectangle () - "Cut a rectangular region of text to register. -If overwrite mode is active, cut text is replaced with whitespace." - (interactive "*") - (if overwrite-mode - (edt-cut-rectangle-overstrike-mode) - (edt-cut-rectangle-insert-mode))) - -;;; -;;; PASTE RECTANGLE -;;; - -(defun edt-paste-rectangle-overstrike-mode () - "Paste a rectangular region of text from register, replacing text at cursor." - (interactive "*") - (picture-yank-rectangle-from-register 3)) - -(defun edt-paste-rectangle-insert-mode () - "Paste previously deleted rectangular region, inserting text at cursor." - (interactive "*") - (picture-yank-rectangle-from-register 3 t)) - -(defun edt-paste-rectangle () - "Paste a rectangular region of text. -If overwrite mode is active, existing text is replace with text from register." - (interactive) - (if overwrite-mode - (edt-paste-rectangle-overstrike-mode) - (edt-paste-rectangle-insert-mode))) - -;;; -;;; DOWNCASE REGION -;;; - -(defun edt-lowercase () - "Change specified characters to lower case. -If text selection IS active, then characters between the cursor and -mark are changed. If text selection is NOT active, there are two -situations. If the current direction is ADVANCE, then the word under -the cursor is changed to lower case and the cursor is moved to rest at -the beginning of the next word. If the current direction is BACKUP, -the word prior to the word under the cursor is changed to lower case -and the cursor is left to rest at the beginning of that word." - (interactive "*") - (if edt-select-mode - (progn - (downcase-region (mark) (point))) - (progn - ;; Move to beginning of current word. - (if (and - (not (bobp)) - (not (eobp)) - (not (bolp)) - (not (eolp)) - (not (eq ?\ (char-syntax (preceding-char)))) - (not (memq (preceding-char) edt-word-entities)) - (not (memq (following-char) edt-word-entities))) - (edt-one-word-backward)) - (if (equal edt-direction-string edt-backward-string) - (edt-one-word-backward)) - (let ((beg (point))) - (edt-one-word-forward) - (downcase-region beg (point))) - (if (equal edt-direction-string edt-backward-string) - (edt-one-word-backward))))) - -;;; -;;; UPCASE REGION -;;; - -(defun edt-uppercase () - "Change specified characters to upper case. -If text selection IS active, then characters between the cursor and -mark are changed. If text selection is NOT active, there are two -situations. If the current direction is ADVANCE, then the word under -the cursor is changed to upper case and the cursor is moved to rest at -the beginning of the next word. If the current direction is BACKUP, -the word prior to the word under the cursor is changed to upper case -and the cursor is left to rest at the beginning of that word." - (interactive "*") - (if edt-select-mode - (progn - (upcase-region (mark) (point))) - (progn - ;; Move to beginning of current word. - (if (and - (not (bobp)) - (not (eobp)) - (not (bolp)) - (not (eolp)) - (not (eq ?\ (char-syntax (preceding-char)))) - (not (memq (preceding-char) edt-word-entities)) - (not (memq (following-char) edt-word-entities))) - (edt-one-word-backward)) - (if (equal edt-direction-string edt-backward-string) - (edt-one-word-backward)) - (let ((beg (point))) - (edt-one-word-forward) - (upcase-region beg (point))) - (if (equal edt-direction-string edt-backward-string) - (edt-one-word-backward))))) - - -;;; -;;; INITIALIZATION COMMANDS. -;;; - -;;; -;;; Emacs version 19 X-windows key definition support -;;; -(defvar edt-last-answer nil - "Most recent response to edt-y-or-n-p.") - -(defun edt-y-or-n-p (prompt &optional not-yes) - "Prompt for a y or n answer with positive default. -Optional second argument NOT-YES changes default to negative. -Like emacs y-or-n-p, also accepts space as y and DEL as n." - (message "%s[%s]" prompt (if not-yes "n" "y")) - (let ((doit t)) - (while doit - (setq doit nil) - (let ((ans (read-char))) - (cond ((or (= ans ?y) (= ans ?Y) (= ans ?\ )) - (setq edt-last-answer t)) - ((or (= ans ?n) (= ans ?N) (= ans ?\C-?)) - (setq edt-last-answer nil)) - ((= ans ?\r) (setq edt-last-answer (not not-yes))) - (t - (setq doit t) (beep) - (message "Please answer y or n. %s[%s]" - prompt (if not-yes "n" "y"))))))) - edt-last-answer) - -(defun edt-load-xkeys (file) - "Load the EDT X-windows key definitions FILE. -If FILE is nil, try to load a default file. The default file names are -~/.edt-lucid-keys for Lucid emacs, and ~/.edt-gnu-keys for GNU emacs." - (interactive "fX key definition file: ") - (cond (file - (setq file (expand-file-name file))) - (edt-xkeys-file - (setq file (expand-file-name edt-xkeys-file))) - (edt-gnu-emacs19-p - (setq file (expand-file-name "~/.edt-gnu-keys"))) - (edt-lucid-emacs19-p - (setq file (expand-file-name "~/.edt-lucid-keys")))) - (cond ((file-readable-p file) - (load-file file)) - (t - (switch-to-buffer "*scratch*") - (erase-buffer) - (insert " - - Ack!! You're running the Enhanced EDT Emulation under X-windows - without loading an EDT X key definition file. To create an EDT X - key definition file, run the edt-mapper.el program. But ONLY run - it from an Emacs loaded without any of your own customizations - found in your .emacs file, etc. Some user customization confuse - the edt-mapper function. To do this, you need to invoke Emacs - as follows: - - emacs -q -l edt-mapper.el - - The file edt-mapper.el includes these same directions on how to - use it! Perhaps it's lying around here someplace. \n ") - (let ((file "edt-mapper.el") - (found nil) - (path nil) - (search-list (append (list (expand-file-name ".")) load-path))) - (while (and (not found) search-list) - (setq path (concat (car search-list) - (if (string-match "/$" (car search-list)) "" "/") - file)) - (if (and (file-exists-p path) (not (file-directory-p path))) - (setq found t)) - (setq search-list (cdr search-list))) - (cond (found - (insert (format - "Ah yes, there it is, in \n\n %s \n\n" path)) - (if (edt-y-or-n-p "Do you want to run it now? ") - (load-file path) - (error "EDT Emulation not configured."))) - (t - (insert "Nope, I can't seem to find it. :-(\n\n") - (sit-for 20) - (error "EDT Emulation not configured."))))))) - -;;;###autoload -(defun edt-emulation-on () - "Turn on EDT Emulation." - (interactive) - ;; If using MS-DOS, need to load edt-pc.el - (if (eq system-type 'ms-dos) - (setq edt-term "pc") - (setq edt-term (getenv "TERM"))) - ;; All DEC VT series terminals are supported by loading edt-vt100.el - (if (string-equal "vt" (substring edt-term 0 (min (length edt-term) 2))) - (setq edt-term "vt100")) - ;; Load EDT terminal specific configuration file. - (let ((term edt-term) - hyphend) - (while (and term - (not (load (concat "edt-" term) t t))) - ;; Strip off last hyphen and what follows, then try again - (if (setq hyphend (string-match "[-_][^-_]+$" term)) - (setq term (substring term 0 hyphend)) - (setq term nil))) - ;; Override terminal-specific file if running X Windows. X Windows support - ;; is handled differently in edt-load-xkeys - (if (eq window-system 'x) - (edt-load-xkeys nil) - (if (null term) - (error "Unable to load EDT terminal specific file for %s" edt-term))) - (setq edt-term term)) - (setq edt-orig-transient-mark-mode transient-mark-mode) - (add-hook 'activate-mark-hook - (function - (lambda () - (edt-select-mode t)))) - (add-hook 'deactivate-mark-hook - (function - (lambda () - (edt-select-mode nil)))) - (if (load "edt-user" t t) - (edt-user-emulation-setup) - (edt-default-emulation-setup))) - -(defun edt-emulation-off() - "Select original global key bindings, disabling EDT Emulation." - (interactive) - (use-global-map global-map) - (if (not edt-keep-current-page-delimiter) - (setq page-delimiter edt-orig-page-delimiter)) - (setq edt-direction-string "") - (setq edt-select-mode-text nil) - (edt-reset) - (force-mode-line-update t) - (setq transient-mark-mode edt-orig-transient-mark-mode) - (message "Original key bindings restored; EDT Emulation disabled")) - -(defun edt-default-emulation-setup (&optional user-setup) - "Setup emulation of DEC's EDT editor." - ;; Setup default EDT global map by copying global map bindings. - ;; This preserves ESC and C-x prefix bindings and other bindings we - ;; wish to retain in EDT emulation mode keymaps. It also permits - ;; customization of these bindings in the EDT global maps without - ;; disturbing the original bindings in global-map. - (fset 'edt-default-ESC-prefix (copy-keymap 'ESC-prefix)) - (setq edt-default-global-map (copy-keymap (current-global-map))) - (define-key edt-default-global-map "\e" 'edt-default-ESC-prefix) - (define-prefix-command 'edt-default-gold-map) - (edt-setup-default-bindings) - ;; If terminal has additional function keys, the terminal-specific - ;; initialization file can assign bindings to them via the optional - ;; function edt-setup-extra-default-bindings. - (if (fboundp 'edt-setup-extra-default-bindings) - (edt-setup-extra-default-bindings)) - ;; Variable needed by edt-learn. - (setq edt-learn-macro-count 0) - ;; Display EDT text selection active within the mode line - (or (assq 'edt-select-mode minor-mode-alist) - (setq minor-mode-alist - (cons '(edt-select-mode edt-select-mode) minor-mode-alist))) - ;; Display EDT direction of motion within the mode line - (or (assq 'edt-direction-string minor-mode-alist) - (setq minor-mode-alist - (cons - '(edt-direction-string edt-direction-string) minor-mode-alist))) - (if user-setup - (progn - (setq edt-user-map-configured t) - (fset 'edt-emulation-on (symbol-function 'edt-select-user-global-map))) - (progn - (fset 'edt-emulation-on (symbol-function 'edt-select-default-global-map)) - (edt-select-default-global-map)))) - -(defun edt-user-emulation-setup () - "Setup user custom emulation of DEC's EDT editor." - ;; Initialize EDT default bindings. - (edt-default-emulation-setup t) - ;; Setup user EDT global map by copying default EDT global map bindings. - (fset 'edt-user-ESC-prefix (copy-keymap 'edt-default-ESC-prefix)) - (setq edt-user-global-map (copy-keymap edt-default-global-map)) - (define-key edt-user-global-map "\e" 'edt-user-ESC-prefix) - ;; If terminal has additional function keys, the user's initialization - ;; file can assign bindings to them via the optional - ;; function edt-setup-extra-default-bindings. - (define-prefix-command 'edt-user-gold-map) - (fset 'edt-user-gold-map (copy-keymap 'edt-default-gold-map)) - (edt-setup-user-bindings) - (edt-select-user-global-map)) - -(defun edt-select-default-global-map() - "Select default EDT emulation key bindings." - (interactive) - (transient-mark-mode 1) - (use-global-map edt-default-global-map) - (if (not edt-keep-current-page-delimiter) - (progn - (setq edt-orig-page-delimiter page-delimiter) - (setq page-delimiter "\f"))) - (setq edt-default-map-active t) - (edt-advance) - (setq edt-select-mode-text 'edt-select-mode-string) - (edt-reset) - (message "Default EDT keymap active")) - -(defun edt-select-user-global-map() - "Select user EDT emulation custom key bindings." - (interactive) - (if edt-user-map-configured - (progn - (transient-mark-mode 1) - (use-global-map edt-user-global-map) - (if (not edt-keep-current-page-delimiter) - (progn - (setq edt-orig-page-delimiter page-delimiter) - (setq page-delimiter "\f"))) - (setq edt-default-map-active nil) - (edt-advance) - (setq edt-select-mode-text 'edt-select-mode-string) - (edt-reset) - (message "User EDT custom keymap active")) - (error "User EDT custom keymap NOT configured!"))) - -(defun edt-switch-global-maps () - "Toggle between default EDT keymap and user EDT keymap." - (interactive) - (if edt-default-map-active - (edt-select-user-global-map) - (edt-select-default-global-map))) - -;; There are three key binding functions needed: one for standard keys -;; (used to bind control keys, primarily), one for Gold sequences of -;; standard keys, and one for function keys. - -(defun edt-bind-gold-key (key gold-binding &optional default) - "Binds commands to a gold key sequence in the EDT Emulator." - (if default - (define-key 'edt-default-gold-map key gold-binding) - (define-key 'edt-user-gold-map key gold-binding))) - -(defun edt-bind-standard-key (key gold-binding &optional default) - "Bind commands to a gold key sequence in the default EDT keymap." - (if default - (define-key edt-default-global-map key gold-binding) - (define-key edt-user-global-map key gold-binding))) - -(defun edt-bind-function-key - (function-key binding gold-binding &optional default) - "Binds function keys in the EDT Emulator." - (catch 'edt-key-not-supported - (let ((key-vector (cdr (assoc function-key *EDT-keys*)))) - (if (stringp key-vector) - (throw 'edt-key-not-supported t)) - (if (not (null key-vector)) - (progn - (if default - (progn - (define-key edt-default-global-map key-vector binding) - (define-key 'edt-default-gold-map key-vector gold-binding)) - (progn - (define-key edt-user-global-map key-vector binding) - (define-key 'edt-user-gold-map key-vector gold-binding)))) - (error "%s is not a legal function key name" function-key))))) - -(defun edt-setup-default-bindings () - "Assigns default EDT Emulation keyboard bindings." - - ;; Function Key Bindings: Regular and GOLD. - - ;; VT100/VT200/VT300 PF1 (GOLD), PF2, PF3, PF4 Keys - (edt-bind-function-key "PF1" 'edt-default-gold-map 'edt-mark-section-wisely t) - (edt-bind-function-key "PF2" 'edt-electric-keypad-help 'describe-function t) - (edt-bind-function-key "PF3" 'edt-find-next 'edt-find t) - (edt-bind-function-key "PF4" 'edt-delete-line 'edt-undelete-line t) - - ;; VT100/VT200/VT300 Arrow Keys - (edt-bind-function-key "UP" 'previous-line 'edt-window-top t) - (edt-bind-function-key "DOWN" 'next-line 'edt-window-bottom t) - (edt-bind-function-key "LEFT" 'backward-char 'edt-sentence-backward t) - (edt-bind-function-key "RIGHT" 'forward-char 'edt-sentence-forward t) - - ;; VT100/VT200/VT300 Keypad Keys - (edt-bind-function-key "KP0" 'edt-line 'open-line t) - (edt-bind-function-key "KP1" 'edt-word 'edt-change-case t) - (edt-bind-function-key "KP2" 'edt-end-of-line 'edt-delete-to-end-of-line t) - (edt-bind-function-key "KP3" 'edt-character 'quoted-insert t) - (edt-bind-function-key "KP4" 'edt-advance 'edt-bottom t) - (edt-bind-function-key "KP5" 'edt-backup 'edt-top t) - (edt-bind-function-key "KP6" 'edt-cut 'yank t) - (edt-bind-function-key "KP7" 'edt-page 'execute-extended-command t) - (edt-bind-function-key "KP8" 'edt-sect 'edt-fill-region t) - (edt-bind-function-key "KP9" 'edt-append 'edt-replace t) - (edt-bind-function-key "KP-" 'edt-delete-word 'edt-undelete-word t) - (edt-bind-function-key "KP," 'edt-delete-character 'edt-undelete-character t) - (edt-bind-function-key "KPP" 'edt-select 'edt-reset t) - (edt-bind-function-key "KPE" 'other-window 'query-replace t) - - ;; VT200/VT300 Function Keys - ;; (F1 through F5, on the VT220, are not programmable, so we skip - ;; making default bindings to those keys. - (edt-bind-function-key "FIND" 'edt-find-next 'edt-find t) - (edt-bind-function-key "INSERT" 'yank 'edt-key-not-assigned t) - (edt-bind-function-key "REMOVE" 'edt-cut 'edt-copy t) - (edt-bind-function-key "SELECT" 'edt-toggle-select 'edt-key-not-assigned t) - (edt-bind-function-key "NEXT" 'edt-sect-forward 'edt-key-not-assigned t) - (edt-bind-function-key "PREVIOUS" 'edt-sect-backward 'edt-key-not-assigned t) - (edt-bind-function-key "F6" 'edt-key-not-assigned 'edt-key-not-assigned t) - (edt-bind-function-key "F7" 'edt-copy-rectangle 'edt-key-not-assigned t) - (edt-bind-function-key "F8" - 'edt-cut-rectangle-overstrike-mode 'edt-paste-rectangle-overstrike-mode t) - (edt-bind-function-key "F9" - 'edt-cut-rectangle-insert-mode 'edt-paste-rectangle-insert-mode t) - (edt-bind-function-key "F10" 'edt-cut-rectangle 'edt-paste-rectangle t) - ;; Under X, the F11 key can be bound. If using a VT-200 or higher terminal, - ;; the default emacs terminal support causes the VT F11 key to seem as if it - ;; is an ESC key when in emacs. - (edt-bind-function-key "F11" - 'edt-key-not-assigned 'edt-key-not-assigned t) - (edt-bind-function-key "F12" - 'edt-beginning-of-line 'delete-other-windows t) ;BS - (edt-bind-function-key "F13" - 'edt-delete-to-beginning-of-word 'edt-key-not-assigned t) ;LF - (edt-bind-function-key "F14" 'edt-key-not-assigned 'edt-key-not-assigned t) - (edt-bind-function-key "HELP" 'edt-electric-keypad-help 'edt-key-not-assigned t) - (edt-bind-function-key "DO" 'execute-extended-command 'edt-key-not-assigned t) - (edt-bind-function-key "F17" 'edt-key-not-assigned 'edt-key-not-assigned t) - (edt-bind-function-key "F18" 'edt-key-not-assigned 'edt-key-not-assigned t) - (edt-bind-function-key "F19" 'edt-key-not-assigned 'edt-key-not-assigned t) - (edt-bind-function-key "F20" 'edt-key-not-assigned 'edt-key-not-assigned t) - - ;; Control key bindings: Regular and GOLD - ;; - ;; Standard EDT control key bindings conflict with standard Emacs - ;; control key bindings. Normally, the standard Emacs control key - ;; bindings are left unchanged in the default EDT mode. However, if - ;; the variable edt-use-EDT-control-key-bindings is set to true - ;; before invoking edt-emulation-on for the first time, then the - ;; standard EDT bindings (with some enhancements) as defined here are - ;; used, instead. - (if edt-use-EDT-control-key-bindings - (progn - (edt-bind-standard-key "\C-a" 'edt-key-not-assigned t) - (edt-bind-standard-key "\C-b" 'edt-key-not-assigned t) - ;; Leave binding of C-c as original prefix key. - (edt-bind-standard-key "\C-d" 'edt-key-not-assigned t) - (edt-bind-standard-key "\C-e" 'edt-key-not-assigned t) - (edt-bind-standard-key "\C-f" 'edt-key-not-assigned t) - ;; Leave binding of C-g to keyboard-quit -; (edt-bind-standard-key "\C-g" 'keyboard-quit t) - ;; Standard EDT binding of C-h. To invoke Emacs help, use - ;; GOLD-C-h instead. - (edt-bind-standard-key "\C-h" 'edt-beginning-of-line t) - (edt-bind-standard-key "\C-i" 'edt-tab-insert t) - (edt-bind-standard-key "\C-j" 'edt-delete-to-beginning-of-word t) - (edt-bind-standard-key "\C-k" 'edt-define-key t) - (edt-bind-gold-key "\C-k" 'edt-restore-key t) - (edt-bind-standard-key "\C-l" 'edt-form-feed-insert t) - ;; Leave binding of C-m to newline. - (edt-bind-standard-key "\C-n" 'edt-set-screen-width-80 t) - (edt-bind-standard-key "\C-o" 'edt-key-not-assigned t) - (edt-bind-standard-key "\C-p" 'edt-key-not-assigned t) - (edt-bind-standard-key "\C-q" 'edt-key-not-assigned t) - ;; Leave binding of C-r to isearch-backward. - ;; Leave binding of C-s to isearch-forward. - (edt-bind-standard-key "\C-t" 'edt-display-the-time t) - (edt-bind-standard-key "\C-u" 'edt-delete-to-beginning-of-line t) - (edt-bind-standard-key "\C-v" 'redraw-display t) - (edt-bind-standard-key "\C-w" 'edt-set-screen-width-132 t) - ;; Leave binding of C-x as original prefix key. - (edt-bind-standard-key "\C-y" 'edt-key-not-assigned t) -; (edt-bind-standard-key "\C-z" 'suspend-emacs t) - ) - ) - - ;; GOLD bindings for a few Control keys. - (edt-bind-gold-key "\C-g" 'keyboard-quit t); Just in case. - (edt-bind-gold-key "\C-h" 'help-for-help t) - (edt-bind-gold-key [f1] 'help-for-help t) - (edt-bind-gold-key [help] 'help-for-help t) - (edt-bind-gold-key "\C-\\" 'split-window-vertically t) - - ;; GOLD bindings for regular keys. - (edt-bind-gold-key "a" 'edt-key-not-assigned t) - (edt-bind-gold-key "A" 'edt-key-not-assigned t) - (edt-bind-gold-key "b" 'buffer-menu t) - (edt-bind-gold-key "B" 'buffer-menu t) - (edt-bind-gold-key "c" 'compile t) - (edt-bind-gold-key "C" 'compile t) - (edt-bind-gold-key "d" 'delete-window t) - (edt-bind-gold-key "D" 'delete-window t) - (edt-bind-gold-key "e" 'edt-exit t) - (edt-bind-gold-key "E" 'edt-exit t) - (edt-bind-gold-key "f" 'find-file t) - (edt-bind-gold-key "F" 'find-file t) - (edt-bind-gold-key "g" 'find-file-other-window t) - (edt-bind-gold-key "G" 'find-file-other-window t) - (edt-bind-gold-key "h" 'edt-electric-keypad-help t) - (edt-bind-gold-key "H" 'edt-electric-keypad-help t) - (edt-bind-gold-key "i" 'insert-file t) - (edt-bind-gold-key "I" 'insert-file t) - (edt-bind-gold-key "j" 'edt-key-not-assigned t) - (edt-bind-gold-key "J" 'edt-key-not-assigned t) - (edt-bind-gold-key "k" 'edt-toggle-capitalization-of-word t) - (edt-bind-gold-key "K" 'edt-toggle-capitalization-of-word t) - (edt-bind-gold-key "l" 'edt-lowercase t) - (edt-bind-gold-key "L" 'edt-lowercase t) - (edt-bind-gold-key "m" 'save-some-buffers t) - (edt-bind-gold-key "M" 'save-some-buffers t) - (edt-bind-gold-key "n" 'next-error t) - (edt-bind-gold-key "N" 'next-error t) - (edt-bind-gold-key "o" 'switch-to-buffer-other-window t) - (edt-bind-gold-key "O" 'switch-to-buffer-other-window t) - (edt-bind-gold-key "p" 'edt-key-not-assigned t) - (edt-bind-gold-key "P" 'edt-key-not-assigned t) - (edt-bind-gold-key "q" 'edt-quit t) - (edt-bind-gold-key "Q" 'edt-quit t) - (edt-bind-gold-key "r" 'revert-buffer t) - (edt-bind-gold-key "R" 'revert-buffer t) - (edt-bind-gold-key "s" 'save-buffer t) - (edt-bind-gold-key "S" 'save-buffer t) - (edt-bind-gold-key "t" 'edt-key-not-assigned t) - (edt-bind-gold-key "T" 'edt-key-not-assigned t) - (edt-bind-gold-key "u" 'edt-uppercase t) - (edt-bind-gold-key "U" 'edt-uppercase t) - (edt-bind-gold-key "v" 'find-file-other-window t) - (edt-bind-gold-key "V" 'find-file-other-window t) - (edt-bind-gold-key "w" 'write-file t) - (edt-bind-gold-key "W" 'write-file t) - (edt-bind-gold-key "x" 'edt-key-not-assigned t) - (edt-bind-gold-key "X" 'edt-key-not-assigned t) - (edt-bind-gold-key "y" 'edt-emulation-off t) - (edt-bind-gold-key "Y" 'edt-emulation-off t) - (edt-bind-gold-key "z" 'edt-switch-global-maps t) - (edt-bind-gold-key "Z" 'edt-switch-global-maps t) - (edt-bind-gold-key "1" 'delete-other-windows t) - (edt-bind-gold-key "!" 'edt-key-not-assigned t) - (edt-bind-gold-key "2" 'edt-split-window t) - (edt-bind-gold-key "@" 'edt-key-not-assigned t) - (edt-bind-gold-key "3" 'edt-key-not-assigned t) - (edt-bind-gold-key "#" 'edt-key-not-assigned t) - (edt-bind-gold-key "4" 'edt-key-not-assigned t) - (edt-bind-gold-key "$" 'edt-key-not-assigned t) - (edt-bind-gold-key "5" 'edt-key-not-assigned t) - (edt-bind-gold-key "%" 'edt-goto-percentage t) - (edt-bind-gold-key "6" 'edt-key-not-assigned t) - (edt-bind-gold-key "^" 'edt-key-not-assigned t) - (edt-bind-gold-key "7" 'edt-key-not-assigned t) - (edt-bind-gold-key "&" 'edt-key-not-assigned t) - (edt-bind-gold-key "8" 'edt-key-not-assigned t) - (edt-bind-gold-key "*" 'edt-key-not-assigned t) - (edt-bind-gold-key "9" 'edt-key-not-assigned t) - (edt-bind-gold-key "(" 'edt-key-not-assigned t) - (edt-bind-gold-key "0" 'edt-key-not-assigned t) - (edt-bind-gold-key ")" 'edt-key-not-assigned t) - (edt-bind-gold-key " " 'undo t) - (edt-bind-gold-key "," 'edt-key-not-assigned t) - (edt-bind-gold-key "<" 'edt-key-not-assigned t) - (edt-bind-gold-key "." 'edt-key-not-assigned t) - (edt-bind-gold-key ">" 'edt-key-not-assigned t) - (edt-bind-gold-key "/" 'edt-key-not-assigned t) - (edt-bind-gold-key "?" 'edt-key-not-assigned t) - (edt-bind-gold-key "\\" 'edt-key-not-assigned t) - (edt-bind-gold-key "|" 'edt-key-not-assigned t) - (edt-bind-gold-key ";" 'edt-key-not-assigned t) - (edt-bind-gold-key ":" 'edt-key-not-assigned t) - (edt-bind-gold-key "'" 'edt-key-not-assigned t) - (edt-bind-gold-key "\"" 'edt-key-not-assigned t) - (edt-bind-gold-key "-" 'edt-key-not-assigned t) - (edt-bind-gold-key "_" 'edt-key-not-assigned t) - (edt-bind-gold-key "=" 'goto-line t) - (edt-bind-gold-key "+" 'edt-key-not-assigned t) - (edt-bind-gold-key "[" 'edt-key-not-assigned t) - (edt-bind-gold-key "{" 'edt-key-not-assigned t) - (edt-bind-gold-key "]" 'edt-key-not-assigned t) - (edt-bind-gold-key "}" 'edt-key-not-assigned t) - (edt-bind-gold-key "`" 'what-line t) - (edt-bind-gold-key "~" 'edt-key-not-assigned t) -) - -;;; -;;; DEFAULT EDT KEYPAD HELP -;;; - -;;; -;;; Upper case commands in the keypad diagram below indicate that the -;;; emulation should look and feel very much like EDT. Lower case -;;; commands are enhancements and/or additions to the EDT keypad -;;; commands or are native Emacs commands. -;;; - -(defun edt-keypad-help () - " - DEFAULT EDT Keypad Active - - F7: Copy Rectangle +----------+----------+----------+----------+ - F8: Cut Rect Overstrike |Prev Line |Next Line |Bkwd Char |Frwd Char | - G-F8: Paste Rect Overstrike | (UP) | (DOWN) | (LEFT) | (RIGHT) | - F9: Cut Rect Insert |Window Top|Window Bot|Bkwd Sent |Frwd Sent | - G-F9: Paste Rect Insert +----------+----------+----------+----------+ - F10: Cut Rectangle -G-F10: Paste Rectangle - F11: ESC - F12: Begining of Line +----------+----------+----------+----------+ -G-F12: Delete Other Windows | GOLD | HELP | FNDNXT | DEL L | - F13: Delete to Begin of Word | (PF1) | (PF2) | (PF3) | (PF4) | - HELP: Keypad Help |Mark Wisel|Desc Funct| FIND | UND L | - DO: Execute extended command +----------+----------+----------+----------+ - | PAGE | SECT | APPEND | DEL W | - C-g: Keyboard Quit | (7) | (8) | (9) | (-) | -G-C-g: Keyboard Quit |Ex Ext Cmd|Fill Regio| REPLACE | UND W | - C-h: Beginning of Line +----------+----------+----------+----------+ -G-C-h: Emacs Help | ADVANCE | BACKUP | CUT | DEL C | - C-i: Tab Insert | (4) | (5) | (6) | (,) | - C-j: Delete to Begin of Word | BOTTOM | TOP | Yank | UND C | - C-k: Define Key +----------+----------+----------+----------+ -G-C-k: Restore Key | WORD | EOL | CHAR | Next | - C-l: Form Feed Insert | (1) | (2) | (3) | Window | - C-n: Set Screen Width 80 | CHNGCASE | DEL EOL |Quoted Ins| ! - C-r: Isearch Backward +---------------------+----------+ (ENTER) | - C-s: Isearch Forward | LINE | SELECT | ! - C-t: Display the Time | (0) | (.) | Query | - C-u: Delete to Begin of Line | Open Line | RESET | Replace | - C-v: Redraw Display +---------------------+----------+----------+ - C-w: Set Screen Width 132 - C-z: Suspend Emacs +----------+----------+----------+ -G-C-\\: Split Window | FNDNXT | Yank | CUT | - | (FIND) | (INSERT) | (REMOVE) | - G-b: Buffer Menu | FIND | | COPY | - G-c: Compile +----------+----------+----------+ - G-d: Delete Window |SELECT/RES|SECT BACKW|SECT FORWA| - G-e: Exit | (SELECT) |(PREVIOUS)| (NEXT) | - G-f: Find File | | | | - G-g: Find File Other Window +----------+----------+----------+ - G-h: Keypad Help - G-i: Insert File - G-k: Toggle Capitalization Word - G-l: Downcase Region - G-m: Save Some Buffers - G-n: Next Error - G-o: Switch to Next Window - G-q: Quit - G-r: Revert File - G-s: Save Buffer - G-u: Upcase Region - G-v: Find File Other Window - G-w: Write file - G-y: EDT Emulation OFF - G-z: Switch to User EDT Key Bindings - G-1: Delete Other Windows - G-2: Split Window - G-%: Go to Percentage - G- : Undo (GOLD Spacebar) - G-=: Go to Line - G-`: What line" - - (interactive) - (describe-function 'edt-keypad-help)) - -(defun edt-electric-helpify (fun) - (let ((name "*Help*")) - (if (save-window-excursion - (let* ((p (symbol-function 'print-help-return-message)) - (b (get-buffer name)) - (m (buffer-modified-p b))) - (and b (not (get-buffer-window b)) - (setq b nil)) - (unwind-protect - (progn - (message "%s..." (capitalize (symbol-name fun))) - (and b - (save-excursion - (set-buffer b) - (set-buffer-modified-p t))) - (fset 'print-help-return-message 'ignore) - (call-interactively fun) - (and (get-buffer name) - (get-buffer-window (get-buffer name)) - (or (not b) - (not (eq b (get-buffer name))) - (not (buffer-modified-p b))))) - (fset 'print-help-return-message p) - (and b (buffer-name b) - (save-excursion - (set-buffer b) - (set-buffer-modified-p m)))))) - (with-electric-help 'delete-other-windows name t)))) - -(defun edt-electric-keypad-help () - "Display default EDT bindings." - (interactive) - (edt-electric-helpify 'edt-keypad-help)) - -(defun edt-electric-user-keypad-help () - "Display user custom EDT bindings." - (interactive) - (edt-electric-helpify 'edt-user-keypad-help)) - -;;; -;;; EDT emulation screen width commands. -;;; -;; Some terminals require modification of terminal attributes when changing the -;; number of columns displayed, hence the fboundp tests below. These functions -;; are defined in the corresponding terminal specific file, if needed. - -(defun edt-set-screen-width-80 () - "Set screen width to 80 columns." - (interactive) - (if (fboundp 'edt-set-term-width-80) - (edt-set-term-width-80)) - (set-screen-width 80) - (message "Screen width 80")) - -(defun edt-set-screen-width-132 () - "Set screen width to 132 columns." - (interactive) - (if (fboundp 'edt-set-term-width-132) - (edt-set-term-width-132)) - (set-screen-width 132) - (message "Screen width 132")) - -(provide 'edt) - -;;; edt.el ends here diff --git a/lisp/emulation/mlconvert.el b/lisp/emulation/mlconvert.el deleted file mode 100644 index 3ded26469ff..00000000000 --- a/lisp/emulation/mlconvert.el +++ /dev/null @@ -1,288 +0,0 @@ -;;; mlconvert.el --- convert buffer of Mocklisp code to real lisp. - -;; Copyright (C) 1985 Free Software Foundation, Inc. - -;; Maintainer: FSF -;; Keywords: emulations - -;; This file is part of GNU Emacs. - -;; 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 -;; the Free Software Foundation; either version 2, 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 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This package converts Mocklisp code written under a Gosling or UniPress -;; Emacs for use with GNU Emacs. The translated code will require runtime -;; support from the mlsupport.el equivalent. - -;;; Code: - -;;;###autoload -(defun convert-mocklisp-buffer () - "Convert buffer of Mocklisp code to real Lisp that GNU Emacs can run." - (interactive) - (emacs-lisp-mode) - (set-syntax-table (copy-sequence (syntax-table))) - (modify-syntax-entry ?\| "w") - (message "Converting mocklisp (ugh!)...") - (goto-char (point-min)) - (fix-mlisp-syntax) - - ;; Emulation of mocklisp is accurate only within a mocklisp-function - ;; so turn any non-function into a defun and then call it. - (goto-char (point-min)) - (condition-case ignore - (while t - (let ((opt (point)) - (form (read (current-buffer)))) - (and (listp form) - (not (eq (car form) 'defun)) - (progn (insert "))\n\n(ml-foo)\n\n") - (save-excursion - (goto-char opt) - (skip-chars-forward "\n") - (insert "(defun (ml-foo \n ")))))) - (end-of-file nil)) - - (goto-char (point-min)) - (insert ";;; GNU Emacs code converted from Mocklisp\n") - (insert "(require 'mlsupport)\n\n") - (fix-mlisp-symbols) - - (goto-char (point-min)) - (message "Converting mocklisp...done")) - -(defun fix-mlisp-syntax () - (while (re-search-forward "['\"]" nil t) - (if (= (preceding-char) ?\") - (progn (forward-char -1) - (forward-sexp 1)) - (delete-char -1) - (insert "?") - (if (or (= (following-char) ?\\) (= (following-char) ?^)) - (forward-char 1) - (if (looking-at "[^a-zA-Z]") - (insert ?\\))) - (forward-char 1) - (delete-char 1)))) - -(defun fix-mlisp-symbols () - (while (progn - (skip-chars-forward " \t\n()") - (not (eobp))) - (cond ((or (= (following-char) ?\?) - (= (following-char) ?\")) - (forward-sexp 1)) - ((= (following-char) ?\;) - (forward-line 1)) - (t - (let ((start (point)) prop) - (forward-sexp 1) - (setq prop (get (intern-soft (buffer-substring start (point))) - 'mocklisp)) - (cond ((null prop)) - ((stringp prop) - (delete-region start (point)) - (insert prop)) - (t - (save-excursion - (goto-char start) - (funcall prop))))))))) - -(defun ml-expansion (ml-name lisp-string) - (put ml-name 'mocklisp lisp-string)) - -(ml-expansion 'defun "ml-defun") -(ml-expansion 'if "ml-if") -(ml-expansion 'setq '(lambda () - (if (looking-at "setq[ \t\n]+buffer-modified-p") - (replace-match "set-buffer-modified-p")))) - -;;(ml-expansion 'while '(lambda () -;; (let ((end (progn (forward-sexp 2) (point-marker))) -;; (start (progn (forward-sexp -1) (point)))) -;; (let ((cond (buffer-substring start end))) -;; (cond ((equal cond "1") -;; (delete-region (point) end) -;; (insert "t")) -;; (t -;; (insert "(not (zerop ") -;; (goto-char end) -;; (insert "))"))) -;; (set-marker end nil) -;; (goto-char start))))) - -(ml-expansion 'arg "ml-arg") -(ml-expansion 'nargs "ml-nargs") -(ml-expansion 'interactive "ml-interactive") -(ml-expansion 'message "ml-message") -(ml-expansion 'print "ml-print") -(ml-expansion 'set "ml-set") -(ml-expansion 'set-default "ml-set-default") -(ml-expansion 'provide-prefix-argument "ml-provide-prefix-argument") -(ml-expansion 'prefix-argument-loop "ml-prefix-argument-loop") -(ml-expansion 'prefix-argument "ml-prefix-arg") -(ml-expansion 'use-local-map "ml-use-local-map") -(ml-expansion 'use-global-map "ml-use-global-map") -(ml-expansion 'modify-syntax-entry "ml-modify-syntax-entry") -(ml-expansion 'error-message "error") - -(ml-expansion 'dot "point-marker") -(ml-expansion 'mark "mark-marker") -(ml-expansion 'beginning-of-file "beginning-of-buffer") -(ml-expansion 'end-of-file "end-of-buffer") -(ml-expansion 'exchange-dot-and-mark "exchange-point-and-mark") -(ml-expansion 'set-mark "set-mark-command") -(ml-expansion 'argument-prefix "universal-arg") - -(ml-expansion 'previous-page "ml-previous-page") -(ml-expansion 'next-page "ml-next-page") -(ml-expansion 'next-window "ml-next-window") -(ml-expansion 'previous-window "ml-previous-window") - -(ml-expansion 'newline "ml-newline") -(ml-expansion 'next-line "ml-next-line") -(ml-expansion 'previous-line "ml-previous-line") -(ml-expansion 'self-insert "self-insert-command") -(ml-expansion 'meta-digit "digit-argument") -(ml-expansion 'meta-minus "negative-argument") - -(ml-expansion 'newline-and-indent "ml-newline-and-indent") -(ml-expansion 'yank-from-killbuffer "yank") -(ml-expansion 'yank-buffer "insert-buffer") -(ml-expansion 'copy-region "copy-region-as-kill") -(ml-expansion 'delete-white-space "delete-horizontal-space") -(ml-expansion 'widen-region "widen") - -(ml-expansion 'forward-word '(lambda () - (if (looking-at "forward-word[ \t\n]*)") - (replace-match "forward-word 1)")))) -(ml-expansion 'backward-word '(lambda () - (if (looking-at "backward-word[ \t\n]*)") - (replace-match "backward-word 1)")))) - -(ml-expansion 'forward-paren "forward-list") -(ml-expansion 'backward-paren "backward-list") -(ml-expansion 'search-reverse "ml-search-backward") -(ml-expansion 're-search-reverse "ml-re-search-backward") -(ml-expansion 'search-forward "ml-search-forward") -(ml-expansion 're-search-forward "ml-re-search-forward") -(ml-expansion 'quote "regexp-quote") -(ml-expansion 're-query-replace "query-replace-regexp") -(ml-expansion 're-replace-string "replace-regexp") - -; forward-paren-bl, backward-paren-bl - -(ml-expansion 'get-tty-character "read-char") -(ml-expansion 'get-tty-input "read-input") -(ml-expansion 'get-tty-string "read-string") -(ml-expansion 'get-tty-buffer "read-buffer") -(ml-expansion 'get-tty-command "read-command") -(ml-expansion 'get-tty-variable "read-variable") -(ml-expansion 'get-tty-no-blanks-input "read-no-blanks-input") -(ml-expansion 'get-tty-key "read-key") - -(ml-expansion 'concat "ml-concat") -(ml-expansion 'c= "char-equal") -(ml-expansion 'goto-character "goto-char") -(ml-expansion 'substr "ml-substr") -(ml-expansion 'variable-apropos "apropos") -(ml-expansion 'execute-mlisp-buffer "eval-current-buffer") -(ml-expansion 'execute-mlisp-file "load") -(ml-expansion 'visit-file "find-file") -(ml-expansion 'read-file "find-file") -(ml-expansion 'write-modified-files "save-some-buffers") -(ml-expansion 'backup-before-writing "make-backup-files") -(ml-expansion 'write-file-exit "save-buffers-kill-emacs") -(ml-expansion 'write-named-file "write-file") -(ml-expansion 'change-file-name "set-visited-file-name") -(ml-expansion 'change-buffer-name "rename-buffer") -(ml-expansion 'buffer-exists "get-buffer") -(ml-expansion 'delete-buffer "kill-buffer") -(ml-expansion 'unlink-file "delete-file") -(ml-expansion 'unlink-checkpoint-files "delete-auto-save-files") -(ml-expansion 'file-exists "file-exists-p") -(ml-expansion 'write-current-file "save-buffer") -(ml-expansion 'change-directory "cd") -(ml-expansion 'temp-use-buffer "set-buffer") -(ml-expansion 'fast-filter-region "filter-region") - -(ml-expansion 'pending-input "input-pending-p") -(ml-expansion 'execute-keyboard-macro "call-last-kbd-macro") -(ml-expansion 'start-remembering "start-kbd-macro") -(ml-expansion 'end-remembering "end-kbd-macro") -(ml-expansion 'define-keyboard-macro "name-last-kbd-macro") -(ml-expansion 'define-string-macro "ml-define-string-macro") - -(ml-expansion 'current-column "ml-current-column") -(ml-expansion 'current-indent "ml-current-indent") -(ml-expansion 'insert-character "insert") - -(ml-expansion 'users-login-name "user-login-name") -(ml-expansion 'users-full-name "user-full-name") -(ml-expansion 'current-time "current-time-string") -(ml-expansion 'current-numeric-time "current-numeric-time-you-lose") -(ml-expansion 'current-buffer-name "buffer-name") -(ml-expansion 'current-file-name "buffer-file-name") - -(ml-expansion 'local-binding-of "local-key-binding") -(ml-expansion 'global-binding-of "global-key-binding") - -;defproc (ProcedureType, "procedure-type"); - -(ml-expansion 'remove-key-binding "global-unset-key") -(ml-expansion 'remove-binding "global-unset-key") -(ml-expansion 'remove-local-binding "local-unset-key") -(ml-expansion 'remove-all-local-bindings "use-local-map nil") -(ml-expansion 'autoload "ml-autoload") - -(ml-expansion 'checkpoint-frequency "auto-save-interval") - -(ml-expansion 'mode-string "mode-name") -(ml-expansion 'right-margin "fill-column") -(ml-expansion 'tab-size "tab-width") -(ml-expansion 'default-right-margin "default-fill-column") -(ml-expansion 'default-tab-size "default-tab-width") -(ml-expansion 'buffer-is-modified "(buffer-modified-p)") - -(ml-expansion 'file-modified-time "you-lose-on-file-modified-time") -(ml-expansion 'needs-checkpointing "you-lose-on-needs-checkpointing") - -(ml-expansion 'lines-on-screen "set-frame-height") -(ml-expansion 'columns-on-screen "set-frame-width") - -(ml-expansion 'dumped-emacs "t") - -(ml-expansion 'buffer-size "ml-buffer-size") -(ml-expansion 'dot-is-visible "pos-visible-in-window-p") - -(ml-expansion 'track-eol-on-^N-^P "track-eol") -(ml-expansion 'ctlchar-with-^ "ctl-arrow") -(ml-expansion 'help-on-command-completion-error "completion-auto-help") -(ml-expansion 'dump-stack-trace "backtrace") -(ml-expansion 'pause-emacs "suspend-emacs") -(ml-expansion 'compile-it "compile") - -(ml-expansion '!= "/=") -(ml-expansion '& "logand") -(ml-expansion '| "logior") -(ml-expansion '^ "logxor") -(ml-expansion '! "ml-not") -(ml-expansion '<< "lsh") - -;Variable pause-writes-files - -;;; mlconvert.el ends here diff --git a/lisp/emulation/mlsupport.el b/lisp/emulation/mlsupport.el deleted file mode 100644 index 7f7a357cc3c..00000000000 --- a/lisp/emulation/mlsupport.el +++ /dev/null @@ -1,435 +0,0 @@ -;;; mlsupport.el --- run-time support for mocklisp code. - -;; Copyright (C) 1985 Free Software Foundation, Inc. - -;; Maintainer: FSF -;; Keywords: extensions - -;; This file is part of GNU Emacs. - -;; 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 -;; the Free Software Foundation; either version 2, 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 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This package provides equivalents of certain primitives from Gosling -;; Emacs (including the commercial UniPress versions). These have an -;; ml- prefix to distinguish them from native GNU Emacs functions with -;; similar names. The package mlconvert.el translates Mocklisp code -;; to use these names. - -;;; Code: - -(defmacro ml-defun (&rest defs) - (list 'ml-defun-1 (list 'quote defs))) - -(defun ml-defun-1 (args) - (while args - (fset (car (car args)) (cons 'mocklisp (cdr (car args)))) - (setq args (cdr args)))) - -(defmacro declare-buffer-specific (&rest vars) - (cons 'progn (mapcar (function (lambda (var) (list 'make-variable-buffer-local (list 'quote var)))) vars))) - -(defun ml-set-default (varname value) - (set-default (intern varname) value)) - -; Lossage: must make various things default missing args to the prefix arg -; Alternatively, must make provide-prefix-argument do something hairy. - -(defun >> (val count) (lsh val (- count))) -(defun novalue () nil) - -(defun ml-not (arg) (if (zerop arg) 1 0)) - -(defun provide-prefix-arg (arg form) - (funcall (car form) arg)) - -(defun define-keymap (name) - (fset (intern name) (make-keymap))) - -;; Make it work to use ml-use-...-map on "esc" and such. -(fset 'esc-map esc-map) -(fset 'ctl-x-map ctl-x-map) - -(defun ml-use-local-map (name) - (use-local-map (intern (concat name "-map")))) - -(defun ml-use-global-map (name) - (use-global-map (intern (concat name "-map")))) - -(defun local-bind-to-key (name key) - (or (current-local-map) - (use-local-map (make-keymap))) - (define-key (current-local-map) - (if (integerp key) - (if (>= key 128) - (concat (char-to-string meta-prefix-char) - (char-to-string (- key 128))) - (char-to-string key)) - key) - (intern name))) - -(defun bind-to-key (name key) - (define-key global-map (if (integerp key) (char-to-string key) key) - (intern name))) - -(defun ml-autoload (name file) - (autoload (intern name) file)) - -(defun ml-define-string-macro (name defn) - (fset (intern name) defn)) - -(defun push-back-character (char) - (setq unread-command-events (list char))) - -(defun to-col (column) - (indent-to column 0)) - -(defmacro is-bound (&rest syms) - (cons 'and (mapcar (function (lambda (sym) (list 'boundp (list 'quote sym)))) syms))) - -(defmacro declare-global (&rest syms) - (cons 'progn (mapcar (function (lambda (sym) (list 'defvar sym nil))) syms))) - -(defmacro error-occurred (&rest body) - (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t))) - -(defun return-prefix-argument (value) - (setq prefix-arg value)) - -(defun ml-prefix-argument () - (if (null current-prefix-arg) 1 - (if (listp current-prefix-arg) (car current-prefix-arg) - (if (eq current-prefix-arg '-) -1 - current-prefix-arg)))) - -(defun ml-print (varname) - (interactive "vPrint variable: ") - (if (boundp varname) - (message "%s => %s" (symbol-name varname) (symbol-value varname)) - (message "%s has no value" (symbol-name varname)))) - -(defun ml-set (str val) (set (intern str) val)) - -(defun ml-message (&rest args) (message "%s" (apply 'concat args))) - -(defun kill-to-end-of-line () - (ml-prefix-argument-loop - (if (eolp) - (kill-region (point) (1+ (point))) - (kill-region (point) (if (search-forward ?\n nil t) - (1- (point)) (point-max)))))) - -(defun set-auto-fill-hook (arg) - (setq auto-fill-function (intern arg))) - -(defun auto-execute (function pattern) - (if (/= (aref pattern 0) ?*) - (error "Only patterns starting with * supported in auto-execute")) - (setq auto-mode-alist (cons (cons (concat "\\." (substring pattern 1) - "\\'") - function) - auto-mode-alist))) - -(defun move-to-comment-column () - (indent-to comment-column)) - -(defun erase-region () - (delete-region (point) (mark))) - -(defun delete-region-to-buffer (bufname) - (copy-to-buffer bufname (point) (mark)) - (delete-region (point) (mark))) - -(defun copy-region-to-buffer (bufname) - (copy-to-buffer bufname (point) (mark))) - -(defun append-region-to-buffer (bufname) - (append-to-buffer bufname (point) (mark))) - -(defun prepend-region-to-buffer (bufname) - (prepend-to-buffer bufname (point) (mark))) - -(defun delete-next-character () - (delete-char (ml-prefix-argument))) - -(defun delete-next-word () - (delete-region (point) (progn (forward-word (ml-prefix-argument)) (point)))) - -(defun delete-previous-word () - (delete-region (point) (progn (backward-word (ml-prefix-argument)) (point)))) - -(defun delete-previous-character () - (delete-backward-char (ml-prefix-argument))) - -(defun forward-character () - (forward-char (ml-prefix-argument))) - -(defun backward-character () - (backward-char (ml-prefix-argument))) - -(defun ml-newline () - (newline (ml-prefix-argument))) - -(defun ml-next-line () - (next-line (ml-prefix-argument))) - -(defun ml-previous-line () - (previous-line (ml-prefix-argument))) - -(defun delete-to-kill-buffer () - (kill-region (point) (mark))) - -(defun narrow-region () - (narrow-to-region (point) (mark))) - -(defun ml-newline-and-indent () - (let ((column (current-indentation))) - (newline (ml-prefix-argument)) - (indent-to column))) - -(defun newline-and-backup () - (open-line (ml-prefix-argument))) - -(defun quote-char () - (quoted-insert (ml-prefix-argument))) - -(defun ml-current-column () - (1+ (current-column))) - -(defun ml-current-indent () - (1+ (current-indentation))) - -(defun region-around-match (&optional n) - (set-mark (match-beginning n)) - (goto-char (match-end n))) - -(defun region-to-string () - (buffer-substring (min (point) (mark)) (max (point) (mark)))) - -(defun use-abbrev-table (name) - (let ((symbol (intern (concat name "-abbrev-table")))) - (or (boundp symbol) - (define-abbrev-table symbol nil)) - (symbol-value symbol))) - -(defun define-hooked-local-abbrev (name exp hook) - (define-local-abbrev name exp (intern hook))) - -(defun define-hooked-global-abbrev (name exp hook) - (define-global-abbrev name exp (intern hook))) - -(defun case-word-lower () - (ml-casify-word 'downcase-region)) - -(defun case-word-upper () - (ml-casify-word 'upcase-region)) - -(defun case-word-capitalize () - (ml-casify-word 'capitalize-region)) - -(defun ml-casify-word (fun) - (save-excursion - (forward-char 1) - (forward-word -1) - (funcall fun (point) - (progn (forward-word (ml-prefix-argument)) - (point))))) - -(defun case-region-lower () - (downcase-region (point) (mark))) - -(defun case-region-upper () - (upcase-region (point) (mark))) - -(defun case-region-capitalize () - (capitalize-region (point) (mark))) - -(defvar saved-command-line-args nil) - -(defun argc () - (or saved-command-line-args - (setq saved-command-line-args command-line-args - command-line-args ())) - (length command-line-args)) - -(defun argv (i) - (or saved-command-line-args - (setq saved-command-line-args command-line-args - command-line-args ())) - (nth i saved-command-line-args)) - -(defun invisible-argc () - (length (or saved-command-line-args - command-line-args))) - -(defun invisible-argv (i) - (nth i (or saved-command-line-args - command-line-args))) - -(defun exit-emacs () - (interactive) - (condition-case () - (exit-recursive-edit) - (error (kill-emacs)))) - -;; Lisp function buffer-size returns total including invisible; -;; mocklisp wants just visible. -(defun ml-buffer-size () - (- (point-max) (point-min))) - -(defun previous-command () - last-command) - -(defun beginning-of-window () - (goto-char (window-start))) - -(defun end-of-window () - (goto-char (window-start)) - (vertical-motion (- (window-height) 2))) - -(defun ml-search-forward (string) - (search-forward string nil nil (ml-prefix-argument))) - -(defun ml-re-search-forward (string) - (re-search-forward string nil nil (ml-prefix-argument))) - -(defun ml-search-backward (string) - (search-backward string nil nil (ml-prefix-argument))) - -(defun ml-re-search-backward (string) - (re-search-backward string nil nil (ml-prefix-argument))) - -(defvar use-users-shell 1 - "Mocklisp compatibility variable; 1 means use shell from SHELL env var. -0 means use /bin/sh.") - -(defvar use-csh-option-f 1 - "Mocklisp compatibility variable; 1 means pass -f when calling csh.") - -(defun filter-region (command) - (let ((shell (if (/= use-users-shell 0) shell-file-name "/bin/sh")) - (csh (equal (file-name-nondirectory shell) "csh"))) - (call-process-region (point) (mark) shell t t nil - (if (and csh use-csh-option-f) "-cf" "-c") - (concat "exec " command)))) - -(defun execute-monitor-command (command) - (let ((shell (if (/= use-users-shell 0) shell-file-name "/bin/sh")) - (csh (equal (file-name-nondirectory shell) "csh"))) - (call-process shell nil t t - (if (and csh use-csh-option-f) "-cf" "-c") - (concat "exec " command)))) - -(defun use-syntax-table (name) - (set-syntax-table (symbol-value (intern (concat name "-syntax-table"))))) - -(defun line-to-top-of-window () - (recenter (1- (ml-prefix-argument)))) - -(defun ml-previous-page (&optional arg) - (let ((count (or arg (ml-prefix-argument)))) - (while (> count 0) - (scroll-down nil) - (setq count (1- count))) - (while (< count 0) - (scroll-up nil) - (setq count (1+ count))))) - -(defun ml-next-page () - (previous-page (- (ml-prefix-argument)))) - -(defun page-next-window (&optional arg) - (let ((count (or arg (ml-prefix-argument)))) - (while (> count 0) - (scroll-other-window nil) - (setq count (1- count))) - (while (< count 0) - (scroll-other-window '-) - (setq count (1+ count))))) - -(defun ml-next-window () - (select-window (next-window))) - -(defun ml-previous-window () - (select-window (previous-window))) - -(defun scroll-one-line-up () - (scroll-up (ml-prefix-argument))) - -(defun scroll-one-line-down () - (scroll-down (ml-prefix-argument))) - -(defun split-current-window () - (split-window (selected-window))) - -(defun last-key-struck () last-command-char) - -(defun execute-mlisp-line (string) - (eval (read string))) - -(defun move-dot-to-x-y (x y) - (goto-char (window-start (selected-window))) - (vertical-motion (1- y)) - (move-to-column (1- x))) - -(defun ml-modify-syntax-entry (string) - (let ((i 5) - (len (length string)) - (datastring (substring string 0 2))) - (if (= (aref string 0) ?\-) - (aset datastring 0 ?\ )) - (if (= (aref string 2) ?\{) - (if (= (aref string 4) ?\ ) - (aset datastring 0 ?\<) - (error "Two-char comment delimiter: use modify-syntax-entry directly"))) - (if (= (aref string 3) ?\}) - (if (= (aref string 4) ?\ ) - (aset datastring 0 ?\>) - (error "Two-char comment delimiter: use modify-syntax-entry directly"))) - (while (< i len) - (modify-syntax-entry (aref string i) datastring) - (setq i (1+ i)) - (if (and (< i len) - (= (aref string i) ?\-)) - (let ((c (aref string (1- i))) - (lim (aref string (1+ i)))) - (while (<= c lim) - (modify-syntax-entry c datastring) - (setq c (1+ c))) - (setq i (+ 2 i))))))) - - - -(defun ml-substr (string from to) - (let ((length (length string))) - (if (< from 0) (setq from (+ from length))) - (if (< to 0) (setq to (+ to length))) - (substring string from (+ from to)))) - -(defun ml-concat (&rest args) - (let ((newargs nil) this) - (while args - (setq this (car args)) - (if (numberp this) - (setq this (number-to-string this))) - (setq newargs (cons this newargs) - args (cdr args))) - (apply 'concat (nreverse newargs)))) - -(provide 'mlsupport) - -;;; mlsupport.el ends here diff --git a/lisp/emulation/pc-mode.el b/lisp/emulation/pc-mode.el deleted file mode 100644 index c7db52ba567..00000000000 --- a/lisp/emulation/pc-mode.el +++ /dev/null @@ -1,52 +0,0 @@ -;;; pc-mode.el --- emulate certain key bindings used on PCs. - -;; Copyright (C) 1995 Free Software Foundation, Inc. - -;; Keywords: emulations - -;; This file is part of GNU Emacs. - -;; 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 -;; the Free Software Foundation; either version 2, 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 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Code: - -;;;###autoload -(defun pc-bindings-mode () - "Set up certain key bindings for PC compatibility. -The keys affected are: -Delete (and its variants) delete forward instead of backward. -C-Backspace kills backward a word (as C-Delete normally would). -M-Backspace does undo. -Home and End move to beginning and end of line -C-Home and C-End move to beginning and end of buffer. -C-Escape does list-buffers." - - (interactive) - (define-key function-key-map [delete] "\C-d") - (define-key function-key-map [M-delete] [?\M-d]) - (define-key function-key-map [C-delete] [?\M-d]) - (global-set-key [C-M-delete] 'kill-sexp) - (global-set-key [C-backspace] 'backward-kill-word) - (global-set-key [M-backspace] 'undo) - - (global-set-key [C-escape] 'list-buffers) - - (global-set-key [home] 'beginning-of-line) - (global-set-key [end] 'end-of-line) - (global-set-key [C-home] 'beginning-of-buffer) - (global-set-key [C-end] 'end-of-buffer)) - -;; pc-mode.el ends here diff --git a/lisp/emulation/pc-select.el b/lisp/emulation/pc-select.el deleted file mode 100644 index a9ca7048243..00000000000 --- a/lisp/emulation/pc-select.el +++ /dev/null @@ -1,689 +0,0 @@ -;;; pc-select.el --- emulate mark, cut, copy and paste from motif -;;; (or MAC GUI) or MS-windoze (bah)) look-and-feel -;;; including key bindings - -;; Copyright (C) 1995, 1996 Free Software Foundation, Inc. - -;; Author: Michael Staats <michael@thp.Uni-Duisburg.DE> -;; Created: 26 Sep 1995 - -;; This file is part of GNU Emacs. - -;; 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 -;; the Free Software Foundation; either version 2, 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 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This package emulates the mark, copy, cut and paste look-and-feel of motif -;; programs (which is the same as the MAC gui and (sorry for that) MS-Windows). -;; It modifies the keybindings of the cursor keys and the next, prior, -;; home and end keys. They will modify mark-active. -;; You can still get the old behaviour of cursor moving with the -;; control sequences C-f, C-b, etc. -;; This package uses transient-mark-mode and -;; delete-selection-mode. -;; -;; In addition to that all key-bindings from the pc-mode are -;; done here too (as suggested by RMS). -;; -;; As I found out after I finished the first version, s-region.el tries -;; to do the same.... But my code is a little more complete and using -;; delete-selection-mode is very important for the look-and-feel. -;; Pete Forman <pete.forman@airgun.wg.waii.com> provided some motif -;; compliant keybindings which I added. I had to modify them a little -;; to add the -mark and -nomark functionality of cursor moving. -;; -;; Credits: -;; Many thanks to all who made comments. -;; Thanks to RMS and Ralf Muschall <prm@rz.uni-jena.de> for criticism. -;; Kevin Cutts <cutts@ukraine.corp.mot.com> added the beginning-of-buffer -;; and end-of-buffer functions which I modified a little. -;; David Biesack <sasdjb@unx.sas.com> suggested some more cleanup. -;; Thanks to Pete Forman <pete.forman@airgun.wg.waii.com> -;; for additional motif keybindings. -;; Thanks to jvromans@squirrel.nl (Johan Vromans) for a bug report -;; concerning setting of this-command. -;; Dan Nicolaescu <done@nexus.sorostm.ro> suggested suppressing the -;; scroll-up/scroll-down error. -;; -;; Ok, some details about the idea of pc-selection-mode: -;; -;; o The standard keys for moving around (right, left, up, down, home, end, -;; prior, next, called "move-keys" from now on) will always de-activate -;; the mark. -;; o If you press "Shift" together with the "move-keys", the region -;; you pass along is activated -;; o You have the copy, cut and paste functions (as in many other programs) -;; which will operate on the active region -;; It was not possible to bind them to C-v, C-x and C-c for obvious -;; emacs reasons. -;; They will be bound according to the "old" behaviour to S-delete (cut), -;; S-insert (paste) and C-insert (copy). These keys do the same in many -;; other programs. -;; - -;;;; Customization: - -(defvar pc-select-override-scroll-error t - "*Non-nil means don't generate error on scrolling past edge of buffer. -This variable applies in PC Selection mode only. -The scroll commands normally generate an error if you try to scroll -past the top or bottom of the buffer. This is annoying when selecting -text with these commands. If you set this variable to non-nil, these -errors are suppressed.") - -;;;; -;; misc -;;;; - -(provide 'pc-select) - -(defun copy-region-as-kill-nomark (beg end) - "Save the region as if killed; but don't kill it; deactivate mark. -If `interprogram-cut-function' is non-nil, also save the text for a window -system cut and paste. - -Deactivating mark is to avoid confusion with delete-selection-mode -and transient-mark-mode." - (interactive "r") - (copy-region-as-kill beg end) - (setq mark-active nil) - (message "Region saved")) - -;;;; -;; non-interactive -;;;; -(defun ensure-mark() - ;; make sure mark is active - ;; test if it is active, if it isn't, set it and activate it - (or mark-active (set-mark-command nil))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;; forward and mark -;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun forward-char-mark (&optional arg) - "Ensure mark is active; move point right ARG characters (left if ARG negative). -On reaching end of buffer, stop and signal error." - (interactive "p") - (ensure-mark) - (forward-char arg)) - -(defun forward-word-mark (&optional arg) - "Ensure mark is active; move point right ARG words (backward if ARG is negative). -Normally returns t. -If an edge of the buffer is reached, point is left there -and nil is returned." - (interactive "p") - (ensure-mark) - (forward-word arg)) - -(defun forward-line-mark (&optional arg) - "Ensure mark is active; move cursor vertically down ARG lines." - (interactive "p") - (ensure-mark) - (forward-line arg) - (setq this-command 'forward-line) -) - -(defun forward-paragraph-mark (&optional arg) - "Ensure mark is active; move forward to end of paragraph. -With arg N, do it N times; negative arg -N means move backward N paragraphs. - -A line which `paragraph-start' matches either separates paragraphs -\(if `paragraph-separate' matches it also) or is the first line of a paragraph. -A paragraph end is the beginning of a line which is not part of the paragraph -to which the end of the previous line belongs, or the end of the buffer." - (interactive "p") - (ensure-mark) - (forward-paragraph arg)) - -(defun next-line-mark (&optional arg) - "Ensure mark is active; move cursor vertically down ARG lines. -If there is no character in the target line exactly under the current column, -the cursor is positioned after the character in that line which spans this -column, or at the end of the line if it is not long enough. -If there is no line in the buffer after this one, behavior depends on the -value of `next-line-add-newlines'. If non-nil, it inserts a newline character -to create a line, and moves the cursor to that line. Otherwise it moves the -cursor to the end of the buffer \(if already at the end of the buffer, an error -is signaled). - -The command C-x C-n can be used to create -a semipermanent goal column to which this command always moves. -Then it does not try to move vertically. This goal column is stored -in `goal-column', which is nil when there is none." - (interactive "p") - (ensure-mark) - (next-line arg) - (setq this-command 'next-line)) - -(defun end-of-line-mark (&optional arg) - "Ensure mark is active; move point to end of current line. -With argument ARG not nil or 1, move forward ARG - 1 lines first. -If scan reaches end of buffer, stop there without error." - (interactive "p") - (ensure-mark) - (end-of-line arg) - (setq this-command 'end-of-line)) - -(defun backward-line-mark (&optional arg) - "Ensure mark is active; move cursor vertically up ARG lines." - (interactive "p") - (ensure-mark) - (if (null arg) - (setq arg 1)) - (forward-line (- arg)) - (setq this-command 'forward-line) -) - -(defun scroll-down-mark (&optional arg) - "Ensure mark is active; scroll down ARG lines; or near full screen if no ARG. -A near full screen is `next-screen-context-lines' less than a full screen. -Negative ARG means scroll upward. -When calling from a program, supply a number as argument or nil." - (interactive "P") - (ensure-mark) - (cond (pc-select-override-scroll-error - (condition-case nil (scroll-down arg) - (beginning-of-buffer (goto-char (point-min))))) - (t (scroll-down arg)))) - -(defun end-of-buffer-mark (&optional arg) - "Ensure mark is active; move point to the end of the buffer. -With arg N, put point N/10 of the way from the end. - -If the buffer is narrowed, this command uses the beginning and size -of the accessible part of the buffer. - -Don't use this command in Lisp programs! -\(goto-char \(point-max)) is faster and avoids clobbering the mark." - (interactive "P") - (ensure-mark) - (let ((size (- (point-max) (point-min)))) - (goto-char (if arg - (- (point-max) - (if (> size 10000) - ;; Avoid overflow for large buffer sizes! - (* (prefix-numeric-value arg) - (/ size 10)) - (/ (* size (prefix-numeric-value arg)) 10))) - (point-max)))) - ;; If we went to a place in the middle of the buffer, - ;; adjust it to the beginning of a line. - (if arg (forward-line 1) - ;; If the end of the buffer is not already on the screen, - ;; then scroll specially to put it near, but not at, the bottom. - (if (let ((old-point (point))) - (save-excursion - (goto-char (window-start)) - (vertical-motion (window-height)) - (< (point) old-point))) - (progn - (overlay-recenter (point)) - (recenter -3))))) - -;;;;;;;;; -;;;;; no mark -;;;;;;;;; - -(defun forward-char-nomark (&optional arg) - "Deactivate mark; move point right ARG characters \(left if ARG negative). -On reaching end of buffer, stop and signal error." - (interactive "p") - (setq mark-active nil) - (forward-char arg)) - -(defun forward-word-nomark (&optional arg) - "Deactivate mark; move point right ARG words \(backward if ARG is negative). -Normally returns t. -If an edge of the buffer is reached, point is left there -and nil is returned." - (interactive "p") - (setq mark-active nil) - (forward-word arg)) - -(defun forward-line-nomark (&optional arg) - "Deactivate mark; move cursor vertically down ARG lines." - (interactive "p") - (setq mark-active nil) - (forward-line arg) - (setq this-command 'forward-line) -) - -(defun forward-paragraph-nomark (&optional arg) - "Deactivate mark; move forward to end of paragraph. -With arg N, do it N times; negative arg -N means move backward N paragraphs. - -A line which `paragraph-start' matches either separates paragraphs -\(if `paragraph-separate' matches it also) or is the first line of a paragraph. -A paragraph end is the beginning of a line which is not part of the paragraph -to which the end of the previous line belongs, or the end of the buffer." - (interactive "p") - (setq mark-active nil) - (forward-paragraph arg)) - -(defun next-line-nomark (&optional arg) - "Deactivate mark; move cursor vertically down ARG lines. -If there is no character in the target line exactly under the current column, -the cursor is positioned after the character in that line which spans this -column, or at the end of the line if it is not long enough. -If there is no line in the buffer after this one, behavior depends on the -value of `next-line-add-newlines'. If non-nil, it inserts a newline character -to create a line, and moves the cursor to that line. Otherwise it moves the -cursor to the end of the buffer (if already at the end of the buffer, an error -is signaled). - -The command C-x C-n can be used to create -a semipermanent goal column to which this command always moves. -Then it does not try to move vertically. This goal column is stored -in `goal-column', which is nil when there is none." - (interactive "p") - (setq mark-active nil) - (next-line arg) - (setq this-command 'next-line)) - -(defun end-of-line-nomark (&optional arg) - "Deactivate mark; move point to end of current line. -With argument ARG not nil or 1, move forward ARG - 1 lines first. -If scan reaches end of buffer, stop there without error." - (interactive "p") - (setq mark-active nil) - (end-of-line arg) - (setq this-command 'end-of-line)) - -(defun backward-line-nomark (&optional arg) - "Deactivate mark; move cursor vertically up ARG lines." - (interactive "p") - (setq mark-active nil) - (if (null arg) - (setq arg 1)) - (forward-line (- arg)) - (setq this-command 'forward-line) -) - -(defun scroll-down-nomark (&optional arg) - "Deactivate mark; scroll down ARG lines; or near full screen if no ARG. -A near full screen is `next-screen-context-lines' less than a full screen. -Negative ARG means scroll upward. -When calling from a program, supply a number as argument or nil." - (interactive "P") - (setq mark-active nil) - (cond (pc-select-override-scroll-error - (condition-case nil (scroll-down arg) - (beginning-of-buffer (goto-char (point-min))))) - (t (scroll-down arg)))) - -(defun end-of-buffer-nomark (&optional arg) - "Deactivate mark; move point to the end of the buffer. -With arg N, put point N/10 of the way from the end. - -If the buffer is narrowed, this command uses the beginning and size -of the accessible part of the buffer. - -Don't use this command in Lisp programs! -\(goto-char (point-max)) is faster and avoids clobbering the mark." - (interactive "P") - (setq mark-active nil) - (let ((size (- (point-max) (point-min)))) - (goto-char (if arg - (- (point-max) - (if (> size 10000) - ;; Avoid overflow for large buffer sizes! - (* (prefix-numeric-value arg) - (/ size 10)) - (/ (* size (prefix-numeric-value arg)) 10))) - (point-max)))) - ;; If we went to a place in the middle of the buffer, - ;; adjust it to the beginning of a line. - (if arg (forward-line 1) - ;; If the end of the buffer is not already on the screen, - ;; then scroll specially to put it near, but not at, the bottom. - (if (let ((old-point (point))) - (save-excursion - (goto-char (window-start)) - (vertical-motion (window-height)) - (< (point) old-point))) - (progn - (overlay-recenter (point)) - (recenter -3))))) - - -;;;;;;;;;;;;;;;;;;;; -;;;;;; backwards and mark -;;;;;;;;;;;;;;;;;;;; - -(defun backward-char-mark (&optional arg) -"Ensure mark is active; move point left ARG characters (right if ARG negative). -On attempt to pass beginning or end of buffer, stop and signal error." - (interactive "p") - (ensure-mark) - (backward-char arg)) - -(defun backward-word-mark (&optional arg) - "Ensure mark is active; move backward until encountering the end of a word. -With argument, do this that many times." - (interactive "p") - (ensure-mark) - (backward-word arg)) - -(defun backward-paragraph-mark (&optional arg) - "Ensure mark is active; move backward to start of paragraph. -With arg N, do it N times; negative arg -N means move forward N paragraphs. - -A paragraph start is the beginning of a line which is a -`first-line-of-paragraph' or which is ordinary text and follows a -paragraph-separating line; except: if the first real line of a -paragraph is preceded by a blank line, the paragraph starts at that -blank line. - -See `forward-paragraph' for more information." - (interactive "p") - (ensure-mark) - (backward-paragraph arg)) - -(defun previous-line-mark (&optional arg) - "Ensure mark is active; move cursor vertically up ARG lines. -If there is no character in the target line exactly over the current column, -the cursor is positioned after the character in that line which spans this -column, or at the end of the line if it is not long enough. - -The command C-x C-n can be used to create -a semipermanent goal column to which this command always moves. -Then it does not try to move vertically. - -If you are thinking of using this in a Lisp program, consider using -`forward-line' with a negative argument instead. It is usually easier -to use and more reliable (no dependence on goal column, etc.)." - (interactive "p") - (ensure-mark) - (previous-line arg) - (setq this-command 'previous-line)) - -(defun beginning-of-line-mark (&optional arg) - "Ensure mark is active; move point to beginning of current line. -With argument ARG not nil or 1, move forward ARG - 1 lines first. -If scan reaches end of buffer, stop there without error." - (interactive "p") - (ensure-mark) - (beginning-of-line arg)) - - -(defun scroll-up-mark (&optional arg) -"Ensure mark is active; scroll upward ARG lines; or near full screen if no ARG. -A near full screen is `next-screen-context-lines' less than a full screen. -Negative ARG means scroll downward. -When calling from a program, supply a number as argument or nil." - (interactive "P") - (ensure-mark) - (cond (pc-select-override-scroll-error - (condition-case nil (scroll-up arg) - (end-of-buffer (goto-char (point-max))))) - (t (scroll-up arg)))) - -(defun beginning-of-buffer-mark (&optional arg) - "Ensure mark is active; move point to the beginning of the buffer. -With arg N, put point N/10 of the way from the beginning. - -If the buffer is narrowed, this command uses the beginning and size -of the accessible part of the buffer. - -Don't use this command in Lisp programs! -\(goto-char (p\oint-min)) is faster and avoids clobbering the mark." - (interactive "P") - (ensure-mark) - (let ((size (- (point-max) (point-min)))) - (goto-char (if arg - (+ (point-min) - (if (> size 10000) - ;; Avoid overflow for large buffer sizes! - (* (prefix-numeric-value arg) - (/ size 10)) - (/ (+ 10 (* size (prefix-numeric-value arg))) 10))) - (point-min)))) - (if arg (forward-line 1))) - -;;;;;;;; -;;; no mark -;;;;;;;; - -(defun backward-char-nomark (&optional arg) - "Deactivate mark; move point left ARG characters (right if ARG negative). -On attempt to pass beginning or end of buffer, stop and signal error." - (interactive "p") - (setq mark-active nil) - (backward-char arg)) - -(defun backward-word-nomark (&optional arg) - "Deactivate mark; move backward until encountering the end of a word. -With argument, do this that many times." - (interactive "p") - (setq mark-active nil) - (backward-word arg)) - -(defun backward-paragraph-nomark (&optional arg) - "Deactivate mark; move backward to start of paragraph. -With arg N, do it N times; negative arg -N means move forward N paragraphs. - -A paragraph start is the beginning of a line which is a -`first-line-of-paragraph' or which is ordinary text and follows a -paragraph-separating line; except: if the first real line of a -paragraph is preceded by a blank line, the paragraph starts at that -blank line. - -See `forward-paragraph' for more information." - (interactive "p") - (setq mark-active nil) - (backward-paragraph arg)) - -(defun previous-line-nomark (&optional arg) - "Deactivate mark; move cursor vertically up ARG lines. -If there is no character in the target line exactly over the current column, -the cursor is positioned after the character in that line which spans this -column, or at the end of the line if it is not long enough. - -The command C-x C-n can be used to create -a semipermanent goal column to which this command always moves. -Then it does not try to move vertically." - (interactive "p") - (setq mark-active nil) - (previous-line arg) - (setq this-command 'previous-line)) - -(defun beginning-of-line-nomark (&optional arg) - "Deactivate mark; move point to beginning of current line. -With argument ARG not nil or 1, move forward ARG - 1 lines first. -If scan reaches end of buffer, stop there without error." - (interactive "p") - (setq mark-active nil) - (beginning-of-line arg)) - -(defun scroll-up-nomark (&optional arg) - "Deactivate mark; scroll upward ARG lines; or near full screen if no ARG. -A near full screen is `next-screen-context-lines' less than a full screen. -Negative ARG means scroll downward. -When calling from a program, supply a number as argument or nil." - (interactive "P") - (setq mark-active nil) - (cond (pc-select-override-scroll-error - (condition-case nil (scroll-up arg) - (end-of-buffer (goto-char (point-max))))) - (t (scroll-up arg)))) - -(defun beginning-of-buffer-nomark (&optional arg) - "Deactivate mark; move point to the beginning of the buffer. -With arg N, put point N/10 of the way from the beginning. - -If the buffer is narrowed, this command uses the beginning and size -of the accessible part of the buffer. - -Don't use this command in Lisp programs! -\(goto-char (point-min)) is faster and avoids clobbering the mark." - (interactive "P") - (setq mark-active nil) - (let ((size (- (point-max) (point-min)))) - (goto-char (if arg - (+ (point-min) - (if (> size 10000) - ;; Avoid overflow for large buffer sizes! - (* (prefix-numeric-value arg) - (/ size 10)) - (/ (+ 10 (* size (prefix-numeric-value arg))) 10))) - (point-min)))) - (if arg (forward-line 1))) - -;;;###autoload -(defun pc-selection-mode () - "Change mark behaviour to emulate Motif, MAC or MS-Windows cut and paste style. - -This mode enables Delete Selection mode and Transient Mark mode. - -The arrow keys (and others) are bound to new functions -which modify the status of the mark. - -The ordinary arrow keys disable the mark. -The shift-arrow keys move, leaving the mark behind. - -C-LEFT and C-RIGHT move back or forward one word, disabling the mark. -S-C-LEFT and S-C-RIGHT move back or forward one word, leaving the mark behind. - -C-DOWN and C-UP move back or forward a paragraph, disabling the mark. -S-C-DOWN and S-C-UP move back or forward a paragraph, leaving the mark behind. - -HOME moves to beginning of line, disabling the mark. -S-HOME moves to beginning of line, leaving the mark behind. -With Ctrl or Meta, these keys move to beginning of buffer instead. - -END moves to end of line, disabling the mark. -S-END moves to end of line, leaving the mark behind. -With Ctrl or Meta, these keys move to end of buffer instead. - -PRIOR or PAGE-UP scrolls and disables the mark. -S-PRIOR or S-PAGE-UP scrolls and leaves the mark behind. - -S-DELETE kills the region (`kill-region'). -S-INSERT yanks text from the kill ring (`yank'). -C-INSERT copies the region into the kill ring (`copy-region-as-kill'). - -In addition, certain other PC bindings are imitated: - - F6 other-window - DELETE delete-char - C-DELETE kill-line - M-DELETE kill-word - C-M-DELETE kill-sexp - C-BACKSPACE backward-kill-word - M-BACKSPACE undo" - - (interactive) - ;; - ;; keybindings - ;; - - ;; This is to avoid confusion with the delete-selection-mode - ;; On simple displays you can't see that a region is active and - ;; will be deleted on the next keypress. IMHO especially for - ;; copy-region-as-kill this is confusing - (define-key global-map "\M-w" 'copy-region-as-kill-nomark) - - - ;; The following keybindings are for standard ISO keyboards - ;; as they are used with IBM compatible PCs, IBM RS/6000, - ;; MACs, many X-Stations and probably more - (define-key global-map [S-right] 'forward-char-mark) - (define-key global-map [right] 'forward-char-nomark) - (define-key global-map [C-S-right] 'forward-word-mark) - (define-key global-map [C-right] 'forward-word-nomark) - (define-key global-map [M-S-right] 'forward-word-mark) - (define-key global-map [M-right] 'forward-word-nomark) - - (define-key global-map [S-down] 'next-line-mark) - (define-key global-map [down] 'next-line-nomark) - - (define-key global-map [S-end] 'end-of-line-mark) - (define-key global-map [end] 'end-of-line-nomark) - (global-set-key [S-C-end] 'end-of-buffer-mark) - (global-set-key [C-end] 'end-of-buffer-nomark) - (global-set-key [S-M-end] 'end-of-buffer-mark) - (global-set-key [M-end] 'end-of-buffer-nomark) - - (define-key global-map [S-next] 'scroll-up-mark) - (define-key global-map [next] 'scroll-up-nomark) - - (define-key global-map [S-left] 'backward-char-mark) - (define-key global-map [left] 'backward-char-nomark) - (define-key global-map [C-S-left] 'backward-word-mark) - (define-key global-map [C-left] 'backward-word-nomark) - (define-key global-map [M-S-left] 'backward-word-mark) - (define-key global-map [M-left] 'backward-word-nomark) - - (define-key global-map [S-up] 'previous-line-mark) - (define-key global-map [up] 'previous-line-nomark) - - (define-key global-map [S-home] 'beginning-of-line-mark) - (define-key global-map [home] 'beginning-of-line-nomark) - (global-set-key [S-C-home] 'beginning-of-buffer-mark) - (global-set-key [C-home] 'beginning-of-buffer-nomark) - (global-set-key [S-M-home] 'beginning-of-buffer-mark) - (global-set-key [M-home] 'beginning-of-buffer-nomark) - - (define-key global-map [S-prior] 'scroll-down-mark) - (define-key global-map [prior] 'scroll-down-nomark) - - (define-key global-map [S-insert] 'yank) - (define-key global-map [C-insert] 'copy-region-as-kill) - (define-key global-map [S-delete] 'kill-region) - - (define-key global-map [M-S-down] 'forward-line-mark) - (define-key global-map [M-down] 'forward-line-nomark) - (define-key global-map [M-S-up] 'backward-line-mark) - (define-key global-map [M-up] 'backward-line-nomark) - - ;; The following bindings are useful on Sun Type 3 keyboards - ;; They implement the Get-Delete-Put (copy-cut-paste) - ;; functions from sunview on the L6, L8 and L10 keys - (define-key global-map [f16] 'yank) - (define-key global-map [f18] 'copy-region-as-kill) - (define-key global-map [f20] 'kill-region) - - ;; The following bindings are from Pete Forman. - ;; I modified them a little to work together with the - ;; mark functionality I added. - - (global-set-key [f6] 'other-window) ; KNextPane F6 - (global-set-key [delete] 'delete-char) ; KDelete Del - (global-set-key [C-delete] 'kill-line) ; KEraseEndLine cDel - (global-set-key [M-backspace] 'undo) ; KUndo aBS - (global-set-key [C-down] 'forward-paragraph-nomark) ; KNextPara cDn - (global-set-key [C-up] 'backward-paragraph-nomark) ; KPrevPara cUp - (global-set-key [S-C-down] 'forward-paragraph-mark) - (global-set-key [S-C-up] 'backward-paragraph-mark) - - ;; The following bindings are taken from pc-mode.el - ;; as suggested by RMS. - ;; I only used the ones that are not covered above. - (define-key function-key-map [M-delete] [?\M-d]) - (global-set-key [C-M-delete] 'kill-sexp) - (global-set-key [C-backspace] 'backward-kill-word) - (global-set-key [C-escape] 'list-buffers) - - ;; - ;; setup - ;; - (setq transient-mark-mode t) - (setq mark-even-if-inactive t) - (delete-selection-mode 1) -) -;;; pc-select.el ends here diff --git a/lisp/emulation/tpu-edt.el b/lisp/emulation/tpu-edt.el deleted file mode 100644 index 7388e5144c0..00000000000 --- a/lisp/emulation/tpu-edt.el +++ /dev/null @@ -1,2490 +0,0 @@ -;;; tpu-edt.el --- Emacs emulating TPU emulating EDT - -;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. - -;; Author: Rob Riepel <riepel@networking.stanford.edu> -;; Maintainer: Rob Riepel <riepel@networking.stanford.edu> -;; Version: 4.2 -;; Keywords: emulations - -;; This file is part of GNU Emacs. - -;; 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 -;; the Free Software Foundation; either version 2, 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 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;; TPU-edt is based on tpu.el by Jeff Kowalski and Bob Covey. - -;;; Commentary: - -;; %% TPU-edt -- Emacs emulating TPU emulating EDT - -;; %% Contents - -;; % Introduction -;; % Differences Between TPU-edt and DEC TPU/edt -;; % Starting TPU-edt -;; % Customizing TPU-edt using the Emacs Initialization File -;; % Regular Expressions in TPU-edt - - -;; %% Introduction - -;; TPU-edt emulates the popular DEC VMS editor EDT (actually, it emulates -;; DEC TPU's EDT emulation, hence the name TPU-edt). TPU-edt features the -;; following TPU/edt functionality: - -;; . EDT keypad -;; . On-line help -;; . Repeat counts -;; . Scroll margins -;; . Learn sequences -;; . Free cursor mode -;; . Rectangular cut and paste -;; . Multiple windows and buffers -;; . TPU line-mode REPLACE command -;; . Wild card search and substitution -;; . Configurable through an initialization file -;; . History recall of search strings, file names, and commands - -;; Please note that TPU-edt does NOT emulate TPU. It emulates TPU's EDT -;; emulation. Very few TPU line-mode commands are supported. - -;; TPU-edt, like its VMS cousin, works on VT-series terminals with DEC -;; style keyboards. VT terminal emulators, including xterm with the -;; appropriate key translations, work just fine too. - -;; TPU-edt works with X-windows. This is accomplished through a TPU-edt X -;; key map. The TPU-edt module tpu-mapper creates this map and stores it -;; in a file. Tpu-mapper will be run automatically the first time you -;; invoke the X-windows version of emacs, or you can run it by hand. See -;; the commentary in tpu-mapper.el for details. - - -;; %% Differences Between TPU-edt and DEC TPU/edt - -;; In some cases, Emacs doesn't support text highlighting, so selected -;; regions are not shown in inverse video. Emacs uses the concept of "the -;; mark". The mark is set at one end of a selected region; the cursor is -;; at the other. The letter "M" appears in the mode line when the mark is -;; set. The native emacs command ^X^X (Control-X twice) exchanges the -;; cursor with the mark; this provides a handy way to find the location of -;; the mark. - -;; In TPU the cursor can be either bound or free. Bound means the cursor -;; cannot wander outside the text of the file being edited. Free means -;; the arrow keys can move the cursor past the ends of lines. Free is the -;; default mode in TPU; bound is the only mode in EDT. Bound is the only -;; mode in the base version of TPU-edt; optional extensions add an -;; approximation of free mode, see the commentary in tpu-extras.el for -;; details. - -;; Like TPU, emacs uses multiple buffers. Some buffers are used to hold -;; files you are editing; other "internal" buffers are used for emacs' own -;; purposes (like showing you help). Here are some commands for dealing -;; with buffers. - -;; Gold-B moves to next buffer, including internal buffers -;; Gold-N moves to next buffer containing a file -;; Gold-M brings up a buffer menu (like TPU "show buffers") - -;; Emacs is very fond of throwing up new windows. Dealing with all these -;; windows can be a little confusing at first, so here are a few commands -;; to that may help: - -;; Gold-Next_Scr moves to the next window on the screen -;; Gold-Prev_Scr moves to the previous window on the screen -;; Gold-TAB also moves to the next window on the screen - -;; Control-x 1 deletes all but the current window -;; Control-x 0 deletes the current window - -;; Note that the buffers associated with deleted windows still exist! - -;; Like TPU, TPU-edt has a "command" function, invoked with Gold-KP7 or -;; Do. Most of the commands available are emacs commands. Some TPU -;; commands are available, they are: replace, exit, quit, include, and -;; Get (unfortunately, "get" is an internal emacs function, so we are -;; stuck with "Get" - to make life easier, Get is available as Gold-g). - -;; TPU-edt supports the recall of commands, file names, and search -;; strings. The history of strings recalled differs slightly from -;; TPU/edt, but it is still very convenient. - -;; Help is available! The traditional help keys (Help and PF2) display -;; a small help file showing the default keypad layout, control key -;; functions, and Gold key functions. Pressing any key inside of help -;; splits the screen and prints a description of the function of the -;; pressed key. Gold-PF2 invokes the native emacs help, with its -;; zillions of options. - -;; Thanks to emacs, TPU-edt has some extensions that may make your life -;; easier, or at least more interesting. For example, Gold-r toggles -;; TPU-edt rectangular mode. In rectangular mode, Remove and Insert work -;; on rectangles. Likewise, Gold-* toggles TPU-edt regular expression -;; mode. In regular expression mode Find, Find Next, and the line-mode -;; replace command work with regular expressions. [A regular expression -;; is a pattern that denotes a set of strings; like VMS wildcards.] - -;; Emacs also gives TPU-edt the undo and occur functions. Undo does -;; what it says; it undoes the last change. Multiple undos in a row -;; undo multiple changes. For your convenience, undo is available on -;; Gold-u. Occur shows all the lines containing a specific string in -;; another window. Moving to that window, and typing ^C^C (Control-C -;; twice) on a particular line moves you back to the original window -;; at that line. Occur is on Gold-o. - -;; Finally, as you edit, remember that all the power of emacs is at -;; your disposal. It really is a fantastic tool. You may even want to -;; take some time and read the emacs tutorial; perhaps not to learn the -;; native emacs key bindings, but to get a feel for all the things -;; emacs can do for you. The emacs tutorial is available from the -;; emacs help function: "Gold-PF2 t" - - -;; %% Starting TPU-edt - -;; All you have to do to start TPU-edt, is turn it on. This can be -;; done from the command line when running emacs. - -;; prompt> emacs -f tpu-edt - -;; If you've already started emacs, turn on TPU-edt using the tpu-edt -;; command. First press `M-x' (that's usually `ESC' followed by `x') -;; and type `tpu-edt' followed by a carriage return. - -;; If you like TPU-edt and want to use it all the time, you can start -;; TPU-edt using the emacs initialization file, .emacs. Simply create -;; a .emacs file in your home directory containing the line: - -;; (tpu-edt) - -;; That's all you need to do to start TPU-edt. - - -;; %% Customizing TPU-edt using the Emacs Initialization File - -;; The following is a sample emacs initialization file. It shows how to -;; invoke TPU-edt, and how to customize it. - -;; ; .emacs - a sample emacs initialization file - -;; ; Turn on TPU-edt -;; (tpu-edt) - -;; ; Set scroll margins 10% (top) and 15% (bottom). -;; (tpu-set-scroll-margins "10%" "15%") - -;; ; Load the vtxxx terminal control functions. -;; (load "vt-control" t) - -;; ; TPU-edt treats words like EDT; here's how to add word separators. -;; ; Note that backslash (\) and double quote (") are quoted with '\'. -;; (tpu-add-word-separators "]\\[-_,.\"=+()'/*#:!&;$") - -;; ; Emacs is happy to save files without a final newline; other Unix -;; ; programs hate that! Here we make sure that files end with newlines. -;; (setq require-final-newline t) - -;; ; Emacs uses Control-s and Control-q. Problems can occur when using -;; ; emacs on terminals that use these codes for flow control (Xon/Xoff -;; ; flow control). These lines disable emacs' use of these characters. -;; (global-unset-key "\C-s") -;; (global-unset-key "\C-q") - -;; ; The emacs universal-argument function is very useful. -;; ; This line maps universal-argument to Gold-PF1. -;; (define-key GOLD-SS3-map "P" 'universal-argument) ; Gold-PF1 - -;; ; Make KP7 move by paragraphs, instead of pages. -;; (define-key SS3-map "w" 'tpu-paragraph) ; KP7 - -;; ; Repeat the preceding mappings for X-windows. -;; (cond -;; (window-system -;; (global-set-key [kp_7] 'tpu-paragraph) ; KP7 -;; (define-key GOLD-map [kp_f1] 'universal-argument))) ; GOLD-PF1 - -;; ; Display the TPU-edt version. -;; (tpu-version) - - -;; %% Regular Expressions in TPU-edt - -;; Gold-* toggles TPU-edt regular expression mode. In regular expression -;; mode, find, find next, replace, and substitute accept emacs regular -;; expressions. A complete list of emacs regular expressions can be found -;; using the emacs "info" command (it's somewhat like the VMS help -;; command). Try the following sequence of commands: - -;; DO info <enter info mode> -;; m emacs <select the "emacs" topic> -;; m regexs <select the "regular expression" topic> - -;; Type "q" to quit out of info mode. - -;; There is a problem in regular expression mode when searching for empty -;; strings, like beginning-of-line (^) and end-of-line ($). When searching -;; for these strings, find-next may find the current string, instead of the -;; next one. This can cause global replace and substitute commands to loop -;; forever in the same location. For this reason, commands like - -;; replace "^" "> " <add "> " to beginning of line> -;; replace "$" "00711" <add "00711" to end of line> - -;; may not work properly. - -;; Commands like those above are very useful for adding text to the -;; beginning or end of lines. They might work on a line-by-line basis, but -;; go into an infinite loop if the "all" response is specified. If the -;; goal is to add a string to the beginning or end of a particular set of -;; lines TPU-edt provides functions to do this. - -;; Gold-^ Add a string at BOL in region or buffer -;; Gold-$ Add a string at EOL in region or buffer - -;; There is also a TPU-edt interface to the native emacs string replacement -;; commands. Gold-/ invokes this command. It accepts regular expressions -;; if TPU-edt is in regular expression mode. Given a repeat count, it will -;; perform the replacement without prompting for confirmation. - -;; This command replaces empty strings correctly, however, it has its -;; drawbacks. As a native emacs command, it has a different interface -;; than the emulated TPU commands. Also, it works only in the forward -;; direction, regardless of the current TPU-edt direction. - -;;; Code: - - -;;; -;;; Version Information -;;; -(defconst tpu-version "4.2" "TPU-edt version number.") - - -;;; -;;; User Configurable Variables -;;; -(defconst tpu-have-ispell t - "*If non-nil (default), TPU-edt uses ispell for spell checking.") - -(defconst tpu-kill-buffers-silently nil - "*If non-nil, TPU-edt kills modified buffers without asking.") - -(defvar tpu-percent-scroll 75 - "*Percentage of the screen to scroll for next/previous screen commands.") - -(defvar tpu-pan-columns 16 - "*Number of columns the tpu-pan functions scroll left or right.") - - -;;; -;;; Emacs version identifiers - currently referenced by -;;; -;;; o tpu-mark o tpu-set-mark -;;; o tpu-string-prompt o tpu-regexp-prompt -;;; o tpu-edt-on o tpu-load-xkeys -;;; o tpu-update-mode-line o mode line section -;;; -(defconst tpu-emacs19-p (not (string-lessp emacs-version "19")) - "Non-nil if we are running Lucid Emacs or version 19.") - -(defconst tpu-lucid-emacs19-p - (and tpu-emacs19-p (string-match "Lucid" emacs-version)) - "Non-nil if we are running Lucid Emacs version 19.") - - -;;; -;;; Global Keymaps -;;; -(defvar CSI-map (make-sparse-keymap) - "Maps the CSI function keys on the VT100 keyboard. -CSI is DEC's name for the sequence <ESC>[.") - -(defvar SS3-map (make-sparse-keymap) - "Maps the SS3 function keys on the VT100 keyboard. -SS3 is DEC's name for the sequence <ESC>O.") - -(defvar GOLD-map (make-keymap) - "Maps the function keys on the VT100 keyboard preceded by PF1. -GOLD is the ASCII 7-bit escape sequence <ESC>OP.") - -(defvar GOLD-CSI-map (make-sparse-keymap) - "Maps the function keys on the VT100 keyboard preceded by GOLD-CSI.") - -(defvar GOLD-SS3-map (make-sparse-keymap) - "Maps the function keys on the VT100 keyboard preceded by GOLD-SS3.") - -(defvar tpu-global-map nil "TPU-edt global keymap.") -(defvar tpu-original-global-map (copy-keymap global-map) - "Original global keymap.") - -(and tpu-lucid-emacs19-p - (defvar minibuffer-local-ns-map (make-sparse-keymap) - "Hack to give Lucid Emacs the same maps as ordinary Emacs.")) - - -;;; -;;; Global Variables -;;; -(defvar tpu-edt-mode nil - "If non-nil, TPU-edt mode is active.") - -(defvar tpu-last-replaced-text "" - "Last text deleted by a TPU-edt replace command.") -(defvar tpu-last-deleted-region "" - "Last text deleted by a TPU-edt remove command.") -(defvar tpu-last-deleted-lines "" - "Last text deleted by a TPU-edt line-delete command.") -(defvar tpu-last-deleted-words "" - "Last text deleted by a TPU-edt word-delete command.") -(defvar tpu-last-deleted-char "" - "Last character deleted by a TPU-edt character-delete command.") - -(defvar tpu-searching-forward t - "If non-nil, TPU-edt is searching in the forward direction.") -(defvar tpu-search-last-string "" - "Last text searched for by the TPU-edt search commands.") - -(defvar tpu-regexp-p nil - "If non-nil, TPU-edt uses regexp search and replace routines.") -(defvar tpu-rectangular-p nil - "If non-nil, TPU-edt removes and inserts rectangles.") -(defvar tpu-advance t - "True when TPU-edt is operating in the forward direction.") -(defvar tpu-reverse nil - "True when TPU-edt is operating in the backward direction.") -(defvar tpu-control-keys nil - "If non-nil, control keys are set to perform TPU functions.") -(defvar tpu-xkeys-file nil - "File containing TPU-edt X key map.") - -(defvar tpu-rectangle-string nil - "Mode line string to identify rectangular mode.") -(defvar tpu-direction-string nil - "Mode line string to identify current direction.") - -(defvar tpu-add-at-bol-hist nil - "History variable for tpu-edt-add-at-bol function.") -(defvar tpu-add-at-eol-hist nil - "History variable for tpu-edt-add-at-eol function.") -(defvar tpu-regexp-prompt-hist nil - "History variable for search and replace functions.") - - -;;; -;;; Buffer Local Variables -;;; -(defvar tpu-newline-and-indent-p nil - "If non-nil, Return produces a newline and indents.") -(make-variable-buffer-local 'tpu-newline-and-indent-p) - -(defvar tpu-newline-and-indent-string nil - "Mode line string to identify AutoIndent mode.") -(make-variable-buffer-local 'tpu-newline-and-indent-string) - -(defvar tpu-saved-delete-func nil - "Saved value of the delete key.") -(make-variable-buffer-local 'tpu-saved-delete-func) - -(defvar tpu-buffer-local-map nil - "TPU-edt buffer local key map.") -(make-variable-buffer-local 'tpu-buffer-local-map) - - -;;; -;;; Mode Line - Modify the mode line to show the following -;;; -;;; o If the mark is set. -;;; o Direction of motion. -;;; o Active rectangle mode. -;;; -(defvar tpu-original-mode-line mode-line-format) -(defvar tpu-original-mm-alist minor-mode-alist) - -(defvar tpu-mark-flag " ") -(make-variable-buffer-local 'tpu-mark-flag) - -(defun tpu-set-mode-line (for-tpu) - "Set the mode for TPU-edt, or reset it to default Emacs." - (cond ((not for-tpu) - (setq mode-line-format tpu-original-mode-line) - (setq minor-mode-alist tpu-original-mm-alist)) - (t - (setq-default mode-line-format - (list (purecopy "") - 'mode-line-modified - 'mode-line-buffer-identification - (purecopy " ") - 'global-mode-string - (purecopy " ") - 'tpu-mark-flag - (purecopy " %[(") - 'mode-name 'mode-line-process 'minor-mode-alist - (purecopy "%n") - (purecopy ")%]--") - (purecopy '(line-number-mode "L%l--")) - (purecopy '(column-number-mode "C%c--")) - (purecopy '(-3 . "%p")) - (purecopy "-%-"))) - (or (assq 'tpu-newline-and-indent-p minor-mode-alist) - (setq minor-mode-alist - (cons '(tpu-newline-and-indent-p - tpu-newline-and-indent-string) - minor-mode-alist))) - (or (assq 'tpu-rectangular-p minor-mode-alist) - (setq minor-mode-alist - (cons '(tpu-rectangular-p tpu-rectangle-string) - minor-mode-alist))) - (or (assq 'tpu-direction-string minor-mode-alist) - (setq minor-mode-alist - (cons '(tpu-direction-string tpu-direction-string) - minor-mode-alist)))))) - -(defun tpu-update-mode-line nil - "Make sure mode-line in the current buffer reflects all changes." - (setq tpu-mark-flag (if (tpu-mark) "M" " ")) - (cond (tpu-emacs19-p (force-mode-line-update)) - (t (set-buffer-modified-p (buffer-modified-p)) (sit-for 0)))) - -(cond (tpu-lucid-emacs19-p - (add-hook 'zmacs-deactivate-region-hook 'tpu-update-mode-line) - (add-hook 'zmacs-activate-region-hook 'tpu-update-mode-line)) - (tpu-emacs19-p - (add-hook 'activate-mark-hook 'tpu-update-mode-line) - (add-hook 'deactivate-mark-hook 'tpu-update-mode-line))) - - -;;; -;;; Match Markers - -;;; -;;; Set in: Search -;;; -;;; Used in: Replace, Substitute, Store-Text, Cut/Remove, -;;; Append, and Change-Case -;;; -(defvar tpu-match-beginning-mark (make-marker)) -(defvar tpu-match-end-mark (make-marker)) - -(defun tpu-set-match nil - "Set markers at match beginning and end." - ;; Add one to beginning mark so it stays with the first character of - ;; the string even if characters are added just before the string. - (setq tpu-match-beginning-mark (copy-marker (1+ (match-beginning 0)))) - (setq tpu-match-end-mark (copy-marker (match-end 0)))) - -(defun tpu-unset-match nil - "Unset match beginning and end markers." - (set-marker tpu-match-beginning-mark nil) - (set-marker tpu-match-end-mark nil)) - -(defun tpu-match-beginning nil - "Returns the location of the last match beginning." - (1- (marker-position tpu-match-beginning-mark))) - -(defun tpu-match-end nil - "Returns the location of the last match end." - (marker-position tpu-match-end-mark)) - -(defun tpu-check-match nil - "Returns t if point is between tpu-match markers. -Otherwise sets the tpu-match markers to nil and returns nil." - ;; make sure 1- marker is in this buffer - ;; 2- point is at or after beginning marker - ;; 3- point is before ending marker, or in the case of - ;; zero length regions (like bol, or eol) that the - ;; beginning, end, and point are equal. - (cond ((and - (equal (marker-buffer tpu-match-beginning-mark) (current-buffer)) - (>= (point) (1- (marker-position tpu-match-beginning-mark))) - (or - (< (point) (marker-position tpu-match-end-mark)) - (and (= (1- (marker-position tpu-match-beginning-mark)) - (marker-position tpu-match-end-mark)) - (= (marker-position tpu-match-end-mark) (point))))) t) - (t - (tpu-unset-match) nil))) - -(defun tpu-show-match-markers nil - "Show the values of the match markers." - (interactive) - (if (markerp tpu-match-beginning-mark) - (let ((beg (marker-position tpu-match-beginning-mark))) - (message "(%s, %s) in %s -- current %s in %s" - (if beg (1- beg) nil) - (marker-position tpu-match-end-mark) - (marker-buffer tpu-match-end-mark) - (point) (current-buffer))))) - - -;;; -;;; Utilities -;;; -(defun tpu-caar (thingy) (car (car thingy))) -(defun tpu-cadr (thingy) (car (cdr thingy))) - -(defun tpu-mark nil - "TPU-edt version of the mark function. -Return the appropriate value of the mark for the current -version of Emacs." - (cond (tpu-lucid-emacs19-p (mark (not zmacs-regions))) - (tpu-emacs19-p (and mark-active (mark (not transient-mark-mode)))) - (t (mark)))) - -(defun tpu-set-mark (pos) - "TPU-edt verion of the `set-mark' function. -Sets the mark at POS and activates the region according to the -current version of Emacs." - (set-mark pos) - (and tpu-lucid-emacs19-p pos (zmacs-activate-region))) - -(defun tpu-string-prompt (prompt history-symbol) - "Read a string with PROMPT." - (if tpu-emacs19-p - (read-from-minibuffer prompt nil nil nil history-symbol) - (read-string prompt))) - -(defvar tpu-last-answer nil "Most recent response to tpu-y-or-n-p.") - -(defun tpu-y-or-n-p (prompt &optional not-yes) - "Prompt for a y or n answer with positive default. -Optional second argument NOT-YES changes default to negative. -Like Emacs `y-or-n-p', but also accepts space as y and DEL as n." - (message "%s[%s]" prompt (if not-yes "n" "y")) - (let ((doit t)) - (while doit - (setq doit nil) - (let ((ans (read-char))) - (cond ((or (= ans ?y) (= ans ?Y) (= ans ?\ )) - (setq tpu-last-answer t)) - ((or (= ans ?n) (= ans ?N) (= ans ?\C-?)) - (setq tpu-last-answer nil)) - ((= ans ?\r) (setq tpu-last-answer (not not-yes))) - (t - (setq doit t) (beep) - (message "Please answer y or n. %s[%s]" - prompt (if not-yes "n" "y"))))))) - tpu-last-answer) - -(defun tpu-local-set-key (key func) - "Replace a key in the TPU-edt local key map. -Create the key map if necessary." - (cond ((not (keymapp tpu-buffer-local-map)) - (setq tpu-buffer-local-map (if (current-local-map) - (copy-keymap (current-local-map)) - (make-sparse-keymap))) - (use-local-map tpu-buffer-local-map))) - (local-set-key key func)) - -(defun tpu-current-line nil - "Return the vertical position of point in the selected window. -Top line is 0. Counts each text line only once, even if it wraps." - (+ (count-lines (window-start) (point)) (if (= (current-column) 0) 1 0) -1)) - - -;;; -;;; Breadcrumbs -;;; -(defvar tpu-breadcrumb-plist nil - "The set of user-defined markers (breadcrumbs), as a plist.") - -(defun tpu-drop-breadcrumb (num) - "Drops a breadcrumb that can be returned to later with goto-breadcrumb." - (interactive "p") - (put tpu-breadcrumb-plist num (list (current-buffer) (point))) - (message "Mark %d set." num)) - -(defun tpu-goto-breadcrumb (num) - "Returns to a breadcrumb set with drop-breadcrumb." - (interactive "p") - (cond ((get tpu-breadcrumb-plist num) - (switch-to-buffer (car (get tpu-breadcrumb-plist num))) - (goto-char (tpu-cadr (get tpu-breadcrumb-plist num))) - (message "mark %d found." num)) - (t - (message "mark %d not found." num)))) - - -;;; -;;; Miscellaneous -;;; -(defun tpu-change-case (num) - "Change the case of the character under the cursor or region. -Accepts a prefix argument of the number of characters to invert." - (interactive "p") - (cond ((tpu-mark) - (let ((beg (region-beginning)) (end (region-end))) - (while (> end beg) - (funcall (if (= (downcase (char-after beg)) (char-after beg)) - 'upcase-region 'downcase-region) - beg (1+ beg)) - (setq beg (1+ beg))) - (tpu-unselect t))) - ((tpu-check-match) - (let ((beg (tpu-match-beginning)) (end (tpu-match-end))) - (while (> end beg) - (funcall (if (= (downcase (char-after beg)) (char-after beg)) - 'upcase-region 'downcase-region) - beg (1+ beg)) - (setq beg (1+ beg))) - (tpu-unset-match))) - (t - (while (> num 0) - (funcall (if (= (downcase (following-char)) (following-char)) - 'upcase-region 'downcase-region) - (point) (1+ (point))) - (forward-char (if tpu-reverse -1 1)) - (setq num (1- num)))))) - -(defun tpu-fill (num) - "Fill paragraph or marked region. -With argument, fill and justify." - (interactive "P") - (cond ((tpu-mark) - (fill-region (point) (tpu-mark) num) - (tpu-unselect t)) - (t - (fill-paragraph num)))) - -(defun tpu-version nil - "Print the TPU-edt version number." - (interactive) - (message - "TPU-edt version %s by Rob Riepel (riepel@networking.stanford.edu)" - tpu-version)) - -(defun tpu-reset-screen-size (height width) - "Sets the screen size." - (interactive "nnew screen height: \nnnew screen width: ") - (set-screen-height height) - (set-screen-width width)) - -(defun tpu-toggle-newline-and-indent nil - "Toggle between 'newline and indent' and 'simple newline'." - (interactive) - (cond (tpu-newline-and-indent-p - (setq tpu-newline-and-indent-string "") - (setq tpu-newline-and-indent-p nil) - (tpu-local-set-key "\C-m" 'newline)) - (t - (setq tpu-newline-and-indent-string " AutoIndent") - (setq tpu-newline-and-indent-p t) - (tpu-local-set-key "\C-m" 'newline-and-indent))) - (tpu-update-mode-line) - (and (interactive-p) - (message "Carriage return inserts a newline%s" - (if tpu-newline-and-indent-p " and indents." ".")))) - -(defun tpu-spell-check nil - "Checks the spelling of the region, or of the entire buffer if no - region is selected." - (interactive) - (cond (tpu-have-ispell - (if (tpu-mark) (ispell-region (tpu-mark) (point)) (ispell-buffer))) - (t - (if (tpu-mark) (spell-region (tpu-mark) (point)) (spell-buffer)))) - (if (tpu-mark) (tpu-unselect t))) - -(defun tpu-toggle-overwrite-mode nil - "Switches in and out of overwrite mode" - (interactive) - (cond (overwrite-mode - (tpu-local-set-key "\177" tpu-saved-delete-func) - (overwrite-mode 0)) - (t - (setq tpu-saved-delete-func (local-key-binding "\177")) - (tpu-local-set-key "\177" 'picture-backward-clear-column) - (overwrite-mode 1)))) - -(defun tpu-special-insert (num) - "Insert a character or control code according to -its ASCII decimal value." - (interactive "P") - (if overwrite-mode (delete-char 1)) - (insert (if num num 0))) - -(defun tpu-quoted-insert (num) - "Read next input character and insert it. -This is useful for inserting control characters." - (interactive "*p") - (let ((char (read-char)) ) - (if overwrite-mode (delete-char num)) - (insert-char char num))) - - -;;; -;;; TPU line-mode commands -;;; -(defun tpu-include (file) - "TPU-like include file" - (interactive "fInclude file: ") - (save-excursion - (insert-file file) - (message ""))) - -(defun tpu-get (file) - "TPU-like get file" - (interactive "FFile to get: ") - (find-file file)) - -(defun tpu-what-line nil - "Tells what line the point is on, - and the total number of lines in the buffer." - (interactive) - (if (eobp) - (message "You are at the End of Buffer. The last line is %d." - (count-lines 1 (point-max))) - (message "Line %d of %d" - (count-lines 1 (1+ (point))) - (count-lines 1 (point-max))))) - -(defun tpu-exit nil - "Exit the way TPU does, save current buffer and ask about others." - (interactive) - (if (not (eq (recursion-depth) 0)) - (exit-recursive-edit) - (progn (save-buffer) (save-buffers-kill-emacs)))) - -(defun tpu-quit nil - "Quit the way TPU does, ask to make sure changes should be abandoned." - (interactive) - (let ((list (buffer-list)) - (working t)) - (while (and list working) - (let ((buffer (car list))) - (if (and (buffer-file-name buffer) (buffer-modified-p buffer)) - (if (tpu-y-or-n-p - "Modifications will not be saved, continue quitting? ") - (kill-emacs t) (setq working nil))) - (setq list (cdr list)))) - (if working (kill-emacs t)))) - - -;;; -;;; Command and Function Aliases -;;; -;;;###autoload -(fset 'tpu-edt-mode 'tpu-edt-on) -(fset 'TPU-EDT-MODE 'tpu-edt-on) - -;;;###autoload -(fset 'tpu-edt 'tpu-edt-on) -(fset 'TPU-EDT 'tpu-edt-on) - -(fset 'exit 'tpu-exit) -(fset 'EXIT 'tpu-exit) - -(fset 'Get 'tpu-get) -(fset 'GET 'tpu-get) - -(fset 'include 'tpu-include) -(fset 'INCLUDE 'tpu-include) - -(fset 'quit 'tpu-quit) -(fset 'QUIT 'tpu-quit) - -(fset 'spell 'tpu-spell-check) -(fset 'SPELL 'tpu-spell-check) - -(fset 'what\ line 'tpu-what-line) -(fset 'WHAT\ LINE 'tpu-what-line) - -(fset 'replace 'tpu-lm-replace) -(fset 'REPLACE 'tpu-lm-replace) - -;; Apparently TPU users really expect to do M-x help RET to get help. -;; So it is really necessary to redefine this. -(fset 'help 'tpu-help) -(fset 'HELP 'tpu-help) - -(fset 'set\ cursor\ free 'tpu-set-cursor-free) -(fset 'SET\ CURSOR\ FREE 'tpu-set-cursor-free) - -(fset 'set\ cursor\ bound 'tpu-set-cursor-bound) -(fset 'SET\ CURSOR\ BOUND 'tpu-set-cursor-bound) - -(fset 'set\ scroll\ margins 'tpu-set-scroll-margins) -(fset 'SET\ SCROLL\ MARGINS 'tpu-set-scroll-margins) - - -;; Around emacs version 18.57, function line-move was renamed to -;; next-line-internal. If we're running under an older emacs, -;; make next-line-internal equivalent to line-move. - -(if (not (fboundp 'next-line-internal)) (fset 'next-line-internal 'line-move)) - - -;;; -;;; Help -;;; -(defconst tpu-help-keypad-map "\f - _______________________ _______________________________ - | HELP | Do | | | | | | - |KeyDefs| | | | | | | - |_______|_______________| |_______|_______|_______|_______| - _______________________ _______________________________ - | Find |Insert |Remove | | Gold | HELP |FndNxt | Del L | - | | |Sto Tex| | key |E-Help | Find |Undel L| - |_______|_______|_______| |_______|_______|_______|_______| - |Select |Pre Scr|Nex Scr| | Page | Sect |Append | Del W | - | Reset |Pre Win|Nex Win| | Do | Fill |Replace|Undel W| - |_______|_______|_______| |_______|_______|_______|_______| - |Move up| |Forward|Reverse|Remove | Del C | - | Top | |Bottom | Top |Insert |Undel C| - _______|_______|_______ |_______|_______|_______|_______| - |Mov Lef|Mov Dow|Mov Rig| | Word | EOL | Char | | - |StaOfLi|Bottom |EndOfLi| |ChngCas|Del EOL|SpecIns| Enter | - |_______|_______|_______| |_______|_______|_______| | - | Line |Select | Subs | - | Open Line | Reset | | - |_______________|_______|_______| -") - -(defconst tpu-help-text " -\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f - - Control Characters - - ^A toggle insert and overwrite - ^B recall - ^E end of line - - ^G Cancel current operation - ^H beginning of line - ^J delete previous word - - ^K learn - ^L insert page break - ^R remember (during learn), re-center - - ^U delete to beginning of line - ^V quote - ^W refresh - - ^Z exit - ^X^X exchange point and mark - useful for checking region boundaries - -\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f - Gold-<key> Functions - - B Next Buffer - display the next buffer (all buffers) - C Recall - edit and possibly repeat previous commands - E Exit - save current buffer and ask about others - G Get - load a file into a new edit buffer - - I Include - include a file in this buffer - K Kill Buffer - abandon edits and delete buffer - M Buffer Menu - display a list of all buffers - N Next File Buffer - display next buffer containing a file - - O Occur - show following lines containing REGEXP - Q Quit - exit without saving anything - R Toggle rectangular mode for remove and insert - S Search and substitute - line mode REPLACE command - - ^T Toggle control key bindings between TPU and emacs - U Undo - undo the last edit - W Write - save current buffer - X Exit - save all modified buffers and exit - -\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f - - More extensive documentation on TPU-edt can be found in the `Commentary' - section of tpu-edt.el. This section can be accessed through the standard - Emacs help facility using the `p' option. Once you exit TPU-edt Help, one - of the following key sequences is sure to get you there. - - ^h p if you're not yet using TPU-edt - Gold-PF2 p if you're using TPU-edt - - Alternatively, fire up Emacs help from the command prompt, with - - M-x help-for-help <CR> p <CR> - - Where `M-x' might be any of `Gold-KP7', 'Do', or 'ESC-x'. - - When you successfully invoke this part of the Emacs help facility, you - will see a buffer named `*Finder*' listing a number of topics. Look for - tpu-edt under `emulations'. - -\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f - - *** No more help, use P to view previous screen") - -(defvar tpu-help-enter (format "%s" "\eOM")) ; tpu-help enter key symbol -(defvar tpu-help-return (format "%s" "\r")) ; tpu-help enter key symbol -(defvar tpu-help-N "N") ; tpu-help "N" symbol -(defvar tpu-help-n "n") ; tpu-help "n" symbol -(defvar tpu-help-P "P") ; tpu-help "P" symbol -(defvar tpu-help-p "p") ; tpu-help "p" symbol - -(defun tpu-help nil - "Display TPU-edt help." - (interactive) - ;; Save current window configuration - (save-window-excursion - ;; Create and fill help buffer if necessary - (if (not (get-buffer "*TPU-edt Help*")) - (progn (generate-new-buffer "*TPU-edt Help*") - (switch-to-buffer "*TPU-edt Help*") - (insert tpu-help-keypad-map) - (insert tpu-help-text) - (setq buffer-read-only t))) - - ;; Display the help buffer - (switch-to-buffer "*TPU-edt Help*") - (delete-other-windows) - (tpu-move-to-beginning) - (forward-line 1) - (tpu-line-to-top-of-window) - - ;; Prompt for keys to describe, based on screen state (split/not split) - (let ((key nil) (fkey nil) (split nil)) - (while (not (equal tpu-help-return fkey)) - (if split - (setq key - (read-key-sequence - "Press the key you want help on (RET=exit, ENTER=redisplay, N=next, P=prev): ")) - (setq key - (read-key-sequence - "Press the key you want help on (RET to exit, N next screen, P prev screen): "))) - - ;; Process the read key - ;; - ;; ENTER - Display just the help window - ;; N or n - Next help or describe-key screen - ;; P or p - Previous help or describe-key screen - ;; RETURN - Exit from TPU-help - ;; default - describe the key - ;; - (setq fkey (format "%s" key)) - (cond ((equal tpu-help-enter fkey) - (setq split nil) - (delete-other-windows)) - ((or (equal tpu-help-N fkey) (equal tpu-help-n fkey)) - (cond (split - (condition-case nil - (scroll-other-window 8) - (error nil))) - (t - (forward-page) - (forward-line 1) - (tpu-line-to-top-of-window)))) - ((or (equal tpu-help-P fkey) (equal tpu-help-p fkey)) - (cond (split - (condition-case nil - (scroll-other-window -8) - (error nil))) - (t - (backward-page) - (forward-line 1) - (tpu-line-to-top-of-window)))) - ((not (equal tpu-help-return fkey)) - (setq split t) - (describe-key key) - ;; If the key is undefined, leave the - ;; message in the mini-buffer for 3 seconds - (if (not (key-binding key)) (sit-for 3)))))))) - - -;;; -;;; Auto-insert -;;; -(defun tpu-insert-escape nil - "Inserts an escape character, and so becomes the escape-key alias." - (interactive) - (insert "\e")) - -(defun tpu-insert-formfeed nil - "Inserts a formfeed character." - (interactive) - (insert "\C-L")) - - -;;; -;;; Define key -;;; -(defvar tpu-saved-control-r nil "Saved value of Control-r.") - -(defun tpu-end-define-macro-key (key) - "Ends the current macro definition" - (interactive "kPress the key you want to use to do what was just learned: ") - (end-kbd-macro nil) - (global-set-key key last-kbd-macro) - (global-set-key "\C-r" tpu-saved-control-r)) - -(defun tpu-define-macro-key nil - "Bind a set of keystrokes to a single key, or key combination." - (interactive) - (setq tpu-saved-control-r (global-key-binding "\C-r")) - (global-set-key "\C-r" 'tpu-end-define-macro-key) - (start-kbd-macro nil)) - - -;;; -;;; Buffers and Windows -;;; -(defun tpu-kill-buffer nil - "Kills the current buffer. If tpu-kill-buffers-silently is non-nil, -kills modified buffers without asking." - (interactive) - (if tpu-kill-buffers-silently (set-buffer-modified-p nil)) - (kill-buffer (current-buffer))) - -(defun tpu-save-all-buffers-kill-emacs nil - "Save all buffers and exit emacs." - (interactive) - (let ((delete-old-versions t)) - (save-buffers-kill-emacs t))) - -(defun tpu-write-current-buffers nil - "Save all modified buffers without exiting." - (interactive) - (save-some-buffers t)) - -(defun tpu-next-buffer nil - "Go to next buffer in ring." - (interactive) - (switch-to-buffer (car (reverse (buffer-list))))) - -(defun tpu-next-file-buffer nil - "Go to next buffer in ring that is visiting a file or directory." - (interactive) - (let ((list (tpu-make-file-buffer-list (buffer-list)))) - (setq list (delq (current-buffer) list)) - (if (not list) (error "No other buffers.")) - (switch-to-buffer (car (reverse list))))) - -(defun tpu-make-file-buffer-list (buffer-list) - "Returns names from BUFFER-LIST excluding those beginning with a space or star." - (delq nil (mapcar '(lambda (b) - (if (or (= (aref (buffer-name b) 0) ? ) - (= (aref (buffer-name b) 0) ?*)) nil b)) - buffer-list))) - -(defun tpu-next-window nil - "Move to the next window." - (interactive) - (if (one-window-p) (message "There is only one window on screen.") - (other-window 1))) - -(defun tpu-previous-window nil - "Move to the previous window." - (interactive) - (if (one-window-p) (message "There is only one window on screen.") - (select-window (previous-window)))) - - -;;; -;;; Search -;;; -(defun tpu-toggle-regexp nil - "Switches in and out of regular expression search and replace mode." - (interactive) - (setq tpu-regexp-p (not tpu-regexp-p)) - (tpu-set-search) - (and (interactive-p) - (message "Regular expression search and substitute %sabled." - (if tpu-regexp-p "en" "dis")))) - -(defun tpu-regexp-prompt (prompt) - "Read a string, adding 'RE' to the prompt if tpu-regexp-p is set." - (let ((re-prompt (concat (if tpu-regexp-p "RE ") prompt))) - (if tpu-emacs19-p - (read-from-minibuffer re-prompt nil nil nil 'tpu-regexp-prompt-hist) - (read-string re-prompt)))) - -(defun tpu-search nil - "Search for a string or regular expression. -The search is performed in the current direction." - (interactive) - (tpu-set-search) - (tpu-search-internal "")) - -(defun tpu-search-forward nil - "Search for a string or regular expression. -The search is begins in the forward direction." - (interactive) - (setq tpu-searching-forward t) - (tpu-set-search t) - (tpu-search-internal "")) - -(defun tpu-search-reverse nil - "Search for a string or regular expression. -The search is begins in the reverse direction." - (interactive) - (setq tpu-searching-forward nil) - (tpu-set-search t) - (tpu-search-internal "")) - -(defun tpu-search-again nil - "Search for the same string or regular expression as last time. -The search is performed in the current direction." - (interactive) - (tpu-search-internal tpu-search-last-string)) - -;; tpu-set-search defines the search functions used by the TPU-edt internal -;; search function. It should be called whenever the direction changes, or -;; the regular expression mode is turned on or off. It can also be called -;; to ensure that the next search will be in the current direction. It is -;; called from: - -;; tpu-advance tpu-backup -;; tpu-toggle-regexp tpu-toggle-search-direction (t) -;; tpu-search tpu-lm-replace -;; tpu-search-forward (t) tpu-search-reverse (t) -;; tpu-search-forward-exit (t) tpu-search-backward-exit (t) - -(defun tpu-set-search (&optional arg) - "Set the search functions and set the search direction to the current -direction. If an argument is specified, don't set the search direction." - (if (not arg) (setq tpu-searching-forward (if tpu-advance t nil))) - (cond (tpu-searching-forward - (cond (tpu-regexp-p - (fset 'tpu-emacs-search 're-search-forward) - (fset 'tpu-emacs-rev-search 're-search-backward)) - (t - (fset 'tpu-emacs-search 'search-forward) - (fset 'tpu-emacs-rev-search 'search-backward)))) - (t - (cond (tpu-regexp-p - (fset 'tpu-emacs-search 're-search-backward) - (fset 'tpu-emacs-rev-search 're-search-forward)) - (t - (fset 'tpu-emacs-search 'search-backward) - (fset 'tpu-emacs-rev-search 'search-forward)))))) - -(defun tpu-search-internal (pat &optional quiet) - "Search for a string or regular expression." - (setq tpu-search-last-string - (if (not (string= "" pat)) pat (tpu-regexp-prompt "Search: "))) - - (tpu-unset-match) - (tpu-adjust-search) - - (let ((case-fold-search - (and case-fold-search (tpu-check-search-case tpu-search-last-string)))) - - (cond ((tpu-emacs-search tpu-search-last-string nil t) - (tpu-set-match) (goto-char (tpu-match-beginning))) - - (t - (tpu-adjust-search t) - (let ((found nil) (pos nil)) - (save-excursion - (let ((tpu-searching-forward (not tpu-searching-forward))) - (tpu-adjust-search) - (setq found (tpu-emacs-rev-search tpu-search-last-string nil t)) - (setq pos (match-beginning 0)))) - - (cond - (found - (cond ((tpu-y-or-n-p - (format "Found in %s direction. Go there? " - (if tpu-searching-forward "reverse" "forward"))) - (goto-char pos) (tpu-set-match) - (tpu-toggle-search-direction)))) - - (t - (if (not quiet) - (message - "%sSearch failed: \"%s\"" - (if tpu-regexp-p "RE " "") tpu-search-last-string))))))))) - -(fset 'tpu-search-internal-core (symbol-function 'tpu-search-internal)) - -(defun tpu-check-search-case (string) - "Returns t if string contains upper case." - ;; if using regexp, eliminate upper case forms (\B \W \S.) - (if tpu-regexp-p - (let ((pat (copy-sequence string)) (case-fold-search nil) (pos 0)) - (while (setq pos (string-match "\\\\\\\\" pat)) (aset pat (+ 1 pos) ?.)) - (while (setq pos (string-match "\\\\B" pat)) (aset pat (+ 1 pos) ?.)) - (while (setq pos (string-match "\\\\W" pat)) (aset pat (+ 1 pos) ?.)) - (while (setq pos (string-match "\\\\S." pat)) - (aset pat (+ 1 pos) ?.) (aset pat (+ 2 pos) ?.)) - (string-equal pat (downcase pat))) - (string-equal string (downcase string)))) - -(defun tpu-adjust-search (&optional arg) - "For forward searches, move forward a character before searching, -and backward a character after a failed search. Arg means end of search." - (if tpu-searching-forward - (cond (arg (if (not (bobp)) (forward-char -1))) - (t (if (not (eobp)) (forward-char 1)))))) - -(defun tpu-toggle-search-direction nil - "Toggle the TPU-edt search direction. -Used for reversing a search in progress." - (interactive) - (setq tpu-searching-forward (not tpu-searching-forward)) - (tpu-set-search t) - (and (interactive-p) - (message "Searching %sward." - (if tpu-searching-forward "for" "back")))) - -(defun tpu-search-forward-exit nil - "Set search direction forward and exit minibuffer." - (interactive) - (setq tpu-searching-forward t) - (tpu-set-search t) - (exit-minibuffer)) - -(defun tpu-search-backward-exit nil - "Set search direction backward and exit minibuffer." - (interactive) - (setq tpu-searching-forward nil) - (tpu-set-search t) - (exit-minibuffer)) - - -;;; -;;; Select / Unselect -;;; -(defun tpu-select (&optional quiet) - "Sets the mark to define one end of a region." - (interactive "P") - (cond ((tpu-mark) - (tpu-unselect quiet)) - (t - (tpu-set-mark (point)) - (tpu-update-mode-line) - (if (not quiet) (message "Move the text cursor to select text."))))) - -(defun tpu-unselect (&optional quiet) - "Removes the mark to unselect the current region." - (interactive "P") - (setq mark-ring nil) - (tpu-set-mark nil) - (tpu-update-mode-line) - (if (not quiet) (message "Selection canceled."))) - - -;;; -;;; Delete / Cut -;;; -(defun tpu-toggle-rectangle nil - "Toggle rectangular mode for remove and insert." - (interactive) - (setq tpu-rectangular-p (not tpu-rectangular-p)) - (setq tpu-rectangle-string (if tpu-rectangular-p " Rect" "")) - (tpu-update-mode-line) - (and (interactive-p) - (message "Rectangular cut and paste %sabled." - (if tpu-rectangular-p "en" "dis")))) - -(defun tpu-arrange-rectangle nil - "Adjust point and mark to mark upper left and lower right -corners of a rectangle." - (let ((mc (current-column)) - (pc (progn (exchange-point-and-mark) (current-column)))) - - (cond ((> (point) (tpu-mark)) ; point on lower line - (cond ((> pc mc) ; point @ lower-right - (exchange-point-and-mark)) ; point -> upper-left - - (t ; point @ lower-left - (move-to-column-force mc) ; point -> lower-right - (exchange-point-and-mark) ; point -> upper-right - (move-to-column-force pc)))) ; point -> upper-left - - (t ; point on upper line - (cond ((> pc mc) ; point @ upper-right - (move-to-column-force mc) ; point -> upper-left - (exchange-point-and-mark) ; point -> lower-left - (move-to-column-force pc) ; point -> lower-right - (exchange-point-and-mark))))))) ; point -> upper-left - -(defun tpu-cut-text nil - "Delete the selected region. -The text is saved for the tpu-paste command." - (interactive) - (cond ((tpu-mark) - (cond (tpu-rectangular-p - (tpu-arrange-rectangle) - (picture-clear-rectangle (point) (tpu-mark) (not overwrite-mode)) - (tpu-unselect t)) - (t - (setq tpu-last-deleted-region - (buffer-substring (tpu-mark) (point))) - (delete-region (tpu-mark) (point)) - (tpu-unselect t)))) - ((tpu-check-match) - (let ((beg (tpu-match-beginning)) (end (tpu-match-end))) - (setq tpu-last-deleted-region (buffer-substring beg end)) - (delete-region beg end) - (tpu-unset-match))) - (t - (error "No selection active.")))) - -(defun tpu-store-text nil - "Copy the selected region to the cut buffer without deleting it. -The text is saved for the tpu-paste command." - (interactive) - (cond ((tpu-mark) - (cond (tpu-rectangular-p - (save-excursion - (tpu-arrange-rectangle) - (setq picture-killed-rectangle - (extract-rectangle (point) (tpu-mark)))) - (tpu-unselect t)) - (t - (setq tpu-last-deleted-region - (buffer-substring (tpu-mark) (point))) - (tpu-unselect t)))) - ((tpu-check-match) - (setq tpu-last-deleted-region - (buffer-substring (tpu-match-beginning) (tpu-match-end))) - (tpu-unset-match)) - (t - (error "No selection active.")))) - -(defun tpu-cut (arg) - "Copy selected region to the cut buffer. In the absence of an -argument, delete the selected region too." - (interactive "P") - (if arg (tpu-store-text) (tpu-cut-text))) - -(defun tpu-append-region (arg) - "Append selected region to the tpu-cut buffer. In the absence of an -argument, delete the selected region too." - (interactive "P") - (cond ((tpu-mark) - (let ((beg (region-beginning)) (end (region-end))) - (setq tpu-last-deleted-region - (concat tpu-last-deleted-region - (buffer-substring beg end))) - (if (not arg) (delete-region beg end)) - (tpu-unselect t))) - ((tpu-check-match) - (let ((beg (tpu-match-beginning)) (end (tpu-match-end))) - (setq tpu-last-deleted-region - (concat tpu-last-deleted-region - (buffer-substring beg end))) - (if (not arg) (delete-region beg end)) - (tpu-unset-match))) - (t - (error "No selection active.")))) - -(defun tpu-delete-current-line (num) - "Delete one or specified number of lines after point. -This includes the newline character at the end of each line. -They are saved for the TPU-edt undelete-lines command." - (interactive "p") - (let ((beg (point))) - (forward-line num) - (if (not (eq (preceding-char) ?\n)) - (insert "\n")) - (setq tpu-last-deleted-lines - (buffer-substring beg (point))) - (delete-region beg (point)))) - -(defun tpu-delete-to-eol (num) - "Delete text up to end of line. -With argument, delete up to to Nth line-end past point. -They are saved for the TPU-edt undelete-lines command." - (interactive "p") - (let ((beg (point))) - (forward-char 1) - (end-of-line num) - (setq tpu-last-deleted-lines - (buffer-substring beg (point))) - (delete-region beg (point)))) - -(defun tpu-delete-to-bol (num) - "Delete text back to beginning of line. -With argument, delete up to to Nth line-end past point. -They are saved for the TPU-edt undelete-lines command." - (interactive "p") - (let ((beg (point))) - (tpu-next-beginning-of-line num) - (setq tpu-last-deleted-lines - (buffer-substring (point) beg)) - (delete-region (point) beg))) - -(defun tpu-delete-current-word (num) - "Delete one or specified number of words after point. -They are saved for the TPU-edt undelete-words command." - (interactive "p") - (let ((beg (point))) - (tpu-forward-to-word num) - (setq tpu-last-deleted-words - (buffer-substring beg (point))) - (delete-region beg (point)))) - -(defun tpu-delete-previous-word (num) - "Delete one or specified number of words before point. -They are saved for the TPU-edt undelete-words command." - (interactive "p") - (let ((beg (point))) - (tpu-backward-to-word num) - (setq tpu-last-deleted-words - (buffer-substring (point) beg)) - (delete-region beg (point)))) - -(defun tpu-delete-current-char (num) - "Delete one or specified number of characters after point. The last -character deleted is saved for the TPU-edt undelete-char command." - (interactive "p") - (while (and (> num 0) (not (eobp))) - (setq tpu-last-deleted-char (char-after (point))) - (cond (overwrite-mode - (picture-clear-column 1) - (forward-char 1)) - (t - (delete-char 1))) - (setq num (1- num)))) - - -;;; -;;; Undelete / Paste -;;; -(defun tpu-paste (num) - "Insert the last region or rectangle of killed text. -With argument reinserts the text that many times." - (interactive "p") - (while (> num 0) - (cond (tpu-rectangular-p - (let ((beg (point))) - (save-excursion - (picture-yank-rectangle (not overwrite-mode)) - (message "")) - (goto-char beg))) - (t - (insert tpu-last-deleted-region))) - (setq num (1- num)))) - -(defun tpu-undelete-lines (num) - "Insert lines deleted by last TPU-edt line-deletion command. -With argument reinserts lines that many times." - (interactive "p") - (let ((beg (point))) - (while (> num 0) - (insert tpu-last-deleted-lines) - (setq num (1- num))) - (goto-char beg))) - -(defun tpu-undelete-words (num) - "Insert words deleted by last TPU-edt word-deletion command. -With argument reinserts words that many times." - (interactive "p") - (let ((beg (point))) - (while (> num 0) - (insert tpu-last-deleted-words) - (setq num (1- num))) - (goto-char beg))) - -(defun tpu-undelete-char (num) - "Insert character deleted by last TPU-edt character-deletion command. -With argument reinserts the character that many times." - (interactive "p") - (while (> num 0) - (if overwrite-mode (prog1 (forward-char -1) (delete-char 1))) - (insert tpu-last-deleted-char) - (forward-char -1) - (setq num (1- num)))) - - -;;; -;;; Replace and Substitute -;;; -(defun tpu-replace nil - "Replace the selected region with the contents of the cut buffer." - (interactive) - (cond ((tpu-mark) - (let ((beg (region-beginning)) (end (region-end))) - (setq tpu-last-replaced-text (buffer-substring beg end)) - (delete-region beg end) - (insert tpu-last-deleted-region) - (tpu-unselect t))) - ((tpu-check-match) - (let ((beg (tpu-match-beginning)) (end (tpu-match-end))) - (setq tpu-last-replaced-text (buffer-substring beg end)) - (replace-match tpu-last-deleted-region - (not case-replace) (not tpu-regexp-p)) - (tpu-unset-match))) - (t - (error "No selection active.")))) - -(defun tpu-substitute (num) - "Replace the selected region with the contents of the cut buffer, and -repeat most recent search. A numeric argument serves as a repeat count. -A negative argument means replace all occurrences of the search string." - (interactive "p") - (cond ((or (tpu-mark) (tpu-check-match)) - (while (and (not (= num 0)) (or (tpu-mark) (tpu-check-match))) - (let ((beg (point))) - (tpu-replace) - (if tpu-searching-forward (forward-char -1) (goto-char beg)) - (if (= num 1) (tpu-search-internal tpu-search-last-string) - (tpu-search-internal-core tpu-search-last-string))) - (setq num (1- num)))) - (t - (error "No selection active.")))) - -(defun tpu-lm-replace (from to) - "Interactively search for OLD-string and substitute NEW-string." - (interactive (list (tpu-regexp-prompt "Old String: ") - (tpu-regexp-prompt "New String: "))) - - (let ((doit t) (strings 0)) - - ;; Can't replace null strings - (if (string= "" from) (error "No string to replace.")) - - ;; Find the first occurrence - (tpu-set-search) - (tpu-search-internal from t) - - ;; Loop on replace question - yes, no, all, last, or quit. - (while doit - (if (not (tpu-check-match)) (setq doit nil) - (progn (message "Replace? Type Yes, No, All, Last, or Quit: ") - (let ((ans (read-char))) - - (cond ((or (= ans ?y) (= ans ?Y) (= ans ?\r) (= ans ?\ )) - (let ((beg (point))) - (replace-match to (not case-replace) (not tpu-regexp-p)) - (setq strings (1+ strings)) - (if tpu-searching-forward (forward-char -1) (goto-char beg))) - (tpu-search-internal from t)) - - ((or (= ans ?n) (= ans ?N) (= ans ?\C-?)) - (tpu-search-internal from t)) - - ((or (= ans ?a) (= ans ?A)) - (save-excursion - (let ((beg (point))) - (replace-match to (not case-replace) (not tpu-regexp-p)) - (setq strings (1+ strings)) - (if tpu-searching-forward (forward-char -1) (goto-char beg))) - (tpu-search-internal-core from t) - (while (tpu-check-match) - (let ((beg (point))) - (replace-match to (not case-replace) (not tpu-regexp-p)) - (setq strings (1+ strings)) - (if tpu-searching-forward (forward-char -1) (goto-char beg))) - (tpu-search-internal-core from t))) - (setq doit nil)) - - ((or (= ans ?l) (= ans ?L)) - (let ((beg (point))) - (replace-match to (not case-replace) (not tpu-regexp-p)) - (setq strings (1+ strings)) - (if tpu-searching-forward (forward-char -1) (goto-char beg))) - (setq doit nil)) - - ((or (= ans ?q) (= ans ?Q)) - (setq doit nil))))))) - - (message "Replaced %s occurrence%s." strings - (if (not (= 1 strings)) "s" "")))) - -(defun tpu-emacs-replace (&optional dont-ask) - "A TPU-edt interface to the emacs replace functions. If TPU-edt is -currently in regular expression mode, the emacs regular expression -replace functions are used. If an argument is supplied, replacements -are performed without asking. Only works in forward direction." - (interactive "P") - (cond (dont-ask - (setq current-prefix-arg nil) - (call-interactively - (if tpu-regexp-p 'replace-regexp 'replace-string))) - (t - (call-interactively - (if tpu-regexp-p 'query-replace-regexp 'query-replace))))) - -(defun tpu-add-at-bol (text) - "Add text to the beginning of each line in a region, -or each line in the entire buffer if no region is selected." - (interactive - (list (tpu-string-prompt "String to add: " 'tpu-add-at-bol-hist))) - (if (string= "" text) (error "No string specified.")) - (cond ((tpu-mark) - (save-excursion - (if (> (point) (tpu-mark)) (exchange-point-and-mark)) - (while (and (< (point) (tpu-mark)) (re-search-forward "^" (tpu-mark) t)) - (if (< (point) (tpu-mark)) (replace-match text)))) - (tpu-unselect t)) - (t - (save-excursion - (goto-char (point-min)) - (while (and (re-search-forward "^" nil t) (not (eobp))) - (replace-match text)))))) - -(defun tpu-add-at-eol (text) - "Add text to the end of each line in a region, -or each line of the entire buffer if no region is selected." - (interactive - (list (tpu-string-prompt "String to add: " 'tpu-add-at-eol-hist))) - (if (string= "" text) (error "No string specified.")) - (cond ((tpu-mark) - (save-excursion - (if (> (point) (tpu-mark)) (exchange-point-and-mark)) - (while (< (point) (tpu-mark)) - (end-of-line) - (if (<= (point) (tpu-mark)) (insert text)) - (forward-line))) - (tpu-unselect t)) - (t - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (end-of-line) (insert text) (forward-line)))))) - -(defun tpu-trim-line-ends nil - "Removes trailing whitespace from every line in the buffer." - (interactive) - (picture-clean)) - - -;;; -;;; Movement by character -;;; -(defun tpu-char (num) - "Move to the next character in the current direction. -A repeat count means move that many characters." - (interactive "p") - (if tpu-advance (tpu-forward-char num) (tpu-backward-char num))) - -(defun tpu-forward-char (num) - "Move right ARG characters (left if ARG is negative)." - (interactive "p") - (forward-char num)) - -(defun tpu-backward-char (num) - "Move left ARG characters (right if ARG is negative)." - (interactive "p") - (backward-char num)) - - -;;; -;;; Movement by word -;;; -(defconst tpu-word-separator-list '() - "List of additional word separators.") -(defconst tpu-skip-chars "^ \t" - "Characters to skip when moving by word. -Additional word separators are added to this string.") - -(defun tpu-word (num) - "Move to the beginning of the next word in the current direction. -A repeat count means move that many words." - (interactive "p") - (if tpu-advance (tpu-forward-to-word num) (tpu-backward-to-word num))) - -(defun tpu-forward-to-word (num) - "Move forward until encountering the beginning of a word. -With argument, do this that many times." - (interactive "p") - (while (and (> num 0) (not (eobp))) - (let* ((beg (point)) - (end (prog2 (end-of-line) (point) (goto-char beg)))) - (cond ((eolp) - (forward-char 1)) - ((memq (char-after (point)) tpu-word-separator-list) - (forward-char 1) - (skip-chars-forward " \t" end)) - (t - (skip-chars-forward tpu-skip-chars end) - (skip-chars-forward " \t" end)))) - (setq num (1- num)))) - -(defun tpu-backward-to-word (num) - "Move backward until encountering the beginning of a word. -With argument, do this that many times." - (interactive "p") - (while (and (> num 0) (not (bobp))) - (let* ((beg (point)) - (end (prog2 (beginning-of-line) (point) (goto-char beg)))) - (cond ((bolp) - ( forward-char -1)) - ((memq (char-after (1- (point))) tpu-word-separator-list) - (forward-char -1)) - (t - (skip-chars-backward " \t" end) - (skip-chars-backward tpu-skip-chars end) - (if (and (not (bolp)) (= ? (char-syntax (char-after (point))))) - (forward-char -1))))) - (setq num (1- num)))) - -(defun tpu-add-word-separators (separators) - "Add new word separators for TPU-edt word commands." - (interactive "sSeparators: ") - (let* ((n 0) (length (length separators))) - (while (< n length) - (let ((char (aref separators n)) - (ss (substring separators n (1+ n)))) - (cond ((not (memq char tpu-word-separator-list)) - (setq tpu-word-separator-list - (append ss tpu-word-separator-list)) - (cond ((= char ?-) - (setq tpu-skip-chars (concat tpu-skip-chars "\\-"))) - ((= char ?\\) - (setq tpu-skip-chars (concat tpu-skip-chars "\\\\"))) - ((= char ?^) - (setq tpu-skip-chars (concat tpu-skip-chars "\\^"))) - (t - (setq tpu-skip-chars (concat tpu-skip-chars ss)))))) - (setq n (1+ n)))))) - -(defun tpu-reset-word-separators nil - "Reset word separators to default value." - (interactive) - (setq tpu-word-separator-list nil) - (setq tpu-skip-chars "^ \t")) - -(defun tpu-set-word-separators (separators) - "Set new word separators for TPU-edt word commands." - (interactive "sSeparators: ") - (tpu-reset-word-separators) - (tpu-add-word-separators separators)) - - -;;; -;;; Movement by line -;;; -(defun tpu-next-line (num) - "Move to next line. -Prefix argument serves as a repeat count." - (interactive "p") - (next-line-internal num) - (setq this-command 'next-line)) - -(defun tpu-previous-line (num) - "Move to previous line. -Prefix argument serves as a repeat count." - (interactive "p") - (next-line-internal (- num)) - (setq this-command 'previous-line)) - -(defun tpu-next-beginning-of-line (num) - "Move to beginning of line; if at beginning, move to beginning of next line. -Accepts a prefix argument for the number of lines to move." - (interactive "p") - (backward-char 1) - (forward-line (- 1 num))) - -(defun tpu-end-of-line (num) - "Move to the next end of line in the current direction. -A repeat count means move that many lines." - (interactive "p") - (if tpu-advance (tpu-next-end-of-line num) (tpu-previous-end-of-line num))) - -(defun tpu-next-end-of-line (num) - "Move to end of line; if at end, move to end of next line. -Accepts a prefix argument for the number of lines to move." - (interactive "p") - (forward-char 1) - (end-of-line num)) - -(defun tpu-previous-end-of-line (num) - "Move EOL upward. -Accepts a prefix argument for the number of lines to move." - (interactive "p") - (end-of-line (- 1 num))) - -(defun tpu-current-end-of-line nil - "Move point to end of current line." - (interactive) - (let ((beg (point))) - (end-of-line) - (if (= beg (point)) (message "You are already at the end of a line.")))) - -(defun tpu-line (num) - "Move to the beginning of the next line in the current direction. -A repeat count means move that many lines." - (interactive "p") - (if tpu-advance (tpu-forward-line num) (tpu-backward-line num))) - -(defun tpu-forward-line (num) - "Move to beginning of next line. -Prefix argument serves as a repeat count." - (interactive "p") - (forward-line num)) - -(defun tpu-backward-line (num) - "Move to beginning of previous line. -Prefix argument serves as repeat count." - (interactive "p") - (or (bolp) (>= 0 num) (setq num (- num 1))) - (forward-line (- num))) - - -;;; -;;; Movement by paragraph -;;; -(defun tpu-paragraph (num) - "Move to the next paragraph in the current direction. -A repeat count means move that many paragraphs." - (interactive "p") - (if tpu-advance - (tpu-next-paragraph num) (tpu-previous-paragraph num))) - -(defun tpu-next-paragraph (num) - "Move to beginning of the next paragraph. -Accepts a prefix argument for the number of paragraphs." - (interactive "p") - (beginning-of-line) - (while (and (not (eobp)) (> num 0)) - (if (re-search-forward "^[ \t]*$" nil t) - (if (re-search-forward "[^ \t\n]" nil t) - (goto-char (match-beginning 0)) - (goto-char (point-max)))) - (setq num (1- num))) - (beginning-of-line)) - - -(defun tpu-previous-paragraph (num) - "Move to beginning of previous paragraph. -Accepts a prefix argument for the number of paragraphs." - (interactive "p") - (end-of-line) - (while (and (not (bobp)) (> num 0)) - (if (not (and (re-search-backward "^[ \t]*$" nil t) - (re-search-backward "[^ \t\n]" nil t) - (re-search-backward "^[ \t]*$" nil t) - (progn (re-search-forward "[^ \t\n]" nil t) - (goto-char (match-beginning 0))))) - (goto-char (point-min))) - (setq num (1- num))) - (beginning-of-line)) - - -;;; -;;; Movement by page -;;; -(defun tpu-page (num) - "Move to the next page in the current direction. -A repeat count means move that many pages." - (interactive "p") - (if tpu-advance (forward-page num) (backward-page num)) - (if (eobp) (recenter -1))) - - -;;; -;;; Scrolling and movement within the buffer -;;; -(defun tpu-scroll-window (num) - "Scroll the display to the next section in the current direction. -A repeat count means scroll that many sections." - (interactive "p") - (if tpu-advance (tpu-scroll-window-up num) (tpu-scroll-window-down num))) - -(defun tpu-scroll-window-down (num) - "Scroll the display down to the next section. -A repeat count means scroll that many sections." - (interactive "p") - (let* ((beg (tpu-current-line)) - (height (1- (window-height))) - (lines (* num (/ (* height tpu-percent-scroll) 100)))) - (next-line-internal (- lines)) - (if (> lines beg) (recenter 0)))) - -(defun tpu-scroll-window-up (num) - "Scroll the display up to the next section. -A repeat count means scroll that many sections." - (interactive "p") - (let* ((beg (tpu-current-line)) - (height (1- (window-height))) - (lines (* num (/ (* height tpu-percent-scroll) 100)))) - (next-line-internal lines) - (if (>= (+ lines beg) height) (recenter -1)))) - -(defun tpu-pan-right (num) - "Pan right tpu-pan-columns (16 by default). -Accepts a prefix argument for the number of tpu-pan-columns to scroll." - (interactive "p") - (scroll-left (* tpu-pan-columns num))) - -(defun tpu-pan-left (num) - "Pan left tpu-pan-columns (16 by default). -Accepts a prefix argument for the number of tpu-pan-columns to scroll." - (interactive "p") - (scroll-right (* tpu-pan-columns num))) - -(defun tpu-move-to-beginning nil - "Move cursor to the beginning of buffer, but don't set the mark." - (interactive) - (goto-char (point-min))) - -(defun tpu-move-to-end nil - "Move cursor to the end of buffer, but don't set the mark." - (interactive) - (goto-char (point-max)) - (recenter -1)) - -(defun tpu-goto-percent (perc) - "Move point to ARG percentage of the buffer." - (interactive "NGoto-percentage: ") - (if (or (> perc 100) (< perc 0)) - (error "Percentage %d out of range 0 < percent < 100" perc) - (goto-char (/ (* (point-max) perc) 100)))) - -(defun tpu-beginning-of-window nil - "Move cursor to top of window." - (interactive) - (move-to-window-line 0)) - -(defun tpu-end-of-window nil - "Move cursor to bottom of window." - (interactive) - (move-to-window-line -1)) - -(defun tpu-line-to-bottom-of-window nil - "Move the current line to the bottom of the window." - (interactive) - (recenter -1)) - -(defun tpu-line-to-top-of-window nil - "Move the current line to the top of the window." - (interactive) - (recenter 0)) - - -;;; -;;; Direction -;;; -(defun tpu-advance-direction nil - "Set TPU Advance mode so keypad commands move forward." - (interactive) - (setq tpu-direction-string " Advance") - (setq tpu-advance t) - (setq tpu-reverse nil) - (tpu-set-search) - (tpu-update-mode-line)) - -(defun tpu-backup-direction nil - "Set TPU Backup mode so keypad commands move backward." - (interactive) - (setq tpu-direction-string " Reverse") - (setq tpu-advance nil) - (setq tpu-reverse t) - (tpu-set-search) - (tpu-update-mode-line)) - - -;;; -;;; Define keymaps -;;; -(define-key global-map "\e[" CSI-map) ; CSI map -(define-key global-map "\eO" SS3-map) ; SS3 map -(define-key SS3-map "P" GOLD-map) ; GOLD map -(define-key GOLD-map "\e[" GOLD-CSI-map) ; GOLD-CSI map -(define-key GOLD-map "\eO" GOLD-SS3-map) ; GOLD-SS3 map - - -;;; -;;; CSI-map key definitions -;;; -(define-key CSI-map "A" 'tpu-previous-line) ; up -(define-key CSI-map "B" 'tpu-next-line) ; down -(define-key CSI-map "D" 'tpu-backward-char) ; left -(define-key CSI-map "C" 'tpu-forward-char) ; right - -(define-key CSI-map "1~" 'tpu-search) ; Find -(define-key CSI-map "2~" 'tpu-paste) ; Insert Here -(define-key CSI-map "3~" 'tpu-cut) ; Remove -(define-key CSI-map "4~" 'tpu-select) ; Select -(define-key CSI-map "5~" 'tpu-scroll-window-down) ; Prev Screen -(define-key CSI-map "6~" 'tpu-scroll-window-up) ; Next Screen - -(define-key CSI-map "11~" 'nil) ; F1 -(define-key CSI-map "12~" 'nil) ; F2 -(define-key CSI-map "13~" 'nil) ; F3 -(define-key CSI-map "14~" 'nil) ; F4 -(define-key CSI-map "15~" 'nil) ; F5 -(define-key CSI-map "17~" 'nil) ; F6 -(define-key CSI-map "18~" 'nil) ; F7 -(define-key CSI-map "19~" 'nil) ; F8 -(define-key CSI-map "20~" 'nil) ; F9 -(define-key CSI-map "21~" 'tpu-exit) ; F10 -(define-key CSI-map "23~" 'tpu-insert-escape) ; F11 (ESC) -(define-key CSI-map "24~" 'tpu-next-beginning-of-line) ; F12 (BS) -(define-key CSI-map "25~" 'tpu-delete-previous-word) ; F13 (LF) -(define-key CSI-map "26~" 'tpu-toggle-overwrite-mode) ; F14 -(define-key CSI-map "28~" 'tpu-help) ; HELP -(define-key CSI-map "29~" 'execute-extended-command) ; DO -(define-key CSI-map "31~" 'tpu-goto-breadcrumb) ; F17 -(define-key CSI-map "32~" 'nil) ; F18 -(define-key CSI-map "33~" 'nil) ; F19 -(define-key CSI-map "34~" 'nil) ; F20 - - -;;; -;;; SS3-map key definitions -;;; -(define-key SS3-map "A" 'tpu-previous-line) ; up -(define-key SS3-map "B" 'tpu-next-line) ; down -(define-key SS3-map "C" 'tpu-forward-char) ; right -(define-key SS3-map "D" 'tpu-backward-char) ; left - -(define-key SS3-map "Q" 'tpu-help) ; PF2 -(define-key SS3-map "R" 'tpu-search-again) ; PF3 -(define-key SS3-map "S" 'tpu-delete-current-line) ; PF4 -(define-key SS3-map "p" 'tpu-line) ; KP0 -(define-key SS3-map "q" 'tpu-word) ; KP1 -(define-key SS3-map "r" 'tpu-end-of-line) ; KP2 -(define-key SS3-map "s" 'tpu-char) ; KP3 -(define-key SS3-map "t" 'tpu-advance-direction) ; KP4 -(define-key SS3-map "u" 'tpu-backup-direction) ; KP5 -(define-key SS3-map "v" 'tpu-cut) ; KP6 -(define-key SS3-map "w" 'tpu-page) ; KP7 -(define-key SS3-map "x" 'tpu-scroll-window) ; KP8 -(define-key SS3-map "y" 'tpu-append-region) ; KP9 -(define-key SS3-map "m" 'tpu-delete-current-word) ; KP- -(define-key SS3-map "l" 'tpu-delete-current-char) ; KP, -(define-key SS3-map "n" 'tpu-select) ; KP. -(define-key SS3-map "M" 'newline) ; KPenter - - -;;; -;;; GOLD-map key definitions -;;; -(define-key GOLD-map "\C-A" 'tpu-toggle-overwrite-mode) ; ^A -(define-key GOLD-map "\C-B" 'nil) ; ^B -(define-key GOLD-map "\C-C" 'nil) ; ^C -(define-key GOLD-map "\C-D" 'nil) ; ^D -(define-key GOLD-map "\C-E" 'nil) ; ^E -(define-key GOLD-map "\C-F" 'set-visited-file-name) ; ^F -(define-key GOLD-map "\C-g" 'keyboard-quit) ; safety first -(define-key GOLD-map "\C-h" 'delete-other-windows) ; BS -(define-key GOLD-map "\C-i" 'other-window) ; TAB -(define-key GOLD-map "\C-J" 'nil) ; ^J -(define-key GOLD-map "\C-K" 'tpu-define-macro-key) ; ^K -(define-key GOLD-map "\C-l" 'downcase-region) ; ^L -(define-key GOLD-map "\C-M" 'nil) ; ^M -(define-key GOLD-map "\C-N" 'nil) ; ^N -(define-key GOLD-map "\C-O" 'nil) ; ^O -(define-key GOLD-map "\C-P" 'nil) ; ^P -(define-key GOLD-map "\C-Q" 'nil) ; ^Q -(define-key GOLD-map "\C-R" 'nil) ; ^R -(define-key GOLD-map "\C-S" 'nil) ; ^S -(define-key GOLD-map "\C-T" 'tpu-toggle-control-keys) ; ^T -(define-key GOLD-map "\C-u" 'upcase-region) ; ^U -(define-key GOLD-map "\C-V" 'nil) ; ^V -(define-key GOLD-map "\C-w" 'tpu-write-current-buffers) ; ^W -(define-key GOLD-map "\C-X" 'nil) ; ^X -(define-key GOLD-map "\C-Y" 'nil) ; ^Y -(define-key GOLD-map "\C-Z" 'nil) ; ^Z -(define-key GOLD-map " " 'undo) ; SPC -(define-key GOLD-map "!" 'nil) ; ! -(define-key GOLD-map "#" 'nil) ; # -(define-key GOLD-map "$" 'tpu-add-at-eol) ; $ -(define-key GOLD-map "%" 'tpu-goto-percent) ; % -(define-key GOLD-map "&" 'nil) ; & -(define-key GOLD-map "(" 'nil) ; ( -(define-key GOLD-map ")" 'nil) ; ) -(define-key GOLD-map "*" 'tpu-toggle-regexp) ; * -(define-key GOLD-map "+" 'nil) ; + -(define-key GOLD-map "," 'tpu-goto-breadcrumb) ; , -(define-key GOLD-map "-" 'negative-argument) ; - -(define-key GOLD-map "." 'tpu-drop-breadcrumb) ; . -(define-key GOLD-map "/" 'tpu-emacs-replace) ; / -(define-key GOLD-map "0" 'digit-argument) ; 0 -(define-key GOLD-map "1" 'digit-argument) ; 1 -(define-key GOLD-map "2" 'digit-argument) ; 2 -(define-key GOLD-map "3" 'digit-argument) ; 3 -(define-key GOLD-map "4" 'digit-argument) ; 4 -(define-key GOLD-map "5" 'digit-argument) ; 5 -(define-key GOLD-map "6" 'digit-argument) ; 6 -(define-key GOLD-map "7" 'digit-argument) ; 7 -(define-key GOLD-map "8" 'digit-argument) ; 8 -(define-key GOLD-map "9" 'digit-argument) ; 9 -(define-key GOLD-map ":" 'nil) ; : -(define-key GOLD-map ";" 'tpu-trim-line-ends) ; ; -(define-key GOLD-map "<" 'nil) ; < -(define-key GOLD-map "=" 'nil) ; = -(define-key GOLD-map ">" 'nil) ; > -(define-key GOLD-map "?" 'tpu-spell-check) ; ? -(define-key GOLD-map "A" 'tpu-toggle-newline-and-indent) ; A -(define-key GOLD-map "B" 'tpu-next-buffer) ; B -(define-key GOLD-map "C" 'repeat-complex-command) ; C -(define-key GOLD-map "D" 'shell-command) ; D -(define-key GOLD-map "E" 'tpu-exit) ; E -(define-key GOLD-map "F" 'tpu-set-cursor-free) ; F -(define-key GOLD-map "G" 'tpu-get) ; G -(define-key GOLD-map "H" 'nil) ; H -(define-key GOLD-map "I" 'tpu-include) ; I -(define-key GOLD-map "K" 'tpu-kill-buffer) ; K -(define-key GOLD-map "L" 'tpu-what-line) ; L -(define-key GOLD-map "M" 'buffer-menu) ; M -(define-key GOLD-map "N" 'tpu-next-file-buffer) ; N -(define-key GOLD-map "O" 'occur) ; O -(define-key GOLD-map "P" 'lpr-buffer) ; P -(define-key GOLD-map "Q" 'tpu-quit) ; Q -(define-key GOLD-map "R" 'tpu-toggle-rectangle) ; R -(define-key GOLD-map "S" 'replace) ; S -(define-key GOLD-map "T" 'tpu-line-to-top-of-window) ; T -(define-key GOLD-map "U" 'undo) ; U -(define-key GOLD-map "V" 'tpu-version) ; V -(define-key GOLD-map "W" 'save-buffer) ; W -(define-key GOLD-map "X" 'tpu-save-all-buffers-kill-emacs) ; X -(define-key GOLD-map "Y" 'copy-region-as-kill) ; Y -(define-key GOLD-map "Z" 'suspend-emacs) ; Z -(define-key GOLD-map "[" 'blink-matching-open) ; [ -(define-key GOLD-map "\\" 'nil) ; \ -(define-key GOLD-map "]" 'blink-matching-open) ; ] -(define-key GOLD-map "^" 'tpu-add-at-bol) ; ^ -(define-key GOLD-map "_" 'split-window-vertically) ; - -(define-key GOLD-map "`" 'what-line) ; ` -(define-key GOLD-map "a" 'tpu-toggle-newline-and-indent) ; a -(define-key GOLD-map "b" 'tpu-next-buffer) ; b -(define-key GOLD-map "c" 'repeat-complex-command) ; c -(define-key GOLD-map "d" 'shell-command) ; d -(define-key GOLD-map "e" 'tpu-exit) ; e -(define-key GOLD-map "f" 'tpu-set-cursor-free) ; f -(define-key GOLD-map "g" 'tpu-get) ; g -(define-key GOLD-map "h" 'nil) ; h -(define-key GOLD-map "i" 'tpu-include) ; i -(define-key GOLD-map "k" 'tpu-kill-buffer) ; k -(define-key GOLD-map "l" 'goto-line) ; l -(define-key GOLD-map "m" 'buffer-menu) ; m -(define-key GOLD-map "n" 'tpu-next-file-buffer) ; n -(define-key GOLD-map "o" 'occur) ; o -(define-key GOLD-map "p" 'lpr-region) ; p -(define-key GOLD-map "q" 'tpu-quit) ; q -(define-key GOLD-map "r" 'tpu-toggle-rectangle) ; r -(define-key GOLD-map "s" 'replace) ; s -(define-key GOLD-map "t" 'tpu-line-to-top-of-window) ; t -(define-key GOLD-map "u" 'undo) ; u -(define-key GOLD-map "v" 'tpu-version) ; v -(define-key GOLD-map "w" 'save-buffer) ; w -(define-key GOLD-map "x" 'tpu-save-all-buffers-kill-emacs) ; x -(define-key GOLD-map "y" 'copy-region-as-kill) ; y -(define-key GOLD-map "z" 'suspend-emacs) ; z -(define-key GOLD-map "{" 'nil) ; { -(define-key GOLD-map "|" 'split-window-horizontally) ; | -(define-key GOLD-map "}" 'nil) ; } -(define-key GOLD-map "~" 'exchange-point-and-mark) ; ~ -(define-key GOLD-map "\177" 'delete-window) ; <X] - - -;;; -;;; GOLD-CSI-map key definitions -;;; -(define-key GOLD-CSI-map "A" 'tpu-move-to-beginning) ; up-arrow -(define-key GOLD-CSI-map "B" 'tpu-move-to-end) ; down-arrow -(define-key GOLD-CSI-map "C" 'end-of-line) ; right-arrow -(define-key GOLD-CSI-map "D" 'beginning-of-line) ; left-arrow - -(define-key GOLD-CSI-map "1~" 'nil) ; Find -(define-key GOLD-CSI-map "2~" 'nil) ; Insert Here -(define-key GOLD-CSI-map "3~" 'tpu-store-text) ; Remove -(define-key GOLD-CSI-map "4~" 'tpu-unselect) ; Select -(define-key GOLD-CSI-map "5~" 'tpu-previous-window) ; Prev Screen -(define-key GOLD-CSI-map "6~" 'tpu-next-window) ; Next Screen - -(define-key GOLD-CSI-map "11~" 'nil) ; F1 -(define-key GOLD-CSI-map "12~" 'nil) ; F2 -(define-key GOLD-CSI-map "13~" 'nil) ; F3 -(define-key GOLD-CSI-map "14~" 'nil) ; F4 -(define-key GOLD-CSI-map "16~" 'nil) ; F5 -(define-key GOLD-CSI-map "17~" 'nil) ; F6 -(define-key GOLD-CSI-map "18~" 'nil) ; F7 -(define-key GOLD-CSI-map "19~" 'nil) ; F8 -(define-key GOLD-CSI-map "20~" 'nil) ; F9 -(define-key GOLD-CSI-map "21~" 'nil) ; F10 -(define-key GOLD-CSI-map "23~" 'nil) ; F11 -(define-key GOLD-CSI-map "24~" 'nil) ; F12 -(define-key GOLD-CSI-map "25~" 'nil) ; F13 -(define-key GOLD-CSI-map "26~" 'nil) ; F14 -(define-key GOLD-CSI-map "28~" 'describe-bindings) ; HELP -(define-key GOLD-CSI-map "29~" 'nil) ; DO -(define-key GOLD-CSI-map "31~" 'tpu-drop-breadcrumb) ; F17 -(define-key GOLD-CSI-map "32~" 'nil) ; F18 -(define-key GOLD-CSI-map "33~" 'nil) ; F19 -(define-key GOLD-CSI-map "34~" 'nil) ; F20 - - -;;; -;;; GOLD-SS3-map key definitions -;;; -(define-key GOLD-SS3-map "A" 'tpu-move-to-beginning) ; up-arrow -(define-key GOLD-SS3-map "B" 'tpu-move-to-end) ; down-arrow -(define-key GOLD-SS3-map "C" 'end-of-line) ; right-arrow -(define-key GOLD-SS3-map "D" 'beginning-of-line) ; left-arrow - -(define-key GOLD-SS3-map "P" 'keyboard-quit) ; PF1 -(define-key GOLD-SS3-map "Q" 'help-for-help) ; PF2 -(define-key GOLD-SS3-map "R" 'tpu-search) ; PF3 -(define-key GOLD-SS3-map "S" 'tpu-undelete-lines) ; PF4 -(define-key GOLD-SS3-map "p" 'open-line) ; KP0 -(define-key GOLD-SS3-map "q" 'tpu-change-case) ; KP1 -(define-key GOLD-SS3-map "r" 'tpu-delete-to-eol) ; KP2 -(define-key GOLD-SS3-map "s" 'tpu-special-insert) ; KP3 -(define-key GOLD-SS3-map "t" 'tpu-move-to-end) ; KP4 -(define-key GOLD-SS3-map "u" 'tpu-move-to-beginning) ; KP5 -(define-key GOLD-SS3-map "v" 'tpu-paste) ; KP6 -(define-key GOLD-SS3-map "w" 'execute-extended-command) ; KP7 -(define-key GOLD-SS3-map "x" 'tpu-fill) ; KP8 -(define-key GOLD-SS3-map "y" 'tpu-replace) ; KP9 -(define-key GOLD-SS3-map "m" 'tpu-undelete-words) ; KP- -(define-key GOLD-SS3-map "l" 'tpu-undelete-char) ; KP, -(define-key GOLD-SS3-map "n" 'tpu-unselect) ; KP. -(define-key GOLD-SS3-map "M" 'tpu-substitute) ; KPenter - - -;;; -;;; Repeat complex command map additions to make arrows work -;;; -(cond ((boundp 'repeat-complex-command-map) - (define-key repeat-complex-command-map "\e[A" 'previous-complex-command) - (define-key repeat-complex-command-map "\e[B" 'next-complex-command) - (define-key repeat-complex-command-map "\eOA" 'previous-complex-command) - (define-key repeat-complex-command-map "\eOB" 'next-complex-command))) - - -;;; -;;; Minibuffer map additions to make KP_enter = RET -;;; -(define-key minibuffer-local-map "\eOM" 'exit-minibuffer) -(define-key minibuffer-local-ns-map "\eOM" 'exit-minibuffer) -(define-key minibuffer-local-completion-map "\eOM" 'exit-minibuffer) -(define-key minibuffer-local-must-match-map "\eOM" 'minibuffer-complete-and-exit) -(and (boundp 'repeat-complex-command-map) - (define-key repeat-complex-command-map "\eOM" 'exit-minibuffer)) - - -;;; -;;; Minibuffer map additions to set search direction -;;; -(define-key minibuffer-local-map "\eOt" 'tpu-search-forward-exit) -(define-key minibuffer-local-map "\eOu" 'tpu-search-backward-exit) - - -;;; -;;; Functions to set, reset, and toggle the control key bindings -;;; -(defun tpu-set-control-keys nil - "Set control keys to TPU style functions." - (define-key global-map "\C-\\" 'quoted-insert) ; ^\ - (define-key global-map "\C-a" 'tpu-toggle-overwrite-mode) ; ^A - (define-key global-map "\C-b" 'repeat-complex-command) ; ^B - (define-key global-map "\C-e" 'tpu-current-end-of-line) ; ^E - (define-key global-map "\C-h" 'tpu-next-beginning-of-line) ; ^H (BS) - (define-key global-map "\C-j" 'tpu-delete-previous-word) ; ^J (LF) - (define-key global-map "\C-k" 'tpu-define-macro-key) ; ^K - (define-key global-map "\C-l" 'tpu-insert-formfeed) ; ^L (FF) - (define-key global-map "\C-r" 'recenter) ; ^R - (define-key global-map "\C-u" 'tpu-delete-to-bol) ; ^U - (define-key global-map "\C-v" 'tpu-quoted-insert) ; ^V - (define-key global-map "\C-w" 'redraw-display) ; ^W - (define-key global-map "\C-z" 'tpu-exit) ; ^Z - (setq tpu-control-keys t)) - -(defun tpu-reset-control-keys (tpu-style) - "Set control keys to TPU or emacs style functions." - (let* ((tpu (and tpu-style (not tpu-control-keys))) - (emacs (and (not tpu-style) tpu-control-keys)) - (doit (or tpu emacs))) - (cond (doit - (if emacs (setq tpu-global-map (copy-keymap global-map))) - (let ((map (if tpu - (copy-keymap tpu-global-map) - (copy-keymap tpu-original-global-map)))) - - (define-key global-map "\C-\\" (lookup-key map "\C-\\")) ; ^\ - (define-key global-map "\C-a" (lookup-key map "\C-a")) ; ^A - (define-key global-map "\C-b" (lookup-key map "\C-b")) ; ^B - (define-key global-map "\C-e" (lookup-key map "\C-e")) ; ^E - (define-key global-map "\C-h" (lookup-key map "\C-h")) ; ^H (BS) - (define-key global-map "\C-j" (lookup-key map "\C-j")) ; ^J (LF) - (define-key global-map "\C-k" (lookup-key map "\C-k")) ; ^K - (define-key global-map "\C-l" (lookup-key map "\C-l")) ; ^L (FF) - (define-key global-map "\C-r" (lookup-key map "\C-r")) ; ^R - (define-key global-map "\C-u" (lookup-key map "\C-u")) ; ^U - (define-key global-map "\C-v" (lookup-key map "\C-v")) ; ^V - (define-key global-map "\C-w" (lookup-key map "\C-w")) ; ^W - (define-key global-map "\C-z" (lookup-key map "\C-z")) ; ^Z - (setq tpu-control-keys tpu-style)))))) - -(defun tpu-toggle-control-keys nil - "Toggles control key bindings between TPU-edt and Emacs." - (interactive) - (tpu-reset-control-keys (not tpu-control-keys)) - (and (interactive-p) - (message "Control keys function with %s bindings." - (if tpu-control-keys "TPU-edt" "Emacs")))) - - -;;; -;;; Emacs version 19 minibuffer history support -;;; -(defun tpu-next-history-element (n) - "Insert the next element of the minibuffer history into the minibuffer." - (interactive "p") - (next-history-element n) - (goto-char (point-max))) - -(defun tpu-previous-history-element (n) - "Insert the previous element of the minibuffer history into the minibuffer." - (interactive "p") - (previous-history-element n) - (goto-char (point-max))) - -(defun tpu-arrow-history nil - "Modify minibuffer maps to use arrows for history recall." - (interactive) - (let ((loc (where-is-internal 'tpu-previous-line)) (cur nil)) - (while (setq cur (car loc)) - (define-key read-expression-map cur 'tpu-previous-history-element) - (define-key minibuffer-local-map cur 'tpu-previous-history-element) - (define-key minibuffer-local-ns-map cur 'tpu-previous-history-element) - (define-key minibuffer-local-completion-map cur 'tpu-previous-history-element) - (define-key minibuffer-local-must-match-map cur 'tpu-previous-history-element) - (setq loc (cdr loc))) - - (setq loc (where-is-internal 'tpu-next-line)) - (while (setq cur (car loc)) - (define-key read-expression-map cur 'tpu-next-history-element) - (define-key minibuffer-local-map cur 'tpu-next-history-element) - (define-key minibuffer-local-ns-map cur 'tpu-next-history-element) - (define-key minibuffer-local-completion-map cur 'tpu-next-history-element) - (define-key minibuffer-local-must-match-map cur 'tpu-next-history-element) - (setq loc (cdr loc))))) - - -;;; -;;; Emacs version 19 X-windows key definition support -;;; -(defun tpu-load-xkeys (file) - "Load the TPU-edt X-windows key definitions FILE. -If FILE is nil, try to load a default file. The default file names are -`~/.tpu-lucid-keys' for Lucid emacs, and `~/.tpu-keys' for Emacs." - (interactive "fX key definition file: ") - (cond (file - (setq file (expand-file-name file))) - (tpu-xkeys-file - (setq file (expand-file-name tpu-xkeys-file))) - (tpu-lucid-emacs19-p - (setq file (convert-standard-filename - (expand-file-name "~/.tpu-lucid-keys")))) - (tpu-emacs19-p - (setq file (convert-standard-filename - (expand-file-name "~/.tpu-keys"))) - (and (not (file-exists-p file)) - (file-exists-p - (convert-standard-filename - (expand-file-name "~/.tpu-gnu-keys"))) - (tpu-copy-keyfile - (convert-standard-filename - (expand-file-name "~/.tpu-gnu-keys")) file)))) - (cond ((file-readable-p file) - (load-file file)) - (t - (switch-to-buffer "*scratch*") - (erase-buffer) - (insert " - - Ack!! You're running TPU-edt under X-windows without loading an - X key definition file. To create a TPU-edt X key definition - file, run the tpu-mapper.el program. It came with TPU-edt. It - even includes directions on how to use it! Perhaps it's lying - around here someplace. ") - (let ((file "tpu-mapper.el") - (found nil) - (path nil) - (search-list (append (list (expand-file-name ".")) load-path))) - (while (and (not found) search-list) - (setq path (concat (car search-list) - (if (string-match "/$" (car search-list)) "" "/") - file)) - (if (and (file-exists-p path) (not (file-directory-p path))) - (setq found t)) - (setq search-list (cdr search-list))) - (cond (found - (insert (format - "Ah yes, there it is, in \n\n %s \n\n" path)) - (if (tpu-y-or-n-p "Do you want to run it now? ") - (load-file path))) - (t - (insert "Nope, I can't seem to find it. :-(\n\n") - (sit-for 120))))))) - -(defun tpu-copy-keyfile (oldname newname) - "Copy the TPU-edt X key definitions file to the new default name." - (interactive "fOld name: \nFNew name: ") - (if (not (get-buffer "*TPU-Notice*")) (generate-new-buffer "*TPU-Notice*")) - (set-buffer "*TPU-Notice*") - (erase-buffer) - (insert " - NOTICE -- - - The default name of the TPU-edt key definition file has changed - from `~/.tpu-gnu-keys' to `~/.tpu-keys'. With your permission, - your key definitions will be copied to the new file. If you'll - never use older versions of Emacs, you can remove the old file. - If the copy fails, you'll be asked if you want to create a new - key definitions file. Do you want to copy your key definition - file now? - ") - (save-window-excursion - (switch-to-buffer-other-window "*TPU-Notice*") - (shrink-window-if-larger-than-buffer) - (goto-char (point-min)) - (beep) - (and (tpu-y-or-n-p "Copy key definitions to the new file now? ") - (condition-case conditions - (copy-file oldname newname) - (error (message "Sorry, couldn't copy - %s" (cdr conditions))))) - (kill-buffer "*TPU-Notice*"))) - - -;;; -;;; Start and Stop TPU-edt -;;; -;;;###autoload -(defun tpu-edt-on nil - "Turn on TPU/edt emulation." - (interactive) - (cond - ((not tpu-edt-mode) - ;; we use picture-mode functions - (require 'picture) - (tpu-set-control-keys) - (cond (tpu-emacs19-p - (and window-system (tpu-load-xkeys nil)) - (tpu-arrow-history)) - (t - ;; define ispell functions - (autoload 'ispell-word "ispell" "Check spelling of word at or before point" t) - (autoload 'ispell-complete-word "ispell" "Complete word at or before point" t) - (autoload 'ispell-buffer "ispell" "Check spelling of entire buffer" t) - (autoload 'ispell-region "ispell" "Check spelling of region" t))) - (tpu-set-mode-line t) - (tpu-advance-direction) - ;; set page delimiter, display line truncation, and scrolling like TPU - (setq-default page-delimiter "\f") - (setq-default truncate-lines t) - (setq scroll-step 1) - (setq tpu-edt-mode t)))) - -(defun tpu-edt-off nil - "Turn off TPU/edt emulation. Note that the keypad is left on." - (interactive) - (cond - (tpu-edt-mode - (tpu-reset-control-keys nil) - (tpu-set-mode-line nil) - (setq-default page-delimiter "^\f") - (setq-default truncate-lines nil) - (setq scroll-step 0) - (setq global-map (copy-keymap tpu-original-global-map)) - (use-global-map global-map) - (setq tpu-edt-mode nil)))) - -(provide 'tpu-edt) - -;;; tpu-edt.el ends here diff --git a/lisp/emulation/tpu-extras.el b/lisp/emulation/tpu-extras.el deleted file mode 100644 index dbaf20ce3aa..00000000000 --- a/lisp/emulation/tpu-extras.el +++ /dev/null @@ -1,477 +0,0 @@ -;;; tpu-extras.el --- Scroll margins and free cursor mode for TPU-edt - -;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. - -;; Author: Rob Riepel <riepel@networking.stanford.edu> -;; Maintainer: Rob Riepel <riepel@networking.stanford.edu> -;; Keywords: emulations - -;; This file is part of GNU Emacs. - -;; 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 -;; the Free Software Foundation; either version 2, 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 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; Use the functions defined here to customize TPU-edt to your tastes by -;; setting scroll margins and/or turning on free cursor mode. Here's an -;; example for your .emacs file. - -;; (tpu-set-cursor-free) ; Set cursor free. -;; (tpu-set-scroll-margins "10%" "15%") ; Set scroll margins. - -;; Scroll margins and cursor binding can be changed from within emacs using -;; the following commands: - -;; tpu-set-scroll-margins or set scroll margins -;; tpu-set-cursor-bound or set cursor bound -;; tpu-set-cursor-free or set cursor free - -;; Additionally, Gold-F toggles between bound and free cursor modes. - -;; Note that switching out of free cursor mode or exiting TPU-edt while in -;; free cursor mode strips trailing whitespace from every line in the file. - - -;;; Details: - -;; The functions contained in this file implement scroll margins and free -;; cursor mode. The following keys and commands are affected. - -;; key/command function scroll cursor - -;; Up-Arrow previous line x x -;; Down-Arrow next line x x -;; Right-Arrow next character x -;; Left-Arrow previous character x -;; KP0 next or previous line x -;; KP7 next or previous page x -;; KP8 next or previous screen x -;; KP2 next or previous end-of-line x x -;; Control-e current end-of-line x -;; Control-h previous beginning-of-line x -;; Next Scr next screen x -;; Prev Scr previous screen x -;; Search find a string x -;; Replace find and replace a string x -;; Newline insert a newline x -;; Paragraph next or previous paragraph x -;; Auto-Fill break lines on spaces x - -;; These functions are not part of the base TPU-edt for the following -;; reasons: - -;; Free cursor mode is implemented with the emacs picture-mode functions. -;; These functions support moving the cursor all over the screen, however, -;; when the cursor is moved past the end of a line, spaces or tabs are -;; appended to the line - even if no text is entered in that area. In -;; order for a free cursor mode to work exactly like TPU/edt, this trailing -;; whitespace needs to be dealt with in every function that might encounter -;; it. Such global changes are impractical, however, free cursor mode is -;; too valuable to abandon completely, so it has been implemented in those -;; functions where it serves best. - -;; The implementation of scroll margins adds overhead to previously -;; simple and often used commands. These commands are now responsible -;; for their normal operation and part of the display function. There -;; is a possibility that this display overhead could adversely affect the -;; performance of TPU-edt on slower computers. In order to support the -;; widest range of computers, scroll margin support is optional. - -;; It's actually not known whether the overhead associated with scroll -;; margin support is significant. If you find that it is, please send -;; a note describing the extent of the performance degradation. Be sure -;; to include a description of the platform where you're running TPU-edt. -;; Send your note to the address provided by Gold-V. - -;; Even with these differences and limitations, these functions implement -;; important aspects of the real TPU/edt. Those who miss free cursor mode -;; and/or scroll margins will appreciate these implementations. - -;;; Code: - - -;;; Gotta have tpu-edt - -(require 'tpu-edt) - - -;;; Customization variables - -(defconst tpu-top-scroll-margin 0 - "*Scroll margin at the top of the screen. -Interpreted as a percent of the current window size.") -(defconst tpu-bottom-scroll-margin 0 - "*Scroll margin at the bottom of the screen. -Interpreted as a percent of the current window size.") - -(defvar tpu-backward-char-like-tpu t - "*If non-nil, in free cursor mode backward-char (left-arrow) works -just like TPU/edt. Otherwise, backward-char will move to the end of -the previous line when starting from a line beginning.") - - -;;; Global variables - -(defvar tpu-cursor-free nil - "If non-nil, let the cursor roam free.") - - -;;; Hooks -- Set cursor free in picture mode. -;;; Clean up when writing a file from cursor free mode. - -(add-hook 'picture-mode-hook 'tpu-set-cursor-free) - -(defun tpu-write-file-hook nil - "Eliminate whitespace at ends of lines, if the cursor is free." - (if (and (buffer-modified-p) tpu-cursor-free) (picture-clean))) - -(or (memq 'tpu-write-file-hook write-file-hooks) - (setq write-file-hooks - (cons 'tpu-write-file-hook write-file-hooks))) - - -;;; Utility routines for implementing scroll margins - -(defun tpu-top-check (beg lines) - "Enforce scroll margin at the top of screen." - (let ((margin (/ (* (window-height) tpu-top-scroll-margin) 100))) - (cond ((< beg margin) (recenter beg)) - ((< (- beg lines) margin) (recenter margin))))) - -(defun tpu-bottom-check (beg lines) - "Enforce scroll margin at the bottom of screen." - (let* ((height (window-height)) - (margin (+ 1 (/ (* height tpu-bottom-scroll-margin) 100))) - ;; subtract 1 from height because it includes mode line - (difference (- height margin 1))) - (cond ((> beg difference) (recenter beg)) - ((> (+ beg lines) difference) (recenter (- margin)))))) - - -;;; Movement by character - -(defun tpu-forward-char (num) - "Move right ARG characters (left if ARG is negative)." - (interactive "p") - (if tpu-cursor-free (picture-forward-column num) (forward-char num))) - -(defun tpu-backward-char (num) - "Move left ARG characters (right if ARG is negative)." - (interactive "p") - (cond ((not tpu-cursor-free) - (backward-char num)) - (tpu-backward-char-like-tpu - (picture-backward-column num)) - ((bolp) - (backward-char 1) - (picture-end-of-line) - (picture-backward-column (1- num))) - (t - (picture-backward-column num)))) - - -;;; Movement by line - -(defun tpu-next-line (num) - "Move to next line. -Prefix argument serves as a repeat count." - (interactive "p") - (let ((beg (tpu-current-line))) - (if tpu-cursor-free (or (eobp) (picture-move-down num)) - (next-line-internal num)) - (tpu-bottom-check beg num) - (setq this-command 'next-line))) - -(defun tpu-previous-line (num) - "Move to previous line. -Prefix argument serves as a repeat count." - (interactive "p") - (let ((beg (tpu-current-line))) - (if tpu-cursor-free (picture-move-up num) (next-line-internal (- num))) - (tpu-top-check beg num) - (setq this-command 'previous-line))) - -(defun tpu-next-beginning-of-line (num) - "Move to beginning of line; if at beginning, move to beginning of next line. -Accepts a prefix argument for the number of lines to move." - (interactive "p") - (let ((beg (tpu-current-line))) - (backward-char 1) - (forward-line (- 1 num)) - (tpu-top-check beg num))) - -(defun tpu-next-end-of-line (num) - "Move to end of line; if at end, move to end of next line. -Accepts a prefix argument for the number of lines to move." - (interactive "p") - (let ((beg (tpu-current-line))) - (cond (tpu-cursor-free - (let ((beg (point))) - (if (< 1 num) (forward-line num)) - (picture-end-of-line) - (if (<= (point) beg) (progn (forward-line) (picture-end-of-line))))) - (t - (forward-char) - (end-of-line num))) - (tpu-bottom-check beg num))) - -(defun tpu-previous-end-of-line (num) - "Move EOL upward. -Accepts a prefix argument for the number of lines to move." - (interactive "p") - (let ((beg (tpu-current-line))) - (cond (tpu-cursor-free - (picture-end-of-line (- 1 num))) - (t - (end-of-line (- 1 num)))) - (tpu-top-check beg num))) - -(defun tpu-current-end-of-line nil - "Move point to end of current line." - (interactive) - (let ((beg (point))) - (if tpu-cursor-free (picture-end-of-line) (end-of-line)) - (if (= beg (point)) (message "You are already at the end of a line.")))) - -(defun tpu-forward-line (num) - "Move to beginning of next line. -Prefix argument serves as a repeat count." - (interactive "p") - (let ((beg (tpu-current-line))) - (next-line-internal num) - (tpu-bottom-check beg num) - (beginning-of-line))) - -(defun tpu-backward-line (num) - "Move to beginning of previous line. -Prefix argument serves as repeat count." - (interactive "p") - (let ((beg (tpu-current-line))) - (or (bolp) (>= 0 num) (setq num (- num 1))) - (next-line-internal (- num)) - (tpu-top-check beg num) - (beginning-of-line))) - - -;;; Movement by paragraph - -(defun tpu-paragraph (num) - "Move to the next paragraph in the current direction. -A repeat count means move that many paragraphs." - (interactive "p") - (let* ((left nil) - (beg (tpu-current-line)) - (height (window-height)) - (top-percent - (if (= 0 tpu-top-scroll-margin) 10 tpu-top-scroll-margin)) - (bottom-percent - (if (= 0 tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin)) - (top-margin (/ (* height top-percent) 100)) - (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100))) - (bottom-margin (max beg (- height bottom-up-margin 1))) - (top (save-excursion (move-to-window-line top-margin) (point))) - (bottom (save-excursion (move-to-window-line bottom-margin) (point))) - (far (save-excursion - (goto-char bottom) (forward-line (- height 2)) (point)))) - (cond (tpu-advance - (tpu-next-paragraph num) - (cond((> (point) far) - (setq left (save-excursion (forward-line height))) - (if (= 0 left) (recenter top-margin) - (recenter (- left bottom-up-margin)))) - (t - (and (> (point) bottom) (recenter bottom-margin))))) - (t - (tpu-previous-paragraph num) - (and (< (point) top) (recenter (min beg top-margin))))))) - - -;;; Movement by page - -(defun tpu-page (num) - "Move to the next page in the current direction. -A repeat count means move that many pages." - (interactive "p") - (let* ((left nil) - (beg (tpu-current-line)) - (height (window-height)) - (top-percent - (if (= 0 tpu-top-scroll-margin) 10 tpu-top-scroll-margin)) - (bottom-percent - (if (= 0 tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin)) - (top-margin (/ (* height top-percent) 100)) - (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100))) - (bottom-margin (max beg (- height bottom-up-margin 1))) - (top (save-excursion (move-to-window-line top-margin) (point))) - (bottom (save-excursion (move-to-window-line bottom-margin) (point))) - (far (save-excursion - (goto-char bottom) (forward-line (- height 2)) (point)))) - (cond (tpu-advance - (forward-page num) - (cond((> (point) far) - (setq left (save-excursion (forward-line height))) - (if (= 0 left) (recenter top-margin) - (recenter (- left bottom-up-margin)))) - (t - (and (> (point) bottom) (recenter bottom-margin))))) - (t - (backward-page num) - (and (< (point) top) (recenter (min beg top-margin))))))) - - -;;; Scrolling - -(defun tpu-scroll-window-down (num) - "Scroll the display down to the next section. -A repeat count means scroll that many sections." - (interactive "p") - (let* ((beg (tpu-current-line)) - (height (1- (window-height))) - (lines (* num (/ (* height tpu-percent-scroll) 100)))) - (next-line-internal (- lines)) - (tpu-top-check beg lines))) - -(defun tpu-scroll-window-up (num) - "Scroll the display up to the next section. -A repeat count means scroll that many sections." - (interactive "p") - (let* ((beg (tpu-current-line)) - (height (1- (window-height))) - (lines (* num (/ (* height tpu-percent-scroll) 100)))) - (next-line-internal lines) - (tpu-bottom-check beg lines))) - - -;;; Replace the TPU-edt internal search function - -(defun tpu-search-internal (pat &optional quiet) - "Search for a string or regular expression." - (let* ((left nil) - (beg (tpu-current-line)) - (height (window-height)) - (top-percent - (if (= 0 tpu-top-scroll-margin) 10 tpu-top-scroll-margin)) - (bottom-percent - (if (= 0 tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin)) - (top-margin (/ (* height top-percent) 100)) - (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100))) - (bottom-margin (max beg (- height bottom-up-margin 1))) - (top (save-excursion (move-to-window-line top-margin) (point))) - (bottom (save-excursion (move-to-window-line bottom-margin) (point))) - (far (save-excursion - (goto-char bottom) (forward-line (- height 2)) (point)))) - (tpu-search-internal-core pat quiet) - (if tpu-searching-forward - (cond((> (point) far) - (setq left (save-excursion (forward-line height))) - (if (= 0 left) (recenter top-margin) - (recenter (- left bottom-up-margin)))) - (t - (and (> (point) bottom) (recenter bottom-margin)))) - (and (< (point) top) (recenter (min beg top-margin)))))) - - - -;;; Replace the newline, newline-and-indent, and do-auto-fill functions - -(or (fboundp 'tpu-old-newline) - (fset 'tpu-old-newline (symbol-function 'newline))) -(or (fboundp 'tpu-old-do-auto-fill) - (fset 'tpu-old-do-auto-fill (symbol-function 'do-auto-fill))) -(or (fboundp 'tpu-old-newline-and-indent) - (fset 'tpu-old-newline-and-indent (symbol-function 'newline-and-indent))) - -(defun newline (&optional num) - "Insert a newline. With arg, insert that many newlines. -In Auto Fill mode, can break the preceding line if no numeric arg. -This is the TPU-edt version that respects the bottom scroll margin." - (interactive "p") - (let ((beg (tpu-current-line))) - (or num (setq num 1)) - (tpu-old-newline num) - (tpu-bottom-check beg num))) - -(defun newline-and-indent nil - "Insert a newline, then indent according to major mode. -Indentation is done using the current indent-line-function. -In programming language modes, this is the same as TAB. -In some text modes, where TAB inserts a tab, this indents -to the specified left-margin column. This is the TPU-edt -version that respects the bottom scroll margin." - (interactive) - (let ((beg (tpu-current-line))) - (tpu-old-newline-and-indent) - (tpu-bottom-check beg 1))) - -(defun do-auto-fill nil - "TPU-edt version that respects the bottom scroll margin." - (let ((beg (tpu-current-line))) - (tpu-old-do-auto-fill) - (tpu-bottom-check beg 1))) - - -;;; Function to set scroll margins - -;;;###autoload -(defun tpu-set-scroll-margins (top bottom) - "Set scroll margins." - (interactive - "sEnter top scroll margin (N lines or N%% or RETURN for current value): \ -\nsEnter bottom scroll margin (N lines or N%% or RETURN for current value): ") - ;; set top scroll margin - (or (string= top "") - (if (string= "%" (substring top -1)) - (setq tpu-top-scroll-margin (string-to-int top)) - (setq tpu-top-scroll-margin - (/ (1- (+ (* (string-to-int top) 100) (window-height))) - (window-height))))) - ;; set bottom scroll margin - (or (string= bottom "") - (if (string= "%" (substring bottom -1)) - (setq tpu-bottom-scroll-margin (string-to-int bottom)) - (setq tpu-bottom-scroll-margin - (/ (1- (+ (* (string-to-int bottom) 100) (window-height))) - (window-height))))) - ;; report scroll margin settings if running interactively - (and (interactive-p) - (message "Scroll margins set. Top = %s%%, Bottom = %s%%" - tpu-top-scroll-margin tpu-bottom-scroll-margin))) - - -;;; Functions to set cursor bound or free - -;;;###autoload -(defun tpu-set-cursor-free nil - "Allow the cursor to move freely about the screen." - (interactive) - (setq tpu-cursor-free t) - (substitute-key-definition 'tpu-set-cursor-free - 'tpu-set-cursor-bound - GOLD-map) - (message "The cursor will now move freely about the screen.")) - -;;;###autoload -(defun tpu-set-cursor-bound nil - "Constrain the cursor to the flow of the text." - (interactive) - (picture-clean) - (setq tpu-cursor-free nil) - (substitute-key-definition 'tpu-set-cursor-bound - 'tpu-set-cursor-free - GOLD-map) - (message "The cursor is now bound to the flow of your text.")) - -;;; tpu-extras.el ends here diff --git a/lisp/emulation/tpu-mapper.el b/lisp/emulation/tpu-mapper.el deleted file mode 100644 index ba6d032fd6a..00000000000 --- a/lisp/emulation/tpu-mapper.el +++ /dev/null @@ -1,395 +0,0 @@ -;;; tpu-mapper.el --- Create a TPU-edt X-windows keymap file - -;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. - -;; Author: Rob Riepel <riepel@networking.stanford.edu> -;; Maintainer: Rob Riepel <riepel@networking.stanford.edu> -;; Keywords: emulations - -;; This file is part of GNU Emacs. - -;; 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 -;; the Free Software Foundation; either version 2, 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 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This emacs lisp program can be used to create an emacs lisp file that -;; defines the TPU-edt keypad for emacs running on x-windows. Please read -;; the "Usage" AND "Known Problems" sections before attempting to run this -;; program. - -;;; Usage: - -;; Simply load this file into the X-windows version of emacs using the -;; following command. - -;; emacs -q -l tpu-mapper - -;; The "-q" option prevents loading of your .emacs file (commands therein -;; might confuse this program). - -;; An instruction screen showing the TPU-edt keypad will be displayed, and -;; you will be prompted to press the TPU-edt editing keys. Tpu-mapper uses -;; the keys you press to create an Emacs Lisp file that will define a -;; TPU-edt keypad for your X server. You can even re-arrange the standard -;; EDT keypad to suit your tastes (or to cope with those silly Sun and PC -;; keypads). - -;; Finally, you will be prompted for the name of the file to store the key -;; definitions. If you chose the default, TPU-edt will find it and load it -;; automatically. If you specify a different file name, you will need to -;; set the variable "tpu-xkeys-file" before starting TPU-edt. Here's how -;; you might go about doing that in your .emacs file. - -;; (setq tpu-xkeys-file (expand-file-name "~/.my-emacs-x-keys")) -;; (tpu-edt) - -;;; Known Problems: - -;; Sometimes, tpu-mapper will ignore a key you press, and just continue to -;; prompt for the same key. This can happen when your window manager sucks -;; up the key and doesn't pass it on to Emacs, or it could be an Emacs bug. -;; Either way, there's nothing that tpu-mapper can do about it. You must -;; press RETURN, to skip the current key and continue. Later, you and/or -;; your local X guru can try to figure out why the key is being ignored. - -;;; Code: - - -;;; -;;; Make sure we're running X-windows and Emacs version 19 -;;; -(cond - ((not (and window-system (not (string-lessp emacs-version "19")))) - (error "tpu-mapper requires running in Emacs 19, with an X display"))) - - -;;; -;;; Decide whether we're running Lucid Emacs or Emacs itself. -;;; -(defconst tpu-lucid-emacs19-p (string-match "Lucid" emacs-version) - "Non-NIL if we are running Lucid Emacs version 19.") - - -;;; -;;; Key variables -;;; -(defvar tpu-kp4 nil) -(defvar tpu-kp5 nil) -(defvar tpu-key nil) -(defvar tpu-enter nil) -(defvar tpu-return nil) -(defvar tpu-key-seq nil) -(defvar tpu-enter-seq nil) -(defvar tpu-return-seq nil) - - -;;; -;;; Make sure the window is big enough to display the instructions -;;; -(if tpu-lucid-emacs19-p (set-screen-size (selected-screen) 80 36) - (set-frame-size (selected-frame) 80 36)) - - -;;; -;;; Create buffers - Directions, Keys, Gold-Keys -;;; -(if (not (get-buffer "Directions")) (generate-new-buffer "Directions")) -(if (not (get-buffer "Keys")) (generate-new-buffer "Keys")) -(if (not (get-buffer "Gold-Keys")) (generate-new-buffer "Gold-Keys")) - - -;;; -;;; Put headers in the Keys buffer -;;; -(set-buffer "Keys") -(insert "\ -;; Key definitions for TPU-edt -;; -") - - -;;; -;;; Display directions -;;; -(switch-to-buffer "Directions") -(insert " - This program prompts you to press keys to create a custom keymap file - for use with the x-windows version of Emacs and TPU-edt. - - Start by pressing the RETURN key, and continue by pressing the keys - specified in the mini-buffer. You can re-arrange the TPU-edt keypad - by pressing any key you want at any prompt. If you want to entirely - omit a key, just press RETURN at the prompt. - - Here's a picture of the standard TPU/edt keypad for reference: - - _______________________ _______________________________ - | HELP | Do | | | | | | - |KeyDefs| | | | | | | - |_______|_______________| |_______|_______|_______|_______| - _______________________ _______________________________ - | Find |Insert |Remove | | Gold | HELP |FndNxt | Del L | - | | |Sto Tex| | key |E-Help | Find |Undel L| - |_______|_______|_______| |_______|_______|_______|_______| - |Select |Pre Scr|Nex Scr| | Page | Sect |Append | Del W | - | Reset |Pre Win|Nex Win| | Do | Fill |Replace|Undel W| - |_______|_______|_______| |_______|_______|_______|_______| - |Move up| |Forward|Reverse|Remove | Del C | - | Top | |Bottom | Top |Insert |Undel C| - _______|_______|_______ |_______|_______|_______|_______| - |Mov Lef|Mov Dow|Mov Rig| | Word | EOL | Char | | - |StaOfLi|Bottom |EndOfLi| |ChngCas|Del EOL|SpecIns| Enter | - |_______|_______|_______| |_______|_______|_______| | - | Line |Select | Subs | - | Open Line | Reset | | - |_______________|_______|_______| - - -") -(delete-other-windows) -(goto-char (point-min)) - -;;; -;;; Save <CR> for future reference -;;; -(cond - (tpu-lucid-emacs19-p - (setq tpu-return-seq (read-key-sequence "Hit carriage-return <CR> to continue ")) - (setq tpu-return (concat "[" (format "%s" (event-key (aref tpu-return-seq 0))) "]"))) - (t - (message "Hit carriage-return <CR> to continue ") - (setq tpu-return-seq (read-event)) - (setq tpu-return (concat "[" (format "%s" tpu-return-seq) "]")))) - - -;;; -;;; Key mapping functions -;;; -(defun tpu-lucid-map-key (ident descrip func gold-func) - (interactive) - (setq tpu-key-seq (read-key-sequence (format "Press %s%s: " ident descrip))) - (setq tpu-key (concat "[" (format "%s" (event-key (aref tpu-key-seq 0))) "]")) - (cond ((not (equal tpu-key tpu-return)) - (set-buffer "Keys") - (insert (format"(global-set-key %s %s)\n" tpu-key func)) - (set-buffer "Gold-Keys") - (insert (format "(define-key GOLD-map %s %s)\n" tpu-key gold-func)) - (set-buffer "Directions")) - ;; bogosity to get next prompt to come up, if the user hits <CR>! - ;; check periodically to see if this is still needed... - (t - (format "%s" tpu-key))) - tpu-key) - -(defun tpu-emacs-map-key (ident descrip func gold-func) - (interactive) - (message "Press %s%s: " ident descrip) - (setq tpu-key-seq (read-event)) - (setq tpu-key (concat "[" (format "%s" tpu-key-seq) "]")) - (cond ((not (equal tpu-key tpu-return)) - (set-buffer "Keys") - (insert (format"(global-set-key %s %s)\n" tpu-key func)) - (set-buffer "Gold-Keys") - (insert (format "(define-key GOLD-map %s %s)\n" tpu-key gold-func)) - (set-buffer "Directions")) - ;; bogosity to get next prompt to come up, if the user hits <CR>! - ;; check periodically to see if this is still needed... - (t - (format "%s" tpu-key))) - tpu-key) - -(fset 'tpu-map-key (if tpu-lucid-emacs19-p 'tpu-lucid-map-key 'tpu-emacs-map-key)) - - -(set-buffer "Keys") -(insert " -;; Arrows -;; -") -(set-buffer "Gold-Keys") -(insert " -;; GOLD Arrows -;; -") -(set-buffer "Directions") - -(tpu-map-key "Up-Arrow" "" "'tpu-previous-line" "'tpu-move-to-beginning") -(tpu-map-key "Down-arrow" "" "'tpu-next-line" "'tpu-move-to-end") -(tpu-map-key "Right-arrow" "" "'tpu-forward-char" "'end-of-line") -(tpu-map-key "Left-arrow" "" "'tpu-backward-char" "'beginning-of-line") - - -(set-buffer "Keys") -(insert " -;; PF keys -;; -") -(set-buffer "Gold-Keys") -(insert " -;; GOLD PF keys -;; -") -(set-buffer "Directions") - -(tpu-map-key "PF1" " - The GOLD key" "GOLD-map" "'keyboard-quit") -(tpu-map-key "PF2" " - The Keypad Help key" "'tpu-help" "'help-for-help") -(tpu-map-key "PF3" " - The Find/Find-Next key" "'tpu-search-again" "'tpu-search") -(tpu-map-key "PF4" " - The Del/Undelete Line key" "'tpu-delete-current-line" "'tpu-undelete-lines") - -(set-buffer "Keys") -(insert " -;; KP0-9 KP- KP, KP. and KPenter -;; -") -(set-buffer "Gold-Keys") -(insert " -;; GOLD KP0-9 KP- KP, and KPenter -;; -") -(set-buffer "Directions") - -(tpu-map-key "KP-0" " - The Line/Open-Line key" "'tpu-line" "'open-line") -(tpu-map-key "KP-1" " - The Word/Change-Case key" "'tpu-word" "'tpu-change-case") -(tpu-map-key "KP-2" " - The EOL/Delete-EOL key" "'tpu-end-of-line" "'tpu-delete-to-eol") -(tpu-map-key "KP-3" " - The Character/Special-Insert key" "'tpu-char" "'tpu-special-insert") -(setq tpu-kp4 (tpu-map-key "KP-4" " - The Forward/Bottom key" "'tpu-advance-direction" "'tpu-move-to-end")) -(setq tpu-kp5 (tpu-map-key "KP-5" " - The Reverse/Top key" "'tpu-backup-direction" "'tpu-move-to-beginning")) -(tpu-map-key "KP-6" " - The Remove/Insert key" "'tpu-cut" "'tpu-paste") -(tpu-map-key "KP-7" " - The Page/Do key" "'tpu-page" "'execute-extended-command") -(tpu-map-key "KP-8" " - The Section/Fill key" "'tpu-scroll-window" "'tpu-fill") -(tpu-map-key "KP-9" " - The Append/Replace key" "'tpu-append-region" "'tpu-replace") -(tpu-map-key "KP--" " - The Delete/Undelete Word key" "'tpu-delete-current-word" "'tpu-undelete-words") -(tpu-map-key "KP-," " - The Delete/Undelete Character key" "'tpu-delete-current-char" "'tpu-undelete-char") -(tpu-map-key "KP-." " - The Select/Reset key" "'tpu-select" "'tpu-unselect") -(tpu-map-key "KP-Enter" " - The Enter key on the numeric keypad" "'newline" "'tpu-substitute") -;; Save the enter key -(setq tpu-enter tpu-key) -(setq tpu-enter-seq tpu-key-seq) - -(set-buffer "Keys") -(insert " -;; Editing keypad (find, insert, remove) -;; (select, prev, next) -;; -") -(set-buffer "Gold-Keys") -(insert " -;; GOLD Editing keypad (find, insert, remove) -;; (select, prev, next) -;; -") -(set-buffer "Directions") - -(tpu-map-key "Find" " - The Find key on the editing keypad" "'tpu-search" "'nil") -(tpu-map-key "Insert" " - The Insert key on the editing keypad" "'tpu-paste" "'nil") -(tpu-map-key "Remove" " - The Remove key on the editing keypad" "'tpu-cut" "'tpu-store-text") -(tpu-map-key "Select" " - The Select key on the editing keypad" "'tpu-select" "'tpu-unselect") -(tpu-map-key "Prev Scr" " - The Prev Scr key on the editing keypad" "'tpu-scroll-window-down" "'tpu-previous-window") -(tpu-map-key "Next Scr" " - The Next Scr key on the editing keypad" "'tpu-scroll-window-up" "'tpu-next-window") - -(set-buffer "Keys") -(insert " -;; F10-14 Help Do F17 -;; -") -(set-buffer "Gold-Keys") -(insert " -;; GOLD F10-14 Help Do F17 -;; -") -(set-buffer "Directions") - -(tpu-map-key "F10" " - Invokes the Exit function on VT200+ terminals" "'tpu-exit" "'nil") -(tpu-map-key "F11" " - Inserts an Escape character into the text" "'tpu-insert-escape" "'nil") -(tpu-map-key "Backspace" " - Not Delete nor ^H! Sometimes on the F12 key" "'tpu-next-beginning-of-line" "'nil") -(tpu-map-key "F13" " - Invokes the delete previous word function" "'tpu-delete-previous-word" "'nil") -(tpu-map-key "F14" " - Toggles insert/overstrike modes" "'tpu-toggle-overwrite-mode" "'nil") -(tpu-map-key "Help" " - Brings up the help screen, same as PF2" "'tpu-help" "'describe-bindings") -(tpu-map-key "Do" " - Invokes the COMMAND function" "'execute-extended-command" "'nil") -(tpu-map-key "F17" "" "'tpu-goto-breadcrumb" "'tpu-drop-breadcrumb") - -(set-buffer "Gold-Keys") -(cond - ((not (equal tpu-enter tpu-return)) - (insert " -;; Minibuffer map additions to make KP_enter = RET -;; -") - - (insert (format "(define-key minibuffer-local-map %s 'exit-minibuffer)\n" tpu-enter)) - (insert (format "(define-key minibuffer-local-ns-map %s 'exit-minibuffer)\n" tpu-enter)) - (insert (format "(define-key minibuffer-local-completion-map %s 'exit-minibuffer)\n" tpu-enter)) - (insert (format "(define-key minibuffer-local-must-match-map %s 'minibuffer-complete-and-exit)\n" tpu-enter)))) - -(cond - ((not (or (equal tpu-kp4 tpu-return) (equal tpu-kp5 tpu-return))) - (insert " -;; Minibuffer map additions to allow KP-4/5 termination of search strings. -;; -") - - (insert (format "(define-key minibuffer-local-map %s 'tpu-search-forward-exit)\n" tpu-kp4)) - (insert (format "(define-key minibuffer-local-map %s 'tpu-search-backward-exit)\n" tpu-kp5)))) - -(insert " -;; Define the tpu-help-enter/return symbols -;; -") - -(cond (tpu-lucid-emacs19-p - (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter-seq)) - (insert (format "(setq tpu-help-return \"%s\")\n" tpu-return-seq)) - (insert "(setq tpu-help-N \"[#<keypress-event N>]\")\n") - (insert "(setq tpu-help-n \"[#<keypress-event n>]\")\n") - (insert "(setq tpu-help-P \"[#<keypress-event P>]\")\n") - (insert "(setq tpu-help-p \"[#<keypress-event p>]\")\n")) - (t - (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter)))) - -(append-to-buffer "Keys" 1 (point)) -(set-buffer "Keys") - -;;; -;;; Save the key mapping program -;;; -(let ((file - (convert-standard-filename - (if tpu-lucid-emacs19-p "~/.tpu-lucid-keys" "~/.tpu-keys")))) - (set-visited-file-name - (read-file-name (format "Save key mapping to file (default %s): " file) "" file))) -(save-buffer) - -;;; -;;; Load the newly defined keys and clean up -;;; -(eval-current-buffer) -(kill-buffer (current-buffer)) -(kill-buffer "*scratch*") -(kill-buffer "Gold-Keys") - -;;; -;;; Let them know it worked. -;;; -(switch-to-buffer "Directions") -(erase-buffer) -(insert " - A custom TPU-edt keymap file has been created. - - Press GOLD-k to remove this buffer and continue editing. -") -(goto-char (point-min)) - -;;; tpu-mapper.el ends here diff --git a/lisp/emulation/vi.el b/lisp/emulation/vi.el deleted file mode 100644 index 265ab94f43f..00000000000 --- a/lisp/emulation/vi.el +++ /dev/null @@ -1,1467 +0,0 @@ -;;; vi.el --- major mode for emulating "vi" editor under GNU Emacs. - -; This file is in the public domain because the authors distributed it -; without a copyright notice before the US signed the Bern Convention. - -;; Author: Neal Ziring <nz@rsch.wisc.edu> -;; Felix S. T. Wu <wu@crys.wisc.edu> -;; Keywords: emulations - -;;; Commentary: - -; Originally written by : seismo!wucs!nz@rsch.wisc.edu (Neal Ziring) -; Extensively redesigned and rewritten by wu@crys.wisc.edu (Felix S.T. Wu) -; Last revision: 01/07/87 Wed (for GNU Emacs 18.33) - -; INSTALLATION PROCEDURE: -; 1) Add a global key binding for command "vi-mode" (I use ESC ESC instead of -; the single ESC used in real "vi", so I can access other ESC prefixed emacs -; commands while I'm in "vi"), say, by putting the following line in your -; ".emacs" file: -; (define-key global-map "\e\e" 'vi-mode) ;quick switch into vi-mode -; 2) If you wish you can define "find-file-hooks" to enter "vi" automatically -; after a file is loaded into the buffer. For example, I defined it as: -; (setq find-file-hooks (list -; (function (lambda () -; (if (not (or (eq major-mode 'Info-mode) -; (eq major-mode 'vi-mode))) -; (vi-mode)))))) -; 3) In your .emacs file you can define the command "vi-mode" to be "autoload" -; or you can execute the "load" command to load "vi" directly. -; 4) Read the comments for command "vi-mode" before you start using it. -; -; COULD DO -; 1). A general 'define-operator' function to replace current hack -; 2). In operator handling, should allow other point moving Emacs commands -; (such as ESC <, ESC >) to be used as arguments. -; -;;; Code: - -(defun vi-switch-mode (arg mode-char) - "Switch the major mode of current buffer as specified by the following char \\{vi-tilde-map}" - (interactive "P\nc") - (let ((mode-cmd (lookup-key vi-tilde-map (char-to-string mode-char)))) - (if (null mode-cmd) - (with-output-to-temp-buffer "*Help*" - (princ (substitute-command-keys "Possible major modes to switch to: \\{vi-tilde-map}")) - (save-excursion - (set-buffer standard-output) - (help-mode))) - (setq prefix-arg arg) ; prefix arg will be passed down - (command-execute mode-cmd nil) ; may need to save mode-line-format etc - (force-mode-line-update)))) ; just in case - - -(if (null (where-is-internal 'vi-switch-mode (current-local-map))) - (define-key ctl-x-map "~" 'vi-switch-mode)) - -(defvar vi-tilde-map nil - "Keymap used for \\[vi-switch-mode] prefix key. Link to various major modes.") - -(if vi-tilde-map - nil - (setq vi-tilde-map (make-keymap)) - (define-key vi-tilde-map "a" 'abbrev-mode) - (define-key vi-tilde-map "c" 'c-mode) - (define-key vi-tilde-map "d" 'vi-debugging) - (define-key vi-tilde-map "e" 'emacs-lisp-mode) - (define-key vi-tilde-map "f" 'auto-fill-mode) - (define-key vi-tilde-map "g" 'prolog-mode) - (define-key vi-tilde-map "h" 'hanoi) - (define-key vi-tilde-map "i" 'info-mode) - (define-key vi-tilde-map "l" 'lisp-mode) - (define-key vi-tilde-map "n" 'nroff-mode) - (define-key vi-tilde-map "o" 'overwrite-mode) - (define-key vi-tilde-map "O" 'outline-mode) - (define-key vi-tilde-map "P" 'picture-mode) - (define-key vi-tilde-map "r" 'vi-readonly-mode) - (define-key vi-tilde-map "t" 'text-mode) - (define-key vi-tilde-map "v" 'vi-mode) - (define-key vi-tilde-map "x" 'tex-mode) - (define-key vi-tilde-map "~" 'vi-back-to-old-mode)) - -(defun vi-debugging (arg) - "Toggle debug-on-error flag. If prefix arg is given, set t." - (interactive "P") - (if arg - (setq debug-on-error t) - (setq debug-on-error (not debug-on-error))) - (if debug-on-error - (message "Debug-on-error ...") - (message "NO more debug-on-error"))) - -(defun vi-back-to-old-mode () - "Go back to the previous mode without setting up for insertion." - (interactive) - (if vi-mode-old-major-mode - (progn - (setq mode-name vi-mode-old-mode-name) - (use-local-map vi-mode-old-local-map) - (setq major-mode vi-mode-old-major-mode) - (setq case-fold-search vi-mode-old-case-fold) - (force-mode-line-update)))) - -(defun vi-readonly-mode () - "Toggle current buffer's readonly flag." - (interactive) - (setq buffer-read-only (not buffer-read-only))) - -(defvar vi-com-map nil - "Keymap used in Evi's command state -Command state includes most of the vi editing commands, with some Emacs -command extensions.") - -(put 'vi-undefined 'suppress-keymap t) -(if vi-com-map nil - (setq vi-com-map (make-keymap)) -;;(fillarray vi-com-map 'vi-undefined) - (define-key vi-com-map "\C-@" 'vi-mark-region) ; extension - (define-key vi-com-map "\C-a" 'vi-ask-for-info) ; extension - (define-key vi-com-map "\C-b" 'vi-backward-windowful) - (define-key vi-com-map "\C-c" 'vi-do-old-mode-C-c-command) ; extension - (define-key vi-com-map "\C-d" 'vi-scroll-down-window) - (define-key vi-com-map "\C-e" 'vi-expose-line-below) - (define-key vi-com-map "\C-f" 'vi-forward-windowful) - (define-key vi-com-map "\C-g" 'keyboard-quit) - (define-key vi-com-map "\C-i" 'indent-relative-maybe) ; TAB - (define-key vi-com-map "\C-j" 'vi-next-line) ; LFD - (define-key vi-com-map "\C-k" 'vi-kill-line) ; extension - (define-key vi-com-map "\C-l" 'recenter) - (define-key vi-com-map "\C-m" 'vi-next-line-first-nonwhite) ; RET - (define-key vi-com-map "\C-n" 'vi-next-line) - (define-key vi-com-map "\C-o" 'vi-split-open-line) - (define-key vi-com-map "\C-p" 'previous-line) - (define-key vi-com-map "\C-q" 'vi-query-replace) ; extension - (define-key vi-com-map "\C-r" 'vi-isearch-backward) ; modification - (define-key vi-com-map "\C-s" 'vi-isearch-forward) ; extension - (define-key vi-com-map "\C-t" 'vi-transpose-objects) ; extension - (define-key vi-com-map "\C-u" 'vi-scroll-up-window) - (define-key vi-com-map "\C-v" 'scroll-up) ; extension - (define-key vi-com-map "\C-w" 'vi-kill-region) ; extension - (define-key vi-com-map "\C-x" 'Control-X-prefix) ; extension - (define-key vi-com-map "\C-y" 'vi-expose-line-above) - (define-key vi-com-map "\C-z" 'suspend-emacs) - - (define-key vi-com-map "\e" 'ESC-prefix); C-[ (ESC) - (define-key vi-com-map "\C-\\" 'vi-unimplemented) - (define-key vi-com-map "\C-]" 'find-tag) - (define-key vi-com-map "\C-^" 'vi-locate-def) ; extension - (define-key vi-com-map "\C-_" 'vi-undefined) - - (define-key vi-com-map " " 'forward-char) - (define-key vi-com-map "!" 'vi-operator) - (define-key vi-com-map "\"" 'vi-char-argument) - (define-key vi-com-map "#" 'universal-argument) ; extension - (define-key vi-com-map "$" 'end-of-line) - (define-key vi-com-map "%" 'vi-find-matching-paren) - (define-key vi-com-map "&" 'vi-unimplemented) - (define-key vi-com-map "'" 'vi-goto-line-mark) - (define-key vi-com-map "(" 'backward-sexp) - (define-key vi-com-map ")" 'forward-sexp) - (define-key vi-com-map "*" 'vi-name-last-change-or-macro) ; extension - (define-key vi-com-map "+" 'vi-next-line-first-nonwhite) - (define-key vi-com-map "," 'vi-reverse-last-find-char) - (define-key vi-com-map "-" 'vi-previous-line-first-nonwhite) - (define-key vi-com-map "." 'vi-redo-last-change-command) - (define-key vi-com-map "/" 'vi-search-forward) - (define-key vi-com-map "0" 'beginning-of-line) - - (define-key vi-com-map "1" 'vi-digit-argument) - (define-key vi-com-map "2" 'vi-digit-argument) - (define-key vi-com-map "3" 'vi-digit-argument) - (define-key vi-com-map "4" 'vi-digit-argument) - (define-key vi-com-map "5" 'vi-digit-argument) - (define-key vi-com-map "6" 'vi-digit-argument) - (define-key vi-com-map "7" 'vi-digit-argument) - (define-key vi-com-map "8" 'vi-digit-argument) - (define-key vi-com-map "9" 'vi-digit-argument) - - (define-key vi-com-map ":" 'vi-ex-cmd) - (define-key vi-com-map ";" 'vi-repeat-last-find-char) - (define-key vi-com-map "<" 'vi-operator) - (define-key vi-com-map "=" 'vi-operator) - (define-key vi-com-map ">" 'vi-operator) - (define-key vi-com-map "?" 'vi-search-backward) - (define-key vi-com-map "@" 'vi-call-named-change-or-macro) ; extension - - (define-key vi-com-map "A" 'vi-append-at-end-of-line) - (define-key vi-com-map "B" 'vi-backward-blank-delimited-word) - (define-key vi-com-map "C" 'vi-change-rest-of-line) - (define-key vi-com-map "D" 'vi-kill-line) - (define-key vi-com-map "E" 'vi-end-of-blank-delimited-word) - (define-key vi-com-map "F" 'vi-backward-find-char) - (define-key vi-com-map "G" 'vi-goto-line) - (define-key vi-com-map "H" 'vi-home-window-line) - (define-key vi-com-map "I" 'vi-insert-before-first-nonwhite) - (define-key vi-com-map "J" 'vi-join-lines) - (define-key vi-com-map "K" 'vi-undefined) - (define-key vi-com-map "L" 'vi-last-window-line) - (define-key vi-com-map "M" 'vi-middle-window-line) - (define-key vi-com-map "N" 'vi-reverse-last-search) - (define-key vi-com-map "O" 'vi-open-above) - (define-key vi-com-map "P" 'vi-put-before) - (define-key vi-com-map "Q" 'vi-quote-words) ; extension - (define-key vi-com-map "R" 'vi-replace-chars) - (define-key vi-com-map "S" 'vi-substitute-lines) - (define-key vi-com-map "T" 'vi-backward-upto-char) - (define-key vi-com-map "U" 'vi-unimplemented) - (define-key vi-com-map "V" 'vi-undefined) - (define-key vi-com-map "W" 'vi-forward-blank-delimited-word) - (define-key vi-com-map "X" 'call-last-kbd-macro) ; modification/extension - (define-key vi-com-map "Y" 'vi-yank-line) - (define-key vi-com-map "Z" (make-sparse-keymap)) ;allow below prefix command - (define-key vi-com-map "ZZ" 'vi-save-all-and-exit) - - (define-key vi-com-map "[" 'vi-unimplemented) - (define-key vi-com-map "\\" 'vi-operator) ; extension for vi-narrow-op - (define-key vi-com-map "]" 'vi-unimplemented) - (define-key vi-com-map "^" 'back-to-indentation) - (define-key vi-com-map "_" 'vi-undefined) - (define-key vi-com-map "`" 'vi-goto-char-mark) - - (define-key vi-com-map "a" 'vi-insert-after) - (define-key vi-com-map "b" 'backward-word) - (define-key vi-com-map "c" 'vi-operator) - (define-key vi-com-map "d" 'vi-operator) - (define-key vi-com-map "e" 'vi-end-of-word) - (define-key vi-com-map "f" 'vi-forward-find-char) - (define-key vi-com-map "g" 'vi-beginning-of-buffer) ; extension - (define-key vi-com-map "h" 'backward-char) - (define-key vi-com-map "i" 'vi-insert-before) - (define-key vi-com-map "j" 'vi-next-line) - (define-key vi-com-map "k" 'previous-line) - (define-key vi-com-map "l" 'forward-char) - (define-key vi-com-map "m" 'vi-set-mark) - (define-key vi-com-map "n" 'vi-repeat-last-search) - (define-key vi-com-map "o" 'vi-open-below) - (define-key vi-com-map "p" 'vi-put-after) - (define-key vi-com-map "q" 'vi-replace) - (define-key vi-com-map "r" 'vi-replace-1-char) - (define-key vi-com-map "s" 'vi-substitute-chars) - (define-key vi-com-map "t" 'vi-forward-upto-char) - (define-key vi-com-map "u" 'undo) - (define-key vi-com-map "v" 'vi-verify-spelling) - (define-key vi-com-map "w" 'vi-forward-word) - (define-key vi-com-map "x" 'vi-kill-char) - (define-key vi-com-map "y" 'vi-operator) - (define-key vi-com-map "z" 'vi-adjust-window) - - (define-key vi-com-map "{" 'backward-paragraph) - (define-key vi-com-map "|" 'vi-goto-column) - (define-key vi-com-map "}" 'forward-paragraph) - (define-key vi-com-map "~" 'vi-change-case) - (define-key vi-com-map "\177" 'delete-backward-char)) - -(put 'backward-char 'point-moving-unit 'char) -(put 'vi-next-line 'point-moving-unit 'line) -(put 'next-line 'point-moving-unit 'line) -(put 'forward-line 'point-moving-unit 'line) -(put 'previous-line 'point-moving-unit 'line) -(put 'vi-isearch-backward 'point-moving-unit 'search) -(put 'vi-search-backward 'point-moving-unit 'search) -(put 'vi-isearch-forward 'point-moving-unit 'search) -(put 'vi-search-forward 'point-moving-unit 'search) -(put 'forward-char 'point-moving-unit 'char) -(put 'end-of-line 'point-moving-unit 'char) -(put 'vi-find-matching-paren 'point-moving-unit 'match) -(put 'vi-goto-line-mark 'point-moving-unit 'line) -(put 'backward-sexp 'point-moving-unit 'sexp) -(put 'forward-sexp 'point-moving-unit 'sexp) -(put 'vi-next-line-first-nonwhite 'point-moving-unit 'line) -(put 'vi-previous-line-first-nonwhite 'point-moving-unit 'line) -(put 'vi-reverse-last-find-char 'point-moving-unit 'rev-find) -(put 'vi-re-search-forward 'point-moving-unit 'search) -(put 'beginning-of-line 'point-moving-unit 'char) -(put 'vi-beginning-of-buffer 'point-moving-unit 'char) -(put 'vi-repeat-last-find-char 'point-moving-unit 'find) -(put 'vi-re-search-backward 'point-moving-unit 'search) -(put 'vi-backward-blank-delimited-word 'point-moving-unit 'WORD) -(put 'vi-end-of-blank-delimited-word 'point-moving-unit 'match) -(put 'vi-backward-find-char 'point-moving-unit 'find) -(put 'vi-goto-line 'point-moving-unit 'line) -(put 'vi-home-window-line 'point-moving-unit 'line) -(put 'vi-last-window-line 'point-moving-unit 'line) -(put 'vi-middle-window-line 'point-moving-unit 'line) -(put 'vi-reverse-last-search 'point-moving-unit 'rev-search) -(put 'vi-backward-upto-char 'point-moving-unit 'find) -(put 'vi-forward-blank-delimited-word 'point-moving-unit 'WORD) -(put 'back-to-indentation 'point-moving-unit 'char) -(put 'vi-goto-char-mark 'point-moving-unit 'char) -(put 'backward-word 'point-moving-unit 'word) -(put 'vi-end-of-word 'point-moving-unit 'match) -(put 'vi-forward-find-char 'point-moving-unit 'find) -(put 'backward-char 'point-moving-unit 'char) -(put 'vi-forward-char 'point-moving-unit 'char) -(put 'vi-repeat-last-search 'point-moving-unit 'search) -(put 'vi-forward-upto-char 'point-moving-unit 'find) -(put 'vi-forward-word 'point-moving-unit 'word) -(put 'vi-goto-column 'point-moving-unit 'match) -(put 'forward-paragraph 'point-moving-unit 'paragraph) -(put 'backward-paragraph 'point-moving-unit 'paragraph) - -;;; region mark commands -(put 'mark-page 'point-moving-unit 'region) -(put 'mark-paragraph 'point-moving-unit 'region) -(put 'mark-word 'point-moving-unit 'region) -(put 'mark-sexp 'point-moving-unit 'region) -(put 'mark-defun 'point-moving-unit 'region) -(put 'mark-whole-buffer 'point-moving-unit 'region) -(put 'mark-end-of-sentence 'point-moving-unit 'region) -(put 'mark-c-function 'point-moving-unit 'region) -;;; - -(defvar vi-mark-alist nil - "Alist of (NAME . MARK), marks are local to each buffer.") - -(defvar vi-scroll-amount (/ (window-height) 2) - "Default amount of lines for scrolling (used by \"^D\"/\"^U\").") - -(defvar vi-shift-width 4 - "Shift amount for \"<\"/\">\" operators.") - -(defvar vi-ins-point nil ; integer - "Last insertion point. Should use `mark' instead.") - -(defvar vi-ins-length nil ; integer - "Length of last insertion.") - -(defvar vi-ins-repetition nil ; integer - "The repetition required for last insertion.") - -(defvar vi-ins-overwrt-p nil ; boolean - "T if last insertion was a replace actually.") - -(defvar vi-ins-prefix-code nil ; ready-to-eval sexp - "Code to be eval'ed before (redo-)insertion begins.") - -(defvar vi-last-find-char nil ; cons cell - "Save last direction, char and upto-flag used for char finding.") - -(defvar vi-last-change-command nil ; cons cell - "Save commands for redoing last changes. Each command is in (FUNC . ARGS) -form that is ready to be `apply'ed.") - -(defvar vi-last-shell-command nil ; last shell op command line - "Save last shell command given for \"!\" operator.") - -(defvar vi-insert-state nil ; boolean - "Non-nil if it is in insert state.") - -; in "loaddefs.el" -;(defvar search-last-string "" -; "Last string search for by a search command.") - -(defvar vi-search-last-command nil ; (re-)search-forward(backward) - "Save last search command for possible redo.") - -(defvar vi-mode-old-local-map nil - "Save the local-map used before entering vi-mode.") - -(defvar vi-mode-old-mode-name nil - "Save the mode-name before entering vi-mode.") - -(defvar vi-mode-old-major-mode nil - "Save the major-mode before entering vi-mode.") - -(defvar vi-mode-old-case-fold nil) - -;(defconst vi-add-to-mode-line-1 -; '(overwrite-mode nil " Insert")) - -;; Value is same as vi-add-to-mode-line-1 when in vi mode, -;; but nil in other buffers. -;(defvar vi-add-to-mode-line nil) - -(defun vi-mode-setup () - "Setup a buffer for vi-mode by creating necessary buffer-local variables." -; (make-local-variable 'vi-add-to-mode-line) -; (setq vi-add-to-mode-line vi-add-to-mode-line-1) -; (or (memq vi-add-to-mode-line minor-mode-alist) -; (setq minor-mode-alist (cons vi-add-to-mode-line minor-mode-alist))) - (make-local-variable 'vi-scroll-amount) - (setq vi-scroll-amount (/ (window-height) 2)) - (make-local-variable 'vi-shift-width) - (setq vi-shift-width 4) - (make-local-variable 'vi-ins-point) - (make-local-variable 'vi-ins-length) - (make-local-variable 'vi-ins-repetition) - (make-local-variable 'vi-ins-overwrt-p) - (make-local-variable 'vi-ins-prefix-code) - (make-local-variable 'vi-last-change-command) - (make-local-variable 'vi-last-shell-command) - (make-local-variable 'vi-last-find-char) - (make-local-variable 'vi-mark-alist) - (make-local-variable 'vi-insert-state) - (make-local-variable 'vi-mode-old-local-map) - (make-local-variable 'vi-mode-old-mode-name) - (make-local-variable 'vi-mode-old-major-mode) - (make-local-variable 'vi-mode-old-case-fold) - (run-hooks 'vi-mode-hook)) - -;;;###autoload -(defun vi-mode () - "Major mode that acts like the `vi' editor. -The purpose of this mode is to provide you the combined power of vi (namely, -the \"cross product\" effect of commands and repeat last changes) and Emacs. - -This command redefines nearly all keys to look like vi commands. -It records the previous major mode, and any vi command for input -\(`i', `a', `s', etc.) switches back to that mode. -Thus, ordinary Emacs (in whatever major mode you had been using) -is \"input\" mode as far as vi is concerned. - -To get back into vi from \"input\" mode, you must issue this command again. -Therefore, it is recommended that you assign it to a key. - -Major differences between this mode and real vi : - -* Limitations and unsupported features - - Search patterns with line offset (e.g. /pat/+3 or /pat/z.) are - not supported. - - Ex commands are not implemented; try ':' to get some hints. - - No line undo (i.e. the 'U' command), but multi-undo is a standard feature. - -* Modifications - - The stopping positions for some point motion commands (word boundary, - pattern search) are slightly different from standard 'vi'. - Also, no automatic wrap around at end of buffer for pattern searching. - - Since changes are done in two steps (deletion then insertion), you need - to undo twice to completely undo a change command. But this is not needed - for undoing a repeated change command. - - No need to set/unset 'magic', to search for a string with regular expr - in it just put a prefix arg for the search commands. Replace cmds too. - - ^R is bound to incremental backward search, so use ^L to redraw screen. - -* Extensions - - Some standard (or modified) Emacs commands were integrated, such as - incremental search, query replace, transpose objects, and keyboard macros. - - In command state, ^X links to the 'ctl-x-map', and ESC can be linked to - esc-map or set undefined. These can give you the full power of Emacs. - - See vi-com-map for those keys that are extensions to standard vi, e.g. - `vi-name-last-change-or-macro', `vi-verify-spelling', `vi-locate-def', - `vi-mark-region', and 'vi-quote-words'. Some of them are quite handy. - - Use \\[vi-switch-mode] to switch among different modes quickly. - -Syntax table and abbrevs while in vi mode remain as they were in Emacs." - (interactive) - (if (null vi-mode-old-major-mode) ; very first call for current buffer - (vi-mode-setup)) - - (if (eq major-mode 'vi-mode) - (message "Already in vi-mode." (ding)) - (setq vi-mode-old-local-map (current-local-map)) - (setq vi-mode-old-mode-name mode-name) - (setq vi-mode-old-major-mode major-mode) - (setq vi-mode-old-case-fold case-fold-search) ; this is needed !! - (setq case-fold-search nil) ; exact case match in searching - (use-local-map vi-com-map) - (setq major-mode 'vi-mode) - (setq mode-name "VI") - (force-mode-line-update) ; force mode line update - (if vi-insert-state ; this is a return from insertion - (vi-end-of-insert-state)))) - -(defun vi-ding() - "Ding !" - (interactive) - (ding)) - -(defun vi-save-all-and-exit () - "Save all modified buffers without asking, then exits emacs." - (interactive) - (save-some-buffers t) - (kill-emacs)) - -;; to be used by "ex" commands -(defvar vi-replaced-string nil) -(defvar vi-replacing-string nil) - -(defun vi-ex-cmd () - "Ex commands are not implemented in Evi mode. For some commonly used ex -commands, you can use the following alternatives for similar effect : -w C-x C-s (save-buffer) -wq C-x C-c (save-buffers-kill-emacs) -w fname C-x C-w (write-file) -e fname C-x C-f (find-file) -r fname C-x i (insert-file) -s/old/new use q (vi-replace) to do unconditional replace - use C-q (vi-query-replace) to do query replace -set sw=n M-x set-variable vi-shift-width n " - (interactive) -;; (let ((cmd (read-string ":")) (lines 1)) -;; (cond ((string-match "s")))) - (with-output-to-temp-buffer "*Help*" - (princ (documentation 'vi-ex-cmd)) - (save-excursion - (set-buffer standard-output) - (help-mode)))) - -(defun vi-undefined () - (interactive) - (message "Command key \"%s\" is undefined in Evi." - (single-key-description last-command-char)) - (ding)) - -(defun vi-unimplemented () - (interactive) - (message "Command key \"%s\" is not implemented in Evi." - (single-key-description last-command-char)) - (ding)) - -;;;;; -(defun vi-goto-insert-state (repetition &optional prefix-code do-it-now-p) - "Go into insert state, the text entered will be repeated if REPETITION > 1. -If PREFIX-CODE is given, do it before insertion begins if DO-IT-NOW-P is T. -In any case, the prefix-code will be done before each 'redo-insert'. -This function expects 'overwrite-mode' being set properly beforehand." - (if do-it-now-p (apply (car prefix-code) (cdr prefix-code))) - (setq vi-ins-point (point)) - (setq vi-ins-repetition repetition) - (setq vi-ins-prefix-code prefix-code) - (setq mode-name vi-mode-old-mode-name) - (setq case-fold-search vi-mode-old-case-fold) - (use-local-map vi-mode-old-local-map) - (setq major-mode vi-mode-old-major-mode) - (force-mode-line-update) - (setq vi-insert-state t)) - -(defun vi-end-of-insert-state () - "Terminate insertion and set up last change command." - (if (or (< (point) vi-ins-point) ;Check if there is any effective change - (and (= (point) vi-ins-point) (null vi-ins-prefix-code)) - (<= vi-ins-repetition 0)) - (vi-goto-command-state t) - (if (> vi-ins-repetition 1) - (progn - (let ((str (buffer-substring vi-ins-point (point)))) - (while (> vi-ins-repetition 1) - (insert str) - (setq vi-ins-repetition (1- vi-ins-repetition)))))) - (vi-set-last-change-command 'vi-first-redo-insertion vi-ins-point (point) - overwrite-mode vi-ins-prefix-code) - (vi-goto-command-state t))) - -(defun vi-first-redo-insertion (begin end &optional overwrite-p prefix-code) - "Redo last insertion the first time. Extract the string and save it for -future redoes. Do prefix-code if it's given, use overwrite mode if asked." - (let ((str (buffer-substring begin end))) - (if prefix-code (apply (car prefix-code) (cdr prefix-code))) - (if overwrite-p (delete-region (point) (+ (point) (length str)))) - (insert str) - (vi-set-last-change-command 'vi-more-redo-insertion str overwrite-p prefix-code))) - -(defun vi-more-redo-insertion (str &optional overwrite-p prefix-code) - "Redo more insertion : copy string from STR to point, use overwrite mode -if overwrite-p is T; apply prefix-code first if it's non-nil." - (if prefix-code (apply (car prefix-code) (cdr prefix-code))) - (if overwrite-p (delete-region (point) (+ (point) (length str)))) - (insert str)) - -(defun vi-goto-command-state (&optional from-insert-state-p) - "Go to vi-mode command state. If optional arg exists, means return from -insert state." - (use-local-map vi-com-map) - (setq vi-insert-state nil) - (if from-insert-state-p - (if overwrite-mode - (overwrite-mode 0) -; (set-minor-mode 'ins "Insert" nil) - ))) - -(defun vi-kill-line (arg) - "kill specified number of lines (=d$), text saved in the kill ring." - (interactive "*P") - (kill-line arg) - (vi-set-last-change-command 'kill-line arg)) - -(defun vi-kill-region (start end) - (interactive "*r") - (kill-region start end) - (vi-set-last-change-command 'kill-region)) - -(defun vi-append-at-end-of-line (arg) - "go to end of line and then go into vi insert state." - (interactive "*p") - (vi-goto-insert-state arg '(end-of-line) t)) - -(defun vi-change-rest-of-line (arg) - "Change the rest of (ARG) lines (= c$ in vi)." - (interactive "*P") - (vi-goto-insert-state 1 (list 'kill-line arg) t)) - -(defun vi-insert-before-first-nonwhite (arg) - "(= ^i in vi)" - (interactive "*p") - (vi-goto-insert-state arg '(back-to-indentation) t)) - -(defun vi-open-above (arg) - "open new line(s) above current line and enter insert state." - (interactive "*p") - (vi-goto-insert-state 1 - (list (function (lambda (x) - (or (beginning-of-line) - (open-line x)))) arg) - t)) - -(defun vi-open-below (arg) - "open new line(s) and go into insert mode on the last line." - (interactive "*p") - (vi-goto-insert-state 1 - (list (function (lambda (x) - (or (end-of-line) - (open-line x) - (forward-line x)))) arg) - t)) - -(defun vi-insert-after (arg) - "start vi insert state after cursor." - (interactive "*p") - (vi-goto-insert-state arg - (list (function (lambda () - (if (not (eolp)) (forward-char))))) - t)) - -(defun vi-insert-before (arg) - "enter insert state before the cursor." - (interactive "*p") - (vi-goto-insert-state arg)) - -(defun vi-goto-line (arg) - "Go to ARGth line." - (interactive "P") - (if (null (vi-raw-numeric-prefix arg)) - (end-of-buffer) - (goto-line (vi-prefix-numeric-value arg)))) - -(defun vi-beginning-of-buffer () - "Move point to the beginning of current buffer." - (interactive) - (goto-char (point-min))) - -;;;;; not used now -;;(defvar regexp-search t ; string -;; "*T if search string can contain regular expressions. (= set magic in vi)") -;;;;; - -(defun vi-isearch-forward (arg) - "Incremental search forward. Use regexp version if ARG is non-nil." - (interactive "P") - (let ((scmd (if arg 'isearch-forward-regexp 'isearch-forward)) - (opoint (point))) - (call-interactively scmd) - (if (= opoint (point)) - nil - (setq vi-search-last-command (if arg 're-search-forward 'search-forward))))) - -(defun vi-isearch-backward (arg) - "Incremental search backward. Use regexp version if ARG is non-nil." - (interactive "P") - (let ((scmd (if arg 'isearch-backward-regexp 'isearch-backward)) - (opoint (point))) - (call-interactively scmd) - (if (= opoint (point)) - nil - (setq vi-search-last-command (if arg 're-search-backward 'search-backward))))) - -(defun vi-search-forward (arg string) - "Nonincremental search forward. Use regexp version if ARG is non-nil." - (interactive (if current-prefix-arg - (list t (read-string "regexp/" nil)) - (list nil (read-string "/" nil)))) - (setq vi-search-last-command (if arg 're-search-forward 'search-forward)) - (if (> (length string) 0) (setq search-last-string string)) - (funcall vi-search-last-command search-last-string nil nil 1)) - -(defun vi-search-backward (arg string) - "Nonincremental search backward. Use regexp version if ARG is non-nil." - (interactive (if current-prefix-arg - (list t (read-string "regexp?" nil)) - (list nil (read-string "?" nil)))) - (setq vi-search-last-command (if arg 're-search-backward 'search-backward)) - (if (> (length string) 0) (setq search-last-string string)) - (funcall vi-search-last-command search-last-string nil nil 1)) - -(defun vi-repeat-last-search (arg &optional search-command search-string) - "Repeat last search command. If optional search-command/string are given, -use those instead of the ones saved." - (interactive "p") - (if (null search-command) (setq search-command vi-search-last-command)) - (if (null search-string) (setq search-string search-last-string)) - (if (null search-command) - (message "No last search command to repeat." (ding)) - (funcall search-command search-string nil nil arg))) - -(defun vi-reverse-last-search (arg &optional search-command search-string) - "Redo last search command in reverse direction. If the optional search args -are given, use those instead of the ones saved." - (interactive "p") - (if (null search-command) (setq search-command vi-search-last-command)) - (if (null search-string) (setq search-string search-last-string)) - (if (null search-command) - (message "No last search command to repeat." (ding)) - (funcall (cond ((eq search-command 're-search-forward) 're-search-backward) - ((eq search-command 're-search-backward) 're-search-forward) - ((eq search-command 'search-forward) 'search-backward) - ((eq search-command 'search-backward) 'search-forward)) - search-string nil nil arg))) - -(defun vi-join-lines (arg) - "join ARG lines from current line (default 2), cleaning up white space." - (interactive "P") - (if (null (vi-raw-numeric-prefix arg)) - (delete-indentation t) - (setq count (vi-prefix-numeric-value arg)) - (while (>= count 2) - (delete-indentation t) - (setq count (1- count)))) - (vi-set-last-change-command 'vi-join-lines arg)) - -(defun vi-backward-kill-line () - "kill the current line. Only works in insert state." - (interactive) - (if (not vi-insert-state) - nil - (beginning-of-line 1) - (kill-line nil))) - -(defun vi-abort-ins () - "abort insert state, kill inserted text and go back to command state." - (interactive) - (if (not vi-insert-state) - nil - (if (> (point) vi-ins-point) - (kill-region vi-ins-point (point))) - (vi-goto-command-state t))) - -(defun vi-backward-windowful (count) - "Backward COUNT windowfuls. Default is one." - (interactive "p") -; (set-mark-command nil) - (while (> count 0) - (scroll-down nil) - (setq count (1- count)))) - -(defun vi-scroll-down-window (count) - "Scrolls down window COUNT lines. -If COUNT is nil (actually, non-integer), scrolls default amount. -The given COUNT is remembered for future scrollings." - (interactive "P") - (if (integerp count) - (setq vi-scroll-amount count)) - (scroll-up vi-scroll-amount)) - -(defun vi-expose-line-below (count) - "Expose COUNT more lines below the current window. Default COUNT is 1." - (interactive "p") - (scroll-up count)) - -(defun vi-forward-windowful (count) - "Forward COUNT windowfuls. Default is one." - (interactive "p") -; (set-mark-command nil) - (while (> count 0) - (scroll-up nil) - (setq count (1- count)))) - -(defun vi-next-line (count) - "Go down count lines, try to keep at the same column." - (interactive "p") - (setq this-command 'next-line) ; this is a needed trick - (if (= (point) (or (line-move count) (point))) - (ding) ; no moving, already at end of buffer - (setq last-command 'next-line))) - -(defun vi-next-line-first-nonwhite (count) - "Go down COUNT lines. Stop at first non-white." - (interactive "p") - (if (= (point) (progn (forward-line count) (back-to-indentation) (point))) - (ding))) ; no moving, already at end of buffer - -(defun vi-previous-line-first-nonwhite (count) - "Go up COUNT lines. Stop at first non-white." - (interactive "p") - (previous-line count) - (back-to-indentation)) - -(defun vi-scroll-up-window (count) - "Scrolls up window COUNT lines. -If COUNT is nil (actually, non-integer), scrolls default amount. -The given COUNT is remembered for future scrollings." - (interactive "P") - (if (integerp count) - (setq vi-scroll-amount count)) - (scroll-down vi-scroll-amount)) - -(defun vi-expose-line-above (count) - "Expose COUNT more lines above the current window. Default COUNT is 1." - (interactive "p") - (scroll-down count)) - -(defun vi-char-argument (arg) - "Get following character (could be any CHAR) as part of the prefix argument. -Possible prefix-arg cases are NIL, INTEGER, (NIL . CHAR) or (INTEGER . CHAR)." - (interactive "P") - (let ((char (read-char))) - (cond ((null arg) (setq prefix-arg (cons nil char))) - ((integerp arg) (setq prefix-arg (cons arg char))) - ; This can happen only if the user changed his/her mind for CHAR, - ; Or there are some leading "universal-argument"s - (t (setq prefix-arg (cons (car arg) char)))))) - -(defun vi-goto-mark (mark-char &optional line-flag) - "Go to marked position or line (if line-flag is given). -Goto mark '@' means jump into and pop the top mark on the mark ring." - (cond ((char-equal mark-char last-command-char) ; `` or '' - (exchange-point-and-mark) (if line-flag (back-to-indentation))) - ((char-equal mark-char ?@) ; jump and pop mark - (set-mark-command t) (if line-flag (back-to-indentation))) - (t - (let ((mark (vi-get-mark mark-char))) - (if (null mark) - (message "Mark register undefined." (vi-ding)) - (set-mark-command nil) - (goto-char mark) - (if line-flag (back-to-indentation))))))) - -(defun vi-goto-line-mark (char) - "Go to the line (at first non-white) marked by next char." - (interactive "c") - (vi-goto-mark char t)) - -(defun vi-goto-char-mark (char) - "Go to the char position marked by next mark-char." - (interactive "c") - (vi-goto-mark char)) - -(defun vi-digit-argument (arg) - "Set numeric prefix argument." - (interactive "P") - (cond ((null arg) (digit-argument arg)) - ((integerp arg) (digit-argument nil) - (setq prefix-arg (* prefix-arg arg))) - (t (digit-argument nil) ; in (NIL . CHAR) or (NUM . CHAR) form - (setq prefix-arg (cons (* prefix-arg - (if (null (car arg)) 1 (car arg))) - (cdr arg)))))) - -(defun vi-raw-numeric-prefix (arg) - "Return the raw value of numeric part prefix argument." - (if (consp arg) (car arg) arg)) - -(defun vi-prefix-numeric-value (arg) - "Return numeric meaning of the raw prefix argument. This is a modification -to the standard one provided in `callint.c' to handle (_ . CHAR) cases." - (cond ((null arg) 1) - ((integerp arg) arg) - ((consp arg) (if (car arg) (car arg) 1)))) - -(defun vi-reverse-last-find-char (count &optional find-arg) - "Reverse last f F t T operation COUNT times. If the optional FIND-ARG -is given, it is used instead of the saved one." - (interactive "p") - (if (null find-arg) (setq find-arg vi-last-find-char)) - (if (null find-arg) - (message "No last find char to repeat." (ding)) - (vi-find-char (cons (* (car find-arg) -1) (cdr find-arg)) count))) ;6/13/86 - -(defun vi-find-char (arg count) - "Find in DIRECTION (1/-1) for CHAR of COUNT'th times on current line. -If UPTO-FLAG is T, stop before the char. ARG = (DIRECTION.CHAR.UPTO-FLAG." - (let* ((direction (car arg)) (char (car (cdr arg))) - (upto-flag (cdr (cdr arg))) (pos (+ (point) direction))) - (if (catch 'exit-find-char - (while t - (cond ((null (char-after pos)) (throw 'exit-find-char nil)) - ((char-equal (char-after pos) ?\n) (throw 'exit-find-char nil)) - ((char-equal char (char-after pos)) (setq count (1- count)) - (if (= count 0) - (throw 'exit-find-char - (if upto-flag - (setq pos (- pos direction)) - pos))))) - (setq pos (+ pos direction)))) - (goto-char pos) - (ding)))) - -(defun vi-repeat-last-find-char (count &optional find-arg) - "Repeat last f F t T operation COUNT times. If optional FIND-ARG is given, -it is used instead of the saved one." - (interactive "p") - (if (null find-arg) (setq find-arg vi-last-find-char)) - (if (null find-arg) - (message "No last find char to repeat." (ding)) - (vi-find-char find-arg count))) - -(defun vi-backward-find-char (count char) - "Find the COUNT'th CHAR backward on current line." - (interactive "p\nc") - (setq vi-last-find-char (cons -1 (cons char nil))) - (vi-repeat-last-find-char count)) - -(defun vi-forward-find-char (count char) - "Find the COUNT'th CHAR forward on current line." - (interactive "p\nc") - (setq vi-last-find-char (cons 1 (cons char nil))) - (vi-repeat-last-find-char count)) - -(defun vi-backward-upto-char (count char) - "Find upto the COUNT'th CHAR backward on current line." - (interactive "p\nc") - (setq vi-last-find-char (cons -1 (cons char t))) - (vi-repeat-last-find-char count)) - -(defun vi-forward-upto-char (count char) - "Find upto the COUNT'th CHAR forward on current line." - (interactive "p\nc") - (setq vi-last-find-char (cons 1 (cons char t))) - (vi-repeat-last-find-char count)) - -(defun vi-end-of-word (count) - "Move forward until encountering the end of a word. -With argument, do this that many times." - (interactive "p") - (if (not (eobp)) (forward-char)) - (if (re-search-forward "\\W*\\w+\\>" nil t count) - (backward-char))) - -(defun vi-replace-1-char (count char) - "Replace char after point by CHAR. Repeat COUNT times." - (interactive "p\nc") - (delete-char count nil) ; don't save in kill ring - (setq last-command-char char) - (self-insert-command count) - (vi-set-last-change-command 'vi-replace-1-char count char)) - -(defun vi-replace-chars (arg) - "Replace chars over old ones." - (interactive "*p") - (overwrite-mode 1) - (vi-goto-insert-state arg)) - -(defun vi-substitute-chars (count) - "Substitute COUNT chars by the input chars, enter insert state." - (interactive "*p") - (vi-goto-insert-state 1 (list (function (lambda (c) ; this is a bit tricky - (delete-region (point) - (+ (point) c)))) - count) t)) - -(defun vi-substitute-lines (count) - "Substitute COUNT lines by the input chars. (=cc in vi)" - (interactive "*p") - (vi-goto-insert-state 1 (list 'vi-delete-op 'next-line (1- count)) t)) - -(defun vi-prefix-char-value (arg) - "Get the char part of the current prefix argument." - (cond ((null arg) nil) - ((integerp arg) nil) - ((consp arg) (cdr arg)) - (t nil))) - -(defun vi-operator (arg) - "Handling vi operators (d/c/</>/!/=/y). Current implementation requires -the key bindings of the operators being fixed." - (interactive "P") - (catch 'vi-exit-op - (let ((this-op-char last-command-char)) - (setq last-command-char (read-char)) - (setq this-command (lookup-key vi-com-map (char-to-string last-command-char))) - (if (not (eq this-command 'vi-digit-argument)) - (setq prefix-arg arg) - (vi-digit-argument arg) - (setq last-command-char (read-char)) - (setq this-command (lookup-key vi-com-map (char-to-string last-command-char)))) - (cond ((char-equal this-op-char last-command-char) ; line op - (vi-execute-op this-op-char 'next-line - (cons (1- (vi-prefix-numeric-value prefix-arg)) - (vi-prefix-char-value prefix-arg)))) - ;; We assume any command that has no property 'point-moving-unit' - ;; as having that property with the value 'CHAR'. 3/12/86 - (t ;; (get this-command 'point-moving-unit) - (vi-execute-op this-op-char this-command prefix-arg)))))) - ;; (t (throw 'vi-exit-op (ding))))))) - -(defun vi-execute-op (op-char motion-command arg) - "Execute vi edit operator as specified by OP-CHAR, the operand is the region -determined by the MOTION-COMMAND with ARG." - (cond ((= op-char ?d) - (if (vi-delete-op motion-command arg) - (vi-set-last-change-command 'vi-delete-op (vi-repeat-command-of motion-command) arg))) - ((= op-char ?c) - (if (vi-delete-op motion-command arg) - (vi-goto-insert-state 1 (list 'vi-delete-op - (vi-repeat-command-of motion-command) arg) nil))) - ((= op-char ?y) - (if (vi-yank-op motion-command arg) - (vi-set-last-change-command 'vi-yank-op (vi-repeat-command-of motion-command) arg))) - ((= op-char ?!) - (if (vi-shell-op motion-command arg) - (vi-set-last-change-command 'vi-shell-op (vi-repeat-command-of motion-command) arg vi-last-shell-command))) - ((= op-char ?<) - (if (vi-shift-op motion-command arg (- vi-shift-width)) - (vi-set-last-change-command 'vi-shift-op (vi-repeat-command-of motion-command) arg (- vi-shift-width)))) - ((= op-char ?>) - (if (vi-shift-op motion-command arg vi-shift-width) - (vi-set-last-change-command 'vi-shift-op (vi-repeat-command-of motion-command) arg vi-shift-width))) - ((= op-char ?=) - (if (vi-indent-op motion-command arg) - (vi-set-last-change-command 'vi-indent-op (vi-repeat-command-of motion-command) arg))) - ((= op-char ?\\) - (vi-narrow-op motion-command arg)))) - -(defun vi-repeat-command-of (command) - "Return the command for redo the given command." - (let ((cmd-type (get command 'point-moving-unit))) - (cond ((eq cmd-type 'search) 'vi-repeat-last-search) - ((eq cmd-type 'find) 'vi-repeat-last-find-char) - (t command)))) - -(defun vi-effective-range (motion-command arg) - "Return (begin . end) of the range spanned by executing the given -MOTION-COMMAND with ARG. - MOTION-COMMAND in ready-to-eval list form is not yet supported." - (save-excursion - (let ((begin (point)) end opoint - (moving-unit (get motion-command 'point-moving-unit))) - (setq prefix-arg arg) - (setq opoint (point)) - (command-execute motion-command nil) -;; Check if there is any effective motion. Note that for single line operation -;; the motion-command causes no effective point movement (since it moves up or -;; down zero lines), but it should be counted as effectively moved. - (if (and (= (point) opoint) (not (eq moving-unit 'line))) - (cons opoint opoint) ; no effective motion - (if (eq moving-unit 'region) - (setq begin (or (mark) (point)))) - (if (<= begin (point)) - (setq end (point)) - (setq end begin) - (setq begin (point))) - (cond ((or (eq moving-unit 'match) (eq moving-unit 'find)) - (setq end (1+ end))) - ((eq moving-unit 'line) - (goto-char begin) (beginning-of-line) (setq begin (point)) - (goto-char end) (next-line 1) (beginning-of-line) (setq end (point)))) - (if (> end (point-max)) (setq end (point-max))) ; force in buffer region - (cons begin end))))) - -(defun vi-delete-op (motion-command arg) - "Delete range specified by MOTION-COMMAND with ARG." - (let* ((range (vi-effective-range motion-command arg)) - (begin (car range)) (end (cdr range)) reg) - (if (= begin end) - nil ; point not moved, abort op - (setq reg (vi-prefix-char-value arg)) - (if (null reg) - (kill-region begin end) ; kill ring as unnamed registers - (if (and (>= reg ?A) (<= reg ?Z)) - (append-to-register (downcase reg) begin end t) - (copy-to-register reg begin end t))) - t))) - -(defun vi-yank-op (motion-command arg) - "Yank (in vi sense) range specified by MOTION-COMMAND with ARG." - (let* ((range (vi-effective-range motion-command arg)) - (begin (car range)) (end (cdr range)) reg) - (if (= begin end) - nil ; point not moved, abort op - (setq reg (vi-prefix-char-value arg)) - (if (null reg) - (copy-region-as-kill begin end); kill ring as unnamed registers - (if (and (>= reg ?A) (<= reg ?Z)) - (append-to-register (downcase reg) begin end nil) - (copy-to-register reg begin end nil))) - t))) - -(defun vi-yank-line (arg) - "Yank (in vi sense) lines (= `yy' command)." - (interactive "*P") - (setq arg (cons (1- (vi-prefix-numeric-value arg)) (vi-prefix-char-value arg))) - (if (vi-yank-op 'next-line arg) - (vi-set-last-change-command 'vi-yank-op 'next-line arg))) - -(defun vi-string-end-with-nl-p (string) - "See if STRING ends with a newline char. -Used in checking whether the yanked text should be put back as lines or not." - (= (aref string (1- (length string))) ?\n)) - -(defun vi-put-before (arg &optional after-p) - "Put yanked (in vi sense) text back before/above cursor. -If a numeric prefix value (currently it should be >1) is given, put back -text as lines. If the optional after-p is given, put after/below the cursor." - (interactive "P") - (let ((reg (vi-prefix-char-value arg)) put-text) - (if (and reg (or (< reg ?1) (> reg ?9)) (null (get-register reg))) - (error "Nothing in register %c" reg) - (if (null reg) (setq reg ?1)) ; the default is the last text killed - (setq put-text - (cond - ((and (>= reg ?1) (<= reg ?9)) - (setq this-command 'yank) ; So we may yank-pop !! - (current-kill (- reg ?0 1) 'do-not-rotate)) - ((stringp (get-register reg)) (get-register reg)) - (t (error "Register %c is not containing text string" reg)))) - (if (vi-string-end-with-nl-p put-text) ; put back text as lines - (if after-p - (progn (next-line 1) (beginning-of-line)) - (beginning-of-line)) - (if after-p (forward-char 1))) - (push-mark (point)) - (insert put-text) - (exchange-point-and-mark) -;; (back-to-indentation) ; this is not allowed if we allow yank-pop - (vi-set-last-change-command 'vi-put-before arg after-p)))) - -(defun vi-put-after (arg) - "Put yanked (in vi sense) text back after/below cursor." - (interactive "P") - (vi-put-before arg t)) - -(defun vi-shell-op (motion-command arg &optional shell-command) - "Perform shell command (as filter). -Performs command on range specified by MOTION-COMMAND -with ARG. If SHELL-COMMAND is not given, ask for one from minibuffer. -If char argument is given, it directs the output to a *temp* buffer." - (let* ((range (vi-effective-range motion-command arg)) - (begin (car range)) (end (cdr range))) - (if (= begin end) - nil ; point not moved, abort op - (cond ((null shell-command) - (setq shell-command (read-string "!" nil)) - (setq vi-last-shell-command shell-command))) - (shell-command-on-region begin end shell-command (not (vi-prefix-char-value arg))) - t))) - -(defun vi-shift-op (motion-command arg amount) - "Perform shift command on range specified by MOTION-COMMAND with ARG for -AMOUNT on each line. Negative amount means shift left. -SPECIAL FEATURE: char argument can be used to specify shift amount(1-9)." - (let* ((range (vi-effective-range motion-command arg)) - (begin (car range)) (end (cdr range))) - (if (= begin end) - nil ; point not moved, abort op - (if (vi-prefix-char-value arg) - (setq amount (if (> amount 0) - (- (vi-prefix-char-value arg) ?0) - (- ?0 (vi-prefix-char-value arg))))) - (indent-rigidly begin end amount) - t))) - -(defun vi-indent-op (motion-command arg) - "Perform indent command on range specified by MOTION-COMMAND with ARG." - (let* ((range (vi-effective-range motion-command arg)) - (begin (car range)) (end (cdr range))) - (if (= begin end) - nil ; point not moved, abort op - (indent-region begin end nil) ; insert TAB as indent command - t))) - -(defun vi-narrow-op (motion-command arg) - "Narrow to region specified by MOTION-COMMAND with ARG." - (let* ((range (vi-effective-range motion-command arg)) - (begin (car range)) (end (cdr range)) reg) - (if (= begin end) - nil ; point not moved, abort op - (narrow-to-region begin end)))) - -(defun vi-get-mark (char) - "Return contents of vi mark register named CHAR, or nil if undefined." - (cdr (assq char vi-mark-alist))) - -(defun vi-set-mark (char) - "Set contents of vi mark register named CHAR to current point. -'@' is the special anonymous mark register." - (interactive "c") - (if (char-equal char ?@) - (set-mark-command nil) - (let ((aelt (assq char vi-mark-alist))) - (if aelt - (move-marker (cdr aelt) (point)) ; fixed 6/12/86 - (setq aelt (cons char (copy-marker (point)))) - (setq vi-mark-alist (cons aelt vi-mark-alist)))))) - -(defun vi-find-matching-paren () - "Locate the matching paren. It's a hack right now." - (interactive) - (cond ((looking-at "[[({]") (forward-sexp 1) (backward-char 1)) - ((looking-at "[])}]") (forward-char 1) (backward-sexp 1)) - (t (ding)))) - -(defun vi-backward-blank-delimited-word (count) - "Backward COUNT blank-delimited words." - (interactive "p") - (if (re-search-backward "[ \t\n\`][^ \t\n\`]+" nil t count) - (if (not (bobp)) (forward-char 1)))) - -(defun vi-forward-blank-delimited-word (count) - "Forward COUNT blank-delimited words." - (interactive "p") - (if (re-search-forward "[^ \t\n]*[ \t\n]+[^ \t\n]" nil t count) - (if (not (eobp)) (backward-char 1)))) - -(defun vi-end-of-blank-delimited-word (count) - "Forward to the end of the COUNT'th blank-delimited word." - (interactive "p") - (if (re-search-forward "[^ \t\n\']+[ \t\n\']" nil t count) - (if (not (eobp)) (backward-char 2)))) - -(defun vi-home-window-line (arg) - "To window home or arg'th line from the top of the window." - (interactive "p") - (move-to-window-line (1- arg)) - (back-to-indentation)) - -(defun vi-last-window-line (arg) - "To window last line or arg'th line from the bottom of the window." - (interactive "p") - (move-to-window-line (- arg)) - (back-to-indentation)) - -(defun vi-middle-window-line () - "To the middle line of the window." - (interactive) - (move-to-window-line nil) - (back-to-indentation)) - -(defun vi-forward-word (count) - "Stop at the beginning of the COUNT'th words from point." - (interactive "p") - (if (re-search-forward "\\w*\\W+\\<" nil t count) - t - (vi-ding))) - -(defun vi-set-last-change-command (fun &rest args) - "Set (FUN . ARGS) as the `last-change-command'." - (setq vi-last-change-command (cons fun args))) - -(defun vi-redo-last-change-command (count &optional command) - "Redo last change command COUNT times. If the optional COMMAND is given, -it is used instead of the current `last-change-command'." - (interactive "p") - (if (null command) - (setq command vi-last-change-command)) - (if (null command) - (message "No last change command available.") - (while (> count 0) - (apply (car command) (cdr command)) - (setq count (1- count))))) - -(defun vi-kill-char (count) - "Kill COUNT chars from current point." - (interactive "*p") - (delete-char count t) ; save in kill ring - (vi-set-last-change-command 'delete-char count t)) - -(defun vi-transpose-objects (arg unit) - "Transpose objects. -The following char specifies unit of objects to be -transposed -- \"c\" for chars, \"l\" for lines, \"w\" for words, \"s\" for - sexp, \"p\" for paragraph. -For the use of the prefix-arg, refer to individual functions called." - (interactive "*P\nc") - (if (char-equal unit ??) - (progn - (message "Transpose: c(har), l(ine), p(aragraph), s(-exp), w(ord),") - (setq unit (read-char)))) - (vi-set-last-change-command 'vi-transpose-objects arg unit) - (cond ((char-equal unit ?c) (transpose-chars arg)) - ((char-equal unit ?l) (transpose-lines (vi-prefix-numeric-value arg))) - ((char-equal unit ?p) (transpose-paragraphs (vi-prefix-numeric-value arg))) - ((char-equal unit ?s) (transpose-sexps (vi-prefix-numeric-value arg))) - ((char-equal unit ?w) (transpose-words (vi-prefix-numeric-value arg))) - (t (vi-transpose-objects arg ??)))) - -(defun vi-query-replace (arg) - "Query replace, use regexp version if ARG is non-nil." - (interactive "*P") - (let ((rcmd (if arg 'query-replace-regexp 'query-replace))) - (call-interactively rcmd nil))) - -(defun vi-replace (arg) - "Replace strings, use regexp version if ARG is non-nil." - (interactive "*P") - (let ((rcmd (if arg 'replace-regexp 'replace-string))) - (call-interactively rcmd nil))) - -(defun vi-adjust-window (arg position) - "Move current line to the top/center/bottom of the window." - (interactive "p\nc") - (cond ((char-equal position ?\r) (recenter 0)) - ((char-equal position ?-) (recenter -1)) - ((char-equal position ?.) (recenter (/ (window-height) 2))) - (t (message "Move current line to: \\r(top) -(bottom) .(middle)") - (setq position (read-char)) - (vi-adjust-window arg position)))) - -(defun vi-goto-column (col) - "Go to given column of the current line." - (interactive "p") - (let ((opoint (point))) - (beginning-of-line) - (while (> col 1) - (if (eolp) - (setq col 0) - (forward-char 1) - (setq col (1- col)))) - (if (= col 1) - t - (goto-char opoint) - (ding)))) - -(defun vi-name-last-change-or-macro (arg char) - "Give name to the last change command or just defined kbd macro. -If prefix ARG is given, name last macro, otherwise name last change command. -The following CHAR will be the name for the command or macro." - (interactive "P\nc") - (if arg - (name-last-kbd-macro (intern (char-to-string char))) - (if (eq (car vi-last-change-command) 'vi-first-redo-insertion) - (let* ((args (cdr vi-last-change-command)) ; save the insertion text - (str (buffer-substring (nth 0 args) (nth 1 args))) - (overwrite-p (nth 2 args)) - (prefix-code (nth 3 args))) - (vi-set-last-change-command 'vi-more-redo-insertion str - overwrite-p prefix-code))) - (fset (intern (char-to-string char)) vi-last-change-command))) - -(defun vi-call-named-change-or-macro (count char) - "Execute COUNT times the keyboard macro definition named by the following CHAR." - (interactive "p\nc") - (if (stringp (symbol-function (intern (char-to-string char)))) - (execute-kbd-macro (intern (char-to-string char)) count) - (vi-redo-last-change-command count (symbol-function (intern (char-to-string char)))))) - -(defun vi-change-case (arg) ; could be made as an operator ? - "Change the case of the char after point." - (interactive "*p") - (catch 'exit - (if (looking-at "[a-z]") - (upcase-region (point) (+ (point) arg)) - (if (looking-at "[A-Z]") - (downcase-region (point) (+ (point) arg)) - (ding) - (throw 'exit nil))) - (vi-set-last-change-command 'vi-change-case arg) ;should avoid redundant save - (forward-char arg))) - -(defun vi-ask-for-info (char) - "Inquire status info. The next CHAR will specify the particular info requested." - (interactive "c") - (cond ((char-equal char ?l) (what-line)) - ((char-equal char ?c) (what-cursor-position)) - ((char-equal char ?p) (what-page)) - (t (message "Ask for: l(ine number), c(ursor position), p(age number)") - (setq char (read-char)) - (vi-ask-for-info char)))) - -(defun vi-mark-region (arg region) - "Mark region appropriately. The next char REGION is d(efun),s(-exp),b(uffer), -p(aragraph), P(age), f(unction in C/Pascal etc.), w(ord), e(nd of sentence), -l(ines)." - (interactive "p\nc") - (cond ((char-equal region ?d) (mark-defun)) - ((char-equal region ?s) (mark-sexp arg)) - ((char-equal region ?b) (mark-whole-buffer)) - ((char-equal region ?p) (mark-paragraph)) - ((char-equal region ?P) (mark-page arg)) - ((char-equal region ?f) (mark-c-function)) - ((char-equal region ?w) (mark-word arg)) - ((char-equal region ?e) (mark-end-of-sentence arg)) - ((char-equal region ?l) (vi-mark-lines arg)) - (t (message "Mark: d(efun),s(-exp),b(uf),p(arag),P(age),f(unct),w(ord),e(os),l(ines)") - (setq region (read-char)) - (vi-mark-region arg region)))) - -(defun vi-mark-lines (num) - "Mark NUM of lines from current line as current region." - (beginning-of-line 1) - (push-mark) - (end-of-line num)) - -(defun vi-verify-spelling (arg unit) - "Verify spelling for the objects specified by char UNIT : [b(uffer), -r(egion), s(tring), w(ord) ]." - (interactive "P\nc") - (setq prefix-arg arg) ; seems not needed - (cond ((char-equal unit ?b) (call-interactively 'spell-buffer)) - ((char-equal unit ?r) (call-interactively 'spell-region)) - ((char-equal unit ?s) (call-interactively 'spell-string)) - ((char-equal unit ?w) (call-interactively 'spell-word)) - (t (message "Spell check: b(uffer), r(egion), s(tring), w(ord)") - (setq unit (read-char)) - (vi-verify-spelling arg unit)))) - -(defun vi-do-old-mode-C-c-command (arg) - "This is a hack for accessing mode specific C-c commands in vi-mode." - (interactive "P") - (let ((cmd (lookup-key vi-mode-old-local-map - (concat "\C-c" (char-to-string (read-char)))))) - (if (catch 'exit-vi-mode ; kludge hack due to dynamic binding - ; of case-fold-search - (if (null cmd) - (progn (ding) nil) - (let ((case-fold-search vi-mode-old-case-fold)) ; a hack - (setq prefix-arg arg) - (command-execute cmd nil) - nil))) - (progn - (vi-back-to-old-mode) - (setq prefix-arg arg) - (command-execute cmd nil))))) - -(defun vi-quote-words (arg char) - "Quote ARG words from the word point is on with pattern specified by CHAR. -Currently, CHAR could be [,{,(,\",',`,<,*, etc." - (interactive "*p\nc") - (while (not (string-match "[[({<\"'`*]" (char-to-string char))) - (message "Enter any of [,{,(,<,\",',`,* as quoting character.") - (setq char (read-char))) - (vi-set-last-change-command 'vi-quote-words arg char) - (if (not (looking-at "\\<")) (forward-word -1)) - (insert char) - (cond ((char-equal char ?[) (setq char ?])) - ((char-equal char ?{) (setq char ?})) - ((char-equal char ?<) (setq char ?>)) - ((char-equal char ?() (setq char ?))) - ((char-equal char ?`) (setq char ?'))) - (vi-end-of-word arg) - (forward-char 1) - (insert char)) - -(defun vi-locate-def () - "Locate definition in current file for the name before the point. -It assumes a `(def..' always starts at the beginning of a line." - (interactive) - (let (name) - (save-excursion - (setq name (buffer-substring (progn (vi-backward-blank-delimited-word 1) - (skip-chars-forward "^a-zA-Z") - (point)) - (progn (vi-end-of-blank-delimited-word 1) - (forward-char) - (skip-chars-backward "^a-zA-Z") - (point))))) - (set-mark-command nil) - (goto-char (point-min)) - (if (re-search-forward (concat "^(def[unvarconst ]*" name) nil t) - nil - (message "No definition for \"%s\" in current file." name (ding)) - (set-mark-command t)))) - -(defun vi-split-open-line (arg) - "Insert a newline and leave point before it. -With ARG, inserts that many newlines." - (interactive "*p") - (vi-goto-insert-state 1 - (list (function (lambda (arg) - (let ((flag (and (bolp) (not (bobp))))) - (if flag (forward-char -1)) - (while (> arg 0) - (save-excursion - (insert ?\n) - (if fill-prefix (insert fill-prefix))) - (setq arg (1- arg))) - (if flag (forward-char 1))))) arg) - t)) - -;;; vi.el ends here diff --git a/lisp/emulation/vip.el b/lisp/emulation/vip.el deleted file mode 100644 index a8739f2350b..00000000000 --- a/lisp/emulation/vip.el +++ /dev/null @@ -1,3045 +0,0 @@ -;;; vip.el --- a VI Package for GNU Emacs - -;; Author: Masahiko Sato <ms@sail.stanford.edu> -;; Version: 3.5 -;; Keywords: emulations - -;; This file is part of GNU Emacs. - -;; 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 -;; the Free Software Foundation; either version 2, 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 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; A full-featured vi(1) emulator. -;; -;; In Japan, the author's address is: masahiko@sato.riec.tohoku.junet -;; -;; Send suggestions and bug reports to one of the above addresses. -;; When you report a bug, be sure to include the version number of VIP and -;; Emacs you are using. - -;; Execute info command by typing "M-x info" to get information on VIP. - -;;; Code: - -;; external variables - -(defvar vip-emacs-local-map nil - "Local map used in emacs mode. (Buffer-specific.)") - -(defvar vip-insert-local-map nil - "Local map used in insert command mode. (Buffer-specific.)") - -(make-variable-buffer-local 'vip-emacs-local-map) -(make-variable-buffer-local 'vip-insert-local-map) - -(defvar vip-insert-point nil - "Remember insert point as a marker. (Buffer-specific.)") - -(set-default 'vip-insert-point (make-marker)) -(make-variable-buffer-local 'vip-insert-point) - -(defvar vip-com-point nil - "Remember com point as a marker. (Buffer-specific.)") - -(set-default 'vip-com-point (make-marker)) -(make-variable-buffer-local 'vip-com-point) - -(defvar vip-current-mode nil - "Current mode. One of `emacs-mode', `vi-mode', `insert-mode'.") - -(make-variable-buffer-local 'vip-current-mode) -(setq-default vip-current-mode 'emacs-mode) - -(defvar vip-emacs-mode-line-buffer-identification nil - "Value of mode-line-buffer-identification in Emacs mode within vip.") -(make-variable-buffer-local 'vip-emacs-mode-line-buffer-identification) -(setq-default vip-emacs-mode-line-buffer-identification - '("Emacs: %17b")) - -(defvar vip-current-major-mode nil - "vip-current-major-mode is the major-mode vi considers it is now. -\(buffer specific\)") - -(make-variable-buffer-local 'vip-current-major-mode) - -(defvar vip-last-shell-com nil - "Last shell command executed by ! command.") - -(defvar vip-use-register nil - "Name of register to store deleted or yanked strings.") - -(defvar vip-d-com nil - "How to reexecute last destructive command. Value is list (M-COM VAL COM).") - -(defconst vip-shift-width 8 - "*The number of columns shifted by > and < command.") - -(defconst vip-re-replace nil - "*If t then do regexp replace, if nil then do string replace.") - -(defvar vip-d-char nil - "The character remembered by the vi \"r\" command.") - -(defvar vip-f-char nil - "For use by \";\" command.") - -(defvar vip-F-char nil - "For use by \".\" command.") - -(defvar vip-f-forward nil - "For use by \";\" command.") - -(defvar vip-f-offset nil - "For use by \";\" command.") - -(defconst vip-search-wrap-around t - "*if t, search wraps around.") - -(defconst vip-re-search nil - "*if t, search is reg-exp search, otherwise vanilla search.") - -(defvar vip-s-string nil - "Last vip search string.") - -(defvar vip-s-forward nil - "If t, search is forward.") - -(defconst vip-case-fold-search nil - "*If t, search ignores cases.") - -(defconst vip-re-query-replace nil - "*If t then do regexp replace, if nil then do string replace.") - -(defconst vip-open-with-indent nil - "*If t, indent when open a new line.") - -(defconst vip-help-in-insert-mode nil - "*If t then C-h is bound to help-command in insert mode. -If nil then it is bound to `delete-backward-char'.") - -(defvar vip-quote-string "> " - "String inserted at the beginning of region.") - -(defvar vip-tags-file-name "TAGS") - -(defvar vip-inhibit-startup-message nil) - -(defvar vip-startup-file (convert-standard-filename "~/.vip") - "Filename used as startup file for vip.") - -;; basic set up - -(global-set-key "\C-z" 'vip-change-mode-to-vi) - -(defmacro vip-loop (count body) - "(COUNT BODY) Execute BODY COUNT times." - (list 'let (list (list 'count count)) - (list 'while (list '> 'count 0) - body - (list 'setq 'count (list '1- 'count))))) - -(defun vip-push-mark-silent (&optional location) - "Set mark at LOCATION (point, by default) and push old mark on mark ring. -No message." - (if (null (mark t)) - nil - (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring)) - (if (> (length mark-ring) mark-ring-max) - (progn - (move-marker (car (nthcdr mark-ring-max mark-ring)) nil) - (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil)))) - (set-mark (or location (point)))) - -(defun vip-goto-col (arg) - "Go to ARG's column." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (save-excursion - (end-of-line) - (if (> val (1+ (current-column))) (error ""))) - (if com (move-marker vip-com-point (point))) - (beginning-of-line) - (forward-char (1- val)) - (if com (vip-execute-com 'vip-goto-col val com)))) - -(defun vip-copy-keymap (map) - (if (null map) (make-sparse-keymap) (copy-keymap map))) - - -;; changing mode - -(defun vip-change-mode (new-mode) - "Change mode to NEW-MODE---either emacs-mode, vi-mode, or insert-mode." - (or (eq new-mode vip-current-mode) - (progn - (cond ((eq new-mode 'vi-mode) - (if (eq vip-current-mode 'insert-mode) - (progn - (vip-copy-region-as-kill (point) vip-insert-point) - (vip-repeat-insert-command)) - (setq vip-emacs-local-map (current-local-map) - vip-emacs-mode-line-buffer-identification - mode-line-buffer-identification - vip-insert-local-map (vip-copy-keymap - (current-local-map)))) - (vip-change-mode-line "Vi: ") - (use-local-map vip-mode-map)) - ((eq new-mode 'insert-mode) - (move-marker vip-insert-point (point)) - (if (eq vip-current-mode 'emacs-mode) - (setq vip-emacs-local-map (current-local-map) - vip-emacs-mode-line-buffer-identification - mode-line-buffer-identification - vip-insert-local-map (vip-copy-keymap - (current-local-map))) - (setq vip-insert-local-map (vip-copy-keymap - vip-emacs-local-map))) - (vip-change-mode-line "Insert") - (use-local-map vip-insert-local-map) - (define-key vip-insert-local-map "\e" 'vip-change-mode-to-vi) - (define-key vip-insert-local-map "\C-z" 'vip-ESC) - (define-key vip-insert-local-map "\C-h" - (if vip-help-in-insert-mode 'help-command - 'delete-backward-char)) - (define-key vip-insert-local-map "\C-w" - 'vip-delete-backward-word)) - ((eq new-mode 'emacs-mode) - (vip-change-mode-line "Emacs:") - (use-local-map vip-emacs-local-map))) - (setq vip-current-mode new-mode) - (force-mode-line-update)))) - -(defun vip-copy-region-as-kill (beg end) - "If BEG and END do not belong to the same buffer, it copies empty region." - (condition-case nil - (copy-region-as-kill beg end) - (error (copy-region-as-kill beg beg)))) - -(defun vip-change-mode-line (string) - "Assuming that the mode line format contains the string \"Emacs:\", this -function replaces the string by \"Vi: \" etc." - (setq mode-line-buffer-identification - (if (string= string "Emacs:") - vip-emacs-mode-line-buffer-identification - (list (concat string " %17b"))))) - -;;;###autoload -(defun vip-mode () - "Turn on VIP emulation of VI." - (interactive) - (if (not vip-inhibit-startup-message) - (progn - (switch-to-buffer "VIP Startup Message") - (erase-buffer) - (insert - "VIP is a Vi emulation package for GNU Emacs. VIP provides most Vi commands -including Ex commands. VIP is however different from Vi in several points. -You can get more information on VIP by: - 1. Typing `M-x info' and selecting menu item \"vip\". - 2. Typing `C-h k' followed by a key whose description you want. - 3. Printing VIP manual which can be found as GNU/man/vip.texinfo - 4. Printing VIP Reference Card which can be found as GNU/etc/vipcard.tex - -This startup message appears whenever you load VIP unless you type `y' now. -Type `n' to quit this window for now.\n") - (goto-char (point-min)) - (if (y-or-n-p "Inhibit VIP startup message? ") - (progn - (save-excursion - (set-buffer - (find-file-noselect - (substitute-in-file-name vip-startup-file))) - (goto-char (point-max)) - (insert "\n(setq vip-inhibit-startup-message t)\n") - (save-buffer) - (kill-buffer (current-buffer))) - (message "VIP startup message inhibited.") - (sit-for 2))) - (kill-buffer (current-buffer)) - (message "") - (setq vip-inhibit-startup-message t))) - (vip-change-mode-to-vi)) - -(defun vip-change-mode-to-vi () - "Change mode to vi mode." - (interactive) - (vip-change-mode 'vi-mode)) - -(defun vip-change-mode-to-insert () - "Change mode to insert mode." - (interactive) - (vip-change-mode 'insert-mode)) - -(defun vip-change-mode-to-emacs () - "Change mode to emacs mode." - (interactive) - (vip-change-mode 'emacs-mode)) - - -;; escape to emacs mode temporarily - -(defun vip-escape-to-emacs (arg &optional events) - "Escape to Emacs mode for one Emacs command. -ARG is used as the prefix value for the executed command. If -EVENTS is a list of events, which become the beginning of the command." - (interactive "P") - (let (com key (old-map (current-local-map))) - (if events (setq unread-command-events events)) - (setq prefix-arg arg) - (use-local-map vip-emacs-local-map) - (unwind-protect - (setq com (key-binding (setq key (read-key-sequence nil)))) - (use-local-map old-map)) - (command-execute com prefix-arg) - (setq prefix-arg nil) ;; reset prefix arg - )) - -(defun vip-message-conditions (conditions) - "Print CONDITIONS as a message." - (let ((case (car conditions)) (msg (cdr conditions))) - (if (null msg) - (message "%s" case) - (message "%s %s" case (prin1-to-string msg))) - (ding))) - -(defun vip-ESC (arg) - "Emulate ESC key in Emacs mode." - (interactive "P") - (vip-escape-to-emacs arg '(?\e))) - -(defun vip-ctl-c (arg) - "Emulate C-c key in Emacs mode." - (interactive "P") - (vip-escape-to-emacs arg '(?\C-c))) - -(defun vip-ctl-x (arg) - "Emulate C-x key in Emacs mode." - (interactive "P") - (vip-escape-to-emacs arg '(?\C-x))) - -(defun vip-ctl-h (arg) - "Emulate C-h key in Emacs mode." - (interactive "P") - (vip-escape-to-emacs arg '(?\C-h))) - - -;; prefix argument for vi mode - -;; In vi mode, prefix argument is a dotted pair (NUM . COM) where NUM -;; represents the numeric value of the prefix argument and COM represents -;; command prefix such as "c", "d", "m" and "y". - -(defun vip-prefix-arg-value (char value com) - "Compute numeric prefix arg value. Invoked by CHAR. VALUE is the value -obtained so far, and COM is the command part obtained so far." - (while (and (>= char ?0) (<= char ?9)) - (setq value (+ (* (if (numberp value) value 0) 10) (- char ?0))) - (setq char (read-char))) - (setq prefix-arg value) - (if com (setq prefix-arg (cons prefix-arg com))) - (while (= char ?U) - (vip-describe-arg prefix-arg) - (setq char (read-char))) - (setq unread-command-events (list char))) - -(defun vip-prefix-arg-com (char value com) - "Vi operator as prefix argument." - (let ((cont t)) - (while (and cont - (or (= char ?c) (= char ?d) (= char ?y) - (= char ?!) (= char ?<) (= char ?>) (= char ?=) - (= char ?#) (= char ?r) (= char ?R) (= char ?\"))) - (if com - ;; this means that we already have a command character, so we - ;; construct a com list and exit while. however, if char is " - ;; it is an error. - (progn - ;; new com is (CHAR . OLDCOM) - (if (or (= char ?#) (= char ?\")) (error "")) - (setq com (cons char com)) - (setq cont nil)) - ;; if com is nil we set com as char, and read more. again, if char - ;; is ", we read the name of register and store it in vip-use-register. - ;; if char is !, =, or #, a complete com is formed so we exit while. - (cond ((or (= char ?!) (= char ?=)) - (setq com char) - (setq char (read-char)) - (setq cont nil)) - ((= char ?#) - ;; read a char and encode it as com - (setq com (+ 128 (read-char))) - (setq char (read-char)) - (setq cont nil)) - ((or (= char ?<) (= char ?>)) - (setq com char) - (setq char (read-char)) - (if (= com char) (setq com (cons char com))) - (setq cont nil)) - ((= char ?\") - (let ((reg (read-char))) - (if (or (and (<= ?A reg) (<= reg ?z)) - (and (<= ?1 reg) (<= reg ?9))) - (setq vip-use-register reg) - (error "")) - (setq char (read-char)))) - (t - (setq com char) - (setq char (read-char))))))) - (if (atom com) - ;; com is a single char, so we construct prefix-arg - ;; and if char is ?, describe prefix arg, otherwise exit by - ;; pushing the char back - (progn - (setq prefix-arg (cons value com)) - (while (= char ?U) - (vip-describe-arg prefix-arg) - (setq char (read-char))) - (setq unread-command-events (list char))) - ;; as com is non-nil, this means that we have a command to execute - (if (or (= (car com) ?r) (= (car com) ?R)) - ;; execute appropriate region command. - (let ((char (car com)) (com (cdr com))) - (setq prefix-arg (cons value com)) - (if (= char ?r) (vip-region prefix-arg) - (vip-Region prefix-arg)) - ;; reset prefix-arg - (setq prefix-arg nil)) - ;; otherwise, reset prefix arg and call appropriate command - (setq value (if (null value) 1 value)) - (setq prefix-arg nil) - (cond ((equal com '(?c . ?c)) (vip-line (cons value ?C))) - ((equal com '(?d . ?d)) (vip-line (cons value ?D))) - ((equal com '(?d . ?y)) (vip-yank-defun)) - ((equal com '(?y . ?y)) (vip-line (cons value ?Y))) - ((equal com '(?< . ?<)) (vip-line (cons value ?<))) - ((equal com '(?> . ?>)) (vip-line (cons value ?>))) - ((equal com '(?! . ?!)) (vip-line (cons value ?!))) - ((equal com '(?= . ?=)) (vip-line (cons value ?=))) - (t (error "")))))) - -(defun vip-describe-arg (arg) - (let (val com) - (setq val (vip-P-val arg) - com (vip-getcom arg)) - (if (null val) - (if (null com) - (message "Value is nil, and command is nil.") - (message "Value is nil, and command is %c." com)) - (if (null com) - (message "Value is %d, and command is nil." val) - (message "Value is %d, and command is %c." val com))))) - -(defun vip-digit-argument (arg) - "Begin numeric argument for the next command." - (interactive "P") - (vip-prefix-arg-value last-command-char nil - (if (consp arg) (cdr arg) nil))) - -(defun vip-command-argument (arg) - "Accept a motion command as an argument." - (interactive "P") - (condition-case conditions - (vip-prefix-arg-com - last-command-char - (cond ((null arg) nil) - ((consp arg) (car arg)) - ((numberp arg) arg) - (t (error "strange arg"))) - (cond ((null arg) nil) - ((consp arg) (cdr arg)) - ((numberp arg) nil) - (t (error "strange arg")))) - (quit - (setq vip-use-register nil) - (signal 'quit nil)))) - -(defun vip-p-val (arg) - "Get value part of prefix-argument ARG." - (cond ((null arg) 1) - ((consp arg) (if (null (car arg)) 1 (car arg))) - (t arg))) - -(defun vip-P-val (arg) - "Get value part of prefix-argument ARG." - (cond ((consp arg) (car arg)) - (t arg))) - -(defun vip-getcom (arg) - "Get com part of prefix-argument ARG." - (cond ((null arg) nil) - ((consp arg) (cdr arg)) - (t nil))) - -(defun vip-getCom (arg) - "Get com part of prefix-argument ARG and modify it." - (let ((com (vip-getcom arg))) - (cond ((equal com ?c) ?C) - ((equal com ?d) ?D) - ((equal com ?y) ?Y) - (t com)))) - - -;; repeat last destructive command - -(defun vip-append-to-register (reg start end) - "Append region to text in register REG. -START and END are buffer positions indicating what to append." - (set-register reg (concat (or (get-register reg) "") - (buffer-substring start end)))) - -(defun vip-execute-com (m-com val com) - "(M-COM VAL COM) Execute command COM. The list (M-COM VAL COM) is set -to vip-d-com for later use by vip-repeat" - (let ((reg vip-use-register)) - (if com - (cond ((= com ?c) (vip-change vip-com-point (point))) - ((= com (- ?c)) (vip-change-subr vip-com-point (point))) - ((or (= com ?C) (= com (- ?C))) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark) (point)) - (if vip-use-register - (progn - (cond ((and (<= ?a vip-use-register) - (<= vip-use-register ?z)) - (copy-to-register - vip-use-register (mark) (point) nil)) - ((and (<= ?A vip-use-register) - (<= vip-use-register ?Z)) - (vip-append-to-register - (+ vip-use-register 32) (mark) (point))) - (t (setq vip-use-register nil) - (error ""))) - (setq vip-use-register nil))) - (delete-region (mark) (point))) - (open-line 1) - (if (= com ?C) (vip-change-mode-to-insert) (yank))) - ((= com ?d) - (if vip-use-register - (progn - (cond ((and (<= ?a vip-use-register) - (<= vip-use-register ?z)) - (copy-to-register - vip-use-register vip-com-point (point) nil)) - ((and (<= ?A vip-use-register) - (<= vip-use-register ?Z)) - (vip-append-to-register - (+ vip-use-register 32) vip-com-point (point))) - (t (setq vip-use-register nil) - (error ""))) - (setq vip-use-register nil))) - (setq last-command - (if (eq last-command 'd-command) 'kill-region nil)) - (kill-region vip-com-point (point)) - (setq this-command 'd-command)) - ((= com ?D) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark) (point)) - (if vip-use-register - (progn - (cond ((and (<= ?a vip-use-register) - (<= vip-use-register ?z)) - (copy-to-register - vip-use-register (mark) (point) nil)) - ((and (<= ?A vip-use-register) - (<= vip-use-register ?Z)) - (vip-append-to-register - (+ vip-use-register 32) (mark) (point))) - (t (setq vip-use-register nil) - (error ""))) - (setq vip-use-register nil))) - (setq last-command - (if (eq last-command 'D-command) 'kill-region nil)) - (kill-region (mark) (point)) - (if (eq m-com 'vip-line) (setq this-command 'D-command))) - (back-to-indentation)) - ((= com ?y) - (if vip-use-register - (progn - (cond ((and (<= ?a vip-use-register) - (<= vip-use-register ?z)) - (copy-to-register - vip-use-register vip-com-point (point) nil)) - ((and (<= ?A vip-use-register) - (<= vip-use-register ?Z)) - (vip-append-to-register - (+ vip-use-register 32) vip-com-point (point))) - (t (setq vip-use-register nil) - (error ""))) - (setq vip-use-register nil))) - (setq last-command nil) - (copy-region-as-kill vip-com-point (point)) - (goto-char vip-com-point)) - ((= com ?Y) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark) (point)) - (if vip-use-register - (progn - (cond ((and (<= ?a vip-use-register) - (<= vip-use-register ?z)) - (copy-to-register - vip-use-register (mark) (point) nil)) - ((and (<= ?A vip-use-register) - (<= vip-use-register ?Z)) - (vip-append-to-register - (+ vip-use-register 32) (mark) (point))) - (t (setq vip-use-register nil) - (error ""))) - (setq vip-use-register nil))) - (setq last-command nil) - (copy-region-as-kill (mark) (point))) - (goto-char vip-com-point)) - ((or (= com ?!) (= com (- ?!))) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark) (point)) - (shell-command-on-region - (mark) (point) - (if (= com ?!) - (setq vip-last-shell-com (vip-read-string "!")) - vip-last-shell-com) - t))) - ((= com ?=) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark) (point)) - (if (> (mark) (point)) (exchange-point-and-mark)) - (indent-region (mark) (point) nil))) - ((= com ?<) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark) (point)) - (indent-rigidly (mark) (point) (- vip-shift-width))) - (goto-char vip-com-point)) - ((= com ?>) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark) (point)) - (indent-rigidly (mark) (point) vip-shift-width)) - (goto-char vip-com-point)) - ((>= com 128) - ;; this is special command # - (vip-special-prefix-com (- com 128))))) - (setq vip-d-com (list m-com val (if (or (= com ?c) (= com ?C) (= com ?!)) - (- com) com) - reg)))) - -(defun vip-repeat (arg) - "(ARG) Re-execute last destructive command. vip-d-com has the form -\(COM ARG CH REG), where COM is the command to be re-executed, ARG is the -argument for COM, CH is a flag for repeat, and REG is optional and if exists -is the name of the register for COM." - (interactive "P") - (if (eq last-command 'vip-undo) - ;; if the last command was vip-undo, then undo-more - (vip-undo-more) - ;; otherwise execute the command stored in vip-d-com. if arg is non-nil - ;; its prefix value is used as new prefix value for the command. - (let ((m-com (car vip-d-com)) - (val (vip-P-val arg)) - (com (car (cdr (cdr vip-d-com)))) - (reg (nth 3 vip-d-com))) - (if (null val) (setq val (car (cdr vip-d-com)))) - (if (null m-com) (error "No previous command to repeat.")) - (setq vip-use-register reg) - (funcall m-com (cons val com))))) - -(defun vip-special-prefix-com (char) - "This command is invoked interactively by the key sequence #<char>" - (cond ((= char ?c) - (downcase-region (min vip-com-point (point)) - (max vip-com-point (point)))) - ((= char ?C) - (upcase-region (min vip-com-point (point)) - (max vip-com-point (point)))) - ((= char ?g) - (set-mark vip-com-point) - (vip-global-execute)) - ((= char ?q) - (set-mark vip-com-point) - (vip-quote-region)) - ((= char ?s) (spell-region vip-com-point (point))))) - - -;; undoing - -(defun vip-undo () - "Undo previous change." - (interactive) - (message "undo!") - (undo-start) - (undo-more 2) - (setq this-command 'vip-undo)) - -(defun vip-undo-more () - "Continue undoing previous changes." - (message "undo more!") - (undo-more 1) - (setq this-command 'vip-undo)) - - -;; utilities - -(defun vip-string-tail (str) - (if (or (null str) (string= str "")) nil - (substring str 1))) - -(defun vip-yank-defun () - (mark-defun) - (copy-region-as-kill (point) (mark))) - -(defun vip-enlarge-region (beg end) - "Enlarge region between BEG and END." - (if (< beg end) - (progn (goto-char beg) (set-mark end)) - (goto-char end) - (set-mark beg)) - (beginning-of-line) - (exchange-point-and-mark) - (if (or (not (eobp)) (not (bolp))) (next-line 1)) - (beginning-of-line) - (if (> beg end) (exchange-point-and-mark))) - -(defun vip-global-execute () - "Call last keyboad macro for each line in the region." - (if (> (point) (mark)) (exchange-point-and-mark)) - (beginning-of-line) - (call-last-kbd-macro) - (while (< (point) (mark)) - (forward-line 1) - (beginning-of-line) - (call-last-kbd-macro))) - -(defun vip-quote-region () - "Quote region by inserting the user supplied string at the beginning of -each line in the region." - (setq vip-quote-string - (let ((str - (vip-read-string (format "quote string \(default \"%s\"\): " - vip-quote-string)))) - (if (string= str "") vip-quote-string str))) - (vip-enlarge-region (point) (mark)) - (if (> (point) (mark)) (exchange-point-and-mark)) - (insert vip-quote-string) - (beginning-of-line) - (forward-line 1) - (while (and (< (point) (mark)) (bolp)) - (insert vip-quote-string) - (beginning-of-line) - (forward-line 1))) - -(defun vip-end-with-a-newline-p (string) - "Check if the string ends with a newline." - (or (string= text "") - (= (aref string (1- (length string))) ?\n))) - -(defun vip-read-string (prompt &optional init) - (setq save-minibuffer-local-map (copy-keymap minibuffer-local-map)) - (define-key minibuffer-local-map "\C-h" 'backward-char) - (define-key minibuffer-local-map "\C-w" 'backward-word) - (define-key minibuffer-local-map "\e" 'exit-minibuffer) - (let (str) - (condition-case conditions - (setq str (read-string prompt init)) - (quit - (setq minibuffer-local-map save-minibuffer-local-map) - (signal 'quit nil))) - (setq minibuffer-local-map save-minibuffer-local-map) - str)) - - -;; insertion commands - -(defun vip-repeat-insert-command () - "This function is called when mode changes from insertion mode to -vi command mode. It will repeat the insertion command if original insertion -command was invoked with argument > 1." - (let ((i-com (car vip-d-com)) (val (car (cdr vip-d-com)))) - (if (and val (> val 1)) ;; first check that val is non-nil - (progn - (setq vip-d-com (list i-com (1- val) ?r)) - (vip-repeat nil) - (setq vip-d-com (list i-com val ?r)))))) - -(defun vip-insert (arg) "" - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (setq vip-d-com (list 'vip-insert val ?r)) - (if com (vip-loop val (yank)) - (vip-change-mode-to-insert)))) - -(defun vip-append (arg) - "Append after point." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (setq vip-d-com (list 'vip-append val ?r)) - (if (not (eolp)) (forward-char)) - (if (equal com ?r) - (vip-loop val (yank)) - (vip-change-mode-to-insert)))) - -(defun vip-Append (arg) - "Append at end of line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (setq vip-d-com (list 'vip-Append val ?r)) - (end-of-line) - (if (equal com ?r) - (vip-loop val (yank)) - (vip-change-mode-to-insert)))) - -(defun vip-Insert (arg) - "Insert before first non-white." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (setq vip-d-com (list 'vip-Insert val ?r)) - (back-to-indentation) - (if (equal com ?r) - (vip-loop val (yank)) - (vip-change-mode-to-insert)))) - -(defun vip-open-line (arg) - "Open line below." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (setq vip-d-com (list 'vip-open-line val ?r)) - (let ((col (current-indentation))) - (if (equal com ?r) - (vip-loop val - (progn - (end-of-line) - (newline 1) - (if vip-open-with-indent (indent-to col)) - (yank))) - (end-of-line) - (newline 1) - (if vip-open-with-indent (indent-to col)) - (vip-change-mode-to-insert))))) - -(defun vip-Open-line (arg) - "Open line above." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (setq vip-d-com (list 'vip-Open-line val ?r)) - (let ((col (current-indentation))) - (if (equal com ?r) - (vip-loop val - (progn - (beginning-of-line) - (open-line 1) - (if vip-open-with-indent (indent-to col)) - (yank))) - (beginning-of-line) - (open-line 1) - (if vip-open-with-indent (indent-to col)) - (vip-change-mode-to-insert))))) - -(defun vip-open-line-at-point (arg) - "Open line at point." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (setq vip-d-com (list 'vip-open-line-at-point val ?r)) - (if (equal com ?r) - (vip-loop val - (progn - (open-line 1) - (yank))) - (open-line 1) - (vip-change-mode-to-insert)))) - -(defun vip-substitute (arg) - "Substitute characters." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (save-excursion - (set-mark (point)) - (forward-char val) - (if (equal com ?r) - (vip-change-subr (mark) (point)) - (vip-change (mark) (point)))) - (setq vip-d-com (list 'vip-substitute val ?r)))) - -(defun vip-substitute-line (arg) - "Substitute lines." - (interactive "p") - (vip-line (cons arg ?C))) - - -;; line command - -(defun vip-line (arg) - (let ((val (car arg)) (com (cdr arg))) - (move-marker vip-com-point (point)) - (next-line (1- val)) - (vip-execute-com 'vip-line val com))) - -(defun vip-yank-line (arg) - "Yank ARG lines (in vi's sense)" - (interactive "P") - (let ((val (vip-p-val arg))) - (vip-line (cons val ?Y)))) - - -;; region command - -(defun vip-region (arg) - (interactive "P") - (let ((val (vip-P-val arg)) - (com (vip-getcom arg))) - (move-marker vip-com-point (point)) - (exchange-point-and-mark) - (vip-execute-com 'vip-region val com))) - -(defun vip-Region (arg) - (interactive "P") - (let ((val (vip-P-val arg)) - (com (vip-getCom arg))) - (move-marker vip-com-point (point)) - (exchange-point-and-mark) - (vip-execute-com 'vip-Region val com))) - -(defun vip-replace-char (arg) - "Replace the following ARG chars by the character read." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (setq vip-d-com (list 'vip-replace-char val ?r)) - (vip-replace-char-subr (if (equal com ?r) vip-d-char (read-char)) val))) - -(defun vip-replace-char-subr (char arg) - (delete-char arg t) - (setq vip-d-char char) - (vip-loop (if (> arg 0) arg (- arg)) (insert char)) - (backward-char arg)) - -(defun vip-replace-string () - "Replace string. If you supply null string as the string to be replaced, -the query replace mode will toggle between string replace and regexp replace." - (interactive) - (let (str) - (setq str (vip-read-string - (if vip-re-replace "Replace regexp: " "Replace string: "))) - (if (string= str "") - (progn - (setq vip-re-replace (not vip-re-replace)) - (message "Replace mode changed to %s." - (if vip-re-replace "regexp replace" - "string replace"))) - (if vip-re-replace - ;; (replace-regexp - ;; str - ;; (vip-read-string (format "Replace regexp \"%s\" with: " str))) - (while (re-search-forward str nil t) - (replace-match (vip-read-string - (format "Replace regexp \"%s\" with: " str)) - nil nil)) - (replace-string - str - (vip-read-string (format "Replace \"%s\" with: " str))))))) - - -;; basic cursor movement. j, k, l, m commands. - -(defun vip-forward-char (arg) - "Move point right ARG characters (left if ARG negative).On reaching end -of buffer, stop and signal error." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (forward-char val) - (if com (vip-execute-com 'vip-forward-char val com)))) - -(defun vip-backward-char (arg) - "Move point left ARG characters (right if ARG negative). On reaching -beginning of buffer, stop and signal error." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (backward-char val) - (if com (vip-execute-com 'vip-backward-char val com)))) - - -;; word command - -(defun vip-forward-word (arg) - "Forward word." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (forward-word val) - (skip-chars-forward " \t\n") - (if com - (progn - (if (or (= com ?c) (= com (- ?c))) - (progn (backward-word 1) (forward-word 1))) - (if (or (= com ?d) (= com ?y)) - (progn - (backward-word 1) - (forward-word 1) - (skip-chars-forward " \t"))) - (vip-execute-com 'vip-forward-word val com))))) - -(defun vip-end-of-word (arg) - "Move point to end of current word." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (forward-char) - (forward-word val) - (backward-char) - (if com - (progn - (forward-char) - (vip-execute-com 'vip-end-of-word val com))))) - -(defun vip-backward-word (arg) - "Backward word." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (backward-word val) - (if com (vip-execute-com 'vip-backward-word val com)))) - -(defun vip-forward-Word (arg) - "Forward word delimited by white character." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (re-search-forward "[^ \t\n]*[ \t\n]+" nil t val) - (if com - (progn - (if (or (= com ?c) (= com (- ?c))) - (progn (backward-word 1) (forward-word 1))) - (if (or (= com ?d) (= com ?y)) - (progn - (backward-word 1) - (forward-word 1) - (skip-chars-forward " \t"))) - (vip-execute-com 'vip-forward-Word val com))))) - -(defun vip-end-of-Word (arg) - "Move forward to end of word delimited by white character." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (forward-char) - (if (re-search-forward "[^ \t\n]+" nil t val) (backward-char)) - (if com - (progn - (forward-char) - (vip-execute-com 'vip-end-of-Word val com))))) - -(defun vip-backward-Word (arg) - "Backward word delimited by white character." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (if (re-search-backward "[ \t\n]+[^ \t\n]+" nil t val) - (forward-char) - (goto-char (point-min))) - (if com (vip-execute-com 'vip-backward-Word val com)))) - -(defun vip-beginning-of-line (arg) - "Go to beginning of line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (beginning-of-line val) - (if com (vip-execute-com 'vip-beginning-of-line val com)))) - -(defun vip-bol-and-skip-white (arg) - "Beginning of line at first non-white character." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (back-to-indentation) - (if com (vip-execute-com 'vip-bol-and-skip-white val com)))) - -(defun vip-goto-eol (arg) - "Go to end of line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (end-of-line val) - (if com (vip-execute-com 'vip-goto-eol val com)))) - -(defun vip-next-line (arg) - "Go to next line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (line-move val) - (setq this-command 'next-line) - (if com (vip-execute-com 'vip-next-line val com)))) - -(defun vip-next-line-at-bol (arg) - "Next line at beginning of line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (next-line val) - (back-to-indentation) - (if com (vip-execute-com 'vip-next-line-at-bol val com)))) - -(defun vip-previous-line (arg) - "Go to previous line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (next-line (- val)) - (setq this-command 'previous-line) - (if com (vip-execute-com 'vip-previous-line val com)))) - -(defun vip-previous-line-at-bol (arg) - "Previous line at beginning of line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (next-line (- val)) - (back-to-indentation) - (if com (vip-execute-com 'vip-previous-line val com)))) - -(defun vip-change-to-eol (arg) - "Change to end of line." - (interactive "P") - (vip-goto-eol (cons arg ?c))) - -(defun vip-kill-line (arg) - "Delete line." - (interactive "P") - (vip-goto-eol (cons arg ?d))) - - -;; moving around - -(defun vip-goto-line (arg) - "Go to ARG's line. Without ARG go to end of buffer." - (interactive "P") - (let ((val (vip-P-val arg)) (com (vip-getCom arg))) - (move-marker vip-com-point (point)) - (set-mark (point)) - (if (null val) - (goto-char (point-max)) - (goto-char (point-min)) - (forward-line (1- val))) - (back-to-indentation) - (if com (vip-execute-com 'vip-goto-line val com)))) - -(defun vip-find-char (arg char forward offset) - "Find ARG's occurrence of CHAR on the current line. If FORWARD then -search is forward, otherwise backward. OFFSET is used to adjust point -after search." - (let ((arg (if forward arg (- arg))) point) - (save-excursion - (save-restriction - (if (> arg 0) - (narrow-to-region - ;; forward search begins here - (if (eolp) (error "") (point)) - ;; forward search ends here - (progn (next-line 1) (beginning-of-line) (point))) - (narrow-to-region - ;; backward search begins from here - (if (bolp) (error "") (point)) - ;; backward search ends here - (progn (beginning-of-line) (point)))) - ;; if arg > 0, point is forwarded before search. - (if (> arg 0) (goto-char (1+ (point-min))) - (goto-char (point-max))) - (let ((case-fold-search nil)) - (search-forward (char-to-string char) nil 0 arg)) - (setq point (point)) - (if (or (and (> arg 0) (= point (point-max))) - (and (< arg 0) (= point (point-min)))) - (error "")))) - (goto-char (+ point (if (> arg 0) (if offset -2 -1) (if offset 1 0)))))) - -(defun vip-find-char-forward (arg) - "Find char on the line. If called interactively read the char to find -from the terminal, and if called from vip-repeat, the char last used is -used. This behaviour is controlled by the sign of prefix numeric value." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if (> val 0) - ;; this means that the function was called interactively - (setq vip-f-char (read-char) - vip-f-forward t - vip-f-offset nil) - (setq val (- val))) - (if com (move-marker vip-com-point (point))) - (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t nil) - (setq val (- val)) - (if com - (progn - (setq vip-F-char vip-f-char);; set new vip-F-char - (forward-char) - (vip-execute-com 'vip-find-char-forward val com))))) - -(defun vip-goto-char-forward (arg) - "Go up to char ARG forward on line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if (> val 0) - ;; this means that the function was called interactively - (setq vip-f-char (read-char) - vip-f-forward t - vip-f-offset t) - (setq val (- val))) - (if com (move-marker vip-com-point (point))) - (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t t) - (setq val (- val)) - (if com - (progn - (setq vip-F-char vip-f-char);; set new vip-F-char - (forward-char) - (vip-execute-com 'vip-goto-char-forward val com))))) - -(defun vip-find-char-backward (arg) - "Find char ARG on line backward." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if (> val 0) - ;; this means that the function was called interactively - (setq vip-f-char (read-char) - vip-f-forward nil - vip-f-offset nil) - (setq val (- val))) - (if com (move-marker vip-com-point (point))) - (vip-find-char - val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil nil) - (setq val (- val)) - (if com - (progn - (setq vip-F-char vip-f-char);; set new vip-F-char - (vip-execute-com 'vip-find-char-backward val com))))) - -(defun vip-goto-char-backward (arg) - "Go up to char ARG backward on line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if (> val 0) - ;; this means that the function was called interactively - (setq vip-f-char (read-char) - vip-f-forward nil - vip-f-offset t) - (setq val (- val))) - (if com (move-marker vip-com-point (point))) - (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil t) - (setq val (- val)) - (if com - (progn - (setq vip-F-char vip-f-char);; set new vip-F-char - (vip-execute-com 'vip-goto-char-backward val com))))) - -(defun vip-repeat-find (arg) - "Repeat previous find command." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (vip-find-char val vip-f-char vip-f-forward vip-f-offset) - (if com - (progn - (if vip-f-forward (forward-char)) - (vip-execute-com 'vip-repeat-find val com))))) - -(defun vip-repeat-find-opposite (arg) - "Repeat previous find command in the opposite direction." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (vip-find-char val vip-f-char (not vip-f-forward) vip-f-offset) - (if com - (progn - (if vip-f-forward (forward-char)) - (vip-execute-com 'vip-repeat-find-opposite val com))))) - - -;; window scrolling etc. - -(defun vip-other-window (arg) - "Switch to other window." - (interactive "p") - (other-window arg) - (or (not (eq vip-current-mode 'emacs-mode)) - (string= (buffer-name (current-buffer)) " *Minibuf-1*") - (vip-change-mode-to-vi))) - -(defun vip-window-top (arg) - "Go to home window line." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (move-to-window-line (1- val)) - (if com (vip-execute-com 'vip-window-top val com)))) - -(defun vip-window-middle (arg) - "Go to middle window line." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (move-to-window-line (+ (/ (1- (window-height)) 2) (1- val))) - (if com (vip-execute-com 'vip-window-middle val com)))) - -(defun vip-window-bottom (arg) - "Go to last window line." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (move-to-window-line (- val)) - (if com (vip-execute-com 'vip-window-bottom val com)))) - -(defun vip-line-to-top (arg) - "Put current line on the home line." - (interactive "p") - (recenter (1- arg))) - -(defun vip-line-to-middle (arg) - "Put current line on the middle line." - (interactive "p") - (recenter (+ (1- arg) (/ (1- (window-height)) 2)))) - -(defun vip-line-to-bottom (arg) - "Put current line on the last line." - (interactive "p") - (recenter (- (window-height) (1+ arg)))) - - -;; paren match - -(defun vip-paren-match (arg) - "Go to the matching parenthesis." - (interactive "P") - (let ((com (vip-getcom arg))) - (if (numberp arg) - (if (or (> arg 99) (< arg 1)) - (error "Prefix must be between 1 and 99.") - (goto-char - (if (> (point-max) 80000) - (* (/ (point-max) 100) arg) - (/ (* (point-max) arg) 100))) - (back-to-indentation)) - (cond ((looking-at "[\(\[{]") - (if com (move-marker vip-com-point (point))) - (forward-sexp 1) - (if com - (vip-execute-com 'vip-paren-match nil com) - (backward-char))) - ((looking-at "[])}]") - (forward-char) - (if com (move-marker vip-com-point (point))) - (backward-sexp 1) - (if com (vip-execute-com 'vip-paren-match nil com))) - (t (error "")))))) - - -;; sentence and paragraph - -(defun vip-forward-sentence (arg) - "Forward sentence." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (forward-sentence val) - (if com (vip-execute-com 'vip-forward-sentence nil com)))) - -(defun vip-backward-sentence (arg) - "Backward sentence." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (backward-sentence val) - (if com (vip-execute-com 'vip-backward-sentence nil com)))) - -(defun vip-forward-paragraph (arg) - "Forward paragraph." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (forward-paragraph val) - (if com (vip-execute-com 'vip-forward-paragraph nil com)))) - -(defun vip-backward-paragraph (arg) - "Backward paragraph." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (backward-paragraph val) - (if com (vip-execute-com 'vip-backward-paragraph nil com)))) - - -;; scrolling - -(defun vip-scroll (arg) - "Scroll to next screen." - (interactive "p") - (if (> arg 0) - (while (> arg 0) - (scroll-up) - (setq arg (1- arg))) - (while (> 0 arg) - (scroll-down) - (setq arg (1+ arg))))) - -(defun vip-scroll-back (arg) - "Scroll to previous screen." - (interactive "p") - (vip-scroll (- arg))) - -(defun vip-scroll-down (arg) - "Scroll up half screen." - (interactive "P") - (if (null arg) (scroll-down (/ (window-height) 2)) - (scroll-down arg))) - -(defun vip-scroll-down-one (arg) - "Scroll up one line." - (interactive "p") - (scroll-down arg)) - -(defun vip-scroll-up (arg) - "Scroll down half screen." - (interactive "P") - (if (null arg) (scroll-up (/ (window-height) 2)) - (scroll-up arg))) - -(defun vip-scroll-up-one (arg) - "Scroll down one line." - (interactive "p") - (scroll-up arg)) - - -;; splitting window - -(defun vip-buffer-in-two-windows () - "Show current buffer in two windows." - (interactive) - (delete-other-windows) - (split-window-vertically nil)) - - -;; searching - -(defun vip-search-forward (arg) - "Search a string forward. ARG is used to find the ARG's occurrence -of the string. Default is vanilla search. Search mode can be toggled by -giving null search string." - (interactive "P") - (let ((val (vip-P-val arg)) (com (vip-getcom arg))) - (setq vip-s-forward t - vip-s-string (vip-read-string (if vip-re-search "RE-/" "/"))) - (if (string= vip-s-string "") - (progn - (setq vip-re-search (not vip-re-search)) - (message "Search mode changed to %s search." - (if vip-re-search "regular expression" - "vanilla"))) - (vip-search vip-s-string t val) - (if com - (progn - (move-marker vip-com-point (mark)) - (vip-execute-com 'vip-search-next val com)))))) - -(defun vip-search-backward (arg) - "Search a string backward. ARG is used to find the ARG's occurrence -of the string. Default is vanilla search. Search mode can be toggled by -giving null search string." - (interactive "P") - (let ((val (vip-P-val arg)) (com (vip-getcom arg))) - (setq vip-s-forward nil - vip-s-string (vip-read-string (if vip-re-search "RE-?" "?"))) - (if (string= vip-s-string "") - (progn - (setq vip-re-search (not vip-re-search)) - (message "Search mode changed to %s search." - (if vip-re-search "regular expression" - "vanilla"))) - (vip-search vip-s-string nil val) - (if com - (progn - (move-marker vip-com-point (mark)) - (vip-execute-com 'vip-search-next val com)))))) - -(defun vip-search (string forward arg &optional no-offset init-point) - "(STRING FORWARD COUNT &optional NO-OFFSET) Search COUNT's occurrence of -STRING. Search will be forward if FORWARD, otherwise backward." - (let ((val (vip-p-val arg)) (com (vip-getcom arg)) - (null-arg (null (vip-P-val arg))) (offset (not no-offset)) - (case-fold-search vip-case-fold-search) - (start-point (or init-point (point)))) - (if forward - (condition-case conditions - (progn - (if (and offset (not (eobp))) (forward-char)) - (if vip-re-search - (progn - (re-search-forward string nil nil val) - (re-search-backward string)) - (search-forward string nil nil val) - (search-backward string)) - (push-mark start-point)) - (search-failed - (if (and null-arg vip-search-wrap-around) - (progn - (goto-char (point-min)) - (vip-search string forward (cons 1 com) t start-point)) - (goto-char start-point) - (signal 'search-failed (cdr conditions))))) - (condition-case conditions - (progn - (if vip-re-search - (re-search-backward string nil nil val) - (search-backward string nil nil val)) - (push-mark start-point)) - (search-failed - (if (and null-arg vip-search-wrap-around) - (progn - (goto-char (point-max)) - (vip-search string forward (cons 1 com) t start-point)) - (goto-char start-point) - (signal 'search-failed (cdr conditions)))))))) - -(defun vip-search-next (arg) - "Repeat previous search." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if (null vip-s-string) (error "No previous search string.")) - (vip-search vip-s-string vip-s-forward arg) - (if com (vip-execute-com 'vip-search-next val com)))) - -(defun vip-search-Next (arg) - "Repeat previous search in the reverse direction." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if (null vip-s-string) (error "No previous search string.")) - (vip-search vip-s-string (not vip-s-forward) arg) - (if com (vip-execute-com 'vip-search-Next val com)))) - - -;; visiting and killing files, buffers - -(defun vip-switch-to-buffer () - "Switch to buffer in the current window." - (interactive) - (let (buffer) - (setq buffer - (read-buffer - (format "switch to buffer \(%s\): " - (buffer-name (other-buffer (current-buffer)))))) - (switch-to-buffer buffer) - (vip-change-mode-to-vi))) - -(defun vip-switch-to-buffer-other-window () - "Switch to buffer in another window." - (interactive) - (let (buffer) - (setq buffer - (read-buffer - (format "Switch to buffer \(%s\): " - (buffer-name (other-buffer (current-buffer)))))) - (switch-to-buffer-other-window buffer) - (vip-change-mode-to-vi))) - -(defun vip-kill-buffer () - "Kill a buffer." - (interactive) - (let (buffer buffer-name) - (setq buffer-name - (read-buffer - (format "Kill buffer \(%s\): " - (buffer-name (current-buffer))))) - (setq buffer - (if (null buffer-name) - (current-buffer) - (get-buffer buffer-name))) - (if (null buffer) (error "Buffer %s nonexistent." buffer-name)) - (if (or (not (buffer-modified-p buffer)) - (y-or-n-p "Buffer is modified, are you sure? ")) - (kill-buffer buffer) - (error "Buffer not killed.")))) - -(defun vip-find-file () - "Visit file in the current window." - (interactive) - (let (file) - (setq file (read-file-name "visit file: ")) - (switch-to-buffer (find-file-noselect file)) - (vip-change-mode-to-vi))) - -(defun vip-find-file-other-window () - "Visit file in another window." - (interactive) - (let (file) - (setq file (read-file-name "Visit file: ")) - (switch-to-buffer-other-window (find-file-noselect file)) - (vip-change-mode-to-vi))) - -(defun vip-info-on-file () - "Give information of the file associated to the current buffer." - (interactive) - (message "\"%s\" line %d of %d" - (if (buffer-file-name) (buffer-file-name) "") - (1+ (count-lines (point-min) (point))) - (1+ (count-lines (point-min) (point-max))))) - - -;; yank and pop - -(defun vip-yank (text) - "yank TEXT silently." - (save-excursion - (vip-push-mark-silent (point)) - (insert text) - (exchange-point-and-mark)) - (skip-chars-forward " \t")) - -(defun vip-put-back (arg) - "Put back after point/below line." - (interactive "P") - (let ((val (vip-p-val arg)) - (text (if vip-use-register - (if (and (<= ?1 vip-use-register) (<= vip-use-register ?9)) - (current-kill (- vip-use-register ?1) 'do-not-rotate) - (get-register vip-use-register)) - (current-kill 0)))) - (if (null text) - (if vip-use-register - (let ((reg vip-use-register)) - (setq vip-use-register nil) - (error "Nothing in register %c" reg)) - (error ""))) - (setq vip-use-register nil) - (if (vip-end-with-a-newline-p text) - (progn - (next-line 1) - (beginning-of-line)) - (if (and (not (eolp)) (not (eobp))) (forward-char))) - (setq vip-d-com (list 'vip-put-back val nil vip-use-register)) - (vip-loop val (vip-yank text)))) - -(defun vip-Put-back (arg) - "Put back at point/above line." - (interactive "P") - (let ((val (vip-p-val arg)) - (text (if vip-use-register - (if (and (<= ?1 vip-use-register) (<= vip-use-register ?9)) - (current-kill (- vip-use-register ?1) 'do-not-rotate) - (get-register vip-use-register)) - (current-kill 0)))) - (if (null text) - (if vip-use-register - (let ((reg vip-use-register)) - (setq vip-use-register nil) - (error "Nothing in register %c" reg)) - (error ""))) - (setq vip-use-register nil) - (if (vip-end-with-a-newline-p text) (beginning-of-line)) - (setq vip-d-com (list 'vip-Put-back val nil vip-use-register)) - (vip-loop val (vip-yank text)))) - -(defun vip-delete-char (arg) - "Delete character." - (interactive "P") - (let ((val (vip-p-val arg))) - (setq vip-d-com (list 'vip-delete-char val nil)) - (if vip-use-register - (progn - (if (and (<= ?A vip-use-register) (<= vip-use-register ?Z)) - (vip-append-to-register - (+ vip-use-register 32) (point) (- (point) val)) - (copy-to-register vip-use-register (point) (- (point) val) nil)) - (setq vip-use-register nil))) - (delete-char val t))) - -(defun vip-delete-backward-char (arg) - "Delete previous character." - (interactive "P") - (let ((val (vip-p-val arg))) - (setq vip-d-com (list 'vip-delete-backward-char val nil)) - (if vip-use-register - (progn - (if (and (<= ?A vip-use-register) (<= vip-use-register ?Z)) - (vip-append-to-register - (+ vip-use-register 32) (point) (+ (point) val)) - (copy-to-register vip-use-register (point) (+ (point) val) nil)) - (setq vip-use-register nil))) - (delete-backward-char val t))) - - -;; join lines. - -(defun vip-join-lines (arg) - "Join this line to next, if ARG is nil. Otherwise, join ARG lines" - (interactive "*P") - (let ((val (vip-P-val arg))) - (setq vip-d-com (list 'vip-join-lines val nil)) - (vip-loop (if (null val) 1 (1- val)) - (progn - (end-of-line) - (if (not (eobp)) - (progn - (forward-line 1) - (delete-region (point) (1- (point))) - (fixup-whitespace))))))) - - -;; making small changes - -(defun vip-change (beg end) - (setq c-string - (vip-read-string (format "%s => " (buffer-substring beg end)))) - (vip-change-subr beg end)) - -(defun vip-change-subr (beg end) - (if vip-use-register - (progn - (copy-to-register vip-use-register beg end nil) - (setq vip-use-register nil))) - (kill-region beg end) - (setq this-command 'vip-change) - (insert c-string)) - - -;; query replace - -(defun vip-query-replace () - "Query replace. If you supply null string as the string to be replaced, -the query replace mode will toggle between string replace and regexp replace." - (interactive) - (let (str) - (setq str (vip-read-string - (if vip-re-query-replace "Query replace regexp: " - "Query replace: "))) - (if (string= str "") - (progn - (setq vip-re-query-replace (not vip-re-query-replace)) - (message "Query replace mode changed to %s." - (if vip-re-query-replace "regexp replace" - "string replace"))) - (if vip-re-query-replace - (query-replace-regexp - str - (vip-read-string (format "Query replace regexp \"%s\" with: " str))) - (query-replace - str - (vip-read-string (format "Query replace \"%s\" with: " str))))))) - - -;; marking - -(defun vip-mark-beginning-of-buffer () - (interactive) - (set-mark (point)) - (goto-char (point-min)) - (exchange-point-and-mark) - (message "mark set at the beginning of buffer")) - -(defun vip-mark-end-of-buffer () - (interactive) - (set-mark (point)) - (goto-char (point-max)) - (exchange-point-and-mark) - (message "mark set at the end of buffer")) - -(defun vip-mark-point (char) - (interactive "c") - (cond ((and (<= ?a char) (<= char ?z)) - (point-to-register (- char (- ?a ?\C-a)) nil)) - ((= char ?<) (vip-mark-beginning-of-buffer)) - ((= char ?>) (vip-mark-end-of-buffer)) - ((= char ?.) (push-mark)) - ((= char ?,) (set-mark-command 1)) - ((= char ?D) (mark-defun)) - (t (error "")))) - -(defun vip-goto-mark (arg) - "Go to mark." - (interactive "P") - (let ((char (read-char)) (com (vip-getcom arg))) - (vip-goto-mark-subr char com nil))) - -(defun vip-goto-mark-and-skip-white (arg) - "Go to mark and skip to first non-white on line." - (interactive "P") - (let ((char (read-char)) (com (vip-getCom arg))) - (vip-goto-mark-subr char com t))) - -(defun vip-goto-mark-subr (char com skip-white) - (cond ((and (<= ?a char) (<= char ?z)) - (let ((buff (current-buffer))) - (if com (move-marker vip-com-point (point))) - (goto-char (register-to-point (- char (- ?a ?\C-a)))) - (if skip-white (back-to-indentation)) - (vip-change-mode-to-vi) - (if com - (if (equal buff (current-buffer)) - (vip-execute-com (if skip-white - 'vip-goto-mark-and-skip-white - 'vip-goto-mark) - nil com) - (switch-to-buffer buff) - (goto-char vip-com-point) - (vip-change-mode-to-vi) - (error ""))))) - ((and (not skip-white) (= char ?`)) - (if com (move-marker vip-com-point (point))) - (exchange-point-and-mark) - (if com (vip-execute-com 'vip-goto-mark nil com))) - ((and skip-white (= char ?')) - (if com (move-marker vip-com-point (point))) - (exchange-point-and-mark) - (back-to-indentation) - (if com (vip-execute-com 'vip-goto-mark-and-skip-white nil com))) - (t (error "")))) - -(defun vip-exchange-point-and-mark () - (interactive) - (exchange-point-and-mark) - (back-to-indentation)) - -(defun vip-keyboard-quit () - "Abort partially formed or running command." - (interactive) - (setq vip-use-register nil) - (keyboard-quit)) - -(defun vip-ctl-c-equivalent (arg) - "Emulate C-c in Emacs mode." - (interactive "P") - (vip-ctl-key-equivalent "\C-c" arg)) - -(defun vip-ctl-x-equivalent (arg) - "Emulate C-x in Emacs mode." - (interactive "P") - (vip-ctl-key-equivalent "\C-x" arg)) - -(defun vip-ctl-key-equivalent (key arg) - (let ((char (read-char))) - (if (and (<= ?A char) (<= char ?Z)) - (setq char (- char (- ?A ?\C-a)))) - (vip-escape-to-emacs arg (list (aref key 0) char)))) - -;; commands in insertion mode - -(defun vip-delete-backward-word (arg) - "Delete previous word." - (interactive "p") - (save-excursion - (set-mark (point)) - (backward-word arg) - (delete-region (point) (mark)))) - - -;; key bindings - -(set 'vip-mode-map (make-keymap)) - -(define-key vip-mode-map "\C-a" 'beginning-of-line) -(define-key vip-mode-map "\C-b" 'vip-scroll-back) -(define-key vip-mode-map "\C-c" 'vip-ctl-c) -(define-key vip-mode-map "\C-d" 'vip-scroll-up) -(define-key vip-mode-map "\C-e" 'vip-scroll-up-one) -(define-key vip-mode-map "\C-f" 'vip-scroll) -(define-key vip-mode-map "\C-g" 'vip-keyboard-quit) -(define-key vip-mode-map "\C-h" 'help-command) -(define-key vip-mode-map "\C-m" 'vip-scroll-back) -(define-key vip-mode-map "\C-n" 'vip-other-window) -(define-key vip-mode-map "\C-o" 'vip-open-line-at-point) -(define-key vip-mode-map "\C-u" 'vip-scroll-down) -(define-key vip-mode-map "\C-x" 'vip-ctl-x) -(define-key vip-mode-map "\C-y" 'vip-scroll-down-one) -(define-key vip-mode-map "\C-z" 'vip-change-mode-to-emacs) -(define-key vip-mode-map "\e" 'vip-ESC) - -(define-key vip-mode-map " " 'vip-scroll) -(define-key vip-mode-map "!" 'vip-command-argument) -(define-key vip-mode-map "\"" 'vip-command-argument) -(define-key vip-mode-map "#" 'vip-command-argument) -(define-key vip-mode-map "$" 'vip-goto-eol) -(define-key vip-mode-map "%" 'vip-paren-match) -(define-key vip-mode-map "&" 'vip-nil) -(define-key vip-mode-map "'" 'vip-goto-mark-and-skip-white) -(define-key vip-mode-map "(" 'vip-backward-sentence) -(define-key vip-mode-map ")" 'vip-forward-sentence) -(define-key vip-mode-map "*" 'call-last-kbd-macro) -(define-key vip-mode-map "+" 'vip-next-line-at-bol) -(define-key vip-mode-map "," 'vip-repeat-find-opposite) -(define-key vip-mode-map "-" 'vip-previous-line-at-bol) -(define-key vip-mode-map "." 'vip-repeat) -(define-key vip-mode-map "/" 'vip-search-forward) - -(define-key vip-mode-map "0" 'vip-beginning-of-line) -(define-key vip-mode-map "1" 'vip-digit-argument) -(define-key vip-mode-map "2" 'vip-digit-argument) -(define-key vip-mode-map "3" 'vip-digit-argument) -(define-key vip-mode-map "4" 'vip-digit-argument) -(define-key vip-mode-map "5" 'vip-digit-argument) -(define-key vip-mode-map "6" 'vip-digit-argument) -(define-key vip-mode-map "7" 'vip-digit-argument) -(define-key vip-mode-map "8" 'vip-digit-argument) -(define-key vip-mode-map "9" 'vip-digit-argument) - -(define-key vip-mode-map ":" 'vip-ex) -(define-key vip-mode-map ";" 'vip-repeat-find) -(define-key vip-mode-map "<" 'vip-command-argument) -(define-key vip-mode-map "=" 'vip-command-argument) -(define-key vip-mode-map ">" 'vip-command-argument) -(define-key vip-mode-map "?" 'vip-search-backward) -(define-key vip-mode-map "@" 'vip-nil) - -(define-key vip-mode-map "A" 'vip-Append) -(define-key vip-mode-map "B" 'vip-backward-Word) -(define-key vip-mode-map "C" 'vip-ctl-c-equivalent) -(define-key vip-mode-map "D" 'vip-kill-line) -(define-key vip-mode-map "E" 'vip-end-of-Word) -(define-key vip-mode-map "F" 'vip-find-char-backward) -(define-key vip-mode-map "G" 'vip-goto-line) -(define-key vip-mode-map "H" 'vip-window-top) -(define-key vip-mode-map "I" 'vip-Insert) -(define-key vip-mode-map "J" 'vip-join-lines) -(define-key vip-mode-map "K" 'vip-kill-buffer) -(define-key vip-mode-map "L" 'vip-window-bottom) -(define-key vip-mode-map "M" 'vip-window-middle) -(define-key vip-mode-map "N" 'vip-search-Next) -(define-key vip-mode-map "O" 'vip-Open-line) -(define-key vip-mode-map "P" 'vip-Put-back) -(define-key vip-mode-map "Q" 'vip-query-replace) -(define-key vip-mode-map "R" 'vip-replace-string) -(define-key vip-mode-map "S" 'vip-switch-to-buffer-other-window) -(define-key vip-mode-map "T" 'vip-goto-char-backward) -(define-key vip-mode-map "U" 'vip-nil) -(define-key vip-mode-map "V" 'vip-find-file-other-window) -(define-key vip-mode-map "W" 'vip-forward-Word) -(define-key vip-mode-map "X" 'vip-ctl-x-equivalent) -(define-key vip-mode-map "Y" 'vip-yank-line) -(define-key vip-mode-map "ZZ" 'save-buffers-kill-emacs) - -(define-key vip-mode-map "[" 'vip-nil) -(define-key vip-mode-map "\\" 'vip-escape-to-emacs) -(define-key vip-mode-map "]" 'vip-nil) -(define-key vip-mode-map "^" 'vip-bol-and-skip-white) -(define-key vip-mode-map "_" 'vip-nil) -(define-key vip-mode-map "`" 'vip-goto-mark) - -(define-key vip-mode-map "a" 'vip-append) -(define-key vip-mode-map "b" 'vip-backward-word) -(define-key vip-mode-map "c" 'vip-command-argument) -(define-key vip-mode-map "d" 'vip-command-argument) -(define-key vip-mode-map "e" 'vip-end-of-word) -(define-key vip-mode-map "f" 'vip-find-char-forward) -(define-key vip-mode-map "g" 'vip-info-on-file) -(define-key vip-mode-map "h" 'vip-backward-char) -(define-key vip-mode-map "i" 'vip-insert) -(define-key vip-mode-map "j" 'vip-next-line) -(define-key vip-mode-map "k" 'vip-previous-line) -(define-key vip-mode-map "l" 'vip-forward-char) -(define-key vip-mode-map "m" 'vip-mark-point) -(define-key vip-mode-map "n" 'vip-search-next) -(define-key vip-mode-map "o" 'vip-open-line) -(define-key vip-mode-map "p" 'vip-put-back) -(define-key vip-mode-map "q" 'vip-nil) -(define-key vip-mode-map "r" 'vip-replace-char) -(define-key vip-mode-map "s" 'vip-switch-to-buffer) -(define-key vip-mode-map "t" 'vip-goto-char-forward) -(define-key vip-mode-map "u" 'vip-undo) -(define-key vip-mode-map "v" 'vip-find-file) -(define-key vip-mode-map "w" 'vip-forward-word) -(define-key vip-mode-map "x" 'vip-delete-char) -(define-key vip-mode-map "y" 'vip-command-argument) -(define-key vip-mode-map "zH" 'vip-line-to-top) -(define-key vip-mode-map "zM" 'vip-line-to-middle) -(define-key vip-mode-map "zL" 'vip-line-to-bottom) -(define-key vip-mode-map "z\C-m" 'vip-line-to-top) -(define-key vip-mode-map "z." 'vip-line-to-middle) -(define-key vip-mode-map "z-" 'vip-line-to-bottom) - -(define-key vip-mode-map "{" 'vip-backward-paragraph) -(define-key vip-mode-map "|" 'vip-goto-col) -(define-key vip-mode-map "}" 'vip-forward-paragraph) -(define-key vip-mode-map "~" 'vip-nil) -(define-key vip-mode-map "\177" 'vip-delete-backward-char) - -(define-key ctl-x-map "3" 'vip-buffer-in-two-windows) -(define-key ctl-x-map "\C-i" 'insert-file) - -(defun vip-version () - (interactive) - (message "VIP version 3.5 of September 15, 1987")) - - -;; implement ex commands - -(defvar ex-token-type nil - "type of token. if non-nil, gives type of address. if nil, it -is a command.") - -(defvar ex-token nil - "value of token.") - -(defvar ex-addresses nil - "list of ex addresses") - -(defvar ex-flag nil - "flag for ex flag") - -(defvar ex-buffer nil - "name of ex buffer") - -(defvar ex-count nil - "value of ex count") - -(defvar ex-g-flag nil - "flag for global command") - -(defvar ex-g-variant nil - "if t global command is executed on lines not matching ex-g-pat") - -(defvar ex-reg-exp nil - "save reg-exp used in substitute") - -(defvar ex-repl nil - "replace pattern for substitute") - -(defvar ex-g-pat nil - "pattern for global command") - -(defvar ex-map (make-sparse-keymap) - "save commands for mapped keys") - -(defvar ex-tag nil - "save ex tag") - -(defvar ex-file nil) - -(defvar ex-variant nil) - -(defvar ex-offset nil) - -(defvar ex-append nil) - -(defun vip-nil () - (interactive) - (error "")) - -(defun vip-looking-back (str) - "returns t if looking back reg-exp STR before point." - (and (save-excursion (re-search-backward str nil t)) - (= (point) (match-end 0)))) - -(defun vip-check-sub (str) - "check if ex-token is an initial segment of STR" - (let ((length (length ex-token))) - (if (and (<= length (length str)) - (string= ex-token (substring str 0 length))) - (setq ex-token str) - (setq ex-token-type "non-command")))) - -(defun vip-get-ex-com-subr () - "get a complete ex command" - (set-mark (point)) - (re-search-forward "[a-z][a-z]*") - (setq ex-token-type "command") - (setq ex-token (buffer-substring (point) (mark))) - (exchange-point-and-mark) - (cond ((looking-at "a") - (cond ((looking-at "ab") (vip-check-sub "abbreviate")) - ((looking-at "ar") (vip-check-sub "args")) - (t (vip-check-sub "append")))) - ((looking-at "[bh]") (setq ex-token-type "non-command")) - ((looking-at "c") - (if (looking-at "co") (vip-check-sub "copy") - (vip-check-sub "change"))) - ((looking-at "d") (vip-check-sub "delete")) - ((looking-at "e") - (if (looking-at "ex") (vip-check-sub "ex") - (vip-check-sub "edit"))) - ((looking-at "f") (vip-check-sub "file")) - ((looking-at "g") (vip-check-sub "global")) - ((looking-at "i") (vip-check-sub "insert")) - ((looking-at "j") (vip-check-sub "join")) - ((looking-at "l") (vip-check-sub "list")) - ((looking-at "m") - (cond ((looking-at "map") (vip-check-sub "map")) - ((looking-at "mar") (vip-check-sub "mark")) - (t (vip-check-sub "move")))) - ((looking-at "n") - (if (looking-at "nu") (vip-check-sub "number") - (vip-check-sub "next"))) - ((looking-at "o") (vip-check-sub "open")) - ((looking-at "p") - (cond ((looking-at "pre") (vip-check-sub "preserve")) - ((looking-at "pu") (vip-check-sub "put")) - (t (vip-check-sub "print")))) - ((looking-at "q") (vip-check-sub "quit")) - ((looking-at "r") - (cond ((looking-at "rec") (vip-check-sub "recover")) - ((looking-at "rew") (vip-check-sub "rewind")) - (t (vip-check-sub "read")))) - ((looking-at "s") - (cond ((looking-at "se") (vip-check-sub "set")) - ((looking-at "sh") (vip-check-sub "shell")) - ((looking-at "so") (vip-check-sub "source")) - ((looking-at "st") (vip-check-sub "stop")) - (t (vip-check-sub "substitute")))) - ((looking-at "t") - (if (looking-at "ta") (vip-check-sub "tag") - (vip-check-sub "t"))) - ((looking-at "u") - (cond ((looking-at "una") (vip-check-sub "unabbreviate")) - ((looking-at "unm") (vip-check-sub "unmap")) - (t (vip-check-sub "undo")))) - ((looking-at "v") - (cond ((looking-at "ve") (vip-check-sub "version")) - ((looking-at "vi") (vip-check-sub "visual")) - (t (vip-check-sub "v")))) - ((looking-at "w") - (if (looking-at "wq") (vip-check-sub "wq") - (vip-check-sub "write"))) - ((looking-at "x") (vip-check-sub "xit")) - ((looking-at "y") (vip-check-sub "yank")) - ((looking-at "z") (vip-check-sub "z"))) - (exchange-point-and-mark)) - -(defun vip-get-ex-token () - "get an ex-token which is either an address or a command. -a token has type \(command, address, end-mark\) and value." - (save-window-excursion - (set-buffer " *ex-working-space*") - (skip-chars-forward " \t") - (cond ((looking-at "[k#]") - (setq ex-token-type "command") - (setq ex-token (char-to-string (following-char))) - (forward-char 1)) - ((looking-at "[a-z]") (vip-get-ex-com-subr)) - ((looking-at "\\.") - (forward-char 1) - (setq ex-token-type "dot")) - ((looking-at "[0-9]") - (set-mark (point)) - (re-search-forward "[0-9]*") - (setq ex-token-type - (cond ((string= ex-token-type "plus") "add-number") - ((string= ex-token-type "minus") "sub-number") - (t "abs-number"))) - (setq ex-token (string-to-int (buffer-substring (point) (mark))))) - ((looking-at "\\$") - (forward-char 1) - (setq ex-token-type "end")) - ((looking-at "%") - (forward-char 1) - (setq ex-token-type "whole")) - ((looking-at "+") - (cond ((or (looking-at "+[-+]") (looking-at "+[\n|]")) - (forward-char 1) - (insert "1") - (backward-char 1) - (setq ex-token-type "plus")) - ((looking-at "+[0-9]") - (forward-char 1) - (setq ex-token-type "plus")) - (t - (error "Badly formed address")))) - ((looking-at "-") - (cond ((or (looking-at "-[-+]") (looking-at "-[\n|]")) - (forward-char 1) - (insert "1") - (backward-char 1) - (setq ex-token-type "minus")) - ((looking-at "-[0-9]") - (forward-char 1) - (setq ex-token-type "minus")) - (t - (error "Badly formed address")))) - ((looking-at "/") - (forward-char 1) - (set-mark (point)) - (let ((cont t)) - (while (and (not (eolp)) cont) - ;;(re-search-forward "[^/]*/") - (re-search-forward "[^/]*\\(/\\|\n\\)") - (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/")) - (setq cont nil)))) - (backward-char 1) - (setq ex-token (buffer-substring (point) (mark))) - (if (looking-at "/") (forward-char 1)) - (setq ex-token-type "search-forward")) - ((looking-at "\\?") - (forward-char 1) - (set-mark (point)) - (let ((cont t)) - (while (and (not (eolp)) cont) - ;;(re-search-forward "[^\\?]*\\?") - (re-search-forward "[^\\?]*\\(\\?\\|\n\\)") - (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?")) - (setq cont nil)) - (backward-char 1) - (if (not (looking-at "\n")) (forward-char 1)))) - (setq ex-token-type "search-backward") - (setq ex-token (buffer-substring (1- (point)) (mark)))) - ((looking-at ",") - (forward-char 1) - (setq ex-token-type "comma")) - ((looking-at ";") - (forward-char 1) - (setq ex-token-type "semi-colon")) - ((looking-at "[!=><&~]") - (setq ex-token-type "command") - (setq ex-token (char-to-string (following-char))) - (forward-char 1)) - ((looking-at "'") - (setq ex-token-type "goto-mark") - (forward-char 1) - (cond ((looking-at "'") (setq ex-token nil)) - ((looking-at "[a-z]") (setq ex-token (following-char))) - (t (error "Marks are ' and a-z"))) - (forward-char 1)) - ((looking-at "\n") - (setq ex-token-type "end-mark") - (setq ex-token "goto")) - (t - (error "illegal token"))))) - -(defun vip-ex (&optional string) - "ex commands within VIP." - (interactive) - (or string - (setq ex-g-flag nil - ex-g-variant nil)) - (let ((com-str (or string (vip-read-string ":"))) - (address nil) (cont t) (dot (point))) - (save-window-excursion - (set-buffer (get-buffer-create " *ex-working-space*")) - (delete-region (point-min) (point-max)) - (insert com-str "\n") - (goto-char (point-min))) - (setq ex-token-type "") - (setq ex-addresses nil) - (while cont - (vip-get-ex-token) - (cond ((or (string= ex-token-type "command") - (string= ex-token-type "end-mark")) - (if address (setq ex-addresses (cons address ex-addresses))) - (cond ((string= ex-token "global") - (ex-global nil) - (setq cont nil)) - ((string= ex-token "v") - (ex-global t) - (setq cont nil)) - (t - (vip-execute-ex-command) - (save-window-excursion - (set-buffer " *ex-working-space*") - (skip-chars-forward " \t") - (cond ((looking-at "|") - (forward-char 1)) - ((looking-at "\n") - (setq cont nil)) - (t (error "Extra character at end of a command"))))))) - ((string= ex-token-type "non-command") - (error (format "%s: Not an editor command" ex-token))) - ((string= ex-token-type "whole") - (setq ex-addresses - (cons (point-max) (cons (point-min) ex-addresses)))) - ((string= ex-token-type "comma") - (setq ex-addresses - (cons (if (null address) (point) address) ex-addresses))) - ((string= ex-token-type "semi-colon") - (if address (setq dot address)) - (setq ex-addresses - (cons (if (null address) (point) address) ex-addresses))) - (t (let ((ans (vip-get-ex-address-subr address dot))) - (if ans (setq address ans)))))))) - -(defun vip-get-ex-pat () - "get a regular expression and set ex-variant if found" - (save-window-excursion - (set-buffer " *ex-working-space*") - (skip-chars-forward " \t") - (if (looking-at "!") - (progn - (setq ex-g-variant (not ex-g-variant) - ex-g-flag (not ex-g-flag)) - (forward-char 1) - (skip-chars-forward " \t"))) - (if (looking-at "/") - (progn - (forward-char 1) - (set-mark (point)) - (let ((cont t)) - (while (and (not (eolp)) cont) - (re-search-forward "[^/]*\\(/\\|\n\\)") - ;;(re-search-forward "[^/]*/") - (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/")) - (setq cont nil)))) - (setq ex-token - (if (= (mark) (point)) "" - (buffer-substring (1- (point)) (mark)))) - (backward-char 1)) - (setq ex-token nil)))) - -(defun vip-get-ex-command () - "get an ex command" - (save-window-excursion - (set-buffer " *ex-working-space*") - (if (looking-at "/") (forward-char 1)) - (skip-chars-forward " \t") - (cond ((looking-at "[a-z]") - (vip-get-ex-com-subr) - (if (string= ex-token-type "non-command") - (error "%s: not an editor command" ex-token))) - ((looking-at "[!=><&~]") - (setq ex-token (char-to-string (following-char))) - (forward-char 1)) - (t (error "Could not find an ex command"))))) - -(defun vip-get-ex-opt-gc () - "get an ex option g or c" - (save-window-excursion - (set-buffer " *ex-working-space*") - (if (looking-at "/") (forward-char 1)) - (skip-chars-forward " \t") - (cond ((looking-at "g") - (setq ex-token "g") - (forward-char 1) - t) - ((looking-at "c") - (setq ex-token "c") - (forward-char 1) - t) - (t nil)))) - -(defun vip-default-ex-addresses (&optional whole-flag) - "compute default addresses. whole-flag means whole buffer." - (cond ((null ex-addresses) - (setq ex-addresses - (if whole-flag - (cons (point-max) (cons (point-min) nil)) - (cons (point) (cons (point) nil))))) - ((null (cdr ex-addresses)) - (setq ex-addresses - (cons (car ex-addresses) ex-addresses))))) - -(defun vip-get-ex-address () - "get an ex-address as a marker and set ex-flag if a flag is found" - (let ((address (point-marker)) (cont t)) - (setq ex-token "") - (setq ex-flag nil) - (while cont - (vip-get-ex-token) - (cond ((string= ex-token-type "command") - (if (or (string= ex-token "print") (string= ex-token "list") - (string= ex-token "#")) - (progn - (setq ex-flag t) - (setq cont nil)) - (error "address expected"))) - ((string= ex-token-type "end-mark") - (setq cont nil)) - ((string= ex-token-type "whole") - (error "a trailing address is expected")) - ((string= ex-token-type "comma") - (error "Extra characters after an address")) - (t (let ((ans (vip-get-ex-address-subr address (point-marker)))) - (if ans (setq address ans)))))) - address)) - -(defun vip-get-ex-address-subr (old-address dot) - "returns an address as a point" - (let ((address nil)) - (if (null old-address) (setq old-address dot)) - (cond ((string= ex-token-type "dot") - (setq address dot)) - ((string= ex-token-type "add-number") - (save-excursion - (goto-char old-address) - (forward-line (if (= old-address 0) (1- ex-token) ex-token)) - (setq address (point-marker)))) - ((string= ex-token-type "sub-number") - (save-excursion - (goto-char old-address) - (forward-line (- ex-token)) - (setq address (point-marker)))) - ((string= ex-token-type "abs-number") - (save-excursion - (goto-char (point-min)) - (if (= ex-token 0) (setq address 0) - (forward-line (1- ex-token)) - (setq address (point-marker))))) - ((string= ex-token-type "end") - (setq address (point-max-marker))) - ((string= ex-token-type "plus") t);; do nothing - ((string= ex-token-type "minus") t);; do nothing - ((string= ex-token-type "search-forward") - (save-excursion - (ex-search-address t) - (setq address (point-marker)))) - ((string= ex-token-type "search-backward") - (save-excursion - (ex-search-address nil) - (setq address (point-marker)))) - ((string= ex-token-type "goto-mark") - (save-excursion - (if (null ex-token) - (exchange-point-and-mark) - (goto-char (register-to-point (- ex-token (- ?a ?\C-a))))) - (setq address (point-marker))))) - address)) - -(defun ex-search-address (forward) - "search pattern and set address" - (if (string= ex-token "") - (if (null vip-s-string) (error "No previous search string") - (setq ex-token vip-s-string)) - (setq vip-s-string ex-token)) - (if forward - (progn - (forward-line 1) - (re-search-forward ex-token)) - (forward-line -1) - (re-search-backward ex-token))) - -(defun vip-get-ex-buffer () - "get a buffer name and set ex-count and ex-flag if found" - (setq ex-buffer nil) - (setq ex-count nil) - (setq ex-flag nil) - (save-window-excursion - (set-buffer " *ex-working-space*") - (skip-chars-forward " \t") - (if (looking-at "[a-zA-Z]") - (progn - (setq ex-buffer (following-char)) - (forward-char 1) - (skip-chars-forward " \t"))) - (if (looking-at "[0-9]") - (progn - (set-mark (point)) - (re-search-forward "[0-9][0-9]*") - (setq ex-count (string-to-int (buffer-substring (point) (mark)))) - (skip-chars-forward " \t"))) - (if (looking-at "[pl#]") - (progn - (setq ex-flag t) - (forward-char 1))) - (if (not (looking-at "[\n|]")) - (error "Illegal extra characters")))) - -(defun vip-get-ex-count () - (setq ex-variant nil - ex-count nil - ex-flag nil) - (save-window-excursion - (set-buffer " *ex-working-space*") - (skip-chars-forward " \t") - (if (looking-at "!") - (progn - (setq ex-variant t) - (forward-char 1))) - (skip-chars-forward " \t") - (if (looking-at "[0-9]") - (progn - (set-mark (point)) - (re-search-forward "[0-9][0-9]*") - (setq ex-count (string-to-int (buffer-substring (point) (mark)))) - (skip-chars-forward " \t"))) - (if (looking-at "[pl#]") - (progn - (setq ex-flag t) - (forward-char 1))) - (if (not (looking-at "[\n|]")) - (error "Illegal extra characters")))) - -(defun vip-get-ex-file () - "get a file name and set ex-variant, ex-append and ex-offset if found" - (setq ex-file nil - ex-variant nil - ex-append nil - ex-offset nil) - (save-window-excursion - (set-buffer " *ex-working-space*") - (skip-chars-forward " \t") - (if (looking-at "!") - (progn - (setq ex-variant t) - (forward-char 1) - (skip-chars-forward " \t"))) - (if (looking-at ">>") - (progn - (setq ex-append t - ex-variant t) - (forward-char 2) - (skip-chars-forward " \t"))) - (if (looking-at "+") - (progn - (forward-char 1) - (set-mark (point)) - (re-search-forward "[ \t\n]") - (backward-char 1) - (setq ex-offset (buffer-substring (point) (mark))) - (forward-char 1) - (skip-chars-forward " \t"))) - (set-mark (point)) - (re-search-forward "[ \t\n]") - (backward-char 1) - (setq ex-file (buffer-substring (point) (mark))))) - -(defun vip-execute-ex-command () - "execute ex command using the value of addresses." - (cond ((string= ex-token "goto") (ex-goto)) - ((string= ex-token "copy") (ex-copy nil)) - ((string= ex-token "delete") (ex-delete)) - ((string= ex-token "edit") (ex-edit)) - ((string= ex-token "file") (vip-info-on-file)) - ;((string= ex-token "global") (ex-global nil)) - ((string= ex-token "join") (ex-line "join")) - ((string= ex-token "k") (ex-mark)) - ((string= ex-token "mark") (ex-mark)) - ((string= ex-token "map") (ex-map)) - ((string= ex-token "move") (ex-copy t)) - ((string= ex-token "put") (ex-put)) - ((string= ex-token "quit") (ex-quit)) - ((string= ex-token "read") (ex-read)) - ((string= ex-token "set") (ex-set)) - ((string= ex-token "shell") (ex-shell)) - ((string= ex-token "substitute") (ex-substitute)) - ((string= ex-token "stop") (suspend-emacs)) - ((string= ex-token "t") (ex-copy nil)) - ((string= ex-token "tag") (ex-tag)) - ((string= ex-token "undo") (vip-undo)) - ((string= ex-token "unmap") (ex-unmap)) - ;((string= ex-token "v") (ex-global t)) - ((string= ex-token "version") (vip-version)) - ((string= ex-token "visual") (ex-edit)) - ((string= ex-token "write") (ex-write nil)) - ((string= ex-token "wq") (ex-write t)) - ((string= ex-token "yank") (ex-yank)) - ((string= ex-token "!") (ex-command)) - ((string= ex-token "=") (ex-line-no)) - ((string= ex-token ">") (ex-line "right")) - ((string= ex-token "<") (ex-line "left")) - ((string= ex-token "&") (ex-substitute t)) - ((string= ex-token "~") (ex-substitute t t)) - ((or (string= ex-token "append") - (string= ex-token "args") - (string= ex-token "change") - (string= ex-token "insert") - (string= ex-token "open") - ) - (error "%s: no such command from VIP" ex-token)) - ((or (string= ex-token "abbreviate") - (string= ex-token "list") - (string= ex-token "next") - (string= ex-token "print") - (string= ex-token "preserve") - (string= ex-token "recover") - (string= ex-token "rewind") - (string= ex-token "source") - (string= ex-token "unabbreviate") - (string= ex-token "xit") - (string= ex-token "z") - ) - (error "%s: not implemented in VIP" ex-token)) - (t (error "%s: Not an editor command" ex-token)))) - -(defun ex-goto () - "ex goto command" - (if (null ex-addresses) - (setq ex-addresses (cons (point) nil))) - (push-mark (point)) - (goto-char (car ex-addresses)) - (beginning-of-line)) - -(defun ex-copy (del-flag) - "ex copy and move command. DEL-FLAG means delete." - (vip-default-ex-addresses) - (let ((address (vip-get-ex-address)) - (end (car ex-addresses)) (beg (car (cdr ex-addresses)))) - (goto-char end) - (save-excursion - (set-mark beg) - (vip-enlarge-region (mark) (point)) - (if del-flag (kill-region (point) (mark)) - (copy-region-as-kill (point) (mark))) - (if ex-flag - (progn - (with-output-to-temp-buffer "*copy text*" - (princ - (if (or del-flag ex-g-flag ex-g-variant) - (current-kill 0) - (buffer-substring (point) (mark))))) - (condition-case nil - (progn - (vip-read-string "[Hit return to continue] ") - (save-excursion (kill-buffer "*copy text*"))) - (quit - (save-excursion (kill-buffer "*copy text*")) - (signal 'quit nil)))))) - (if (= address 0) - (goto-char (point-min)) - (goto-char address) - (forward-line 1)) - (insert (current-kill 0)))) - -(defun ex-delete () - "ex delete" - (vip-default-ex-addresses) - (vip-get-ex-buffer) - (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) - (if (> beg end) (error "First address exceeds second")) - (save-excursion - (vip-enlarge-region beg end) - (exchange-point-and-mark) - (if ex-count - (progn - (set-mark (point)) - (forward-line (1- ex-count))) - (set-mark end)) - (vip-enlarge-region (point) (mark)) - (if ex-flag - ;; show text to be deleted and ask for confirmation - (progn - (with-output-to-temp-buffer " *delete text*" - (princ (buffer-substring (point) (mark)))) - (condition-case conditions - (vip-read-string "[Hit return to continue] ") - (quit - (save-excursion (kill-buffer " *delete text*")) - (error ""))) - (save-excursion (kill-buffer " *delete text*"))) - (if ex-buffer - (if (and (<= ?A ex-buffer) (<= ex-buffer ?Z)) - (vip-append-to-register - (+ ex-buffer 32) (point) (mark)) - (copy-to-register ex-buffer (point) (mark) nil))) - (delete-region (point) (mark)))))) - -(defun ex-edit () - "ex-edit" - (vip-get-ex-file) - (if (and (not ex-variant) (buffer-modified-p) buffer-file-name) - (error "No write since last change \(:e! overrides\)")) - (vip-change-mode-to-emacs) - (set-buffer - (find-file-noselect (concat default-directory ex-file))) - (vip-change-mode-to-vi) - (goto-char (point-min)) - (if ex-offset - (progn - (save-window-excursion - (set-buffer " *ex-working-space*") - (delete-region (point-min) (point-max)) - (insert ex-offset "\n") - (goto-char (point-min))) - (goto-char (vip-get-ex-address)) - (beginning-of-line)))) - -(defun ex-global (variant) - "ex global command" - (if (or ex-g-flag ex-g-variant) - (error "Global within global not allowed") - (if variant - (setq ex-g-flag nil - ex-g-variant t) - (setq ex-g-flag t - ex-g-variant nil))) - (vip-get-ex-pat) - (if (null ex-token) - (error "Missing regular expression for global command")) - (if (string= ex-token "") - (if (null vip-s-string) (error "No previous search string") - (setq ex-g-pat vip-s-string)) - (setq ex-g-pat ex-token - vip-s-string ex-token)) - (if (null ex-addresses) - (setq ex-addresses (list (point-max) (point-min)))) - (let ((marks nil) (mark-count 0) - com-str (end (car ex-addresses)) (beg (car (cdr ex-addresses)))) - (if (> beg end) (error "First address exceeds second")) - (save-excursion - (vip-enlarge-region beg end) - (exchange-point-and-mark) - (let ((cont t) (limit (point-marker))) - (exchange-point-and-mark) - ;; skip the last line if empty - (beginning-of-line) - (if (and (eobp) (not (bobp))) (backward-char 1)) - (while (and cont (not (bobp)) (>= (point) limit)) - (beginning-of-line) - (set-mark (point)) - (end-of-line) - (let ((found (re-search-backward ex-g-pat (mark) t))) - (if (or (and ex-g-flag found) - (and ex-g-variant (not found))) - (progn - (end-of-line) - (setq mark-count (1+ mark-count)) - (setq marks (cons (point-marker) marks))))) - (beginning-of-line) - (if (bobp) (setq cont nil) - (forward-line -1) - (end-of-line))))) - (save-window-excursion - (set-buffer " *ex-working-space*") - (setq com-str (buffer-substring (1+ (point)) (1- (point-max))))) - (while marks - (goto-char (car marks)) - ; report progress of execution on a slow machine. - ;(message "Executing global command...") - ;(if (zerop (% mark-count 10)) - ;(message "Executing global command...%d" mark-count)) - (vip-ex com-str) - (setq mark-count (1- mark-count)) - (setq marks (cdr marks))))) - ;(message "Executing global command...done"))) - -(defun ex-line (com) - "ex line commands. COM is join, shift-right or shift-left." - (vip-default-ex-addresses) - (vip-get-ex-count) - (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) point) - (if (> beg end) (error "First address exceeds second")) - (save-excursion - (vip-enlarge-region beg end) - (exchange-point-and-mark) - (if ex-count - (progn - (set-mark (point)) - (forward-line ex-count))) - (if ex-flag - ;; show text to be joined and ask for confirmation - (progn - (with-output-to-temp-buffer " *text*" - (princ (buffer-substring (point) (mark)))) - (condition-case conditions - (progn - (vip-read-string "[Hit return to continue] ") - (ex-line-subr com (point) (mark))) - (quit - (ding))) - (save-excursion (kill-buffer " *text*"))) - (ex-line-subr com (point) (mark))) - (setq point (point))) - (goto-char (1- point)) - (beginning-of-line))) - -(defun ex-line-subr (com beg end) - (cond ((string= com "join") - (goto-char (min beg end)) - (while (and (not (eobp)) (< (point) (max beg end))) - (end-of-line) - (if (and (<= (point) (max beg end)) (not (eobp))) - (progn - (forward-line 1) - (delete-region (point) (1- (point))) - (if (not ex-variant) (fixup-whitespace)))))) - ((or (string= com "right") (string= com "left")) - (indent-rigidly - (min beg end) (max beg end) - (if (string= com "right") vip-shift-width (- vip-shift-width))) - (goto-char (max beg end)) - (end-of-line) - (forward-char 1)))) - -(defun ex-mark () - "ex mark" - (let (char) - (if (null ex-addresses) - (setq ex-addresses - (cons (point) nil))) - (save-window-excursion - (set-buffer " *ex-working-space*") - (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 "Extra characters at end of \"k\" command"))) - (if (looking-at "[\n|]") - (error "\"k\" requires a following letter") - (error "Mark must specify a letter")))) - (save-excursion - (goto-char (car ex-addresses)) - (point-to-register (- char (- ?a ?\C-a)) nil)))) - -(defun ex-map () - "ex map" - (let (char string) - (save-window-excursion - (set-buffer " *ex-working-space*") - (skip-chars-forward " \t") - (setq char (char-to-string (following-char))) - (forward-char 1) - (skip-chars-forward " \t") - (if (looking-at "[\n|]") (error "Missing rhs")) - (set-mark (point)) - (end-of-buffer) - (backward-char 1) - (setq string (buffer-substring (mark) (point)))) - (if (not (lookup-key ex-map char)) - (define-key ex-map char - (or (lookup-key vip-mode-map char) 'vip-nil))) - (define-key vip-mode-map char - (eval - (list 'quote - (cons 'lambda - (list '(count) - '(interactive "p") - (list 'execute-kbd-macro string 'count)))))))) - -(defun ex-unmap () - "ex unmap" - (let (char) - (save-window-excursion - (set-buffer " *ex-working-space*") - (skip-chars-forward " \t") - (setq char (char-to-string (following-char))) - (forward-char 1) - (skip-chars-forward " \t") - (if (not (looking-at "[\n|]")) (error "Macro must be a character"))) - (if (not (lookup-key ex-map char)) - (error "That macro wasn't mapped")) - (define-key vip-mode-map char (lookup-key ex-map char)) - (define-key ex-map char nil))) - -(defun ex-put () - "ex put" - (let ((point (if (null ex-addresses) (point) (car ex-addresses)))) - (vip-get-ex-buffer) - (setq vip-use-register ex-buffer) - (goto-char point) - (if (= point 0) (vip-Put-back 1) (vip-put-back 1)))) - -(defun ex-quit () - "ex quit" - (let (char) - (save-window-excursion - (set-buffer " *ex-working-space*") - (skip-chars-forward " \t") - (setq char (following-char))) - (if (= char ?!) (kill-emacs t) (save-buffers-kill-emacs)))) - -(defun ex-read () - "ex read" - (let ((point (if (null ex-addresses) (point) (car ex-addresses))) - (variant nil) command file) - (goto-char point) - (if (not (= point 0)) (next-line 1)) - (beginning-of-line) - (save-window-excursion - (set-buffer " *ex-working-space*") - (skip-chars-forward " \t") - (if (looking-at "!") - (progn - (setq variant t) - (forward-char 1) - (skip-chars-forward " \t") - (set-mark (point)) - (end-of-line) - (setq command (buffer-substring (mark) (point)))) - (set-mark (point)) - (re-search-forward "[ \t\n]") - (backward-char 1) - (setq file (buffer-substring (point) (mark))))) - (if variant - (shell-command command t) - (insert-file file)))) - -(defun ex-set () - (eval (list 'setq - (read-variable "Variable: ") - (eval (read-minibuffer "Value: "))))) - -(defun ex-shell () - "ex shell" - (vip-change-mode-to-emacs) - (shell)) - -(defun ex-substitute (&optional repeat r-flag) - "ex substitute. -If REPEAT use previous reg-exp which is ex-reg-exp or -vip-s-string" - (let (pat repl (opt-g nil) (opt-c nil) (matched-pos nil)) - (if repeat (setq ex-token nil) (vip-get-ex-pat)) - (if (null ex-token) - (setq pat (if r-flag vip-s-string ex-reg-exp) - repl ex-repl) - (setq pat (if (string= ex-token "") vip-s-string ex-token)) - (setq vip-s-string pat - ex-reg-exp pat) - (vip-get-ex-pat) - (if (null ex-token) - (setq ex-token "" - ex-repl "") - (setq repl ex-token - ex-repl ex-token))) - (while (vip-get-ex-opt-gc) - (if (string= ex-token "g") (setq opt-g t) (setq opt-c t))) - (vip-get-ex-count) - (if ex-count - (save-excursion - (if ex-addresses (goto-char (car ex-addresses))) - (set-mark (point)) - (forward-line (1- ex-count)) - (setq ex-addresses (cons (point) (cons (mark) nil)))) - (if (null ex-addresses) - (setq ex-addresses (cons (point) (cons (point) nil))) - (if (null (cdr ex-addresses)) - (setq ex-addresses (cons (car ex-addresses) ex-addresses))))) - ;(setq G opt-g) - (let ((beg (car ex-addresses)) (end (car (cdr ex-addresses))) - (cont t) eol-mark) - (save-excursion - (vip-enlarge-region beg end) - (let ((limit (save-excursion - (goto-char (max (point) (mark))) - (point-marker)))) - (goto-char (min (point) (mark))) - (while (< (point) limit) - (end-of-line) - (setq eol-mark (point-marker)) - (beginning-of-line) - (if opt-g - (progn - (while (and (not (eolp)) - (re-search-forward pat eol-mark t)) - (if (or (not opt-c) (y-or-n-p "Replace? ")) - (progn - (setq matched-pos (point)) - (replace-match repl)))) - (end-of-line) - (forward-char)) - (if (and (re-search-forward pat eol-mark t) - (or (not opt-c) (y-or-n-p "Replace? "))) - (progn - (setq matched-pos (point)) - (replace-match repl))) - (end-of-line) - (forward-char)))))) - (if matched-pos (goto-char matched-pos)) - (beginning-of-line) - (if opt-c (message "done")))) - -(defun ex-tag () - "ex tag" - (let (tag) - (save-window-excursion - (set-buffer " *ex-working-space*") - (skip-chars-forward " \t") - (set-mark (point)) - (skip-chars-forward "^ |\t\n") - (setq tag (buffer-substring (mark) (point)))) - (if (not (string= tag "")) (setq ex-tag tag)) - (vip-change-mode-to-emacs) - (condition-case conditions - (progn - (if (string= tag "") - (find-tag ex-tag t) - (find-tag-other-window ex-tag)) - (vip-change-mode-to-vi)) - (error - (vip-change-mode-to-vi) - (vip-message-conditions conditions))))) - -(defun ex-write (q-flag) - "ex write" - (vip-default-ex-addresses t) - (vip-get-ex-file) - (if (string= ex-file "") - (progn - (if (null buffer-file-name) - (error "No file associated with this buffer")) - (setq ex-file buffer-file-name)) - (setq ex-file (expand-file-name ex-file))) - (if (and (not (string= ex-file (buffer-file-name))) - (file-exists-p ex-file) - (not ex-variant)) - (error "\"%s\" File exists - use w! to override" ex-file)) - (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) - (if (> beg end) (error "First address exceeds second")) - (save-excursion - (vip-enlarge-region beg end) - (write-region (point) (mark) ex-file ex-append t))) - (if (null buffer-file-name) (setq buffer-file-name ex-file)) - (if q-flag (save-buffers-kill-emacs))) - -(defun ex-yank () - "ex yank" - (vip-default-ex-addresses) - (vip-get-ex-buffer) - (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) - (if (> beg end) (error "First address exceeds second")) - (save-excursion - (vip-enlarge-region beg end) - (exchange-point-and-mark) - (if (or ex-g-flag ex-g-variant) (error "Can't yank within global")) - (if ex-count - (progn - (set-mark (point)) - (forward-line (1- ex-count))) - (set-mark end)) - (vip-enlarge-region (point) (mark)) - (if ex-flag (error "Extra characters at end of command")) - (if ex-buffer - (copy-to-register ex-buffer (point) (mark) nil)) - (copy-region-as-kill (point) (mark))))) - -(defun ex-command () - "execute shell command" - (let (command) - (save-window-excursion - (set-buffer " *ex-working-space*") - (skip-chars-forward " \t") - (set-mark (point)) - (end-of-line) - (setq command (buffer-substring (mark) (point)))) - (if (null ex-addresses) - (shell-command command) - (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) - (if (null beg) (setq beg end)) - (save-excursion - (goto-char beg) - (set-mark end) - (vip-enlarge-region (point) (mark)) - (shell-command-on-region (point) (mark) command t)) - (goto-char beg))))) - -(defun ex-line-no () - "print line number" - (message "%d" - (1+ (count-lines - (point-min) - (if (null ex-addresses) (point-max) (car ex-addresses)))))) - -(if (file-exists-p vip-startup-file) (load vip-startup-file)) - -;;; vip.el ends here diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el deleted file mode 100644 index 93846321476..00000000000 --- a/lisp/emulation/viper-ex.el +++ /dev/null @@ -1,2029 +0,0 @@ -;;; viper-ex.el --- functions implementing the Ex commands for Viper - -;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. - -;; This file is part of GNU Emacs. - -;; 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 -;; the Free Software Foundation; either version 2, 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 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - - -;; Code - -(require 'viper-util) - -;; Compiler pacifier -(defvar read-file-name-map) -;; end compiler pacifier - -;;; Variables - -(defconst vip-ex-work-buf-name " *ex-working-space*") -(defconst vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) -(defconst vip-ex-tmp-buf-name " *ex-tmp*") - - -;;; Variable completion in :set command - -;; The list of Ex commands. Used for completing command names. -(defconst ex-token-alist - '(("!") ("=") (">") ("&") ("~") - ("yank") ("xit") ("WWrite") ("Write") ("write") ("wq") ("visual") - ("version") ("vglobal") ("unmap") ("undo") ("tag") ("transfer") ("suspend") - ("substitute") ("submitReport") ("stop") ("sr") ("source") ("shell") - ("set") ("rewind") ("recover") ("read") ("quit") ("pwd") - ("put") ("preserve") ("PreviousRelatedFile") ("RelatedFile") - ("next") ("Next") ("move") ("mark") ("map") ("kmark") ("join") - ("help") ("goto") ("global") ("file") ("edit") ("delete") ("copy") - ("chdir") ("cd") ("Buffer") ("buffer") ("args")) ) - -;; A-list of Ex variables that can be set using the :set command. -(defconst ex-variable-alist - '(("wrapscan") ("ws") ("wrapmargin") ("wm") - ("global-tabstop") ("gts") ("tabstop") ("ts") - ("showmatch") ("sm") ("shiftwidth") ("sw") ("shell") ("sh") - ("readonly") ("ro") - ("nowrapscan") ("nows") ("noshowmatch") ("nosm") - ("noreadonly") ("noro") ("nomagic") ("noma") - ("noignorecase") ("noic") - ("global-noautoindent") ("gnoai") ("noautoindent") ("noai") - ("magic") ("ma") ("ignorecase") ("ic") - ("global-autoindent") ("gai") ("autoindent") ("ai") - )) - - - -;; Token recognized during parsing of Ex commands (e.g., "read", "comma") -(defvar ex-token nil) - -;; Type of token. -;; If non-nil, gives type of address; if nil, it is a command. -(defvar ex-token-type nil) - -;; List of addresses passed to Ex command -(defvar ex-addresses nil) - -;; It seems that this flag is used only for `#', `print', and `list', which -;; aren't implemented. Check later. -(defvar ex-flag nil) - -;; "buffer" where Ex commands keep deleted data. -;; In Emacs terms, this is a register. -(defvar ex-buffer nil) - -;; Value of ex count. -(defvar ex-count nil) - -;; Flag for global command. -(defvar ex-g-flag nil) - -;; If t, global command is executed on lines not matching ex-g-pat. -(defvar ex-g-variant nil) - -;; Save reg-exp used in substitute. -(defvar ex-reg-exp nil) - - -;; Replace pattern for substitute. -(defvar ex-repl nil) - -;; Pattern for global command. -(defvar ex-g-pat nil) - - -(defvar ex-unix-type-shell - (let ((case-fold-search t)) - (and (stringp shell-file-name) - (string-match - (concat - "\\(" - "csh$\\|csh.exe$" - "\\|" - "ksh$\\|ksh.exe$" - "\\|" - "^sh$\\|sh.exe$" - "\\|" - "[^a-z]sh$\\|[^a-z]sh.exe$" - "\\|" - "bash$\\|bash.exe$" - "\\)") - shell-file-name))) - "Is the user using a unix-type shell?") - -(defvar ex-unix-type-shell-options - (let ((case-fold-search t)) - (if ex-unix-type-shell - (cond ((string-match "\\(csh$\\|csh.exe$\\)" shell-file-name) - "-f") ; csh: do it fast - ((string-match "\\(bash$\\|bash.exe$\\)" shell-file-name) - "-noprofile") ; bash: ignore .profile - ))) - "Options to pass to the Unix-style shell. -Don't put `-c' here, as it is added automatically.") - -(defvar ex-nontrivial-find-file-function - (cond (ex-unix-type-shell 'vip-ex-nontrivial-find-file-unix) - ((eq system-type 'emx) 'vip-ex-nontrivial-find-file-ms) ; OS/2 - (vip-ms-style-os-p 'vip-ex-nontrivial-find-file-ms) ; a Microsoft OS - (vip-vms-os-p 'vip-ex-nontrivial-find-file-unix) ; VMS - (t 'vip-ex-nontrivial-find-file-unix) ; presumably UNIX - )) - -;; Remembers the previous Ex tag. -(defvar ex-tag nil) - -;; file used by Ex commands like :r, :w, :n -(defvar ex-file nil) - -;; If t, tells Ex that this is a variant-command, i.e., w>>, r!, etc. -(defvar ex-variant nil) - -;; Specified the offset of an Ex command, such as :read. -(defvar ex-offset nil) - -;; Tells Ex that this is a w>> command. -(defvar ex-append nil) - -;; File containing the shell command to be executed at Ex prompt, -;; e.g., :r !date -(defvar ex-cmdfile nil) - -;; flag used in vip-ex-read-file-name to indicate that we may be reading -;; multiple file names. Used for :edit and :next -(defvar vip-keep-reading-filename nil) - -(defconst ex-cycle-other-window t - "*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.") - -(defconst ex-cycle-through-non-files nil - "*Cycle through *scratch* and other buffers that don't visit any file.") - -;; Last shell command executed with :! command. -(defvar vip-ex-last-shell-com nil) - -;; Indicates if Minibuffer was exited temporarily in Ex-command. -(defvar vip-incomplete-ex-cmd nil) - -;; Remembers the last ex-command prompt. -(defvar vip-last-ex-prompt "") - - -;;; Code - -;; Check if ex-token is an initial segment of STR -(defun vip-check-sub (str) - (let ((length (length ex-token))) - (if (and (<= length (length str)) - (string= ex-token (substring str 0 length))) - (setq ex-token str) - (setq ex-token-type 'non-command)))) - -;; Get a complete ex command -(defun vip-get-ex-com-subr () - (let (case-fold-search) - (set-mark (point)) - (re-search-forward "[a-zA-Z][a-zA-Z]*") - (setq ex-token-type 'command) - (setq ex-token (buffer-substring (point) (mark t))) - (exchange-point-and-mark) - (cond ((looking-at "a") - (cond ((looking-at "ab") (vip-check-sub "abbreviate")) - ((looking-at "ar") (vip-check-sub "args")) - (t (vip-check-sub "append")))) - ((looking-at "h") (vip-check-sub "help")) - ((looking-at "c") - (cond ((looking-at "cd") (vip-check-sub "cd")) - ((looking-at "ch") (vip-check-sub "chdir")) - ((looking-at "co") (vip-check-sub "copy")) - (t (vip-check-sub "change")))) - ((looking-at "d") (vip-check-sub "delete")) - ((looking-at "b") (vip-check-sub "buffer")) - ((looking-at "B") (vip-check-sub "Buffer")) - ((looking-at "e") - (if (looking-at "ex") (vip-check-sub "ex") - (vip-check-sub "edit"))) - ((looking-at "f") (vip-check-sub "file")) - ((looking-at "g") (vip-check-sub "global")) - ((looking-at "i") (vip-check-sub "insert")) - ((looking-at "j") (vip-check-sub "join")) - ((looking-at "l") (vip-check-sub "list")) - ((looking-at "m") - (cond ((looking-at "map") (vip-check-sub "map")) - ((looking-at "mar") (vip-check-sub "mark")) - (t (vip-check-sub "move")))) - ((looking-at "k[a-z][^a-z]") - (setq ex-token "kmark") - (forward-char 1) - (exchange-point-and-mark)) ; this is canceled out by another - ; exchange-point-and-mark at the end - ((looking-at "k") (vip-check-sub "kmark")) - ((looking-at "n") (if (looking-at "nu") - (vip-check-sub "number") - (vip-check-sub "next"))) - ((looking-at "N") (vip-check-sub "Next")) - ((looking-at "o") (vip-check-sub "open")) - ((looking-at "p") - (cond ((looking-at "pre") (vip-check-sub "preserve")) - ((looking-at "pu") (vip-check-sub "put")) - ((looking-at "pw") (vip-check-sub "pwd")) - (t (vip-check-sub "print")))) - ((looking-at "P") (vip-check-sub "PreviousRelatedFile")) - ((looking-at "R") (vip-check-sub "RelatedFile")) - ((looking-at "q") (vip-check-sub "quit")) - ((looking-at "r") - (cond ((looking-at "rec") (vip-check-sub "recover")) - ((looking-at "rew") (vip-check-sub "rewind")) - (t (vip-check-sub "read")))) - ((looking-at "s") - (cond ((looking-at "se") (vip-check-sub "set")) - ((looking-at "sh") (vip-check-sub "shell")) - ((looking-at "so") (vip-check-sub "source")) - ((looking-at "sr") (vip-check-sub "sr")) - ((looking-at "st") (vip-check-sub "stop")) - ((looking-at "sus") (vip-check-sub "suspend")) - ((looking-at "subm") (vip-check-sub "submitReport")) - (t (vip-check-sub "substitute")))) - ((looking-at "t") - (if (looking-at "ta") (vip-check-sub "tag") - (vip-check-sub "transfer"))) - ((looking-at "u") - (cond ((looking-at "una") (vip-check-sub "unabbreviate")) - ((looking-at "unm") (vip-check-sub "unmap")) - (t (vip-check-sub "undo")))) - ((looking-at "v") - (cond ((looking-at "ve") (vip-check-sub "version")) - ((looking-at "vi") (vip-check-sub "visual")) - (t (vip-check-sub "vglobal")))) - ((looking-at "w") - (if (looking-at "wq") (vip-check-sub "wq") - (vip-check-sub "write"))) - ((looking-at "W") - (if (looking-at "WW") - (vip-check-sub "WWrite") - (vip-check-sub "Write"))) - ((looking-at "x") (vip-check-sub "xit")) - ((looking-at "y") (vip-check-sub "yank")) - ((looking-at "z") (vip-check-sub "z"))) - (exchange-point-and-mark) - )) - -;; Get an ex-token which is either an address or a command. -;; A token has a type, \(command, address, end-mark\), and a value -(defun vip-get-ex-token () - (save-window-excursion - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) - (set-buffer vip-ex-work-buf) - (skip-chars-forward " \t|") - (cond ((looking-at "#") - (setq ex-token-type 'command) - (setq ex-token (char-to-string (following-char))) - (forward-char 1)) - ((looking-at "[a-z]") (vip-get-ex-com-subr)) - ((looking-at "\\.") - (forward-char 1) - (setq ex-token-type 'dot)) - ((looking-at "[0-9]") - (set-mark (point)) - (re-search-forward "[0-9]*") - (setq ex-token-type - (cond ((eq ex-token-type 'plus) 'add-number) - ((eq ex-token-type 'minus) 'sub-number) - (t 'abs-number))) - (setq ex-token (string-to-int (buffer-substring (point) (mark t))))) - ((looking-at "\\$") - (forward-char 1) - (setq ex-token-type 'end)) - ((looking-at "%") - (forward-char 1) - (setq ex-token-type 'whole)) - ((looking-at "+") - (cond ((or (looking-at "+[-+]") (looking-at "+[\n|]")) - (forward-char 1) - (insert "1") - (backward-char 1) - (setq ex-token-type 'plus)) - ((looking-at "+[0-9]") - (forward-char 1) - (setq ex-token-type 'plus)) - (t - (error vip-BadAddress)))) - ((looking-at "-") - (cond ((or (looking-at "-[-+]") (looking-at "-[\n|]")) - (forward-char 1) - (insert "1") - (backward-char 1) - (setq ex-token-type 'minus)) - ((looking-at "-[0-9]") - (forward-char 1) - (setq ex-token-type 'minus)) - (t - (error vip-BadAddress)))) - ((looking-at "/") - (forward-char 1) - (set-mark (point)) - (let ((cont t)) - (while (and (not (eolp)) cont) - ;;(re-search-forward "[^/]*/") - (re-search-forward "[^/]*\\(/\\|\n\\)") - (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/")) - (setq cont nil)))) - (backward-char 1) - (setq ex-token (buffer-substring (point) (mark t))) - (if (looking-at "/") (forward-char 1)) - (setq ex-token-type 'search-forward)) - ((looking-at "\\?") - (forward-char 1) - (set-mark (point)) - (let ((cont t)) - (while (and (not (eolp)) cont) - ;;(re-search-forward "[^\\?]*\\?") - (re-search-forward "[^\\?]*\\(\\?\\|\n\\)") - (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?")) - (setq cont nil)) - (backward-char 1) - (if (not (looking-at "\n")) (forward-char 1)))) - (setq ex-token-type 'search-backward) - (setq ex-token (buffer-substring (1- (point)) (mark t)))) - ((looking-at ",") - (forward-char 1) - (setq ex-token-type 'comma)) - ((looking-at ";") - (forward-char 1) - (setq ex-token-type 'semi-colon)) - ((looking-at "[!=><&~]") - (setq ex-token-type 'command) - (setq ex-token (char-to-string (following-char))) - (forward-char 1)) - ((looking-at "'") - (setq ex-token-type 'goto-mark) - (forward-char 1) - (cond ((looking-at "'") (setq ex-token nil)) - ((looking-at "[a-z]") (setq ex-token (following-char))) - (t (error "Marks are ' and a-z"))) - (forward-char 1)) - ((looking-at "\n") - (setq ex-token-type 'end-mark) - (setq ex-token "goto")) - (t - (error vip-BadExCommand))))) - -;; Reads Ex command. Tries to determine if it has to exit because command -;; is complete or invalid. If not, keeps reading command. -(defun ex-cmd-read-exit () - (interactive) - (setq vip-incomplete-ex-cmd t) - (let ((quit-regex1 (concat - "\\(" "set[ \t]*" - "\\|" "edit[ \t]*" - "\\|" "[nN]ext[ \t]*" - "\\|" "unm[ \t]*" - "\\|" "^[ \t]*rep" - "\\)")) - (quit-regex2 (concat - "[a-zA-Z][ \t]*" - "\\(" "!" "\\|" ">>" - "\\|" "\\+[0-9]+" - "\\)" - "*[ \t]*$")) - (stay-regex (concat - "\\(" "^[ \t]*$" - "\\|" "[?/].*[?/].*" - "\\|" "[ktgjmsz][ \t]*$" - "\\|" "^[ \t]*ab.*" - "\\|" "tr[ansfer \t]*" - "\\|" "sr[ \t]*" - "\\|" "mo.*" - "\\|" "^[ \t]*k?ma[^p]*" - "\\|" "^[ \t]*fi.*" - "\\|" "v?gl.*" - "\\|" "[vg][ \t]*$" - "\\|" "jo.*" - "\\|" "^[ \t]*ta.*" - "\\|" "^[ \t]*una.*" - "\\|" "^[ \t]*su.*" - "\\|['`][a-z][ \t]*" - "\\|" "![ \t]*[a-zA-Z].*" - "\\)" - "!*"))) - - (save-window-excursion ;; put cursor at the end of the Ex working buffer - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) - (set-buffer vip-ex-work-buf) - (goto-char (point-max))) - (cond ((vip-looking-back quit-regex1) (exit-minibuffer)) - ((vip-looking-back stay-regex) (insert " ")) - ((vip-looking-back quit-regex2) (exit-minibuffer)) - (t (insert " "))))) - -;; complete Ex command -(defun ex-cmd-complete () - (interactive) - (let (save-pos dist compl-list string-to-complete completion-result) - - (save-excursion - (setq dist (skip-chars-backward "[a-zA-Z!=>&~]") - save-pos (point))) - - (if (or (= dist 0) - (vip-looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)") - (vip-looking-back - "^[ \t]*[a-zA-Z!=>&~][ \t]*[/?]*+[ \t]+[a-zA-Z!=>&~]+")) - ;; Preceding characters are not the ones allowed in an Ex command - ;; or we have typed past command name. - ;; Note: we didn't do parsing, so there may be surprises. - (if (or (vip-looking-back "[a-zA-Z!=>&~][ \t]*[/?]*[ \t]*") - (vip-looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)") - (looking-at "[^ \t\n\C-m]")) - nil - (with-output-to-temp-buffer "*Completions*" - (display-completion-list - (vip-alist-to-list ex-token-alist)))) - ;; Preceding chars may be part of a command name - (setq string-to-complete (buffer-substring save-pos (point))) - (setq completion-result - (try-completion string-to-complete ex-token-alist)) - - (cond ((eq completion-result t) ; exact match--do nothing - (vip-tmp-insert-at-eob " (Sole completion)")) - ((eq completion-result nil) - (vip-tmp-insert-at-eob " (No match)")) - (t ;; partial completion - (goto-char save-pos) - (delete-region (point) (point-max)) - (insert completion-result) - (let (case-fold-search) - (setq compl-list - (vip-filter-alist (concat "^" completion-result) - ex-token-alist))) - (if (> (length compl-list) 1) - (with-output-to-temp-buffer "*Completions*" - (display-completion-list - (vip-alist-to-list (reverse compl-list))))))) - ))) - - -;; Read Ex commands -;; Ex commands themselves are implemented in viper-ex.el -(defun vip-ex (&optional string) - (interactive) - (or string - (setq ex-g-flag nil - ex-g-variant nil)) - (let* ((map (copy-keymap minibuffer-local-map)) - (address nil) - (cont t) - (dot (point)) - prev-token-type com-str) - - (vip-add-keymap vip-ex-cmd-map map) - - (setq com-str (or string (vip-read-string-with-history - ":" - nil - 'vip-ex-history - (car vip-ex-history) - map))) - (save-window-excursion - ;; just a precaution - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) - (set-buffer vip-ex-work-buf) - (delete-region (point-min) (point-max)) - (insert com-str "\n") - (goto-char (point-min))) - (setq ex-token-type nil - ex-addresses nil) - (while cont - (vip-get-ex-token) - (cond ((memq ex-token-type '(command end-mark)) - (if address (setq ex-addresses (cons address ex-addresses))) - (cond ((string= ex-token "global") - (ex-global nil) - (setq cont nil)) - ((string= ex-token "vglobal") - (ex-global t) - (setq cont nil)) - (t - (vip-execute-ex-command) - (save-window-excursion - (setq vip-ex-work-buf - (get-buffer-create vip-ex-work-buf-name)) - (set-buffer vip-ex-work-buf) - (skip-chars-forward " \t") - (cond ((looking-at "|") - (forward-char 1)) - ((looking-at "\n") - (setq cont nil)) - (t (error "`%s': %s" ex-token vip-SpuriousText))) - )) - )) - ((eq ex-token-type 'non-command) - (error "`%s': %s" ex-token vip-BadExCommand)) - ((eq ex-token-type 'whole) - (setq address nil) - (setq ex-addresses - (if ex-addresses - (cons (point-max) ex-addresses) - (cons (point-max) (cons (point-min) ex-addresses))))) - ((eq ex-token-type 'comma) - (if (eq prev-token-type 'whole) - (setq address (point-min))) - (setq ex-addresses - (cons (if (null address) (point) address) ex-addresses))) - ((eq ex-token-type 'semi-colon) - (if (eq prev-token-type 'whole) - (setq address (point-min))) - (if address (setq dot address)) - (setq ex-addresses - (cons (if (null address) (point) address) ex-addresses))) - (t (let ((ans (vip-get-ex-address-subr address dot))) - (if ans (setq address ans))))) - (setq prev-token-type ex-token-type)))) - - -;; Get a regular expression and set `ex-variant', if found -(defun vip-get-ex-pat () - (save-window-excursion - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) - (set-buffer vip-ex-work-buf) - (skip-chars-forward " \t") - (if (looking-at "!") - (progn - (setq ex-g-variant (not ex-g-variant) - ex-g-flag (not ex-g-flag)) - (forward-char 1) - (skip-chars-forward " \t"))) - (let ((c (following-char))) - (if (string-match "[0-9A-Za-z]" (format "%c" c)) - (error - "Global regexp must be inside matching non-alphanumeric chars")) - (if (looking-at "[^\\\\\n]") - (progn - (forward-char 1) - (set-mark (point)) - (let ((cont t)) - (while (and (not (eolp)) cont) - (if (not (re-search-forward (format "[^%c]*%c" c c) nil t)) - (if (member ex-token '("global" "vglobal")) - (error - "Missing closing delimiter for global regexp") - (goto-char (point-max)))) - (if (not (vip-looking-back - (format "[^\\\\]\\(\\\\\\\\\\)*\\\\%c" c))) - (setq cont nil)))) - (setq ex-token - (if (= (mark t) (point)) "" - (buffer-substring (1- (point)) (mark t)))) - (backward-char 1)) - (setq ex-token nil)) - c))) - -;; get an ex command -(defun vip-get-ex-command () - (save-window-excursion - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) - (set-buffer vip-ex-work-buf) - (if (looking-at "/") (forward-char 1)) - (skip-chars-forward " \t") - (cond ((looking-at "[a-z]") - (vip-get-ex-com-subr) - (if (eq ex-token-type 'non-command) - (error "`%s': %s" ex-token vip-BadExCommand))) - ((looking-at "[!=><&~]") - (setq ex-token (char-to-string (following-char))) - (forward-char 1)) - (t (error vip-BadExCommand))))) - -;; Get an Ex option g or c -(defun vip-get-ex-opt-gc (c) - (save-window-excursion - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) - (set-buffer vip-ex-work-buf) - (if (looking-at (format "%c" c)) (forward-char 1)) - (skip-chars-forward " \t") - (cond ((looking-at "g") - (setq ex-token "g") - (forward-char 1) - t) - ((looking-at "c") - (setq ex-token "c") - (forward-char 1) - t) - (t nil)))) - -;; Compute default addresses. WHOLE-FLAG means use the whole buffer -(defun vip-default-ex-addresses (&optional whole-flag) - (cond ((null ex-addresses) - (setq ex-addresses - (if whole-flag - (cons (point-max) (cons (point-min) nil)) - (cons (point) (cons (point) nil))))) - ((null (cdr ex-addresses)) - (setq ex-addresses - (cons (car ex-addresses) ex-addresses))))) - -;; 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)) - (setq ex-token "") - (setq ex-flag nil) - (while cont - (vip-get-ex-token) - (cond ((eq ex-token-type 'command) - (if (member ex-token '("print" "list" "#")) - (progn - (setq ex-flag t - cont nil)) - (error "Address expected in this Ex command"))) - ((eq ex-token-type 'end-mark) - (setq cont nil)) - ((eq ex-token-type 'whole) - (error "Trailing address expected")) - ((eq ex-token-type 'comma) - (error "`%s': %s" ex-token vip-SpuriousText)) - (t (let ((ans (vip-get-ex-address-subr address (point-marker)))) - (if ans (setq address ans)))))) - address)) - -;; Returns an address as a point -(defun vip-get-ex-address-subr (old-address dot) - (let ((address nil)) - (if (null old-address) (setq old-address dot)) - (cond ((eq ex-token-type 'dot) - (setq address dot)) - ((eq ex-token-type 'add-number) - (save-excursion - (goto-char old-address) - (forward-line (if (= old-address 0) (1- ex-token) ex-token)) - (setq address (point-marker)))) - ((eq ex-token-type 'sub-number) - (save-excursion - (goto-char old-address) - (forward-line (- ex-token)) - (setq address (point-marker)))) - ((eq ex-token-type 'abs-number) - (save-excursion - (goto-char (point-min)) - (if (= ex-token 0) (setq address 0) - (forward-line (1- ex-token)) - (setq address (point-marker))))) - ((eq ex-token-type 'end) - (setq address (point-max-marker))) - ((eq ex-token-type 'plus) t) ; do nothing - ((eq ex-token-type 'minus) t) ; do nothing - ((eq ex-token-type 'search-forward) - (save-excursion - (ex-search-address t) - (setq address (point-marker)))) - ((eq ex-token-type 'search-backward) - (save-excursion - (ex-search-address nil) - (setq address (point-marker)))) - ((eq ex-token-type 'goto-mark) - (save-excursion - (if (null ex-token) - (exchange-point-and-mark) - (goto-char (vip-register-to-point - (1+ (- ex-token ?a)) 'enforce-buffer))) - (setq address (point-marker))))) - address)) - - -;; Search pattern and set address -(defun ex-search-address (forward) - (if (string= ex-token "") - (if (null vip-s-string) - (error vip-NoPrevSearch) - (setq ex-token vip-s-string)) - (setq vip-s-string ex-token)) - (if forward - (progn - (forward-line 1) - (re-search-forward ex-token)) - (forward-line -1) - (re-search-backward ex-token))) - -;; Get a buffer name and set `ex-count' and `ex-flag' if found -(defun vip-get-ex-buffer () - (setq ex-buffer nil) - (setq ex-count nil) - (setq ex-flag nil) - (save-window-excursion - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) - (set-buffer vip-ex-work-buf) - (skip-chars-forward " \t") - (if (looking-at "[a-zA-Z]") - (progn - (setq ex-buffer (following-char)) - (forward-char 1) - (skip-chars-forward " \t"))) - (if (looking-at "[0-9]") - (progn - (set-mark (point)) - (re-search-forward "[0-9][0-9]*") - (setq ex-count (string-to-int (buffer-substring (point) (mark t)))) - (skip-chars-forward " \t"))) - (if (looking-at "[pl#]") - (progn - (setq ex-flag t) - (forward-char 1))) - (if (not (looking-at "[\n|]")) - (error "`%s': %s" ex-token vip-SpuriousText)))) - -(defun vip-get-ex-count () - (setq ex-variant nil - ex-count nil - ex-flag nil) - (save-window-excursion - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) - (set-buffer vip-ex-work-buf) - (skip-chars-forward " \t") - (if (looking-at "!") - (progn - (setq ex-variant t) - (forward-char 1))) - (skip-chars-forward " \t") - (if (looking-at "[0-9]") - (progn - (set-mark (point)) - (re-search-forward "[0-9][0-9]*") - (setq ex-count (string-to-int (buffer-substring (point) (mark t)))) - (skip-chars-forward " \t"))) - (if (looking-at "[pl#]") - (progn - (setq ex-flag t) - (forward-char 1))) - (if (not (looking-at "[\n|]")) - (error "`%s': %s" - (buffer-substring (point-min) (1- (point-max))) vip-BadExCommand)))) - -;; Expand \% and \# in ex command -(defun ex-expand-filsyms (cmd buf) - (let (cf pf ret) - (save-excursion - (set-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 `#'")) - (save-excursion - (set-buffer (get-buffer-create vip-ex-tmp-buf-name)) - (erase-buffer) - (insert cmd) - (goto-char (point-min)) - (while (re-search-forward "%\\|#" nil t) - (let ((data (match-data)) - (char (buffer-substring (match-beginning 0) (match-end 0)))) - (if (vip-looking-back (concat "\\\\" char)) - (replace-match char) - (store-match-data data) - (if (string= char "%") - (replace-match cf) - (replace-match pf))))) - (end-of-line) - (setq ret (buffer-substring (point-min) (point))) - (message "%s" ret)) - ret)) - -;; Get a file name and set ex-variant, `ex-append' and `ex-offset' if found -(defun vip-get-ex-file () - (let (prompt) - (setq ex-file nil - ex-variant nil - ex-append nil - ex-offset nil - ex-cmdfile nil) - (save-excursion - (save-window-excursion - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) - (set-buffer vip-ex-work-buf) - (skip-chars-forward " \t") - (if (looking-at "!") - (if (and (not (vip-looking-back "[ \t]")) - ;; read doesn't have a corresponding :r! form, so ! is - ;; immediately interpreted as a shell command. - (not (string= ex-token "read"))) - (progn - (setq ex-variant t) - (forward-char 1) - (skip-chars-forward " \t")) - (setq ex-cmdfile t) - (forward-char 1) - (skip-chars-forward " \t"))) - (if (looking-at ">>") - (progn - (setq ex-append t - ex-variant t) - (forward-char 2) - (skip-chars-forward " \t"))) - (if (looking-at "+") - (progn - (forward-char 1) - (set-mark (point)) - (re-search-forward "[ \t\n]") - (backward-char 1) - (setq ex-offset (buffer-substring (point) (mark t))) - (forward-char 1) - (skip-chars-forward " \t"))) - ;; this takes care of :r, :w, etc., when they get file names - ;; from the history list - (if (member ex-token '("read" "write" "edit" "visual" "next")) - (progn - (setq ex-file (buffer-substring (point) (1- (point-max)))) - (setq ex-file - ;; For :e, match multiple non-white strings separated - ;; by white. For others, find the first non-white string - (if (string-match - (if (string= ex-token "edit") - "[^ \t\n]+\\([ \t]+[^ \t\n]+\\)*" - "[^ \t\n]+") - ex-file) - (progn - ;; if file name comes from history, don't leave - ;; minibuffer when the user types space - (setq vip-incomplete-ex-cmd nil) - ;; this must be the last clause in this progn - (substring ex-file (match-beginning 0) (match-end 0)) - ) - "")) - ;; this leaves only the command name in the work area - ;; file names are gone - (delete-region (point) (1- (point-max))) - )) - (goto-char (point-max)) - (skip-chars-backward " \t\n") - (setq prompt (buffer-substring (point-min) (point))) - )) - - (setq vip-last-ex-prompt prompt) - - ;; If we just finished reading command, redisplay prompt - (if vip-incomplete-ex-cmd - (setq ex-file (vip-ex-read-file-name (format ":%s " prompt))) - ;; file was typed in-line - (setq ex-file (or ex-file ""))) - )) - - -;; Completes file name or exits minibuffer. If Ex command accepts multiple -;; file names, arranges to re-enter the minibuffer. -(defun vip-complete-filename-or-exit () - (interactive) - (setq vip-keep-reading-filename t) - ;; don't exit if directory---ex-commands don't - (cond ((ex-cmd-accepts-multiple-files-p ex-token) (exit-minibuffer)) - ;; apparently the argument to an Ex command is - ;; supposed to be a shell command - ((vip-looking-back "^[ \t]*!.*") - (setq ex-cmdfile t) - (insert " ")) - (t - (setq ex-cmdfile nil) - (minibuffer-complete-word)))) - -(defun vip-handle-! () - (interactive) - (if (and (string= - (buffer-string) (vip-abbreviate-file-name default-directory)) - (member ex-token '("read" "write"))) - (erase-buffer)) - (insert "!")) - -(defun ex-cmd-accepts-multiple-files-p (token) - (member token '("edit" "next" "Next"))) - -;; If user doesn't enter anything, then "" is returned, i.e., the -;; prompt-directory is not returned. -(defun vip-ex-read-file-name (prompt) - (let* ((str "") - (minibuffer-local-completion-map - (copy-keymap minibuffer-local-completion-map)) - beg end cont val) - - (vip-add-keymap ex-read-filename-map - (if vip-emacs-p - minibuffer-local-completion-map - read-file-name-map)) - - (setq cont (setq vip-keep-reading-filename t)) - (while cont - (setq vip-keep-reading-filename nil - val (read-file-name (concat prompt str) nil default-directory)) - (if (string-match " " val) - (setq val (concat "\\\"" val "\\\""))) - (setq str (concat str (if (equal val "") "" " ") - val (if (equal val "") "" " "))) - - ;; Only edit, next, and Next commands accept multiple files. - ;; vip-keep-reading-filename is set in the anonymous function that is - ;; bound to " " in ex-read-filename-map. - (setq cont (and vip-keep-reading-filename - (ex-cmd-accepts-multiple-files-p ex-token))) - ) - - (setq beg (string-match "[^ \t]" str) ; delete leading blanks - end (string-match "[ \t]*$" str)) ; delete trailing blanks - (if (member ex-token '("read" "write")) - (if (string-match "[\t ]*!" str) - ;; this is actually a shell command - (progn - (setq ex-cmdfile t) - (setq beg (1+ beg)) - (setq vip-last-ex-prompt (concat vip-last-ex-prompt " !"))))) - (substring str (or beg 0) end))) - -;; Execute ex command using the value of addresses -(defun vip-execute-ex-command () - (vip-deactivate-mark) - (cond ((string= ex-token "args") (ex-args)) - ((string= ex-token "copy") (ex-copy nil)) - ((string= ex-token "cd") (ex-cd)) - ((string= ex-token "chdir") (ex-cd)) - ((string= ex-token "delete") (ex-delete)) - ((string= ex-token "edit") (ex-edit)) - ((string= ex-token "file") (vip-info-on-file)) - ((string= ex-token "goto") (ex-goto)) - ((string= ex-token "help") (ex-help)) - ((string= ex-token "join") (ex-line "join")) - ((string= ex-token "kmark") (ex-mark)) - ((string= ex-token "mark") (ex-mark)) - ((string= ex-token "map") (ex-map)) - ((string= ex-token "move") (ex-copy t)) - ((string= ex-token "next") (ex-next ex-cycle-other-window)) - ((string= ex-token "Next") (ex-next (not ex-cycle-other-window))) - ((string= ex-token "RelatedFile") (ex-next-related-buffer 1)) - ((string= ex-token "put") (ex-put)) - ((string= ex-token "pwd") (ex-pwd)) - ((string= ex-token "preserve") (ex-preserve)) - ((string= ex-token "PreviousRelatedFile") (ex-next-related-buffer -1)) - ((string= ex-token "quit") (ex-quit)) - ((string= ex-token "read") (ex-read)) - ((string= ex-token "recover") (ex-recover)) - ((string= ex-token "rewind") (ex-rewind)) - ((string= ex-token "submitReport") (vip-submit-report)) - ((string= ex-token "set") (ex-set)) - ((string= ex-token "shell") (ex-shell)) - ((string= ex-token "source") (ex-source)) - ((string= ex-token "sr") (ex-substitute t t)) - ((string= ex-token "substitute") (ex-substitute)) - ((string= ex-token "suspend") (suspend-emacs)) - ((string= ex-token "stop") (suspend-emacs)) - ((string= ex-token "transfer") (ex-copy nil)) - ((string= ex-token "buffer") (if ex-cycle-other-window - (vip-switch-to-buffer-other-window) - (vip-switch-to-buffer))) - ((string= ex-token "Buffer") (if ex-cycle-other-window - (vip-switch-to-buffer) - (vip-switch-to-buffer-other-window))) - ((string= ex-token "tag") (ex-tag)) - ((string= ex-token "undo") (vip-undo)) - ((string= ex-token "unmap") (ex-unmap)) - ((string= ex-token "version") (vip-version)) - ((string= ex-token "visual") (ex-edit)) - ((string= ex-token "write") (ex-write nil)) - ((string= ex-token "Write") (save-some-buffers)) - ((string= ex-token "wq") (ex-write t)) - ((string= ex-token "WWrite") (save-some-buffers t)) ; don't ask - ((string= ex-token "xit") (ex-write t)) - ((string= ex-token "yank") (ex-yank)) - ((string= ex-token "!") (ex-command)) - ((string= ex-token "=") (ex-line-no)) - ((string= ex-token ">") (ex-line "right")) - ((string= ex-token "<") (ex-line "left")) - ((string= ex-token "&") (ex-substitute t)) - ((string= ex-token "~") (ex-substitute t t)) - ((or (string= ex-token "append") - (string= ex-token "change") - (string= ex-token "insert") - (string= ex-token "open")) - (error "`%s': Obsolete command, not supported by Viper" ex-token)) - ((or (string= ex-token "abbreviate") - (string= ex-token "unabbreviate")) - (error - "`%s': Vi abbrevs are obsolete. Use the more powerful Emacs abbrevs" - ex-token)) - ((or (string= ex-token "list") - (string= ex-token "print") - (string= ex-token "z") - (string= ex-token "#")) - (error "`%s': Command not implemented in Viper" ex-token)) - (t (error "`%s': %s" ex-token vip-BadExCommand)))) - -(defun vip-undisplayed-files () - (mapcar - (function - (lambda (b) - (if (null (get-buffer-window b)) - (let ((f (buffer-file-name b))) - (if f f - (if ex-cycle-through-non-files - (let ((s (buffer-name b))) - (if (string= " " (substring s 0 1)) - nil - s)) - nil))) - nil))) - (buffer-list))) - - -(defun ex-args () - (let ((l (vip-undisplayed-files)) - (args "") - (file-count 1)) - (while (not (null l)) - (if (car l) - (setq args (format "%s %d) %s\n" args file-count (car l)) - file-count (1+ file-count))) - (setq l (cdr l))) - (if (string= args "") - (message "All files are already displayed") - (save-excursion - (save-window-excursion - (with-output-to-temp-buffer " *vip-info*" - (princ "\n\nThese files are not displayed in any window.\n") - (princ "\n=============\n") - (princ args) - (princ "\n=============\n") - (princ "\nThe numbers can be given as counts to :next. ") - (princ "\n\nPress any key to continue...\n\n")) - (vip-read-event)))))) - -;; Ex cd command. Default directory of this buffer changes -(defun ex-cd () - (vip-get-ex-file) - (if (string= ex-file "") - (setq ex-file "~")) - (setq default-directory (file-name-as-directory (expand-file-name ex-file)))) - -;; Ex copy and move command. DEL-FLAG means delete -(defun ex-copy (del-flag) - (vip-default-ex-addresses) - (let ((address (vip-get-ex-address)) - (end (car ex-addresses)) (beg (car (cdr ex-addresses)))) - (goto-char end) - (save-excursion - (push-mark beg t) - (vip-enlarge-region (mark t) (point)) - (if del-flag - (kill-region (point) (mark t)) - (copy-region-as-kill (point) (mark t))) - (if ex-flag - (progn - (with-output-to-temp-buffer "*copy text*" - (princ - (if (or del-flag ex-g-flag ex-g-variant) - (current-kill 0) - (buffer-substring (point) (mark t))))) - (condition-case nil - (progn - (read-string "[Hit return to continue] ") - (save-excursion (kill-buffer "*copy text*"))) - (quit (save-excursion (kill-buffer "*copy text*")) - (signal 'quit nil)))))) - (if (= address 0) - (goto-char (point-min)) - (goto-char address) - (forward-line 1)) - (insert (current-kill 0)))) - -;; Ex delete command -(defun ex-delete () - (vip-default-ex-addresses) - (vip-get-ex-buffer) - (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) - (if (> beg end) (error vip-FirstAddrExceedsSecond)) - (save-excursion - (vip-enlarge-region beg end) - (exchange-point-and-mark) - (if ex-count - (progn - (set-mark (point)) - (forward-line (1- ex-count))) - (set-mark end)) - (vip-enlarge-region (point) (mark t)) - (if ex-flag - ;; show text to be deleted and ask for confirmation - (progn - (with-output-to-temp-buffer " *delete text*" - (princ (buffer-substring (point) (mark t)))) - (condition-case nil - (read-string "[Hit return to continue] ") - (quit - (save-excursion (kill-buffer " *delete text*")) - (error ""))) - (save-excursion (kill-buffer " *delete text*"))) - (if ex-buffer - (cond ((vip-valid-register ex-buffer '(Letter)) - (vip-append-to-register - (downcase ex-buffer) (point) (mark t))) - ((vip-valid-register ex-buffer) - (copy-to-register ex-buffer (point) (mark t) nil)) - (t (error vip-InvalidRegister ex-buffer)))) - (kill-region (point) (mark t)))))) - - - -;; Ex edit command -;; In Viper, `e' and `e!' behave identically. In both cases, the user is -;; asked if current buffer should really be discarded. -;; This command can take multiple file names. It replaces the current buffer -;; with the first file in its argument list -(defun ex-edit (&optional file) - (if (not file) - (vip-get-ex-file)) - (cond ((and (string= ex-file "") buffer-file-name) - (setq ex-file (vip-abbreviate-file-name (buffer-file-name)))) - ((string= ex-file "") - (error vip-NoFileSpecified))) - - (let (msg do-edit) - (if buffer-file-name - (cond ((buffer-modified-p) - (setq msg - (format "Buffer %s is modified. Discard changes? " - (buffer-name)) - do-edit t)) - ((not (verify-visited-file-modtime (current-buffer))) - (setq msg - (format "File %s changed on disk. Reread from disk? " - buffer-file-name) - do-edit t)) - (t (setq do-edit nil)))) - - (if do-edit - (if (yes-or-no-p msg) - (progn - (set-buffer-modified-p nil) - (kill-buffer (current-buffer))) - (message "Buffer %s was left intact" (buffer-name)))) - ) ; let - - (if (null (setq file (get-file-buffer ex-file))) - (progn - (ex-find-file ex-file) - (or (eq major-mode 'dired-mode) - (vip-change-state-to-vi)) - (goto-char (point-min))) - (switch-to-buffer file)) - (if ex-offset - (progn - (save-window-excursion - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) - (set-buffer vip-ex-work-buf) - (delete-region (point-min) (point-max)) - (insert ex-offset "\n") - (goto-char (point-min))) - (goto-char (vip-get-ex-address)) - (beginning-of-line))) - (ex-fixup-history vip-last-ex-prompt ex-file)) - -;; Find-file FILESPEC if it appears to specify a single file. -;; Otherwise, assume that FILES{EC is a wildcard. -;; In this case, split it into substrings separated by newlines. -;; Each line is assumed to be a file name. find-file's each file thus obtained. -(defun ex-find-file (filespec) - (let ((nonstandard-filename-chars "[^-a-zA-Z0-9_./,~$\\]")) - (cond ((file-exists-p filespec) (find-file filespec)) - ((string-match nonstandard-filename-chars filespec) - (funcall ex-nontrivial-find-file-function filespec)) - (t (find-file filespec))) - )) - - -;; Ex global command -(defun ex-global (variant) - (let ((gcommand ex-token)) - (if (or ex-g-flag ex-g-variant) - (error "`%s' within `global' is not allowed" gcommand) - (if variant - (setq ex-g-flag nil - ex-g-variant t) - (setq ex-g-flag t - ex-g-variant nil))) - (vip-get-ex-pat) - (if (null ex-token) - (error "`%s': Missing regular expression" gcommand))) - - (if (string= ex-token "") - (if (null vip-s-string) - (error vip-NoPrevSearch) - (setq ex-g-pat vip-s-string)) - (setq ex-g-pat ex-token - vip-s-string ex-token)) - (if (null ex-addresses) - (setq ex-addresses (list (point-max) (point-min))) - (vip-default-ex-addresses)) - (let ((marks nil) (mark-count 0) - com-str (end (car ex-addresses)) (beg (car (cdr ex-addresses)))) - (if (> beg end) (error vip-FirstAddrExceedsSecond)) - (save-excursion - (vip-enlarge-region beg end) - (exchange-point-and-mark) - (let ((cont t) (limit (point-marker))) - (exchange-point-and-mark) - ;; skip the last line if empty - (beginning-of-line) - (if (eobp) (vip-backward-char-carefully)) - (while (and cont (not (bobp)) (>= (point) limit)) - (beginning-of-line) - (set-mark (point)) - (end-of-line) - (let ((found (re-search-backward ex-g-pat (mark t) t))) - (if (or (and ex-g-flag found) - (and ex-g-variant (not found))) - (progn - (end-of-line) - (setq mark-count (1+ mark-count)) - (setq marks (cons (point-marker) marks))))) - (beginning-of-line) - (if (bobp) (setq cont nil) - (forward-line -1) - (end-of-line))))) - (save-window-excursion - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) - (set-buffer vip-ex-work-buf) - (setq com-str (buffer-substring (1+ (point)) (1- (point-max))))) - (while marks - (goto-char (car marks)) - (vip-ex com-str) - (setq mark-count (1- mark-count)) - (setq marks (cdr marks))))) - -;; Ex goto command -(defun ex-goto () - (if (null ex-addresses) - (setq ex-addresses (cons (point) nil))) - (push-mark (point) t) - (goto-char (car ex-addresses)) - (beginning-of-line)) - -;; Ex line commands. COM is join, shift-right or shift-left -(defun ex-line (com) - (vip-default-ex-addresses) - (vip-get-ex-count) - (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) point) - (if (> beg end) (error vip-FirstAddrExceedsSecond)) - (save-excursion - (vip-enlarge-region beg end) - (exchange-point-and-mark) - (if ex-count - (progn - (set-mark (point)) - (forward-line ex-count))) - (if ex-flag - ;; show text to be joined and ask for confirmation - (progn - (with-output-to-temp-buffer " *text*" - (princ (buffer-substring (point) (mark t)))) - (condition-case nil - (progn - (read-string "[Hit return to continue] ") - (ex-line-subr com (point) (mark t))) - (quit (ding))) - (save-excursion (kill-buffer " *text*"))) - (ex-line-subr com (point) (mark t))) - (setq point (point))) - (goto-char (1- point)) - (beginning-of-line))) - -(defun ex-line-subr (com beg end) - (cond ((string= com "join") - (goto-char (min beg end)) - (while (and (not (eobp)) (< (point) (max beg end))) - (end-of-line) - (if (and (<= (point) (max beg end)) (not (eobp))) - (progn - (forward-line 1) - (delete-region (point) (1- (point))) - (if (not ex-variant) (fixup-whitespace)))))) - ((or (string= com "right") (string= com "left")) - (indent-rigidly - (min beg end) (max beg end) - (if (string= com "right") vip-shift-width (- vip-shift-width))) - (goto-char (max beg end)) - (end-of-line) - (vip-forward-char-carefully)))) - - -;; Ex mark command -(defun ex-mark () - (let (char) - (if (null ex-addresses) - (setq ex-addresses - (cons (point) nil))) - (save-window-excursion - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) - (set-buffer vip-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 vip-SpuriousText))) - (error "`%s' requires a following letter" ex-token))) - (save-excursion - (goto-char (car ex-addresses)) - (point-to-register (1+ (- char ?a)))))) - - - -;; Alternate file is the file next to the first one in the buffer ring -(defun ex-next (cycle-other-window &optional find-alt-file) - (catch 'ex-edit - (let (count l) - (if (not find-alt-file) - (progn - (vip-get-ex-file) - (if (or (char-or-string-p ex-offset) - (and (not (string= "" ex-file)) - (not (string-match "^[0-9]+$" ex-file)))) - (progn - (ex-edit t) - (throw 'ex-edit nil)) - (setq count (string-to-int ex-file)) - (if (= count 0) (setq count 1)) - (if (< count 0) (error "Usage: `next <count>' (count >= 0)")))) - (setq count 1)) - (setq l (vip-undisplayed-files)) - (while (> count 0) - (while (and (not (null l)) (null (car l))) - (setq l (cdr l))) - (setq count (1- count)) - (if (> count 0) - (setq l (cdr l)))) - (if find-alt-file (car l) - (progn - (if (and (car l) (get-file-buffer (car l))) - (let* ((w (if cycle-other-window - (get-lru-window) (selected-window))) - (b (window-buffer w))) - (set-window-buffer w (get-file-buffer (car l))) - (bury-buffer b) - ;; this puts "next <count>" in the ex-command history - (ex-fixup-history vip-last-ex-prompt ex-file)) - (error "Not that many undisplayed files"))))))) - - -(defun ex-next-related-buffer (direction &optional no-recursion) - - (vip-ring-rotate1 vip-related-files-and-buffers-ring direction) - - (let ((file-or-buffer-name - (vip-current-ring-item vip-related-files-and-buffers-ring)) - (old-ring vip-related-files-and-buffers-ring) - (old-win (selected-window)) - skip-rest buf wind) - - (or (and (ring-p vip-related-files-and-buffers-ring) - (> (ring-length vip-related-files-and-buffers-ring) 0)) - (error "This buffer has no related files or buffers")) - - (or (stringp file-or-buffer-name) - (error - "File and buffer names must be strings, %S" file-or-buffer-name)) - - (setq buf (cond ((get-buffer file-or-buffer-name)) - ((file-exists-p file-or-buffer-name) - (find-file-noselect file-or-buffer-name)) - )) - - (if (not (vip-buffer-live-p buf)) - (error "Didn't find buffer %S or file %S" - file-or-buffer-name - (vip-abbreviate-file-name - (expand-file-name file-or-buffer-name)))) - - (if (equal buf (current-buffer)) - (or no-recursion - ;; try again - (progn - (setq skip-rest t) - (ex-next-related-buffer direction 'norecursion)))) - - (if skip-rest - () - ;; setup buffer - (if (setq wind (vip-get-visible-buffer-window buf)) - () - (setq wind (get-lru-window (if vip-xemacs-p nil 'visible))) - (set-window-buffer wind buf)) - - (if (vip-window-display-p) - (progn - (raise-frame (window-frame wind)) - (if (equal (window-frame wind) (window-frame old-win)) - (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) - (setq vip-related-files-and-buffers-ring old-ring)) - - (setq vip-local-search-start-marker (point-marker)) - ))) - - -;; Force auto save -(defun ex-preserve () - (message "Autosaving all buffers that need to be saved...") - (do-auto-save t)) - -;; Ex put -(defun ex-put () - (let ((point (if (null ex-addresses) (point) (car ex-addresses)))) - (vip-get-ex-buffer) - (setq vip-use-register ex-buffer) - (goto-char point) - (if (bobp) (vip-Put-back 1) (vip-put-back 1)))) - -;; Ex print working directory -(defun ex-pwd () - (message default-directory)) - -;; Ex quit command -(defun ex-quit () - ;; skip "!", if it is q!. In Viper q!, w!, etc., behave as q, w, etc. - (save-excursion - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) - (set-buffer vip-ex-work-buf) - (if (looking-at "!") (forward-char 1))) - (if (< vip-expert-level 3) - (save-buffers-kill-emacs) - (kill-buffer (current-buffer)))) - - -;; Ex read command -(defun ex-read () - (vip-get-ex-file) - (let ((point (if (null ex-addresses) (point) (car ex-addresses))) - command) - (goto-char point) - (vip-add-newline-at-eob-if-necessary) - (if (not (or (bobp) (eobp))) (forward-line 1)) - (if (and (not ex-variant) (string= ex-file "")) - (progn - (if (null buffer-file-name) - (error vip-NoFileSpecified)) - (setq ex-file buffer-file-name))) - (if ex-cmdfile - (progn - (setq command (ex-expand-filsyms ex-file (current-buffer))) - (shell-command command t)) - (insert-file-contents ex-file))) - (ex-fixup-history vip-last-ex-prompt ex-file)) - -;; this function fixes ex-history for some commands like ex-read, ex-edit -(defun ex-fixup-history (&rest args) - (setq vip-ex-history - (cons (mapconcat 'identity args " ") (cdr vip-ex-history)))) - - -;; Ex recover from emacs \#file\# -(defun ex-recover () - (vip-get-ex-file) - (if (or ex-append ex-offset) - (error "`recover': %s" vip-SpuriousText)) - (if (string= ex-file "") - (progn - (if (null buffer-file-name) - (error "This buffer isn't visiting any file")) - (setq ex-file buffer-file-name)) - (setq ex-file (expand-file-name ex-file))) - (if (and (not (string= ex-file (buffer-file-name))) - (buffer-modified-p) - (not ex-variant)) - (error "No write since last change \(:rec! overrides\)")) - (recover-file ex-file)) - -;; Tell that `rewind' is obsolete and to use `:next count' instead -(defun ex-rewind () - (message - "Use `:n <count>' instead. Counts are obtained from the `:args' command")) - - -;; read variable name for ex-set -(defun ex-set-read-variable () - (let ((minibuffer-local-completion-map - (copy-keymap minibuffer-local-completion-map)) - (cursor-in-echo-area t) - str batch) - (define-key - minibuffer-local-completion-map " " 'minibuffer-complete-and-exit) - (define-key minibuffer-local-completion-map "=" 'exit-minibuffer) - (if (vip-set-unread-command-events - (ex-get-inline-cmd-args "[ \t]*[a-zA-Z]*[ \t]*" nil "\C-m")) - (progn - (setq batch t) - (vip-set-unread-command-events ?\C-m))) - (message ":set <Variable> [= <Value>]") - (or batch (sit-for 2)) - - (while (string-match "^[ \\t\\n]*$" - (setq str - (completing-read ":set " ex-variable-alist))) - (message ":set <Variable> ") - ;; if there are unread events, don't wait - (or (vip-set-unread-command-events "") (sit-for 2)) - ) ; while - str)) - - -(defun ex-set () - (let ((var (ex-set-read-variable)) - (val 0) - (set-cmd "setq") - (ask-if-save t) - (auto-cmd-label "; don't touch or else...") - (delete-turn-on-auto-fill-pattern - "([ \t]*add-hook[ \t]+'vip-insert-state-hooks[ \t]+'turn-on-auto-fill.*)") - actual-lisp-cmd lisp-cmd-del-pattern - val2 orig-var) - (setq orig-var var) - (cond ((member var '("ai" "autoindent")) - (setq var "vip-auto-indent" - set-cmd "setq" - ask-if-save nil - val "t")) - ((member var '("gai" "global-autoindent")) - (kill-local-variable 'vip-auto-indent) - (setq var "vip-auto-indent" - set-cmd "setq-default" - val "t")) - ((member var '("noai" "noautoindent")) - (setq var "vip-auto-indent" - ask-if-save nil - val "nil")) - ((member var '("gnoai" "global-noautoindent")) - (kill-local-variable 'vip-auto-indent) - (setq var "vip-auto-indent" - set-cmd "setq-default" - val "nil")) - ((member var '("ic" "ignorecase")) - (setq var "vip-case-fold-search" - val "t")) - ((member var '("noic" "noignorecase")) - (setq var "vip-case-fold-search" - val "nil")) - ((member var '("ma" "magic")) - (setq var "vip-re-search" - val "t")) - ((member var '("noma" "nomagic")) - (setq var "vip-re-search" - val "nil")) - ((member var '("ro" "readonly")) - (setq var "buffer-read-only" - val "t")) - ((member var '("noro" "noreadonly")) - (setq var "buffer-read-only" - val "nil")) - ((member var '("sm" "showmatch")) - (setq var "blink-matching-paren" - val "t")) - ((member var '("nosm" "noshowmatch")) - (setq var "blink-matching-paren" - val "nil")) - ((member var '("ws" "wrapscan")) - (setq var "vip-search-wrap-around-t" - val "t")) - ((member var '("nows" "nowrapscan")) - (setq var "vip-search-wrap-around-t" - val "nil"))) - (if (eq val 0) ; value must be set by the user - (let ((cursor-in-echo-area t)) - (message ":set %s = <Value>" var) - ;; if there are unread events, don't wait - (or (vip-set-unread-command-events "") (sit-for 2)) - (setq val (read-string (format ":set %s = " var))) - (ex-fixup-history "set" orig-var val) - - ;; check numerical values - (if (member var - '("sw" "shiftwidth" - "ts" "tabstop" - "gts" "global-tabstop" - "wm" "wrapmargin")) - (condition-case nil - (or (numberp (setq val2 (car (read-from-string val)))) - (error "%s: Invalid value, numberp, %S" var val)) - (error - (error "%s: Invalid value, numberp, %S" var val)))) - - (cond - ((member var '("sw" "shiftwidth")) - (setq var "vip-shift-width")) - ((member var '("ts" "tabstop")) - ;; make it take effect in curr buff and new bufs - (setq var "tab-width" - set-cmd "setq" - ask-if-save nil)) - ((member var '("gts" "global-tabstop")) - (kill-local-variable 'tab-width) - (setq var "tab-width" - set-cmd "setq-default")) - ((member var '("wm" "wrapmargin")) - ;; make it take effect in curr buff and new bufs - (kill-local-variable 'fill-column) - (setq var "fill-column" - val (format "(- (window-width) %s)" val) - set-cmd "setq-default")) - ((member var '("sh" "shell")) - (setq var "explicit-shell-file-name" - val (format "\"%s\"" val))))) - (ex-fixup-history "set" orig-var)) - - (setq actual-lisp-cmd (format "\n(%s %s %s) %s" - set-cmd var val auto-cmd-label)) - (setq lisp-cmd-del-pattern - (format "^\n?[ \t]*([ \t]*%s[ \t]+%s[ \t].*)[ \t]*%s" - set-cmd var auto-cmd-label)) - - (if (and ask-if-save - (y-or-n-p (format "Do you want to save this setting in %s " - vip-custom-file-name))) - (progn - (vip-save-string-in-file - actual-lisp-cmd vip-custom-file-name - ;; del pattern - lisp-cmd-del-pattern) - (if (string= var "fill-column") - (if (> val2 0) - (vip-save-string-in-file - (concat - "(add-hook 'vip-insert-state-hooks 'turn-on-auto-fill) " - auto-cmd-label) - vip-custom-file-name - delete-turn-on-auto-fill-pattern) - (vip-save-string-in-file - nil vip-custom-file-name delete-turn-on-auto-fill-pattern) - (vip-save-string-in-file - nil vip-custom-file-name - ;; del pattern - lisp-cmd-del-pattern) - )) - )) - - (message "%s %s %s" set-cmd var (if (string-match "^[ \t]*$" val) - (format "%S" val) - val)) - (eval (car (read-from-string actual-lisp-cmd))) - (if (string= var "fill-column") - (if (> val2 0) - (auto-fill-mode 1) - (auto-fill-mode -1))) - - )) - -;; In inline args, skip regex-forw and (optionally) chars-back. -;; 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 vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) - (set-buffer vip-ex-work-buf) - (goto-char (point-min)) - (re-search-forward regex-forw nil t) - (let ((beg (point)) - end) - (goto-char (point-max)) - (if chars-back - (skip-chars-backward chars-back) - (skip-chars-backward " \t\n\C-m")) - (setq end (point)) - ;; replace SPC with `=' to suppress the special meaning SPC has - ;; in Ex commands - (goto-char beg) - (if replace-str - (while (re-search-forward " +" nil t) - (replace-match replace-str nil t) - (vip-forward-char-carefully))) - (goto-char end) - (buffer-substring beg end)))) - - -;; Ex shell command -(defun ex-shell () - (shell)) - -;; Viper help. Invokes Info -(defun ex-help () - (condition-case nil - (progn - (pop-to-buffer (get-buffer-create "*info*")) - (info (if vip-xemacs-p "viper.info" "viper")) - (message "Type `i' to search for a specific topic")) - (error (beep 1) - (with-output-to-temp-buffer " *vip-info*" - (princ (format " -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. " - (if vip-xemacs-p "X" "") - )))))) - -;; Ex source command. Loads the file specified as argument or `~/.vip' -(defun ex-source () - (vip-get-ex-file) - (if (string= ex-file "") - (load vip-custom-file-name) - (load ex-file))) - -;; Ex substitute command -;; If REPEAT use previous regexp which is ex-reg-exp or vip-s-string -(defun ex-substitute (&optional repeat r-flag) - (let ((opt-g nil) - (opt-c nil) - (matched-pos nil) - (case-fold-search vip-case-fold-search) - delim pat repl) - (if repeat (setq ex-token nil) (setq delim (vip-get-ex-pat))) - (if (null ex-token) - (progn - (setq pat (if r-flag vip-s-string ex-reg-exp)) - (or (stringp pat) - (error "No previous pattern to use in substitution")) - (setq repl ex-repl - delim (string-to-char pat))) - (setq pat (if (string= ex-token "") vip-s-string ex-token)) - (setq vip-s-string pat - ex-reg-exp pat) - (setq delim (vip-get-ex-pat)) - (if (null ex-token) - (setq ex-token "" - ex-repl "") - (setq repl ex-token - ex-repl ex-token))) - (while (vip-get-ex-opt-gc delim) - (if (string= ex-token "g") (setq opt-g t) (setq opt-c t))) - (vip-get-ex-count) - (if ex-count - (save-excursion - (if ex-addresses (goto-char (car ex-addresses))) - (set-mark (point)) - (forward-line (1- ex-count)) - (setq ex-addresses (cons (point) (cons (mark t) nil)))) - (if (null ex-addresses) - (setq ex-addresses (cons (point) (cons (point) nil))) - (if (null (cdr ex-addresses)) - (setq ex-addresses (cons (car ex-addresses) ex-addresses))))) - ;(setq G opt-g) - (let ((beg (car ex-addresses)) - (end (car (cdr ex-addresses))) - eol-mark) - (save-excursion - (vip-enlarge-region beg end) - (let ((limit (save-excursion - (goto-char (max (point) (mark t))) - (point-marker)))) - (goto-char (min (point) (mark t))) - (while (< (point) limit) - (end-of-line) - (setq eol-mark (point-marker)) - (beginning-of-line) - (if opt-g - (progn - (while (and (not (eolp)) - (re-search-forward pat eol-mark t)) - (if (or (not opt-c) (y-or-n-p "Replace? ")) - (progn - (setq matched-pos (point)) - (if (not (stringp repl)) - (error "Can't perform Ex substitution: No previous replacement pattern")) - (replace-match repl t)))) - (end-of-line) - (vip-forward-char-carefully)) - (if (null pat) - (error - "Can't repeat Ex substitution: No previous regular expression")) - (if (and (re-search-forward pat eol-mark t) - (or (not opt-c) (y-or-n-p "Replace? "))) - (progn - (setq matched-pos (point)) - (if (not (stringp repl)) - (error "Can't perform Ex substitution: No previous replacement pattern")) - (replace-match repl t))) - (end-of-line) - (vip-forward-char-carefully)))))) - (if matched-pos (goto-char matched-pos)) - (beginning-of-line) - (if opt-c (message "done")))) - -;; Ex tag command -(defun ex-tag () - (let (tag) - (save-window-excursion - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) - (set-buffer vip-ex-work-buf) - (skip-chars-forward " \t") - (set-mark (point)) - (skip-chars-forward "^ |\t\n") - (setq tag (buffer-substring (mark t) (point)))) - (if (not (string= tag "")) (setq ex-tag tag)) - (vip-change-state-to-emacs) - (condition-case conds - (progn - (if (string= tag "") - (find-tag ex-tag t) - (find-tag-other-window ex-tag)) - (vip-change-state-to-vi)) - (error - (vip-change-state-to-vi) - (vip-message-conditions conds))))) - -;; Ex write command -(defun ex-write (q-flag) - (vip-default-ex-addresses t) - (vip-get-ex-file) - (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) - temp-buf writing-same-file region - file-exists writing-whole-file) - (if (> beg end) (error vip-FirstAddrExceedsSecond)) - (if ex-cmdfile - (progn - (vip-enlarge-region beg end) - (shell-command-on-region (point) (mark t) ex-file)) - (if (and (string= ex-file "") (not (buffer-file-name))) - (setq ex-file - (read-file-name - (format "Buffer %s isn't visiting any file. File to save in: " - (buffer-name))))) - - (setq writing-whole-file (and (= (point-min) beg) (= (point-max) end)) - ex-file (if (string= ex-file "") - (buffer-file-name) - (expand-file-name ex-file))) - ;; if ex-file is a directory use the file portion of the buffer file name - (if (and (file-directory-p ex-file) - buffer-file-name - (not (file-directory-p buffer-file-name))) - (setq ex-file - (concat 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))) - - (if (and writing-whole-file writing-same-file) - (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) - )) - ) - ;; this prevents the loss of data if writing part of the buffer - (if (and (buffer-file-name) writing-same-file) - (set-visited-file-modtime)) - (or writing-whole-file - (not writing-same-file) - (set-buffer-modified-p t)) - (if q-flag - (if (< vip-expert-level 2) - (save-buffers-kill-emacs) - (kill-buffer (current-buffer)))) - ))) - - -(defun ex-write-info (exists file-name beg end) - (message "`%s'%s %d lines, %d characters" - (vip-abbreviate-file-name file-name) - (if exists "" " [New file]") - (count-lines beg (min (1+ end) (point-max))) - (- end beg))) - -;; Ex yank command -(defun ex-yank () - (vip-default-ex-addresses) - (vip-get-ex-buffer) - (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) - (if (> beg end) (error vip-FirstAddrExceedsSecond)) - (save-excursion - (vip-enlarge-region beg end) - (exchange-point-and-mark) - (if (or ex-g-flag ex-g-variant) - (error "Can't execute `yank' within `global'")) - (if ex-count - (progn - (set-mark (point)) - (forward-line (1- ex-count))) - (set-mark end)) - (vip-enlarge-region (point) (mark t)) - (if ex-flag (error "`yank': %s" vip-SpuriousText)) - (if ex-buffer - (cond ((vip-valid-register ex-buffer '(Letter)) - (vip-append-to-register - (downcase ex-buffer) (point) (mark t))) - ((vip-valid-register ex-buffer) - (copy-to-register ex-buffer (point) (mark t) nil)) - (t (error vip-InvalidRegister ex-buffer)))) - (copy-region-as-kill (point) (mark t))))) - -;; Execute shell command -(defun ex-command () - (let (command) - (save-window-excursion - (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) - (set-buffer vip-ex-work-buf) - (skip-chars-forward " \t") - (setq command (buffer-substring (point) (point-max))) - (end-of-line)) - (setq command (ex-expand-filsyms command (current-buffer))) - (if (and (> (length command) 0) (string= "!" (substring command 0 1))) - (if vip-ex-last-shell-com - (setq command (concat vip-ex-last-shell-com (substring command 1))) - (error "No previous shell command"))) - (setq vip-ex-last-shell-com command) - (if (null ex-addresses) - (shell-command command) - (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) - (if (null beg) (setq beg end)) - (save-excursion - (goto-char beg) - (set-mark end) - (vip-enlarge-region (point) (mark t)) - (shell-command-on-region (point) (mark t) command t)) - (goto-char beg))))) - -;; Print line number -(defun ex-line-no () - (message "%d" - (1+ (count-lines - (point-min) - (if (null ex-addresses) (point-max) (car ex-addresses)))))) - -;; Give information on the file visited by the current buffer -(defun vip-info-on-file () - (interactive) - (let ((pos1 (vip-line-pos 'start)) - (pos2 (vip-line-pos 'end)) - lines file info) - (setq lines (count-lines (point-min) (vip-line-pos 'end)) - file (if (buffer-file-name) - (concat (vip-abbreviate-file-name (buffer-file-name)) ":") - (concat (buffer-name) " [Not visiting any file]:")) - info (format "line=%d/%d pos=%d/%d col=%d %s" - (if (= pos1 pos2) - (1+ lines) - lines) - (count-lines (point-min) (point-max)) - (point) (1- (point-max)) - (1+ (current-column)) - (if (buffer-modified-p) "[Modified]" "[Unchanged]"))) - (if (< (+ 1 (length info) (length file)) - (window-width (minibuffer-window))) - (message (concat file " " info)) - (save-window-excursion - (with-output-to-temp-buffer " *vip-info*" - (princ (concat "\n" - file "\n\n\t" info - "\n\n\nPress any key to continue...\n\n"))) - (vip-read-event) - (kill-buffer " *vip-info*"))) - )) - - -(provide 'viper-ex) - -;;; viper-ex.el ends here diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el deleted file mode 100644 index f9c09514d79..00000000000 --- a/lisp/emulation/viper-keym.el +++ /dev/null @@ -1,584 +0,0 @@ -;;; viper-keym.el --- Viper keymaps - -;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. - -;; This file is part of GNU Emacs. - -;; 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 -;; the Free Software Foundation; either version 2, 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 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;; Code - -(require 'viper-util) - -;;; Variables - -(defvar vip-toggle-key "\C-z" - "The key used to change states from emacs to Vi and back. -In insert mode, this key also functions as Meta. -Must be set in .vip file or prior to loading Viper. -This setting cannot be changed interactively.") - -(defvar vip-ESC-key "\e" - "Key used to ESC. -Must be set in .vip file or prior to loading Viper. -This setting cannot be changed interactively.") - - -;;; Keymaps - -;; Keymaps for vital things like \e and C-z. -;; Not for users -(defvar vip-vi-intercept-map (make-sparse-keymap)) -(defvar vip-insert-intercept-map (make-sparse-keymap)) -(defvar vip-emacs-intercept-map (make-sparse-keymap)) - -;; keymap used to zap all keymaps other than function-key-map, -;; device-function-key-map, etc. -(defvar vip-overriding-map (make-sparse-keymap)) - -(vip-deflocalvar vip-vi-local-user-map (make-sparse-keymap) - "Keymap for user-defined local bindings. -Useful for changing bindings such as ZZ in certain major modes. -For instance, in letter-mode, one may want to bind ZZ to -mh-send-letter. In a newsreader such as gnus, tin, or rn, ZZ could be bound -to save-buffers-kill-emacs then post article, etc.") -(put 'vip-vi-local-user-map 'permanent-local t) - -(defvar vip-vi-global-user-map (make-sparse-keymap) - "Keymap for user-defined global bindings. -These bindings are seen in all Viper buffers.") - -(defvar vip-vi-basic-map (make-keymap) - "This is the main keymap in effect in Viper's Vi state. -This map is global, shared by all buffers.") - -(defvar vip-vi-kbd-map (make-sparse-keymap) - "This keymap keeps keyboard macros defined via the :map command.") - -(defvar vip-vi-diehard-map (make-sparse-keymap) - "This keymap is in use when the user asks Viper to simulate Vi very closely. -This happens when vip-expert-level is 1 or 2. See vip-set-expert-level.") - - -(vip-deflocalvar vip-insert-local-user-map (make-sparse-keymap) - "Auxiliary map for per-buffer user-defined keybindings in Insert state.") -(put 'vip-insert-local-user-map 'permanent-local t) - -(defvar vip-insert-global-user-map (make-sparse-keymap) - "Auxiliary map for global user-defined bindings in Insert state.") - -(defvar vip-insert-basic-map (make-sparse-keymap) - "The basic insert-mode keymap.") - -(defvar vip-insert-diehard-map (make-keymap) - "Map used when user wants vi-style keys in insert mode. -Most of the Emacs keys are suppressed. This map overshadows -vip-insert-basic-map. Not recommended, except for novice users.") - -(defvar vip-insert-kbd-map (make-sparse-keymap) - "This keymap keeps VI-style kbd macros for insert mode.") - -(defvar vip-replace-map (make-sparse-keymap) - "Map used in Viper's replace state.") - -(defvar vip-emacs-global-user-map (make-sparse-keymap) - "Auxiliary map for global user-defined bindings in Emacs state.") - -(defvar vip-emacs-kbd-map (make-sparse-keymap) - "This keymap keeps Vi-style kbd macros for emacs mode.") - -(vip-deflocalvar vip-emacs-local-user-map (make-sparse-keymap) - "Auxiliary map for local user-defined bindings in Emacs state.") -(put 'vip-emacs-local-user-map 'permanent-local t) - -;; This keymap should stay empty -(defvar vip-empty-keymap (make-sparse-keymap)) - -;; This was the main Vi mode in old versions of VIP which may have been -;; extensively used by VIP users. We declare it as a global var -;; and, after .vip is loaded, we add this keymap to vip-vi-basic-map. -(defvar vip-mode-map (make-sparse-keymap)) - - -;;; Variables used by minor modes - -;; Association list of the form -;; ((major-mode . keymap) (major-mode . keymap) ...) -;; Viper uses these keymaps to make user-requested adjustments -;; to its Vi state in various major modes.") -(defvar vip-vi-state-modifier-alist nil) - -;; Association list of the form -;; ((major-mode . keymap) (major-mode . keymap) ...) -;; Viper uses these keymaps to make user-requested adjustments -;; to its Insert state in various major modes.") -(defvar vip-insert-state-modifier-alist nil) - -;; Association list of the form -;; ((major-mode . keymap) (major-mode . keymap) ...) -;; Viper uses these keymaps to make user-requested adjustments -;; to its Emacs state in various major modes. -(defvar vip-emacs-state-modifier-alist nil) - -;; Tells vip-add-local-keys to create a new vip-vi-local-user-map for new -;; buffers. Not a user option. -(vip-deflocalvar vip-need-new-vi-local-map t "") -(put 'vip-need-new-vi-local-map 'permanent-local t) - -;; Tells vip-add-local-keys to create a new vip-insert-local-user-map for new -;; buffers. Not a user option. -(vip-deflocalvar vip-need-new-insert-local-map t "") -(put 'vip-need-new-insert-local-map 'permanent-local t) - -;; Tells vip-add-local-keys to create a new vip-emacs-local-user-map for new -;; buffers. Not a user option. -(vip-deflocalvar vip-need-new-emacs-local-map t "") -(put 'vip-need-new-emacs-local-map 'permanent-local t) - - - -;; Insert mode keymap - -;; for novice users, pretend you are the real vi. -(define-key vip-insert-diehard-map "\t" 'vip-insert-tab) -(define-key vip-insert-diehard-map "\C-a" 'self-insert-command) -(define-key vip-insert-diehard-map "\C-b" 'self-insert-command) -(define-key vip-insert-diehard-map "\C-c" 'vip-change-state-to-vi) -(define-key vip-insert-diehard-map "\C-e" 'self-insert-command) -(define-key vip-insert-diehard-map "\C-f" 'self-insert-command) -(define-key vip-insert-diehard-map "\C-g" 'self-insert-command) -(define-key vip-insert-diehard-map "\C-i" 'self-insert-command) -(define-key vip-insert-diehard-map "\C-k" 'self-insert-command) -(define-key vip-insert-diehard-map "\C-l" 'self-insert-command) -(define-key vip-insert-diehard-map "\C-n" 'self-insert-command) -(define-key vip-insert-diehard-map "\C-o" 'self-insert-command) -(define-key vip-insert-diehard-map "\C-p" 'self-insert-command) -(define-key vip-insert-diehard-map "\C-q" 'self-insert-command) -(define-key vip-insert-diehard-map "\C-r" 'self-insert-command) -(define-key vip-insert-diehard-map "\C-s" 'self-insert-command) -(define-key vip-insert-diehard-map "\C-u" 'vip-erase-line) -(define-key vip-insert-diehard-map "\C-x" 'self-insert-command) -(define-key vip-insert-diehard-map "\C-y" 'self-insert-command) -(define-key vip-insert-diehard-map "\C-z" 'self-insert-command) -(define-key vip-insert-diehard-map "\C-]" 'self-insert-command) -(define-key vip-insert-diehard-map "\C-_" 'self-insert-command) - -(let ((i ?\ )) - (while (<= i ?~) - (define-key vip-insert-diehard-map (make-string 1 i) 'self-insert-command) - (setq i (1+ i)))) - -;; Insert mode map when user wants emacs style -(define-key vip-insert-basic-map "\C-d" 'vip-backward-indent) -(define-key vip-insert-basic-map "\C-w" 'vip-delete-backward-word) -(define-key vip-insert-basic-map "\C-t" 'vip-forward-indent) -(define-key vip-insert-basic-map - (if vip-xemacs-p [(shift tab)] [S-tab]) 'vip-insert-tab) -(define-key vip-insert-basic-map "\C-v" 'quoted-insert) -(define-key vip-insert-basic-map "\C-?" 'vip-del-backward-char-in-insert) -(define-key vip-insert-basic-map "\C-\\" 'vip-alternate-Meta-key) -(define-key vip-insert-basic-map vip-toggle-key 'vip-escape-to-vi) -(define-key vip-insert-basic-map "\C-c\M-p" - 'vip-insert-prev-from-insertion-ring) -(define-key vip-insert-basic-map "\C-c\M-n" - 'vip-insert-next-from-insertion-ring) - - -;; 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-?" 'vip-del-backward-char-in-replace) - - - -;; Vi keymaps - -(define-key vip-vi-basic-map "\C-^" - (function (lambda () (interactive) (vip-ex "e#")))) -(define-key vip-vi-basic-map "\C-b" 'vip-scroll-screen-back) -(define-key vip-vi-basic-map "\C-d" 'vip-scroll-up) -(define-key vip-vi-basic-map "\C-e" 'vip-scroll-up-one) -(define-key vip-vi-basic-map "\C-f" 'vip-scroll-screen) -(define-key vip-vi-basic-map "\C-m" 'vip-next-line-at-bol) -(define-key vip-vi-basic-map "\C-u" 'vip-scroll-down) -(define-key vip-vi-basic-map "\C-y" 'vip-scroll-down-one) -(define-key vip-vi-basic-map "\C-s" 'vip-isearch-forward) -(define-key vip-vi-basic-map "\C-r" 'vip-isearch-backward) -(define-key vip-vi-basic-map "\C-c/" 'vip-toggle-search-style) -(define-key vip-vi-basic-map "\C-cg" 'vip-info-on-file) - -(define-key vip-vi-basic-map "\C-c\M-p" 'vip-prev-destructive-command) -(define-key vip-vi-basic-map "\C-c\M-n" 'vip-next-destructive-command) - - -(define-key vip-vi-basic-map " " 'vip-forward-char) -(define-key vip-vi-basic-map "!" 'vip-command-argument) -(define-key vip-vi-basic-map "\"" 'vip-command-argument) -(define-key vip-vi-basic-map "#" 'vip-command-argument) -(define-key vip-vi-basic-map "$" 'vip-goto-eol) -(define-key vip-vi-basic-map "%" 'vip-paren-match) -(define-key vip-vi-basic-map "&" - (function (lambda () (interactive) (vip-ex "&")))) -(define-key vip-vi-basic-map "'" 'vip-goto-mark-and-skip-white) -(define-key vip-vi-basic-map "(" 'vip-backward-sentence) -(define-key vip-vi-basic-map ")" 'vip-forward-sentence) -(define-key vip-vi-basic-map "*" 'call-last-kbd-macro) -(define-key vip-vi-basic-map "+" 'vip-next-line-at-bol) -(define-key vip-vi-basic-map "," 'vip-repeat-find-opposite) -(define-key vip-vi-basic-map "-" 'vip-previous-line-at-bol) -(define-key vip-vi-basic-map "." 'vip-repeat) -(define-key vip-vi-basic-map "/" 'vip-search-forward) - -(define-key vip-vi-basic-map "0" 'vip-beginning-of-line) -(define-key vip-vi-basic-map "1" 'vip-digit-argument) -(define-key vip-vi-basic-map "2" 'vip-digit-argument) -(define-key vip-vi-basic-map "3" 'vip-digit-argument) -(define-key vip-vi-basic-map "4" 'vip-digit-argument) -(define-key vip-vi-basic-map "5" 'vip-digit-argument) -(define-key vip-vi-basic-map "6" 'vip-digit-argument) -(define-key vip-vi-basic-map "7" 'vip-digit-argument) -(define-key vip-vi-basic-map "8" 'vip-digit-argument) -(define-key vip-vi-basic-map "9" 'vip-digit-argument) - -(define-key vip-vi-basic-map ":" 'vip-ex) -(define-key vip-vi-basic-map ";" 'vip-repeat-find) -(define-key vip-vi-basic-map "<" 'vip-command-argument) -(define-key vip-vi-basic-map "=" 'vip-command-argument) -(define-key vip-vi-basic-map ">" 'vip-command-argument) -(define-key vip-vi-basic-map "?" 'vip-search-backward) -(define-key vip-vi-basic-map "@" 'vip-register-macro) - -(define-key vip-vi-basic-map "A" 'vip-Append) -(define-key vip-vi-basic-map "B" 'vip-backward-Word) -(define-key vip-vi-basic-map "C" 'vip-change-to-eol) -(define-key vip-vi-basic-map "D" 'vip-kill-line) -(define-key vip-vi-basic-map "E" 'vip-end-of-Word) -(define-key vip-vi-basic-map "F" 'vip-find-char-backward) -(define-key vip-vi-basic-map "G" 'vip-goto-line) -(define-key vip-vi-basic-map "H" 'vip-window-top) -(define-key vip-vi-basic-map "I" 'vip-Insert) -(define-key vip-vi-basic-map "J" 'vip-join-lines) -(define-key vip-vi-basic-map "K" 'vip-nil) -(define-key vip-vi-basic-map "L" 'vip-window-bottom) -(define-key vip-vi-basic-map "M" 'vip-window-middle) -(define-key vip-vi-basic-map "N" 'vip-search-Next) -(define-key vip-vi-basic-map "O" 'vip-Open-line) -(define-key vip-vi-basic-map "P" 'vip-Put-back) -(define-key vip-vi-basic-map "Q" 'vip-query-replace) -(define-key vip-vi-basic-map "R" 'vip-overwrite) -(define-key vip-vi-basic-map "S" 'vip-substitute-line) -(define-key vip-vi-basic-map "T" 'vip-goto-char-backward) -(define-key vip-vi-basic-map "U" 'vip-undo) -(define-key vip-vi-basic-map "V" 'find-file-other-window) -(define-key vip-vi-basic-map "W" 'vip-forward-Word) -(define-key vip-vi-basic-map "X" 'vip-delete-backward-char) -(define-key vip-vi-basic-map "Y" 'vip-yank-line) -(define-key vip-vi-basic-map "ZZ" 'vip-save-kill-buffer) - -(define-key vip-vi-basic-map "\\" 'vip-escape-to-emacs) -(define-key vip-vi-basic-map "[" 'vip-brac-function) -(define-key vip-vi-basic-map "]" 'vip-ket-function) -(define-key vip-vi-basic-map "\C-\\" 'vip-alternate-Meta-key) -(define-key vip-vi-basic-map "^" 'vip-bol-and-skip-white) -(define-key vip-vi-basic-map "`" 'vip-goto-mark) - -(define-key vip-vi-basic-map "a" 'vip-append) -(define-key vip-vi-basic-map "b" 'vip-backward-word) -(define-key vip-vi-basic-map "c" 'vip-command-argument) -(define-key vip-vi-basic-map "d" 'vip-command-argument) -(define-key vip-vi-basic-map "e" 'vip-end-of-word) -(define-key vip-vi-basic-map "f" 'vip-find-char-forward) -(define-key vip-vi-basic-map "g" 'vip-nil) -(define-key vip-vi-basic-map "h" 'vip-backward-char) -(define-key vip-vi-basic-map "i" 'vip-insert) -(define-key vip-vi-basic-map "j" 'vip-next-line) -(define-key vip-vi-basic-map "k" 'vip-previous-line) -(define-key vip-vi-basic-map "l" 'vip-forward-char) -(define-key vip-vi-basic-map "m" 'vip-mark-point) -(define-key vip-vi-basic-map "n" 'vip-search-next) -(define-key vip-vi-basic-map "o" 'vip-open-line) -(define-key vip-vi-basic-map "p" 'vip-put-back) -(define-key vip-vi-basic-map "q" 'vip-nil) -(define-key vip-vi-basic-map "r" 'vip-replace-char) -(define-key vip-vi-basic-map "s" 'vip-substitute) -(define-key vip-vi-basic-map "t" 'vip-goto-char-forward) -(define-key vip-vi-basic-map "u" 'vip-undo) -(define-key vip-vi-basic-map "v" 'find-file) -(define-key vip-vi-basic-map "\C-v" 'find-file-other-frame) -(define-key vip-vi-basic-map "w" 'vip-forward-word) -(define-key vip-vi-basic-map "x" 'vip-delete-char) -(define-key vip-vi-basic-map "y" 'vip-command-argument) -(define-key vip-vi-basic-map "zH" 'vip-line-to-top) -(define-key vip-vi-basic-map "zM" 'vip-line-to-middle) -(define-key vip-vi-basic-map "zL" 'vip-line-to-bottom) -(define-key vip-vi-basic-map "z\C-m" 'vip-line-to-top) -(define-key vip-vi-basic-map "z." 'vip-line-to-middle) -(define-key vip-vi-basic-map "z-" 'vip-line-to-bottom) - -(define-key vip-vi-basic-map "{" 'vip-backward-paragraph) -(define-key vip-vi-basic-map "|" 'vip-goto-col) -(define-key vip-vi-basic-map "}" 'vip-forward-paragraph) -(define-key vip-vi-basic-map "~" 'vip-toggle-case) -(define-key vip-vi-basic-map "\C-?" 'vip-backward-char) -(define-key vip-vi-basic-map "_" 'vip-nil) - -;;; Escape from Emacs to Vi for one command -(global-set-key "\C-c\\" 'vip-escape-to-vi) ; everywhere - -;;; This is vip-vi-diehard-map. Used when vip-vi-diehard-minor-mode is on. - -(define-key vip-vi-diehard-map "\C-a" 'vip-nil) -(define-key vip-vi-diehard-map "\C-c" 'vip-nil) -(define-key vip-vi-diehard-map "\C-g" 'vip-info-on-file) -(define-key vip-vi-diehard-map "\C-i" 'vip-nil) -(define-key vip-vi-diehard-map "\C-k" 'vip-nil) -(define-key vip-vi-diehard-map "\C-l" 'redraw-display) -(define-key vip-vi-diehard-map "\C-n" 'vip-next-line) -(define-key vip-vi-diehard-map "\C-o" 'vip-nil) -(define-key vip-vi-diehard-map "\C-p" 'vip-previous-line) -(define-key vip-vi-diehard-map "\C-q" 'vip-nil) -(define-key vip-vi-diehard-map "\C-r" 'redraw-display) -(define-key vip-vi-diehard-map "\C-s" 'vip-nil) -(define-key vip-vi-diehard-map "\C-t" 'vip-nil) -(define-key vip-vi-diehard-map "\C-v" 'vip-nil) -(define-key vip-vi-diehard-map "\C-w" 'vip-nil) -(define-key vip-vi-diehard-map "@" 'vip-nil) -(define-key vip-vi-diehard-map "_" 'vip-nil) -(define-key vip-vi-diehard-map "*" 'vip-nil) -(define-key vip-vi-diehard-map "#" 'vip-nil) -(define-key vip-vi-diehard-map "\C-_" 'vip-nil) -(define-key vip-vi-diehard-map "\C-]" 'vip-nil) ; This is actually tags. - - -;;; Minibuffer keymap - - -(defvar vip-minibuffer-map (make-sparse-keymap) - "Keymap used to modify keys when Minibuffer is in Insert state.") - -(define-key vip-minibuffer-map "\C-m" 'vip-exit-minibuffer) -(define-key vip-minibuffer-map "\C-j" 'vip-exit-minibuffer) - -;; Map used to read Ex-style commands. -(defvar vip-ex-cmd-map (make-sparse-keymap)) -(define-key vip-ex-cmd-map " " 'ex-cmd-read-exit) -(define-key vip-ex-cmd-map "\t" 'ex-cmd-complete) - -;; Keymap for reading file names in Ex-style commands. -(defvar ex-read-filename-map (make-sparse-keymap)) -(define-key ex-read-filename-map " " 'vip-complete-filename-or-exit) -(define-key ex-read-filename-map "!" 'vip-handle-!) - -;; Some other maps -(defvar vip-slash-and-colon-map (make-sparse-keymap) - "This map redefines `/' and `:' to behave as in Vi. -Useful in some modes, such as Gnus, MH, etc.") -(define-key vip-slash-and-colon-map ":" 'vip-ex) -(define-key vip-slash-and-colon-map "/" 'vip-search-forward) - -(defvar vip-comint-mode-modifier-map (make-sparse-keymap) - "This map modifies comint mode.") -(define-key vip-comint-mode-modifier-map "\C-m" 'comint-send-input) -(define-key vip-comint-mode-modifier-map "\C-d" 'comint-delchar-or-maybe-eof) - -(defvar vip-dired-modifier-map (make-sparse-keymap) - "This map modifies Dired behavior.") -(define-key vip-dired-modifier-map ":" 'vip-ex) -(define-key vip-dired-modifier-map "/" 'vip-search-forward) - - - -;;; Code - -(defun vip-add-local-keys (state alist) - "Override some vi-state or insert-state bindings in the current buffer. -The effect is seen in the current buffer only. -Useful for customizing mailer buffers, gnus, etc. -STATE is 'vi-state, 'insert-state, or 'emacs-state -ALIST is of the form ((key . func) (key . func) ...) -Normally, this would be called from a hook to a major mode or -on a per buffer basis. -Usage: - (vip-add-local-keys state '((key-str . func) (key-str . func)...)) " - - (let (map) - (cond ((eq state 'vi-state) - (if vip-need-new-vi-local-map - (setq vip-vi-local-user-map (make-sparse-keymap))) - (setq vip-need-new-vi-local-map nil - map vip-vi-local-user-map)) - ((eq state 'insert-state) - (if vip-need-new-insert-local-map - (setq vip-insert-local-user-map (make-sparse-keymap))) - (setq vip-need-new-insert-local-map nil - map vip-insert-local-user-map)) - ((eq state 'emacs-state) - (if vip-need-new-emacs-local-map - (setq vip-emacs-local-user-map (make-sparse-keymap))) - (setq vip-need-new-emacs-local-map nil - map vip-emacs-local-user-map)) - (t - (error - "Invalid state in vip-add-local-keys: %S. Valid states: vi-state, insert-state or emacs-state" state))) - - (vip-modify-keymap map alist) - (vip-normalize-minor-mode-map-alist) - (vip-set-mode-vars-for vip-current-state))) - -(defun vip-zap-local-keys () - "Unconditionally reset Viper vip-*-local-user-map's. -Rarely useful, but if u made a mistake by switching to a mode that adds -undesirable local keys, e.g., comint-mode, then this function can restore -sanity." - (interactive) - (setq vip-vi-local-user-map (make-sparse-keymap) - vip-need-new-vi-local-map nil - vip-insert-local-user-map (make-sparse-keymap) - vip-need-new-insert-local-map nil - vip-emacs-local-user-map (make-sparse-keymap) - vip-need-new-emacs-local-map nil) - (vip-normalize-minor-mode-map-alist)) - - -(defun vip-modify-major-mode (mode state keymap) - "Modify key bindings in a major-mode in a Viper state using a keymap. - -If the default for a major mode is emacs-state, then modifications to this -major mode may not take effect until the buffer switches state to Vi, -Insert or Emacs. If this happens, add vip-change-state-to-emacs to this -major mode's hook. If no such hook exists, you may have to put an advice on -the function that invokes the major mode. See vip-set-hooks for hints. - -The above needs not to be done for major modes that come up in Vi or Insert -state by default. - -Arguments: (major-mode vip-state keymap)" - (let ((alist - (cond ((eq state 'vi-state) 'vip-vi-state-modifier-alist) - ((eq state 'insert-state) 'vip-insert-state-modifier-alist) - ((eq state 'emacs-state) 'vip-emacs-state-modifier-alist))) - elt) - (if (setq elt (assoc mode (eval alist))) - (set alist (delq elt (eval alist)))) - (set alist (cons (cons mode keymap) (eval alist))) - - ;; Normalization usually doesn't help here, since one needs to - ;; normalize in the actual buffer where changes to the keymap are - ;; to take place. However, it doesn't hurt, and it helps whenever this - ;; function is actually called from within the right buffer. - (vip-normalize-minor-mode-map-alist) - - (vip-set-mode-vars-for vip-current-state))) - - -;; Displays variables that control Viper's keymaps -(defun vip-debug-keymaps () - (interactive) - (with-output-to-temp-buffer " *vip-debug*" - (princ (format "Buffer name: %s\n\n" (buffer-name))) - (princ "Variables: \n") - (princ (format "major-mode: %S\n" major-mode)) - (princ (format "vip-current-state: %S\n" vip-current-state)) - (princ (format "vip-mode-string: %S\n\n" vip-mode-string)) - (princ (format "vip-vi-intercept-minor-mode: %S\n" - vip-vi-intercept-minor-mode)) - (princ (format "vip-insert-intercept-minor-mode: %S\n" - vip-insert-intercept-minor-mode)) - (princ (format "vip-emacs-intercept-minor-mode: %S\n" - vip-emacs-intercept-minor-mode)) - (princ (format "vip-vi-minibuffer-minor-mode: %S\n" - vip-vi-minibuffer-minor-mode)) - (princ (format "vip-insert-minibuffer-minor-mode: %S\n\n" - vip-insert-minibuffer-minor-mode)) - (princ (format "vip-vi-local-user-minor-mode: %S\n" - vip-vi-local-user-minor-mode)) - (princ (format "vip-vi-global-user-minor-mode: %S\n" - vip-vi-global-user-minor-mode)) - (princ (format "vip-vi-kbd-minor-mode: %S\n" vip-vi-kbd-minor-mode)) - (princ (format "vip-vi-state-modifier-minor-mode: %S\n" - vip-vi-state-modifier-minor-mode)) - (princ (format "vip-vi-diehard-minor-mode: %S\n" - vip-vi-diehard-minor-mode)) - (princ (format "vip-vi-basic-minor-mode: %S\n" vip-vi-basic-minor-mode)) - (princ (format "vip-replace-minor-mode: %S\n" vip-replace-minor-mode)) - (princ (format "vip-insert-local-user-minor-mode: %S\n" - vip-insert-local-user-minor-mode)) - (princ (format "vip-insert-global-user-minor-mode: %S\n" - vip-insert-global-user-minor-mode)) - (princ (format "vip-insert-kbd-minor-mode: %S\n" - vip-insert-kbd-minor-mode)) - (princ (format "vip-insert-state-modifier-minor-mode: %S\n" - vip-insert-state-modifier-minor-mode)) - (princ (format "vip-insert-diehard-minor-mode: %S\n" - vip-insert-diehard-minor-mode)) - (princ (format "vip-insert-basic-minor-mode: %S\n" - vip-insert-basic-minor-mode)) - (princ (format "vip-emacs-local-user-minor-mode: %S\n" - vip-emacs-local-user-minor-mode)) - (princ (format "vip-emacs-kbd-minor-mode: %S\n" - vip-emacs-kbd-minor-mode)) - (princ (format "vip-emacs-global-user-minor-mode: %S\n" - vip-emacs-global-user-minor-mode)) - (princ (format "vip-emacs-state-modifier-minor-mode: %S\n" - vip-emacs-state-modifier-minor-mode)) - - (princ (format "\nvip-expert-level %S\n" vip-expert-level)) - (princ (format "vip-no-multiple-ESC %S\n" vip-no-multiple-ESC)) - (princ (format "vip-always %S\n" vip-always)) - (princ (format "vip-ex-style-motion %S\n" - vip-ex-style-motion)) - (princ (format "vip-ex-style-editing-in-insert %S\n" - vip-ex-style-editing-in-insert)) - (princ (format "vip-want-emacs-keys-in-vi %S\n" - vip-want-emacs-keys-in-vi)) - (princ (format "vip-want-emacs-keys-in-insert %S\n" - vip-want-emacs-keys-in-insert)) - (princ (format "vip-want-ctl-h-help %S\n" vip-want-ctl-h-help)) - - (princ "\n\n\n") - (princ (format "Default value for minor-mode-map-alist: \n%S\n\n" - (default-value 'minor-mode-map-alist))) - (princ (format "Actual value for minor-mode-map-alist: \n%S\n" - minor-mode-map-alist)) - )) - - -;;; Keymap utils - -(defun vip-add-keymap (mapsrc mapdst) - "Add contents of mapsrc to mapdst. It is assumed that mapsrc is sparse." - (if vip-xemacs-p - (map-keymap (function (lambda (key binding) - (define-key mapdst key binding))) - mapsrc) - (mapcar - (function (lambda (p) - (define-key mapdst (vector (car p)) (cdr p)) - )) - (cdr mapsrc)))) - -(defun vip-modify-keymap (map alist) - "Modifies MAP with bindings specified in the ALIST. The alist has the -form ((key . function) (key . function) ... )." - (mapcar (function (lambda (p) - (define-key map (eval (car p)) (cdr p)))) - alist)) - - -(provide 'viper-keym) - -;;; viper-keym.el ends here diff --git a/lisp/emulation/viper-macs.el b/lisp/emulation/viper-macs.el deleted file mode 100644 index 6b0b2fb99ea..00000000000 --- a/lisp/emulation/viper-macs.el +++ /dev/null @@ -1,943 +0,0 @@ -;;; viper-macs.el --- functions implementing keyboard macros for Viper - -;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. - -;; This file is part of GNU Emacs. - -;; 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 -;; the Free Software Foundation; either version 2, 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 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;; Code - -(require 'viper-util) -(require 'viper-keym) - - -;;; Variables - -;; Register holding last macro. -(defvar vip-last-macro-reg nil) - -;; format of the elements of kbd alists: -;; (name ((buf . macr)...(buf . macr)) ((maj-mode . macr)...) (t . macr)) -;; kbd macro alist for Vi state -(defvar vip-vi-kbd-macro-alist nil) -;; same for insert/replace state -(defvar vip-insert-kbd-macro-alist nil) -;; same for emacs state -(defvar vip-emacs-kbd-macro-alist nil) - -;; Internal var that passes info between start-kbd-macro and end-kbd-macro -;; in :map and :map! -(defvar vip-kbd-macro-parameters nil) - -(defvar vip-this-kbd-macro nil - "Vector of keys representing the name of currently running Viper kbd macro.") -(defvar vip-last-kbd-macro nil - "Vector of keys representing the name of last Viper keyboard macro.") - -(defconst vip-fast-keyseq-timeout 200 - "*Key sequence separated by no more than this many milliseconds is viewed as a macro, if such a macro is defined. -This also controls ESC-keysequences generated by keyboard function keys.") - - -(defvar vip-repeat-from-history-key 'f12 - "Prefix key for invocation of vip-repeat-from-history function, -which repeats previous destructive commands from the history of such -commands. -This function can then be invoked as <this-key> 1 or <this-key> 2. -The notation for these keys is borrowed from XEmacs. Basically, -a key is a symbol, e.g., `a', `\\1', `f2', etc., or a list, e.g., -`(meta control f1)'.") - - - -;;; Code - -;; Ex map command -(defun ex-map () - (let ((mod-char "") - macro-name macro-body map-args ins) - (save-window-excursion - (set-buffer vip-ex-work-buf) - (if (looking-at "!") - (progn - (setq ins t - mod-char "!") - (forward-char 1)))) - (setq map-args (ex-map-read-args mod-char) - macro-name (car map-args) - macro-body (cdr map-args)) - (setq vip-kbd-macro-parameters (list ins mod-char macro-name macro-body)) - (if macro-body - (vip-end-mapping-kbd-macro 'ignore) - (ex-fixup-history (format "map%s %S" mod-char - (vip-display-macro macro-name))) - ;; if defining macro for insert, switch there for authentic WYSIWYG - (if ins (vip-change-state-to-insert)) - (start-kbd-macro nil) - (define-key vip-vi-intercept-map "\C-x)" 'vip-end-mapping-kbd-macro) - (define-key vip-insert-intercept-map "\C-x)" 'vip-end-mapping-kbd-macro) - (define-key vip-emacs-intercept-map "\C-x)" 'vip-end-mapping-kbd-macro) - (message "Mapping %S in %s state. Hit `C-x )' to complete the mapping" - (vip-display-macro macro-name) - (if ins "Insert" "Vi"))) - )) - - -;; Ex unmap -(defun ex-unmap () - (let ((mod-char "") - temp macro-name ins) - (save-window-excursion - (set-buffer vip-ex-work-buf) - (if (looking-at "!") - (progn - (setq ins t - mod-char "!") - (forward-char 1)))) - - (setq macro-name (ex-unmap-read-args mod-char)) - (setq temp (vip-fixup-macro (vconcat macro-name))) ;; copy and fixup - (ex-fixup-history (format "unmap%s %S" mod-char - (vip-display-macro temp))) - (vip-unrecord-kbd-macro macro-name (if ins 'insert-state 'vi-state)) - )) - - -;; read arguments for ex-map -(defun ex-map-read-args (variant) - (let ((cursor-in-echo-area t) - (key-seq []) - temp key event message - macro-name macro-body args) - - (condition-case nil - (setq args (concat (ex-get-inline-cmd-args ".*map[!]*[ \t]?" "\n\C-m") - " nil nil ") - temp (read-from-string args) - macro-name (car temp) - macro-body (car (read-from-string args (cdr temp)))) - (error - (signal - 'error - '("map: Macro name and body must be a quoted string or a vector")))) - - ;; We expect macro-name to be a vector, a string, or a quoted string. - ;; In the second case, it will emerge as a symbol when read from - ;; the above read-from-string. So we need to convert it into a string - (if macro-name - (cond ((vectorp macro-name) nil) - ((stringp macro-name) - (setq macro-name (vconcat macro-name))) - (t (setq macro-name (vconcat (prin1-to-string macro-name))))) - (message ":map%s <Name>" variant)(sit-for 2) - (while - (not (member key - '(?\C-m ?\n (control m) (control j) return linefeed))) - (setq key-seq (vconcat key-seq (if key (vector key) []))) - ;; the only keys available for editing are these-- no help while there - (if (member - key - '(?\b ?\d '^? '^H (control h) (control \?) backspace delete)) - (setq key-seq (subseq key-seq 0 (- (length key-seq) 2)))) - (setq message - (format - ":map%s %s" - variant (if (> (length key-seq) 0) - (prin1-to-string (vip-display-macro key-seq)) - ""))) - (message message) - (setq event (vip-read-key)) - ;;(setq event (vip-read-event)) - (setq key - (if (vip-mouse-event-p event) - (progn - (message "%s (No mouse---only keyboard keys, please)" - message) - (sit-for 2) - nil) - (vip-event-key event))) - ) - (setq macro-name key-seq)) - - (if (= (length macro-name) 0) - (error "Can't map an empty macro name")) - (setq macro-name (vip-fixup-macro macro-name)) - (if (vip-char-array-p macro-name) - (setq macro-name (vip-char-array-to-macro macro-name))) - - (if macro-body - (cond ((vip-char-array-p macro-body) - (setq macro-body (vip-char-array-to-macro macro-body))) - ((vectorp macro-body) nil) - (t (error "map: Invalid syntax in macro definition")))) - (setq cursor-in-echo-area nil)(sit-for 0) ; this overcomes xemacs tty bug - (cons macro-name macro-body))) - - - -;; read arguments for ex-unmap -(defun ex-unmap-read-args (variant) - (let ((cursor-in-echo-area t) - (macro-alist (if (string= variant "!") - vip-insert-kbd-macro-alist - vip-vi-kbd-macro-alist)) - ;; these are disabled just in case, to avoid surprises when doing - ;; completing-read - vip-vi-kbd-minor-mode vip-insert-kbd-minor-mode - vip-emacs-kbd-minor-mode - vip-vi-intercept-minor-mode vip-insert-intercept-minor-mode - vip-emacs-intercept-minor-mode - event message - key key-seq macro-name) - (setq macro-name (ex-get-inline-cmd-args ".*unma?p?[!]*[ \t]*")) - - (if (> (length macro-name) 0) - () - (message ":unmap%s <Name>" variant) (sit-for 2) - (while - (not - (member key '(?\C-m ?\n (control m) (control j) return linefeed))) - (setq key-seq (vconcat key-seq (if key (vector key) []))) - ;; the only keys available for editing are these-- no help while there - (cond ((member - key - '(?\b ?\d '^? '^H (control h) (control \?) backspace delete)) - (setq key-seq (subseq key-seq 0 (- (length key-seq) 2)))) - ((member key '(tab (control i) ?\t)) - (setq key-seq (subseq key-seq 0 (1- (length key-seq)))) - (setq message - (format - ":unmap%s %s" - variant (if (> (length key-seq) 0) - (prin1-to-string - (vip-display-macro key-seq)) - ""))) - (setq key-seq - (vip-do-sequence-completion key-seq macro-alist message)) - )) - (setq message - (format - ":unmap%s %s" - variant (if (> (length key-seq) 0) - (prin1-to-string - (vip-display-macro key-seq)) - ""))) - (message message) - (setq event (vip-read-key)) - ;;(setq event (vip-read-event)) - (setq key - (if (vip-mouse-event-p event) - (progn - (message "%s (No mouse---only keyboard keys, please)" - message) - (sit-for 2) - nil) - (vip-event-key event))) - ) - (setq macro-name key-seq)) - - (if (= (length macro-name) 0) - (error "Can't unmap an empty macro name")) - - ;; convert macro names into vector, if starts with a `[' - (if (memq (elt macro-name 0) '(?\[ ?\")) - (car (read-from-string macro-name)) - (vconcat macro-name)) - )) - - -;; Terminate a Vi kbd macro. -;; optional argument IGNORE, if t, indicates that we are dealing with an -;; existing macro that needs to be registered, but there is no need to -;; terminate a kbd macro. -(defun vip-end-mapping-kbd-macro (&optional ignore) - (interactive) - (define-key vip-vi-intercept-map "\C-x)" nil) - (define-key vip-insert-intercept-map "\C-x)" nil) - (define-key vip-emacs-intercept-map "\C-x)" nil) - (if (and (not ignore) - (or (not vip-kbd-macro-parameters) - (not defining-kbd-macro))) - (error "Not mapping a kbd-macro")) - (let ((mod-char (nth 1 vip-kbd-macro-parameters)) - (ins (nth 0 vip-kbd-macro-parameters)) - (macro-name (nth 2 vip-kbd-macro-parameters)) - (macro-body (nth 3 vip-kbd-macro-parameters))) - (setq vip-kbd-macro-parameters nil) - (or ignore - (progn - (end-kbd-macro nil) - (setq macro-body (vip-events-to-macro last-kbd-macro)) - ;; always go back to Vi, since this is where we started - ;; defining macro - (vip-change-state-to-vi))) - - (vip-record-kbd-macro macro-name - (if ins 'insert-state 'vi-state) - (vip-display-macro macro-body)) - - (ex-fixup-history (format "map%s %S %S" mod-char - (vip-display-macro macro-name) - (vip-display-macro macro-body))) - )) - - - -(defadvice start-kbd-macro (after vip-kbd-advice activate) - "Remove Viper's intercepting bindings for C-x ). -This may be needed if the previous `:map' command terminated abnormally." - (define-key vip-vi-intercept-map "\C-x)" nil) - (define-key vip-insert-intercept-map "\C-x)" nil) - (define-key vip-emacs-intercept-map "\C-x)" nil)) - - - -;;; Recording, unrecording, executing - -;; accepts as macro names: strings and vectors. -;; strings must be strings of characters; vectors must be vectors of keys -;; in canonic form. the canonic form is essentially the form used in XEmacs -(defun vip-record-kbd-macro (macro-name state macro-body &optional scope) - "Record a Vi macro. Can be used in `.vip' file to define permanent macros. -MACRO-NAME is a string of characters or a vector of keys. STATE is -either `vi-state' or `insert-state'. It specifies the Viper state in which to -define the macro. MACRO-BODY is a string that represents the keyboard macro. -Optional SCOPE says whether the macro should be global \(t\), mode-specific -\(a major-mode symbol\), or buffer-specific \(buffer name, a string\). -If SCOPE is nil, the user is asked to specify the scope." - (let* (state-name keymap - (macro-alist-var - (cond ((eq state 'vi-state) - (setq state-name "Vi state" - keymap vip-vi-kbd-map) - 'vip-vi-kbd-macro-alist) - ((memq state '(insert-state replace-state)) - (setq state-name "Insert state" - keymap vip-insert-kbd-map) - 'vip-insert-kbd-macro-alist) - (t - (setq state-name "Emacs state" - keymap vip-emacs-kbd-map) - 'vip-emacs-kbd-macro-alist) - )) - new-elt old-elt old-sub-elt msg - temp lis lis2) - - (if (= (length macro-name) 0) - (error "Can't map an empty macro name")) - - ;; Macro-name is usually a vector. However, command history or macros - ;; recorded in ~/.vip may be recorded as strings. So, convert to vectors. - (setq macro-name (vip-fixup-macro macro-name)) - (if (vip-char-array-p macro-name) - (setq macro-name (vip-char-array-to-macro macro-name))) - (setq macro-body (vip-fixup-macro macro-body)) - (if (vip-char-array-p macro-body) - (setq macro-body (vip-char-array-to-macro macro-body))) - - ;; don't ask if scope is given and is of the right type - (or (eq scope t) - (stringp scope) - (and scope (symbolp scope)) - (progn - (setq scope - (cond - ((y-or-n-p - (format - "Map this macro for buffer `%s' only? " - (buffer-name))) - (setq msg - (format - "%S is mapped to %s for %s in `%s'" - (vip-display-macro macro-name) - (vip-abbreviate-string - (format - "%S" - (setq temp (vip-display-macro macro-body))) - 14 "" "" - (if (stringp temp) " ....\"" " ....]")) - state-name (buffer-name))) - (buffer-name)) - ((y-or-n-p - (format - "Map this macro for the major mode `%S' only? " - major-mode)) - (setq msg - (format - "%S is mapped to %s for %s in `%S'" - (vip-display-macro macro-name) - (vip-abbreviate-string - (format - "%S" - (setq temp (vip-display-macro macro-body))) - 14 "" "" - (if (stringp macro-body) " ....\"" " ....]")) - state-name major-mode)) - major-mode) - (t - (setq msg - (format - "%S is globally mapped to %s in %s" - (vip-display-macro macro-name) - (vip-abbreviate-string - (format - "%S" - (setq temp (vip-display-macro macro-body))) - 14 "" "" - (if (stringp macro-body) " ....\"" " ....]")) - state-name)) - t))) - (if (y-or-n-p - (format "Save this macro in %s? " - (vip-abbreviate-file-name vip-custom-file-name))) - (vip-save-string-in-file - (format "\n(vip-record-kbd-macro %S '%S %s '%S)" - (vip-display-macro macro-name) - state - ;; if we don't let vector macro-body through %S, - ;; the symbols `\.' `\[' etc will be converted into - ;; characters, causing invalid read error on recorded - ;; macros in .vip. - ;; I am not sure is macro-body can still be a string at - ;; this point, but I am preserving this option anyway. - (if (vectorp macro-body) - (format "%S" macro-body) - macro-body) - scope) - vip-custom-file-name)) - - (message msg) - )) - - (setq new-elt - (cons macro-name - (cond ((eq scope t) (list nil nil (cons t nil))) - ((symbolp scope) - (list nil (list (cons scope nil)) (cons t nil))) - ((stringp scope) - (list (list (cons scope nil)) nil (cons t nil)))))) - (setq old-elt (assoc macro-name (eval macro-alist-var))) - - (if (null old-elt) - (progn - ;; insert new-elt in macro-alist-var and keep the list sorted - (define-key - keymap - (vector (vip-key-to-emacs-key (aref macro-name 0))) - 'vip-exec-mapped-kbd-macro) - (setq lis (eval macro-alist-var)) - (while (and lis (string< (vip-array-to-string (car (car lis))) - (vip-array-to-string macro-name))) - (setq lis2 (cons (car lis) lis2)) - (setq lis (cdr lis))) - - (setq lis2 (reverse lis2)) - (set macro-alist-var (append lis2 (cons new-elt lis))) - (setq old-elt new-elt))) - (setq old-sub-elt - (cond ((eq scope t) (vip-kbd-global-pair old-elt)) - ((symbolp scope) (assoc scope (vip-kbd-mode-alist old-elt))) - ((stringp scope) (assoc scope (vip-kbd-buf-alist old-elt))))) - (if old-sub-elt - (setcdr old-sub-elt macro-body) - (cond ((symbolp scope) (setcar (cdr (cdr old-elt)) - (cons (cons scope macro-body) - (vip-kbd-mode-alist old-elt)))) - ((stringp scope) (setcar (cdr old-elt) - (cons (cons scope macro-body) - (vip-kbd-buf-alist old-elt)))))) - )) - - - -;; macro name must be a vector of vip-style keys -(defun vip-unrecord-kbd-macro (macro-name state) - "Delete macro MACRO-NAME from Viper STATE. -MACRO-NAME must be a vector of vip-style keys. This command is used by Viper -internally, but the user can also use it in ~/.vip to delete pre-defined macros -supplied with Viper. The best way to avoid mistakes in macro names to be passed -to this function is to use vip-describe-kbd-macros and copy the name from -there." - (let* (state-name keymap - (macro-alist-var - (cond ((eq state 'vi-state) - (setq state-name "Vi state" - keymap vip-vi-kbd-map) - 'vip-vi-kbd-macro-alist) - ((memq state '(insert-state replace-state)) - (setq state-name "Insert state" - keymap vip-insert-kbd-map) - 'vip-insert-kbd-macro-alist) - (t - (setq state-name "Emacs state" - keymap vip-emacs-kbd-map) - 'vip-emacs-kbd-macro-alist) - )) - buf-mapping mode-mapping global-mapping - macro-pair macro-entry) - - ;; Macro-name is usually a vector. However, command history or macros - ;; recorded in ~/.vip may appear as strings. So, convert to vectors. - (setq macro-name (vip-fixup-macro macro-name)) - (if (vip-char-array-p macro-name) - (setq macro-name (vip-char-array-to-macro macro-name))) - - (setq macro-entry (assoc macro-name (eval macro-alist-var))) - (if (= (length macro-name) 0) - (error "Can't unmap an empty macro name")) - (if (null macro-entry) - (error "%S is not mapped to a macro for %s in `%s'" - (vip-display-macro macro-name) - state-name (buffer-name))) - - (setq buf-mapping (vip-kbd-buf-pair macro-entry) - mode-mapping (vip-kbd-mode-pair macro-entry) - global-mapping (vip-kbd-global-pair macro-entry)) - - (cond ((and (cdr buf-mapping) - (or (and (not (cdr mode-mapping)) (not (cdr global-mapping))) - (y-or-n-p - (format "Unmap %S for `%s' only? " - (vip-display-macro macro-name) - (buffer-name))))) - (setq macro-pair buf-mapping) - (message "%S is unmapped for %s in `%s'" - (vip-display-macro macro-name) - state-name (buffer-name))) - ((and (cdr mode-mapping) - (or (not (cdr global-mapping)) - (y-or-n-p - (format "Unmap %S for the major mode `%S' only? " - (vip-display-macro macro-name) - major-mode)))) - (setq macro-pair mode-mapping) - (message "%S is unmapped for %s in %S" - (vip-display-macro macro-name) state-name major-mode)) - ((cdr (setq macro-pair (vip-kbd-global-pair macro-entry))) - (message - "Global mapping of %S for %s is removed" - (vip-display-macro macro-name) state-name)) - (t (error "%S is not mapped to a macro for %s in `%s'" - (vip-display-macro macro-name) - state-name (buffer-name)))) - (setcdr macro-pair nil) - (or (cdr buf-mapping) - (cdr mode-mapping) - (cdr global-mapping) - (progn - (set macro-alist-var (delq macro-entry (eval macro-alist-var))) - (if (vip-can-release-key (aref macro-name 0) - (eval macro-alist-var)) - (define-key - keymap - (vector (vip-key-to-emacs-key (aref macro-name 0))) - nil)) - )) - )) - -;; Check if MACRO-ALIST has an entry for a macro name starting with -;; CHAR. If not, this indicates that the binding for this char -;; in vip-vi/insert-kbd-map can be released. -(defun vip-can-release-key (char macro-alist) - (let ((lis macro-alist) - (can-release t) - macro-name) - - (while (and lis can-release) - (setq macro-name (car (car lis))) - (if (eq char (aref macro-name 0)) - (setq can-release nil)) - (setq lis (cdr lis))) - can-release)) - - -(defun vip-exec-mapped-kbd-macro (count) - "Dispatch kbd macro." - (interactive "P") - (let* ((macro-alist (cond ((eq vip-current-state 'vi-state) - vip-vi-kbd-macro-alist) - ((memq vip-current-state - '(insert-state replace-state)) - vip-insert-kbd-macro-alist) - (t - vip-emacs-kbd-macro-alist))) - (unmatched-suffix "") - ;; Macros and keys are executed with other macros turned off - ;; For macros, this is done to avoid macro recursion - vip-vi-kbd-minor-mode vip-insert-kbd-minor-mode - vip-emacs-kbd-minor-mode - next-best-match keyseq event-seq - macro-first-char macro-alist-elt macro-body - command) - - (setq macro-first-char last-command-event - event-seq (vip-read-fast-keysequence macro-first-char macro-alist) - keyseq (vip-events-to-macro event-seq) - macro-alist-elt (assoc keyseq macro-alist) - next-best-match (vip-find-best-matching-macro macro-alist keyseq)) - - (if (null macro-alist-elt) - (setq macro-alist-elt (car next-best-match) - unmatched-suffix (subseq event-seq (cdr next-best-match)))) - - (cond ((null macro-alist-elt)) - ((setq macro-body (vip-kbd-buf-definition macro-alist-elt))) - ((setq macro-body (vip-kbd-mode-definition macro-alist-elt))) - ((setq macro-body (vip-kbd-global-definition macro-alist-elt)))) - - ;; when defining keyboard macro, don't use the macro mappings - (if (and macro-body (not defining-kbd-macro)) - ;; block cmd executed as part of a macro from entering command history - (let ((command-history command-history)) - (setq vip-this-kbd-macro (car macro-alist-elt)) - (execute-kbd-macro (vip-macro-to-events macro-body) count) - (setq vip-this-kbd-macro nil - vip-last-kbd-macro (car macro-alist-elt)) - (vip-set-unread-command-events unmatched-suffix)) - ;; If not a macro, or the macro is suppressed while defining another - ;; macro, put keyseq back on the event queue - (vip-set-unread-command-events event-seq) - ;; if the user typed arg, then use it if prefix arg is not set by - ;; some other command (setting prefix arg can happen if we do, say, - ;; 2dw and there is a macro starting with 2. Then control will go to - ;; this routine - (or prefix-arg (setq prefix-arg count)) - (setq command (key-binding (read-key-sequence nil))) - (if (commandp command) - (command-execute command) - (beep 1))) - )) - - - -;;; Displaying and completing macros - -(defun vip-describe-kbd-macros () - "Show currently defined keyboard macros." - (interactive) - (with-output-to-temp-buffer " *vip-info*" - (princ "Macros in Vi state:\n===================\n") - (mapcar 'vip-describe-one-macro vip-vi-kbd-macro-alist) - (princ "\n\nMacros in Insert and Replace states:\n====================================\n") - (mapcar 'vip-describe-one-macro vip-insert-kbd-macro-alist) - (princ "\n\nMacros in Emacs state:\n======================\n") - (mapcar 'vip-describe-one-macro vip-emacs-kbd-macro-alist) - )) - -(defun vip-describe-one-macro (macro) - (princ (format "\n *** Mappings for %S:\n ------------\n" - (vip-display-macro (car macro)))) - (princ " ** Buffer-specific:") - (if (vip-kbd-buf-alist macro) - (mapcar 'vip-describe-one-macro-elt (vip-kbd-buf-alist macro)) - (princ " none\n")) - (princ "\n ** Mode-specific:") - (if (vip-kbd-mode-alist macro) - (mapcar 'vip-describe-one-macro-elt (vip-kbd-mode-alist macro)) - (princ " none\n")) - (princ "\n ** Global:") - (if (vip-kbd-global-definition macro) - (princ (format "\n %S" (cdr (vip-kbd-global-pair macro)))) - (princ " none")) - (princ "\n")) - -(defun vip-describe-one-macro-elt (elt) - (let ((name (car elt)) - (defn (cdr elt))) - (princ (format "\n * %S:\n %S\n" name defn)))) - - - -;; check if SEQ is a prefix of some car of an element in ALIST -(defun vip-keyseq-is-a-possible-macro (seq alist) - (let ((converted-seq (vip-events-to-macro seq))) - (eval (cons 'or - (mapcar - (function (lambda (elt) - (vip-prefix-subseq-p converted-seq elt))) - (vip-this-buffer-macros alist)))))) - -;; whether SEQ1 is a prefix of SEQ2 -(defun vip-prefix-subseq-p (seq1 seq2) - (let ((len1 (length seq1)) - (len2 (length seq2))) - (if (<= len1 len2) - (equal seq1 (subseq seq2 0 len1))))) - -;; find the longest common prefix -(defun vip-common-seq-prefix (&rest seqs) - (let* ((first (car seqs)) - (rest (cdr seqs)) - (pref []) - (idx 0) - len) - (if (= (length seqs) 0) - (setq len 0) - (setq len (apply 'min (mapcar 'length seqs)))) - (while (< idx len) - (if (eval (cons 'and - (mapcar (function (lambda (s) - (equal (elt first idx) - (elt s idx)))) - rest))) - (setq pref (vconcat pref (vector (elt first idx))))) - (setq idx (1+ idx))) - pref)) - -;; get all sequences that match PREFIX from a given A-LIST -(defun vip-extract-matching-alist-members (pref alist) - (delq nil (mapcar (function (lambda (elt) - (if (vip-prefix-subseq-p pref elt) - elt))) - (vip-this-buffer-macros alist)))) - -(defun vip-do-sequence-completion (seq alist compl-message) - (let* ((matches (vip-extract-matching-alist-members seq alist)) - (new-seq (apply 'vip-common-seq-prefix matches)) - ) - (cond ((and (equal seq new-seq) (= (length matches) 1)) - (message "%s (Sole completion)" compl-message) - (sit-for 2)) - ((null matches) - (message "%s (No match)" compl-message) - (sit-for 2) - (setq new-seq seq)) - ((member seq matches) - (message "%s (Complete, but not unique)" compl-message) - (sit-for 2) - (vip-display-vector-completions matches)) - ((equal seq new-seq) - (vip-display-vector-completions matches))) - new-seq)) - - -(defun vip-display-vector-completions (list) - (with-output-to-temp-buffer "*Completions*" - (display-completion-list - (mapcar 'prin1-to-string - (mapcar 'vip-display-macro list))))) - - - -;; alist is the alist of macros -;; str is the fast key sequence entered -;; returns: (matching-macro-def . unmatched-suffix-start-index) -(defun vip-find-best-matching-macro (alist str) - (let ((lis alist) - (def-len 0) - (str-len (length str)) - match unmatched-start-idx found macro-def) - (while (and (not found) lis) - (setq macro-def (car lis) - def-len (length (car macro-def))) - (if (and (>= str-len def-len) - (equal (car macro-def) (subseq str 0 def-len))) - (if (or (vip-kbd-buf-definition macro-def) - (vip-kbd-mode-definition macro-def) - (vip-kbd-global-definition macro-def)) - (setq found t)) - ) - (setq lis (cdr lis))) - - (if found - (setq match macro-def - unmatched-start-idx def-len) - (setq match nil - unmatched-start-idx 0)) - - (cons match unmatched-start-idx))) - - - -;; returns a list of names of macros defined for the current buffer -(defun vip-this-buffer-macros (macro-alist) - (let (candidates) - (setq candidates - (mapcar (function - (lambda (elt) - (if (or (vip-kbd-buf-definition elt) - (vip-kbd-mode-definition elt) - (vip-kbd-global-definition elt)) - (car elt)))) - macro-alist)) - (setq candidates (delq nil candidates)))) - - -;; if seq of Viper key symbols (representing a macro) can be converted to a -;; string--do so. Otherwise, do nothing. -(defun vip-display-macro (macro-name-or-body) - (cond ((vip-char-symbol-sequence-p macro-name-or-body) - (mapconcat 'symbol-name macro-name-or-body "")) - ((vip-char-array-p macro-name-or-body) - (mapconcat 'char-to-string macro-name-or-body "")) - (t macro-name-or-body))) - -;; convert sequence of events (that came presumably from emacs kbd macro) into -;; Viper's macro, which is a vector of the form -;; [ desc desc ... ] -;; Each desc is either a symbol of (meta symb), (shift symb), etc. -;; Here we purge events that happen to be lists. In most cases, these events -;; got into a macro definition unintentionally; say, when the user moves mouse -;; during a macro definition, then something like (switch-frame ...) might get -;; in. Another reason for purging lists-events is that we can't store them in -;; textual form (say, in .emacs) and then read them back. -(defun vip-events-to-macro (event-seq) - (vconcat (delq nil (mapcar (function (lambda (elt) - (if (consp elt) - nil - (vip-event-key elt)))) - event-seq)))) - -;; convert strings or arrays of characters to Viper macro form -(defun vip-char-array-to-macro (array) - (let ((vec (vconcat array)) - macro) - (if vip-xemacs-p - (setq macro (mapcar 'character-to-event vec)) - (setq macro vec)) - (vconcat (mapcar 'vip-event-key macro)))) - -;; For macros bodies and names, goes over MACRO and checks if all members are -;; names of keys (actually, it only checks if they are symbols or lists -;; if a digit is found, it is converted into a symbol (e.g., 0 -> \0, etc). -;; If MACRO is not a list or vector -- doesn't change MACRO. -(defun vip-fixup-macro (macro) - (let ((len (length macro)) - (idx 0) - elt break) - (if (or (vectorp macro) (listp macro)) - (while (and (< idx len) (not break)) - (setq elt (elt macro idx)) - (cond ((numberp elt) - ;; fix number - (if (and (<= 0 elt) (<= elt 9)) - (cond ((arrayp macro) - (aset macro - idx - (intern (char-to-string (+ ?0 elt))))) - ((listp macro) - (setcar (nthcdr idx macro) - (intern (char-to-string (+ ?0 elt))))) - ))) - ((listp elt) - (vip-fixup-macro elt)) - ((symbolp elt) nil) - (t (setq break t))) - (setq idx (1+ idx)))) - - (if break - (error "Wrong type macro component, symbol-or-listp, %S" elt) - macro))) - -(defun vip-char-array-p (array) - (eval (cons 'and (mapcar 'vip-characterp array)))) - -(defun vip-macro-to-events (macro-body) - (vconcat (mapcar 'vip-key-to-emacs-key macro-body))) - - -;; check if vec is a vector of character symbols -(defun vip-char-symbol-sequence-p (vec) - (and - (sequencep vec) - (eval - (cons 'and - (mapcar - (function (lambda (elt) - (and (symbolp elt) (= (length (symbol-name elt)) 1)))) - vec))))) - - -;; Check if vec is a vector of key-press events representing characters -;; XEmacs only -(defun vip-event-vector-p (vec) - (and (vectorp vec) - (eval (cons 'and (mapcar '(lambda (elt) (if (eventp elt) t)) vec))))) - - -;;; Reading fast key sequences - -;; Assuming that CHAR was the first character in a fast succession of key -;; strokes, read the rest. Return the vector of keys that was entered in -;; this fast succession of key strokes. -;; A fast keysequence is one that is terminated by a pause longer than -;; vip-fast-keyseq-timeout. -(defun vip-read-fast-keysequence (event macro-alist) - (let ((lis (vector event)) - next-event) - (while (and (vip-fast-keysequence-p) - (vip-keyseq-is-a-possible-macro lis macro-alist)) - (setq next-event (vip-read-key)) - ;;(setq next-event (vip-read-event)) - (or (vip-mouse-event-p next-event) - (setq lis (vconcat lis (vector next-event))))) - lis)) - - -;;; Keyboard macros in registers - -;; sets register to last-kbd-macro carefully. -(defun vip-set-register-macro (reg) - (if (get-register reg) - (if (y-or-n-p "Register contains data. Overwrite? ") - () - (error - "Macro not saved in register. Can still be invoked via `C-x e'"))) - (set-register reg last-kbd-macro)) - -(defun vip-register-macro (count) - "Keyboard macros in registers - a modified \@ command." - (interactive "P") - (let ((reg (downcase (read-char)))) - (cond ((or (and (<= ?a reg) (<= reg ?z))) - (setq vip-last-macro-reg reg) - (if defining-kbd-macro - (progn - (end-kbd-macro) - (vip-set-register-macro reg)) - (execute-kbd-macro (get-register reg) count))) - ((or (= ?@ reg) (= ?\^j reg) (= ?\^m reg)) - (if vip-last-macro-reg - nil - (error "No previous kbd macro")) - (execute-kbd-macro (get-register vip-last-macro-reg) count)) - ((= ?\# reg) - (start-kbd-macro count)) - ((= ?! reg) - (setq reg (downcase (read-char))) - (if (or (and (<= ?a reg) (<= reg ?z))) - (progn - (setq vip-last-macro-reg reg) - (vip-set-register-macro reg)))) - (t - (error "`%c': Unknown register" reg))))) - - -(defun vip-global-execute () - "Call last keyboad macro for each line in the region." - (if (> (point) (mark t)) (exchange-point-and-mark)) - (beginning-of-line) - (call-last-kbd-macro) - (while (< (point) (mark t)) - (forward-line 1) - (beginning-of-line) - (call-last-kbd-macro))) - - -(provide 'viper-macs) - -;;; viper-macs.el ends here diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el deleted file mode 100644 index 73cef2eef85..00000000000 --- a/lisp/emulation/viper-mous.el +++ /dev/null @@ -1,459 +0,0 @@ -;;; viper-mous.el --- mouse support for Viper - -;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. - -;; This file is part of GNU Emacs. - -;; 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 -;; the Free Software Foundation; either version 2, 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 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;; Code - -(require 'viper-util) - -;; compiler pacifier -(defvar double-click-time) -(defvar mouse-track-multi-click-time) -;; end compiler pacifier - - -;;; Variables - -;; Variable used for catching the switch-frame event. -;; If non-nil, indicates that previous-frame should be the selected -;; one. Used by vip-mouse-click-get-word. Not a user option. -(defvar vip-frame-of-focus nil) - -;; Frame that was selected before the switch-frame event. -(defconst vip-current-frame-saved (selected-frame)) - -(defvar vip-surrounding-word-function 'vip-surrounding-word - "*Function that determines what constitutes a word for clicking events. -Takes two parameters: a COUNT, indicating how many words to return, -and CLICK-COUNT, telling whether this is the first click, a double-click, -or a tripple-click.") - -;; time interval in millisecond within which successive clicks are -;; considered related -(defconst vip-multiclick-timeout (if vip-xemacs-p - mouse-track-multi-click-time - double-click-time) - "*Time interval in millisecond within which successive clicks are -considered related.") - -;; current event click count; XEmacs only -(defvar vip-current-click-count 0) -;; time stamp of the last click event; XEmacs only -(defvar vip-last-click-event-timestamp 0) - -;; Local variable used to toggle wraparound search on click. -(vip-deflocalvar vip-mouse-click-search-noerror t) - -;; Local variable used to delimit search after wraparound. -(vip-deflocalvar vip-mouse-click-search-limit nil) - -;; remembers prefix argument to pass along to commands invoked by second -;; click. -;; This is needed because in Emacs (not XEmacs), assigning to preix-arg -;; causes Emacs to count the second click as if it was a single click -(defvar vip-global-prefix-argument nil) - - - -;;; Code - -(defsubst vip-multiclick-p () - (not (vip-sit-for-short vip-multiclick-timeout t))) - -;; Returns window where click occurs -(defsubst vip-mouse-click-window (click) - (if vip-xemacs-p - (event-window click) - (posn-window (event-start click)))) - -;; Returns window where click occurs -(defsubst vip-mouse-click-frame (click) - (window-frame (vip-mouse-click-window click))) - -;; Returns the buffer of the window where click occurs -(defsubst vip-mouse-click-window-buffer (click) - (window-buffer (vip-mouse-click-window click))) - -;; Returns the name of the buffer in the window where click occurs -(defsubst vip-mouse-click-window-buffer-name (click) - (buffer-name (vip-mouse-click-window-buffer click))) - -;; Returns position of a click -(defsubst vip-mouse-click-posn (click) - (if vip-xemacs-p - (event-point click) - (posn-point (event-start click)))) - - -(defun vip-surrounding-word (count click-count) - "Returns word surrounding point according to a heuristic. -COUNT indicates how many regions to return. -If CLICK-COUNT is 1, `word' is a word in Vi sense. -If CLICK-COUNT is 2,then `word' is a Word in Vi sense. -If the character clicked on is a non-separator and is non-alphanumeric but -is adjacent to an alphanumeric symbol, then it is considered alphanumeric -for the purpose of this command. If this character has a matching -character, such as `\(' is a match for `\)', then the matching character is -also considered alphanumeric. -For convenience, in Lisp modes, `-' is considered alphanumeric. - -If CLICK-COUNT is 3 or more, returns the line clicked on with leading and -trailing space and tabs removed. In that case, the first argument, COUNT, -is ignored." - (let ((modifiers "") - beg skip-flag result - word-beg) - (if (> click-count 2) - (save-excursion - (beginning-of-line) - (vip-skip-all-separators-forward 'within-line) - (setq beg (point)) - (end-of-line) - (setq result (buffer-substring beg (point)))) - - (if (and (not (vip-looking-at-alphasep)) - (or (save-excursion (vip-backward-char-carefully) - (vip-looking-at-alpha)) - (save-excursion (vip-forward-char-carefully) - (vip-looking-at-alpha)))) - (setq modifiers - (cond ((looking-at "\\\\") "\\\\") - ((looking-at "-") "C-C-") - ((looking-at "[][]") "][") - ((looking-at "[()]") ")(") - ((looking-at "[{}]") "{}") - ((looking-at "[<>]") "<>") - ((looking-at "[`']") "`'") - ((looking-at "\\^") "\\^") - ((vip-looking-at-separator) "") - (t (char-to-string (following-char)))) - )) - - ;; Add `-' to alphanum, if it wasn't added and if we are in Lisp - (or (looking-at "-") - (not (string-match "lisp" (symbol-name major-mode))) - (setq modifiers (concat modifiers "C-C-"))) - - - (save-excursion - (cond ((> click-count 1) (vip-skip-nonseparators 'backward)) - ((vip-looking-at-alpha modifiers) - (vip-skip-alpha-backward modifiers)) - ((not (vip-looking-at-alphasep modifiers)) - (vip-skip-nonalphasep-backward)) - (t (if (> click-count 1) - (vip-skip-nonseparators 'backward) - (vip-skip-alpha-backward modifiers)))) - - (setq word-beg (point)) - - (setq skip-flag nil) ; don't move 1 char forw the first time - (while (> count 0) - (if skip-flag (vip-forward-char-carefully 1)) - (setq skip-flag t) ; now always move 1 char forward - (if (> click-count 1) - (vip-skip-nonseparators 'forward) - (vip-skip-alpha-forward modifiers)) - (setq count (1- count))) - - (setq result (buffer-substring word-beg (point)))) - ) ; if - ;; XEmacs doesn't have set-text-properties, but there buffer-substring - ;; doesn't return properties together with the string, so it's not needed. - (if vip-emacs-p - (set-text-properties 0 (length result) nil result)) - result - )) - - -(defun vip-mouse-click-get-word (click count click-count) - "Returns word surrounding the position of a mouse click. -Click may be in another window. Current window and buffer isn't changed. -On single or double click, returns the word as determined by -`vip-surrounding-word-function'." - - (let ((click-word "") - (click-pos (vip-mouse-click-posn click)) - (click-buf (vip-mouse-click-window-buffer click))) - (or (natnump count) (setq count 1)) - (or (natnump click-count) (setq click-count 1)) - - (save-excursion - (save-window-excursion - (if click-pos - (progn - (set-buffer click-buf) - - (goto-char click-pos) - (setq click-word - (funcall vip-surrounding-word-function count click-count))) - (error "Click must be over a window.")) - click-word)))) - - -(defun vip-mouse-click-insert-word (click arg) - "Insert word clicked or double-clicked on. -With prefix argument, N, insert that many words. -This command must be bound to a mouse click. -The double-click action of the same mouse button must not be bound -\(or it must be bound to the same function\). -See `vip-surrounding-word' for the definition of a word in this case." - (interactive "e\nP") - (if vip-frame-of-focus ;; to handle clicks in another frame - (select-frame vip-frame-of-focus)) - - ;; turn arg into a number - (cond ((integerp arg) nil) - ;; prefix arg is a list when one hits C-u then command - ((and (listp arg) (integerp (car arg))) - (setq arg (car arg))) - (t (setq arg 1))) - - (let (click-count interrupting-event) - (if (and - (vip-multiclick-p) - ;; This trick checks if there is a pending mouse event - ;; if so, we use this latter event and discard the current mouse click - ;; If the next pending event is not a mouse event, we execute - ;; the current mouse event - (progn - (setq interrupting-event (vip-read-event)) - (vip-mouse-event-p last-input-event))) - (progn ;; interrupted wait - (setq vip-global-prefix-argument arg) - ;; count this click for XEmacs - (vip-event-click-count click)) - ;; uninterrupted wait or the interrupting event wasn't a mouse event - (setq click-count (vip-event-click-count click)) - (if (> click-count 1) - (setq arg vip-global-prefix-argument - vip-global-prefix-argument nil)) - (insert (vip-mouse-click-get-word click arg click-count)) - (if (and interrupting-event - (eventp interrupting-event) - (not (vip-mouse-event-p interrupting-event))) - (vip-set-unread-command-events interrupting-event)) - ))) - -;; arg is an event. accepts symbols and numbers, too -(defun vip-mouse-event-p (event) - (if (eventp event) - (string-match "\\(mouse-\\|frame\\|screen\\|track\\)" - (prin1-to-string (vip-event-key event))))) - -;; XEmacs has no double-click events. So, we must simulate. -;; So, we have to simulate event-click-count. -(defun vip-event-click-count (click) - (if vip-xemacs-p - (progn - ;; if more than 1 second - (if (> (- (event-timestamp click) vip-last-click-event-timestamp) - vip-multiclick-timeout) - (setq vip-current-click-count 0)) - (setq vip-last-click-event-timestamp (event-timestamp click) - vip-current-click-count (1+ vip-current-click-count))) - (event-click-count click))) - - - -(defun vip-mouse-click-search-word (click arg) - "Find the word clicked or double-clicked on. Word may be in another window. -With prefix argument, N, search for N-th occurrence. -This command must be bound to a mouse click. The double-click action of the -same button must not be bound \(or it must be bound to the same function\). -See `vip-surrounding-word' for the details on what constitutes a word for -this command." - (interactive "e\nP") - (if vip-frame-of-focus ;; to handle clicks in another frame - (select-frame vip-frame-of-focus)) - (let (click-word click-count - (previous-search-string vip-s-string)) - - (if (and - (vip-multiclick-p) - ;; This trick checks if there is a pending mouse event - ;; if so, we use this latter event and discard the current mouse click - ;; If the next pending event is not a mouse event, we execute - ;; the current mouse event - (progn - (vip-read-event) - (vip-mouse-event-p last-input-event))) - (progn ;; interrupted wait - (setq vip-global-prefix-argument - (or vip-global-prefix-argument arg)) - ;; remember command that was before the multiclick - (setq this-command last-command) - ;; make sure we counted this event---needed for XEmacs only - (vip-event-click-count click)) - ;; uninterrupted wait - (setq click-count (vip-event-click-count click)) - (setq click-word (vip-mouse-click-get-word click nil click-count)) - - (if (> click-count 1) - (setq arg vip-global-prefix-argument - vip-global-prefix-argument nil)) - (setq arg (or arg 1)) - - (vip-deactivate-mark) - (if (or (not (string= click-word vip-s-string)) - (not (markerp vip-search-start-marker)) - (not (equal (marker-buffer vip-search-start-marker) - (current-buffer))) - (not (eq last-command 'vip-mouse-click-search-word))) - (progn - (setq vip-search-start-marker (point-marker) - vip-local-search-start-marker vip-search-start-marker - vip-mouse-click-search-noerror t - vip-mouse-click-search-limit nil) - - ;; make search string known to Viper - (setq vip-s-string (if vip-re-search - (regexp-quote click-word) - click-word)) - (if (not (string= vip-s-string (car vip-search-history))) - (setq vip-search-history - (cons vip-s-string vip-search-history))) - )) - - (push-mark nil t) - (while (> arg 0) - (vip-forward-word 1) - (condition-case nil - (progn - (if (not (search-forward click-word vip-mouse-click-search-limit - vip-mouse-click-search-noerror)) - (progn - (setq vip-mouse-click-search-noerror nil) - (setq vip-mouse-click-search-limit - (save-excursion - (if (and - (markerp vip-local-search-start-marker) - (marker-buffer vip-local-search-start-marker)) - (goto-char vip-local-search-start-marker)) - (vip-line-pos 'end))) - - (goto-char (point-min)) - (search-forward click-word - vip-mouse-click-search-limit nil))) - (goto-char (match-beginning 0)) - (message "Searching for: %s" vip-s-string) - (if (<= arg 1) ; found the right occurrence of the pattern - (progn - (vip-adjust-window) - (vip-flash-search-pattern))) - ) - (error (beep 1) - (if (or (not (string= click-word previous-search-string)) - (not (eq last-command 'vip-mouse-click-search-word))) - (message "`%s': String not found in %s" - vip-s-string (buffer-name (current-buffer))) - (message - "`%s': Last occurrence in %s. Back to beginning of search" - click-word (buffer-name (current-buffer))) - (setq arg 1) ;; to terminate the loop - (sit-for 2)) - (setq vip-mouse-click-search-noerror t) - (setq vip-mouse-click-search-limit nil) - (if (and (markerp vip-local-search-start-marker) - (marker-buffer vip-local-search-start-marker)) - (goto-char vip-local-search-start-marker)))) - (setq arg (1- arg))) - ))) - -(defun vip-mouse-catch-frame-switch (event arg) - "Catch the event of switching frame. -Usually is bound to a 'down-mouse' event to work properly. See sample -bindings in viper.el and in the Viper manual." - (interactive "e\nP") - (setq vip-frame-of-focus nil) - ;; pass prefix arg along to vip-mouse-click-search/insert-word - (setq prefix-arg arg) - (if (eq last-command 'handle-switch-frame) - (setq vip-frame-of-focus vip-current-frame-saved)) - ;; make Emacs forget that it executed vip-mouse-catch-frame-switch - (setq this-command last-command)) - -;; Called just before switching frames. Saves the old selected frame. -;; Sets last-command to handle-switch-frame (this is done automatically in -;; Emacs. -;; The semantics of switching frames is different in Emacs and XEmacs. -;; In Emacs, if you select-frame A while mouse is over frame B and then -;; start typing, input goes to frame B, which becomes selected. -;; In XEmacs, input will go to frame A. This may be a bug in one of the -;; Emacsen, but also may be a design decision. -;; Also, in Emacs sending input to frame B generates handle-switch-frame -;; event, while in XEmacs it doesn't. -;; All this accounts for the difference in the behavior of -;; vip-mouse-click-* commands when you click in a frame other than the one -;; that was the last to receive input. In Emacs, focus will be in frame A -;; until you do something other than vip-mouse-click-* command. -;; In XEmacs, you have to manually select frame B (with the mouse click) in -;; order to shift focus to frame B. -(defsubst vip-remember-current-frame (frame) - (setq last-command 'handle-switch-frame - vip-current-frame-saved (selected-frame))) - - -(cond ((vip-window-display-p) - (let* ((search-key (if vip-xemacs-p - [(meta shift button1up)] [M-S-mouse-1])) - (search-key-catch (if vip-xemacs-p - [(meta shift button1)] [M-S-down-mouse-1])) - (insert-key (if vip-xemacs-p - [(meta shift button2up)] [M-S-mouse-2])) - (insert-key-catch (if vip-xemacs-p - [(meta shift button2)] [M-S-down-mouse-2])) - (search-key-unbound (and (not (key-binding search-key)) - (not (key-binding search-key-catch)))) - (insert-key-unbound (and (not (key-binding insert-key)) - (not (key-binding insert-key-catch)))) - ) - - (if search-key-unbound - (global-set-key search-key 'vip-mouse-click-search-word)) - (if insert-key-unbound - (global-set-key insert-key 'vip-mouse-click-insert-word)) - - ;; The following would be needed if you want to use the above two - ;; while clicking in another frame. If you only want to use them - ;; by clicking in another window, not frame, the bindings below - ;; aren't necessary. - - ;; These must be bound to mouse-down event for the same mouse - ;; buttons as 'vip-mouse-click-search-word and - ;; 'vip-mouse-click-insert-word - (if search-key-unbound - (global-set-key search-key-catch 'vip-mouse-catch-frame-switch)) - (if insert-key-unbound - (global-set-key insert-key-catch 'vip-mouse-catch-frame-switch)) - - (if vip-xemacs-p - (add-hook 'mouse-leave-frame-hook - 'vip-remember-current-frame) - (defadvice handle-switch-frame (before vip-frame-advice activate) - "Remember the selected frame before the switch-frame event." - (vip-remember-current-frame (selected-frame)))) - ))) - - - -(provide 'viper-mous) - -;;; viper-mous.el ends here diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el deleted file mode 100644 index 059e840d3a4..00000000000 --- a/lisp/emulation/viper-util.el +++ /dev/null @@ -1,1269 +0,0 @@ -;;; viper-util.el --- Utilities used by viper.el - -;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. - -;; This file is part of GNU Emacs. - -;; 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 -;; the Free Software Foundation; either version 2, 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 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - - -;; 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))))) - - -;;; 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 - -(if vip-xemacs-p - (progn - (fset 'vip-read-event (symbol-function 'next-command-event)) - (fset 'vip-make-overlay (symbol-function 'make-extent)) - (fset 'vip-overlay-start (symbol-function 'extent-start-position)) - (fset 'vip-overlay-end (symbol-function 'extent-end-position)) - (fset 'vip-overlay-put (symbol-function 'set-extent-property)) - (fset 'vip-overlay-p (symbol-function 'extentp)) - (fset 'vip-overlay-get (symbol-function 'extent-property)) - (fset 'vip-move-overlay (symbol-function 'set-extent-endpoints)) - (if (vip-window-display-p) - (fset 'vip-iconify (symbol-function 'iconify-frame))) - (cond ((vip-has-face-support-p) - (fset 'vip-get-face (symbol-function 'get-face)) - (fset 'vip-color-defined-p - (symbol-function 'valid-color-name-p)) - ))) - (fset 'vip-read-event (symbol-function 'read-event)) - (fset 'vip-make-overlay (symbol-function 'make-overlay)) - (fset 'vip-overlay-start (symbol-function 'overlay-start)) - (fset 'vip-overlay-end (symbol-function 'overlay-end)) - (fset 'vip-overlay-put (symbol-function 'overlay-put)) - (fset 'vip-overlay-p (symbol-function 'overlayp)) - (fset 'vip-overlay-get (symbol-function 'overlay-get)) - (fset 'vip-move-overlay (symbol-function 'move-overlay)) - (if (vip-window-display-p) - (fset 'vip-iconify (symbol-function 'iconify-or-deiconify-frame))) - (cond ((vip-has-face-support-p) - (fset 'vip-get-face (symbol-function 'internal-get-face)) - (fset 'vip-color-defined-p (symbol-function 'x-color-defined-p)) - ))) - -(fset 'vip-characterp - (symbol-function - (if vip-xemacs-p 'characterp 'integerp))) - -(defsubst vip-color-display-p () - (if vip-emacs-p - (x-display-color-p) - (eq (device-class (selected-device)) 'color))) - -(defsubst vip-get-cursor-color () - (if vip-emacs-p - (cdr (assoc 'cursor-color (frame-parameters))) - (color-instance-name (frame-property (selected-frame) 'cursor-color)))) - -(defun vip-set-face-pixmap (face pixmap) - "Set face pixmap on a monochrome display." - (if (and (vip-window-display-p) (not (vip-color-display-p))) - (condition-case nil - (set-face-background-pixmap face pixmap) - (error - (message "Pixmap not found for %S: %s" (face-name face) pixmap) - (sit-for 1))))) - - -;; OS/2 -(cond ((eq (vip-device-type) 'pm) - (fset 'vip-color-defined-p - (function (lambda (color) (assoc color pm-color-alist)))))) - -;; needed to smooth out the difference between Emacs and XEmacs -(defsubst vip-italicize-face (face) - (if vip-xemacs-p - (make-face-italic face) - (make-face-italic face nil 'noerror))) - -;; test if display is color and the colors are defined -(defsubst vip-can-use-colors (&rest colors) - (if (vip-color-display-p) - (not (memq nil (mapcar 'vip-color-defined-p colors))) - )) - -(defun vip-hide-face (face) - (if (and (vip-has-face-support-p) vip-emacs-p) - (add-to-list 'facemenu-unlisted-faces face))) - -;; cursor colors -(defun vip-change-cursor-color (new-color) - (if (and (vip-window-display-p) (vip-color-display-p) - (stringp new-color) (vip-color-defined-p new-color) - (not (string= new-color (vip-get-cursor-color)))) - (modify-frame-parameters - (selected-frame) (list (cons 'cursor-color new-color))))) - -(defsubst 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) - (not (string= color vip-replace-overlay-cursor-color))) - (vip-overlay-put vip-replace-overlay 'vip-cursor-color color))))) - -;; restore cursor color from replace overlay -(defsubst vip-restore-cursor-color-after-replace () - (vip-change-cursor-color - (vip-overlay-get vip-replace-overlay 'vip-cursor-color))) -(defsubst vip-restore-cursor-color-after-insert () - (vip-change-cursor-color vip-saved-cursor-color)) - - -;; Check the current version against the major and minor version numbers -;; using op: cur-vers op major.minor If emacs-major-version or -;; emacs-minor-version are not defined, we assume that the current version -;; is hopelessly outdated. We assume that emacs-major-version and -;; emacs-minor-version are defined. Otherwise, for Emacs/XEmacs 19, if the -;; current minor version is < 10 (xemacs) or < 23 (emacs) the return value -;; will be nil (when op is =, >, or >=) and t (when op is <, <=), which may be -;; incorrect. However, this gives correct result in our cases, since we are -;; testing for sufficiently high Emacs versions. -(defun vip-check-version (op major minor &optional type-of-emacs) - (if (and (boundp 'emacs-major-version) (boundp 'emacs-minor-version)) - (and (cond ((eq type-of-emacs 'xemacs) vip-xemacs-p) - ((eq type-of-emacs 'emacs) vip-emacs-p) - (t t)) - (cond ((eq op '=) (and (= emacs-minor-version minor) - (= emacs-major-version major))) - ((memq op '(> >= < <=)) - (and (or (funcall op emacs-major-version major) - (= emacs-major-version major)) - (if (= emacs-major-version major) - (funcall op emacs-minor-version minor) - t))) - (t - (error "%S: Invalid op in vip-check-version" op)))) - (cond ((memq op '(= > >=)) nil) - ((memq op '(< <=)) t)))) - -;;;; warn if it is a wrong version of emacs -;;(if (or (vip-check-version '< 19 29 'emacs) -;; (vip-check-version '< 19 12 'xemacs)) -;; (progn -;; (with-output-to-temp-buffer " *vip-info*" -;; (switch-to-buffer " *vip-info*") -;; (insert -;; (format " -;; -;;This version of Viper requires -;; -;;\t Emacs 19.29 and higher -;;\t OR -;;\t XEmacs 19.12 and higher -;; -;;It is unlikely to work under Emacs version %s -;;that you are using... " emacs-version)) -;; -;; (if noninteractive -;; () -;; (beep 1) -;; (beep 1) -;; (insert "\n\nType any key to continue... ") -;; (vip-read-event))) -;; (kill-buffer " *vip-info*"))) - - -(defun vip-get-visible-buffer-window (wind) - (if vip-xemacs-p - (get-buffer-window wind t) - (get-buffer-window wind 'visible))) - - -;; Return line position. -;; If pos is 'start then returns position of line start. -;; If pos is 'end, returns line end. If pos is 'mid, returns line center. -;; Pos = 'indent returns beginning of indentation. -;; Otherwise, returns point. Current point is not moved in any case." -(defun vip-line-pos (pos) - (let ((cur-pos (point)) - (result)) - (cond - ((equal pos 'start) - (beginning-of-line)) - ((equal pos 'end) - (end-of-line)) - ((equal pos 'mid) - (goto-char (+ (vip-line-pos 'start) (vip-line-pos 'end) 2))) - ((equal pos 'indent) - (back-to-indentation)) - (t nil)) - (setq result (point)) - (goto-char cur-pos) - result)) - - -;; Like move-marker but creates a virgin marker if arg isn't already a marker. -;; The first argument must eval to a variable name. -;; Arguments: (var-name position &optional buffer). -;; -;; This is useful for moving markers that are supposed to be local. -;; For this, VAR-NAME should be made buffer-local with nil as a default. -;; Then, each time this var is used in `vip-move-marker-locally' in a new -;; buffer, a new marker will be created. -(defun vip-move-marker-locally (var pos &optional buffer) - (if (markerp (eval var)) - () - (set var (make-marker))) - (move-marker (eval var) pos buffer)) - - -;; Print CONDITIONS as a message. -(defun vip-message-conditions (conditions) - (let ((case (car conditions)) (msg (cdr conditions))) - (if (null msg) - (message "%s" case) - (message "%s: %s" case (mapconcat 'prin1-to-string msg " "))) - (beep 1))) - - - -;;; List/alist utilities - -;; Convert LIST to an alist -(defun vip-list-to-alist (lst) - (let ((alist)) - (while lst - (setq alist (cons (list (car lst)) alist)) - (setq lst (cdr lst))) - alist)) - -;; Convert ALIST to a list. -(defun vip-alist-to-list (alst) - (let ((lst)) - (while alst - (setq lst (cons (car (car alst)) lst)) - (setq alst (cdr alst))) - lst)) - -;; Filter ALIST using REGEXP. Return alist whose elements match the regexp. -(defun vip-filter-alist (regexp alst) - (interactive "s x") - (let ((outalst) (inalst alst)) - (while (car inalst) - (if (string-match regexp (car (car inalst))) - (setq outalst (cons (car inalst) outalst))) - (setq inalst (cdr inalst))) - outalst)) - -;; Filter LIST using REGEXP. Return list whose elements match the regexp. -(defun vip-filter-list (regexp lst) - (interactive "s x") - (let ((outlst) (inlst lst)) - (while (car inlst) - (if (string-match regexp (car inlst)) - (setq outlst (cons (car inlst) outlst))) - (setq inlst (cdr inlst))) - outlst)) - - -;; Append LIS2 to LIS1, both alists, by side-effect and returns LIS1 -;; LIS2 is modified by filtering it: deleting its members of the form -;; \(car elt\) such that (car elt') is in LIS1. -(defun vip-append-filter-alist (lis1 lis2) - (let ((temp lis1) - elt) - - ;;filter-append the second list - (while temp - ;; delete all occurrences - (while (setq elt (assoc (car (car temp)) lis2)) - (setq lis2 (delq elt lis2))) - (setq temp (cdr temp))) - - (nconc lis1 lis2))) - - -;;; Support for :e and file globbing - -(defun vip-ex-nontrivial-find-file-unix (filespec) - "Glob the file spec and visit all files matching the spec. -This function is designed to work under Unix. It may also work under VMS. - -Users who prefer other types of shells should write their own version of this -function and set the variable `ex-nontrivial-find-file-function' -appropriately." - (let ((gshell - (cond (ex-unix-type-shell shell-file-name) - ((memq system-type '(vax-vms axp-vms)) "*dcl*") ; VAX VMS - (t "sh"))) ; probably Unix anyway - (gshell-options - ;; using cond in anticipation of further additions - (cond (ex-unix-type-shell-options) - )) - (command (cond (vip-ms-style-os-p (format "\"ls -1 -d %s\"" filespec)) - (t (format "ls -1 -d %s" filespec)))) - file-list status) - (save-excursion - (set-buffer (get-buffer-create vip-ex-tmp-buf-name)) - (erase-buffer) - (setq status - (if gshell-options - (call-process gshell nil t nil - gshell-options - "-c" - command) - (call-process gshell nil t nil - "-c" - command))) - (goto-char (point-min)) - ;; Issue an error, if no match. - (if (> status 0) - (save-excursion - (skip-chars-forward " \t\n\j") - (if (looking-at "ls:") - (vip-forward-Word 1)) - (error "%s: %s" - (if (stringp gshell) - gshell - "shell") - (buffer-substring (point) (vip-line-pos 'end))) - )) - (goto-char (point-min)) - (setq file-list (vip-get-filenames-from-buffer 'one-per-line))) - - (mapcar 'find-file file-list) - )) - -(defun vip-ex-nontrivial-find-file-ms (filespec) - "Glob the file spec and visit all files matching the spec. -This function is designed to work under MS type systems, such as NT, W95, and -DOS. It may also work under OS/2. - -The users of Unix-type shells should be able to use -`vip-ex-nontrivial-find-file-unix', making it into the value of the variable -`ex-nontrivial-find-file-function'. If this doesn't work, the user may have -to write a custom function, similar to `vip-ex-nontrivial-find-file-unix'." - (save-excursion - (set-buffer (get-buffer-create vip-ex-tmp-buf-name)) - (erase-buffer) - (insert filespec) - (goto-char (point-min)) - (mapcar 'find-file - (vip-glob-ms-windows-files (vip-get-filenames-from-buffer))) - )) - - -;; Interpret the stuff in the buffer as a list of file names -;; return a list of file names listed in the buffer beginning at point -;; If optional arg is supplied, assume each filename is listed on a separate -;; line -(defun vip-get-filenames-from-buffer (&optional one-per-line) - (let ((skip-chars (if one-per-line "\t\n" " \t\n")) - result fname delim) - (skip-chars-forward skip-chars) - (while (not (eobp)) - (if (cond ((looking-at "\"") - (setq delim ?\") - (re-search-forward "[^\"]+" nil t)) ; noerror - ((looking-at "'") - (setq delim ?') - (re-search-forward "[^']+" nil t)) ; noerror - (t - (re-search-forward - (concat "[^" skip-chars "]+") nil t))) ;noerror - (setq fname - (buffer-substring (match-beginning 0) (match-end 0)))) - (if delim - (forward-char 1)) - (skip-chars-forward " \t\n") - (setq result (cons fname result))) - result)) - -;; convert MS-DOS wildcards to regexp -(defun vip-wildcard-to-regexp (wcard) - (save-excursion - (set-buffer (get-buffer-create vip-ex-tmp-buf-name)) - (erase-buffer) - (insert wcard) - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward "^*?.\\\\") - (cond ((eq (char-after (point)) ?*) (insert ".")(forward-char 1)) - ((eq (char-after (point)) ?.) (insert "\\")(forward-char 1)) - ((eq (char-after (point)) ?\\) (insert "\\")(forward-char 1)) - ((eq (char-after (point)) ??) (delete-char 1)(insert "."))) - ) - (buffer-string) - )) - - -;; glob windows files -;; LIST is expected to be in reverse order -(defun vip-glob-ms-windows-files (list) - (let ((tmp list) - (case-fold-search t) - tmp2) - (while tmp - (setq tmp2 (cons (directory-files - ;; the directory part - (or (file-name-directory (car tmp)) - "") - t ; return full names - ;; the regexp part: globs the file names - (concat "^" - (vip-wildcard-to-regexp - (file-name-nondirectory (car tmp))) - "$")) - tmp2)) - (setq tmp (cdr tmp))) - (reverse (apply 'append tmp2)))) - -(defun vip-convert-standard-file-name (fname) - (if vip-emacs-p - (convert-standard-filename fname) - ;; hopefully, XEmacs adds this functionality - fname)) - - - -;;; Insertion ring - -;; Rotate RING's index. DIRection can be positive or negative. -(defun vip-ring-rotate1 (ring dir) - (if (and (ring-p ring) (> (ring-length ring) 0)) - (progn - (setcar ring (cond ((> dir 0) - (ring-plus1 (car ring) (ring-length ring))) - ((< dir 0) - (ring-minus1 (car ring) (ring-length ring))) - ;; don't rotate if dir = 0 - (t (car ring)))) - (vip-current-ring-item ring) - ))) - -(defun vip-special-ring-rotate1 (ring dir) - (if (memq vip-intermediate-command - '(repeating-display-destructive-command - repeating-insertion-from-ring)) - (vip-ring-rotate1 ring dir) - ;; don't rotate otherwise - (vip-ring-rotate1 ring 0))) - -;; current ring item; if N is given, then so many items back from the -;; current -(defun vip-current-ring-item (ring &optional n) - (setq n (or n 0)) - (if (and (ring-p ring) (> (ring-length ring) 0)) - (aref (cdr (cdr ring)) (mod (- (car ring) 1 n) (ring-length ring))))) - -;; push item onto ring. the second argument is a ring-variable, not value. -(defun vip-push-onto-ring (item ring-var) - (or (ring-p (eval ring-var)) - (set ring-var (make-ring (eval (intern (format "%S-size" ring-var)))))) - (or (null item) ; don't push nil - (and (stringp item) (string= item "")) ; or empty strings - (equal item (vip-current-ring-item (eval ring-var))) ; or old stuff - ;; Since vip-set-destructive-command checks if we are inside vip-repeat, - ;; we don't check whether this-command-keys is a `.'. - ;; The cmd vip-repeat makes a call to the current function only if - ;; `.' is executing a command from the command history. It doesn't - ;; call the push-onto-ring function if `.' is simply repeating the - ;; last destructive command. - ;; We only check for ESC (which happens when we do insert with a - ;; prefix argument, or if this-command-keys doesn't give anything - ;; meaningful (in that case we don't know what to show to the user). - (and (eq ring-var 'vip-command-ring) - (string-match "\\([0-9]*\e\\|^[ \t]*$\\|escape\\)" - (vip-array-to-string (this-command-keys)))) - (vip-ring-insert (eval ring-var) item)) - ) - - -;; removing elts from ring seems to break it -(defun vip-cleanup-ring (ring) - (or (< (ring-length ring) 2) - (null (vip-current-ring-item ring)) - ;; last and previous equal - (if (equal (vip-current-ring-item ring) (vip-current-ring-item ring 1)) - (vip-ring-pop ring)))) - -;; ring-remove seems to be buggy, so we concocted this for our purposes. -(defun vip-ring-pop (ring) - (let* ((ln (ring-length ring)) - (vec (cdr (cdr ring))) - (veclen (length vec)) - (hd (car ring)) - (idx (max 0 (ring-minus1 hd ln))) - (top-elt (aref vec idx))) - - ;; shift elements - (while (< (1+ idx) veclen) - (aset vec idx (aref vec (1+ idx))) - (setq idx (1+ idx))) - (aset vec idx nil) - - (setq hd (max 0 (ring-minus1 hd ln))) - (if (= hd (1- ln)) (setq hd 0)) - (setcar ring hd) ; move head - (setcar (cdr ring) (max 0 (1- ln))) ; adjust length - top-elt - )) - -(defun vip-ring-insert (ring item) - (let* ((ln (ring-length ring)) - (vec (cdr (cdr ring))) - (veclen (length vec)) - (hd (car ring)) - (vecpos-after-hd (if (= hd 0) ln hd)) - (idx ln)) - - (if (= ln veclen) - (progn - (aset vec hd item) ; hd is always 1+ the actual head index in vec - (setcar ring (ring-plus1 hd ln))) - (setcar (cdr ring) (1+ ln)) - (setcar ring (ring-plus1 vecpos-after-hd (1+ ln))) - (while (and (>= idx vecpos-after-hd) (> ln 0)) - (aset vec idx (aref vec (1- idx))) - (setq idx (1- idx))) - (aset vec vecpos-after-hd item)) - item)) - - -;;; String utilities - -;; If STRING is longer than MAX-LEN, truncate it and print ...... instead -;; PRE-STRING is a string to prepend to the abbrev string. -;; POST-STRING is a string to append to the abbrev string. -;; ABBREV_SIGN is a string to be inserted before POST-STRING -;; if the orig string was truncated. -(defun vip-abbreviate-string (string max-len - pre-string post-string abbrev-sign) - (let (truncated-str) - (setq truncated-str - (if (stringp string) - (substring string 0 (min max-len (length string))))) - (cond ((null truncated-str) "") - ((> (length string) max-len) - (format "%s%s%s%s" - pre-string truncated-str abbrev-sign post-string)) - (t (format "%s%s%s" pre-string truncated-str post-string))))) - -;; tells if we are over a whitespace-only line -(defsubst vip-over-whitespace-line () - (save-excursion - (beginning-of-line) - (looking-at "^[ \t]*$"))) - - -;;; Saving settings in custom file - -;; Save the current setting of VAR in CUSTOM-FILE. -;; If given, MESSAGE is a message to be displayed after that. -;; This message is erased after 2 secs, if erase-msg is non-nil. -;; Arguments: var message custom-file &optional erase-message -(defun vip-save-setting (var message custom-file &optional erase-msg) - (let* ((var-name (symbol-name var)) - (var-val (if (boundp var) (eval var))) - (regexp (format "^[^;]*%s[ \t\n]*[a-zA-Z---_']*[ \t\n)]" var-name)) - (buf (find-file-noselect (substitute-in-file-name custom-file))) - ) - (message message) - (save-excursion - (set-buffer buf) - (goto-char (point-min)) - (if (re-search-forward regexp nil t) - (let ((reg-end (1- (match-end 0)))) - (search-backward var-name) - (delete-region (match-beginning 0) reg-end) - (goto-char (match-beginning 0)) - (insert (format "%s '%S" var-name var-val))) - (goto-char (point-max)) - (if (not (bolp)) (insert "\n")) - (insert (format "(setq %s '%S)\n" var-name var-val))) - (save-buffer)) - (kill-buffer buf) - (if erase-msg - (progn - (sit-for 2) - (message ""))) - )) - -;; Save STRING in CUSTOM-FILE. If PATTERN is non-nil, remove strings that -;; match this pattern. -(defun vip-save-string-in-file (string custom-file &optional pattern) - (let ((buf (find-file-noselect (substitute-in-file-name custom-file)))) - (save-excursion - (set-buffer buf) - (goto-char (point-min)) - (if pattern (delete-matching-lines pattern)) - (goto-char (point-max)) - (if string (insert string)) - (save-buffer)) - (kill-buffer buf) - )) - - -;;; Overlays - -;; Search - -(defun vip-flash-search-pattern () - (if (vip-overlay-p vip-search-overlay) - (vip-move-overlay vip-search-overlay (match-beginning 0) (match-end 0)) - (setq vip-search-overlay - (vip-make-overlay - (match-beginning 0) (match-end 0) (current-buffer)))) - - (vip-overlay-put vip-search-overlay 'priority vip-search-overlay-priority) - (if (vip-has-face-support-p) - (progn - (vip-overlay-put vip-search-overlay 'face vip-search-face) - (sit-for 2) - (vip-overlay-put vip-search-overlay 'face nil)))) - - -;; Replace state - -(defsubst vip-move-replace-overlay (beg end) - (vip-move-overlay vip-replace-overlay beg end)) - -(defun vip-set-replace-overlay (beg end) - (if (vip-overlay-p vip-replace-overlay) - (vip-move-replace-overlay beg end) - (setq vip-replace-overlay (vip-make-overlay beg end (current-buffer))) - ;; never detach - (vip-overlay-put - vip-replace-overlay (if vip-emacs-p 'evaporate 'detachable) nil) - (vip-overlay-put - vip-replace-overlay 'priority vip-replace-overlay-priority)) - (if (vip-has-face-support-p) - (vip-overlay-put vip-replace-overlay 'face vip-replace-overlay-face)) - (vip-save-cursor-color) - (vip-change-cursor-color vip-replace-overlay-cursor-color) - ) - - -(defsubst vip-set-replace-overlay-glyphs (before-glyph after-glyph) - (if (or (not (vip-has-face-support-p)) - vip-use-replace-region-delimiters) - (let ((before-name (if vip-xemacs-p 'begin-glyph 'before-string)) - (after-name (if vip-xemacs-p 'end-glyph 'after-string))) - (vip-overlay-put vip-replace-overlay before-name before-glyph) - (vip-overlay-put vip-replace-overlay after-name after-glyph)))) - -(defsubst vip-hide-replace-overlay () - (vip-set-replace-overlay-glyphs nil nil) - (vip-restore-cursor-color-after-replace) - (vip-restore-cursor-color-after-insert) - (if (vip-has-face-support-p) - (vip-overlay-put vip-replace-overlay 'face nil))) - - -(defsubst vip-replace-start () - (vip-overlay-start vip-replace-overlay)) -(defsubst vip-replace-end () - (vip-overlay-end vip-replace-overlay)) - - -;; Minibuffer - -(defun vip-set-minibuffer-overlay () - (vip-check-minibuffer-overlay) - (if (vip-has-face-support-p) - (progn - (vip-overlay-put - vip-minibuffer-overlay 'face vip-minibuffer-current-face) - (vip-overlay-put - vip-minibuffer-overlay 'priority vip-minibuffer-overlay-priority) - ;; never detach - (vip-overlay-put - vip-minibuffer-overlay (if vip-emacs-p 'evaporate 'detachable) nil) - ;; make vip-minibuffer-overlay open-ended - ;; In emacs, it is made open ended at creation time - (if vip-xemacs-p - (progn - (vip-overlay-put vip-minibuffer-overlay 'start-open nil) - (vip-overlay-put vip-minibuffer-overlay 'end-open nil))) - ))) - -(defun vip-check-minibuffer-overlay () - (or (vip-overlay-p vip-minibuffer-overlay) - (setq vip-minibuffer-overlay - (if vip-xemacs-p - (vip-make-overlay 1 (1+ (buffer-size)) (current-buffer)) - ;; make overlay open-ended - (vip-make-overlay - 1 (1+ (buffer-size)) (current-buffer) nil 'rear-advance))) - )) - - -(defsubst vip-is-in-minibuffer () - (string-match "\*Minibuf-" (buffer-name))) - - - -;;; XEmacs compatibility - -(defun vip-abbreviate-file-name (file) - (if vip-emacs-p - (abbreviate-file-name file) - ;; XEmacs requires addl argument - (abbreviate-file-name file t))) - -;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg -;; in sit-for, so this function smoothes out the differences. -(defsubst vip-sit-for-short (val &optional nodisp) - (if vip-xemacs-p - (sit-for (/ val 1000.0) nodisp) - (sit-for 0 val nodisp))) - -;; EVENT may be a single event of a sequence of events -(defsubst vip-ESC-event-p (event) - (let ((ESC-keys '(?\e (control \[) escape)) - (key (vip-event-key event))) - (member key ESC-keys))) - - -(defsubst vip-mark-marker () - (if vip-xemacs-p - (mark-marker t) - (mark-marker))) - -;; like (set-mark-command nil) but doesn't push twice, if (car mark-ring) -;; is the same as (mark t). -(defsubst vip-set-mark-if-necessary () - (setq mark-ring (delete (vip-mark-marker) mark-ring)) - (set-mark-command nil)) - -;; In transient mark mode (zmacs mode), it is annoying when regions become -;; highlighted due to Viper's pushing marks. So, we deactivate marks, unless -;; the user explicitly wants highlighting, e.g., by hitting '' or `` -(defun vip-deactivate-mark () - (if vip-xemacs-p - (zmacs-deactivate-region) - (deactivate-mark))) - -(defsubst vip-leave-region-active () - (if vip-xemacs-p - (setq zmacs-region-stays t))) - - -(defsubst vip-events-to-keys (events) - (cond (vip-xemacs-p (events-to-keys events)) - (t events))) - - -(defun vip-eval-after-load (file form) - (if vip-emacs-p - (eval-after-load file form) - (or (assoc file after-load-alist) - (setq after-load-alist (cons (list file) after-load-alist))) - (let ((elt (assoc file after-load-alist))) - (or (member form (cdr elt)) - (setq elt (nconc elt (list form))))) - form - )) - -;; This is here because Emacs changed the way local hooks work. -;; -;;Add to the value of HOOK the function FUNCTION. -;;FUNCTION is not added if already present. -;;FUNCTION is added (if necessary) at the beginning of the hook list -;;unless the optional argument APPEND is non-nil, in which case -;;FUNCTION is added at the end. -;; -;;HOOK should be a symbol, and FUNCTION may be any valid function. If -;;HOOK is void, it is first set to nil. If HOOK's value is a single -;;function, it is changed to a list of functions." -(defun vip-add-hook (hook function &optional append) - (if (not (boundp hook)) (set hook nil)) - ;; If the hook value is a single function, turn it into a list. - (let ((old (symbol-value hook))) - (if (or (not (listp old)) (eq (car old) 'lambda)) - (setq old (list old))) - (if (member function old) - nil - (set hook (if append - (append old (list function)) ; don't nconc - (cons function old)))))) - -;; This is here because of Emacs's changes in the semantics of add/remove-hooks -;; and due to the bugs they introduced. -;; -;; Remove from the value of HOOK the function FUNCTION. -;; HOOK should be a symbol, and FUNCTION may be any valid function. If -;; FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the -;; list of hooks to run in HOOK, then nothing is done. See `vip-add-hook'." -(defun vip-remove-hook (hook function) - (if (or (not (boundp hook)) ;unbound symbol, or - (null (symbol-value hook)) ;value is nil, or - (null function)) ;function is nil, then - nil ;Do nothing. - (let ((hook-value (symbol-value hook))) - (if (consp hook-value) - ;; don't side-effect the list - (setq hook-value (delete function (copy-sequence hook-value))) - (if (equal hook-value function) - (setq hook-value nil))) - (set hook hook-value)))) - - - -;; like read-event, but in XEmacs also try to convert to char, if possible -(defun vip-read-event-convert-to-char () - (let (event) - (if vip-emacs-p - (read-event) - (setq event (next-command-event)) - (or (event-to-character event) - event)) - )) - -;; This function lets function-key-map convert key sequences into logical -;; keys. This does a better job than vip-read-event when it comes to kbd -;; macros, since it enables certain macros to be shared between X and TTY modes -;; by correctly mapping key sequences for Left/Right/... (one an ascii -;; terminal) into logical keys left, right, etc. -(defun vip-read-key () - (let ((overriding-local-map vip-overriding-map) - (inhibit-quit t) - key) - (use-global-map vip-overriding-map) - (setq key (elt (read-key-sequence nil) 0)) - (use-global-map global-map) - key)) - - -;; Emacs has a bug in eventp, which causes (eventp nil) to return (nil) -;; instead of nil, if '(nil) was previously inadvertently assigned to -;; unread-command-events -(defun vip-event-key (event) - (or (and event (eventp event)) - (error "vip-event-key: Wrong type argument, eventp, %S" event)) - (let ((mod (event-modifiers event)) - basis) - (setq basis - (cond - (vip-xemacs-p - (cond ((key-press-event-p event) - (event-key event)) - ((button-event-p event) - (concat "mouse-" (prin1-to-string (event-button event)))) - (t - (error "vip-event-key: Unknown event, %S" event)))) - (t - ;; Emacs doesn't handle capital letters correctly, since - ;; \S-a isn't considered the same as A (it behaves as - ;; plain `a' instead). So we take care of this here - (cond ((and (vip-characterp event) (<= ?A event) (<= event ?Z)) - (setq mod nil - event event)) - ;; Emacs has the oddity whereby characters 128+char - ;; represent M-char *if* this appears inside a string. - ;; So, we convert them manually to (meta char). - ((and (vip-characterp event) (< ?\C-? event) (<= event 255)) - (setq mod '(meta) - event (- event ?\C-? 1))) - (t (event-basic-type event))) - ))) - (if (vip-characterp basis) - (setq basis - (if (= basis ?\C-?) - (list 'control '\?) ; taking care of an emacs bug - (intern (char-to-string basis))))) - (if mod - (append mod (list basis)) - basis))) - -(defun vip-key-to-emacs-key (key) - (let (key-name char-p modifiers mod-char-list base-key base-key-name) - (cond (vip-xemacs-p key) - ((symbolp key) - (setq key-name (symbol-name key)) - (if (= (length key-name) 1) ; character event - (string-to-char key-name) - key)) - ((listp key) - (setq modifiers (subseq key 0 (1- (length key))) - base-key (vip-seq-last-elt key) - base-key-name (symbol-name base-key) - char-p (= (length base-key-name) 1)) - (setq mod-char-list - (mapcar - '(lambda (elt) (upcase (substring (symbol-name elt) 0 1))) - modifiers)) - (if char-p - (setq key-name - (car (read-from-string - (concat - "?\\" - (mapconcat 'identity mod-char-list "-\\") - "-" - base-key-name)))) - (setq key-name - (intern - (concat - (mapconcat 'identity mod-char-list "-") - "-" - base-key-name)))))) - )) - - -;; Args can be a sequence of events, a string, or a Viper macro. Will try to -;; convert events to keys and, if all keys are regular printable -;; characters, will return a string. Otherwise, will return a string -;; representing a vector of converted events. If the input was a Viper macro, -;; will return a string that represents this macro as a vector. -(defun vip-array-to-string (event-seq) - (let (temp temp2) - (cond ((stringp event-seq) event-seq) - ((vip-event-vector-p event-seq) - (setq temp (mapcar 'vip-event-key event-seq)) - (cond ((vip-char-symbol-sequence-p temp) - (mapconcat 'symbol-name temp "")) - ((and (vip-char-array-p - (setq temp2 (mapcar 'vip-key-to-character temp)))) - (mapconcat 'char-to-string temp2 "")) - (t (prin1-to-string (vconcat temp))))) - ((vip-char-symbol-sequence-p event-seq) - (mapconcat 'symbol-name event-seq "")) - ((and (vectorp event-seq) - (vip-char-array-p - (setq temp (mapcar 'vip-key-to-character event-seq)))) - (mapconcat 'char-to-string temp "")) - (t (prin1-to-string event-seq))))) - -(defun vip-key-press-events-to-chars (events) - (mapconcat (if vip-emacs-p - 'char-to-string - (function - (lambda (elt) (char-to-string (event-to-character elt))))) - events - "")) - - -(defsubst vip-fast-keysequence-p () - (not (vip-sit-for-short vip-fast-keyseq-timeout t))) - -(defun vip-read-char-exclusive () - (let (char - (echo-keystrokes 1)) - (while (null char) - (condition-case nil - (setq char (read-char)) - (error - ;; skip event if not char - (vip-read-event)))) - char)) - -;; key is supposed to be in viper's representation, e.g., (control l), a -;; character, etc. -(defun vip-key-to-character (key) - (cond ((eq key 'space) ?\ ) - ((eq key 'delete) ?\C-?) - ((eq key 'backspace) ?\C-h) - ((and (symbolp key) - (= 1 (length (symbol-name key)))) - (string-to-char (symbol-name key))) - ((and (listp key) - (eq (car key) 'control) - (symbol-name (nth 1 key)) - (= 1 (length (symbol-name (nth 1 key))))) - (read (format "?\\C-%s" (symbol-name (nth 1 key))))) - (t key))) - - -(defun vip-setup-master-buffer (&rest other-files-or-buffers) - "Set up the current buffer as a master buffer. -Arguments become related buffers. This function should normally be used in -the `Local variables' section of a file." - (setq vip-related-files-and-buffers-ring - (make-ring (1+ (length other-files-or-buffers)))) - (mapcar '(lambda (elt) - (vip-ring-insert vip-related-files-and-buffers-ring elt)) - other-files-or-buffers) - (vip-ring-insert vip-related-files-and-buffers-ring (buffer-name)) - ) - -;;; Movement utilities - -(defvar vip-syntax-preference 'strict-vi - "*Syntax type characterizing Viper's alphanumeric symbols. -`emacs' means only word constituents are considered to be alphanumeric. -Word constituents are symbols specified as word constituents by the current -syntax table. -`extended' means word and symbol constituents. -`reformed-vi' means Vi-ish behavior: word constituents and the symbol `_'. -However, word constituents are determined according to Emacs syntax tables, -which may be different from Vi in some major modes. -`strict-vi' means Viper words are exactly as in Vi.") - -(vip-deflocalvar vip-ALPHA-char-class "w" - "String of syntax classes characterizing Viper's alphanumeric symbols. -In addition, the symbol `_' may be considered alphanumeric if -`vip-syntax-preference'is `reformed-vi'.") - -(vip-deflocalvar vip-strict-ALPHA-chars "a-zA-Z0-9_" - "Regexp matching the set of alphanumeric characters acceptable to strict -Vi.") -(vip-deflocalvar vip-strict-SEP-chars " \t\n" - "Regexp matching the set of alphanumeric characters acceptable to strict -Vi.") - -(vip-deflocalvar vip-SEP-char-class " -" - "String of syntax classes for Vi separators. -Usually contains ` ', linefeed, TAB or formfeed.") - -(defun vip-update-alphanumeric-class () - "Set the syntax class of Viper alphanumerals according to `vip-syntax-preference'. -Must be called in order for changes to `vip-syntax-preference' to take effect." - (interactive) - (setq-default - vip-ALPHA-char-class - (cond ((eq vip-syntax-preference 'emacs) "w") ; only word constituents - ((eq vip-syntax-preference 'extended) "w_") ; word & symbol chars - (t "w")))) ; vi syntax: word constituents and the symbol `_' - -;; addl-chars are characters to be temporarily considered as alphanumerical -(defun vip-looking-at-alpha (&optional addl-chars) - (or (stringp addl-chars) (setq addl-chars "")) - (if (eq vip-syntax-preference 'reformed-vi) - (setq addl-chars (concat addl-chars "_"))) - (let ((char (char-after (point)))) - (if char - (if (eq vip-syntax-preference 'strict-vi) - (looking-at (concat "[" vip-strict-ALPHA-chars addl-chars "]")) - (or (memq char - ;; convert string to list - (append (vconcat addl-chars) nil)) - (memq (char-syntax char) - (append (vconcat vip-ALPHA-char-class) nil))))) - )) - -(defsubst vip-looking-at-separator () - (let ((char (char-after (point)))) - (if char - (or (eq char ?\n) ; RET is always a separator in Vi - (memq (char-syntax char) - (append (vconcat vip-SEP-char-class) nil)))))) - -(defsubst vip-looking-at-alphasep (&optional addl-chars) - (or (vip-looking-at-separator) (vip-looking-at-alpha addl-chars))) - -(defsubst vip-skip-alpha-forward (&optional addl-chars) - (or (stringp addl-chars) (setq addl-chars "")) - (vip-skip-syntax - 'forward - (cond ((eq vip-syntax-preference 'strict-vi) - "") - (t vip-ALPHA-char-class )) - (cond ((eq vip-syntax-preference 'strict-vi) - (concat vip-strict-ALPHA-chars addl-chars)) - (t addl-chars)))) - -(defsubst vip-skip-alpha-backward (&optional addl-chars) - (or (stringp addl-chars) (setq addl-chars "")) - (vip-skip-syntax - 'backward - (cond ((eq vip-syntax-preference 'strict-vi) - "") - (t vip-ALPHA-char-class )) - (cond ((eq vip-syntax-preference 'strict-vi) - (concat vip-strict-ALPHA-chars addl-chars)) - (t addl-chars)))) - -;; weird syntax tables may confuse strict-vi style -(defsubst vip-skip-all-separators-forward (&optional within-line) - (vip-skip-syntax 'forward - vip-SEP-char-class - (or within-line "\n") - (if within-line (vip-line-pos 'end)))) -(defsubst vip-skip-all-separators-backward (&optional within-line) - (vip-skip-syntax 'backward - vip-SEP-char-class - (or within-line "\n") - (if within-line (vip-line-pos 'start)))) -(defun vip-skip-nonseparators (direction) - (let ((func (intern (format "skip-syntax-%S" direction)))) - (funcall func (concat "^" vip-SEP-char-class) - (vip-line-pos (if (eq direction 'forward) 'end 'start))))) - -(defsubst vip-skip-nonalphasep-forward () - (if (eq vip-syntax-preference 'strict-vi) - (skip-chars-forward - (concat "^" vip-strict-SEP-chars vip-strict-ALPHA-chars)) - (skip-syntax-forward - (concat - "^" vip-ALPHA-char-class vip-SEP-char-class) (vip-line-pos 'end)))) -(defsubst vip-skip-nonalphasep-backward () - (if (eq vip-syntax-preference 'strict-vi) - (skip-chars-backward - (concat "^" vip-strict-SEP-chars vip-strict-ALPHA-chars)) - (skip-syntax-backward - (concat - "^" vip-ALPHA-char-class vip-SEP-char-class) (vip-line-pos 'start)))) - -;; Skip SYNTAX like skip-syntax-* and ADDL-CHARS like skip-chars-* -;; Return the number of chars traveled. -;; Either SYNTAX or ADDL-CHARS can be nil, in which case they are interpreted -;; as an empty string. -(defun vip-skip-syntax (direction syntax addl-chars &optional limit) - (let ((total 0) - (local 1) - (skip-chars-func (intern (format "skip-chars-%S" direction))) - (skip-syntax-func (intern (format "skip-syntax-%S" direction)))) - (or (stringp addl-chars) (setq addl-chars "")) - (or (stringp syntax) (setq syntax "")) - (while (and (not (= local 0)) (not (eobp))) - (setq local - (+ (funcall skip-syntax-func syntax limit) - (funcall skip-chars-func addl-chars limit))) - (setq total (+ total local))) - total - )) - - - - -(provide 'viper-util) - -;;; viper-util.el ends here diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el deleted file mode 100644 index 592f15021ac..00000000000 --- a/lisp/emulation/viper.el +++ /dev/null @@ -1,5892 +0,0 @@ -;;; viper.el --- A full-featured Vi emulator for GNU Emacs 19 and XEmacs 19, -;; a VI Plan for Emacs Rescue, -;; and a venomous VI PERil. -;; Viper Is also a Package for Emacs Rebels. -;; -;; Keywords: emulations -;; Author: Michael Kifer <kifer@cs.sunysb.edu> - -;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. - -(defconst viper-version "2.91 of August 5, 1996" - "The current version of Viper") - -;; This file is part of GNU Emacs. - -;; 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 -;; the Free Software Foundation; either version 2, 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 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; Viper is a full-featured Vi emulator for Emacs 19. It emulates and -;; improves upon the standard features of Vi and, at the same time, allows -;; full access to all Emacs facilities. Viper supports multiple undo, -;; file name completion, command, file, and search history and it extends -;; Vi in many other ways. Viper is highly customizable through the various -;; hooks, user variables, and keymaps. It is implemented as a collection -;; of minor modes and it is designed to provide full access to all Emacs -;; major and minor modes. -;; -;;; History -;; -;; Viper is a new name for a package formerly known as VIP-19, -;; which was a successor of VIP version 3.5 by Masahiko Sato -;; <ms@sail.stanford.edu> and VIP version 4.2 by Aamod Sane -;; <sane@cs.uiuc.edu>. Some ideas from vip 4.4.2 by Aamod Sane -;; were also shamelessly plagiarized. -;; -;; Viper maintains some degree of compatibility with these older -;; packages. See the documentation for customization. -;; -;; The main difference between Viper and these older packages are: -;; -;; 1. Viper emulates Vi at several levels, from almost complete conformity -;; to a rather loose Vi-compliance. -;; -;; 2. Viper provides full access to all major and minor modes of Emacs -;; without the need to type extra keys. -;; The older versions of VIP (and other Vi emulators) do not work with -;; some major and minor modes. -;; -;; 3. Viper supports vi-style undo. -;; -;; 4. Viper fully emulates (and improves upon) vi's replacement mode. -;; -;; 5. Viper has a better interface to ex, including command, variable, and -;; file name completion. -;; -;; 6. Viper uses native Emacs history and completion features; it doesn't -;; rely on other packages (such as gmhist.el and completer.el) to provide -;; these features. -;; -;; 7. Viper supports Vi-style editing in the minibuffer, by allowing the -;; user to switch from Insert state to Vi state to Replace state, etc. -;; -;; 8. Viper keeps history of recently inserted pieces of text and recently -;; executed Vi-style destructive commands, such as `i', `d', etc. -;; These pieces of text can be inserted in later insertion commands; -;; the previous destructive commands can be re-executed. -;; -;; 9. Viper has Vi-style keyboard macros, which enhances the similar -;; facility in the original Vi. -;; First, one can execute any Emacs command while defining a -;; macro, not just the Vi commands. Second, macros are defined in a -;; WYSYWYG mode, using an interface to Emacs' WYSIWYG style of defining -;; macros. Third, in Viper, one can define macros that are specific to -;; a given buffer, a given major mode, or macros defined for all buffers. -;; The same macro name can have several different definitions: -;; one global, several definitions for various major modes, and -;; definitions for specific buffers. -;; Buffer-specific definitions override mode-specific -;; definitions, which, in turn, override global definitions. -;; -;; -;;; Installation: -;; ------------- -;; -;; (require 'viper) -;; - -;;; Acknowledgements: -;; ----------------- -;; Bug reports and ideas contributed by many users have helped -;; improve Viper and the various versions of VIP. -;; See the on-line manual for a complete list of contributors. -;; -;; -;;; Notes: -;; -;; 1. Major modes. -;; In most cases, Viper handles major modes correctly, i.e., they come up -;; in the right state (either vi-state or emacs-state). For instance, text -;; files come up in vi-state, while, say, Dired appears in emacs-state by -;; default. -;; However, some modes do not appear in the right mode in the beginning, -;; usually because they neglect to follow Emacs conventions (e.g., they don't -;; use kill-all-local-variables when they start). Some major modes -;; may fail to come up in emacs-state if they call hooks, such as -;; text-hook, for no good reason. -;; -;; As an immediate solution, you can hit C-z to bring about the right mode. -;; An interim solution is to add an appropriate hook to the mode like this: -;; -;; (add-hook 'your-favorite-mode 'viper-mode) -;; or -;; (add-hook 'your-favorite-mode 'vip-change-state-to-emacs) -;; -;; whichever applies. The right thing to do, however, is to complain to the -;; author of the respective package. (Sometimes they also neglect to equip -;; their modes with hooks, which is one more reason for complaining.) -;; -;; 2. Keymap handling -;; Because Emacs 19 has an elegant mechanism for turning minor mode keymaps -;; on and off, implementation of Viper has been greatly simplified. Viper -;; has several minor modes. -;; -;; Viper's Vi state consists of seven minor modes: -;; -;; vip-vi-intercept-minor-mode -;; vip-vi-local-user-minor-mode -;; vip-vi-global-user-minor-mode -;; vip-vi-kbd-minor-mode -;; vip-vi-state-modifier-minor-mode -;; vip-vi-diehard-minor-mode -;; vip-vi-basic-minor-mode -;; -;; Bindings done to the keymap of the first mode overshadow those done to -;; the second, which, in turn, overshadows those done to the third, etc. -;; -;; The last vip-vi-basic-minor-mode contains most of the usual Vi bindings -;; in its edit mode. This mode provides access to all Emacs facilities. -;; Novice users, however, may want to set their vip-expert-level to 1 -;; in their .vip file. This will enable vip-vi-diehard-minor-mode. This -;; minor mode's bindings make Viper simulate the usual Vi very closely. -;; For instance, C-c will not have its standard Emacs binding -;; and so many of the goodies of Emacs are not available. -;; -;; A skilled user should set vip-expert-level to at least 3. This will -;; enable `C-c' and many Emacs facilities will become available. -;; In this case, vip-vi-diehard-minor-mode is inactive. -;; -;; Viper gurus should have at least -;; (setq vip-expert-level 4) -;; in their ~/.vip files. This will unsuppress all Emacs keys that are not -;; essential for VI-style editing. -;; Pick-and-choose users may want to put -;; (setq vip-expert-level 5) -;; in ~/.vip. Viper will then leave it up to the user to set the variables -;; vip-want-* See vip-set-expert-level for details. -;; -;; The very first minor mode, vip-vi-intercept-minor-mode, is of no -;; concern for the user. It is needed to bind Viper's vital keys, such as -;; ESC and C-z. -;; -;; The second mode, vip-vi-local-user-minor-mode, usually has an -;; empty keymap. However, the user can set bindings in this keymap, which -;; will overshadow the corresponding bindings in the other two minor -;; modes. This is useful, for example, for setting up ZZ in gnus, -;; rmail, mh-e, etc., to send message instead of saving it in a file. -;; Likewise, in Dired mode, you may want to bind ZN and ZP to commands -;; that would visit the next or the previous file in the Dired buffer. -;; Setting local keys is tricky, so don't do it directly. Instead, use -;; vip-add-local-keys function (see its doc). -;; -;; The third minor mode, vip-vi-global-user-minor-mode, is also intended -;; for the users but, unlike vip-vi-local-user-minor-mode, its key -;; bindings are seen in all Viper buffers. This mode keys can be done -;; with define-key command. -;; -;; The fourth minor mode, vip-vi-kbd-minor-mode, is used by keyboard -;; macros. Users are NOT supposed to modify this keymap directly. -;; -;; The fifth mode, vip-vi-state-modifier-minor-mode, can be used to set -;; key bindings that are visible in some major modes but not in others. -;; -;; Users are allowed to modify keymaps that belong to -;; vip-vi-local-user-minor-mode, vip-vi-global-user-minor-mode, -;; and vip-vi-state-modifier-minor-mode only. -;; -;; Viper's Insert state also has seven minor modes: -;; -;; vip-insert-intercept-minor-mode -;; vip-insert-local-user-minor-mode -;; vip-insert-global-user-minor-mode -;; vip-insert-kbd-minor-mode -;; vip-insert-state-modifier-minor-mode -;; vip-insert-diehard-minor-mode -;; vip-insert-basic-minor-mode -;; -;; As with VI's editing modes, the first mode, vip-insert-intercept-minor-mode -;; is used to bind vital keys that are not to be changed by the user. -;; -;; The next mode, vip-insert-local-user-minor-mode, is used to customize -;; bindings in the insert state of Viper. The third mode, -;; vip-insert-global-user-minor-mode is like -;; vip-insert-local-user-minor-mode, except that its bindings are seen in -;; all Viper buffers. As with vip-vi-local-user-minor-mode, its bindings -;; should be done via the function vip-add-local-keys. Bindings for -;; vip-insert-global-user-minor-mode can be set with the define-key command. -;; -;; The next minor mode, vip-insert-kbd-minor-mode, -;; is used for keyboard VI-style macros defined with :map!. -;; -;; The fifth minor mode, vip-insert-state-modifier-minor-mode, is like -;; vip-vi-state-modifier-minor-mode, except that it is used in the Insert -;; state; it can be used to modify keys in a mode-specific fashion. -;; -;; The minor mode vip-insert-diehard-minor-mode is in effect when -;; the user wants a high degree of Vi compatibility (a bad idea, really!). -;; The last minor mode, vip-insert-basic-minor-mode, is always in effect -;; when Viper is in insert state. It binds a small number of keys needed for -;; Viper's operation. -;; -;; Finally, Viper provides minor modes for overriding bindings set by Emacs -;; modes when Viper is in Emacs state: -;; -;; vip-emacs-local-user-minor-mode -;; vip-emacs-global-user-minor-mode -;; vip-emacs-kbd-minor-mode -;; vip-emacs-state-modifier-minor-mode -;; -;; These minor modes are in effect when Viper is in Emacs state. The keymap -;; associated with vip-emacs-global-user-minor-mode, -;; vip-emacs-global-user-map, overrides the global and local keymaps as -;; well as the minor mode keymaps set by other modes. The keymap of -;; vip-emacs-local-user-minor-mode, vip-emacs-local-user-map, overrides -;; everything, but it is used on a per buffer basis. -;; The keymap associated with vip-emacs-state-modifier-minor-mode -;; overrides keys on a per-major-mode basis. The mode -;; vip-emacs-kbd-minor-mode is used to define Vi-style macros in Emacs -;; state. -;; -;; 3. There is also one minor mode that is used when Viper is in its -;; replace-state (used for commands like cw, C, etc.). This mode is -;; called -;; -;; vip-replace-minor-mode -;; -;; and its keymap is vip-replace-map. Replace minor mode is always -;; used in conjunction with the minor modes for insert-state, and its -;; keymap overshadows the keymaps for insert minor modes. -;; -;; 4. Defining buffer-local bindings in Vi and Insert modes. -;; As mentioned before, sometimes, it is convenient to have -;; buffer-specific of mode-specific key bindings in Vi and insert modes. -;; Viper provides a special function, vip-add-local-keys, to do precisely -;; this. For instance, is you need to add couple of mode-specific bindings -;; to Insert mode, you can put -;; -;; (vip-add-local-keys 'insert-state '((key1 . func1) (key2 .func2))) -;; -;; somewhere in a hook of this major mode. If you put something like this -;; in your own elisp function, this will define bindings specific to the -;; buffer that was current at the time of the call to vip-add-local-keys. -;; The only thing to make sure here is that the major mode of this buffer -;; is written according to Emacs conventions, which includes a call to -;; (kill-all-local-variables). See vip-add-local-keys for more details. -;; -;; -;; TO DO (volunteers?): -;; -;; 1. Some of the code that is inherited from VIP-3.5 is rather -;; convoluted. Instead of vip-command-argument, keymaps should bind the -;; actual commands. E.g., "dw" should be bound to a generic command -;; vip-delete that will delete things based on the value of -;; last-command-char. This would greatly simplify the logic and the code. -;; -;; 2. Somebody should venture to write a customization package a la -;; options.el that would allow the user to change values of variables -;; that meet certain specs (e.g., match a regexp) and whose doc string -;; starts with a '*'. Then, the user should be offered to save -;; variables that were changed. This will make user's customization job -;; much easier. -;; - -;; Code - -(require 'advice) -(require 'cl) -(require 'ring) - -(require 'viper-util) - -;; Compiler pacifier -(defvar vip-minibuffer-current-face) -(defvar vip-minibuffer-insert-face) -(defvar vip-minibuffer-vi-face) -(defvar vip-minibuffer-emacs-face) -(defvar iso-accents-mode) -(defvar zmacs-region-stays) -;; end pacifier - - -;;; Variables - -;; Is t until viper-mode executes for the very first time. -;; Prevents recursive descend into startup messages. -(defvar vip-first-time t) - -(defvar vip-expert-level 0 - "User's expert level. -The minor mode vip-vi-diehard-minor-mode is in effect when -vip-expert-level is 1 or 2 or when vip-want-emacs-keys-in-vi is t. -The minor mode vip-insert-diehard-minor-mode is in effect when -vip-expert-level is 1 or 2 or if vip-want-emacs-keys-in-insert is t. -Use `M-x vip-set-expert-level' to change this.") - -;; Max expert level supported by Viper. This is NOT a user option. -;; It is here to make it hard for the user from resetting it. -(defconst vip-max-expert-level 5) - -;; Contains user settings for vars affected by vip-set-expert-level function. -;; Not a user option. -(defvar vip-saved-user-settings nil) - - -;;; Viper minor modes - -;; This is not local in Emacs, so we make it local. -;; This must be local because although the stack of minor modes can be the same -;; for all buffers, the associated *keymaps* can be different. In Viper, -;; vip-vi-local-user-map, vip-insert-local-user-map, and others can have -;; different keymaps for different buffers. -;; Also, the keymaps associated with vip-vi/insert-state-modifier-minor-mode -;; can be different. -(make-variable-buffer-local 'minor-mode-map-alist) - -;; Mode for vital things like \e, C-z. -(vip-deflocalvar vip-vi-intercept-minor-mode nil) - -(vip-deflocalvar vip-vi-basic-minor-mode nil - "Viper's minor mode for Vi bindings.") - -(vip-deflocalvar vip-vi-local-user-minor-mode nil - "Auxiliary minor mode for user-defined local bindings in Vi state.") - -(vip-deflocalvar vip-vi-global-user-minor-mode nil - "Auxiliary minor mode for user-defined global bindings in Vi state.") - -(vip-deflocalvar vip-vi-state-modifier-minor-mode nil - "Minor mode used to make major-mode-specific modification to Vi state.") - -(vip-deflocalvar vip-vi-diehard-minor-mode nil - "This minor mode is in effect when the user wants Viper to be Vi.") - -(vip-deflocalvar vip-vi-kbd-minor-mode nil - "Minor mode for Ex command macros in Vi state. -The corresponding keymap stores key bindings of Vi macros defined with -the Ex command :map.") - -;; Mode for vital things like \e, C-z. -(vip-deflocalvar vip-insert-intercept-minor-mode nil) - -(vip-deflocalvar vip-insert-basic-minor-mode nil - "Viper's minor mode for bindings in Insert mode.") - -(vip-deflocalvar vip-insert-local-user-minor-mode nil - "Auxiliary minor mode for buffer-local user-defined bindings in Insert state. -This is a way to overshadow normal Insert mode bindings locally to certain -designated buffers.") - -(vip-deflocalvar vip-insert-global-user-minor-mode nil - "Auxiliary minor mode for global user-defined bindings in Insert state.") - -(vip-deflocalvar vip-insert-state-modifier-minor-mode nil - "Minor mode used to make major-mode-specific modification to Insert state.") - -(vip-deflocalvar vip-insert-diehard-minor-mode nil - "Minor mode that simulates Vi very closely. -Not recommened, except for the novice user.") - -(vip-deflocalvar vip-insert-kbd-minor-mode nil -"Minor mode for Ex command macros Insert state. -The corresponding keymap stores key bindings of Vi macros defined with -the Ex command :map!.") - -(vip-deflocalvar vip-replace-minor-mode nil - "Minor mode in effect in replace state (cw, C, and the like commands).") - -;; Mode for vital things like \C-z and \C-x) -;; This is t, by default. So, any new buffer will have C-z defined as -;; switch to Vi, unless we switched states in this buffer -(vip-deflocalvar vip-emacs-intercept-minor-mode t) - -(vip-deflocalvar vip-emacs-local-user-minor-mode t - "Minor mode for local user bindings effective in Emacs state. -Users can use it to override Emacs bindings when Viper is in its Emacs -state.") - -(vip-deflocalvar vip-emacs-global-user-minor-mode t - "Minor mode for global user bindings in effect in Emacs state. -Users can use it to override Emacs bindings when Viper is in its Emacs -state.") - -(vip-deflocalvar vip-emacs-kbd-minor-mode t - "Minor mode for Vi style macros in Emacs state. -The corresponding keymap stores key bindings of Vi macros defined with -`vip-record-kbd-macro' command. There is no Ex-level command to do this -interactively.") - -(vip-deflocalvar vip-emacs-state-modifier-minor-mode t - "Minor mode used to make major-mode-specific modification to Emacs state. -For instance, a Vi purist may want to bind `dd' in Dired mode to a function -that deletes a file.") - - - -;;; ISO characters - -(vip-deflocalvar vip-automatic-iso-accents nil - "*If non-nil, ISO accents will be turned on in insert/replace emacs states and turned off in vi-state. -For some users, this behavior may be too primitive. In this case, use -insert/emacs/vi state hooks.") - - -;;; 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.") - - - -;; VI-style Undo - -;; Used to 'undo' complex commands, such as replace and insert commands. -(vip-deflocalvar vip-undo-needs-adjustment nil) -(put 'vip-undo-needs-adjustment 'permanent-local t) - -;; A mark that Viper puts on buffer-undo-list. Marks the beginning of a -;; complex command that must be undone atomically. If inserted, it is -;; erased by vip-change-state-to-vi and vip-repeat. -(defconst vip-buffer-undo-list-mark 'viper) - -(defvar vip-keep-point-on-undo nil - "*Non-nil means not to move point while undoing commands. -This style is different from Emacs and Vi. Try it to see if -it better fits your working style.") - -;; Replace mode and changing text - -;; Viper's own after/before change functions, which get vip-add-hook'ed to -;; Emacs's -(vip-deflocalvar vip-after-change-functions nil "") -(vip-deflocalvar vip-before-change-functions nil "") -(vip-deflocalvar vip-post-command-hooks nil "") -(vip-deflocalvar vip-pre-command-hooks nil "") - -;; Can be used to pass global states around for short period of time -(vip-deflocalvar vip-intermediate-command nil "") - -;; Indicates that the current destructive command has started in replace mode. -(vip-deflocalvar vip-began-as-replace nil "") - -(defvar vip-replace-overlay-cursor-color "Red" - "*Cursor color to use in Replace state") -(defvar vip-insert-state-cursor-color nil - "Cursor color for Viper insert state.") -(put 'vip-insert-state-cursor-color 'permanent-local t) -;; place to save cursor colow when switching to insert mode -(vip-deflocalvar vip-saved-cursor-color nil "") - -(vip-deflocalvar vip-replace-overlay nil "") -(put 'vip-replace-overlay 'permanent-local t) - -(defvar vip-replace-overlay-pixmap "gray3" - "Pixmap to use for search face on non-color displays.") -(defvar vip-search-face-pixmap "gray3" - "Pixmap to use for search face on non-color displays.") - - -(defun vip-set-replace-overlay-face () - (if (vip-has-face-support-p) - (defvar vip-replace-overlay-face - (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-replace-region-end-delimiter "$" - "A string marking the end of replacement regions. -It is used only with TTYs or if `vip-use-replace-region-delimiters' -is non-nil.") -(defvar vip-replace-region-start-delimiter "" - "A string marking the beginning of replacement regions. -It is used only with TTYs or if `vip-use-replace-region-delimiters' -is non-nil.") -(defvar vip-use-replace-region-delimiters (not (vip-has-face-support-p)) - "*If non-nil, Viper will always use `vip-replace-region-end-delimiter' and -`vip-replace-region-start-delimiter' to delimit replacement regions, even on -color displays. By default, the delimiters are used only on TTYs.") - -;; XEmacs requires glyphs -(if vip-xemacs-p - (progn - (or (glyphp vip-replace-region-end-delimiter) - (setq vip-replace-region-end-delimiter - (make-glyph vip-replace-region-end-delimiter))) - (or (glyphp vip-replace-region-start-delimiter) - (setq vip-replace-region-start-delimiter - (make-glyph vip-replace-region-start-delimiter))) - )) - - -;; These are local marker that must be initialized to nil and moved with -;; `vip-move-marker-locally' -;; -;; Remember the last position inside the replace region. -(vip-deflocalvar vip-last-posn-in-replace-region nil) -;; Remember the last position while inserting -(vip-deflocalvar vip-last-posn-while-in-insert-state nil) -(put 'vip-last-posn-in-replace-region 'permanent-local t) -(put 'vip-last-posn-while-in-insert-state 'permanent-local t) - -(vip-deflocalvar vip-sitting-in-replace nil "") -(put 'vip-sitting-in-replace 'permanent-local t) - -;; Remember the number of characters that have to be deleted in replace -;; mode to compensate for the inserted characters. -(vip-deflocalvar vip-replace-chars-to-delete 0 "") -(vip-deflocalvar vip-replace-chars-deleted 0 "") - -;; Insertion ring and command ring -(defvar vip-insertion-ring-size 14 - "The size of the insertion ring.") -;; The insertion ring. -(defvar vip-insertion-ring nil) -;; This is temp insertion ring. Used to do rotation for display purposes. -;; When rotation just started, it is initialized to vip-insertion-ring. -(defvar vip-temp-insertion-ring nil) -(defvar vip-last-inserted-string-from-insertion-ring "") - -(defvar vip-command-ring-size 14 - "The size of the command ring.") -;; The command ring. -(defvar vip-command-ring nil) -;; This is temp command ring. Used to do rotation for display purposes. -;; When rotation just started, it is initialized to vip-command-ring. -(defvar vip-temp-command-ring nil) - -;; Modes and related variables - -;; Current mode. One of: `emacs-state', `vi-state', `insert-state' -(vip-deflocalvar vip-current-state 'emacs-state) - -(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.") - -;; Autoindent in insert - -;; Variable that keeps track of whether C-t has been pressed. -(vip-deflocalvar vip-cted nil "") - -;; Preserve the indent value, used by C-d in insert mode. -(vip-deflocalvar vip-current-indent 0) - -;; Whether to preserve the indent, used by C-d in insert mode. -(vip-deflocalvar vip-preserve-indent nil) - -(vip-deflocalvar vip-auto-indent nil - "*Autoindent if t.") -(vip-deflocalvar vip-electric-mode t - "*If t, enable electric behavior. -Currently only enables auto-indentation `according to mode'.") - -(defconst vip-shift-width 8 - "*The shiftwidth variable.") - -;; Variables for repeating destructive commands - -(defconst vip-keep-point-on-repeat t - "*If t, don't move point when repeating previous command. -This is useful for doing repeated changes with the '.' key. -The user can change this to nil, if she likes when the cursor moves -to a new place after repeating previous Vi command.") - -;; Remember insert point as a marker. This is a local marker that must be -;; initialized to nil and moved with `vip-move-marker-locally'. -(vip-deflocalvar vip-insert-point nil) -(put 'vip-insert-point 'permanent-local t) - -;; This remembers the point before dabbrev-expand was called. -;; If vip-insert-point turns out to be bigger than that, it is reset -;; back to vip-pre-command-point. -;; The reason this is needed is because dabbrev-expand (and possibly -;; others) may jump to before the insertion point, delete something and -;; then reinsert a bigger piece. For instance: bla^blo -;; If dabbrev-expand is called after `blo' and ^ undicates vip-insert-point, -;; then point jumps to the beginning of `blo'. If expansion is found, `blablo' -;; is deleted, and we have |^, where | denotes point. Next, dabbrev-expand -;; will insert the expansion, and we get: blablo^ -;; Whatever we insert next goes before the ^, i.e., before the -;; vip-insert-point marker. So, Viper will think that nothing was -;; inserted. Remembering the orig position of the marker circumvents the -;; problem. -;; We don't know of any command, except dabbrev-expand, that has the same -;; problem. However, the same trick can be used if such a command is -;; discovered later. -;; -(vip-deflocalvar vip-pre-command-point nil) -(put 'vip-pre-command-point 'permanent-local t) ; this is probably an overkill - -;; This is used for saving inserted text. -(defvar vip-last-insertion nil) - -;; Remembers the last replaced region. -(defvar vip-last-replace-region "") - -;; Remember com point as a marker. -;; This is a local marker. Should be moved with `vip-move-marker-locally' -(vip-deflocalvar vip-com-point nil) - -;; If non-nil, the value is a list (M-COM VAL COM REG inserted-text cmd-keys) -;; It is used to re-execute last destructive command. -;; M-COM is a Lisp symbol representing the function to be executed. -;; VAL is the prefix argument that was used with that command. -;; COM is an internal descriptor, such as ?r, ?c, ?C, which contains -;; additional information on how the function in M-COM is to be handled. -;; REG is the register used by command -;; INSERTED-TEXT is text inserted by that command (in case of o, c, C, i, r -;; commands). -;; COMMAND-KEYS are the keys that were typed to invoke the command. -(defvar vip-d-com nil) - -;; The character remembered by the Vi `r' command. -(defvar vip-d-char nil) - -;; Name of register to store deleted or yanked strings -(defvar vip-use-register nil) - - - -;; Variables for Moves and Searches - -;; For use by `;' command. -(defvar vip-f-char nil) - -;; For use by `.' command. -(defvar vip-F-char nil) - -;; For use by `;' command. -(defvar vip-f-forward nil) - -;; For use by `;' command. -(defvar vip-f-offset nil) - -;; Last search string -(defvar vip-s-string "") - -(defvar vip-quote-string "> " - "String inserted at the beginning of quoted region.") - -;; If t, search is forward. -(defvar vip-s-forward nil) - -(defconst vip-case-fold-search nil - "*If not nil, search ignores cases.") - -(defconst vip-re-search t - "*If not nil, search is reg-exp search, otherwise vanilla search.") - -(defvar vip-adjust-window-after-search t - "*If not nil, pull the window up or down, depending on the direction of the -search, if search ends up near the bottom or near the top of the window.") - -(defconst vip-re-query-replace t - "*If t then do regexp replace, if nil then do string replace.") - -(defconst vip-re-replace t - "*If t, do regexp replace. nil means do string replace.") - -(vip-deflocalvar vip-ex-style-motion t - "*Ex-style: the commands l,h do not cross lines, etc.") - -(vip-deflocalvar vip-ex-style-editing-in-insert t - "*The keys ^H, ^? don't jump lines in insert, ESC moves cursor back, etc. -Note: this doesn't preclude ^H and ^? from deleting characters by moving -past the insertion point. This is a feature, not a bug. ") - -(vip-deflocalvar vip-delete-backwards-in-replace nil - "*If t, DEL key will delete characters while moving the cursor backwards. -If nil, the cursor will move backwards without deleting anything.") - -(defconst vip-buffer-search-char nil - "*Key bound for buffer-searching.") - -(defconst vip-search-wrap-around-t t - "*If t, search wraps around.") - -(vip-deflocalvar vip-related-files-and-buffers-ring nil - "*Ring of file and buffer names that are considered to be related to the -current buffer. -These buffers can be cycled through via :R and :P commands.") -(put 'vip-related-files-and-buffers-ring 'permanent-local t) - -;; Used to find out if we are done with searching the current buffer. -(vip-deflocalvar vip-local-search-start-marker nil) -;; As above, but global -(defvar vip-search-start-marker (make-marker)) - -;; the search overlay -(vip-deflocalvar vip-search-overlay nil) - - -(defvar vip-heading-start - (concat "^\\s-*(\\s-*defun\\s-\\|" ; lisp - "^{\\s-*$\\|^[_a-zA-Z][^()]*[()].*{\\s-*$\\|" ; C/C++ - "^\\s-*class.*{\\|^\\s-*struct.*{\\|^\\s-*enum.*{\\|" - "^\\\\[sb][a-z]*{.*}\\s-*$\\|" ; latex - "^@node\\|@table\\|^@m?enu\\|^@itemize\\|^@if\\|" ; texinfo - "^.+:-") ; prolog - "*Regexps for Headings. Used by \[\[ and \]\].") - -(defvar vip-heading-end - (concat "^}\\|" ; C/C++ - "^\\\\end{\\|" ; latex - "^@end \\|" ; texinfo - ")\n\n[ \t\n]*\\|" ; lisp - "\\.\\s-*$") ; prolog - "*Regexps to end Headings/Sections. Used by \[\].") - - -;; These two vars control the interaction of jumps performed by ' and `. -;; In this new version, '' doesn't erase the marks set by ``, so one can -;; use both kinds of jumps interchangeably and without loosing positions -;; inside the lines. - -;; Remembers position of the last jump done using ``'. -(vip-deflocalvar vip-last-jump nil) -;; Remembers position of the last jump done using `''. -(vip-deflocalvar vip-last-jump-ignore 0) - -;; Some common error messages - -(defconst vip-SpuriousText "Spurious text after command" "") -(defconst vip-BadExCommand "Not an editor command" "") -(defconst vip-InvalidCommandArgument "Invalid command argument" "") -(defconst vip-NoPrevSearch "No previous search string" "") -(defconst vip-EmptyRegister "`%c': Nothing in this register" "") -(defconst vip-InvalidRegister "`%c': Invalid register" "") -(defconst vip-EmptyTextmarker "`%c': Text marker doesn't point anywhere" "") -(defconst vip-InvalidTextmarker "`%c': Invalid text marker" "") -(defconst vip-InvalidViCommand "Invalid command" "") -(defconst vip-BadAddress "Ill-formed address" "") -(defconst vip-FirstAddrExceedsSecond "First address exceeds second" "") -(defconst vip-NoFileSpecified "No file specified" "") - - -;; History variables - -;; History of search strings. -(defvar vip-search-history (list "")) -;; History of query-replace strings used as a source. -(defvar vip-replace1-history nil) -;; History of query-replace strings used as replacement. -(defvar vip-replace2-history nil) -;; History of region quoting strings. -(defvar vip-quote-region-history (list vip-quote-string)) -;; History of Ex-style commands. -(defvar vip-ex-history nil) -;; History of shell commands. -(defvar vip-shell-history nil) - - -;; Last shell command. There are two of these, one for Ex (in viper-ex) -;; and one for Vi. - -;; Last shell command executed with ! command. -(defvar vip-last-shell-com nil) - - - -;;; Miscellaneous - -;; don't bark when mark is inactive -(setq mark-even-if-inactive t) - -(defvar vip-inhibit-startup-message nil - "Whether Viper startup message should be inhibited.") - -(defvar vip-always t - "t means, arrange that vi-state will be a default.") - -(defvar vip-custom-file-name (vip-convert-standard-file-name "~/.vip") - "Viper customisation file. -This variable must be set _before_ loading Viper.") - - -(defvar vip-spell-function 'ispell-region - "Spell function used by #s<move> command to spell.") - -(defvar vip-tags-file-name "TAGS" - "The tags file used by Viper.") - -;; Minibuffer - -(defvar vip-vi-style-in-minibuffer t - "If t, use vi-style editing in minibuffer. -Should be set in `~/.vip' file.") - -;; overlay used in the minibuffer to indicate which state it is in -(vip-deflocalvar vip-minibuffer-overlay nil) - -;; Hook, specific to Viper, which is run just *before* exiting the minibuffer. -;; Beginning with Emacs 19.26, the standard `minibuffer-exit-hook' is run -;; *after* exiting the minibuffer -(defvar vip-minibuffer-exit-hook nil) - -(vip-deflocalvar vip-vi-minibuffer-minor-mode nil - "Minor mode that forces Vi-style when the Minibuffer is in Vi state.") -(vip-deflocalvar vip-insert-minibuffer-minor-mode nil - "Minor mode that forces Vi-style when the Minibuffer is in Insert state.") - -;; setup emacs-supported vi-style feel -(setq next-line-add-newlines nil - require-final-newline t) - -(make-variable-buffer-local 'require-final-newline) - - -;; Mode line -(defconst vip-vi-state-id "<V> " - "Mode line tag identifying the Vi mode of Viper.") -(defconst vip-emacs-state-id "<E> " - "Mode line tag identifying the Emacs mode of Viper.") -(defconst vip-insert-state-id "<I> " - "Mode line tag identifying the Insert mode of Viper.") -(defconst vip-replace-state-id "<R> " - "Mode line tag identifying the Replace mode of Viper.") - -;; Viper changes the default mode-line-buffer-identification -(setq-default mode-line-buffer-identification '(" %b")) - -;; Variable displaying the current Viper state in the mode line. -(vip-deflocalvar vip-mode-string vip-emacs-state-id) -(or (memq 'vip-mode-string global-mode-string) - (setq global-mode-string - (append '("" vip-mode-string) (cdr global-mode-string)))) - - -(defvar vip-vi-state-hook nil - "*Hooks run just before the switch to Vi mode is completed.") -(defvar vip-insert-state-hook nil - "*Hooks run just before the switch to Insert mode is completed.") -(defvar vip-replace-state-hook nil - "*Hooks run just before the switch to Replace mode is completed.") -(defvar vip-emacs-state-hook nil - "*Hooks run just before the switch to Emacs mode is completed.") - -(defvar vip-load-hook nil - "Hooks run just after loading Viper.") - - -;; Generic predicates - -;; These test functions are shamelessly lifted from vip 4.4.2 by Aamod Sane - -;; generate test functions -;; given symbol foo, foo-p is the test function, foos is the set of -;; Viper command keys -;; (macroexpand '(vip-test-com-defun foo)) -;; (defun foo-p (com) (consp (memq (if (< com 0) (- com) com) foos))) - -(defmacro vip-test-com-defun (name) - (let* ((snm (symbol-name name)) - (nm-p (intern (concat snm "-p"))) - (nms (intern (concat snm "s")))) - (` (defun (, nm-p) (com) - (consp (memq (if (< com 0) (- com) com) (, nms))))))) - -;; Variables for defining VI commands - -;; Modifying commands that can be prefixes to movement commands -(defconst vip-prefix-commands '(?c ?d ?y ?! ?= ?# ?< ?> ?\")) -(vip-test-com-defun vip-prefix-command) - -;; Commands that are pairs eg. dd. r and R here are a hack -(defconst vip-charpair-commands '(?c ?d ?y ?! ?= ?< ?> ?r ?R)) -(vip-test-com-defun vip-charpair-command) - -(defconst vip-movement-commands '(?b ?B ?e ?E ?f ?F ?G ?h ?H ?j ?k ?l - ?H ?M ?n ?t ?T ?w ?W ?$ ?% - ?^ ?( ?) ?- ?+ ?| ?{ ?} ?[ ?] ?' ?` - ?; ?, ?0 ?? ?/ - ) - "Movement commands") -(vip-test-com-defun vip-movement-command) - -;; Commands that can be repeated by . (dotted) -(defconst vip-dotable-commands '(?c ?d ?C ?D ?> ?<)) -(vip-test-com-defun vip-dotable-command) - -;; Commands that can follow a # -(defconst vip-hash-cmds '(?c ?C ?g ?q ?S)) -(vip-test-com-defun vip-hash-cmd) - -;; Commands that may have registers as prefix -(defconst vip-regsuffix-commands '(?d ?y ?Y ?D ?p ?P ?x ?X)) -(vip-test-com-defun vip-regsuffix-command) - -(defconst vip-vi-commands (append vip-movement-commands - vip-dotable-commands - vip-charpair-commands - vip-hash-cmds - vip-prefix-commands - vip-regsuffix-commands) - "The list of all commands in Vi-state.") -(vip-test-com-defun vip-vi-command) - - -;;; Arrange the keymaps -(require 'viper-keym) - - -;;; CODE - -;; sentinels - -;; Runs vip-after-change-functions inside after-change-functions -(defun vip-after-change-sentinel (beg end len) - (let ((list vip-after-change-functions)) - (while list - (funcall (car list) beg end len) - (setq list (cdr list))))) - -;; Runs vip-before-change-functions inside before-change-functions -(defun vip-before-change-sentinel (beg end) - (let ((list vip-before-change-functions)) - (while list - (funcall (car list) beg end) - (setq list (cdr list))))) - -(defsubst vip-post-command-sentinel () - (run-hooks 'vip-post-command-hooks)) - -(defsubst vip-pre-command-sentinel () - (run-hooks 'vip-pre-command-hooks)) - -;; Needed so that Viper will be able to figure the last inserted -;; chunk of text with reasonable accuracy. -(defsubst vip-insert-state-post-command-sentinel () - (if (and (memq vip-current-state '(insert-state replace-state)) - vip-insert-point - (>= (point) vip-insert-point)) - (setq vip-last-posn-while-in-insert-state (point-marker))) - (if (eq vip-current-state 'insert-state) - (progn - (or (stringp vip-saved-cursor-color) - (string= (vip-get-cursor-color) vip-insert-state-cursor-color) - (setq vip-saved-cursor-color (vip-get-cursor-color))) - (if (stringp vip-saved-cursor-color) - (vip-change-cursor-color vip-insert-state-cursor-color)) - )) - (if (and (eq this-command 'dabbrev-expand) - (integerp vip-pre-command-point) - (> vip-insert-point vip-pre-command-point)) - (move-marker vip-insert-point vip-pre-command-point)) - ) - -(defsubst vip-insert-state-pre-command-sentinel () - (or (memq this-command '(self-insert-command)) - (memq (vip-event-key last-command-event) - '(up down left right (meta f) (meta b) - (control n) (control p) (control f) (control b))) - (vip-restore-cursor-color-after-insert)) - (if (and (eq this-command 'dabbrev-expand) - (markerp vip-insert-point) - (marker-position vip-insert-point)) - (setq vip-pre-command-point (marker-position vip-insert-point)))) - -(defsubst vip-R-state-post-command-sentinel () - ;; Restoring cursor color is needed despite - ;; vip-replace-state-pre-command-sentinel: When you jump to another buffer in - ;; another frame, the pre-command hook won't change cursor color to default - ;; in that other frame. So, if the second frame cursor was red and we set - ;; the point outside the replacement region, then the cursor color will - ;; remain red. Restoring the default, below, prevents this. - (if (and (<= (vip-replace-start) (point)) - (<= (point) (vip-replace-end))) - (vip-change-cursor-color vip-replace-overlay-cursor-color) - (vip-restore-cursor-color-after-replace) - )) - -;; to speed up, don't change cursor color before self-insert -;; and common move commands -(defsubst vip-replace-state-pre-command-sentinel () - (or (memq this-command '(self-insert-command)) - (memq (vip-event-key last-command-event) - '(up down left right (meta f) (meta b) - (control n) (control p) (control f) (control b))) - (vip-restore-cursor-color-after-replace))) - -(defun vip-replace-state-post-command-sentinel () - ;; Restoring cursor color is needed despite - ;; vip-replace-state-pre-command-sentinel: When one jumps to another buffer - ;; in another frame, the pre-command hook won't change cursor color to - ;; default in that other frame. So, if the second frame cursor was red and - ;; we set the point outside the replacement region, then the cursor color - ;; will remain red. Restoring the default, below, fixes this problem. - ;; - ;; We optimize for self-insert-command's here, since they either don't change - ;; cursor color or, if they terminate replace mode, the color will be changed - ;; in vip-finish-change - (or (memq this-command '(self-insert-command)) - (vip-restore-cursor-color-after-replace)) - (cond - ((eq vip-current-state 'replace-state) - ;; delete characters to compensate for inserted chars. - (let ((replace-boundary (vip-replace-end))) - (save-excursion - (goto-char vip-last-posn-in-replace-region) - (delete-char vip-replace-chars-to-delete) - (setq vip-replace-chars-to-delete 0 - vip-replace-chars-deleted 0) - ;; terminate replace mode if reached replace limit - (if (= vip-last-posn-in-replace-region - (vip-replace-end)) - (vip-finish-change vip-last-posn-in-replace-region))) - - (if (and (<= (vip-replace-start) (point)) - (<= (point) replace-boundary)) - (progn - ;; the state may have changed in vip-finish-change above - (if (eq vip-current-state 'replace-state) - (vip-change-cursor-color vip-replace-overlay-cursor-color)) - (setq vip-last-posn-in-replace-region (point-marker)))) - )) - - (t ;; terminate replace mode if changed Viper states. - (vip-finish-change vip-last-posn-in-replace-region)))) - - -;; changing mode - -;; Change state to NEW-STATE---either emacs-state, vi-state, or insert-state. -(defun vip-change-state (new-state) - ;; Keep vip-post/pre-command-hooks fresh. - ;; We remove then add vip-post/pre-command-sentinel since it is very - ;; desirable that vip-pre-command-sentinel is the last hook and - ;; vip-post-command-sentinel is the first hook. - (remove-hook 'post-command-hook 'vip-post-command-sentinel) - (add-hook 'post-command-hook 'vip-post-command-sentinel) - (remove-hook 'pre-command-hook 'vip-pre-command-sentinel) - (add-hook 'pre-command-hook 'vip-pre-command-sentinel t) - ;; These hooks will be added back if switching to insert/replace mode - (vip-remove-hook 'vip-post-command-hooks - 'vip-insert-state-post-command-sentinel) - (vip-remove-hook 'vip-pre-command-hooks - 'vip-insert-state-pre-command-sentinel) - (cond ((eq new-state 'vi-state) - (cond ((member vip-current-state '(insert-state replace-state)) - - ;; move vip-last-posn-while-in-insert-state - ;; This is a normal hook that is executed in insert/replace - ;; states after each command. In Vi/Emacs state, it does - ;; nothing. We need to execute it here to make sure that - ;; the last posn was recorded when we hit ESC. - ;; It may be left unrecorded if the last thing done in - ;; insert/repl state was dabbrev-expansion or abbrev - ;; expansion caused by hitting ESC - (vip-insert-state-post-command-sentinel) - - (condition-case conds - (progn - (vip-save-last-insertion - vip-insert-point - vip-last-posn-while-in-insert-state) - (if vip-began-as-replace - (setq vip-began-as-replace nil) - ;; repeat insert commands if numerical arg > 1 - (save-excursion - (vip-repeat-insert-command)))) - (error - (vip-message-conditions conds))) - - (if (> (length vip-last-insertion) 0) - (vip-push-onto-ring vip-last-insertion - 'vip-insertion-ring)) - - (if vip-ex-style-editing-in-insert - (or (bolp) (backward-char 1)))) - )) - - ;; insert or replace - ((memq new-state '(insert-state replace-state)) - (if (memq vip-current-state '(emacs-state vi-state)) - (vip-move-marker-locally 'vip-insert-point (point))) - (vip-move-marker-locally 'vip-last-posn-while-in-insert-state (point)) - (vip-add-hook 'vip-post-command-hooks - 'vip-insert-state-post-command-sentinel t) - (vip-add-hook 'vip-pre-command-hooks - 'vip-insert-state-pre-command-sentinel t)) - ) ; outermost cond - - ;; Nothing needs to be done to switch to emacs mode! Just set some - ;; variables, which is already done in vip-change-state-to-emacs! - - (setq vip-current-state new-state) - (vip-normalize-minor-mode-map-alist) - (vip-adjust-keys-for new-state) - (vip-set-mode-vars-for new-state) - (vip-refresh-mode-line) - ) - - - -(defun vip-adjust-keys-for (state) - "Make necessary adjustments to keymaps before entering STATE." - (cond ((memq state '(insert-state replace-state)) - (if vip-auto-indent - (progn - (define-key vip-insert-basic-map "\C-m" 'vip-autoindent) - (if vip-want-emacs-keys-in-insert - ;; expert - (define-key vip-insert-basic-map "\C-j" nil) - ;; novice - (define-key vip-insert-basic-map "\C-j" 'vip-autoindent)))) - - (setq vip-insert-diehard-minor-mode - (not vip-want-emacs-keys-in-insert)) - - (if vip-want-ctl-h-help - (progn - (define-key vip-insert-basic-map [(control h)] 'help-command) - (define-key vip-replace-map [(control h)] 'help-command)) - (define-key vip-insert-basic-map - [(control h)] 'vip-del-backward-char-in-insert) - (define-key vip-replace-map - [(control h)] 'vip-del-backward-char-in-replace))) - - (t ; Vi state - (setq vip-vi-diehard-minor-mode (not vip-want-emacs-keys-in-vi)) - (if vip-want-ctl-h-help - (define-key vip-vi-basic-map [(control h)] 'help-command) - (define-key vip-vi-basic-map [(control h)] 'vip-backward-char))) - )) - - -;; Normalizes minor-mode-map-alist by putting Viper keymaps first. -;; This ensures that Viper bindings are in effect, regardless of which minor -;; modes were turned on by the user or by other packages. -(defun vip-normalize-minor-mode-map-alist () - (setq minor-mode-map-alist - (vip-append-filter-alist - (list - (cons 'vip-vi-intercept-minor-mode vip-vi-intercept-map) - (cons 'vip-vi-minibuffer-minor-mode vip-minibuffer-map) - (cons 'vip-vi-local-user-minor-mode vip-vi-local-user-map) - (cons 'vip-vi-kbd-minor-mode vip-vi-kbd-map) - (cons 'vip-vi-global-user-minor-mode vip-vi-global-user-map) - (cons 'vip-vi-state-modifier-minor-mode - (if (keymapp - (cdr (assoc major-mode vip-vi-state-modifier-alist))) - (cdr (assoc major-mode vip-vi-state-modifier-alist)) - vip-empty-keymap)) - (cons 'vip-vi-diehard-minor-mode vip-vi-diehard-map) - (cons 'vip-vi-basic-minor-mode vip-vi-basic-map) - (cons 'vip-insert-intercept-minor-mode vip-insert-intercept-map) - (cons 'vip-replace-minor-mode vip-replace-map) - ;; vip-insert-minibuffer-minor-mode must come after - ;; vip-replace-minor-mode - (cons 'vip-insert-minibuffer-minor-mode - vip-minibuffer-map) - (cons 'vip-insert-local-user-minor-mode - vip-insert-local-user-map) - (cons 'vip-insert-kbd-minor-mode vip-insert-kbd-map) - (cons 'vip-insert-global-user-minor-mode - vip-insert-global-user-map) - (cons 'vip-insert-state-modifier-minor-mode - (if (keymapp - (cdr - (assoc major-mode vip-insert-state-modifier-alist))) - (cdr - (assoc major-mode vip-insert-state-modifier-alist)) - vip-empty-keymap)) - (cons 'vip-insert-diehard-minor-mode vip-insert-diehard-map) - (cons 'vip-insert-basic-minor-mode vip-insert-basic-map) - (cons 'vip-emacs-intercept-minor-mode - vip-emacs-intercept-map) - (cons 'vip-emacs-local-user-minor-mode - vip-emacs-local-user-map) - (cons 'vip-emacs-kbd-minor-mode vip-emacs-kbd-map) - (cons 'vip-emacs-global-user-minor-mode - vip-emacs-global-user-map) - (cons 'vip-emacs-state-modifier-minor-mode - (if (keymapp - (cdr - (assoc major-mode vip-emacs-state-modifier-alist))) - (cdr - (assoc major-mode vip-emacs-state-modifier-alist)) - vip-empty-keymap)) - ) - minor-mode-map-alist))) - - - - - -;; Viper mode-changing commands and utilities - -;; Modifies mode-line-buffer-identification. -(defun vip-refresh-mode-line () - (setq vip-mode-string - (cond ((eq vip-current-state 'emacs-state) vip-emacs-state-id) - ((eq vip-current-state 'vi-state) vip-vi-state-id) - ((eq vip-current-state 'replace-state) vip-replace-state-id) - ((eq vip-current-state 'insert-state) vip-insert-state-id))) - - ;; Sets Viper mode string in global-mode-string - (force-mode-line-update)) - -;;;###autoload -(defun viper-mode () - "Turn on Viper emulation of Vi." - (interactive) - (if (not noninteractive) - (progn - (if vip-first-time ; This check is important. Without it, startup and - (progn ; expert-level msgs mix up when viper-mode recurses - (setq vip-first-time nil) - (if (not vip-inhibit-startup-message) - (save-window-excursion - (setq vip-inhibit-startup-message t) - (delete-other-windows) - (switch-to-buffer "Viper Startup Message") - (erase-buffer) - (insert - (substitute-command-keys - "Viper Is a Package for Emacs Rebels. -It is also a VI Plan for Emacs Rescue and a venomous VI PERil. - -Technically speaking, Viper is a Vi emulation package for GNU Emacs 19 and -XEmacs 19. It supports virtually all of Vi and Ex functionality, extending -and improving upon much of it. - - 1. Viper supports Vi at several levels. Level 1 is the closest to Vi, - level 5 provides the most flexibility to depart from many Vi conventions. - - You will be asked to specify your user level in a following screen. - - If you select user level 1 then the keys ^X, ^C, ^Z, and ^G will behave - as in VI, to smooth transition to Viper for the beginners. However, to - use Emacs productively, you are advised to reach user level 3 or higher. - - If your user level is 2 or higher, ^X and ^C will invoke Emacs - functions,as usual in Emacs; ^Z will toggle vi/emacs modes, and - ^G will be the usual Emacs's keyboard-quit (something like ^C in VI). - - 2. Vi exit functions (e.g., :wq, ZZ) work on INDIVIDUAL files -- they - do not cause Emacs to quit, except at user level 1 (a novice). - 3. ^X^C EXITS EMACS. - 4. Viper supports multiple undo: `u' will undo. Typing `.' will repeat - undo. Another `u' changes direction. - - 6. Emacs Meta functions are invoked by typing `C-\\' or `\\ ESC'. - On a window system, the best way is to use the Meta-key. - 7. Try \\[keyboard-quit] and \\[abort-recursive-edit] repeatedly,if - something funny happens. This would abort the current editing command. - -You can get more information on Viper by: - - a. Typing `:help' in Vi state - b. Printing Viper manual, found in ./etc/viper.dvi - c. Printing ViperCard, the Quick Reference, found in ./etc/viperCard.dvi - -This startup message appears whenever you load Viper, unless you type `y' now." - )) - (goto-char (point-min)) - (if (y-or-n-p "Inhibit Viper startup message? ") - (vip-save-setting - 'vip-inhibit-startup-message - "Viper startup message inhibited" - vip-custom-file-name t)) - ;;(kill-buffer (current-buffer)) - (message - "The last message is in buffer `Viper Startup Message'") - (sit-for 4) - )) - (vip-set-expert-level 'dont-change-unless))) - (vip-change-state-to-vi)))) - -;;;###autoload -(defalias 'vip-mode 'viper-mode) - - -;; Switch from Insert state to Vi state. -(defun vip-exit-insert-state () - (interactive) - (vip-change-state-to-vi)) - -(defun vip-set-mode-vars-for (state) - "Sets Viper minor mode variables to put Viper's state STATE in effect." - - ;; Emacs state - (setq vip-vi-minibuffer-minor-mode nil - vip-insert-minibuffer-minor-mode nil - vip-vi-intercept-minor-mode nil - vip-insert-intercept-minor-mode nil - - vip-vi-local-user-minor-mode nil - vip-vi-kbd-minor-mode nil - vip-vi-global-user-minor-mode nil - vip-vi-state-modifier-minor-mode nil - vip-vi-diehard-minor-mode nil - vip-vi-basic-minor-mode nil - - vip-replace-minor-mode nil - - vip-insert-local-user-minor-mode nil - vip-insert-kbd-minor-mode nil - vip-insert-global-user-minor-mode nil - vip-insert-state-modifier-minor-mode nil - vip-insert-diehard-minor-mode nil - vip-insert-basic-minor-mode nil - vip-emacs-intercept-minor-mode t - vip-emacs-local-user-minor-mode t - vip-emacs-kbd-minor-mode (not (vip-is-in-minibuffer)) - vip-emacs-global-user-minor-mode t - vip-emacs-state-modifier-minor-mode t - ) - - ;; Vi state - (if (eq state 'vi-state) ; adjust for vi-state - (setq - vip-vi-intercept-minor-mode t - vip-vi-minibuffer-minor-mode (vip-is-in-minibuffer) - vip-vi-local-user-minor-mode t - vip-vi-kbd-minor-mode (not (vip-is-in-minibuffer)) - vip-vi-global-user-minor-mode t - vip-vi-state-modifier-minor-mode t - ;; don't let the diehard keymap block command completion - ;; and other things in the minibuffer - vip-vi-diehard-minor-mode (not - (or vip-want-emacs-keys-in-vi - (vip-is-in-minibuffer))) - vip-vi-basic-minor-mode t - vip-emacs-intercept-minor-mode nil - vip-emacs-local-user-minor-mode nil - vip-emacs-kbd-minor-mode nil - vip-emacs-global-user-minor-mode nil - vip-emacs-state-modifier-minor-mode nil - )) - - ;; Insert and Replace states - (if (member state '(insert-state replace-state)) - (setq - vip-insert-intercept-minor-mode t - vip-replace-minor-mode (eq state 'replace-state) - vip-insert-minibuffer-minor-mode (vip-is-in-minibuffer) - vip-insert-local-user-minor-mode t - vip-insert-kbd-minor-mode (not (vip-is-in-minibuffer)) - vip-insert-global-user-minor-mode t - vip-insert-state-modifier-minor-mode t - ;; don't let the diehard keymap block command completion - ;; and other things in the minibuffer - vip-insert-diehard-minor-mode (not - (or vip-want-emacs-keys-in-insert - (vip-is-in-minibuffer))) - vip-insert-basic-minor-mode t - vip-emacs-intercept-minor-mode nil - vip-emacs-local-user-minor-mode nil - vip-emacs-kbd-minor-mode nil - vip-emacs-global-user-minor-mode nil - vip-emacs-state-modifier-minor-mode nil - )) - - ;; minibuffer faces - (if (vip-has-face-support-p) - (setq vip-minibuffer-current-face - (cond ((eq state 'emacs-state) vip-minibuffer-emacs-face) - ((eq state 'vi-state) vip-minibuffer-vi-face) - ((memq state '(insert-state replace-state)) - vip-minibuffer-insert-face)))) - - (if (vip-is-in-minibuffer) - (vip-set-minibuffer-overlay)) - ) - -;; This also takes care of the annoying incomplete lines in files. -;; Also, this fixes `undo' to work vi-style for complex commands. -(defun vip-change-state-to-vi () - "Change Viper state to Vi." - (interactive) - (if (and vip-first-time (not (vip-is-in-minibuffer))) - (viper-mode) - (if overwrite-mode (overwrite-mode nil)) - (if abbrev-mode (expand-abbrev)) - (if (and auto-fill-function (> (current-column) fill-column)) - (funcall auto-fill-function)) - ;; don't leave whitespace lines around - (if (and (memq last-command - '(vip-autoindent - vip-open-line vip-Open-line - vip-replace-state-exit-cmd)) - (vip-over-whitespace-line)) - (indent-to-left-margin)) - (vip-add-newline-at-eob-if-necessary) - (if vip-undo-needs-adjustment (vip-adjust-undo)) - (vip-change-state 'vi-state) - - ;; always turn off iso-accents-mode, or else we won't be able to use the - ;; keys `,',^ in Vi state, as they will do accents instead of Vi actions. - (if (and (boundp 'iso-accents-mode) iso-accents-mode) - (iso-accents-mode -1)) - - (vip-restore-cursor-color-after-insert) - - ;; Protection against user errors in hooks - (condition-case conds - (run-hooks 'vip-vi-state-hook) - (error - (vip-message-conditions conds))))) - -(defun vip-change-state-to-insert () - "Change Viper state to Insert." - (interactive) - (vip-change-state 'insert-state) - (if (and vip-automatic-iso-accents (fboundp 'iso-accents-mode)) - (iso-accents-mode 1)) ; turn iso accents on - - (or (stringp vip-saved-cursor-color) - (string= (vip-get-cursor-color) vip-insert-state-cursor-color) - (setq vip-saved-cursor-color (vip-get-cursor-color))) - ;; Commented out, because if vip-change-state-to-insert is executed - ;; non-interactively then the old cursor color may get lost. Same old Emacs - ;; bug related to local variables? -;;;(if (stringp vip-saved-cursor-color) -;;; (vip-change-cursor-color vip-insert-state-cursor-color)) - ;; Protection against user errors in hooks - (condition-case conds - (run-hooks 'vip-insert-state-hook) - (error - (vip-message-conditions conds)))) - -(defsubst vip-downgrade-to-insert () - (setq vip-current-state 'insert-state - vip-replace-minor-mode nil) - ) - - - -;; Change to replace state. When the end of replacement region is reached, -;; replace state changes to insert state. -(defun vip-change-state-to-replace (&optional non-R-cmd) - (vip-change-state 'replace-state) - (if (and vip-automatic-iso-accents (fboundp 'iso-accents-mode)) - (iso-accents-mode 1)) ; turn iso accents on - ;; Run insert-state-hook - (condition-case conds - (run-hooks 'vip-insert-state-hook 'vip-replace-state-hook) - (error - (vip-message-conditions conds))) - - (if non-R-cmd - (vip-start-replace) - ;; 'R' is implemented using Emacs's overwrite-mode - (vip-start-R-mode)) - ) - - -(defun vip-change-state-to-emacs () - "Change Viper state to Emacs." - (interactive) - (vip-change-state 'emacs-state) - (if (and vip-automatic-iso-accents (fboundp 'iso-accents-mode)) - (iso-accents-mode 1)) ; turn iso accents on - - ;; Protection agains user errors in hooks - (condition-case conds - (run-hooks 'vip-emacs-state-hook) - (error - (vip-message-conditions conds)))) - -;; escape to emacs mode termporarily -(defun vip-escape-to-emacs (arg &optional events) - "Escape to Emacs state from Vi state for one Emacs command. -ARG is used as the prefix value for the executed command. If -EVENTS is a list of events, which become the beginning of the command." - (interactive "P") - (if (= last-command-char ?\\) - (message "Switched to EMACS state for the next command...")) - (vip-escape-to-state arg events 'emacs-state)) - -;; escape to Vi mode termporarily -(defun vip-escape-to-vi (arg) - "Escape from Emacs state to Vi state for one Vi 1-character command. -If the Vi command that the user types has a prefix argument, e.g., `d2w', then -Vi's prefix argument will be used. Otherwise, the prefix argument passed to -`vip-escape-to-vi' is used." - (interactive "P") - (message "Switched to VI state for the next command...") - (vip-escape-to-state arg nil 'vi-state)) - -;; Escape to STATE mode for one Emacs command. -(defun vip-escape-to-state (arg events state) - ;;(let (com key prefix-arg) - (let (com key) - ;; this temporarily turns off Viper's minor mode keymaps - (vip-set-mode-vars-for state) - (vip-normalize-minor-mode-map-alist) - (if events (vip-set-unread-command-events events)) - - ;; protect against keyboard quit and other errors - (condition-case nil - (let (vip-vi-kbd-minor-mode - vip-insert-kbd-minor-mode - vip-emacs-kbd-minor-mode) - (unwind-protect - (progn - (setq com (key-binding (setq key - (if vip-xemacs-p - (read-key-sequence nil) - (read-key-sequence nil t))))) - ;; In case of binding indirection--chase definitions. - ;; Have to do it here because we execute this command under - ;; different keymaps, so command-execute may not do the - ;; right thing there - (while (vectorp com) (setq com (key-binding com)))) - nil) - ;; Execute command com in the original Viper state, not in state - ;; `state'. Otherwise, if we switch buffers while executing the - ;; escaped to command, Viper's mode vars will remain those of - ;; `state'. When we return to the orig buffer, the bindings will be - ;; screwed up. - (vip-set-mode-vars-for vip-current-state) - - ;; this-command, last-command-char, last-command-event - (setq this-command com) - (if vip-xemacs-p ; XEmacs represents key sequences as vectors - (setq last-command-event (vip-seq-last-elt key) - last-command-char (event-to-character last-command-event)) - ;; Emacs represents them as sequences (str or vec) - (setq last-command-event (vip-seq-last-elt key) - last-command-char last-command-event)) - - (if (commandp com) - (progn - (setq prefix-arg (or prefix-arg arg)) - (command-execute com))) - ) - (quit (ding)) - (error (beep 1)))) - ;; set state in the new buffer - (vip-set-mode-vars-for vip-current-state)) - -(defun vip-exec-form-in-vi (form) - "Execute FORM in Vi state, regardless of the Ccurrent Vi state." - (let ((buff (current-buffer)) - result) - (vip-set-mode-vars-for 'vi-state) - (setq result (eval form)) - (if (not (equal buff (current-buffer))) ; cmd switched buffer - (save-excursion - (set-buffer buff) - (vip-set-mode-vars-for vip-current-state))) - (vip-set-mode-vars-for vip-current-state) - result)) - -(defun vip-exec-form-in-emacs (form) - "Execute FORM in Emacs, temporarily disabling Viper's minor modes. -Similar to vip-escape-to-emacs, but accepts forms rather than keystrokes." - (let ((buff (current-buffer)) - result) - (vip-set-mode-vars-for 'emacs-state) - (setq result (eval form)) - (if (not (equal buff (current-buffer))) ; cmd switched buffer - (save-excursion - (set-buffer buff) - (vip-set-mode-vars-for vip-current-state))) - (vip-set-mode-vars-for vip-current-state) - result)) - - -;; This is needed because minor modes sometimes override essential Viper -;; bindings. By letting Viper know which files these modes are in, it will -;; arrange to reorganize minor-mode-map-alist so that things will work right. -(defun vip-harness-minor-mode (load-file) - "Familiarize Viper with a minor mode defined in LOAD_FILE. -Minor modes that have their own keymaps may overshadow Viper keymaps. -This function is designed to make Viper aware of the packages that define -such minor modes. -Usage: - (vip-harness-minor-mode load-file) - -LOAD-FILE is a name of the file where the specific minor mode is defined. -Suffixes such as .el or .elc should be stripped." - - (interactive "sEnter name of the load file: ") - - (vip-eval-after-load load-file '(vip-normalize-minor-mode-map-alist)) - - ;; Change the default for minor-mode-map-alist each time a harnessed minor - ;; mode adds its own keymap to the a-list. - (vip-eval-after-load - load-file '(setq-default minor-mode-map-alist minor-mode-map-alist)) - ) - - -(defun vip-ESC (arg) - "Emulate ESC key in Emacs. -Prevents multiple escape keystrokes if vip-no-multiple-ESC is true. -If vip-no-multiple-ESC is 'twice double ESC would ding in vi-state. -Other ESC sequences are emulated via the current Emacs's major mode -keymap. This is more convenient on TTYs, since this won't block -function keys such as up,down, etc. ESC will also will also work as -a Meta key in this case. When vip-no-multiple-ESC is nil, ESC functions -as a Meta key and any number of multiple escapes is allowed." - (interactive "P") - (let (char) - (cond ((and (not vip-no-multiple-ESC) (eq vip-current-state 'vi-state)) - (setq char (vip-read-char-exclusive)) - (vip-escape-to-emacs arg (list ?\e char) )) - ((and (eq vip-no-multiple-ESC 'twice) - (eq vip-current-state 'vi-state)) - (setq char (vip-read-char-exclusive)) - (if (= char (string-to-char vip-ESC-key)) - (ding) - (vip-escape-to-emacs arg (list ?\e char) ))) - (t (ding))) - )) - -(defun vip-alternate-Meta-key (arg) - "Simulate Emacs Meta key." - (interactive "P") - (sit-for 1) (message "ESC-") - (vip-escape-to-emacs arg '(?\e))) - -(defun vip-toggle-key-action () - "Action bound to `vip-toggle-key'." - (interactive) - (if (and (< vip-expert-level 2) (equal vip-toggle-key "\C-z")) - (if (vip-window-display-p) - (vip-iconify) - (suspend-emacs)) - (vip-change-state-to-emacs))) - - -;; Intercept ESC sequences on dumb terminals. -;; Based on the idea contributed by Marcelino Veiga Tuimil <mveiga@dit.upm.es> - -;; Check if last key was ESC and if so try to reread it as a function key. -;; But only if there are characters to read during a very short time. -;; Returns the last event, if any. -(defun vip-envelop-ESC-key () - (let ((event last-input-event) - (keyseq [nil]) - inhibit-quit) - (if (vip-ESC-event-p event) - (progn - (if (vip-fast-keysequence-p) - (progn - (let (minor-mode-map-alist) - (vip-set-unread-command-events event) - (setq keyseq - (funcall - (ad-get-orig-definition 'read-key-sequence) nil)) - ) ; let - ;; If keyseq translates into something that still has ESC - ;; at the beginning, separate ESC from the rest of the seq. - ;; In XEmacs we check for events that are keypress meta-key - ;; and convert them into [escape key] - ;; - ;; This is needed for the following reason: - ;; If ESC is the first symbol, we interpret it as if the - ;; user typed ESC and then quickly some other symbols. - ;; If ESC is not the first one, then the key sequence - ;; entered was apparently translated into a function key or - ;; something (e.g., one may have - ;; (define-key function-key-map "\e[192z" [f11]) - ;; which would translate the escape-sequence generated by - ;; f11 in an xterm window into the symbolic key f11. - ;; - ;; If `first-key' is not an ESC event, we make it into the - ;; last-command-event in order to pretend that this key was - ;; pressed. This is needed to allow arrow keys to be bound to - ;; macros. Otherwise, vip-exec-mapped-kbd-macro will think that - ;; the last event was ESC and so it'll execute whatever is - ;; bound to ESC. (Viper macros can't be bound to - ;; ESC-sequences). - (let* ((first-key (elt keyseq 0)) - (key-mod (event-modifiers first-key))) - (cond ((vip-ESC-event-p first-key) - ;; put keys following ESC on the unread list - ;; and return ESC as the key-sequence - (vip-set-unread-command-events (subseq keyseq 1)) - (setq last-input-event event - keyseq (if vip-emacs-p - "\e" - (vector (character-to-event ?\e))))) - ((and vip-xemacs-p - (key-press-event-p first-key) - (equal '(meta) key-mod)) - (vip-set-unread-command-events - (vconcat (vector - (character-to-event (event-key first-key))) - (subseq keyseq 1))) - (setq last-input-event event - keyseq (vector (character-to-event ?\e)))) - ((eventp first-key) - (setq last-command-event first-key)) - )) - ) ; end progn - - ;; this is escape event with nothing after it - ;; put in unread-command-event and then re-read - (vip-set-unread-command-events event) - (setq keyseq - (funcall (ad-get-orig-definition 'read-key-sequence) nil)) - )) - ;; not an escape event - (setq keyseq (vector event))) - keyseq)) - - - -(defadvice read-key-sequence (around vip-read-keyseq-ad activate) - "Harness to work for Viper. This advice is harmless---don't worry!" - (let (inhibit-quit event keyseq) - (setq keyseq ad-do-it) - (setq event (if vip-xemacs-p - (elt keyseq 0) ; XEmacs returns vector of events - (elt (listify-key-sequence keyseq) 0))) - (if (vip-ESC-event-p event) - (let (unread-command-events) - (vip-set-unread-command-events keyseq) - (if (vip-fast-keysequence-p) - (let ((vip-vi-global-user-minor-mode nil) - (vip-vi-local-user-minor-mode nil) - (vip-replace-minor-mode nil) ; actually unnecessary - (vip-insert-global-user-minor-mode nil) - (vip-insert-local-user-minor-mode nil)) - (setq keyseq ad-do-it)) - (setq keyseq ad-do-it)))) - keyseq)) - -(defadvice describe-key (before vip-read-keyseq-ad protect activate) - "Force to read key via `read-key-sequence'." - (interactive (list (vip-events-to-keys - (read-key-sequence "Describe key: "))))) - -(defadvice describe-key-briefly (before vip-read-keyseq-ad protect activate) - "Force to read key via `read-key-sequence'." - (interactive (list (vip-events-to-keys - (read-key-sequence "Describe key briefly: "))))) - -;; Listen to ESC key. -;; If a sequence of keys starting with ESC is issued with very short delays, -;; interpret these keys in Emacs mode, so ESC won't be interpreted as a Vi key. -(defun vip-intercept-ESC-key () - "Function that implements ESC key in Viper emulation of Vi." - (interactive) - (let ((cmd (or (key-binding (vip-envelop-ESC-key)) - '(lambda () (interactive) (error ""))))) - - ;; call the actual function to execute ESC (if no other symbols followed) - ;; or the key bound to the ESC sequence (if the sequence was issued - ;; with very short delay between characters. - (if (eq cmd 'vip-intercept-ESC-key) - (setq cmd - (cond ((eq vip-current-state 'vi-state) - 'vip-ESC) - ((eq vip-current-state 'insert-state) - 'vip-exit-insert-state) - ((eq vip-current-state 'replace-state) - 'vip-replace-state-exit-cmd) - (t 'vip-change-state-to-vi) - ))) - (call-interactively cmd))) - - - -;; prefix argument for Vi mode - -;; In Vi mode, prefix argument is a dotted pair (NUM . COM) where NUM -;; represents the numeric value of the prefix argument and COM represents -;; command prefix such as "c", "d", "m" and "y". - -;; Get value part of prefix-argument ARG. -(defsubst vip-p-val (arg) - (cond ((null arg) 1) - ((consp arg) - (if (or (null (car arg)) (equal (car arg) '(nil))) - 1 (car arg))) - (t arg))) - -;; Get raw value part of prefix-argument ARG. -(defsubst vip-P-val (arg) - (cond ((consp arg) (car arg)) - (t arg))) - -;; Get com part of prefix-argument ARG. -(defsubst vip-getcom (arg) - (cond ((null arg) nil) - ((consp arg) (cdr arg)) - (t nil))) - -;; Get com part of prefix-argument ARG and modify it. -(defun vip-getCom (arg) - (let ((com (vip-getcom arg))) - (cond ((equal com ?c) ?C) - ((equal com ?d) ?D) - ((equal com ?y) ?Y) - (t com)))) - - -;; Compute numeric prefix arg value. -;; Invoked by EVENT. COM is the command part obtained so far. -(defun vip-prefix-arg-value (event com) - (let (value func) - ;; read while number - (while (and (vip-characterp event) (>= event ?0) (<= event ?9)) - (setq value (+ (* (if (vip-characterp value) value 0) 10) (- event ?0))) - (setq event (vip-read-event-convert-to-char))) - - (setq prefix-arg value) - (if com (setq prefix-arg (cons prefix-arg com))) - (while (eq event ?U) - (vip-describe-arg prefix-arg) - (setq event (vip-read-event-convert-to-char))) - - (if (or com (and (not (eq vip-current-state 'vi-state)) - ;; make sure it is a Vi command - (vip-characterp event) (vip-vi-command-p event) - )) - ;; If appears to be one of the vi commands, - ;; then execute it with funcall and clear prefix-arg in order to not - ;; confuse subsequent commands - (progn - ;; last-command-char is the char we want emacs to think was typed - ;; last. If com is not nil, the vip-digit-argument command was called - ;; from within vip-prefix-arg command, such as `d', `w', etc., i.e., - ;; the user typed, say, d2. In this case, `com' would be `d', `w', - ;; etc. - ;; If vip-digit-argument was invoked by vip-escape-to-vi (which is - ;; indicated by the fact that the current state is not vi-state, - ;; then `event' represents the vi command to be executed (e.g., `d', - ;; `w', etc. Again, last-command-char must make emacs believe that - ;; this is the command we typed. - (setq last-command-char (or com event)) - (setq func (vip-exec-form-in-vi - (` (key-binding (char-to-string (, event)))))) - (funcall func prefix-arg) - (setq prefix-arg nil)) - ;; some other command -- let emacs do it in its own way - (vip-set-unread-command-events event)) - )) - - -;; Vi operator as prefix argument." -(defun vip-prefix-arg-com (char value com) - (let ((cont t) - cmd-info mv-or-digit-cmd) - (while (and cont - (memq char - (list ?c ?d ?y ?! ?< ?> ?= ?# ?r ?R ?\" - vip-buffer-search-char))) - (if com - ;; this means that we already have a command character, so we - ;; construct a com list and exit while. however, if char is " - ;; it is an error. - (progn - ;; new com is (CHAR . OLDCOM) - (if (memq char '(?# ?\")) (error "")) - (setq com (cons char com)) - (setq cont nil)) - ;; If com is nil we set com as char, and read more. Again, if char - ;; is ", we read the name of register and store it in vip-use-register. - ;; if char is !, =, or #, a complete com is formed so we exit the - ;; while loop. - (cond ((memq char '(?! ?=)) - (setq com char) - (setq char (read-char)) - (setq cont nil)) - ((= char ?#) - ;; read a char and encode it as com - (setq com (+ 128 (read-char))) - (setq char (read-char))) - ((= char ?\") - (let ((reg (read-char))) - (if (vip-valid-register reg) - (setq vip-use-register reg) - (error "")) - (setq char (read-char)))) - (t - (setq com char) - (setq char (vip-read-char-exclusive)))))) - - (if (atom com) - ;; `com' is a single char, so we construct the command argument - ;; and if `char' is `?', we describe the arg; otherwise - ;; we prepare the command that will be executed at the end. - (progn - (setq cmd-info (cons value com)) - (while (= char ?U) - (vip-describe-arg cmd-info) - (setq char (read-char))) - ;; `char' is a movement command or a digit arg command---so we execute - ;; it at the very end - (setq mv-or-digit-cmd - (vip-exec-form-in-vi - (` (key-binding (char-to-string (, char))))))) - - ;; as com is non-nil, this means that we have a command to execute - (if (memq (car com) '(?r ?R)) - ;; execute apropriate region command. - (let ((char (car com)) (com (cdr com))) - (setq prefix-arg (cons value com)) - (if (= char ?r) (vip-region prefix-arg) - (vip-Region prefix-arg)) - ;; reset prefix-arg - (setq prefix-arg nil)) - ;; otherwise, reset prefix arg and call appropriate command - (setq value (if (null value) 1 value)) - (setq prefix-arg nil) - (cond ((equal com '(?c . ?c)) (vip-line (cons value ?C))) - ((equal com '(?d . ?d)) (vip-line (cons value ?D))) - ((equal com '(?d . ?y)) (vip-yank-defun)) - ((equal com '(?y . ?y)) (vip-line (cons value ?Y))) - ((equal com '(?< . ?<)) (vip-line (cons value ?<))) - ((equal com '(?> . ?>)) (vip-line (cons value ?>))) - ((equal com '(?! . ?!)) (vip-line (cons value ?!))) - ((equal com '(?= . ?=)) (vip-line (cons value ?=))) - (t (error ""))))) - - (if mv-or-digit-cmd - (progn - (setq last-command-char char) - (funcall mv-or-digit-cmd cmd-info))) - )) - -(defun vip-describe-arg (arg) - (let (val com) - (setq val (vip-P-val arg) - com (vip-getcom arg)) - (if (null val) - (if (null com) - (message "Value is nil, and command is nil") - (message "Value is nil, and command is `%c'" com)) - (if (null com) - (message "Value is `%d', and command is nil" val) - (message "Value is `%d', and command is `%c'" val com))))) - -(defun vip-digit-argument (arg) - "Begin numeric argument for the next command." - (interactive "P") - (vip-leave-region-active) - (vip-prefix-arg-value - last-command-char (if (consp arg) (cdr arg) nil))) - -(defun vip-command-argument (arg) - "Accept a motion command as an argument." - (interactive "P") - (condition-case nil - (vip-prefix-arg-com - last-command-char - (cond ((null arg) nil) - ((consp arg) (car arg)) - ((integerp arg) arg) - (t (error vip-InvalidCommandArgument))) - (cond ((null arg) nil) - ((consp arg) (cdr arg)) - ((integerp arg) nil) - (t (error vip-InvalidCommandArgument)))) - (quit (setq vip-use-register nil) - (signal 'quit nil))) - (vip-deactivate-mark)) - - -;; repeat last destructive command - -;; Append region to text in register REG. -;; START and END are buffer positions indicating what to append. -(defsubst vip-append-to-register (reg start end) - (set-register reg (concat (if (stringp (get-register reg)) - (get-register reg) "") - (buffer-substring start end)))) - -;; Saves last inserted text for possible use by vip-repeat command. -(defun vip-save-last-insertion (beg end) - (setq vip-last-insertion (buffer-substring beg end)) - (or (< (length vip-d-com) 5) - (setcar (nthcdr 4 vip-d-com) vip-last-insertion)) - (or (null vip-command-ring) - (ring-empty-p vip-command-ring) - (progn - (setcar (nthcdr 4 (vip-current-ring-item vip-command-ring)) - vip-last-insertion) - ;; del most recent elt, if identical to the second most-recent - (vip-cleanup-ring vip-command-ring))) - ) - -(defsubst vip-yank-last-insertion () - "Inserts the text saved by the previous vip-save-last-insertion command." - (condition-case nil - (insert vip-last-insertion) - (error nil))) - - -;; define functions to be executed - -;; invoked by the `C' command -(defun vip-exec-change (m-com com) - ;; handle C cmd at the eol and at eob. - (if (or (and (eolp) (= vip-com-point (point))) - (= vip-com-point (point-max))) - (progn - (insert " ")(backward-char 1))) - (if (= vip-com-point (point)) - (vip-forward-char-carefully)) - (if (= com ?c) - (vip-change vip-com-point (point)) - (vip-change-subr vip-com-point (point)))) - -;; this is invoked by vip-substitute-line -(defun vip-exec-Change (m-com com) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark t) (point)) - (if vip-use-register - (progn - (cond ((vip-valid-register vip-use-register '(letter digit)) - ;;(vip-valid-register vip-use-register '(letter) - (copy-to-register - vip-use-register (mark t) (point) nil)) - ((vip-valid-register vip-use-register '(Letter)) - (vip-append-to-register - (downcase vip-use-register) (mark t) (point))) - (t (setq vip-use-register nil) - (error vip-InvalidRegister vip-use-register))) - (setq vip-use-register nil))) - (delete-region (mark t) (point))) - (open-line 1) - (if (= com ?C) (vip-change-mode-to-insert) (vip-yank-last-insertion))) - -(defun vip-exec-delete (m-com com) - (if vip-use-register - (progn - (cond ((vip-valid-register vip-use-register '(letter digit)) - ;;(vip-valid-register vip-use-register '(letter)) - (copy-to-register - vip-use-register vip-com-point (point) nil)) - ((vip-valid-register vip-use-register '(Letter)) - (vip-append-to-register - (downcase vip-use-register) vip-com-point (point))) - (t (setq vip-use-register nil) - (error vip-InvalidRegister vip-use-register))) - (setq vip-use-register nil))) - (setq last-command - (if (eq last-command 'd-command) 'kill-region nil)) - (kill-region vip-com-point (point)) - (setq this-command 'd-command) - (if vip-ex-style-motion - (if (and (eolp) (not (bolp))) (backward-char 1)))) - -(defun vip-exec-Delete (m-com com) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark t) (point)) - (if vip-use-register - (progn - (cond ((vip-valid-register vip-use-register '(letter digit)) - ;;(vip-valid-register vip-use-register '(letter)) - (copy-to-register - vip-use-register (mark t) (point) nil)) - ((vip-valid-register vip-use-register '(Letter)) - (vip-append-to-register - (downcase vip-use-register) (mark t) (point))) - (t (setq vip-use-register nil) - (error vip-InvalidRegister vip-use-register))) - (setq vip-use-register nil))) - (setq last-command - (if (eq last-command 'D-command) 'kill-region nil)) - (kill-region (mark t) (point)) - (if (eq m-com 'vip-line) (setq this-command 'D-command))) - (back-to-indentation)) - -(defun vip-exec-yank (m-com com) - (if vip-use-register - (progn - (cond ((vip-valid-register vip-use-register '(letter digit)) - ;; (vip-valid-register vip-use-register '(letter)) - (copy-to-register - vip-use-register vip-com-point (point) nil)) - ((vip-valid-register vip-use-register '(Letter)) - (vip-append-to-register - (downcase vip-use-register) vip-com-point (point))) - (t (setq vip-use-register nil) - (error vip-InvalidRegister vip-use-register))) - (setq vip-use-register nil))) - (setq last-command nil) - (copy-region-as-kill vip-com-point (point)) - (goto-char vip-com-point)) - -(defun vip-exec-Yank (m-com com) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark t) (point)) - (if vip-use-register - (progn - (cond ((vip-valid-register vip-use-register '(letter digit)) - (copy-to-register - vip-use-register (mark t) (point) nil)) - ((vip-valid-register vip-use-register '(Letter)) - (vip-append-to-register - (downcase vip-use-register) (mark t) (point))) - (t (setq vip-use-register nil) - (error vip-InvalidRegister vip-use-register))) - (setq vip-use-register nil))) - (setq last-command nil) - (copy-region-as-kill (mark t) (point))) - (vip-deactivate-mark) - (goto-char vip-com-point)) - -(defun vip-exec-bang (m-com com) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark t) (point)) - (shell-command-on-region - (mark t) (point) - (if (= com ?!) - (setq vip-last-shell-com - (vip-read-string-with-history - "!" - nil - 'vip-shell-history - (car vip-shell-history) - )) - vip-last-shell-com) - t))) - -(defun vip-exec-equals (m-com com) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark t) (point)) - (if (> (mark t) (point)) (exchange-point-and-mark)) - (indent-region (mark t) (point) nil))) - -(defun vip-exec-shift (m-com com) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark t) (point)) - (if (> (mark t) (point)) (exchange-point-and-mark)) - (indent-rigidly (mark t) (point) - (if (= com ?>) - vip-shift-width - (- vip-shift-width)))) - ;; return point to where it was before shift - (goto-char vip-com-point)) - -;; this is needed because some commands fake com by setting it to ?r, which -;; denotes repeated insert command. -(defsubst vip-exec-dummy (m-com com) - nil) - -(defun vip-exec-buffer-search (m-com com) - (setq vip-s-string (buffer-substring (point) vip-com-point)) - (setq vip-s-forward t) - (setq vip-search-history (cons vip-s-string vip-search-history)) - (vip-search vip-s-string vip-s-forward 1)) - -(defvar vip-exec-array (make-vector 128 nil)) - -;; Using a dispatch array allows adding functions like buffer search -;; without affecting other functions. Buffer search can now be bound -;; to any character. - -(aset vip-exec-array ?c 'vip-exec-change) -(aset vip-exec-array ?C 'vip-exec-Change) -(aset vip-exec-array ?d 'vip-exec-delete) -(aset vip-exec-array ?D 'vip-exec-Delete) -(aset vip-exec-array ?y 'vip-exec-yank) -(aset vip-exec-array ?Y 'vip-exec-Yank) -(aset vip-exec-array ?r 'vip-exec-dummy) -(aset vip-exec-array ?! 'vip-exec-bang) -(aset vip-exec-array ?< 'vip-exec-shift) -(aset vip-exec-array ?> 'vip-exec-shift) -(aset vip-exec-array ?= 'vip-exec-equals) - - - -;; This function is called by various movement commands to execute a -;; destructive command on the region specified by the movement command. For -;; instance, if the user types cw, then the command vip-forward-word will -;; call vip-execute-com to execute vip-exec-change, which eventually will -;; call vip-change to invoke the replace mode on the region. -;; -;; The list (M-COM VAL COM REG INSETED-TEXT COMMAND-KEYS) is set to -;; vip-d-com for later use by vip-repeat. -(defun vip-execute-com (m-com val com) - (let ((reg vip-use-register)) - ;; this is the special command `#' - (if (> com 128) - (vip-special-prefix-com (- com 128)) - (let ((fn (aref vip-exec-array (if (< com 0) (- com) com)))) - (if (null fn) - (error "%c: %s" com vip-InvalidViCommand) - (funcall fn m-com com)))) - (if (vip-dotable-command-p com) - (vip-set-destructive-command - (list m-com val - (if (memq com (list ?c ?C ?!)) (- com) com) - reg nil nil))) - )) - - -(defun vip-repeat (arg) - "Re-execute last destructive command. -Use the info in vip-d-com, which has the form -\(com val ch reg inserted-text command-keys\), -where `com' is the command to be re-executed, `val' is the -argument to `com', `ch' is a flag for repeat, and `reg' is optional; -if it exists, it is the name of the register for `com'. -If the prefix argument, ARG, is non-nil, it is used instead of `val'." - (interactive "P") - (let ((save-point (point)) ; save point before repeating prev cmd - ;; Pass along that we are repeating a destructive command - ;; This tells vip-set-destructive-command not to update - ;; vip-command-ring - (vip-intermediate-command 'vip-repeat)) - (if (eq last-command 'vip-undo) - ;; if the last command was vip-undo, then undo-more - (vip-undo-more) - ;; otherwise execute the command stored in vip-d-com. if arg is non-nil - ;; its prefix value is used as new prefix value for the command. - (let ((m-com (car vip-d-com)) - (val (vip-P-val arg)) - (com (nth 2 vip-d-com)) - (reg (nth 3 vip-d-com))) - (if (null val) (setq val (nth 1 vip-d-com))) - (if (null m-com) (error "No previous command to repeat.")) - (setq vip-use-register reg) - (if (nth 4 vip-d-com) ; text inserted by command - (setq vip-last-insertion (nth 4 vip-d-com) - vip-d-char (nth 4 vip-d-com))) - (funcall m-com (cons val com)) - (if (and vip-keep-point-on-repeat (< save-point (point))) - (goto-char save-point)) ; go back to before repeat. - (if (and (eolp) (not (bolp))) - (backward-char 1)) - )) - (if vip-undo-needs-adjustment (vip-adjust-undo)) ; take care of undo - ;; If the prev cmd was rotating the command ring, this means that `.' has - ;; just executed a command from that ring. So, push it on the ring again. - ;; If we are just executing previous command , then don't push vip-d-com - ;; because vip-d-com is not fully constructed in this case (its keys and - ;; the inserted text may be nil). Besides, in this case, the command - ;; executed by `.' is already on the ring. - (if (eq last-command 'vip-display-current-destructive-command) - (vip-push-onto-ring vip-d-com 'vip-command-ring)) - (vip-deactivate-mark) - )) - -(defun vip-repeat-from-history () - "Repeat a destructive command from history. -Doesn't change vip-command-ring in any way, so `.' will work as before -executing this command. -This command is supposed to be bound to a two-character Vi macro where -the second character is a digit 0 to 9. The digit indicates which -history command to execute. `<char>0' is equivalent to `.', `<char>1' -invokes the command before that, etc." - (interactive) - (let* ((vip-intermediate-command 'repeating-display-destructive-command) - (idx (cond (vip-this-kbd-macro - (string-to-number - (symbol-name (elt vip-this-kbd-macro 1)))) - (t 0))) - (num idx) - (vip-d-com vip-d-com)) - - (or (and (numberp num) (<= 0 num) (<= num 9)) - (progn - (setq idx 0 - num 0) - (message - "`vip-repeat-from-history' must be invoked as a Vi macro bound to `<key><digit>'"))) - (while (< 0 num) - (setq vip-d-com (vip-special-ring-rotate1 vip-command-ring -1)) - (setq num (1- num))) - (vip-repeat nil) - (while (> idx num) - (vip-special-ring-rotate1 vip-command-ring 1) - (setq num (1+ num))) - )) - - -;; This command is invoked interactively by the key sequence #<char> -(defun vip-special-prefix-com (char) - (cond ((= char ?c) - (downcase-region (min vip-com-point (point)) - (max vip-com-point (point)))) - ((= char ?C) - (upcase-region (min vip-com-point (point)) - (max vip-com-point (point)))) - ((= char ?g) - (push-mark vip-com-point t) - (vip-global-execute)) - ((= char ?q) - (push-mark vip-com-point t) - (vip-quote-region)) - ((= char ?s) (funcall vip-spell-function vip-com-point (point))) - (t (error "#%c: %s" char vip-InvalidViCommand)))) - - -;; undoing - -(defun vip-undo () - "Undo previous change." - (interactive) - (message "undo!") - (let ((modified (buffer-modified-p)) - (before-undo-pt (point-marker)) - (after-change-functions after-change-functions) - undo-beg-posn undo-end-posn) - - ;; no need to remove this hook, since this var has scope inside a let. - (add-hook 'after-change-functions - '(lambda (beg end len) - (setq undo-beg-posn beg - undo-end-posn (or end beg)))) - - (undo-start) - (undo-more 2) - (setq undo-beg-posn (or undo-beg-posn before-undo-pt) - undo-end-posn (or undo-end-posn undo-beg-posn)) - - (goto-char undo-beg-posn) - (sit-for 0) - (if (and vip-keep-point-on-undo - (pos-visible-in-window-p before-undo-pt)) - (progn - (push-mark (point-marker) t) - (vip-sit-for-short 300) - (goto-char undo-end-posn) - (vip-sit-for-short 300) - (if (and (> (abs (- undo-beg-posn before-undo-pt)) 1) - (> (abs (- undo-end-posn before-undo-pt)) 1)) - (goto-char before-undo-pt) - (goto-char undo-beg-posn))) - (push-mark before-undo-pt t)) - (if (and (eolp) (not (bolp))) (backward-char 1)) - (if (not modified) (set-buffer-modified-p t))) - (setq this-command 'vip-undo)) - -;; Continue undoing previous changes. -(defun vip-undo-more () - (message "undo more!") - (condition-case nil - (undo-more 1) - (error (beep) - (message "No further undo information in this buffer"))) - (if (and (eolp) (not (bolp))) (backward-char 1)) - (setq this-command 'vip-undo)) - -;; The following two functions are used to set up undo properly. -;; In VI, unlike Emacs, if you open a line, say, and add a bunch of lines, -;; they are undone all at once. -(defun vip-adjust-undo () - (let ((inhibit-quit t) - tmp tmp2) - (setq vip-undo-needs-adjustment nil) - (if (listp buffer-undo-list) - (if (setq tmp (memq vip-buffer-undo-list-mark buffer-undo-list)) - (progn - (setq tmp2 (cdr tmp)) ; the part after mark - - ;; cut tail from buffer-undo-list temporarily by direct - ;; manipulation with pointers in buffer-undo-list - (setcdr tmp nil) - - (setq buffer-undo-list (delq nil buffer-undo-list)) - (setq buffer-undo-list - (delq vip-buffer-undo-list-mark buffer-undo-list)) - ;; restore tail of buffer-undo-list - (setq buffer-undo-list (nconc buffer-undo-list tmp2))) - (setq buffer-undo-list (delq nil buffer-undo-list)))))) - - -(defun vip-set-complex-command-for-undo () - (if (listp buffer-undo-list) - (if (not vip-undo-needs-adjustment) - (let ((inhibit-quit t)) - (setq buffer-undo-list - (cons vip-buffer-undo-list-mark buffer-undo-list)) - (setq vip-undo-needs-adjustment t))))) - - - - -(defun vip-display-current-destructive-command () - (let ((text (nth 4 vip-d-com)) - (keys (nth 5 vip-d-com)) - (max-text-len 30)) - - (setq this-command 'vip-display-current-destructive-command) - - (message " `.' runs %s%s" - (concat "`" (vip-array-to-string keys) "'") - (vip-abbreviate-string text max-text-len - " inserting `" "'" " .......")) - )) - - -;; don't change vip-d-com if it was vip-repeat command invoked with `.' -;; or in some other way (non-interactively). -(defun vip-set-destructive-command (list) - (or (eq vip-intermediate-command 'vip-repeat) - (progn - (setq vip-d-com list) - (setcar (nthcdr 5 vip-d-com) - (vip-array-to-string (this-command-keys))) - (vip-push-onto-ring vip-d-com 'vip-command-ring)))) - -(defun vip-prev-destructive-command (next) - "Find previous destructive command in the history of destructive commands. -With prefix argument, find next destructive command." - (interactive "P") - (let (cmd vip-intermediate-command) - (if (eq last-command 'vip-display-current-destructive-command) - ;; repeated search through command history - (setq vip-intermediate-command 'repeating-display-destructive-command) - ;; first search through command history--set temp ring - (setq vip-temp-command-ring (copy-list vip-command-ring))) - (setq cmd (if next - (vip-special-ring-rotate1 vip-temp-command-ring 1) - (vip-special-ring-rotate1 vip-temp-command-ring -1))) - (if (null cmd) - () - (setq vip-d-com cmd)) - (vip-display-current-destructive-command))) - -(defun vip-next-destructive-command () - "Find next destructive command in the history of destructive commands." - (interactive) - (vip-prev-destructive-command 'next)) - -(defun vip-insert-prev-from-insertion-ring (arg) - "Cycle through insertion ring in the direction of older insertions. -Undoes previous insertion and inserts new. -With prefix argument, cycles in the direction of newer elements. -In minibuffer, this command executes whatever the invocation key is bound -to in the global map, instead of cycling through the insertion ring." - (interactive "P") - (let (vip-intermediate-command) - (if (eq last-command 'vip-insert-from-insertion-ring) - (progn ; repeated search through insertion history - (setq vip-intermediate-command 'repeating-insertion-from-ring) - (if (eq vip-current-state 'replace-state) - (undo 1) - (if vip-last-inserted-string-from-insertion-ring - (backward-delete-char - (length vip-last-inserted-string-from-insertion-ring)))) - ) - ;;first search through insertion history - (setq vip-temp-insertion-ring (copy-list vip-insertion-ring))) - (setq this-command 'vip-insert-from-insertion-ring) - ;; so that things will be undone properly - (setq buffer-undo-list (cons nil buffer-undo-list)) - (setq vip-last-inserted-string-from-insertion-ring - (vip-special-ring-rotate1 vip-temp-insertion-ring (if arg 1 -1))) - - ;; this change of vip-intermediate-command must come after - ;; vip-special-ring-rotate1, so that the ring will rotate, but before the - ;; insertion. - (setq vip-intermediate-command nil) - (if vip-last-inserted-string-from-insertion-ring - (insert vip-last-inserted-string-from-insertion-ring)) - )) - -(defun vip-insert-next-from-insertion-ring () - "Cycle through insertion ring in the direction of older insertions. -Undo previous insertion and inserts new." - (interactive) - (vip-insert-prev-from-insertion-ring 'next)) - - -;; some region utilities - -;; If at the last line of buffer, add \\n before eob, if newline is missing. -(defun vip-add-newline-at-eob-if-necessary () - (save-excursion - (end-of-line) - ;; make sure all lines end with newline, unless in the minibuffer or - ;; when requested otherwise (require-final-newline is nil) - (if (and (eobp) - (not (bolp)) - require-final-newline - (not (vip-is-in-minibuffer)) - (not buffer-read-only)) - (insert "\n")))) - -(defun vip-yank-defun () - (mark-defun) - (copy-region-as-kill (point) (mark t))) - -;; Enlarge region between BEG and END. -(defun vip-enlarge-region (beg end) - (or beg (setq beg end)) ; if beg is nil, set to end - (or end (setq end beg)) ; if end is nil, set to beg - - (if (< beg end) - (progn (goto-char beg) (set-mark end)) - (goto-char end) - (set-mark beg)) - (beginning-of-line) - (exchange-point-and-mark) - (if (or (not (eobp)) (not (bolp))) (forward-line 1)) - (if (not (eobp)) (beginning-of-line)) - (if (> beg end) (exchange-point-and-mark))) - - -;; Quote region by each line with a user supplied string. -(defun vip-quote-region () - (setq vip-quote-string - (vip-read-string-with-history - "Quote string: " - nil - 'vip-quote-region-history - vip-quote-string)) - (vip-enlarge-region (point) (mark t)) - (if (> (point) (mark t)) (exchange-point-and-mark)) - (insert vip-quote-string) - (beginning-of-line) - (forward-line 1) - (while (and (< (point) (mark t)) (bolp)) - (insert vip-quote-string) - (beginning-of-line) - (forward-line 1))) - -;; Tells whether BEG is on the same line as END. -;; If one of the args is nil, it'll return nil. -(defun vip-same-line (beg end) - (let ((selective-display nil) - (incr 0) - temp) - (if (and beg end (> beg end)) - (setq temp beg - beg end - end temp)) - (if (and beg end) - (cond ((or (> beg (point-max)) (> end (point-max))) ; out of range - nil) - (t - ;; This 'if' is needed because Emacs treats the next empty line - ;; as part of the previous line. - (if (= (vip-line-pos 'start) end) - (setq incr 1)) - (<= (+ incr (count-lines beg end)) 1)))) - )) - - -;; Check if the string ends with a newline. -(defun vip-end-with-a-newline-p (string) - (or (string= string "") - (= (vip-seq-last-elt string) ?\n))) - -(defun vip-tmp-insert-at-eob (msg) - (let ((savemax (point-max))) - (goto-char savemax) - (insert msg) - (sit-for 2) - (goto-char savemax) (delete-region (point) (point-max)) - )) - - - -;;; Minibuffer business - -(defsubst vip-set-minibuffer-style () - (add-hook 'minibuffer-setup-hook 'vip-minibuffer-setup-sentinel)) - - -(defun vip-minibuffer-setup-sentinel () - (let ((hook (if vip-vi-style-in-minibuffer - 'vip-change-state-to-insert - 'vip-change-state-to-emacs))) - (funcall hook) - )) - -;; Interpret last event in the local map -(defun vip-exit-minibuffer () - (interactive) - (let (command) - (setq command (local-key-binding (char-to-string last-command-char))) - (if command - (command-execute command) - (exit-minibuffer)))) - - -(defun vip-set-search-face () - (if (vip-has-face-support-p) - (defvar vip-search-face - (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.") - )) - - -(defun vip-set-minibuffer-faces () - (if (not (vip-has-face-support-p)) - () - (defvar vip-minibuffer-emacs-face - (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 - (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 - (if (vip-can-use-colors "darkseagreen2" "Black") - (progn - (set-face-background - 'vip-minibuffer-insert-face "darkseagreen2") - (set-face-foreground - 'vip-minibuffer-insert-face "Black")) - (copy-face 'modeline 'vip-minibuffer-insert-face)) - (vip-italicize-face 'vip-minibuffer-insert-face))) - 'vip-minibuffer-insert-face) - "Face used in the Minibuffer when it is in Insert state.") - - (defvar vip-minibuffer-vi-face - (progn - (make-face 'vip-minibuffer-vi-face) - (vip-hide-face 'vip-minibuffer-vi-face) - (or (face-differs-from-default-p 'vip-minibuffer-vi-face) - (if vip-vi-style-in-minibuffer - (if (vip-can-use-colors "Black" "grey") - (progn - (set-face-background 'vip-minibuffer-vi-face "grey") - (set-face-foreground 'vip-minibuffer-vi-face "Black")) - (copy-face 'bold 'vip-minibuffer-vi-face)) - (copy-face 'bold 'vip-minibuffer-vi-face) - (invert-face 'vip-minibuffer-vi-face))) - 'vip-minibuffer-vi-face) - "Face used in the Minibuffer when it is in Vi state.") - - ;; the current face used in the minibuffer - (vip-deflocalvar vip-minibuffer-current-face vip-minibuffer-emacs-face "") - )) - - - -;;; Reading string with history - -(defun vip-read-string-with-history (prompt &optional initial - history-var default keymap) - ;; Read string, prompting with PROMPT and inserting the INITIAL - ;; value. Uses HISTORY-VAR. DEFAULT is the default value to accept if the - ;; input is an empty string. Use KEYMAP, if given, or the - ;; minibuffer-local-map. - ;; Default value is displayed until the user types something in the - ;; minibuffer. - (let ((minibuffer-setup-hook - '(lambda () - (if (stringp initial) - (progn - ;; don't wait if we have unread events or in kbd macro - (or unread-command-events - executing-kbd-macro - (sit-for 840)) - (erase-buffer) - (insert initial))) - (vip-minibuffer-setup-sentinel))) - (val "") - (padding "") - temp-msg) - - (setq keymap (or keymap minibuffer-local-map) - initial (or initial "") - temp-msg (if default - (format "(default: %s) " default) - "")) - - (setq vip-incomplete-ex-cmd nil) - (setq val (read-from-minibuffer prompt - (concat temp-msg initial val padding) - keymap nil history-var)) - (setq minibuffer-setup-hook nil - padding (vip-array-to-string (this-command-keys)) - temp-msg "") - ;; the following tries to be smart about what to put in history - (if (not (string= val (car (eval history-var)))) - (set history-var (cons val (eval history-var)))) - (if (or (string= (nth 0 (eval history-var)) (nth 1 (eval history-var))) - (string= (nth 0 (eval history-var)) "")) - (set history-var (cdr (eval history-var)))) - ;; If the user enters nothing but the prev cmd wasn't vip-ex, - ;; vip-command-argument, or `! shell-command', this probably means - ;; that the user typed something then erased. Return "" in this case, not - ;; the default---the default is too confusing in this case. - (cond ((and (string= val "") - (not (string= prompt "!")) ; was a `! shell-command' - (not (memq last-command - '(vip-ex - vip-command-argument - t) - ))) - "") - ((string= val "") (or default "")) - (t val)) - )) - - - -;; insertion commands - -;; Called when state changes from Insert Vi command mode. -;; Repeats the insertion command if Insert state was entered with prefix -;; argument > 1. -(defun vip-repeat-insert-command () - (let ((i-com (car vip-d-com)) - (val (nth 1 vip-d-com)) - (char (nth 2 vip-d-com))) - (if (and val (> val 1)) ; first check that val is non-nil - (progn - (setq vip-d-com (list i-com (1- val) ?r nil nil nil)) - (vip-repeat nil) - (setq vip-d-com (list i-com val char nil nil nil)) - )))) - -(defun vip-insert (arg) - "Insert before point." - (interactive "P") - (vip-set-complex-command-for-undo) - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (vip-set-destructive-command (list 'vip-insert val ?r nil nil nil)) - (if com - (vip-loop val (vip-yank-last-insertion)) - (vip-change-state-to-insert)))) - -(defun vip-append (arg) - "Append after point." - (interactive "P") - (vip-set-complex-command-for-undo) - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (vip-set-destructive-command (list 'vip-append val ?r nil nil nil)) - (if (not (eolp)) (forward-char)) - (if (equal com ?r) - (vip-loop val (vip-yank-last-insertion)) - (vip-change-state-to-insert)))) - -(defun vip-Append (arg) - "Append at end of line." - (interactive "P") - (vip-set-complex-command-for-undo) - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (vip-set-destructive-command (list 'vip-Append val ?r nil nil nil)) - (end-of-line) - (if (equal com ?r) - (vip-loop val (vip-yank-last-insertion)) - (vip-change-state-to-insert)))) - -(defun vip-Insert (arg) - "Insert before first non-white." - (interactive "P") - (vip-set-complex-command-for-undo) - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (vip-set-destructive-command (list 'vip-Insert val ?r nil nil nil)) - (back-to-indentation) - (if (equal com ?r) - (vip-loop val (vip-yank-last-insertion)) - (vip-change-state-to-insert)))) - -(defun vip-open-line (arg) - "Open line below." - (interactive "P") - (vip-set-complex-command-for-undo) - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (vip-set-destructive-command (list 'vip-open-line val ?r nil nil nil)) - (let ((col (current-indentation))) - (if (equal com ?r) - (vip-loop val - (progn - (end-of-line) - (newline 1) - (if vip-auto-indent - (progn - (setq vip-cted t) - (if vip-electric-mode - (indent-according-to-mode) - (indent-to col)) - )) - (vip-yank-last-insertion))) - (end-of-line) - (newline 1) - (if vip-auto-indent - (progn - (setq vip-cted t) - (if vip-electric-mode - (indent-according-to-mode) - (indent-to col)))) - (vip-change-state-to-insert))))) - -(defun vip-Open-line (arg) - "Open line above." - (interactive "P") - (vip-set-complex-command-for-undo) - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (vip-set-destructive-command (list 'vip-Open-line val ?r nil nil nil)) - (let ((col (current-indentation))) - (if (equal com ?r) - (vip-loop val - (progn - (beginning-of-line) - (open-line 1) - (if vip-auto-indent - (progn - (setq vip-cted t) - (if vip-electric-mode - (indent-according-to-mode) - (indent-to col)) - )) - (vip-yank-last-insertion))) - (beginning-of-line) - (open-line 1) - (if vip-auto-indent - (progn - (setq vip-cted t) - (if vip-electric-mode - (indent-according-to-mode) - (indent-to col)) - )) - (vip-change-state-to-insert))))) - -(defun vip-open-line-at-point (arg) - "Open line at point." - (interactive "P") - (vip-set-complex-command-for-undo) - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (vip-set-destructive-command - (list 'vip-open-line-at-point val ?r nil nil nil)) - (if (equal com ?r) - (vip-loop val - (progn - (open-line 1) - (vip-yank-last-insertion))) - (open-line 1) - (vip-change-state-to-insert)))) - -(defun vip-substitute (arg) - "Substitute characters." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (push-mark nil t) - (forward-char val) - (if (equal com ?r) - (vip-change-subr (mark t) (point)) - (vip-change (mark t) (point))) - (vip-set-destructive-command (list 'vip-substitute val ?r nil nil nil)) - )) - -(defun vip-substitute-line (arg) - "Substitute lines." - (interactive "p") - (vip-set-complex-command-for-undo) - (vip-line (cons arg ?C))) - -;; Prepare for replace -(defun vip-start-replace () - (setq vip-began-as-replace t - vip-sitting-in-replace t - vip-replace-chars-to-delete 0 - vip-replace-chars-deleted 0) - (vip-add-hook 'vip-after-change-functions 'vip-replace-mode-spy-after t) - (vip-add-hook 'vip-before-change-functions 'vip-replace-mode-spy-before t) - ;; this will get added repeatedly, but no harm - (add-hook 'after-change-functions 'vip-after-change-sentinel t) - (add-hook 'before-change-functions 'vip-before-change-sentinel t) - (vip-move-marker-locally 'vip-last-posn-in-replace-region - (vip-replace-start)) - (vip-add-hook - 'vip-post-command-hooks 'vip-replace-state-post-command-sentinel t) - (vip-add-hook - 'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel t) - ) - - -;; checks how many chars were deleted by the last change -(defun vip-replace-mode-spy-before (beg end) - (setq vip-replace-chars-deleted - (- end beg - (max 0 (- end (vip-replace-end))) - (max 0 (- (vip-replace-start) beg)) - ))) - -;; Invoked as an after-change-function to set up parameters of the last change -(defun vip-replace-mode-spy-after (beg end length) - (if (memq vip-intermediate-command '(repeating-insertion-from-ring)) - (progn - (setq vip-replace-chars-to-delete 0) - (vip-move-marker-locally - 'vip-last-posn-in-replace-region (point))) - - (let (beg-col end-col real-end chars-to-delete) - (setq real-end (min end (vip-replace-end))) - (save-excursion - (goto-char beg) - (setq beg-col (current-column)) - (goto-char real-end) - (setq end-col (current-column))) - - ;; If beg of change is outside the replacement region, then don't - ;; delete anything in the repl region (set chars-to-delete to 0). - ;; - ;; This works fine except that we have to take special care of - ;; dabbrev-expand. The problem stems from new-dabbrev.el, which - ;; sometimes simply shifts the repl region rightwards, without - ;; deleting an equal amount of characters. - ;; - ;; The reason why new-dabbrev.el causes this are this: - ;; if one dinamically completes a partial word that starts before the - ;; replacement region (but ends inside) then new-dabbrev.el first - ;; moves cursor backwards, to the beginning of the word to be - ;; completed (say, pt A). Then it inserts the - ;; completed word and then deletes the old, incomplete part. - ;; Since the complete word is inserted at position before the repl - ;; region, the next If-statement would have set chars-to-delete to 0 - ;; unless we check for the current command, which must be - ;; dabbrev-expand. - ;; - ;; In fact, it might be also useful to have overlays for insert - ;; regions as well, since this will let us capture the situation when - ;; dabbrev-expand goes back past the insertion point to find the - ;; beginning of the word to be expanded. - (if (or (and (<= (vip-replace-start) beg) - (<= beg (vip-replace-end))) - (and (= length 0) (eq this-command 'dabbrev-expand))) - (setq chars-to-delete - (max (- end-col beg-col) (- real-end beg) 0)) - (setq chars-to-delete 0)) - - ;; if beg = last change position, it means that we are within the - ;; same command that does multiple changes. Moreover, it means - ;; that we have two subsequent changes (insert/delete) that - ;; complement each other. - (if (= beg (marker-position vip-last-posn-in-replace-region)) - (setq vip-replace-chars-to-delete - (- (+ chars-to-delete vip-replace-chars-to-delete) - vip-replace-chars-deleted)) - (setq vip-replace-chars-to-delete chars-to-delete)) - - (vip-move-marker-locally - 'vip-last-posn-in-replace-region - (max (if (> end (vip-replace-end)) (vip-replace-start) end) - (or (marker-position vip-last-posn-in-replace-region) - (vip-replace-start)) - )) - - (setq vip-replace-chars-to-delete - (max 0 (min vip-replace-chars-to-delete - (- (vip-replace-end) - vip-last-posn-in-replace-region)))) - ))) - - -;; Delete stuff between posn and the end of vip-replace-overlay-marker, if -;; posn is within the overlay. -(defun vip-finish-change (posn) - (vip-remove-hook 'vip-after-change-functions 'vip-replace-mode-spy-after) - (vip-remove-hook 'vip-before-change-functions 'vip-replace-mode-spy-before) - (vip-remove-hook 'vip-post-command-hooks - 'vip-replace-state-post-command-sentinel) - (vip-remove-hook - 'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel) - (vip-restore-cursor-color-after-replace) - (setq vip-sitting-in-replace nil) ; just in case we'll need to know it - (save-excursion - (if (and - vip-replace-overlay - (>= posn (vip-replace-start)) - (< posn (vip-replace-end))) - (delete-region posn (vip-replace-end))) - ) - - (if (eq vip-current-state 'replace-state) - (vip-downgrade-to-insert)) - ;; replace mode ended => nullify vip-last-posn-in-replace-region - (vip-move-marker-locally 'vip-last-posn-in-replace-region nil) - (vip-hide-replace-overlay) - (vip-refresh-mode-line) - (vip-put-string-on-kill-ring vip-last-replace-region) - ) - -;; Make STRING be the first element of the kill ring. -(defun vip-put-string-on-kill-ring (string) - (setq kill-ring (cons string kill-ring)) - (if (> (length kill-ring) kill-ring-max) - (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)) - (setq kill-ring-yank-pointer kill-ring)) - -(defun vip-finish-R-mode () - (vip-remove-hook 'vip-post-command-hooks 'vip-R-state-post-command-sentinel) - (vip-remove-hook - 'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel) - (vip-downgrade-to-insert)) - -(defun vip-start-R-mode () - ;; Leave arg as 1, not t: XEmacs insists that it must be a pos number - (overwrite-mode 1) - (vip-add-hook - 'vip-post-command-hooks 'vip-R-state-post-command-sentinel t) - (vip-add-hook - 'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel t) - ) - - - -(defun vip-replace-state-exit-cmd () - "Binding for keys that cause Replace state to switch to Vi or to Insert. -These keys are ESC, RET, and LineFeed" - (interactive) - (if overwrite-mode ;; If you are in replace mode invoked via 'R' - (vip-finish-R-mode) - (vip-finish-change vip-last-posn-in-replace-region)) - (let (com) - (if (eq this-command 'vip-intercept-ESC-key) - (setq com 'vip-exit-insert-state) - (vip-set-unread-command-events last-input-char) - (setq com (key-binding (read-key-sequence nil)))) - - (condition-case conds - (command-execute com) - (error - (vip-message-conditions conds))) - ) - (vip-hide-replace-overlay)) - - -;; This is the function bound to 'R'---unlimited replace. -;; Similar to Emacs's own overwrite-mode. -(defun vip-overwrite (arg) - "Begin overwrite mode." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg)) (len)) - (vip-set-destructive-command (list 'vip-overwrite val ?r nil nil nil)) - (if com - (progn - ;; Viper saves inserted text in vip-last-insertion - (setq len (length vip-last-insertion)) - (delete-char len) - (vip-loop val (vip-yank-last-insertion))) - (setq last-command 'vip-overwrite) - (vip-set-complex-command-for-undo) - (vip-set-replace-overlay (point) (vip-line-pos 'end)) - (vip-change-state-to-replace) - ))) - - -;; line commands - -(defun vip-line (arg) - (let ((val (car arg)) - (com (cdr arg))) - (vip-move-marker-locally 'vip-com-point (point)) - (if (not (eobp)) - (vip-next-line-carefully (1- val))) - ;; this ensures that dd, cc, D, yy will do the right thing on the last - ;; line of buffer when this line has no \n. - (vip-add-newline-at-eob-if-necessary) - (vip-execute-com 'vip-line val com)) - (if (and (eobp) (not (bobp))) (forward-line -1)) - ) - -(defun vip-yank-line (arg) - "Yank ARG lines (in Vi's sense)." - (interactive "P") - (let ((val (vip-p-val arg))) - (vip-line (cons val ?Y)))) - - -;; region commands - -(defun vip-region (arg) - "Execute command on a region." - (interactive "P") - (let ((val (vip-P-val arg)) - (com (vip-getcom arg))) - (vip-move-marker-locally 'vip-com-point (point)) - (exchange-point-and-mark) - (vip-execute-com 'vip-region val com))) - -(defun vip-Region (arg) - "Execute command on a Region." - (interactive "P") - (let ((val (vip-P-val arg)) - (com (vip-getCom arg))) - (vip-move-marker-locally 'vip-com-point (point)) - (exchange-point-and-mark) - (vip-execute-com 'vip-Region val com))) - -(defun vip-replace-char (arg) - "Replace the following ARG chars by the character read." - (interactive "P") - (if (and (eolp) (bolp)) (error "No character to replace here")) - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (vip-replace-char-subr com val) - (if (and (eolp) (not (bolp))) (forward-char 1)) - (vip-set-destructive-command - (list 'vip-replace-char val ?r nil vip-d-char nil)) - )) - -(defun vip-replace-char-subr (com arg) - (let ((take-care-of-iso-accents - (and (boundp 'iso-accents-mode) vip-automatic-iso-accents)) - char) - (setq char (if (equal com ?r) - vip-d-char - (read-char))) - (if (and take-care-of-iso-accents (memq char '(?' ?\" ?^ ?~))) - ;; get European characters - (progn - (iso-accents-mode 1) - (vip-set-unread-command-events char) - (setq char (aref (read-key-sequence nil) 0)) - (iso-accents-mode -1))) - (delete-char arg t) - (setq vip-d-char char) - (vip-loop (if (> arg 0) arg (- arg)) - (if (eq char ?\C-m) (insert "\n") (insert char))) - (backward-char arg))) - - -;; basic cursor movement. j, k, l, h commands. - -(defun vip-forward-char (arg) - "Move point right ARG characters (left if ARG negative). -On reaching end of line, stop and signal error." - (interactive "P") - (vip-leave-region-active) - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (if vip-ex-style-motion - (progn - ;; the boundary condition check gets weird here because - ;; forward-char may be the parameter of a delete, and 'dl' works - ;; just like 'x' for the last char on a line, so we have to allow - ;; the forward motion before the 'vip-execute-com', but, of - ;; course, 'dl' doesn't work on an empty line, so we have to - ;; catch that condition before 'vip-execute-com' - (if (and (eolp) (bolp)) (error "") (forward-char val)) - (if com (vip-execute-com 'vip-forward-char val com)) - (if (eolp) (progn (backward-char 1) (error "")))) - (forward-char val) - (if com (vip-execute-com 'vip-forward-char val com))))) - -(defun vip-backward-char (arg) - "Move point left ARG characters (right if ARG negative). -On reaching beginning of line, stop and signal error." - (interactive "P") - (vip-leave-region-active) - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (if vip-ex-style-motion - (progn - (if (bolp) (error "") (backward-char val)) - (if com (vip-execute-com 'vip-backward-char val com))) - (backward-char val) - (if com (vip-execute-com 'vip-backward-char val com))))) - -;; Like forward-char, but doesn't move at end of buffer. -(defun vip-forward-char-carefully (&optional arg) - (setq arg (or arg 1)) - (if (>= (point-max) (+ (point) arg)) - (forward-char arg) - (goto-char (point-max)))) - -;; Like backward-char, but doesn't move at end of buffer. -(defun vip-backward-char-carefully (&optional arg) - (setq arg (or arg 1)) - (if (<= (point-min) (- (point) arg)) - (backward-char arg) - (goto-char (point-min)))) - -(defun vip-next-line-carefully (arg) - (condition-case nil - (next-line arg) - (error nil))) - - - -;;; Word command - -;; Words are formed from alpha's and nonalphas - <sp>,\t\n are separators -;; for word movement. When executed with a destructive command, \n is -;; usually left untouched for the last word. -;; Viper uses syntax table to determine what is a word and what is a -;; separator. However, \n is always a separator. Also, if vip-syntax-preference -;; is 'vi, then `_' is part of the word. - -;; skip only one \n -(defun vip-skip-separators (forward) - (if forward - (progn - (vip-skip-all-separators-forward 'within-line) - (if (looking-at "\n") - (progn - (forward-char) - (vip-skip-all-separators-forward 'within-line)))) - (vip-skip-all-separators-backward 'within-line) - (backward-char) - (if (looking-at "\n") - (vip-skip-all-separators-backward 'within-line) - (forward-char)))) - -(defun vip-forward-word-kernel (val) - (while (> val 0) - (cond ((vip-looking-at-alpha) - (vip-skip-alpha-forward "_") - (vip-skip-separators t)) - ((vip-looking-at-separator) - (vip-skip-separators t)) - ((not (vip-looking-at-alphasep)) - (vip-skip-nonalphasep-forward) - (vip-skip-separators t))) - (setq val (1- val)))) - -;; first search backward for pat. Then skip chars backwards using aux-pat -(defun vip-fwd-skip (pat aux-pat lim) - (if (and (save-excursion - (re-search-backward pat lim t)) - (= (point) (match-end 0))) - (goto-char (match-beginning 0))) - (skip-chars-backward aux-pat lim) - (if (= (point) lim) - (vip-forward-char-carefully)) - ) - - -(defun vip-forward-word (arg) - "Forward word." - (interactive "P") - (vip-leave-region-active) - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (vip-forward-word-kernel val) - (if com (progn - (cond ((memq com (list ?c (- ?c))) - (vip-fwd-skip "\n[ \t]*" " \t" vip-com-point)) - ;; Yank words including the whitespace, but not newline - ((memq com (list ?y (- ?y))) - (vip-fwd-skip "\n[ \t]*" "" vip-com-point)) - ((vip-dotable-command-p com) - (vip-fwd-skip "\n[ \t]*" "" vip-com-point))) - (vip-execute-com 'vip-forward-word val com))))) - - -(defun vip-forward-Word (arg) - "Forward word delimited by white characters." - (interactive "P") - (vip-leave-region-active) - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (vip-loop val - (progn - (vip-skip-nonseparators 'forward) - (vip-skip-separators t))) - (if com (progn - (cond ((memq com (list ?c (- ?c))) - (vip-fwd-skip "\n[ \t]*" " \t" vip-com-point)) - ;; Yank words including the whitespace, but not newline - ((memq com (list ?y (- ?y))) - (vip-fwd-skip "\n[ \t]*" "" vip-com-point)) - ((vip-dotable-command-p com) - (vip-fwd-skip "\n[ \t]*" "" vip-com-point))) - (vip-execute-com 'vip-forward-Word val com))))) - - -;; this is a bit different from Vi, but Vi's end of word -;; makes no sense whatsoever -(defun vip-end-of-word-kernel () - (if (vip-end-of-word-p) (forward-char)) - (if (vip-looking-at-separator) - (vip-skip-all-separators-forward)) - - (cond ((vip-looking-at-alpha) (vip-skip-alpha-forward "_")) - ((not (vip-looking-at-alphasep)) (vip-skip-nonalphasep-forward))) - (vip-backward-char-carefully)) - -(defun vip-end-of-word-p () - (or (eobp) - (save-excursion - (cond ((vip-looking-at-alpha) - (forward-char) - (not (vip-looking-at-alpha))) - ((not (vip-looking-at-alphasep)) - (forward-char) - (vip-looking-at-alphasep)))))) - - -(defun vip-end-of-word (arg &optional careful) - "Move point to end of current word." - (interactive "P") - (vip-leave-region-active) - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (vip-loop val (vip-end-of-word-kernel)) - (if com - (progn - (forward-char) - (vip-execute-com 'vip-end-of-word val com))))) - -(defun vip-end-of-Word (arg) - "Forward to end of word delimited by white character." - (interactive "P") - (vip-leave-region-active) - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (vip-loop val - (progn - (vip-end-of-word-kernel) - (vip-skip-nonseparators 'forward) - (backward-char))) - (if com - (progn - (forward-char) - (vip-execute-com 'vip-end-of-Word val com))))) - -(defun vip-backward-word-kernel (val) - (while (> val 0) - (backward-char) - (cond ((vip-looking-at-alpha) - (vip-skip-alpha-backward "_")) - ((vip-looking-at-separator) - (forward-char) - (vip-skip-separators nil) - (backward-char) - (cond ((vip-looking-at-alpha) - (vip-skip-alpha-backward "_")) - ((not (vip-looking-at-alphasep)) - (vip-skip-nonalphasep-backward)) - (t (forward-char)))) - ((not (vip-looking-at-alphasep)) - (vip-skip-nonalphasep-backward))) - (setq val (1- val)))) - -(defun vip-backward-word (arg) - "Backward word." - (interactive "P") - (vip-leave-region-active) - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com - (let (i) - (if (setq i (save-excursion (backward-char) (looking-at "\n"))) - (backward-char)) - (vip-move-marker-locally 'vip-com-point (point)) - (if i (forward-char)))) - (vip-backward-word-kernel val) - (if com (vip-execute-com 'vip-backward-word val com)))) - -(defun vip-backward-Word (arg) - "Backward word delimited by white character." - (interactive "P") - (vip-leave-region-active) - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com - (let (i) - (if (setq i (save-excursion (backward-char) (looking-at "\n"))) - (backward-char)) - (vip-move-marker-locally 'vip-com-point (point)) - (if i (forward-char)))) - (vip-loop val - (progn - (vip-skip-separators nil) - (vip-skip-nonseparators 'backward))) - (if com (vip-execute-com 'vip-backward-Word val com)))) - - - -;; line commands - -(defun vip-beginning-of-line (arg) - "Go to beginning of line." - (interactive "P") - (vip-leave-region-active) - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (beginning-of-line val) - (if com (vip-execute-com 'vip-beginning-of-line val com)))) - -(defun vip-bol-and-skip-white (arg) - "Beginning of line at first non-white character." - (interactive "P") - (vip-leave-region-active) - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (forward-to-indentation (1- val)) - (if com (vip-execute-com 'vip-bol-and-skip-white val com)))) - -(defun vip-goto-eol (arg) - "Go to end of line." - (interactive "P") - (vip-leave-region-active) - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (end-of-line val) - (if com (vip-execute-com 'vip-goto-eol val com)) - (if vip-ex-style-motion - (if (and (eolp) (not (bolp)) - ;; a fix for vip-change-to-eol - (not (equal vip-current-state 'insert-state))) - (backward-char 1) - )))) - - -(defun vip-goto-col (arg) - "Go to ARG's column." - (interactive "P") - (vip-leave-region-active) - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (save-excursion - (end-of-line) - (if (> val (1+ (current-column))) (error ""))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (beginning-of-line) - (forward-char (1- val)) - (if com (vip-execute-com 'vip-goto-col val com)))) - - -(defun vip-next-line (arg) - "Go to next line." - (interactive "P") - (vip-leave-region-active) - (let ((val (vip-p-val arg)) - (com (vip-getCom arg))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (next-line val) - (if vip-ex-style-motion - (if (and (eolp) (not (bolp))) (backward-char 1))) - (setq this-command 'next-line) - (if com (vip-execute-com 'vip-next-line val com)))) - -(defun vip-next-line-at-bol (arg) - "Next line at beginning of line." - (interactive "P") - (vip-leave-region-active) - (save-excursion - (end-of-line) - (if (eobp) (error "Last line in buffer"))) - (let ((val (vip-p-val arg)) - (com (vip-getCom arg))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (forward-line val) - (back-to-indentation) - (if com (vip-execute-com 'vip-next-line-at-bol val com)))) - -(defun vip-previous-line (arg) - "Go to previous line." - (interactive "P") - (vip-leave-region-active) - (let ((val (vip-p-val arg)) - (com (vip-getCom arg))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (previous-line val) - (if vip-ex-style-motion - (if (and (eolp) (not (bolp))) (backward-char 1))) - (setq this-command 'previous-line) - (if com (vip-execute-com 'vip-previous-line val com)))) - - -(defun vip-previous-line-at-bol (arg) - "Previous line at beginning of line." - (interactive "P") - (vip-leave-region-active) - (save-excursion - (beginning-of-line) - (if (bobp) (error "First line in buffer"))) - (let ((val (vip-p-val arg)) - (com (vip-getCom arg))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (forward-line (- val)) - (back-to-indentation) - (if com (vip-execute-com 'vip-previous-line val com)))) - -(defun vip-change-to-eol (arg) - "Change to end of line." - (interactive "P") - (vip-goto-eol (cons arg ?c))) - -(defun vip-kill-line (arg) - "Delete line." - (interactive "P") - (vip-goto-eol (cons arg ?d))) - -(defun vip-erase-line (arg) - "Erase line." - (interactive "P") - (vip-beginning-of-line (cons arg ?d))) - - -;;; Moving around - -(defun vip-goto-line (arg) - "Go to ARG's line. Without ARG go to end of buffer." - (interactive "P") - (let ((val (vip-P-val arg)) - (com (vip-getCom arg))) - (vip-move-marker-locally 'vip-com-point (point)) - (vip-deactivate-mark) - (push-mark nil t) - (if (null val) - (goto-char (point-max)) - (goto-char (point-min)) - (forward-line (1- val))) - - ;; positioning is done twice: before and after command execution - (if (and (eobp) (bolp) (not (bobp))) (forward-line -1)) - (back-to-indentation) - - (if com (vip-execute-com 'vip-goto-line val com)) - - (if (and (eobp) (bolp) (not (bobp))) (forward-line -1)) - (back-to-indentation) - )) - -;; Find ARG's occurrence of CHAR on the current line. -;; If FORWARD then search is forward, otherwise backward. OFFSET is used to -;; adjust point after search. -(defun vip-find-char (arg char forward offset) - (or (char-or-string-p char) (error "")) - (let ((arg (if forward arg (- arg))) - (cmd (if (eq vip-intermediate-command 'vip-repeat) - (nth 5 vip-d-com) - (vip-array-to-string (this-command-keys)))) - point) - (save-excursion - (save-restriction - (if (> arg 0) - (narrow-to-region - ;; forward search begins here - (if (eolp) (error "Command `%s': At end of line" cmd) (point)) - ;; forward search ends here - (progn (end-of-line) (point))) - (narrow-to-region - ;; backward search begins from here - (if (bolp) - (error "Command `%s': At beginning of line" cmd) (point)) - ;; backward search ends here - (progn (beginning-of-line) (point)))) - ;; if arg > 0, point is forwarded before search. - (if (> arg 0) (goto-char (1+ (point-min))) - (goto-char (point-max))) - (if (let ((case-fold-search nil)) - (search-forward (char-to-string char) nil 0 arg)) - (setq point (point)) - (error "Command `%s': `%c' not found" cmd char)))) - (goto-char (+ point (if (> arg 0) (if offset -2 -1) (if offset 1 0)))))) - -(defun vip-find-char-forward (arg) - "Find char on the line. -If called interactively read the char to find from the terminal, and if -called from vip-repeat, the char last used is used. This behaviour is -controlled by the sign of prefix numeric value." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg)) - (cmd-representation (nth 5 vip-d-com))) - (if (> val 0) - ;; this means that the function was called interactively - (setq vip-f-char (read-char) - vip-f-forward t - vip-f-offset nil) - ;; vip-repeat --- set vip-F-char from command-keys - (setq vip-F-char (if (stringp cmd-representation) - (vip-seq-last-elt cmd-representation) - vip-F-char) - vip-f-char vip-F-char) - (setq val (- val))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t nil) - (setq val (- val)) - (if com - (progn - (setq vip-F-char vip-f-char) ; set new vip-F-char - (forward-char) - (vip-execute-com 'vip-find-char-forward val com))))) - -(defun vip-goto-char-forward (arg) - "Go up to char ARG forward on line." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg)) - (cmd-representation (nth 5 vip-d-com))) - (if (> val 0) - ;; this means that the function was called interactively - (setq vip-f-char (read-char) - vip-f-forward t - vip-f-offset t) - ;; vip-repeat --- set vip-F-char from command-keys - (setq vip-F-char (if (stringp cmd-representation) - (vip-seq-last-elt cmd-representation) - vip-F-char) - vip-f-char vip-F-char) - (setq val (- val))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t t) - (setq val (- val)) - (if com - (progn - (setq vip-F-char vip-f-char) ; set new vip-F-char - (forward-char) - (vip-execute-com 'vip-goto-char-forward val com))))) - -(defun vip-find-char-backward (arg) - "Find char ARG on line backward." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg)) - (cmd-representation (nth 5 vip-d-com))) - (if (> val 0) - ;; this means that the function was called interactively - (setq vip-f-char (read-char) - vip-f-forward nil - vip-f-offset nil) - ;; vip-repeat --- set vip-F-char from command-keys - (setq vip-F-char (if (stringp cmd-representation) - (vip-seq-last-elt cmd-representation) - vip-F-char) - vip-f-char vip-F-char) - (setq val (- val))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (vip-find-char - val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil nil) - (setq val (- val)) - (if com - (progn - (setq vip-F-char vip-f-char) ; set new vip-F-char - (vip-execute-com 'vip-find-char-backward val com))))) - -(defun vip-goto-char-backward (arg) - "Go up to char ARG backward on line." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg)) - (cmd-representation (nth 5 vip-d-com))) - (if (> val 0) - ;; this means that the function was called interactively - (setq vip-f-char (read-char) - vip-f-forward nil - vip-f-offset t) - ;; vip-repeat --- set vip-F-char from command-keys - (setq vip-F-char (if (stringp cmd-representation) - (vip-seq-last-elt cmd-representation) - vip-F-char) - vip-f-char vip-F-char) - (setq val (- val))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil t) - (setq val (- val)) - (if com - (progn - (setq vip-F-char vip-f-char) ; set new vip-F-char - (vip-execute-com 'vip-goto-char-backward val com))))) - -(defun vip-repeat-find (arg) - "Repeat previous find command." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (vip-deactivate-mark) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (vip-find-char val vip-f-char vip-f-forward vip-f-offset) - (if com - (progn - (if vip-f-forward (forward-char)) - (vip-execute-com 'vip-repeat-find val com))))) - -(defun vip-repeat-find-opposite (arg) - "Repeat previous find command in the opposite direction." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (vip-deactivate-mark) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (vip-find-char val vip-f-char (not vip-f-forward) vip-f-offset) - (if com - (progn - (if vip-f-forward (forward-char)) - (vip-execute-com 'vip-repeat-find-opposite val com))))) - - -;; window scrolling etc. - -(defun vip-other-window (arg) - "Switch to other window." - (interactive "p") - (other-window arg) - (or (not (eq vip-current-state 'emacs-state)) - (string= (buffer-name (current-buffer)) " *Minibuf-1*") - (vip-change-state-to-vi))) - -(defun vip-window-top (arg) - "Go to home window line." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getCom arg))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (push-mark nil t) - (move-to-window-line (1- val)) - - ;; positioning is done twice: before and after command execution - (if (and (eobp) (bolp) (not (bobp))) (forward-line -1)) - (back-to-indentation) - - (if com (vip-execute-com 'vip-window-top val com)) - - (if (and (eobp) (bolp) (not (bobp))) (forward-line -1)) - (back-to-indentation) - )) - -(defun vip-window-middle (arg) - "Go to middle window line." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getCom arg)) - lines) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (push-mark nil t) - (if (not (pos-visible-in-window-p (point-max))) - (move-to-window-line (+ (/ (1- (window-height)) 2) (1- val))) - (setq lines (count-lines (window-start) (point-max))) - (move-to-window-line (+ (/ lines 2) (1- val)))) - - ;; positioning is done twice: before and after command execution - (if (and (eobp) (bolp) (not (bobp))) (forward-line -1)) - (back-to-indentation) - - (if com (vip-execute-com 'vip-window-middle val com)) - - (if (and (eobp) (bolp) (not (bobp))) (forward-line -1)) - (back-to-indentation) - )) - -(defun vip-window-bottom (arg) - "Go to last window line." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getCom arg))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (push-mark nil t) - (move-to-window-line (- val)) - - ;; positioning is done twice: before and after command execution - (if (and (eobp) (bolp) (not (bobp))) (forward-line -1)) - (back-to-indentation) - - (if com (vip-execute-com 'vip-window-bottom val com)) - - (if (and (eobp) (bolp) (not (bobp))) (forward-line -1)) - (back-to-indentation) - )) - -(defun vip-line-to-top (arg) - "Put current line on the home line." - (interactive "p") - (recenter (1- arg))) - -(defun vip-line-to-middle (arg) - "Put current line on the middle line." - (interactive "p") - (recenter (+ (1- arg) (/ (1- (window-height)) 2)))) - -(defun vip-line-to-bottom (arg) - "Put current line on the last line." - (interactive "p") - (recenter (- (window-height) (1+ arg)))) - -;; If vip-adjust-window-after-search is t, scroll up or down 1/4 of window -;; height, depending on whether we are at the bottom or at the top of the -;; window. This function is called by vip-search (which is called from -;; vip-search-forward/backward/next) -(defun vip-adjust-window () - (let ((win-height (if vip-emacs-p - (1- (window-height)) ; adjust for modeline - (window-displayed-height))) - (pt (point)) - at-top-p at-bottom-p - min-scroll direction) - (save-excursion - (move-to-window-line 0) ; top - (setq at-top-p (<= (count-lines pt (point)) 2)) - (move-to-window-line -1) ; bottom - (setq at-bottom-p (<= (count-lines pt (point)) 2)) - ) - (cond (at-top-p (setq min-scroll 1 - direction 1)) - (at-bottom-p (setq min-scroll 2 - direction -1))) - (if (and vip-adjust-window-after-search min-scroll) - (recenter - (* (max min-scroll (/ win-height 7)) direction))) - )) - - -;; paren match -;; must correct this to only match ( to ) etc. On the other hand -;; it is good that paren match gets confused, because that way you -;; catch _all_ imbalances. - -(defun vip-paren-match (arg) - "Go to the matching parenthesis." - (interactive "P") - (vip-leave-region-active) - (let ((com (vip-getcom arg)) - parse-sexp-ignore-comments anchor-point) - (if (integerp arg) - (if (or (> arg 99) (< arg 1)) - (error "Prefix must be between 1 and 99") - (goto-char - (if (> (point-max) 80000) - (* (/ (point-max) 100) arg) - (/ (* (point-max) arg) 100))) - (back-to-indentation)) - (let (beg-lim end-lim) - (if (and (eolp) (not (bolp))) (forward-char -1)) - (if (not (looking-at "[][(){}]")) - (setq anchor-point (point))) - (save-excursion - (beginning-of-line) - (setq beg-lim (point)) - (end-of-line) - (setq end-lim (point))) - (cond ((re-search-forward "[][(){}]" end-lim t) - (backward-char) ) - ((re-search-backward "[][(){}]" beg-lim t)) - (t - (error "No matching character on line")))) - (cond ((looking-at "[\(\[{]") - (if com (vip-move-marker-locally 'vip-com-point (point))) - (forward-sexp 1) - (if com - (vip-execute-com 'vip-paren-match nil com) - (backward-char))) - (anchor-point - (if com - (progn - (vip-move-marker-locally 'vip-com-point anchor-point) - (forward-char 1) - (vip-execute-com 'vip-paren-match nil com) - ))) - ((looking-at "[])}]") - (forward-char) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (backward-sexp 1) - (if com (vip-execute-com 'vip-paren-match nil com))) - (t (error "")))))) - - -;; sentence ,paragraph and heading - -(defun vip-forward-sentence (arg) - "Forward sentence." - (interactive "P") - (push-mark nil t) - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (forward-sentence val) - (if com (vip-execute-com 'vip-forward-sentence nil com)))) - -(defun vip-backward-sentence (arg) - "Backward sentence." - (interactive "P") - (push-mark nil t) - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (backward-sentence val) - (if com (vip-execute-com 'vip-backward-sentence nil com)))) - -(defun vip-forward-paragraph (arg) - "Forward paragraph." - (interactive "P") - (push-mark nil t) - (let ((val (vip-p-val arg)) - (com (vip-getCom arg))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (forward-paragraph val) - (if com - (progn - (backward-char 1) - (vip-execute-com 'vip-forward-paragraph nil com))))) - -(defun vip-backward-paragraph (arg) - "Backward paragraph." - (interactive "P") - (push-mark nil t) - (let ((val (vip-p-val arg)) - (com (vip-getCom arg))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (backward-paragraph val) - (if com - (progn - (forward-char 1) - (vip-execute-com 'vip-backward-paragraph nil com) - (backward-char 1))))) - -;; should be mode-specific etc. - -(defun vip-prev-heading (arg) - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getCom arg))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (re-search-backward vip-heading-start nil t val) - (goto-char (match-beginning 0)) - (if com (vip-execute-com 'vip-prev-heading nil com)))) - -(defun vip-heading-end (arg) - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getCom arg))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (re-search-forward vip-heading-end nil t val) - (goto-char (match-beginning 0)) - (if com (vip-execute-com 'vip-heading-end nil com)))) - -(defun vip-next-heading (arg) - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getCom arg))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (end-of-line) - (re-search-forward vip-heading-start nil t val) - (goto-char (match-beginning 0)) - (if com (vip-execute-com 'vip-next-heading nil com)))) - - -;; scrolling - -(setq scroll-step 1) - -(defun vip-scroll-screen (arg) - "Scroll to next screen." - (interactive "p") - (condition-case nil - (if (> arg 0) - (while (> arg 0) - (scroll-up) - (setq arg (1- arg))) - (while (> 0 arg) - (scroll-down) - (setq arg (1+ arg)))) - (error (beep 1) - (if (> arg 0) - (progn - (message "End of buffer") - (goto-char (point-max))) - (message "Beginning of buffer") - (goto-char (point-min)))) - )) - -(defun vip-scroll-screen-back (arg) - "Scroll to previous screen." - (interactive "p") - (vip-scroll-screen (- arg))) - -(defun vip-scroll-down (arg) - "Pull down half screen." - (interactive "P") - (condition-case nil - (if (null arg) - (scroll-down (/ (window-height) 2)) - (scroll-down arg)) - (error (beep 1) - (message "Beginning of buffer") - (goto-char (point-min))))) - -(defun vip-scroll-down-one (arg) - "Scroll up one line." - (interactive "p") - (scroll-down arg)) - -(defun vip-scroll-up (arg) - "Pull up half screen." - (interactive "P") - (condition-case nil - (if (null arg) - (scroll-up (/ (window-height) 2)) - (scroll-up arg)) - (error (beep 1) - (message "End of buffer") - (goto-char (point-max))))) - -(defun vip-scroll-up-one (arg) - "Scroll down one line." - (interactive "p") - (scroll-up arg)) - - -;; searching - -(defun vip-if-string (prompt) - (let ((s (vip-read-string-with-history - prompt - nil ; no initial - 'vip-search-history - (car vip-search-history)))) - (if (not (string= s "")) - (setq vip-s-string s)))) - - -(defun vip-toggle-search-style (arg) - "Toggle the value of vip-case-fold-search/vip-re-search. -Without prefix argument, will ask which search style to toggle. With prefix -arg 1,toggles vip-case-fold-search; with arg 2 toggles vip-re-search. - -Although this function is bound to \\[vip-toggle-search-style], the most -convenient way to use it is to bind `//' to the macro -`1 M-x vip-toggle-search-style' and `///' to -`2 M-x vip-toggle-search-style'. In this way, hitting `//' quickly will -toggle case-fold-search and hitting `/' three times witth toggle regexp -search. Macros are more convenient in this case because they don't affect -the Emacs binding of `/'." - (interactive "P") - (let (msg) - (cond ((or (eq arg 1) - (and (null arg) - (y-or-n-p (format "Search style: '%s'. Want '%s'? " - (if vip-case-fold-search - "case-insensitive" "case-sensitive") - (if vip-case-fold-search - "case-sensitive" - "case-insensitive"))))) - (setq vip-case-fold-search (null vip-case-fold-search)) - (if vip-case-fold-search - (setq msg "Search becomes case-insensitive") - (setq msg "Search becomes case-sensitive"))) - ((or (eq arg 2) - (and (null arg) - (y-or-n-p (format "Search style: '%s'. Want '%s'? " - (if vip-re-search - "regexp-search" "vanilla-search") - (if vip-re-search - "vanilla-search" - "regexp-search"))))) - (setq vip-re-search (null vip-re-search)) - (if vip-re-search - (setq msg "Search becomes regexp-style") - (setq msg "Search becomes vanilla-style"))) - (t - (setq msg "Search style remains unchanged"))) - (prin1 msg t))) - -(defun vip-set-vi-search-style-macros (unset) - "Set the macros for toggling the search style in Viper's vi-state. -The macro that toggles case sensitivity is bound to `//', and the one that -toggles regexp search is bound to `///'. -With a prefix argument, this function unsets the macros. " - (interactive "P") - (or noninteractive - (if (not unset) - (progn - ;; toggle case sensitivity in search - (vip-record-kbd-macro - "//" 'vi-state - [1 (meta x) v i p - t o g g l e - s e a r c h - s t y l e return] - 't) - ;; toggle regexp/vanila search - (vip-record-kbd-macro - "///" 'vi-state - [2 (meta x) v i p - t o g g l e - s e a r c h - s t y l e return] - 't) - (if (interactive-p) - (message - "// and /// now toggle case-sensitivity and regexp search."))) - (vip-unrecord-kbd-macro "//" 'vi-state) - (sit-for 2) - (vip-unrecord-kbd-macro "///" 'vi-state)))) - -(defun vip-set-emacs-search-style-macros (unset &optional arg-majormode) - "Set the macros for toggling the search style in Viper's emacs-state. -The macro that toggles case sensitivity is bound to `//', and the one that -toggles regexp search is bound to `///'. -With a prefix argument, this function unsets the macros. -If the optional prefix argument is non-nil and specifies a valid major mode, -this sets the macros only in the macros in that major mode. Otherwise, -the macros are set in the current major mode. -\(When unsetting the macros, the second argument has no effect.\)" - (interactive "P") - (or noninteractive - (if (not unset) - (progn - ;; toggle case sensitivity in search - (vip-record-kbd-macro - "//" 'emacs-state - [1 (meta x) v i p - t o g g l e - s e a r c h - s t y l e return] - (or arg-majormode major-mode)) - ;; toggle regexp/vanila search - (vip-record-kbd-macro - "///" 'emacs-state - [2 (meta x) v i p - t o g g l e - s e a r c h - s t y l e return] - (or arg-majormode major-mode)) - (if (interactive-p) - (message - "// and /// now toggle case-sensitivity and regexp search."))) - (vip-unrecord-kbd-macro "//" 'emacs-state) - (sit-for 2) - (vip-unrecord-kbd-macro "///" 'emacs-state)))) - - -(defun vip-search-forward (arg) - "Search a string forward. -ARG is used to find the ARG's occurrence of the string. -Null string will repeat previous search." - (interactive "P") - (let ((val (vip-P-val arg)) - (com (vip-getcom arg)) - (old-str vip-s-string)) - (setq vip-s-forward t) - (vip-if-string "/") - ;; this is not used at present, but may be used later - (if (or (not (equal old-str vip-s-string)) - (not (markerp vip-local-search-start-marker)) - (not (marker-buffer vip-local-search-start-marker))) - (setq vip-local-search-start-marker (point-marker))) - (vip-search vip-s-string t val) - (if com - (progn - (vip-move-marker-locally 'vip-com-point (mark t)) - (vip-execute-com 'vip-search-next val com))))) - -(defun vip-search-backward (arg) - "Search a string backward. -ARG is used to find the ARG's occurrence of the string. -Null string will repeat previous search." - (interactive "P") - (let ((val (vip-P-val arg)) - (com (vip-getcom arg)) - (old-str vip-s-string)) - (setq vip-s-forward nil) - (vip-if-string "?") - ;; this is not used at present, but may be used later - (if (or (not (equal old-str vip-s-string)) - (not (markerp vip-local-search-start-marker)) - (not (marker-buffer vip-local-search-start-marker))) - (setq vip-local-search-start-marker (point-marker))) - (vip-search vip-s-string nil val) - (if com - (progn - (vip-move-marker-locally 'vip-com-point (mark t)) - (vip-execute-com 'vip-search-next val com))))) - - -;; Search for COUNT's occurrence of STRING. -;; Search is forward if FORWARD is non-nil, otherwise backward. -;; INIT-POINT is the position where search is to start. -;; Arguments: -;; (STRING FORW COUNT &optional NO-OFFSET INIT-POINT LIMIT FAIL-IF-NOT-FOUND) -(defun vip-search (string forward arg - &optional no-offset init-point fail-if-not-found) - (if (not (equal string "")) - (let ((val (vip-p-val arg)) - (com (vip-getcom arg)) - (offset (not no-offset)) - (case-fold-search vip-case-fold-search) - (start-point (or init-point (point)))) - (vip-deactivate-mark) - (if forward - (condition-case nil - (progn - (if offset (vip-forward-char-carefully)) - (if vip-re-search - (progn - (re-search-forward string nil nil val) - (re-search-backward string)) - (search-forward string nil nil val) - (search-backward string)) - (if (not (equal start-point (point))) - (push-mark start-point t))) - (search-failed - (if (and (not fail-if-not-found) vip-search-wrap-around-t) - (progn - (message "Search wrapped around BOTTOM of buffer") - (goto-char (point-min)) - (vip-search string forward (cons 1 com) t start-point 'fail) - ;; don't wait in macros - (or executing-kbd-macro (sit-for 2)) - ;; delete the wrap-around message - (message "") - ) - (goto-char start-point) - (error "`%s': %s not found" - string - (if vip-re-search "Pattern" "String")) - ))) - ;; backward - (condition-case nil - (progn - (if vip-re-search - (re-search-backward string nil nil val) - (search-backward string nil nil val)) - (if (not (equal start-point (point))) - (push-mark start-point t))) - (search-failed - (if (and (not fail-if-not-found) vip-search-wrap-around-t) - (progn - (message "Search wrapped around TOP of buffer") - (goto-char (point-max)) - (vip-search string forward (cons 1 com) t start-point 'fail) - ;; don't wait in macros - (or executing-kbd-macro (sit-for 2)) - ;; delete the wrap-around message - (message "") - ) - (goto-char start-point) - (error "`%s': %s not found" - string - (if vip-re-search "Pattern" "String")) - )))) - ;; pull up or down if at top/bottom of window - (vip-adjust-window) - ;; highlight the result of search - ;; don't wait and don't highlight in macros - (or executing-kbd-macro - (vip-flash-search-pattern)) - ))) - -(defun vip-search-next (arg) - "Repeat previous search." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if (null vip-s-string) (error vip-NoPrevSearch)) - (vip-search vip-s-string vip-s-forward arg) - (if com - (progn - (vip-move-marker-locally 'vip-com-point (mark t)) - (vip-execute-com 'vip-search-next val com))))) - -(defun vip-search-Next (arg) - "Repeat previous search in the reverse direction." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if (null vip-s-string) (error vip-NoPrevSearch)) - (vip-search vip-s-string (not vip-s-forward) arg) - (if com - (progn - (vip-move-marker-locally 'vip-com-point (mark t)) - (vip-execute-com 'vip-search-Next val com))))) - - -;; Search contents of buffer defined by one of Viper's motion commands. -;; Repeatable via `n' and `N'. -(defun vip-buffer-search-enable (&optional c) - (cond (c (setq vip-buffer-search-char c)) - ((null vip-buffer-search-char) - (setq vip-buffer-search-char ?g))) - (define-key vip-vi-basic-map - (char-to-string vip-buffer-search-char) 'vip-command-argument) - (aset vip-exec-array vip-buffer-search-char 'vip-exec-buffer-search) - (setq vip-prefix-commands (cons vip-buffer-search-char vip-prefix-commands))) - -;; This is a Viper wraper for isearch-forward. -(defun vip-isearch-forward (arg) - "Do incremental search forward." - (interactive "P") - ;; emacs bug workaround - (if (listp arg) (setq arg (car arg))) - (vip-exec-form-in-emacs (list 'isearch-forward arg))) - -;; This is a Viper wraper for isearch-backward." -(defun vip-isearch-backward (arg) - "Do incremental search backward." - (interactive "P") - ;; emacs bug workaround - (if (listp arg) (setq arg (car arg))) - (vip-exec-form-in-emacs (list 'isearch-backward arg))) - - -;; visiting and killing files, buffers - -(defun vip-switch-to-buffer () - "Switch to buffer in the current window." - (interactive) - (let (buffer) - (setq buffer - (read-buffer - (format "Switch to buffer in this window \(%s\): " - (buffer-name (other-buffer (current-buffer)))))) - (switch-to-buffer buffer) - )) - -(defun vip-switch-to-buffer-other-window () - "Switch to buffer in another window." - (interactive) - (let (buffer) - (setq buffer - (read-buffer - (format "Switch to buffer in another window \(%s\): " - (buffer-name (other-buffer (current-buffer)))))) - (switch-to-buffer-other-window buffer) - )) - -(defun vip-kill-buffer () - "Kill a buffer." - (interactive) - (let (buffer buffer-name) - (setq buffer-name - (read-buffer - (format "Kill buffer \(%s\): " - (buffer-name (current-buffer))))) - (setq buffer - (if (null buffer-name) - (current-buffer) - (get-buffer buffer-name))) - (if (null buffer) (error "`%s': No such buffer" buffer-name)) - (if (or (not (buffer-modified-p buffer)) - (y-or-n-p - (format - "Buffer `%s' is modified, are you sure you want to kill it? " - buffer-name))) - (kill-buffer buffer) - (error "Buffer not killed")))) - - -(defvar vip-smart-suffix-list '("" "tex" "c" "cc" "el" "p") - "*List of suffixes that Viper automatically tries to append to filenames ending with a `.'. -This is useful when you the current directory contains files with the same -prefix and many different suffixes. Usually, only one of the suffixes -represents an editable file. However, file completion will stop at the `.' -The smart suffix feature lets you hit RET in such a case, and Viper will -select the appropriate suffix. - -Suffixes are tried in the order given and the first suffix for which a -corresponding file exists is selected. If no file exists for any of the -suffixes, the user is asked to confirm. - -To turn this feature off, set this variable to nil.") - -;; Try to add suffix to files ending with a `.' -;; Useful when the user hits RET on a non-completed file name. -(defun vip-file-add-suffix () - (let ((count 0) - (len (length vip-smart-suffix-list)) - (file (buffer-string)) - found key cmd suff) - (goto-char (point-max)) - (if (and vip-smart-suffix-list (string-match "\\.$" file)) - (progn - (while (and (not found) (< count len)) - (setq suff (nth count vip-smart-suffix-list) - count (1+ count)) - (if (file-exists-p (format "%s%s" file suff)) - (progn - (setq found t) - (insert suff)))) - - (if found - () - (vip-tmp-insert-at-eob " [Please complete file name]") - (unwind-protect - (while (not (memq cmd '(exit-minibuffer vip-exit-minibuffer))) - (setq cmd - (key-binding (setq key (read-key-sequence nil)))) - (cond ((eq cmd 'self-insert-command) - (if vip-xemacs-p - (insert (events-to-keys key)) - (insert key))) - ((memq cmd '(exit-minibuffer vip-exit-minibuffer)) - nil) - (t (command-execute cmd))) - ))) - )) - )) - - -;; Advice for use in find-file and read-file-name commands. -(defadvice exit-minibuffer (before vip-exit-minibuffer-advice activate) - "Run `vip-minibuffer-exit-hook' just before exiting the minibuffer." - (run-hooks 'vip-minibuffer-exit-hook)) - -(defadvice find-file (before vip-add-suffix-advice activate) - "Use `read-file-name' for reading arguments." - (interactive (list (read-file-name "Find file: " - nil default-directory)))) - -(defadvice find-file-other-window (before vip-add-suffix-advice activate) - "Use `read-file-name' for reading arguments." - (interactive (list (read-file-name "Find file in other window: " - nil default-directory)))) - -(defadvice find-file-other-frame (before vip-add-suffix-advice activate) - "Use `read-file-name' for reading arguments." - (interactive (list (read-file-name "Find file in other frame: " - nil default-directory)))) - -(defadvice read-file-name (around vip-suffix-advice activate) - "Tell `exit-minibuffer' to run `vip-file-add-suffix' as a hook." - (let ((vip-minibuffer-exit-hook 'vip-file-add-suffix)) - ad-do-it)) - - - -;; yank and pop - -(defsubst vip-yank (text) - "Yank TEXT silently. This works correctly with Emacs's yank-pop command." - (insert text) - (setq this-command 'yank)) - -(defun vip-put-back (arg) - "Put back after point/below line." - (interactive "P") - (let ((val (vip-p-val arg)) - (text (if vip-use-register - (cond ((vip-valid-register vip-use-register '(digit)) - (current-kill (- vip-use-register ?1) 'do-not-rotate)) - ((vip-valid-register vip-use-register) - (get-register (downcase vip-use-register))) - (t (error vip-InvalidRegister vip-use-register))) - (current-kill 0)))) - (if (null text) - (if vip-use-register - (let ((reg vip-use-register)) - (setq vip-use-register nil) - (error vip-EmptyRegister reg)) - (error ""))) - (setq vip-use-register nil) - (if (vip-end-with-a-newline-p text) - (progn - (end-of-line) - (if (eobp) - (insert "\n") - (forward-line 1)) - (beginning-of-line)) - (if (not (eolp)) (vip-forward-char-carefully))) - (set-marker (vip-mark-marker) (point) (current-buffer)) - (vip-set-destructive-command - (list 'vip-put-back val nil vip-use-register nil nil)) - (vip-loop val (vip-yank text))) - ;; Vi puts cursor on the last char when the yanked text doesn't contain a - ;; newline; it leaves the cursor at the beginning when the text contains - ;; a newline - (if (vip-same-line (point) (mark)) - (or (= (point) (mark)) (vip-backward-char-carefully)) - (exchange-point-and-mark) - (if (bolp) - (back-to-indentation))) - (vip-deactivate-mark)) - -(defun vip-Put-back (arg) - "Put back at point/above line." - (interactive "P") - (let ((val (vip-p-val arg)) - (text (if vip-use-register - (cond ((vip-valid-register vip-use-register '(digit)) - (current-kill (- vip-use-register ?1) 'do-not-rotate)) - ((vip-valid-register vip-use-register) - (get-register (downcase vip-use-register))) - (t (error vip-InvalidRegister vip-use-register))) - (current-kill 0)))) - (if (null text) - (if vip-use-register - (let ((reg vip-use-register)) - (setq vip-use-register nil) - (error vip-EmptyRegister reg)) - (error ""))) - (setq vip-use-register nil) - (if (vip-end-with-a-newline-p text) (beginning-of-line)) - (vip-set-destructive-command - (list 'vip-Put-back val nil vip-use-register nil nil)) - (set-marker (vip-mark-marker) (point) (current-buffer)) - (vip-loop val (vip-yank text))) - ;; Vi puts cursor on the last char when the yanked text doesn't contain a - ;; newline; it leaves the cursor at the beginning when the text contains - ;; a newline - (if (vip-same-line (point) (mark)) - (or (= (point) (mark)) (vip-backward-char-carefully)) - (exchange-point-and-mark) - (if (bolp) - (back-to-indentation))) - (vip-deactivate-mark)) - - -;; Copy region to kill-ring. -;; If BEG and END do not belong to the same buffer, copy empty region. -(defun vip-copy-region-as-kill (beg end) - (condition-case nil - (copy-region-as-kill beg end) - (error (copy-region-as-kill beg beg)))) - - -(defun vip-delete-char (arg) - "Delete character." - (interactive "P") - (let ((val (vip-p-val arg))) - (vip-set-destructive-command (list 'vip-delete-char val nil nil nil nil)) - (if (> val 1) - (save-excursion - (let ((here (point))) - (end-of-line) - (if (> val (- (point) here)) - (setq val (- (point) here)))))) - (if (and (eq val 0) (not vip-ex-style-motion)) (setq val 1)) - (if (and vip-ex-style-motion (eolp)) - (if (bolp) (error "") (setq val 0))) ; not bol---simply back 1 ch - (if vip-use-register - (progn - (cond ((vip-valid-register vip-use-register '((Letter))) - (vip-append-to-register - (downcase vip-use-register) (point) (- (point) val))) - ((vip-valid-register vip-use-register) - (copy-to-register - vip-use-register (point) (- (point) val) nil)) - (t (error vip-InvalidRegister vip-use-register))) - (setq vip-use-register nil))) - (if vip-ex-style-motion - (progn - (delete-char val t) - (if (and (eolp) (not (bolp))) (backward-char 1))) - (if (eolp) - (delete-backward-char val t) - (delete-char val t))))) - -(defun vip-delete-backward-char (arg) - "Delete previous character. On reaching beginning of line, stop and beep." - (interactive "P") - (let ((val (vip-p-val arg))) - (vip-set-destructive-command - (list 'vip-delete-backward-char val nil nil nil nil)) - (if (> val 1) - (save-excursion - (let ((here (point))) - (beginning-of-line) - (if (> val (- here (point))) - (setq val (- here (point))))))) - (if vip-use-register - (progn - (cond ((vip-valid-register vip-use-register '(Letter)) - (vip-append-to-register - (downcase vip-use-register) (point) (+ (point) val))) - ((vip-valid-register vip-use-register) - (copy-to-register - vip-use-register (point) (+ (point) val) nil)) - (t (error vip-InvalidRegister vip-use-register))) - (setq vip-use-register nil))) - (if (bolp) (ding) - (delete-backward-char val t)))) - -(defun vip-del-backward-char-in-insert () - "Delete 1 char backwards while in insert mode." - (interactive) - (if (and vip-ex-style-editing-in-insert (bolp)) - (beep 1) - (delete-backward-char 1 t))) - -(defun vip-del-backward-char-in-replace () - "Delete one character in replace mode. -If `vip-delete-backwards-in-replace' is t, then DEL key actually deletes -charecters. If it is nil, then the cursor just moves backwards, similarly -to Vi. The variable `vip-ex-style-editing-in-insert', if t, doesn't let the -cursor move past the beginning of line." - (interactive) - (cond (vip-delete-backwards-in-replace - (cond ((not (bolp)) - (delete-backward-char 1 t)) - (vip-ex-style-editing-in-insert - (beep 1)) - ((bobp) - (beep 1)) - (t - (delete-backward-char 1 t)))) - (vip-ex-style-editing-in-insert - (if (bolp) - (beep 1) - (backward-char 1))) - (t - (backward-char 1)))) - - - -;; join lines. - -(defun vip-join-lines (arg) - "Join this line to next, if ARG is nil. Otherwise, join ARG lines." - (interactive "*P") - (let ((val (vip-P-val arg))) - (vip-set-destructive-command (list 'vip-join-lines val nil nil nil nil)) - (vip-loop (if (null val) 1 (1- val)) - (progn - (end-of-line) - (if (not (eobp)) - (progn - (forward-line 1) - (delete-region (point) (1- (point))) - (fixup-whitespace))))))) - - -;; Replace state - -(defun vip-change (beg end) - (if (markerp beg) (setq beg (marker-position beg))) - (if (markerp end) (setq end (marker-position end))) - ;; beg is sometimes (mark t), which may be nil - (or beg (setq beg end)) - - (vip-set-complex-command-for-undo) - (if vip-use-register - (progn - (copy-to-register vip-use-register beg end nil) - (setq vip-use-register nil))) - (vip-set-replace-overlay beg end) - (setq last-command nil) ; separate repl text from prev kills - - (if (= (vip-replace-start) (point-max)) - (error "End of buffer")) - - (setq vip-last-replace-region - (buffer-substring (vip-replace-start) - (vip-replace-end))) - - ;; protect against error while inserting "@" and other disasters - ;; (e.g., read-only buff) - (condition-case conds - (if (vip-same-line (vip-replace-start) - (vip-replace-end)) - (progn - ;; tabs cause problems in replace, so untabify - (goto-char (vip-replace-end)) - (insert-before-markers "@") ; put placeholder after the TAB - (untabify (vip-replace-start) (point)) - ;; del @, don't put on kill ring - (delete-backward-char 1) - - (vip-set-replace-overlay-glyphs - vip-replace-region-start-delimiter - vip-replace-region-end-delimiter) - ;; this move takes care of the last posn in the overlay, which - ;; has to be shifted because of insert. We can't simply insert - ;; "$" before-markers because then overlay-start will shift the - ;; beginning of the overlay in case we are replacing a single - ;; character. This fixes the bug with `s' and `cl' commands. - (vip-move-replace-overlay (vip-replace-start) (point)) - (goto-char (vip-replace-start)) - (vip-change-state-to-replace t)) - (kill-region (vip-replace-start) - (vip-replace-end)) - (vip-hide-replace-overlay) - (vip-change-state-to-insert)) - (error ;; make sure that the overlay doesn't stay. - ;; go back to the original point - (goto-char (vip-replace-start)) - (vip-hide-replace-overlay) - (vip-message-conditions conds)))) - - -(defun vip-change-subr (beg end) - ;; beg is sometimes (mark t), which may be nil - (or beg (setq beg end)) - - (if vip-use-register - (progn - (copy-to-register vip-use-register beg end nil) - (setq vip-use-register nil))) - (kill-region beg end) - (setq this-command 'vip-change) - (vip-yank-last-insertion)) - -(defun vip-toggle-case (arg) - "Toggle character case." - (interactive "P") - (let ((val (vip-p-val arg)) (c)) - (vip-set-destructive-command (list 'vip-toggle-case val nil nil nil nil)) - (while (> val 0) - (setq c (following-char)) - (delete-char 1 nil) - (if (eq c (upcase c)) - (insert-char (downcase c) 1) - (insert-char (upcase c) 1)) - (if (eolp) (backward-char 1)) - (setq val (1- val))))) - - -;; query replace - -(defun vip-query-replace () - "Query replace. -If a null string is suplied as the string to be replaced, -the query replace mode will toggle between string replace -and regexp replace." - (interactive) - (let (str) - (setq str (vip-read-string-with-history - (if vip-re-query-replace "Query replace regexp: " - "Query replace: ") - nil ; no initial - 'vip-replace1-history - (car vip-replace1-history) ; default - )) - (if (string= str "") - (progn - (setq vip-re-query-replace (not vip-re-query-replace)) - (message "Query replace mode changed to %s" - (if vip-re-query-replace "regexp replace" - "string replace"))) - (if vip-re-query-replace - (query-replace-regexp - str - (vip-read-string-with-history - (format "Query replace regexp `%s' with: " str) - nil ; no initial - 'vip-replace1-history - (car vip-replace1-history) ; default - )) - (query-replace - str - (vip-read-string-with-history - (format "Query replace `%s' with: " str) - nil ; no initial - 'vip-replace1-history - (car vip-replace1-history) ; default - )))))) - - -;; marking - -(defun vip-mark-beginning-of-buffer () - "Mark beginning of buffer." - (interactive) - (push-mark (point)) - (goto-char (point-min)) - (exchange-point-and-mark) - (message "Mark set at the beginning of buffer")) - -(defun vip-mark-end-of-buffer () - "Mark end of buffer." - (interactive) - (push-mark (point)) - (goto-char (point-max)) - (exchange-point-and-mark) - (message "Mark set at the end of buffer")) - -(defun vip-mark-point () - "Set mark at point of buffer." - (interactive) - (let ((char (vip-read-char-exclusive))) - (cond ((and (<= ?a char) (<= char ?z)) - (point-to-register (1+ (- char ?a)))) - ((= char ?<) (vip-mark-beginning-of-buffer)) - ((= char ?>) (vip-mark-end-of-buffer)) - ((= char ?.) (vip-set-mark-if-necessary)) - ((= char ?,) (vip-cycle-through-mark-ring)) - ((= char ?D) (mark-defun)) - (t (error "")) - ))) - -;; Algorithm: If first invocation of this command save mark on ring, goto -;; mark, M0, and pop the most recent elt from the mark ring into mark, -;; making it into the new mark, M1. -;; Push this mark back and set mark to the original point position, p1. -;; So, if you hit '' or `` then you can return to p1. -;; -;; If repeated command, pop top elt from the ring into mark and -;; jump there. This forgets the position, p1, and puts M1 back into mark. -;; Then we save the current pos, which is M0, jump to M1 and pop M2 from -;; the ring into mark. Push M2 back on the ring and set mark to M0. -;; etc. -(defun vip-cycle-through-mark-ring () - "Visit previous locations on the mark ring. -One can use `` and '' to temporarily jump 1 step back." - (let* ((sv-pt (point))) - ;; if repeated `m,' command, pop the previously saved mark. - ;; Prev saved mark is actually prev saved point. It is used if the - ;; user types `` or '' and is discarded - ;; from the mark ring by the next `m,' command. - ;; In any case, go to the previous or previously saved mark. - ;; Then push the current mark (popped off the ring) and set current - ;; point to be the mark. Current pt as mark is discarded by the next - ;; m, command. - (if (eq last-command 'vip-cycle-through-mark-ring) - () - ;; save current mark if the first iteration - (setq mark-ring (delete (vip-mark-marker) mark-ring)) - (if (mark t) - (push-mark (mark t) t)) ) - (pop-mark) - (set-mark-command 1) - ;; don't duplicate mark on the ring - (setq mark-ring (delete (vip-mark-marker) mark-ring)) - (push-mark sv-pt t) - (vip-deactivate-mark) - (setq this-command 'vip-cycle-through-mark-ring) - )) - - -(defun vip-goto-mark (arg) - "Go to mark." - (interactive "P") - (let ((char (read-char)) - (com (vip-getcom arg))) - (vip-goto-mark-subr char com nil))) - -(defun vip-goto-mark-and-skip-white (arg) - "Go to mark and skip to first non-white character on line." - (interactive "P") - (let ((char (read-char)) - (com (vip-getCom arg))) - (vip-goto-mark-subr char com t))) - -(defun vip-goto-mark-subr (char com skip-white) - (if (eobp) - (if (bobp) - (error "Empty buffer") - (backward-char 1))) - (cond ((vip-valid-register char '(letter)) - (let* ((buff (current-buffer)) - (reg (1+ (- char ?a))) - (text-marker (get-register reg))) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (if (not (vip-valid-marker text-marker)) - (error vip-EmptyTextmarker char)) - (if (and (vip-same-line (point) vip-last-jump) - (= (point) vip-last-jump-ignore)) - (push-mark vip-last-jump t) - (push-mark nil t)) ; no msg - (vip-register-to-point reg) - (setq vip-last-jump (point-marker)) - (cond (skip-white - (back-to-indentation) - (setq vip-last-jump-ignore (point)))) - (if com - (if (equal buff (current-buffer)) - (vip-execute-com (if skip-white - 'vip-goto-mark-and-skip-white - 'vip-goto-mark) - nil com) - (switch-to-buffer buff) - (goto-char vip-com-point) - (vip-change-state-to-vi) - (error ""))))) - ((and (not skip-white) (= char ?`)) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (if (and (vip-same-line (point) vip-last-jump) - (= (point) vip-last-jump-ignore)) - (goto-char vip-last-jump)) - (if (null (mark t)) (error "Mark is not set in this buffer")) - (if (= (point) (mark t)) (pop-mark)) - (exchange-point-and-mark) - (setq vip-last-jump (point-marker) - vip-last-jump-ignore 0) - (if com (vip-execute-com 'vip-goto-mark nil com))) - ((and skip-white (= char ?')) - (if com (vip-move-marker-locally 'vip-com-point (point))) - (if (and (vip-same-line (point) vip-last-jump) - (= (point) vip-last-jump-ignore)) - (goto-char vip-last-jump)) - (if (= (point) (mark t)) (pop-mark)) - (exchange-point-and-mark) - (setq vip-last-jump (point)) - (back-to-indentation) - (setq vip-last-jump-ignore (point)) - (if com (vip-execute-com 'vip-goto-mark-and-skip-white nil com))) - (t (error vip-InvalidTextmarker char)))) - -(defun vip-insert-tab () - (interactive) - (insert-tab)) - -(defun vip-exchange-point-and-mark () - (interactive) - (exchange-point-and-mark) - (back-to-indentation)) - -;; Input Mode Indentation - -;; Returns t, if the string before point matches the regexp STR. -(defsubst vip-looking-back (str) - (and (save-excursion (re-search-backward str nil t)) - (= (point) (match-end 0)))) - - -(defun vip-forward-indent () - "Indent forward -- `C-t' in Vi." - (interactive) - (setq vip-cted t) - (indent-to (+ (current-column) vip-shift-width))) - -(defun vip-backward-indent () - "Backtab, C-d in VI" - (interactive) - (if vip-cted - (let ((p (point)) (c (current-column)) bol (indent t)) - (if (vip-looking-back "[0^]") - (progn - (if (eq ?^ (preceding-char)) - (setq vip-preserve-indent t)) - (delete-backward-char 1) - (setq p (point)) - (setq indent nil))) - (save-excursion - (beginning-of-line) - (setq bol (point))) - (if (re-search-backward "[^ \t]" bol 1) (forward-char)) - (delete-region (point) p) - (if indent - (indent-to (- c vip-shift-width))) - (if (or (bolp) (vip-looking-back "[^ \t]")) - (setq vip-cted nil))))) - -(defun vip-autoindent () - "Auto Indentation, Vi-style." - (interactive) - (let ((col (current-indentation))) - (if vip-preserve-indent - (setq vip-preserve-indent nil) - (setq vip-current-indent col)) - ;; don't leave whitespace lines around - (if (memq last-command - '(vip-autoindent - vip-open-line vip-Open-line - vip-replace-state-exit-cmd)) - (indent-to-left-margin)) - ;; use \n instead of newline, or else <Return> will move the insert point - ;;(newline 1) - (insert "\n") - (if vip-auto-indent - (progn - (setq vip-cted t) - (if vip-electric-mode - (indent-according-to-mode) - (indent-to vip-current-indent)) - )) - )) - - -;; Viewing registers - -(defun vip-ket-function (arg) - "Function called by \], the ket. View registers and call \]\]." - (interactive "P") - (let ((reg (read-char))) - (cond ((vip-valid-register reg '(letter Letter)) - (view-register (downcase reg))) - ((vip-valid-register reg '(digit)) - (let ((text (current-kill (- reg ?1) 'do-not-rotate))) - (save-excursion - (set-buffer (get-buffer-create "*Output*")) - (delete-region (point-min) (point-max)) - (insert (format "Register %c contains the string:\n" reg)) - (insert text) - (goto-char (point-min))) - (display-buffer "*Output*"))) - ((= ?\] reg) - (vip-next-heading arg)) - (t (error - vip-InvalidRegister reg))))) - -(defun vip-brac-function (arg) - "Function called by \[, the brac. View textmarkers and call \[\[" - (interactive "P") - (let ((reg (read-char))) - (cond ((= ?\[ reg) - (vip-prev-heading arg)) - ((= ?\] reg) - (vip-heading-end arg)) - ((vip-valid-register reg '(letter)) - (let* ((val (get-register (1+ (- reg ?a)))) - (buf (if (not val) - (error vip-EmptyTextmarker reg) - (marker-buffer val))) - (pos (marker-position val)) - line-no text (s pos) (e pos)) - (save-excursion - (set-buffer (get-buffer-create "*Output*")) - (delete-region (point-min) (point-max)) - (if (and buf pos) - (progn - (save-excursion - (set-buffer buf) - (setq line-no (1+ (count-lines (point-min) val))) - (goto-char pos) - (beginning-of-line) - (if (re-search-backward "[^ \t]" nil t) - (progn - (beginning-of-line) - (setq s (point)))) - (goto-char pos) - (forward-line 1) - (if (re-search-forward "[^ \t]" nil t) - (progn - (end-of-line) - (setq e (point)))) - (setq text (buffer-substring s e)) - (setq text (format "%s<%c>%s" - (substring text 0 (- pos s)) - reg (substring text (- pos s))))) - (insert - (format - "Textmarker `%c' is in buffer `%s' at line %d.\n" - reg (buffer-name buf) line-no)) - (insert (format "Here is some text around %c:\n\n %s" - reg text))) - (insert (format vip-EmptyTextmarker reg))) - (goto-char (point-min))) - (display-buffer "*Output*"))) - (t (error vip-InvalidTextmarker reg))))) - - - -;; commands in insertion mode - -(defun vip-delete-backward-word (arg) - "Delete previous word." - (interactive "p") - (save-excursion - (push-mark nil t) - (backward-word arg) - (delete-region (point) (mark t)) - (pop-mark))) - - -(defun vip-set-expert-level (&optional dont-change-unless) - "Sets the expert level for a Viper user. -Can be called interactively to change (temporarily or permanently) the -current expert level. - -The optional argument DONT-CHANGE-UNLESS if not nil, says that -the level should not be changed, unless its current value is -meaningless (i.e., not one of 1,2,3,4,5). - -User level determines the setting of Viper variables that are most -sensitive for VI-style look-and-feel." - - (interactive) - - (if (not (natnump vip-expert-level)) (setq vip-expert-level 0)) - - (save-window-excursion - (delete-other-windows) - ;; if 0 < vip-expert-level < vip-max-expert-level - ;; & dont-change-unless = t -- use it; else ask - (vip-ask-level dont-change-unless)) - - (setq vip-always t - vip-ex-style-motion t - vip-ex-style-editing-in-insert t - vip-want-ctl-h-help nil) - - (cond ((eq vip-expert-level 1) ; novice or beginner - (global-set-key ; in emacs-state - vip-toggle-key - (if (vip-window-display-p) 'vip-iconify 'suspend-emacs)) - (setq vip-no-multiple-ESC t - vip-re-search t - vip-vi-style-in-minibuffer t - vip-search-wrap-around-t t - vip-want-emacs-keys-in-vi nil - vip-want-emacs-keys-in-insert nil)) - - ((and (> vip-expert-level 1) (< vip-expert-level 5)) - ;; intermediate to guru - (setq vip-no-multiple-ESC (if (vip-window-display-p) t 'twice) - vip-want-emacs-keys-in-vi t - vip-want-emacs-keys-in-insert (> vip-expert-level 2)) - - (if (eq vip-expert-level 4) ; respect user's ex-style motions - ; and vip-no-multiple-ESC - (progn - (setq-default vip-ex-style-editing-in-insert - (cdr (assoc 'vip-ex-style-editing-in-insert - vip-saved-user-settings)) - vip-ex-style-motion - (cdr (assoc 'vip-ex-style-motion - vip-saved-user-settings))) - (setq vip-ex-style-motion - (cdr (assoc 'vip-ex-style-motion vip-saved-user-settings)) - vip-ex-style-editing-in-insert - (cdr (assoc 'vip-ex-style-editing-in-insert - vip-saved-user-settings)) - vip-re-search - (cdr (assoc 'vip-re-search vip-saved-user-settings)) - vip-no-multiple-ESC - (cdr (assoc 'vip-no-multiple-ESC - vip-saved-user-settings)))))) - - ;; A wizard!! - ;; Ideally, if 5 is selected, a buffer should pop up to let the - ;; user toggle the values of variables. - (t (setq-default vip-ex-style-editing-in-insert - (cdr (assoc 'vip-ex-style-editing-in-insert - vip-saved-user-settings)) - vip-ex-style-motion - (cdr (assoc 'vip-ex-style-motion - vip-saved-user-settings))) - (setq vip-want-ctl-h-help - (cdr (assoc 'vip-want-ctl-h-help vip-saved-user-settings)) - vip-always - (cdr (assoc 'vip-always vip-saved-user-settings)) - vip-no-multiple-ESC - (cdr (assoc 'vip-no-multiple-ESC vip-saved-user-settings)) - vip-ex-style-motion - (cdr (assoc 'vip-ex-style-motion vip-saved-user-settings)) - vip-ex-style-editing-in-insert - (cdr (assoc 'vip-ex-style-editing-in-insert - vip-saved-user-settings)) - vip-re-search - (cdr (assoc 'vip-re-search vip-saved-user-settings)) - vip-want-emacs-keys-in-vi - (cdr (assoc 'vip-want-emacs-keys-in-vi - vip-saved-user-settings)) - vip-want-emacs-keys-in-insert - (cdr (assoc 'vip-want-emacs-keys-in-insert - vip-saved-user-settings))))) - (vip-set-mode-vars-for vip-current-state) - (if (or vip-always - (and (> vip-expert-level 0) (> 5 vip-expert-level))) - (vip-set-hooks))) - -;; Ask user expert level. -(defun vip-ask-level (dont-change-unless) - (let ((ask-buffer " *vip-ask-level*") - level-changed repeated) - (save-window-excursion - (switch-to-buffer ask-buffer) - - (or (eq this-command 'vip-set-expert-level) - (and - (<= vip-expert-level vip-max-expert-level) - (>= vip-expert-level 1)) - (progn - (insert " - - *** Important Notice for VIP users*** - - This is VIPER - -@joke -Viper Is a Package for Emacs Rebels, -a VI Plan for Emacs Rescue, -and a venomous VI PERil. -@end joke - -Technically speaking, Viper is a new Vi emulator that replaces -the old VIP package. - -Viper emulates Vi much better than VIP. It also significantly -extends and improves upon Vi in many useful ways. - -Although many VIP settings in your ~/.vip are compatible with Viper, -you may have to change some of them. Please refer to the documentation, -which can be obtained by executing - -:help - -when Viper is in Vi state. - -If you will be so lucky as to find a bug, report it via the command - -:submitReport - -Type any key to continue... ") - - (read-char) - (erase-buffer))) - - (while (or (> vip-expert-level vip-max-expert-level) - (< vip-expert-level 1) - (null dont-change-unless)) - (erase-buffer) - (if repeated - (progn - (message "Invalid user level") - (beep 1)) - (setq repeated t)) - (setq dont-change-unless t - level-changed t) - (insert " -Please specify your level of familiarity with the venomous VI PERil -(and the VI Plan for Emacs Rescue). -You can change it at any time by typing `M-x vip-set-expert-level RET' - - 1 -- BEGINNER: Almost all Emacs features are suppressed. - Feels almost like straight Vi. File name completion and - command history in the minibuffer are thrown in as a bonus. - To use Emacs productively, you must reach level 3 or higher. - 2 -- MASTER: C-c now has its standard Emacs meaning in Vi command state, - so most Emacs commands can be used when Viper is in Vi state. - Good progress---you are well on the way to level 3! - 3 -- GRAND MASTER: Like 3, but most Emacs commands are available also - in Viper's insert state. - 4 -- GURU: Like 3, but user settings are respected for vip-no-multiple-ESC, - vip-re-search, vip-ex-style-motion, & vip-ex-style-editing-in-insert - variables. Adjust these settings to your taste. - 5 -- WIZARD: Like 4, but user settings are also respected for vip-always, - vip-want-ctl-h-help, vip-want-emacs-keys-in-vi, and - vip-want-emacs-keys-in-insert. Adjust these to your taste. - -Please, specify your level now: ") - - (setq vip-expert-level (- (vip-read-char-exclusive) ?0)) - ) ; end while - - ;; tell the user if level was changed - (and level-changed - (progn - (insert - (format "\n\n\n\n\n\t\tYou have selected user level %d" - vip-expert-level)) - (if (y-or-n-p "Do you wish to make this change permanent? ") - ;; save the setting for vip-expert-level - (vip-save-setting - 'vip-expert-level - (format "Saving user level %d ..." vip-expert-level) - vip-custom-file-name)) - )) - (bury-buffer) ; remove ask-buffer from screen - (message "") - ))) - - -(defun viper-version () - (interactive) - (message "Viper version is %s" viper-version)) - -(defalias 'vip-version 'viper-version) - -(defun vip-nil () - (interactive) - (beep 1)) - - -;; if ENFORCE-BUFFER is not nil, error if CHAR is a marker in another buffer -(defun vip-register-to-point (char &optional enforce-buffer) - "Like jump-to-register, but switches to another buffer in another window." - (interactive "cViper register to point: ") - (let ((val (get-register char))) - (cond - ((and (fboundp 'frame-configuration-p) - (frame-configuration-p val)) - (set-frame-configuration val)) - ((window-configuration-p val) - (set-window-configuration val)) - ((vip-valid-marker val) - (if (and enforce-buffer - (not (equal (current-buffer) (marker-buffer val)))) - (error (concat vip-EmptyTextmarker " in this buffer") - (1- (+ char ?a)))) - (pop-to-buffer (marker-buffer val)) - (goto-char val)) - ((and (consp val) (eq (car val) 'file)) - (find-file (cdr val))) - (t - (error vip-EmptyTextmarker (1- (+ char ?a))))))) - - -(defun vip-save-kill-buffer () - "Save then kill current buffer. " - (interactive) - (if (< vip-expert-level 2) - (save-buffers-kill-emacs) - (save-buffer) - (kill-buffer (current-buffer)))) - - - -;;; Bug Report - -(defun vip-submit-report () - "Submit bug report on Viper." - (interactive) - (let ((reporter-prompt-for-summary-p t) - (vip-device-type (vip-device-type)) - color-display-p frame-parameters - minibuffer-emacs-face minibuffer-vi-face minibuffer-insert-face - varlist salutation window-config) - - ;; If mode info is needed, add variable to `let' and then set it below, - ;; like we did with color-display-p. - (setq color-display-p (if (vip-window-display-p) - (vip-color-display-p) - 'non-x) - minibuffer-vi-face (if (vip-has-face-support-p) - (vip-get-face vip-minibuffer-vi-face) - 'non-x) - minibuffer-insert-face (if (vip-has-face-support-p) - (vip-get-face vip-minibuffer-insert-face) - 'non-x) - minibuffer-emacs-face (if (vip-has-face-support-p) - (vip-get-face vip-minibuffer-emacs-face) - 'non-x) - frame-parameters (if (fboundp 'frame-parameters) - (frame-parameters (selected-frame)))) - - (setq varlist (list 'vip-vi-minibuffer-minor-mode - 'vip-insert-minibuffer-minor-mode - 'vip-vi-intercept-minor-mode - 'vip-vi-local-user-minor-mode - 'vip-vi-kbd-minor-mode - 'vip-vi-global-user-minor-mode - 'vip-vi-state-modifier-minor-mode - 'vip-vi-diehard-minor-mode - 'vip-vi-basic-minor-mode - 'vip-replace-minor-mode - 'vip-insert-intercept-minor-mode - 'vip-insert-local-user-minor-mode - 'vip-insert-kbd-minor-mode - 'vip-insert-global-user-minor-mode - 'vip-insert-state-modifier-minor-mode - 'vip-insert-diehard-minor-mode - 'vip-insert-basic-minor-mode - 'vip-emacs-intercept-minor-mode - 'vip-emacs-local-user-minor-mode - 'vip-emacs-kbd-minor-mode - 'vip-emacs-global-user-minor-mode - 'vip-emacs-state-modifier-minor-mode - 'vip-automatic-iso-accents - 'vip-want-emacs-keys-in-insert - 'vip-want-emacs-keys-in-vi - 'vip-keep-point-on-undo - 'vip-no-multiple-ESC - 'vip-ESC-key - 'vip-want-ctl-h-help - 'vip-ex-style-editing-in-insert - 'vip-delete-backwards-in-replace - 'vip-vi-style-in-minibuffer - 'vip-vi-state-hook - 'vip-insert-state-hook - 'vip-replace-state-hook - 'vip-emacs-state-hook - 'ex-cycle-other-window - 'ex-cycle-through-non-files - 'vip-expert-level - 'major-mode - 'vip-device-type - 'color-display-p - 'frame-parameters - 'minibuffer-vi-face - 'minibuffer-insert-face - 'minibuffer-emacs-face - )) - (setq salutation " -Congratulations! You may have unearthed a bug in Viper! -Please mail a concise, accurate summary of the problem to the address above. - --------------------------------------------------------------------") - (setq window-config (current-window-configuration)) - (with-output-to-temp-buffer " *vip-info*" - (switch-to-buffer " *vip-info*") - (delete-other-windows) - (princ " -PLEASE FOLLOW THESE PROCEDURES ------------------------------- - -Before reporting a bug, please verify that it is related to Viper, and is -not cause by other packages you are using. - -Don't report compilation warnings, unless you are certain that there is a -problem. These warnings are normal and unavoidable. - -Please note that users should not modify variables and keymaps other than -those advertised in the manual. Such `customization' is likely to crash -Viper, as it would any other improperly customized Emacs package. - -If you are reporting an error message received while executing one of the -Viper commands, type: - - M-x set-variable <Return> debug-on-error <Return> t <Return> - -Then reproduce the error. The above command will cause Emacs to produce a -back trace of the execution that leads to the error. Please include this -trace in your bug report. - -If you believe that one of Viper's commands goes into an infinite loop -\(e.g., Emacs freezes\), type: - - M-x set-variable <Return> debug-on-quit <Return> t <Return> - -Then reproduce the problem. Wait for a few seconds, then type C-g to abort -the current command. Include the resulting back trace in the bug report. - -Mail anyway (y or n)? ") - (if (y-or-n-p "Mail anyway? ") - () - (set-window-configuration window-config) - (error "Bug report aborted"))) - - (require 'reporter) - (set-window-configuration window-config) - - (reporter-submit-bug-report "kifer@cs.sunysb.edu" - (vip-version) - varlist - nil 'delete-other-windows - salutation) - )) - - - - -;; Smoothes out the difference between Emacs' unread-command-events -;; and XEmacs unread-command-event. Arg is a character, an event, a list of -;; events or a sequence of keys. -;; -;; Due to the way unread-command-events in Emacs (not XEmacs), a non-event -;; symbol in unread-command-events list may cause Emacs to turn this symbol -;; into an event. Below, we delete nil from event lists, since nil is the most -;; common symbol that might appear in this wrong context. -(defun vip-set-unread-command-events (arg) - (if vip-emacs-p - (setq - unread-command-events - (let ((new-events - (cond ((eventp arg) (list arg)) - ((listp arg) arg) - ((sequencep arg) - (listify-key-sequence arg)) - (t (error - "vip-set-unread-command-events: Invalid argument, %S" - arg))))) - (if (not (eventp nil)) - (setq new-events (delq nil new-events))) - (append new-events unread-command-events))) - ;; XEmacs - (setq - unread-command-events - (append - (cond ((vip-characterp arg) (list (character-to-event arg))) - ((eventp arg) (list arg)) - ((stringp arg) (mapcar 'character-to-event arg)) - ((vectorp arg) (append arg nil)) ; turn into list - ((listp arg) (vip-eventify-list-xemacs arg)) - (t (error - "vip-set-unread-command-events: Invalid argument, %S" arg))) - unread-command-events)))) - -;; list is assumed to be a list of events of characters -(defun vip-eventify-list-xemacs (lis) - (mapcar - (function (lambda (elt) - (cond ((vip-characterp elt) (character-to-event elt)) - ((eventp elt) elt) - (t (error - "vip-eventify-list-xemacs: can't convert to event, %S" - elt))))) - lis)) - - - -;;; Bring in the rest of the files -(require 'viper-mous) -(require 'viper-macs) -(require 'viper-ex) - - - -;; The following is provided for compatibility with older VIP's - -(defalias 'vip-change-mode-to-vi 'vip-change-state-to-vi) -(defalias 'vip-change-mode-to-insert 'vip-change-state-to-insert) -(defalias 'vip-change-mode-to-emacs 'vip-change-state-to-emacs) - - - -;;; Load .vip and set up hooks - -;; This hook designed to enable Vi-style editing in comint-based modes." -(defun vip-comint-mode-hook () - (setq require-final-newline nil - vip-ex-style-editing-in-insert nil - vip-ex-style-motion nil) - (vip-change-state-to-insert)) - - -;; This sets major mode hooks to make them come up in vi-state. -(defun vip-set-hooks () - - ;; It is of course a misnomer to call viper-mode a `major mode'. - ;; However, this has the effect that if the user didn't specify the - ;; default mode, new buffers that fall back on the default will come up - ;; in Fundamental Mode and Vi state. - (setq default-major-mode 'viper-mode) - - ;; The following major modes should come up in vi-state - (defadvice fundamental-mode (after vip-fundamental-mode-ad activate) - "Run `vip-change-state-to-vi' on entry." - (vip-change-state-to-vi)) - - (defvar makefile-mode-hook) - (add-hook 'makefile-mode-hook 'viper-mode) - - (defvar help-mode-hook) - (add-hook 'help-mode-hook 'viper-mode) - - (defvar awk-mode-hook) - (add-hook 'awk-mode-hook 'viper-mode) - - (defvar html-mode-hook) - (add-hook 'html-mode-hook 'viper-mode) - (defvar html-helper-mode-hook) - (add-hook 'html-helper-mode-hook 'viper-mode) - (defvar java-mode-hook) - (add-hook 'java-mode-hook 'viper-mode) - - (defvar emacs-lisp-mode-hook) - (add-hook 'emacs-lisp-mode-hook 'viper-mode) - - (defvar lisp-mode-hook) - (add-hook 'lisp-mode-hook 'viper-mode) - - (defvar bibtex-mode-hook) - (add-hook 'bibtex-mode-hook 'viper-mode) - - (defvar cc-mode-hook) - (add-hook 'cc-mode-hook 'viper-mode) - - (defvar c-mode-hook) - (add-hook 'c-mode-hook 'viper-mode) - - (defvar c++-mode-hook) - (add-hook 'c++-mode-hook 'viper-mode) - - (defvar lisp-interaction-mode-hook) - (add-hook 'lisp-interaction-mode-hook 'viper-mode) - - (defvar fortran-mode-hook) - (add-hook 'fortran-mode-hook 'vip-mode) - - (defvar basic-mode-hook) - (add-hook 'basic-mode-hook 'vip-mode) - (defvar bat-mode-hook) - (add-hook 'bat-mode-hook 'vip-mode) - - (defvar text-mode-hook) - (add-hook 'text-mode-hook 'viper-mode) - - (add-hook 'completion-list-mode-hook 'viper-mode) - (add-hook 'compilation-mode-hook 'viper-mode) - - (add-hook 'perl-mode-hook 'viper-mode) - (add-hook 'tcl-mode-hook 'viper-mode) - - (defvar emerge-startup-hook) - (add-hook 'emerge-startup-hook 'vip-change-state-to-emacs) - - ;; Tell vc-diff to put *vc* in Vi mode - (if (featurep 'vc) - (defadvice vc-diff (after vip-vc-ad activate) - "Force Vi state in VC diff buffer." - (vip-change-state-to-vi)) - (vip-eval-after-load - "vc" - '(defadvice vc-diff (after vip-vc-ad activate) - "Force Vi state in VC diff buffer." - (vip-change-state-to-vi)))) - - (vip-eval-after-load - "emerge" - '(defadvice emerge-quit (after vip-emerge-advice activate) - "Run `vip-change-state-to-vi' after quitting emerge." - (vip-change-state-to-vi))) - ;; In case Emerge was loaded before Viper. - (defadvice emerge-quit (after vip-emerge-advice activate) - "Run `vip-change-state-to-vi' after quitting emerge." - (vip-change-state-to-vi)) - - (vip-eval-after-load - "asm-mode" - '(defadvice asm-mode (after vip-asm-mode-ad activate) - "Run `vip-change-state-to-vi' on entry." - (vip-change-state-to-vi))) - - ;; passwd.el sets up its own buffer, which turns up in Vi mode, - ;; thus overriding the local map. We don't need Vi mode here. - (vip-eval-after-load - "passwd" - '(defadvice read-passwd-1 (before vip-passwd-ad activate) - "Switch to emacs state while reading password." - (vip-change-state-to-emacs))) - - (vip-eval-after-load - "prolog" - '(defadvice prolog-mode (after vip-prolog-ad activate) - "Switch to Vi state in Prolog mode." - (vip-change-state-to-vi))) - - ;; Emacs shell, ange-ftp, and comint-based modes - (defvar comint-mode-hook) - (vip-modify-major-mode - 'comint-mode 'insert-state vip-comint-mode-modifier-map) - (vip-modify-major-mode - 'comint-mode 'vi-state vip-comint-mode-modifier-map) - (vip-modify-major-mode - 'shell-mode 'insert-state vip-comint-mode-modifier-map) - (vip-modify-major-mode - 'shell-mode 'vi-state vip-comint-mode-modifier-map) - ;; ange-ftp in XEmacs - (vip-modify-major-mode - 'ange-ftp-shell-mode 'insert-state vip-comint-mode-modifier-map) - (vip-modify-major-mode - 'ange-ftp-shell-mode 'vi-state vip-comint-mode-modifier-map) - ;; ange-ftp in Emacs - (vip-modify-major-mode - 'internal-ange-ftp-mode 'insert-state vip-comint-mode-modifier-map) - (vip-modify-major-mode - 'internal-ange-ftp-mode 'vi-state vip-comint-mode-modifier-map) - ;; set hook - (add-hook 'comint-mode-hook 'vip-comint-mode-hook) - - ;; Shell scripts - (defvar sh-mode-hook) - (add-hook 'sh-mode-hook 'viper-mode) - (defvar ksh-mode-hook) - (add-hook 'ksh-mode-hook 'viper-mode) - - ;; Dired - (vip-modify-major-mode 'dired-mode 'emacs-state vip-dired-modifier-map) - (vip-set-emacs-search-style-macros nil 'dired-mode) - (add-hook 'dired-mode-hook 'vip-change-state-to-emacs) - - ;; Tar - (vip-modify-major-mode 'tar-mode 'emacs-state vip-slash-and-colon-map) - (vip-set-emacs-search-style-macros nil 'tar-mode) - - ;; MH-E - (vip-modify-major-mode 'mh-folder-mode 'emacs-state vip-slash-and-colon-map) - (vip-set-emacs-search-style-macros nil 'mh-folder-mode) - ;; changing state to emacs is needed so the preceding will take hold - (add-hook 'mh-folder-mode-hook 'vip-change-state-to-emacs) - (add-hook 'mh-show-mode-hook 'viper-mode) - - ;; Gnus - (vip-modify-major-mode 'gnus-group-mode 'emacs-state vip-slash-and-colon-map) - (vip-set-emacs-search-style-macros nil 'gnus-group-mode) - (vip-modify-major-mode - 'gnus-summary-mode 'emacs-state vip-slash-and-colon-map) - (vip-set-emacs-search-style-macros nil 'gnus-summary-mode) - ;; changing state to emacs is needed so the preceding will take hold - (add-hook 'gnus-group-mode-hook 'vip-change-state-to-emacs) - (add-hook 'gnus-summary-mode-hook 'vip-change-state-to-emacs) - (add-hook 'gnus-article-mode-hook 'viper-mode) - - ;; Info - (vip-modify-major-mode 'Info-mode 'emacs-state vip-slash-and-colon-map) - (vip-set-emacs-search-style-macros nil 'Info-mode) - ;; Switching to emacs is needed so the above will take hold - (defadvice Info-mode (after vip-Info-ad activate) - "Switch to emacs mode." - (vip-change-state-to-emacs)) - - ;; Buffer menu - (vip-modify-major-mode - 'Buffer-menu-mode 'emacs-state vip-slash-and-colon-map) - (vip-set-emacs-search-style-macros nil 'Buffer-menu-mode) - ;; Switching to emacs is needed so the above will take hold - (defadvice Buffer-menu-mode (after vip-Buffer-menu-ad activate) - "Switch to emacs mode." - (vip-change-state-to-emacs)) - - ;; View mode - (if vip-emacs-p - (progn - (defvar view-mode-hook) - (add-hook 'view-mode-hook 'vip-change-state-to-emacs)) - (defadvice view-minor-mode (after vip-view-ad activate) - "Switch to Emacs state in View mode." - (vip-change-state-to-emacs)) - (defvar view-hook) - (add-hook 'view-hook 'vip-change-state-to-emacs)) - - ;; For VM users. - ;; Put summary and other VM buffers in Emacs state. - (defvar vm-mode-hooks) - (defvar vm-summary-mode-hooks) - (add-hook 'vm-mode-hooks 'vip-change-state-to-emacs) - (add-hook 'vm-summary-mode-hooks 'vip-change-state-to-emacs) - - ;; For RMAIL users. - ;; Put buf in Emacs state after edit. - (vip-eval-after-load - "rmailedit" - '(defadvice rmail-cease-edit (after vip-rmail-advice activate) - "Switch to emacs state when done editing message." - (vip-change-state-to-emacs))) - ;; In case RMAIL was loaded before Viper. - (defadvice rmail-cease-edit (after vip-rmail-advice activate) - "Switch to emacs state when done editing message." - (vip-change-state-to-emacs)) - ) ; vip-set-hooks - -;; Set some useful macros -;; These must be before we load .vip, so the user can unrecord them. - -;; repeat the 2nd previous command without rotating the command history -(vip-record-kbd-macro - (vector vip-repeat-from-history-key '\1) 'vi-state - [(meta x) v i p - r e p e a t - f r o m - h i s t o r y return] 't) -;; repeat the 3d previous command without rotating the command history -(vip-record-kbd-macro - (vector vip-repeat-from-history-key '\2) 'vi-state - [(meta x) v i p - r e p e a t - f r o m - h i s t o r y return] 't) - -;; set the toggle case sensitivity and regexp search macros -(vip-set-vi-search-style-macros nil) - - -;; ~/.vip is loaded if it exists -(if (and (file-exists-p vip-custom-file-name) - (not noninteractive)) - (load vip-custom-file-name)) - -;; VIP compatibility: merge whatever the user has in vip-mode-map into -;; Viper's basic map. -(vip-add-keymap vip-mode-map vip-vi-global-user-map) - - -;; Applying Viper customization -- runs after (load .vip) - -;; Save user settings or Viper defaults for vars controled by vip-expert-level -(setq vip-saved-user-settings - (list (cons 'vip-want-ctl-h-help vip-want-ctl-h-help) - (cons 'vip-always vip-always) - (cons 'vip-no-multiple-ESC vip-no-multiple-ESC) - (cons 'vip-ex-style-motion vip-ex-style-motion) - (cons 'vip-ex-style-editing-in-insert - vip-ex-style-editing-in-insert) - (cons 'vip-want-emacs-keys-in-vi vip-want-emacs-keys-in-vi) - (cons 'vip-want-emacs-keys-in-insert vip-want-emacs-keys-in-insert) - (cons 'vip-re-search vip-re-search))) - - -(vip-set-minibuffer-style) -(vip-set-minibuffer-faces) -(vip-set-search-face) -(vip-set-replace-overlay-face) -(if vip-buffer-search-char - (vip-buffer-search-enable)) -(vip-update-alphanumeric-class) - -;;; Familiarize Viper with some minor modes that have their own keymaps -(vip-harness-minor-mode "compile") -(vip-harness-minor-mode "outline") -(vip-harness-minor-mode "allout") -(vip-harness-minor-mode "xref") -(vip-harness-minor-mode "lmenu") -(vip-harness-minor-mode "vc") -(vip-harness-minor-mode "ltx-math") ; LaTeX-math-mode in AUC-TeX -(vip-harness-minor-mode "latex") ; which is in one of these two files -(vip-harness-minor-mode "cyrillic") -(vip-harness-minor-mode "russian") -(vip-harness-minor-mode "view-less") -(vip-harness-minor-mode "view") - - -;; Intercept maps could go in viper-keym.el -;; We keep them here in case someone redefines them in ~/.vip - -(define-key vip-vi-intercept-map vip-ESC-key 'vip-intercept-ESC-key) -(define-key vip-insert-intercept-map vip-ESC-key 'vip-intercept-ESC-key) - -;; This is taken care of by vip-insert-global-user-map. -;;(define-key vip-replace-map vip-ESC-key 'vip-intercept-ESC-key) - - -;; The default vip-toggle-key is \C-z; for the novice, it suspends or -;; iconifies Emacs -(define-key vip-vi-intercept-map vip-toggle-key 'vip-toggle-key-action) -(define-key vip-emacs-intercept-map vip-toggle-key 'vip-change-state-to-vi) - - -(if (or vip-always - (and (< vip-expert-level 5) (> vip-expert-level 0))) - (vip-set-hooks)) - -;; Let all minor modes take effect after loading -;; this may not be enough, so we also set default minor-mode-alist. -;; Without setting the default, new buffers that come up in emacs mode have -;; minor-mode-map-alist = nil, unless we call vip-change-state-* -(if (eq vip-current-state 'emacs-state) - (progn - (vip-change-state-to-emacs) - (setq-default minor-mode-map-alist minor-mode-map-alist) - )) - - -(run-hooks 'vip-load-hook) ; the last chance to change something - -(provide 'viper) -(provide 'vip19) -(provide 'vip) - -;;; viper.el ends here diff --git a/lisp/emulation/ws-mode.el b/lisp/emulation/ws-mode.el deleted file mode 100644 index 91f8b0170fc..00000000000 --- a/lisp/emulation/ws-mode.el +++ /dev/null @@ -1,753 +0,0 @@ -;;; ws-mode.el --- WordStar emulation mode for GNU Emacs - -;; Copyright (C) 1991 Free Software Foundation, Inc. - -;; Author: Juergen Nickelsen <nickel@cs.tu-berlin.de> -;; Version: 0.7 -;; Keywords: emulations - -;; This file is part of GNU Emacs. - -;; 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 -;; the Free Software Foundation; either version 2, 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 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This emulates WordStar, with a major mode. - -;;; Code: - -(defvar wordstar-mode-map nil "") -(defvar wordstar-C-j-map nil "") -(defvar wordstar-C-k-map nil "") -(defvar wordstar-C-o-map nil "") -(defvar wordstar-C-q-map nil "") - -(if wordstar-mode-map - () - (setq wordstar-mode-map (make-keymap)) - ;; (setq wordstar-C-j-map (make-keymap)) ; later, perhaps - (setq wordstar-C-k-map (make-keymap)) - (setq wordstar-C-o-map (make-keymap)) - (setq wordstar-C-q-map (make-keymap)) - - (define-key wordstar-mode-map "\C-a" 'backward-word) - (define-key wordstar-mode-map "\C-b" 'fill-paragraph) - (define-key wordstar-mode-map "\C-c" 'scroll-up) - (define-key wordstar-mode-map "\C-d" 'forward-char) - (define-key wordstar-mode-map "\C-e" 'previous-line) - (define-key wordstar-mode-map "\C-f" 'forward-word) - (define-key wordstar-mode-map "\C-g" 'delete-char) - (define-key wordstar-mode-map "\C-h" 'backward-char) - (define-key wordstar-mode-map "\C-i" 'indent-for-tab-command) - (define-key wordstar-mode-map "\C-j" 'help-for-help) - (define-key wordstar-mode-map "\C-k" wordstar-C-k-map) - (define-key wordstar-mode-map "\C-l" 'ws-repeat-search) - (define-key wordstar-mode-map "\C-n" 'open-line) - (define-key wordstar-mode-map "\C-o" wordstar-C-o-map) - (define-key wordstar-mode-map "\C-p" 'quoted-insert) - (define-key wordstar-mode-map "\C-q" wordstar-C-q-map) - (define-key wordstar-mode-map "\C-r" 'scroll-down) - (define-key wordstar-mode-map "\C-s" 'backward-char) - (define-key wordstar-mode-map "\C-t" 'kill-word) - (define-key wordstar-mode-map "\C-u" 'keyboard-quit) - (define-key wordstar-mode-map "\C-v" 'overwrite-mode) - (define-key wordstar-mode-map "\C-w" 'scroll-down-line) - (define-key wordstar-mode-map "\C-x" 'next-line) - (define-key wordstar-mode-map "\C-y" 'kill-complete-line) - (define-key wordstar-mode-map "\C-z" 'scroll-up-line) - - ;; wordstar-C-k-map - - (define-key wordstar-C-k-map " " ()) - (define-key wordstar-C-k-map "0" 'ws-set-marker-0) - (define-key wordstar-C-k-map "1" 'ws-set-marker-1) - (define-key wordstar-C-k-map "2" 'ws-set-marker-2) - (define-key wordstar-C-k-map "3" 'ws-set-marker-3) - (define-key wordstar-C-k-map "4" 'ws-set-marker-4) - (define-key wordstar-C-k-map "5" 'ws-set-marker-5) - (define-key wordstar-C-k-map "6" 'ws-set-marker-6) - (define-key wordstar-C-k-map "7" 'ws-set-marker-7) - (define-key wordstar-C-k-map "8" 'ws-set-marker-8) - (define-key wordstar-C-k-map "9" 'ws-set-marker-9) - (define-key wordstar-C-k-map "b" 'ws-begin-block) - (define-key wordstar-C-k-map "\C-b" 'ws-begin-block) - (define-key wordstar-C-k-map "c" 'ws-copy-block) - (define-key wordstar-C-k-map "\C-c" 'ws-copy-block) - (define-key wordstar-C-k-map "d" 'save-buffers-kill-emacs) - (define-key wordstar-C-k-map "\C-d" 'save-buffers-kill-emacs) - (define-key wordstar-C-k-map "f" 'find-file) - (define-key wordstar-C-k-map "\C-f" 'find-file) - (define-key wordstar-C-k-map "h" 'ws-show-markers) - (define-key wordstar-C-k-map "\C-h" 'ws-show-markers) - (define-key wordstar-C-k-map "i" 'ws-indent-block) - (define-key wordstar-C-k-map "\C-i" 'ws-indent-block) - (define-key wordstar-C-k-map "k" 'ws-end-block) - (define-key wordstar-C-k-map "\C-k" 'ws-end-block) - (define-key wordstar-C-k-map "p" 'ws-print-block) - (define-key wordstar-C-k-map "\C-p" 'ws-print-block) - (define-key wordstar-C-k-map "q" 'kill-emacs) - (define-key wordstar-C-k-map "\C-q" 'kill-emacs) - (define-key wordstar-C-k-map "r" 'insert-file) - (define-key wordstar-C-k-map "\C-r" 'insert-file) - (define-key wordstar-C-k-map "s" 'save-some-buffers) - (define-key wordstar-C-k-map "\C-s" 'save-some-buffers) - (define-key wordstar-C-k-map "t" 'ws-mark-word) - (define-key wordstar-C-k-map "\C-t" 'ws-mark-word) - (define-key wordstar-C-k-map "u" 'ws-exdent-block) - (define-key wordstar-C-k-map "\C-u" 'keyboard-quit) - (define-key wordstar-C-k-map "v" 'ws-move-block) - (define-key wordstar-C-k-map "\C-v" 'ws-move-block) - (define-key wordstar-C-k-map "w" 'ws-write-block) - (define-key wordstar-C-k-map "\C-w" 'ws-write-block) - (define-key wordstar-C-k-map "x" 'save-buffers-kill-emacs) - (define-key wordstar-C-k-map "\C-x" 'save-buffers-kill-emacs) - (define-key wordstar-C-k-map "y" 'ws-delete-block) - (define-key wordstar-C-k-map "\C-y" 'ws-delete-block) - - ;; wordstar-C-j-map not yet implemented - - ;; wordstar-C-o-map - - (define-key wordstar-C-o-map " " ()) - (define-key wordstar-C-o-map "c" 'wordstar-center-line) - (define-key wordstar-C-o-map "\C-c" 'wordstar-center-line) - (define-key wordstar-C-o-map "b" 'switch-to-buffer) - (define-key wordstar-C-o-map "\C-b" 'switch-to-buffer) - (define-key wordstar-C-o-map "j" 'justify-current-line) - (define-key wordstar-C-o-map "\C-j" 'justify-current-line) - (define-key wordstar-C-o-map "k" 'kill-buffer) - (define-key wordstar-C-o-map "\C-k" 'kill-buffer) - (define-key wordstar-C-o-map "l" 'list-buffers) - (define-key wordstar-C-o-map "\C-l" 'list-buffers) - (define-key wordstar-C-o-map "m" 'auto-fill-mode) - (define-key wordstar-C-o-map "\C-m" 'auto-fill-mode) - (define-key wordstar-C-o-map "r" 'set-fill-column) - (define-key wordstar-C-o-map "\C-r" 'set-fill-column) - (define-key wordstar-C-o-map "\C-u" 'keyboard-quit) - (define-key wordstar-C-o-map "wd" 'delete-other-windows) - (define-key wordstar-C-o-map "wh" 'split-window-horizontally) - (define-key wordstar-C-o-map "wo" 'other-window) - (define-key wordstar-C-o-map "wv" 'split-window-vertically) - - ;; wordstar-C-q-map - (define-key wordstar-C-q-map " " ()) - (define-key wordstar-C-q-map "0" 'ws-find-marker-0) - (define-key wordstar-C-q-map "1" 'ws-find-marker-1) - (define-key wordstar-C-q-map "2" 'ws-find-marker-2) - (define-key wordstar-C-q-map "3" 'ws-find-marker-3) - (define-key wordstar-C-q-map "4" 'ws-find-marker-4) - (define-key wordstar-C-q-map "5" 'ws-find-marker-5) - (define-key wordstar-C-q-map "6" 'ws-find-marker-6) - (define-key wordstar-C-q-map "7" 'ws-find-marker-7) - (define-key wordstar-C-q-map "8" 'ws-find-marker-8) - (define-key wordstar-C-q-map "9" 'ws-find-marker-9) - (define-key wordstar-C-q-map "a" 'ws-query-replace) - (define-key wordstar-C-q-map "\C-a" 'ws-query-replace) - (define-key wordstar-C-q-map "b" 'ws-goto-block-begin) - (define-key wordstar-C-q-map "\C-b" 'ws-goto-block-begin) - (define-key wordstar-C-q-map "c" 'end-of-buffer) - (define-key wordstar-C-q-map "\C-c" 'end-of-buffer) - (define-key wordstar-C-q-map "d" 'end-of-line) - (define-key wordstar-C-q-map "\C-d" 'end-of-line) - (define-key wordstar-C-q-map "f" 'ws-search) - (define-key wordstar-C-q-map "\C-f" 'ws-search) - (define-key wordstar-C-q-map "k" 'ws-goto-block-end) - (define-key wordstar-C-q-map "\C-k" 'ws-goto-block-end) - (define-key wordstar-C-q-map "l" 'ws-undo) - (define-key wordstar-C-q-map "\C-l" 'ws-undo) - (define-key wordstar-C-q-map "p" 'ws-last-cursorp) - (define-key wordstar-C-q-map "\C-p" 'ws-last-cursorp) - (define-key wordstar-C-q-map "r" 'beginning-of-buffer) - (define-key wordstar-C-q-map "\C-r" 'beginning-of-buffer) - (define-key wordstar-C-q-map "s" 'beginning-of-line) - (define-key wordstar-C-q-map "\C-s" 'beginning-of-line) - (define-key wordstar-C-q-map "\C-u" 'keyboard-quit) - (define-key wordstar-C-q-map "w" 'ws-last-error) - (define-key wordstar-C-q-map "\C-w" 'ws-last-error) - (define-key wordstar-C-q-map "y" 'ws-kill-eol) - (define-key wordstar-C-q-map "\C-y" 'ws-kill-eol) - (define-key wordstar-C-q-map "\177" 'ws-kill-bol)) - -;;;###autoload -(defun wordstar-mode () - "Major mode with WordStar-like key bindings. - -BUGS: - - Help menus with WordStar commands (C-j just calls help-for-help) - are not implemented - - Options for search and replace - - Show markers (C-k h) is somewhat strange - - Search and replace (C-q a) is only available in forward direction - -No key bindings beginning with ESC are installed, they will work -Emacs-like. - -The key bindings are: - - C-a backward-word - C-b fill-paragraph - C-c scroll-up-line - C-d forward-char - C-e previous-line - C-f forward-word - C-g delete-char - C-h backward-char - C-i indent-for-tab-command - C-j help-for-help - C-k ordstar-C-k-map - C-l ws-repeat-search - C-n open-line - C-p quoted-insert - C-r scroll-down-line - C-s backward-char - C-t kill-word - C-u keyboard-quit - C-v overwrite-mode - C-w scroll-down - C-x next-line - C-y kill-complete-line - C-z scroll-up - - C-k 0 ws-set-marker-0 - C-k 1 ws-set-marker-1 - C-k 2 ws-set-marker-2 - C-k 3 ws-set-marker-3 - C-k 4 ws-set-marker-4 - C-k 5 ws-set-marker-5 - C-k 6 ws-set-marker-6 - C-k 7 ws-set-marker-7 - C-k 8 ws-set-marker-8 - C-k 9 ws-set-marker-9 - C-k b ws-begin-block - C-k c ws-copy-block - C-k d save-buffers-kill-emacs - C-k f find-file - C-k h ws-show-markers - C-k i ws-indent-block - C-k k ws-end-block - C-k p ws-print-block - C-k q kill-emacs - C-k r insert-file - C-k s save-some-buffers - C-k t ws-mark-word - C-k u ws-exdent-block - C-k C-u keyboard-quit - C-k v ws-move-block - C-k w ws-write-block - C-k x kill-emacs - C-k y ws-delete-block - - C-o c wordstar-center-line - C-o b switch-to-buffer - C-o j justify-current-line - C-o k kill-buffer - C-o l list-buffers - C-o m auto-fill-mode - C-o r set-fill-column - C-o C-u keyboard-quit - C-o wd delete-other-windows - C-o wh split-window-horizontally - C-o wo other-window - C-o wv split-window-vertically - - C-q 0 ws-find-marker-0 - C-q 1 ws-find-marker-1 - C-q 2 ws-find-marker-2 - C-q 3 ws-find-marker-3 - C-q 4 ws-find-marker-4 - C-q 5 ws-find-marker-5 - C-q 6 ws-find-marker-6 - C-q 7 ws-find-marker-7 - C-q 8 ws-find-marker-8 - C-q 9 ws-find-marker-9 - C-q a ws-query-replace - C-q b ws-to-block-begin - C-q c end-of-buffer - C-q d end-of-line - C-q f ws-search - C-q k ws-to-block-end - C-q l ws-undo - C-q p ws-last-cursorp - C-q r beginning-of-buffer - C-q C-u keyboard-quit - C-q w ws-last-error - C-q y ws-kill-eol - C-q DEL ws-kill-bol -" - (interactive) - (kill-all-local-variables) - (use-local-map wordstar-mode-map) - (setq mode-name "WordStar") - (setq major-mode 'wordstar-mode)) - - -(defun wordstar-center-paragraph () - "Center each line in the paragraph at or after point. -See `wordstar-center-line' for more info." - (interactive) - (save-excursion - (forward-paragraph) - (or (bolp) (newline 1)) - (let ((end (point))) - (backward-paragraph) - (wordstar-center-region (point) end)))) - -(defun wordstar-center-region (from to) - "Center each line starting in the region. -See `wordstar-center-line' for more info." - (interactive "r") - (if (> from to) - (let ((tem to)) - (setq to from from tem))) - (save-excursion - (save-restriction - (narrow-to-region from to) - (goto-char from) - (while (not (eobp)) - (wordstar-center-line) - (forward-line 1))))) - -(defun wordstar-center-line () - "Center the line point is on, within the width specified by `fill-column'. -This means adjusting the indentation to match -the distance between the end of the text and `fill-column'." - (interactive) - (save-excursion - (let (line-length) - (beginning-of-line) - (delete-horizontal-space) - (end-of-line) - (delete-horizontal-space) - (setq line-length (current-column)) - (beginning-of-line) - (indent-to - (+ left-margin - (/ (- fill-column left-margin line-length) 2)))))) - -(defun scroll-down-line () - "Scroll one line down." - (interactive) - (scroll-down 1)) - -(defun scroll-up-line () - "Scroll one line up." - (interactive) - (scroll-up 1)) - -;;;;;;;;;;; -;; wordstar special variables: - -(defvar ws-marker-0 nil "Position marker 0 in WordStar mode.") -(defvar ws-marker-1 nil "Position marker 1 in WordStar mode.") -(defvar ws-marker-2 nil "Position marker 2 in WordStar mode.") -(defvar ws-marker-3 nil "Position marker 3 in WordStar mode.") -(defvar ws-marker-4 nil "Position marker 4 in WordStar mode.") -(defvar ws-marker-5 nil "Position marker 5 in WordStar mode.") -(defvar ws-marker-6 nil "Position marker 6 in WordStar mode.") -(defvar ws-marker-7 nil "Position marker 7 in WordStar mode.") -(defvar ws-marker-8 nil "Position marker 8 in WordStar mode.") -(defvar ws-marker-9 nil "Position marker 9 in WordStar mode.") - -(defvar ws-block-begin-marker nil "Beginning of \"Block\" in WordStar mode.") -(defvar ws-block-end-marker nil "End of \"Block\" in WordStar mode.") - -(defvar ws-search-string nil "String of last search in WordStar mode.") -(defvar ws-search-direction t - "Direction of last search in WordStar mode. T if forward, NIL if backward.") - -(defvar ws-last-cursorposition nil - "Position before last search etc. in WordStar mode.") - -(defvar ws-last-errormessage nil - "Last error message issued by a WordStar mode function.") - -;;;;;;;;;;; -;; wordstar special functions: - -(defun ws-error (string) - "Report error of a WordStar special function. Error message is saved -in ws-last-errormessage for recovery with C-q w." - (setq ws-last-errormessage string) - (error string)) - -(defun ws-set-marker-0 () - "In WordStar mode: Set marker 0 to current cursor position." - (interactive) - (setq ws-marker-0 (point-marker)) - (message "Marker 0 set")) - -(defun ws-set-marker-1 () - "In WordStar mode: Set marker 1 to current cursor position." - (interactive) - (setq ws-marker-1 (point-marker)) - (message "Marker 1 set")) - -(defun ws-set-marker-2 () - "In WordStar mode: Set marker 2 to current cursor position." - (interactive) - (setq ws-marker-2 (point-marker)) - (message "Marker 2 set")) - -(defun ws-set-marker-3 () - "In WordStar mode: Set marker 3 to current cursor position." - (interactive) - (setq ws-marker-3 (point-marker)) - (message "Marker 3 set")) - -(defun ws-set-marker-4 () - "In WordStar mode: Set marker 4 to current cursor position." - (interactive) - (setq ws-marker-4 (point-marker)) - (message "Marker 4 set")) - -(defun ws-set-marker-5 () - "In WordStar mode: Set marker 5 to current cursor position." - (interactive) - (setq ws-marker-5 (point-marker)) - (message "Marker 5 set")) - -(defun ws-set-marker-6 () - "In WordStar mode: Set marker 6 to current cursor position." - (interactive) - (setq ws-marker-6 (point-marker)) - (message "Marker 6 set")) - -(defun ws-set-marker-7 () - "In WordStar mode: Set marker 7 to current cursor position." - (interactive) - (setq ws-marker-7 (point-marker)) - (message "Marker 7 set")) - -(defun ws-set-marker-8 () - "In WordStar mode: Set marker 8 to current cursor position." - (interactive) - (setq ws-marker-8 (point-marker)) - (message "Marker 8 set")) - -(defun ws-set-marker-9 () - "In WordStar mode: Set marker 9 to current cursor position." - (interactive) - (setq ws-marker-9 (point-marker)) - (message "Marker 9 set")) - -(defun ws-begin-block () - "In WordStar mode: Set block begin marker to current cursor position." - (interactive) - (setq ws-block-begin-marker (point-marker)) - (message "Block begin marker set")) - -(defun ws-show-markers () - "In WordStar mode: Show block markers." - (interactive) - (if (or ws-block-begin-marker ws-block-end-marker) - (save-excursion - (if ws-block-begin-marker - (let () - (goto-char ws-block-begin-marker) - (message "Block begin marker") - (sit-for 2)) - (message "Block begin marker not set") - (sit-for 2)) - (if ws-block-end-marker - (let () - (goto-char ws-block-end-marker) - (message "Block end marker") - (sit-for 2)) - (message "Block end marker not set")) - (message "")) - (message "Block markers not set"))) - - -(defun ws-indent-block () - "In WordStar mode: Indent block (not yet implemented)." - (interactive) - (ws-error "Indent block not yet implemented")) - -(defun ws-end-block () - "In WordStar mode: Set block end marker to current cursor position." - (interactive) - (setq ws-block-end-marker (point-marker)) - (message "Block end marker set")) - -(defun ws-print-block () - "In WordStar mode: Print block." - (interactive) - (message "Don't do this. Write block to a file (C-k w) and print this file.")) - -(defun ws-mark-word () - "In WordStar mode: Mark current word as block." - (interactive) - (save-excursion - (forward-word 1) - (sit-for 1) - (ws-end-block) - (forward-word -1) - (sit-for 1) - (ws-begin-block))) - -(defun ws-exdent-block () - "I don't know what this (C-k u) should do." - (interactive) - (ws-error "This won't be done -- not yet implemented.")) - -(defun ws-move-block () - "In WordStar mode: Move block to current cursor position." - (interactive) - (if (and ws-block-begin-marker ws-block-end-marker) - (let () - (kill-region ws-block-begin-marker ws-block-end-marker) - (yank) - (save-excursion - (goto-char (region-beginning)) - (setq ws-block-begin-marker (point-marker)) - (goto-char (region-end)) - (setq ws-block-end-marker (point-marker)))) - (ws-error (cond (ws-block-begin-marker "Block end marker not set") - (ws-block-end-marker "Block begin marker not set") - (t "Block markers not set"))))) - -(defun ws-write-block () - "In WordStar mode: Write block to file." - (interactive) - (if (and ws-block-begin-marker ws-block-end-marker) - (let ((filename (read-file-name "Write block to file: "))) - (write-region ws-block-begin-marker ws-block-end-marker filename)) - (ws-error (cond (ws-block-begin-marker "Block end marker not set") - (ws-block-end-marker "Block begin marker not set") - (t "Block markers not set"))))) - - -(defun ws-delete-block () - "In WordStar mode: Delete block." - (interactive) - (if (and ws-block-begin-marker ws-block-end-marker) - (let () - (kill-region ws-block-begin-marker ws-block-end-marker) - (setq ws-block-end-marker nil) - (setq ws-block-begin-marker nil)) - (ws-error (cond (ws-block-begin-marker "Block end marker not set") - (ws-block-end-marker "Block begin marker not set") - (t "Block markers not set"))))) - -(defun ws-find-marker-0 () - "In WordStar mode: Go to marker 0." - (interactive) - (if ws-marker-0 - (let () - (setq ws-last-cursorposition (point-marker)) - (goto-char ws-marker-0)) - (ws-error "Marker 0 not set"))) - -(defun ws-find-marker-1 () - "In WordStar mode: Go to marker 1." - (interactive) - (if ws-marker-1 - (let () - (setq ws-last-cursorposition (point-marker)) - (goto-char ws-marker-1)) - (ws-error "Marker 1 not set"))) - -(defun ws-find-marker-2 () - "In WordStar mode: Go to marker 2." - (interactive) - (if ws-marker-2 - (let () - (setq ws-last-cursorposition (point-marker)) - (goto-char ws-marker-2)) - (ws-error "Marker 2 not set"))) - -(defun ws-find-marker-3 () - "In WordStar mode: Go to marker 3." - (interactive) - (if ws-marker-3 - (let () - (setq ws-last-cursorposition (point-marker)) - (goto-char ws-marker-3)) - (ws-error "Marker 3 not set"))) - -(defun ws-find-marker-4 () - "In WordStar mode: Go to marker 4." - (interactive) - (if ws-marker-4 - (let () - (setq ws-last-cursorposition (point-marker)) - (goto-char ws-marker-4)) - (ws-error "Marker 4 not set"))) - -(defun ws-find-marker-5 () - "In WordStar mode: Go to marker 5." - (interactive) - (if ws-marker-5 - (let () - (setq ws-last-cursorposition (point-marker)) - (goto-char ws-marker-5)) - (ws-error "Marker 5 not set"))) - -(defun ws-find-marker-6 () - "In WordStar mode: Go to marker 6." - (interactive) - (if ws-marker-6 - (let () - (setq ws-last-cursorposition (point-marker)) - (goto-char ws-marker-6)) - (ws-error "Marker 6 not set"))) - -(defun ws-find-marker-7 () - "In WordStar mode: Go to marker 7." - (interactive) - (if ws-marker-7 - (let () - (setq ws-last-cursorposition (point-marker)) - (goto-char ws-marker-7)) - (ws-error "Marker 7 not set"))) - -(defun ws-find-marker-8 () - "In WordStar mode: Go to marker 8." - (interactive) - (if ws-marker-8 - (let () - (setq ws-last-cursorposition (point-marker)) - (goto-char ws-marker-8)) - (ws-error "Marker 8 not set"))) - -(defun ws-find-marker-9 () - "In WordStar mode: Go to marker 9." - (interactive) - (if ws-marker-9 - (let () - (setq ws-last-cursorposition (point-marker)) - (goto-char ws-marker-9)) - (ws-error "Marker 9 not set"))) - -(defun ws-goto-block-begin () - "In WordStar mode: Go to block begin marker." - (interactive) - (if ws-block-begin-marker - (let () - (setq ws-last-cursorposition (point-marker)) - (goto-char ws-block-begin-marker)) - (ws-error "Block begin marker not set"))) - -(defun ws-search (string) - "In WordStar mode: Search string, remember string for repetition." - (interactive "sSearch for: ") - (message "Forward (f) or backward (b)") - (let ((direction - (read-char))) - (cond ((equal (upcase direction) ?F) - (setq ws-search-string string) - (setq ws-search-direction t) - (setq ws-last-cursorposition (point-marker)) - (search-forward string)) - ((equal (upcase direction) ?B) - (setq ws-search-string string) - (setq ws-search-direction nil) - (setq ws-last-cursorposition (point-marker)) - (search-backward string)) - (t (keyboard-quit))))) - -(defun ws-goto-block-end () - "In WordStar mode: Go to block end marker." - (interactive) - (if ws-block-end-marker - (let () - (setq ws-last-cursorposition (point-marker)) - (goto-char ws-block-end-marker)) - (ws-error "Block end marker not set"))) - -(defun ws-undo () - "In WordStar mode: Undo and give message about undoing more changes." - (interactive) - (undo) - (message "Repeat C-q l to undo more changes.")) - -(defun ws-goto-last-cursorposition () - "In WordStar mode: " - (interactive) - (if ws-last-cursorposition - (let () - (setq ws-last-cursorposition (point-marker)) - (goto-char ws-last-cursorposition)) - (ws-error "No last cursor position available."))) - -(defun ws-last-error () - "In WordStar mode: repeat last error message. -This will only work for errors raised by WordStar mode functions." - (interactive) - (if ws-last-errormessage - (message ws-last-errormessage) - (message "No WordStar error yet."))) - -(defun ws-kill-eol () - "In WordStar mode: Kill to end of line (like WordStar, not like Emacs)." - (interactive) - (let ((p (point))) - (end-of-line) - (kill-region p (point)))) - -(defun ws-kill-bol () - "In WordStar mode: Kill to beginning of line -\(like WordStar, not like Emacs)." - (interactive) - (let ((p (point))) - (beginning-of-line) - (kill-region (point) p))) - -(defun kill-complete-line () - "Kill the complete line." - (interactive) - (beginning-of-line) - (if (eobp) (error "End of buffer")) - (let ((beg (point))) - (forward-line 1) - (kill-region beg (point)))) - -(defun ws-repeat-search () - "In WordStar mode: Repeat last search." - (interactive) - (setq ws-last-cursorposition (point-marker)) - (if ws-search-string - (if ws-search-direction - (search-forward ws-search-string) - (search-backward ws-search-string)) - (ws-error "No search to repeat"))) - -(defun ws-query-replace (from to) - "In WordStar mode: Search string, remember string for repetition." - (interactive "sReplace: -sWith: " ) - (setq ws-search-string from) - (setq ws-search-direction t) - (setq ws-last-cursorposition (point-marker)) - (query-replace from to)) - -(defun ws-copy-block () - "In WordStar mode: Copy block to current cursor position." - (interactive) - (if (and ws-block-begin-marker ws-block-end-marker) - (let () - (copy-region-as-kill ws-block-begin-marker ws-block-end-marker) - (yank) - (save-excursion - (goto-char (region-beginning)) - (setq ws-block-begin-marker (point-marker)) - (goto-char (region-end)) - (setq ws-block-end-marker (point-marker)))) - (ws-error (cond (ws-block-begin-marker "Block end marker not set") - (ws-block-end-marker "Block begin marker not set") - (t "Block markers not set"))))) - -;;; ws-mode.el ends here |