(ido-completing-read prompt collection nil require-match
initial-input history def))
-
-(declare-function iswitchb-read-buffer "iswitchb"
- (prompt &optional default require-match
- _predicate start matches-set))
-(declare-function iswitchb-minibuffer-setup "iswitchb")
-(defvar iswitchb-temp-buflist)
-(defvar iswitchb-mode)
-(defvar iswitchb-make-buflist-hook)
-
-(defun gnus-iswitchb-completing-read (prompt collection &optional require-match
- initial-input history def)
- "`iswitchb' based completing-read function."
- (declare (obsolete nil "29.1"))
- ;; Make sure iswitchb is loaded before we let-bind its variables.
- ;; If it is loaded inside the let, variables can become unbound afterwards.
- (require 'iswitchb)
- (let ((iswitchb-make-buflist-hook
- (lambda ()
- (setq iswitchb-temp-buflist
- (let ((choices (append
- (when initial-input (list initial-input))
- (symbol-value history) collection))
- filtered-choices)
- (dolist (x choices)
- (setq filtered-choices (cl-adjoin x filtered-choices)))
- (nreverse filtered-choices))))))
- (unwind-protect
- (progn
- (or iswitchb-mode
- (add-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup))
- (iswitchb-read-buffer prompt def require-match))
- (or iswitchb-mode
- (remove-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup)))))
-
(defmacro gnus-parse-without-error (&rest body)
"Allow continuing onto the next line even if an error occurs."
(declare (indent 0) (debug t))
;; is cached.
(if last (setcdr last base-size))))))))
-;;;_* Iswitchb compatibility
-
-;; We moved Iswitchb to `obsolete' in 24.4, but autoloads in files in
-;; `obsolete' aren't obeyed (since that would encourage people to keep using
-;; those packages, oblivious to their obsolescence). Given the fact that
-;; Iswitchb was very popular, we decided to keep its autoload for a bit longer,
-;; so we moved it here.
-
-;;;###autoload(when (locate-library "obsolete/iswitchb")
-;;;###autoload (autoload 'iswitchb-mode "iswitchb" "Toggle Iswitchb mode." t)
-;;;###autoload (make-obsolete 'iswitchb-mode
-;;;###autoload "use `icomplete-mode' or `ido-mode' instead." "24.4"))
-
(provide 'icomplete)
;;;_* Local emacs vars.
+++ /dev/null
-;;; isearchb.el --- a marriage between iswitchb and isearch -*- lexical-binding: t -*-
-
-;; Copyright (C) 2004-2024 Free Software Foundation, Inc.
-
-;; Author: John Wiegley <johnw@gnu.org>
-;; Maintainer: emacs-devel@gnu.org
-;; Created: 16 Apr 2004
-;; Version: 1.5
-;; Keywords: lisp
-
-;; 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 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; 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. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This module allows you to switch to buffers even faster than with
-;; iswitchb! It is not intended to replace it, however, as it works
-;; well only with buffers whose names don't typically overlap. You'll
-;; have to try it first, and see how your mileage varies.
-;;
-;; The first way to use isearchb is by holding down a modifier key, in
-;; which case every letter you type while holding it searches for any
-;; buffer matching what you're typing (using the same ordering scheme
-;; employed by iswitchb). To use it this way, add to your .emacs:
-;;
-;; (isearchb-set-keybindings 'super) ; s-x s-y s-z now finds "xyz"
-;;
-;; The other way is by using a command that puts you into "search"
-;; mode, just like with isearch. I use C-z for this. The binding in
-;; my .emacs looks like:
-;;
-;; (define-key global-map [(control ?z)] 'isearchb-activate)
-;;
-;; Now, after pressing C-z (for example), each self-inserting
-;; character thereafter will search for a buffer containing those
-;; characters. For instance, typing "C-z xyz" will switch to the
-;; first buffer containing "xyz". Once you press a non-self-inserting
-;; character (such as any control key sequence), the search will end.
-;;
-;; C-z after C-z toggles between the previously selected buffer and
-;; the current one.
-;;
-;; C-g aborts the search and returns you to your original buffer.
-;;
-;; TAB, after typing in a few characters (after C-z), will jump into
-;; iswitchb, using the prefix you've typed so far. This is handy when
-;; you realize that isearchb is not powerful enough to find the buffer
-;; you're looking for.
-;;
-;; C-s and C-r move forward and backward in the buffer list. If
-;; `isearchb-show-completions' is non-nil (the default), the list of
-;; possible completions is shown in the minibuffer.
-;;
-;; If `isearchb-idle-timeout' is set to a number, isearchb will quit
-;; after that many seconds of idle time. I recommend trying it set to
-;; one or two seconds. Then, if you switch to a buffer and wait for
-;; that amount of time, you can start typing without manually exiting
-;; isearchb.
-
-;; TODO:
-;; C-z C-z is broken
-;; killing iswitchb.el and then trying to switch back is broken
-;; make sure TAB isn't broken
-
-;;; Code:
-
-;; FIXME: Don't rely on iswitchb! See bug#36260.
-(with-suppressed-warnings ((obsolete iswitchb))
- (require 'iswitchb))
-
-(defgroup isearchb nil
- "Switch between buffers using a mechanism like isearch."
- :group 'iswitchb)
-
-(defcustom isearchb-idle-timeout nil
- "Number of idle seconds before isearchb turns itself off.
-If nil, don't use a timeout."
- :type '(choice (integer :tag "Seconds")
- (const :tag "Disable" nil)))
-
-(defcustom isearchb-show-completions t
- "If non-nil, show possible completions in the minibuffer."
- :type 'boolean)
-
-(defvar isearchb-start-buffer nil)
-(defvar isearchb-last-buffer nil)
-(defvar isearchb-idle-timer nil)
-
-(defun isearchb-stop (&optional return-to-buffer ignore-command)
- "Called by isearchb to terminate a search in progress."
- (remove-hook 'pre-command-hook 'isearchb-follow-char)
- (if return-to-buffer
- (switch-to-buffer isearchb-start-buffer)
- (setq isearchb-last-buffer isearchb-start-buffer))
- (when isearchb-idle-timer
- (cancel-timer isearchb-idle-timer)
- (setq isearchb-idle-timer nil))
- (if ignore-command
- (setq this-command 'ignore
- last-command 'ignore))
- (message nil))
-
-(defun isearchb-iswitchb ()
- "isearchb's custom version of the `iswitchb' command.
-Its purpose is to pass different call arguments to
-`iswitchb-read-buffer'."
- (interactive)
- (let* ((prompt "iswitch ")
- (iswitchb-method 'samewindow)
- (buf (iswitchb-read-buffer prompt nil nil nil iswitchb-text t)))
- (if (eq iswitchb-exit 'findfile)
- (call-interactively 'find-file)
- (when buf
- (if (get-buffer buf)
- ;; buffer exists, so view it and then exit
- (iswitchb-visit-buffer buf)
- ;; else buffer doesn't exist
- (iswitchb-possible-new-buffer buf))))))
-
-(defun isearchb ()
- "Switch to buffer matching a substring, based on chars typed."
- (interactive)
- (unless (eq last-command 'isearchb)
- (setq iswitchb-text nil))
- (unless iswitchb-text
- (setq iswitchb-text "")
- (iswitchb-make-buflist nil))
- (if last-command-event
- (setq iswitchb-rescan t
- iswitchb-text (concat iswitchb-text
- (char-to-string
- (event-basic-type last-command-event)))))
- (iswitchb-set-matches)
- (let* ((match (car iswitchb-matches))
- (buf (and match (get-buffer match))))
- (if (null buf)
- (progn
- (isearchb-stop t)
- (isearchb-iswitchb))
- (switch-to-buffer buf)
- (if isearchb-show-completions
- (message "isearchb: %s%s" iswitchb-text
- (iswitchb-completions iswitchb-text))
- (if (= 1 (length iswitchb-matches))
- (message "isearchb: %s (only match)" iswitchb-text)
- (message "isearchb: %s" iswitchb-text))))))
-
-(defun isearchb-set-keybindings (modifier)
- "Setup isearchb on the given MODIFIER."
- (dotimes (i 128)
- (if (eq 'self-insert-command
- (lookup-key global-map (vector i)))
- (define-key global-map (vector (list modifier i)) 'isearchb))))
-
-(defun isearchb-follow-char ()
- "Function added to `post-command-hook' to handle the isearchb \"mode\"."
- (let (keys)
- (if (not (and (memq last-command '(isearchb isearchb-activate))
- (setq keys (this-command-keys))
- (= 1 (length keys))))
- (isearchb-stop)
- (cond
- ((or (equal keys "\C-h") (equal keys "\C-?")
- (equal keys [backspace]) (equal keys [delete]))
- (setq iswitchb-text
- (substring iswitchb-text 0 (1- (length iswitchb-text))))
- (if (= 0 (length iswitchb-text))
- (isearchb-stop t t)
- (setq last-command-event nil)
- (setq this-command 'isearchb)))
- ((or (equal keys "\C-i") (equal keys [tab]))
- (setq this-command 'isearchb-iswitchb))
- ((equal keys "\C-s")
- (iswitchb-next-match)
- (setq last-command-event nil)
- (setq this-command 'isearchb))
- ((equal keys "\C-r")
- (iswitchb-prev-match)
- (setq last-command-event nil)
- (setq this-command 'isearchb))
- ((equal keys "\C-g")
- (ding)
- (isearchb-stop t t))
- ((eq (lookup-key global-map keys) 'self-insert-command)
- (setq this-command 'isearchb)))
- (if (and isearchb-idle-timeout
- (null isearchb-idle-timer))
- (setq isearchb-idle-timer
- (run-with-idle-timer isearchb-idle-timeout nil
- 'isearchb-stop))))))
-
-;;;###autoload
-(defun isearchb-activate ()
- "Active isearchb mode for subsequent alphanumeric keystrokes.
-Executing this command again will terminate the search; or, if
-the search has not yet begun, will toggle to the last buffer
-accessed via isearchb."
- (interactive)
- (cond
- ((eq last-command 'isearchb)
- (isearchb-stop nil t))
- ((eq last-command 'isearchb-activate)
- (if isearchb-last-buffer
- (switch-to-buffer isearchb-last-buffer)
- (error "isearchb: There is no previous buffer to toggle to"))
- (isearchb-stop nil t))
- (t
- (message "isearchb: ")
- (setq iswitchb-text nil
- isearchb-start-buffer (current-buffer))
- (add-hook 'pre-command-hook 'isearchb-follow-char))))
-
-(provide 'isearchb)
-
-;;; isearchb.el ends here
+++ /dev/null
-;;; bruce.el --- bruce phrase utility for overloading the Communications -*- lexical-binding: t; -*-
-;;; Decency Act snoops, if any.
-
-;; Copyright (C) 1988, 1993, 1997, 2001-2024 Free Software Foundation,
-;; Inc.
-
-;; Maintainer: emacs-devel@gnu.org
-;; Keywords: games
-;; Created: Jan 1997
-;; Obsolete-since: 24.3
-
-;; 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 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; 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. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This program was written to protest the miss-named "Communications
-;; Decency Act of 1996. This Act bans "indecent speech", whatever that is,
-;; from the Internet. For more on the CDA, see Richard Stallman's essay on
-;; censorship, included in the etc directory of emacs distributions 19.34
-;; and up. See also https://www.eff.org/blueribbon.html.
-
-;; For many years, emacs has included a program called Spook. This program
-;; adds a series of "keywords" to email just before it goes out. On the
-;; theory that the NSA monitors people's email, the keywords would be
-;; picked up by the NSA's snoop computers, causing them to waste time
-;; reading your meeting schedule notices or other email boring to everyone
-;; but you and (you hope) the recipient. See below (I left in the original
-;; writeup when I made this conversion), or the emacs documentation at
-;; https://www.gnu.org/software/emacs/manual/.
-
-;; Bruce is a direct copy of spook, with the word "spook" replaced with
-;; the word "bruce". Thanks to "esr", whoever he, she or it may be, this
-;; conversion was an extremely easy piece of editing, suitable for a first
-;; essay at elisp programming.
-
-;; You may think of the name as having been derived from a certain Monty
-;; Python routine. Or from Lenny Bruce, who opposed censorship in his own
-;; inimitable way. Bruce does exactly what Spook does: it throws keywords
-;; into your email messages or other documents.
-
-;; However, in order to comply with the CDA as interpreted by Richard
-;; Stallman (see the essay on censorship), bruce is distributed without a
-;; data file from which to select words at random. Sorry about that. I
-;; believe the average user will be able to come up with a few words on
-;; his or her own. If that is a problem, feel free to ask any American
-;; teenager, preferably one who attends a government school. Failing
-;; that, you might write to Mr. Clinton or Ms Reno or their successors and
-;; ask them for suggestions. Think of it as a public spirited act: the
-;; time they spend answering you is time not spent persecuting someone
-;; else. However, do ask them to respond by snail mail, where their
-;; suggestions would be legal.
-
-;; To build the data file, just start a file called bruce.lines in the etc
-;; directory of your emacs distribution. Note that each phrase or word has
-;; to be followed by an ascii 0, control-@. See the file spook.lines in
-;; the etc directory for an example. In emacs, use c-q c-@ to insert the
-;; ascii 0s.
-
-;; Once you have edited up a data file, you have to tell emacs how to find
-;; the program bruce. Add the following two lines to your .emacs file. Be
-;; sure to uncomment the second line.
-
-;; for bruce mode
-;; (autoload 'bruce "bruce" "Use the Bruce program to protest the CDA" t)
-
-;; Shut down emacs and fire it up again. Then "M-x bruce" should put some
-;; shocking words in the current buffer.
-
-
-;; Please note that I am not suggesting that you actually use this program
-;; to add "illegal" words to your email, or any other purpose. First, you
-;; don't really need a program to do it, and second, it would be illegal
-;; for me to suggest or advise that you actually break the law. This
-;; program was written as a demonstration only, and as an act of political
-;; protest and free expression protected by the First Amendment, or
-;; whatever is left of it.
-
-
-;; We now return to the original writeup for spook:
-
-;; Steve Strassmann <straz@media-lab.media.mit.edu> didn't write the
-;; program spook, from which this was adapted, and even if he did, he
-;; really didn't mean for you to use it in an anarchistic way.
-;;
-;; To use this:
-;; Just before sending mail, do M-x spook.
-;; A number of phrases will be inserted into your buffer, to help
-;; give your message that extra bit of attractiveness for automated
-;; keyword scanners. Help defeat the NSA trunk trawler!
-
-;;; Code:
-
-(require 'cookie1)
-
-; Variables
-(defgroup bruce nil
- "Insert phrases selected at random from a file into a buffer."
- :prefix "bruce-"
- :group 'games)
-
-(defcustom bruce-phrases-file "~/bruce.lines"
- "Keep your favorite phrases here."
- :type 'file)
-
-(defcustom bruce-phrase-default-count 15
- "Default number of phrases to insert."
- :type 'integer)
-
-;;;###autoload
-(defun bruce ()
- "Adds that special touch of class to your outgoing mail."
- (interactive)
- (or (file-exists-p bruce-phrases-file)
- (error "You need to create %s" bruce-phrases-file))
- (cookie-insert bruce-phrases-file
- bruce-phrase-default-count
- "Checking authorization..."
- "Checking authorization...Approved"))
-
-;;;###autoload
-(defun snarf-bruces ()
- "Return a vector containing the lines from `bruce-phrases-file'."
- (or (file-exists-p bruce-phrases-file)
- (error "You need to create %s" bruce-phrases-file))
- (cookie-snarf bruce-phrases-file
- "Checking authorization..."
- "Checking authorization...Approved"))
-
-;; Note: the implementation that used to take up most of this file has been
-;; cleaned up, generalized, gratuitously broken by esr, and now resides in
-;; cookie1.el.
-
-(provide 'bruce)
-
-;;; bruce.el ends here
+++ /dev/null
-;;; crisp.el --- CRiSP/Brief Emacs emulator -*- lexical-binding: t; -*-
-
-;; Copyright (C) 1997-1999, 2001-2024 Free Software Foundation, Inc.
-
-;; Author: Gary D. Foster <Gary.Foster@Corp.Sun.COM>
-;; Keywords: emulations brief crisp
-;; Obsolete-since: 24.5
-
-;; 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 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; 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. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; *Note: This package has now moved to elpa.gnu.org.*
-
-;; Keybindings and minor functions to duplicate the functionality and
-;; finger-feel of the CRiSP/Brief editor. This package is designed to
-;; facilitate transitioning from Brief to (XE|E)macs with a minimum
-;; amount of hassles.
-
-;; Enable this package by putting (require 'crisp) in your .emacs and
-;; use M-x crisp-mode to toggle it on or off.
-
-;; This package will automatically load the scroll-all.el package if
-;; you put (setq crisp-load-scroll-all t) in your .emacs before
-;; loading this package. If this feature is enabled, it will bind
-;; meta-f1 to the scroll-all mode toggle. The scroll-all package
-;; duplicates the scroll-all feature in CRiSP.
-
-;; Also, the default keybindings for brief/CRiSP override the M-x
-;; key to exit the editor. If you don't like this functionality, you
-;; can prevent this behavior (or redefine it dynamically) by setting
-;; the value of `crisp-override-meta-x' either in your .emacs or
-;; interactively. The default setting is t, which means that M-x will
-;; by default run `save-buffers-kill-emacs' instead of the command
-;; `execute-extended-command'.
-
-;; Finally, if you want to change the string displayed in the mode
-;; line when this mode is in effect, override the definition of
-;; `crisp-mode-mode-line-string' in your .emacs. The default value is
-;; " *Crisp*" which may be a bit lengthy if you have a lot of things
-;; being displayed there.
-
-;; All these overrides should go *before* the (require 'crisp) statement.
-
-;;; Code:
-
-;; local variables
-
-(defgroup crisp nil
- "Emulator for CRiSP and Brief key bindings."
- :prefix "crisp-"
- :group 'emulations)
-
-(defvar crisp-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [(f1)] #'other-window)
-
- (define-key map [(f2) (down)] #'enlarge-window)
- (define-key map [(f2) (left)] #'shrink-window-horizontally)
- (define-key map [(f2) (right)] #'enlarge-window-horizontally)
- (define-key map [(f2) (up)] #'shrink-window)
- (define-key map [(f3) (down)] #'split-window-below)
- (define-key map [(f3) (right)] #'split-window-right)
-
- (define-key map [(f4)] #'delete-window)
- (define-key map [(control f4)] #'delete-other-windows)
-
- (define-key map [(f5)] #'search-forward-regexp)
- (define-key map [(f19)] #'search-forward-regexp)
- (define-key map [(meta f5)] #'search-backward-regexp)
-
- (define-key map [(f6)] #'query-replace)
-
- (define-key map [(f7)] #'start-kbd-macro)
- (define-key map [(meta f7)] #'end-kbd-macro)
-
- (define-key map [(f8)] #'call-last-kbd-macro)
- ;;(define-key map [(meta f8)] #'save-kbd-macro) ;FIXME:Unknown command?
-
- (define-key map [(f9)] #'find-file)
- (define-key map [(meta f9)] #'load-library)
-
- (define-key map [(f10)] #'execute-extended-command)
- (define-key map [(meta f10)] #'compile)
-
- (define-key map [(SunF37)] #'kill-buffer)
- (define-key map [(kp-add)] #'crisp-copy-line)
- (define-key map [(kp-subtract)] #'crisp-kill-line)
- ;; just to cover all the bases (GNU Emacs, for instance)
- (define-key map [(f24)] #'crisp-kill-line)
- (define-key map [(insert)] #'crisp-yank-clipboard)
- (define-key map [(f16)] #'crisp-set-clipboard) ; copy on Sun5 kbd
- (define-key map [(f20)] #'crisp-kill-region) ; cut on Sun5 kbd
- (define-key map [(f18)] #'crisp-yank-clipboard) ; paste on Sun5 kbd
-
- ;; (define-key map [(control f)] #'fill-paragraph-or-region)
- (define-key map [(meta d)] (lambda ()
- (interactive)
- (beginning-of-line) (kill-line)))
- (define-key map [(meta e)] #'find-file)
- (define-key map [(meta g)] #'goto-line)
- (define-key map [(meta h)] #'help)
- (define-key map [(meta i)] #'overwrite-mode)
- (define-key map [(meta j)] #'bookmark-jump)
- (define-key map [(meta l)] #'crisp-mark-line)
- (define-key map [(meta m)] #'set-mark-command)
- (define-key map [(meta n)] #'bury-buffer)
- (define-key map [(meta p)] #'crisp-unbury-buffer)
- (define-key map [(meta u)] #'undo)
- (define-key map [(f14)] #'undo)
- (define-key map [(meta w)] #'save-buffer)
- (define-key map [(meta x)] #'crisp-meta-x-wrapper)
- (define-key map [(meta ?0)] (lambda ()
- (interactive)
- (bookmark-set "0")))
- (define-key map [(meta ?1)] (lambda ()
- (interactive)
- (bookmark-set "1")))
- (define-key map [(meta ?2)] (lambda ()
- (interactive)
- (bookmark-set "2")))
- (define-key map [(meta ?3)] (lambda ()
- (interactive)
- (bookmark-set "3")))
- (define-key map [(meta ?4)] (lambda ()
- (interactive)
- (bookmark-set "4")))
- (define-key map [(meta ?5)] (lambda ()
- (interactive)
- (bookmark-set "5")))
- (define-key map [(meta ?6)] (lambda ()
- (interactive)
- (bookmark-set "6")))
- (define-key map [(meta ?7)] (lambda ()
- (interactive)
- (bookmark-set "7")))
- (define-key map [(meta ?8)] (lambda ()
- (interactive)
- (bookmark-set "8")))
- (define-key map [(meta ?9)] (lambda ()
- (interactive)
- (bookmark-set "9")))
-
- (define-key map [(shift delete)] #'kill-word)
- (define-key map [(shift backspace)] #'backward-kill-word)
- (define-key map [(control left)] #'backward-word)
- (define-key map [(control right)] #'forward-word)
-
- (define-key map [(home)] #'crisp-home)
- (define-key map [(control home)] (lambda ()
- (interactive)
- (move-to-window-line 0)))
- (define-key map [(meta home)] #'beginning-of-line)
- (define-key map [(end)] #'crisp-end)
- (define-key map [(control end)] (lambda ()
- (interactive)
- (move-to-window-line -1)))
- (define-key map [(meta end)] #'end-of-line)
- map)
- "Local keymap for CRiSP emulation mode.
-All the bindings are done here instead of globally to try and be
-nice to the world.")
-
-(defcustom crisp-mode-mode-line-string " *CRiSP*"
- "String to display in the mode line when CRiSP emulation mode is enabled."
- :type 'string)
-
-;;;###autoload
-(defcustom crisp-mode nil
- "Track status of CRiSP emulation mode.
-A value of nil means CRiSP mode is not enabled. A value of t
-indicates CRiSP mode is enabled.
-
-Setting this variable directly does not take effect;
-use either M-x customize or the function `crisp-mode'."
- :set (lambda (_symbol value) (crisp-mode (if value 1 0)))
- :initialize #'custom-initialize-default
- :require 'crisp
- :version "20.4"
- :type 'boolean)
-
-(defcustom crisp-override-meta-x t
- "Controls overriding the normal Emacs M-x key binding in the CRiSP emulator.
-Normally the CRiSP emulator rebinds M-x to `save-buffers-exit-emacs', and
-provides the usual M-x functionality on the F10 key. If this variable
-is non-nil, M-x will exit Emacs."
- :type 'boolean)
-
-(defcustom crisp-load-scroll-all nil
- "Controls loading of the Scroll Lock in the CRiSP emulator.
-Its default behavior is to load and enable the Scroll Lock minor mode
-package when enabling the CRiSP emulator.
-
-If this variable is nil when you start the CRiSP emulator, it
-does not load the scroll-all package."
- :type 'boolean)
-
-(defcustom crisp-load-hook nil
- "Hooks to run after loading the CRiSP emulator package."
- :type 'hook)
-
-(defcustom crisp-mode-hook nil
- "Hook run by the function `crisp-mode'."
- :type 'hook)
-
-(defconst crisp-version "1.34"
- "The version of the CRiSP emulator.")
-
-(defconst crisp-mode-help-address "gfoster@suzieq.ml.org"
- "The email address of the CRiSP mode author/maintainer.")
-
-;; Silence the byte-compiler.
-(defvar crisp-last-last-command nil
- "The previous value of `last-command'.")
-
-;; The cut and paste routines are different between XEmacs and Emacs
-;; so we need to set up aliases for the functions.
-(defalias 'crisp-set-clipboard 'clipboard-kill-ring-save)
-(defalias 'crisp-kill-region 'clipboard-kill-region)
-(defalias 'crisp-yank-clipboard 'clipboard-yank)
-
-(defun crisp-region-active ()
- "Compatibility function to test for an active region."
- mark-active)
-
-(defun crisp-version (&optional arg)
- "Version number of the CRiSP emulator package.
-If ARG, insert results at point."
- (interactive "P")
- (let ((foo (concat "CRiSP version " crisp-version)))
- (if arg
- (insert (message foo))
- (message foo))))
-
-(defun crisp-mark-line (arg)
- "Set mark at the end of the line.
-Arg works as in `end-of-line'."
- (interactive "p")
- (let (newmark)
- (save-excursion
- (end-of-line arg)
- (setq newmark (point)))
- (push-mark newmark nil t)))
-
-(defun crisp-kill-line (arg)
- "Mark and kill line(s).
-Marks from point to end of the current line (honoring prefix arguments),
-copies the region to the kill ring and clipboard, and then deletes it."
- (interactive "*p")
- (if (crisp-region-active)
- (call-interactively 'crisp-kill-region)
- (crisp-mark-line arg)
- (call-interactively 'crisp-kill-region)))
-
-(defun crisp-copy-line (arg)
- "Mark and copy line(s).
-Marks from point to end of the current line (honoring prefix arguments),
-copies the region to the kill ring and clipboard, and then deactivates
-the region."
- (interactive "*p")
- (if (crisp-region-active)
- (call-interactively 'crisp-set-clipboard)
- (crisp-mark-line arg)
- (call-interactively 'crisp-set-clipboard))
- ;; clear the region after the operation is complete
- ;; XEmacs does this automagically, Emacs doesn't.
- (if (boundp 'mark-active)
- (setq mark-active nil)))
-
-(defun crisp-home ()
- "\"Home\" the point, the way CRiSP would do it.
-The first use moves point to beginning of the line. Second
-consecutive use moves point to beginning of the screen. Third
-consecutive use moves point to the beginning of the buffer."
- (interactive nil)
- (cond
- ((and (eq last-command 'crisp-home)
- (eq crisp-last-last-command 'crisp-home))
- (goto-char (point-min)))
- ((eq last-command 'crisp-home)
- (move-to-window-line 0))
- (t
- (beginning-of-line)))
- (setq crisp-last-last-command last-command))
-
-(defun crisp-end ()
- "\"End\" the point, the way CRiSP would do it.
-The first use moves point to end of the line. Second
-consecutive use moves point to the end of the screen. Third
-consecutive use moves point to the end of the buffer."
- (interactive nil)
- (cond
- ((and (eq last-command 'crisp-end)
- (eq crisp-last-last-command 'crisp-end))
- (goto-char (point-max)))
- ((eq last-command 'crisp-end)
- (move-to-window-line -1)
- (end-of-line))
- (t
- (end-of-line)))
- (setq crisp-last-last-command last-command))
-
-(defun crisp-unbury-buffer ()
- "Go back one buffer."
- (interactive)
- (switch-to-buffer (car (last (buffer-list)))))
-
-(defun crisp-meta-x-wrapper ()
- "Wrapper function to conditionally override the normal M-x bindings.
-When `crisp-override-meta-x' is non-nil, M-x will exit Emacs (the
-normal CRiSP binding) and when it is nil M-x will run
-`execute-extended-command' (the normal Emacs binding)."
- (interactive)
- (if crisp-override-meta-x
- (save-buffers-kill-emacs)
- (call-interactively 'execute-extended-command)))
-
-;;;###autoload
-(define-minor-mode crisp-mode
- "Toggle CRiSP/Brief emulation (CRiSP mode)."
- :keymap crisp-mode-map
- :lighter crisp-mode-mode-line-string
- (when crisp-mode
- ;; Make menu entries show M-u or f14 in preference to C-x u.
- (put 'undo :advertised-binding
- `([?\M-u] [f14] ,@(get 'undo :advertised-binding)))
- ;; Force transient-mark-mode, so that the marking routines work as
- ;; expected. If the user turns off transient mark mode, most
- ;; things will still work fine except the crisp-(copy|kill)
- ;; functions won't work quite as nicely when regions are marked
- ;; differently and could really confuse people. Caveat emptor.
- (if (fboundp 'transient-mark-mode)
- (transient-mark-mode t))
- (if crisp-load-scroll-all
- (require 'scroll-all))
- (if (featurep 'scroll-all)
- (define-key crisp-mode-map [(meta f1)] #'scroll-all-mode))))
-
-;; People might use Apropos on `brief'.
-;;;###autoload
-(defalias 'brief-mode #'crisp-mode)
-
-(run-hooks 'crisp-load-hook)
-(provide 'crisp)
-
-;;; crisp.el ends here
+++ /dev/null
-;;; gulp.el --- ask for updates for Lisp packages -*- lexical-binding: t; -*-
-
-;; Copyright (C) 1996, 2001-2024 Free Software Foundation, Inc.
-
-;; Author: Sam Shteingold <shteingd@math.ucla.edu>
-;; Maintainer: emacs-devel@gnu.org
-;; Keywords: maint
-;; Obsolete-since: 25.1
-
-;; 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 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; 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. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Search the emacs/{version}/lisp directory for *.el files, extract the
-;; name of the author or maintainer and send him e-mail requesting
-;; update.
-
-;;; Code:
-(defgroup gulp nil
- "Ask for updates for Lisp packages."
- :prefix "-"
- :group 'maint)
-
-(defcustom gulp-discard "^;+ *Maintainer: *\\(FSF\\|emacs-devel@gnu\\.org\\) *$"
- "The regexp matching the packages not requiring the request for updates."
- :version "24.4" ; added emacs-devel
- :type 'regexp)
-
-(defcustom gulp-tmp-buffer "*gulp*"
- "The name of the temporary buffer."
- :type 'string)
-
-(defcustom gulp-max-len 2000
- "Distance into a Lisp source file to scan for keywords."
- :type 'integer)
-
-(defcustom gulp-request-header
- (concat
- "This message was created automatically.
-I'm going to start pretesting a new version of GNU Emacs soon, so I'd
-like to ask if you have any updates for the Emacs packages you work on.
-You're listed as the maintainer of the following package(s):\n\n")
- "The starting text of a gulp message."
- :type 'string)
-
-(defcustom gulp-request-end
- (concat
- "\nIf you have any changes since the version in the previous release ("
- (format "%d.%d" emacs-major-version emacs-minor-version)
- "),
-please send them to me ASAP.
-
-Please don't send the whole file. Instead, please send a patch made with
-`diff -c' that shows precisely the changes you would like me to install.
-Also please include itemized change log entries for your changes;
-please use lisp/ChangeLog* as a guide for the style and for what kinds
-of information to include.
-
-Thanks.")
- "The closing text in a gulp message."
- :type 'string)
-
-(declare-function mail-subject "sendmail" ())
-(declare-function mail-send "sendmail" ())
-
-(defun gulp-send-requests (dir &optional time)
- "Send requests for updates to the authors of Lisp packages in directory DIR.
-For each maintainer, the message consists of `gulp-request-header',
-followed by the list of packages (with modification times if the optional
-prefix argument TIME is non-nil), concluded with `gulp-request-end'.
-
-You can't edit the messages, but you can confirm whether to send each one.
-
-The list of addresses for which you decided not to send mail
-is left in the `*gulp*' buffer at the end."
- (interactive "DRequest updates for Lisp directory: \nP")
- (with-current-buffer (get-buffer-create gulp-tmp-buffer)
- (let ((m-p-alist (gulp-create-m-p-alist
- (directory-files dir nil "\\`[^=].*\\.el\\'" t)
- dir))
- ;; Temporarily inhibit undo in the *gulp* buffer.
- (buffer-undo-list t)
- mail-setup-hook msg node)
- (setq m-p-alist
- (sort m-p-alist
- (function (lambda (a b)
- (string< (car a) (car b))))))
- (while (setq node (car m-p-alist))
- (setq msg (gulp-create-message (cdr node) time))
- (setq mail-setup-hook
- (lambda ()
- (mail-subject)
- (insert "It's time for Emacs updates again")
- (goto-char (point-max))
- (insert msg)))
- (mail nil (car node))
- (goto-char (point-min))
- (if (y-or-n-p "Send? ") (mail-send)
- (kill-this-buffer)
- (set-buffer gulp-tmp-buffer)
- (insert (format "%s\n\n" node)))
- (setq m-p-alist (cdr m-p-alist))))
- (set-buffer gulp-tmp-buffer)
- (setq buffer-undo-list nil)))
-
-
-(defun gulp-create-message (rec time)
- "Return the message string for REC, which is a list like (FILE TIME)."
- (let (node (str gulp-request-header))
- (while (setq node (car rec))
- (setq str (concat str "\t" (car node)
- (if time (concat "\tLast modified:\t" (cdr node)))
- "\n"))
- (setq rec (cdr rec)))
- (concat str gulp-request-end)))
-
-
-(defun gulp-create-m-p-alist (flist dir)
- "Create the maintainer/package alist for files in FLIST in DIR.
-That is a list of elements, each of the form (MAINTAINER PACKAGES...)."
- (save-excursion
- (let (mplist filen node mnt tm fl-tm)
- (get-buffer-create gulp-tmp-buffer)
- (set-buffer gulp-tmp-buffer)
- (setq buffer-undo-list t)
- (while flist
- (setq fl-tm (gulp-maintainer (setq filen (car flist)) dir))
- (if (setq tm (cdr fl-tm) mnt (car fl-tm));; there is a definite maintainer
- (if (setq node (assoc mnt mplist));; this is not a new maintainer
- (setq mplist (cons (cons mnt (cons (cons filen tm) (cdr node)))
- (delete node mplist)))
- (setq mplist (cons (list mnt (cons filen (cdr fl-tm))) mplist))))
- (setq flist (cdr flist)))
- (erase-buffer)
- mplist)))
-
-(defun gulp-maintainer (filenm dir)
- "Return a list (MAINTAINER TIMESTAMP) for the package FILENM in directory DIR."
- (save-excursion
- (let* ((fl (expand-file-name filenm dir)) mnt
- (timest (format-time-string "%Y-%m-%d %a %T %Z"
- (elt (file-attributes fl) 5))))
- (set-buffer gulp-tmp-buffer)
- (erase-buffer)
- (insert-file-contents fl nil 0 gulp-max-len)
- (goto-char 1)
- (if (re-search-forward gulp-discard nil t)
- (setq mnt nil) ;; do nothing, return nil
- (goto-char 1)
- (if (and (re-search-forward "^;+ *Maintainer: \\(.*\\)$" nil t)
- (> (length (setq mnt (match-string 1))) 0))
- () ;; found!
- (goto-char 1)
- (if (re-search-forward "^;+ *Author: \\(.*\\)$" nil t)
- (setq mnt (match-string 1))))
- (if (= (length mnt) 0) (setq mnt nil))) ;; "^;; Author: $" --> nil
- (cons mnt timest))))
-
-(provide 'gulp)
-
-;;; gulp.el ends here
+++ /dev/null
-;;; info-edit.el --- Editing info files -*- lexical-binding:t -*-
-
-;; Copyright (C) 1985-1986, 1992-2024 Free Software Foundation, Inc.
-
-;; Maintainer: emacs-devel@gnu.org
-;; Keywords: help
-;; Obsolete-since: 24.4
-
-;; 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 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; 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. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'info)
-
-(defvar Info-edit-mode-hook nil
- "Hook run when `Info-edit-mode' is activated.")
-
-(make-obsolete-variable 'Info-edit-mode-hook
- "editing Info nodes by hand is not recommended." "24.4")
-
-(defvar Info-edit-mode-map (let ((map (make-sparse-keymap)))
- (set-keymap-parent map text-mode-map)
- (define-key map "\C-c\C-c" #'Info-cease-edit)
- map)
- "Local keymap used within `e' command of Info.")
-
-(make-obsolete-variable 'Info-edit-mode-map
- "editing Info nodes by hand is not recommended."
- "24.4")
-
-;; Info-edit mode is suitable only for specially formatted data.
-(put 'Info-edit-mode 'mode-class 'special)
-
-(define-derived-mode Info-edit-mode text-mode "Info Edit"
- "Major mode for editing the contents of an Info node.
-Like text mode with the addition of `Info-cease-edit'
-which returns to Info mode for browsing."
- (setq buffer-read-only nil)
- (force-mode-line-update)
- (buffer-enable-undo (current-buffer)))
-
-(defun Info-edit ()
- "Edit the contents of this Info node."
- (interactive)
- (Info-edit-mode)
- (message "%s" (substitute-command-keys
- "Editing: Type \\<Info-edit-mode-map>\\[Info-cease-edit] to return to info")))
-
-(put 'Info-edit 'disabled "Editing Info nodes by hand is not recommended.
-This feature will be removed in future.")
-
-(defun Info-cease-edit ()
- "Finish editing Info node; switch back to Info proper."
- (interactive)
- ;; Do this first, so nothing has changed if user C-g's at query.
- (and (buffer-modified-p)
- (y-or-n-p "Save the file? ")
- (save-buffer))
- (Info-mode)
- (force-mode-line-update)
- (and (marker-position Info-tag-table-marker)
- (buffer-modified-p)
- (message "Tags may have changed. Use Info-tagify if necessary")))
-
-(with-eval-after-load 'ibuffer
- (defvar ibuffer-help-buffer-modes)
- ;; Moved here from definition of ibuffer-help-buffer-modes to make
- ;; that variable customizable even though this code is obsolete. See
- ;; also Bug#30990.
- (add-to-list 'ibuffer-help-buffer-modes 'Info-edit-mode))
-
-(provide 'info-edit)
-
-;;; info-edit.el ends here
+++ /dev/null
-;;; iswitchb.el --- switch between buffers using substrings -*- lexical-binding: t; -*-
-
-;; Copyright (C) 1996-1997, 2000-2024 Free Software Foundation, Inc.
-
-;; Author: Stephen Eglen <stephen@gnu.org>
-;; Keywords: completion convenience
-;; Obsolete-since: 24.4
-
-;; 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 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; 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. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file is obsolete - use icomplete-mode or ido-mode instead.
-
-;; Installation:
-;; To get the functions in this package bound to keys, use
-;; M-x iswitchb-mode or customize the option `iswitchb-mode'.
-;; Alternatively, add the following line to your .emacs:
-;; (iswitchb-mode 1)
-
-;; As you type in a substring, the list of buffers currently matching
-;; the substring is displayed as you type. The list is ordered so
-;; that the most recent buffers visited come at the start of the list.
-;; The buffer at the start of the list will be the one visited when
-;; you press return. By typing more of the substring, the list is
-;; narrowed down so that gradually the buffer you want will be at the
-;; top of the list. Alternatively, you can use C-s and C-r to rotate
-;; buffer names in the list until the one you want is at the top of
-;; the list. Completion is also available so that you can see what is
-;; common to all of the matching buffers as you type.
-
-;; This code is similar to a couple of other packages. Michael R Cook
-;; <cook@sightpath.com> wrote a similar buffer switching package, but
-;; does exact matching rather than substring matching on buffer names.
-;; I also modified a couple of functions from icomplete.el to provide
-;; the completion feedback in the minibuffer.
-
-;;; Example
-
-;; If I have two buffers called "123456" and "123", with "123456" the
-;; most recent, when I use iswitchb, I first of all get presented with
-;; the list of all the buffers
-;;
-;; iswitch {123456,123}
-;;
-;; If I then press 2:
-;; iswitch 2[3]{123456,123}
-;;
-;; The list in {} are the matching buffers, most recent first (buffers
-;; visible in the current frame are put at the end of the list by
-;; default). At any time I can select the item at the head of the
-;; list by pressing RET. I can also put the first element at the end
-;; of the list by pressing C-s, or put the last element at the head of
-;; the list by pressing C-r. The item in [] indicates what can be
-;; added to my input by pressing TAB. In this case, I will get "3"
-;; added to my input. So, press TAB:
-;; iswitch 23{123456,123}
-;;
-;; At this point, I still have two matching buffers.
-;; If I want the first buffer in the list, I simply press RET. If I
-;; wanted the second in the list, I could press C-s to move it to the
-;; top of the list and then RET to select it.
-;;
-;; However, if I type 4, I only have one match left:
-;; iswitch 234[123456] [Matched]
-;;
-;; Since there is only one matching buffer left, it is given in [] and we
-;; see the text [Matched] afterwards. I can now press TAB or RET to go
-;; to that buffer.
-;;
-;; If however, I now type "a":
-;; iswitch 234a [No match]
-;; There are no matching buffers. If I press RET or TAB, I can be
-;; prompted to create a new buffer called "234a".
-;;
-;; Of course, where this function comes in really useful is when you
-;; can specify the buffer using only a few keystrokes. In the above
-;; example, the quickest way to get to the "123456" buffer would be
-;; just to type 4 and then RET (assuming there isn't any newer buffer
-;; with 4 in its name).
-
-;; To see a full list of all matching buffers in a separate buffer,
-;; hit ? or press TAB when there are no further completions to the
-;; substring. Repeated TAB presses will scroll you through this
-;; separate buffer.
-
-;; The buffer at the head of the list can be killed by pressing C-k.
-;; If the buffer needs saving, you will be queried before the buffer
-;; is killed.
-
-;; If you find that the file you are after is not in a buffer, you can
-;; press C-x C-f to immediately drop into find-file.
-
-;; See the doc string of iswitchb for full keybindings and features.
-;; (describe-function 'iswitchb)
-
-;; Case matching: The case of strings when matching can be ignored or
-;; used depending on the value of iswitchb-case (default is the same
-;; as case-fold-search, normally t). Imagine you have the following
-;; buffers:
-;;
-;; INBOX *info* *scratch*
-;;
-;; Then these will be the matching buffers, depending on how you type
-;; the two letters `in' and the value of iswitchb-case:
-;;
-;; iswitchb-case user input | matching buffers
-;; ----------------------------------------------
-;; nil in | *info*
-;; t in | INBOX, *info*
-;; t IN | INBOX
-;; t In | [No match]
-
-;;; Customization
-
-;; See the User Variables section below for easy ways to change the
-;; functionality of the program. These are accessible using the
-;; custom package.
-;; To modify the keybindings, use something like:
-;;
-;;(add-hook 'iswitchb-mode-hook 'iswitchb-my-keys)
-;;(defun iswitchb-my-keys ()
-;; "Add my keybindings for iswitchb."
-;; (define-key iswitchb-mode-map " " 'iswitchb-next-match))
-;;
-;; Seeing all the matching buffers
-;;
-;; If you have many matching buffers, they may not all fit onto one
-;; line of the minibuffer. In Emacs 21, the variable
-;; `resize-mini-windows' controls how many lines of the minibuffer can
-;; be seen. For older versions of emacs, you can use
-;; `resize-minibuffer-mode'. You can also limit iswitchb so that it
-;; only shows a certain number of lines -- see the documentation for
-;; `iswitchb-minibuffer-setup-hook'.
-
-;; Changing the list of buffers
-
-;; By default, the list of current buffers is most recent first,
-;; oldest last, with the exception that the buffers visible in the
-;; current frame are put at the end of the list. A hook exists to
-;; allow other functions to order the list. For example, if you add:
-;;
-;; (add-hook 'iswitchb-make-buflist-hook 'iswitchb-summaries-to-end)
-;;
-;; then all buffers matching "Summary" are moved to the end of the
-;; list. (I find this handy for keeping the INBOX Summary and so on
-;; out of the way.) It also moves buffers matching "output\*$" to the
-;; end of the list (these are created by AUCTeX when compiling.)
-;; Other functions could be made available which alter the list of
-;; matching buffers (either deleting or rearranging elements.)
-
-;; Font-Lock
-
-;; font-lock is used to highlight the first matching buffer. To
-;; switch this off, set (setq iswitchb-use-faces nil). Coloring of
-;; the matching buffer name was suggested by Carsten Dominik
-;; (dominik@strw.leidenuniv.nl)
-
-;; Replacement for read-buffer
-
-;; iswitchb-read-buffer has been written to be a drop in replacement
-;; for the normal buffer selection routine `read-buffer'. To use
-;; iswitch for all buffer selections in Emacs, add:
-;; (setq read-buffer-function #'iswitchb-read-buffer)
-;; (This variable was introduced in Emacs 20.3.)
-
-;; Using iswitchb for other completion tasks.
-
-;; Kin Cho (kin@neoscale.com) sent the following suggestion to use
-;; iswitchb for other completion tasks.
-;;
-;; (defun my-icompleting-read (prompt choices)
-;; "Use iswitch as a completing-read replacement to choose from
-;; choices. PROMPT is a string to prompt with. CHOICES is a list of
-;; strings to choose from."
-;; (let ((iswitchb-make-buflist-hook
-;; (lambda ()
-;; (setq iswitchb-temp-buflist choices))))
-;; (iswitchb-read-buffer prompt)))
-;;
-;; example:
-;; (my-icompleting-read "Which fruit? " '
-;; ("apple" "pineapple" "pear" "bananas" "oranges") )
-
-;; Kin Cho also suggested the following defun. Once you have a subset of
-;; matching buffers matching your current prompt, you can then press
-;; e.g. C-o to restrict matching to those buffers and clearing the prompt:
-;; (defun iswitchb-exclude-nonmatching()
-;; "Make iswitchb work on only the currently matching names."
-;; (interactive)
-;; (setq iswitchb-buflist iswitchb-matches)
-;; (setq iswitchb-rescan t)
-;; (delete-minibuffer-contents))
-;;
-;; (add-hook 'iswitchb-define-mode-map-hook
-;; (lambda () (define-key
-;; iswitchb-mode-map "\C-o"
-;; 'iswitchb-exclude-nonmatching)))
-
-;; Other lisp packages extend iswitchb behavior to other tasks. See
-;; ido.el (by Kim Storm) and mcomplete.el (Yuji Minejima).
-
-;; Window managers: Switching frames/focus follows mouse; Sawfish.
-
-;; If you switch to a buffer that is visible in another frame,
-;; iswitchb can switch focus to that frame. If your window manager
-;; uses "click to focus" policy for window selection, you should also
-;; set focus-follows-mouse to nil.
-
-;; iswitch functionality has also been implemented for switching
-;; between windows in the Sawfish window manager.
-
-;; Regexp matching
-
-;; There is provision for regexp matching within iswitchb, enabled
-;; through `iswitchb-regexp'. This allows you to type `c$' for
-;; example and see all buffer names ending in `c'. No completion
-;; mechanism is currently offered when regexp searching.
-
-;;; TODO
-
-;;; Acknowledgments
-
-;; Thanks to Jari Aalto <jari.aalto@poboxes.com> for help with the
-;; first version of this package, iswitch-buffer. Thanks also to many
-;; others for testing earlier versions.
-
-;;; Code:
-
-(require 'font-lock)
-
-;;; User Variables
-;;
-;; These are some things you might want to change.
-
-(defgroup iswitchb nil
- "Switch between buffers using substrings."
- :group 'convenience
- :group 'completion
- :link '(emacs-commentary-link :tag "Commentary" "iswitchb.el")
- :link '(url-link "https://www.anc.ed.ac.uk/~stephen/emacs/")
- :link '(emacs-library-link :tag "Lisp File" "iswitchb.el"))
-
-(defcustom iswitchb-case case-fold-search
- "Non-nil if searching of buffer names should ignore case.
-If this is non-nil but the user input has any upper case letters, matching
-is temporarily case sensitive."
- :type 'boolean)
-
-(defcustom iswitchb-buffer-ignore
- '("^ ")
- "List of regexps or functions matching buffer names to ignore.
-For example, traditional behavior is not to list buffers whose names begin
-with a space, for which the regexp is `^ '. See the source file for
-example functions that filter buffer names."
- :type '(repeat (choice regexp function)))
-(put 'iswitchb-buffer-ignore 'risky-local-variable t)
-
-(defcustom iswitchb-max-to-show nil
- "If non-nil, limit the number of names shown in the minibuffer.
-If this value is N, and N is greater than the number of matching
-buffers, the first N/2 and the last N/2 matching buffers are
-shown. This can greatly speed up iswitchb if you have a
-multitude of buffers open."
- :type '(choice (const :tag "Show all" nil) integer))
-
-(defcustom iswitchb-use-virtual-buffers nil
- "If non-nil, refer to past buffers when none match.
-This feature relies upon the `recentf' package, which will be
-enabled if this variable is configured to a non-nil value."
- :type 'boolean
- :require 'recentf
- :set (function
- (lambda (sym value)
- (if value (recentf-mode 1))
- (set sym value))))
-
-(defvar iswitchb-virtual-buffers nil)
-
-(defcustom iswitchb-cannot-complete-hook 'iswitchb-completion-help
- "Hook run when `iswitchb-complete' can't complete any more.
-The most useful values are `iswitchb-completion-help', which pops up a
-window with completion alternatives, or `iswitchb-next-match' or
-`iswitchb-prev-match', which cycle the buffer list."
- :type 'hook)
-
-;; Examples for setting the value of iswitchb-buffer-ignore
-;;(defun iswitchb-ignore-c-mode (name)
-;; "Ignore all c mode buffers -- example function for iswitchb."
-;; (with-current-buffer name
-;; (derived-mode-p 'c-mode)))
-
-;;(setq iswitchb-buffer-ignore '("^ " iswitchb-ignore-c-mode))
-;;(setq iswitchb-buffer-ignore '("^ " "\\.c\\'" "\\.h\\'"))
-
-(defcustom iswitchb-default-method 'always-frame
- "How to switch to new buffer when using `iswitchb-buffer'.
-Possible values:
-`samewindow' Show new buffer in same window
-`otherwindow' Show new buffer in another window (same frame)
-`display' Display buffer in another window without switching to it
-`otherframe' Show new buffer in another frame
-`maybe-frame' If a buffer is visible in another frame, prompt to ask if
- you want to see the buffer in the same window of the current
- frame or in the other frame.
-`always-frame' If a buffer is visible in another frame, raise that
- frame. Otherwise, visit the buffer in the same window."
- :type '(choice (const samewindow)
- (const otherwindow)
- (const display)
- (const otherframe)
- (const maybe-frame)
- (const always-frame)))
-
-(defcustom iswitchb-regexp nil
- "Non-nil means that `iswitchb' will do regexp matching.
-Value can be toggled within `iswitchb' using `iswitchb-toggle-regexp'."
- :type 'boolean)
-
-(defcustom iswitchb-newbuffer t
- "Non-nil means create new buffer if no buffer matches substring.
-See also `iswitchb-prompt-newbuffer'."
- :type 'boolean)
-
-(defcustom iswitchb-prompt-newbuffer t
- "Non-nil means prompt user to confirm before creating new buffer.
-See also `iswitchb-newbuffer'."
- :type 'boolean)
-
-(defcustom iswitchb-use-faces t
- "Non-nil means use font-lock faces for showing first match."
- :type 'boolean)
-
-(defcustom iswitchb-use-frame-buffer-list nil
- "Non-nil means use the currently selected frame's buffer list."
- :type 'boolean)
-
-(defcustom iswitchb-make-buflist-hook nil
- "Hook to run when list of matching buffers is created."
- :type 'hook)
-
-(defcustom iswitchb-delim ","
- "Delimiter to put between buffer names when displaying results."
- :type 'string)
-
-(defcustom iswitchb-all-frames 'visible
- "Argument to pass to `walk-windows' when iswitchb is finding buffers.
-See documentation of `walk-windows' for useful values."
- :type '(choice (const :tag "Selected frame only" nil)
- (const :tag "All existing frames" t)
- (const :tag "All visible frames" visible)
- (const :tag "All frames on this terminal" 0)))
-
-(defcustom iswitchb-minibuffer-setup-hook nil
- "Iswitchb-specific customization of minibuffer setup.
-
-This hook is run during minibuffer setup if `iswitchb' is active.
-For instance:
-\(add-hook \\='iswitchb-minibuffer-setup-hook
- \\='\(lambda () (setq-local max-mini-window-height 3)))
-will constrain the minibuffer to a maximum height of 3 lines when
-iswitchb is running."
- :type 'hook)
-
-(defface iswitchb-single-match
- '((t
- (:inherit font-lock-comment-face)))
- "Iswitchb face for single matching buffer name."
- :version "22.1")
-
-(defface iswitchb-current-match
- '((t
- (:inherit font-lock-function-name-face)))
- "Iswitchb face for current matching buffer name."
- :version "22.1")
-
-(defface iswitchb-virtual-matches
- '((t
- (:inherit font-lock-builtin-face)))
- "Iswitchb face for matching virtual buffer names.
-See also `iswitchb-use-virtual-buffers'."
- :version "22.1")
-
-(defface iswitchb-invalid-regexp
- '((t
- (:inherit font-lock-warning-face)))
- "Iswitchb face for indicating invalid regexp. "
- :version "22.1")
-
-;; Do we need the variable iswitchb-use-mycompletion?
-
-;;; Internal Variables
-
-(defvar iswitchb-method nil
- "Stores the method for viewing the selected buffer.
-Its value is one of `samewindow', `otherwindow', `display', `otherframe',
-`maybe-frame' or `always-frame'. See `iswitchb-default-method' for
-details of values.")
-
-(defvar iswitchb-eoinput 1
- "Point where minibuffer input ends and completion info begins.
-Copied from `icomplete-eoinput'.")
-(make-variable-buffer-local 'iswitchb-eoinput)
-
-(defvar iswitchb-buflist nil
- "Stores the current list of buffers that will be searched through.
-The list is ordered, so that the most recent buffers come first,
-although by default, the buffers visible in the current frame are put
-at the end of the list. Created by `iswitchb-make-buflist'.")
-
-;; todo -- is this necessary?
-
-(defvar iswitchb-use-mycompletion nil
- "Non-nil means use `iswitchb-buffer' completion feedback.
-Should only be set to t by iswitchb functions, so that it doesn't
-interfere with other minibuffer usage.")
-
-(defvar iswitchb-change-word-sub nil
- "Private variable used by `iswitchb-word-matching-substring'.")
-
-(defvar iswitchb-common-match-string nil
- "Stores the string that is common to all matching buffers.")
-
-(defvar iswitchb-rescan nil
- "Non-nil means we need to regenerate the list of matching buffers.")
-
-(defvar iswitchb-text nil
- "Stores the users string as it is typed in.")
-
-(defvar iswitchb-matches nil
- "List of buffers currently matching `iswitchb-text'.")
-
-(defvar iswitchb-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map minibuffer-local-map)
- (define-key map "?" #'iswitchb-completion-help)
- (define-key map "\C-s" #'iswitchb-next-match)
- (define-key map "\C-r" #'iswitchb-prev-match)
- (define-key map [?\C-.] #'iswitchb-next-match)
- (define-key map [?\C-,] #'iswitchb-prev-match)
- (define-key map "\t" #'iswitchb-complete)
- (define-key map "\C-j" #'iswitchb-select-buffer-text)
- (define-key map "\C-t" #'iswitchb-toggle-regexp)
- (define-key map "\C-x\C-f" #'iswitchb-find-file)
- (define-key map "\C-c" #'iswitchb-toggle-case)
- (define-key map "\C-k" #'iswitchb-kill-buffer)
- (define-key map "\C-m" #'iswitchb-exit-minibuffer)
- map)
- "Minibuffer keymap for `iswitchb-buffer'.")
-
-(defvar iswitchb-global-map
- (let ((map (make-sparse-keymap)))
- (dolist (b '((switch-to-buffer . iswitchb-buffer)
- (switch-to-buffer-other-window . iswitchb-buffer-other-window)
- (switch-to-buffer-other-frame . iswitchb-buffer-other-frame)
- (display-buffer . iswitchb-display-buffer)))
- (define-key map (vector 'remap (car b)) (cdr b)))
- map)
- "Global keymap for `iswitchb-mode'.")
-
-(defvar iswitchb-history nil
- "History of buffers selected using `iswitchb-buffer'.")
-
-(defvar iswitchb-exit nil
- "Flag to monitor how `iswitchb-buffer' exits.
-If equal to `takeprompt', we use the prompt as the buffer name to be
-selected.")
-
-(defvar iswitchb-buffer-ignore-orig nil
- "Stores original value of `iswitchb-buffer-ignore'.")
-
-(defvar iswitchb-default nil
- "Default buffer for iswitchb.")
-
-;; The following variables are needed to keep the byte compiler quiet.
-(defvar iswitchb-require-match nil
- "Non-nil if matching buffer must be selected.")
-
-(defvar iswitchb-temp-buflist nil
- "Stores a temporary version of the buffer list being created.")
-
-(defvar iswitchb-bufs-in-frame nil
- "List of the buffers visible in the current frame.")
-
-(defvar iswitchb-minibuf-depth nil
- "Value we expect to be returned by `minibuffer-depth' in the minibuffer.")
-
-(defvar iswitchb-common-match-inserted nil
- "Non-nil if we have just inserted a common match in the minibuffer.")
-
-(defvar iswitchb-invalid-regexp)
-
-;;; FUNCTIONS
-
-;;; MAIN FUNCTION
-(defun iswitchb ()
- "Switch to buffer matching a substring.
-As you type in a string, all of the buffers matching the string are
-displayed. When you have found the buffer you want, it can then be
-selected. As you type, most keys have their normal keybindings,
-except for the following:
-\\<iswitchb-mode-map>
-
-RET Select the buffer at the front of the list of matches. If the
-list is empty, possibly prompt to create new buffer.
-
-\\[iswitchb-select-buffer-text] Select the current prompt as the buffer.
-If no buffer is found, prompt for a new one.
-
-\\[iswitchb-next-match] Put the first element at the end of the list.
-\\[iswitchb-prev-match] Put the last element at the start of the list.
-\\[iswitchb-complete] Complete a common suffix to the current string that
-matches all buffers. If there is only one match, select that buffer.
-If there is no common suffix, show a list of all matching buffers
-in a separate window.
-\\[iswitchb-toggle-regexp] Toggle regexp searching.
-\\[iswitchb-toggle-case] Toggle case-sensitive searching of buffer names.
-\\[iswitchb-completion-help] Show list of matching buffers in separate window.
-\\[iswitchb-find-file] Exit iswitchb and drop into `find-file'.
-\\[iswitchb-kill-buffer] Kill buffer at head of buffer list."
- ;;\\[iswitchb-toggle-ignore] Toggle ignoring certain buffers (see \
- ;;`iswitchb-buffer-ignore')
-
- (let* ((prompt "iswitch ")
- iswitchb-invalid-regexp
- (buf (iswitchb-read-buffer prompt)))
-
- ;;(message "chosen text %s" iswitchb-final-text)
- ;; Choose the buffer name: either the text typed in, or the head
- ;; of the list of matches
-
- (cond ( (eq iswitchb-exit 'findfile)
- (call-interactively 'find-file))
- (iswitchb-invalid-regexp
- (message "Won't make invalid regexp named buffer"))
- (t
- ;; View the buffer
- ;;(message "go to buf %s" buf)
- ;; Check buf is non-nil.
- (if buf
- (if (get-buffer buf)
- ;; buffer exists, so view it and then exit
- (iswitchb-visit-buffer buf)
- ;; else buffer doesn't exist
- (iswitchb-possible-new-buffer buf)))
- ))))
-
-(defun iswitchb-read-buffer (prompt &optional default require-match
- _predicate start matches-set)
- "Replacement for the built-in `read-buffer'.
-Return the name of a buffer selected.
-PROMPT is the prompt to give to the user.
-DEFAULT if given is the default buffer to be selected, which will
-go to the front of the list.
-If REQUIRE-MATCH is non-nil, an existing buffer must be selected.
-If START is a string, the selection process is started with that
-string.
-If MATCHES-SET is non-nil, the buflist is not updated before
-the selection process begins. Used by isearchb.el."
- ;; The map is generated every time so that it can inherit new
- ;; functions.
- (let ((map (copy-keymap minibuffer-local-map))
- buf-sel iswitchb-final-text
- icomplete-mode) ; prevent icomplete starting up
- (define-key map "?" #'iswitchb-completion-help)
- (define-key map "\C-s" #'iswitchb-next-match)
- (define-key map "\C-r" #'iswitchb-prev-match)
- (define-key map "\t" #'iswitchb-complete)
- (define-key map "\C-j" #'iswitchb-select-buffer-text)
- (define-key map "\C-t" #'iswitchb-toggle-regexp)
- (define-key map "\C-x\C-f" #'iswitchb-find-file)
- (define-key map "\C-n" #'iswitchb-toggle-ignore)
- (define-key map "\C-c" #'iswitchb-toggle-case)
- (define-key map "\C-k" #'iswitchb-kill-buffer)
- (define-key map "\C-m" #'iswitchb-exit-minibuffer)
- (setq iswitchb-mode-map map)
- (run-hooks 'iswitchb-define-mode-map-hook)
-
- (setq iswitchb-exit nil)
- (setq iswitchb-default
- (if (bufferp default)
- (buffer-name default)
- default))
- (setq iswitchb-text (or start ""))
- (unless matches-set
- (setq iswitchb-rescan t)
- (iswitchb-make-buflist iswitchb-default)
- (iswitchb-set-matches))
- (let
- ((minibuffer-local-completion-map iswitchb-mode-map)
- ;; Record the minibuffer depth that we expect to find once
- ;; the minibuffer is set up and iswitchb-entryfn-p is called.
- (iswitchb-minibuf-depth (1+ (minibuffer-depth)))
- (iswitchb-require-match require-match))
- ;; prompt the user for the buffer name
- (setq iswitchb-final-text (completing-read
- prompt ;the prompt
- '(("dummy" . 1)) ;table
- nil ;predicate
- nil ;require-match [handled elsewhere]
- start ;initial-contents
- 'iswitchb-history)))
- (if (and (not (eq iswitchb-exit 'usefirst))
- (get-buffer iswitchb-final-text))
- ;; This happens for example if the buffer was chosen with the mouse.
- (setq iswitchb-matches (list iswitchb-final-text)
- iswitchb-virtual-buffers nil))
-
- ;; If no buffer matched, but a virtual buffer was selected, visit
- ;; that file now and act as though that buffer had been selected.
- (if (and iswitchb-virtual-buffers
- (not (iswitchb-existing-buffer-p)))
- (let ((virt (car iswitchb-virtual-buffers))
- (new-buf))
- ;; Keep the name of the buffer returned by find-file-noselect, as
- ;; the buffer 'virt' could be a symlink to a file of a different name.
- (setq new-buf (buffer-name (find-file-noselect (cdr virt))))
- (setq iswitchb-matches (list new-buf)
- iswitchb-virtual-buffers nil)))
-
- ;; Handling the require-match must be done in a better way.
- (if (and require-match
- (not (iswitchb-existing-buffer-p)))
- (error "Must specify valid buffer"))
-
- (if (or (eq iswitchb-exit 'takeprompt)
- (null iswitchb-matches))
- (setq buf-sel iswitchb-final-text)
- ;; else take head of list
- (setq buf-sel (car iswitchb-matches)))
-
- ;; Or possibly choose the default buffer
- (if (equal iswitchb-final-text "")
- (setq buf-sel (car iswitchb-matches)))
-
- buf-sel))
-
-(defun iswitchb-existing-buffer-p ()
- "Return non-nil if there is a matching buffer."
- (not (null iswitchb-matches)))
-
-;;; COMPLETION CODE
-
-(defun iswitchb-set-common-completion ()
- "Find common completion of `iswitchb-text' in `iswitchb-matches'.
-The result is stored in `iswitchb-common-match-string'."
-
- (let (val)
- (setq iswitchb-common-match-string nil)
- (if (and iswitchb-matches
- (not iswitchb-regexp) ;; testing
- (stringp iswitchb-text)
- (> (length iswitchb-text) 0))
- (if (setq val (iswitchb-find-common-substring
- iswitchb-matches iswitchb-text))
- (setq iswitchb-common-match-string val)))
- val))
-
-(defun iswitchb-complete ()
- "Try and complete the current pattern amongst the buffer names."
- (interactive)
- (let (res)
- (cond ((not iswitchb-matches)
- (run-hooks 'iswitchb-cannot-complete-hook))
- (iswitchb-invalid-regexp
- ;; Do nothing
- )
- ((= 1 (length iswitchb-matches))
- ;; only one choice, so select it.
- (exit-minibuffer))
-
- (t
- ;; else there could be some completions
- (setq res iswitchb-common-match-string)
- (if (and (not (memq res '(t nil)))
- (not (equal res iswitchb-text)))
- ;; found something to complete, so put it in the minibuffer.
- (progn
- (setq iswitchb-rescan nil
- iswitchb-common-match-inserted t)
- (delete-region (minibuffer-prompt-end) (point))
- (insert res))
- ;; else nothing to complete
- (run-hooks 'iswitchb-cannot-complete-hook)
- )))))
-
-;;; TOGGLE FUNCTIONS
-
-(defun iswitchb-toggle-case ()
- "Toggle the value of variable `iswitchb-case'."
- (interactive)
- (setq iswitchb-case (not iswitchb-case))
- ;; ask for list to be regenerated.
- (setq iswitchb-rescan t))
-
-(defun iswitchb-toggle-regexp ()
- "Toggle the value of `iswitchb-regexp'."
- (interactive)
- (setq iswitchb-regexp (not iswitchb-regexp))
- ;; ask for list to be regenerated.
- (setq iswitchb-rescan t))
-
-(defun iswitchb-toggle-ignore ()
- "Toggle ignoring buffers specified with `iswitchb-buffer-ignore'."
- (interactive)
- (if iswitchb-buffer-ignore
- (progn
- (setq iswitchb-buffer-ignore-orig iswitchb-buffer-ignore)
- (setq iswitchb-buffer-ignore nil))
- ;; else
- (setq iswitchb-buffer-ignore iswitchb-buffer-ignore-orig))
- (iswitchb-make-buflist iswitchb-default)
- ;; ask for list to be regenerated.
- (setq iswitchb-rescan t))
-
-(defun iswitchb-exit-minibuffer ()
- "Exit minibuffer, but make sure we have a match if one is needed."
- (interactive)
- (if (or (not iswitchb-require-match)
- (iswitchb-existing-buffer-p))
- (progn
- (setq iswitchb-exit 'usefirst)
- (throw 'exit nil))))
-
-(defun iswitchb-select-buffer-text ()
- "Select the buffer named by the prompt.
-If no buffer exactly matching the prompt exists, maybe create a new one."
- (interactive)
- (setq iswitchb-exit 'takeprompt)
- (exit-minibuffer))
-
-(defun iswitchb-find-file ()
- "Drop into `find-file' from buffer switching."
- (interactive)
- (setq iswitchb-exit 'findfile)
- (exit-minibuffer))
-
-(defvar recentf-list)
-
-(defun iswitchb-next-match ()
- "Put first element of `iswitchb-matches' at the end of the list."
- (interactive)
- (let ((next (cadr iswitchb-matches)))
- (if (and (null next) iswitchb-virtual-buffers)
- (setq recentf-list
- (iswitchb-chop recentf-list
- (cdr (cadr iswitchb-virtual-buffers))))
- (setq iswitchb-buflist (iswitchb-chop iswitchb-buflist next)))
- (setq iswitchb-rescan t)))
-
-(defun iswitchb-prev-match ()
- "Put last element of `iswitchb-matches' at the front of the list."
- (interactive)
- (let ((prev (car (last iswitchb-matches))))
- (if (and (null prev) iswitchb-virtual-buffers)
- (setq recentf-list
- (iswitchb-chop recentf-list
- (cdr (car (last iswitchb-virtual-buffers)))))
- (setq iswitchb-buflist (iswitchb-chop iswitchb-buflist prev)))
- (setq iswitchb-rescan t)))
-
-(defun iswitchb-chop (list elem)
- "Remove all elements before ELEM and put them at the end of LIST."
- (let ((ret nil)
- (next nil)
- (sofar nil))
- (while (not ret)
- (setq next (car list))
- (if (equal next elem)
- (setq ret (append list (nreverse sofar)))
- ;; else
- (progn
- (setq list (cdr list))
- (setq sofar (cons next sofar)))))
- ret))
-
-;;; CREATE LIST OF ALL CURRENT BUFFERS
-
-(defun iswitchb-make-buflist (default)
- "Set `iswitchb-buflist' to the current list of buffers.
-Currently visible buffers are put at the end of the list.
-The hook `iswitchb-make-buflist-hook' is run after the list has been
-created to allow the user to further modify the order of the buffer names
-in this list. If DEFAULT is non-nil, and corresponds to an existing buffer,
-it is put to the start of the list."
- (setq iswitchb-buflist
- (let* ((iswitchb-current-buffers (iswitchb-get-buffers-in-frames))
- (iswitchb-temp-buflist
- (delq nil
- (mapcar
- (lambda (x)
- (let ((b-name (buffer-name x)))
- (if (not
- (or
- (iswitchb-ignore-buffername-p b-name)
- (memq b-name iswitchb-current-buffers)))
- b-name)))
- (buffer-list (and iswitchb-use-frame-buffer-list
- (selected-frame)))))))
- (setq iswitchb-temp-buflist
- (nconc iswitchb-temp-buflist iswitchb-current-buffers))
- (run-hooks 'iswitchb-make-buflist-hook)
- ;; Should this be after the hooks, or should the hooks be the
- ;; final thing to be run?
- (if default
- (progn
- (setq iswitchb-temp-buflist
- (delete default iswitchb-temp-buflist))
- (setq iswitchb-temp-buflist
- (cons default iswitchb-temp-buflist))))
- iswitchb-temp-buflist)))
-
-(defun iswitchb-to-end (lst)
- "Move the elements from LST to the end of `iswitchb-temp-buflist'."
- (dolist (elem lst)
- (setq iswitchb-temp-buflist (delq elem iswitchb-temp-buflist)))
- (setq iswitchb-temp-buflist (nconc iswitchb-temp-buflist lst)))
-
-(defun iswitchb-get-buffers-in-frames (&optional current)
- "Return the list of buffers that are visible in the current frame.
-If optional argument CURRENT is given, restrict searching to the
-current frame, rather than all frames, regardless of value of
-`iswitchb-all-frames'."
- (let ((iswitchb-bufs-in-frame nil))
- (walk-windows 'iswitchb-get-bufname nil
- (if current
- nil
- iswitchb-all-frames))
- iswitchb-bufs-in-frame))
-
-(defun iswitchb-get-bufname (win)
- "Used by `iswitchb-get-buffers-in-frames' to walk through all windows."
- (let ((buf (buffer-name (window-buffer win))))
- (if (not (member buf iswitchb-bufs-in-frame))
- ;; Only add buf if it is not already in list.
- ;; This prevents same buf in two different windows being
- ;; put into the list twice.
- (setq iswitchb-bufs-in-frame
- (cons buf iswitchb-bufs-in-frame)))))
-
-;;; FIND MATCHING BUFFERS
-
-(defun iswitchb-set-matches ()
- "Set `iswitchb-matches' to the list of buffers matching prompt."
- (if iswitchb-rescan
- (setq iswitchb-matches
- (let ((buflist iswitchb-buflist))
- (iswitchb-get-matched-buffers iswitchb-text iswitchb-regexp
- buflist))
- iswitchb-virtual-buffers nil)))
-
-(defun iswitchb-get-matched-buffers (regexp
- &optional string-format buffer-list)
- "Return buffers matching REGEXP.
-If STRING-FORMAT is nil, consider REGEXP as just a string.
-BUFFER-LIST can be list of buffers or list of strings."
- (let ((case-fold-search (iswitchb-case))
- name ret)
- (if (null string-format) (setq regexp (regexp-quote regexp)))
- (setq iswitchb-invalid-regexp nil)
- (condition-case error
- (dolist (x buffer-list (nreverse ret))
- (setq name (if (stringp x) x (buffer-name x)))
- (when (and (string-match regexp name)
- (not (iswitchb-ignore-buffername-p name)))
- (push name ret)))
- (invalid-regexp
- (setq iswitchb-invalid-regexp t)
- (cdr error)))))
-
-(defun iswitchb-ignore-buffername-p (bufname)
- "Return t if the buffer BUFNAME should be ignored."
- (let ((data (match-data))
- (re-list iswitchb-buffer-ignore)
- ignorep
- nextstr)
- (while re-list
- (setq nextstr (car re-list))
- (cond
- ((stringp nextstr)
- (if (string-match nextstr bufname)
- (progn
- (setq ignorep t)
- (setq re-list nil))))
- ((functionp nextstr)
- (if (funcall nextstr bufname)
- (progn
- (setq ignorep t)
- (setq re-list nil)))))
- (setq re-list (cdr re-list)))
- (set-match-data data)
-
- ;; return the result
- ignorep))
-
-(defun iswitchb-word-matching-substring (word)
- "Return part of WORD before 1st match to `iswitchb-change-word-sub'.
-If `iswitchb-change-word-sub' cannot be found in WORD, return nil."
- (let ((case-fold-search (iswitchb-case)))
- (let ((m (string-match iswitchb-change-word-sub word)))
- (if m
- (substring word m)
- ;; else no match
- nil))))
-
-(defun iswitchb-find-common-substring (lis subs)
- "Return common string following SUBS in each element of LIS."
- (let (res
- alist
- iswitchb-change-word-sub)
- (setq iswitchb-change-word-sub
- (if iswitchb-regexp
- subs
- (regexp-quote subs)))
- (setq res (mapcar #'iswitchb-word-matching-substring lis))
- (setq res (delq nil res)) ;; remove any nil elements (shouldn't happen)
- (setq alist (mapcar #'iswitchb-makealist res)) ;; could use an OBARRAY
-
- ;; try-completion returns t if there is an exact match.
- (let ((completion-ignore-case (iswitchb-case)))
-
- (try-completion subs alist))))
-
-(defun iswitchb-makealist (res)
- "Return dotted pair (RES . 1)."
- (cons res 1))
-
-;; from Wayne Mesard <wmesard@esd.sgi.com>
-(defun iswitchb-rotate-list (lis)
- "Destructively remove the last element from LIS.
-Return the modified list with the last element prepended to it."
- (if (<= (length lis) 1)
- lis
- (let ((las lis)
- (prev lis))
- (while (consp (cdr las))
- (setq prev las
- las (cdr las)))
- (setcdr prev nil)
- (cons (car las) lis))))
-
-(defun iswitchb-completion-help ()
- "Show possible completions in a *Completions* buffer."
- ;; we could allow this buffer to be used to select match, but I think
- ;; choose-completion-string will need redefining, so it just inserts
- ;; choice with out any previous input.
- (interactive)
- (setq iswitchb-rescan nil)
- (let ((buf (current-buffer))
- (temp-buf "*Completions*")
- (win))
-
- (if (and (eq last-command this-command)
- (not iswitchb-common-match-inserted))
- ;; scroll buffer
- (progn
- (set-buffer temp-buf)
- (setq win (get-buffer-window temp-buf))
- (if (pos-visible-in-window-p (point-max) win)
- (set-window-start win (point-min))
- (scroll-other-window))
- (set-buffer buf))
-
- (with-output-to-temp-buffer temp-buf
- (display-completion-list (or iswitchb-matches iswitchb-buflist)))
- (setq iswitchb-common-match-inserted nil))))
-
-;;; KILL CURRENT BUFFER
-
-(defun iswitchb-kill-buffer ()
- "Kill the buffer at the head of `iswitchb-matches'."
- (interactive)
- (let ((enable-recursive-minibuffers t)
- buf)
-
- (setq buf (car iswitchb-matches))
- ;; check to see if buf is non-nil.
- (if buf
- (let ((bufobjs (mapcar (lambda (name)
- (or (get-buffer name) name))
- iswitchb-buflist)))
- (kill-buffer buf)
-
- ;; Check if buffer exists. XEmacs gnuserv.el makes alias
- ;; for kill-buffer which does not return t if buffer is
- ;; killed, so we can't rely on kill-buffer return value.
- (if (get-buffer buf)
- ;; buffer couldn't be killed.
- (setq iswitchb-rescan t)
- ;; Else `kill-buffer' succeeds so re-make the buffer list
- ;; taking into account packages like uniquify may rename
- ;; buffers, and try to preserve the ordering of buffers.
- (setq iswitchb-buflist
- (delq nil (mapcar (lambda (b)
- (if (bufferp b)
- (buffer-name b)
- b))
- bufobjs))))))))
-
-;;; VISIT CHOSEN BUFFER
-(defun iswitchb-visit-buffer (buffer)
- "Visit buffer named BUFFER according to `iswitchb-method'."
- (let (win newframe)
- (cond
- ((eq iswitchb-method 'samewindow)
- (switch-to-buffer buffer))
-
- ((memq iswitchb-method '(always-frame maybe-frame))
- (cond
- ((and (setq win (iswitchb-window-buffer-p buffer))
- (or (eq iswitchb-method 'always-frame)
- (y-or-n-p "Jump to frame? ")))
- (setq newframe (window-frame win))
- (if (fboundp 'select-frame-set-input-focus)
- (select-frame-set-input-focus newframe)
- (raise-frame newframe)
- (select-frame newframe)
- )
- (select-window win))
- (t
- ;; No buffer in other frames...
- (switch-to-buffer buffer)
- )))
-
- ((eq iswitchb-method 'otherwindow)
- (switch-to-buffer-other-window buffer))
-
- ((eq iswitchb-method 'display)
- (display-buffer buffer))
-
- ((eq iswitchb-method 'otherframe)
- (progn
- (switch-to-buffer-other-frame buffer)
- (if (fboundp 'select-frame-set-input-focus)
- (select-frame-set-input-focus (selected-frame)))
- )))))
-
-(defun iswitchb-possible-new-buffer (buf)
- "Possibly create and visit a new buffer called BUF."
-
- (let ((newbufcreated))
- (if (and iswitchb-newbuffer
- (or
- (not iswitchb-prompt-newbuffer)
-
- (and iswitchb-prompt-newbuffer
- (y-or-n-p
- (format-message
- "No buffer matching `%s', create one? "
- buf)))))
- ;; then create a new buffer
- (progn
- (setq newbufcreated (get-buffer-create buf))
- (set-buffer-major-mode newbufcreated)
- (iswitchb-visit-buffer newbufcreated))
- ;; else won't create new buffer
- (message "no buffer matching `%s'" buf))))
-
-(defun iswitchb-window-buffer-p (buffer)
- "Return window pointer if BUFFER is visible in another frame.
-If BUFFER is visible in the current frame, return nil."
- (interactive)
- (let ((blist (iswitchb-get-buffers-in-frames 'current)))
- ;; If the buffer is visible in current frame, return nil
- (unless (member buffer blist)
- ;; maybe in other frame or icon
- (get-buffer-window buffer 0) ; better than 'visible
- )))
-
-(defun iswitchb-buffer ()
- "Switch to another buffer.
-
-The buffer name is selected interactively by typing a substring. The
-buffer is displayed according to `iswitchb-default-method' -- the
-default is to show it in the same window, unless it is already visible
-in another frame.
-For details of keybindings, do `\\[describe-function] iswitchb'."
- (interactive)
- (setq iswitchb-method iswitchb-default-method)
- (iswitchb))
-
-(defun iswitchb-buffer-other-window ()
- "Switch to another buffer and show it in another window.
-The buffer name is selected interactively by typing a substring.
-For details of keybindings, do `\\[describe-function] iswitchb'."
- (interactive)
- (setq iswitchb-method 'otherwindow)
- (iswitchb))
-
-(defun iswitchb-display-buffer ()
- "Display a buffer in another window but don't select it.
-The buffer name is selected interactively by typing a substring.
-For details of keybindings, do `\\[describe-function] iswitchb'."
- (interactive)
- (setq iswitchb-method 'display)
- (iswitchb))
-
-(defun iswitchb-buffer-other-frame ()
- "Switch to another buffer and show it in another frame.
-The buffer name is selected interactively by typing a substring.
-For details of keybindings, do `\\[describe-function] iswitchb'."
- (interactive)
- (setq iswitchb-method 'otherframe)
- (iswitchb))
-
-;;; ICOMPLETE TYPE CODE
-
-(defun iswitchb-exhibit ()
- "Find matching buffers and display a list in the minibuffer.
-Copied from `icomplete-exhibit' with two changes:
-1. It prints a default buffer name when there is no text yet entered.
-2. It calls my completion routine rather than the standard completion."
- (if iswitchb-use-mycompletion
- (let ((contents (buffer-substring (minibuffer-prompt-end) (point-max)))
- (buffer-undo-list t))
- (save-excursion
- (goto-char (point-max))
- ; Register the end of input, so we
- ; know where the extra stuff
- ; (match-status info) begins:
- (if (not (boundp 'iswitchb-eoinput))
- ;; In case it got wiped out by major mode business:
- (make-local-variable 'iswitchb-eoinput))
- (setq iswitchb-eoinput (point))
- ;; Update the list of matches
- (setq iswitchb-text contents)
- (iswitchb-set-matches)
- (setq iswitchb-rescan t)
- (iswitchb-set-common-completion)
-
- ;; Insert the match-status information:
- (insert (iswitchb-completions
- contents))))))
-
-(defun iswitchb-completions (name)
- "Return the string that is displayed after the user's text.
-Modified from `icomplete-completions'."
-
- (let ((comps iswitchb-matches)
- ; "-determined" - only one candidate
- (open-bracket-determined "[")
- (close-bracket-determined "]")
- ;"-prospects" - more than one candidate
- (open-bracket-prospects "{")
- (close-bracket-prospects "}")
- first)
-
- (if (and iswitchb-use-faces comps)
- (progn
- (setq first (copy-sequence (car comps)))
- (setq first (format "%s" first))
- (put-text-property 0 (length first) 'face
- (if (= (length comps) 1)
- (if iswitchb-invalid-regexp
- 'iswitchb-invalid-regexp
- 'iswitchb-single-match)
- 'iswitchb-current-match)
- first)
- (setq comps (cons first (cdr comps)))))
-
- ;; If no buffers matched, and virtual buffers are being used, then
- ;; consult the list of past visited files, to see if we can find
- ;; the file which the user might thought was still open.
- (when (and iswitchb-use-virtual-buffers (null comps)
- recentf-list)
- (setq iswitchb-virtual-buffers nil)
- (let ((head recentf-list) name)
- (while head
- (if (and (setq name (file-name-nondirectory (car head)))
- (string-match (if iswitchb-regexp
- iswitchb-text
- (regexp-quote iswitchb-text)) name)
- (null (get-file-buffer (car head)))
- (not (assoc name iswitchb-virtual-buffers))
- (not (iswitchb-ignore-buffername-p name))
- (file-exists-p (car head)))
- (setq iswitchb-virtual-buffers
- (cons (cons name (car head))
- iswitchb-virtual-buffers)))
- (setq head (cdr head)))
- (setq iswitchb-virtual-buffers (nreverse iswitchb-virtual-buffers)
- comps (mapcar #'car iswitchb-virtual-buffers))
- (let ((comp comps))
- (while comp
- (put-text-property 0 (length (car comp))
- 'face 'iswitchb-virtual-matches
- (car comp))
- (setq comp (cdr comp))))))
-
- (cond ((null comps) (format " %sNo match%s"
- open-bracket-determined
- close-bracket-determined))
-
- (iswitchb-invalid-regexp
- (concat " " (car comps)))
- ((null (cdr comps)) ;one match
- (concat
- (if (if (not iswitchb-regexp)
- (= (length name)
- (length (car comps)))
- (string-match name (car comps))
- (string-equal (match-string 0 (car comps))
- (car comps)))
- ""
- (concat open-bracket-determined
- ;; when there is one match, show the
- ;; matching buffer name in full
- (car comps)
- close-bracket-determined))
- (if (not iswitchb-use-faces) " [Matched]")))
- (t ;multiple matches
- (if (and iswitchb-max-to-show
- (> (length comps) iswitchb-max-to-show))
- (setq comps
- (append
- (let ((res nil)
- (comp comps)
- (end (/ iswitchb-max-to-show 2)))
- (while (>= (setq end (1- end)) 0)
- (setq res (cons (car comp) res)
- comp (cdr comp)))
- (nreverse res))
- (list "...")
- (nthcdr (- (length comps)
- (/ iswitchb-max-to-show 2))
- comps))))
- (let* (
- (alternatives
- (mapconcat #'identity comps iswitchb-delim)))
-
- (concat
-
- ;; put in common completion item -- what you get by
- ;; pressing tab
- (if (and (stringp iswitchb-common-match-string)
- (> (length iswitchb-common-match-string) (length name)))
- (concat open-bracket-determined
- (substring iswitchb-common-match-string
- (length name))
- close-bracket-determined))
- ;; end of partial matches...
-
- ;; list all alternatives
- open-bracket-prospects
- alternatives
- close-bracket-prospects))))))
-
-(defun iswitchb-minibuffer-setup ()
- "Set up minibuffer for `iswitchb-buffer'.
-Copied from `icomplete-minibuffer-setup-hook'."
- (when (iswitchb-entryfn-p)
- (setq-local iswitchb-use-mycompletion t)
- (add-hook 'pre-command-hook #'iswitchb-pre-command nil t)
- (add-hook 'post-command-hook #'iswitchb-post-command nil t)
- (run-hooks 'iswitchb-minibuffer-setup-hook)))
-
-(defun iswitchb-pre-command ()
- "Run before command in `iswitchb-buffer'."
- (iswitchb-tidy))
-
-(defun iswitchb-post-command ()
- "Run after command in `iswitchb-buffer'."
- (iswitchb-exhibit))
-
-(defun iswitchb-tidy ()
- "Remove completions display, if any, prior to new user input.
-Copied from `icomplete-tidy'."
-
- (if (and (boundp 'iswitchb-eoinput)
- iswitchb-eoinput)
-
- (if (> iswitchb-eoinput (point-max))
- ;; Oops, got rug pulled out from under us - reinit:
- (setq iswitchb-eoinput (point-max))
- (let ((buffer-undo-list buffer-undo-list )) ; prevent entry
- (delete-region iswitchb-eoinput (point-max))))
-
- ;; Reestablish the local variable 'cause minibuffer-setup is weird:
- (make-local-variable 'iswitchb-eoinput)
- (setq iswitchb-eoinput 1)))
-
-(defun iswitchb-entryfn-p ()
- "Return non-nil if we are using `iswitchb-buffer'."
- (eq iswitchb-minibuf-depth (minibuffer-depth)))
-
-(defun iswitchb-summaries-to-end ()
- "Move the summaries to the end of the list.
-This is an example function which can be hooked on to
-`iswitchb-make-buflist-hook'. Any buffer matching the regexps
-`Summary' or `output\\*$'are put to the end of the list."
- (let ((summaries (delq nil
- (mapcar
- (lambda (x)
- (if (string-match "Summary\\|output\\*$" x)
- x))
- iswitchb-temp-buflist))))
- (iswitchb-to-end summaries)))
-
-(defun iswitchb-case ()
- "Return non-nil if we should ignore case when matching.
-See the variable `iswitchb-case' for details."
- (if iswitchb-case
- (isearch-no-upper-case-p iswitchb-text t)))
-
-;;;###autoload
-(define-minor-mode iswitchb-mode
- "Toggle Iswitchb mode.
-
-Iswitchb mode is a global minor mode that enables switching
-between buffers using substrings. See `iswitchb' for details."
- :keymap iswitchb-global-map :global t
- (if iswitchb-mode
- (add-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup)
- (remove-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup)))
-
-(provide 'iswitchb)
-
-;;; iswitchb.el ends here
+++ /dev/null
-;;; meese.el --- protect the impressionable young minds of America -*- lexical-binding: t; -*-
-
-;; This is in the public domain on account of being distributed since
-;; 1985 or 1986 without a copyright notice.
-
-;; This file is part of GNU Emacs.
-
-;; Maintainer: emacs-devel@gnu.org
-;; Keywords: games
-;; Obsolete-since: 24.4
-
-;;; Commentary:
-
-;; Adds a hook to protect the impressionable young minds of America
-;; from reading certain files in the Emacs distribution using Emacs.
-
-;; This file is named after Ed Meese, the US Attorney General
-;; under President Reagan, because of his support for censorship.
-
-;;; Code:
-
-(defun protect-innocence-hook ()
- (let ((dir (file-name-directory buffer-file-name)))
- (if (and (equal buffer-file-name (expand-file-name "sex.6" dir))
- (file-exists-p buffer-file-name)
- (not (y-or-n-p "Are you over 18? ")))
- (progn
- (clear-visited-file-modtime)
- (setq buffer-file-name (expand-file-name "celibacy.1" dir))
- (let ((inhibit-read-only t)) ; otherwise (erase-buffer) may bomb.
- (erase-buffer)
- (insert-file-contents buffer-file-name t))
- (rename-buffer (file-name-nondirectory buffer-file-name))))))
-
-;;;(add-hook 'find-file-hook 'protect-innocence-hook)
-(provide 'meese)
-
-;;; meese.el ends here
+++ /dev/null
-;;; messcompat.el --- making message mode compatible with mail mode -*- lexical-binding: t; -*-
-
-;; Copyright (C) 1996-2024 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: mail, news
-;; Obsolete-since: 26.1
-
-;; 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 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; 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. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file tries to provide backward compatibility with sendmail.el
-;; for Message mode. It should be used by simply adding
-;;
-;; (require 'messcompat)
-;;
-;; to the .emacs file. Loading it after Message mode has been
-;; loaded will have no effect.
-
-;;; Code:
-
-(require 'sendmail)
-
-;(setq message-from-style mail-from-style)
-;(setq message-interactive mail-interactive)
-(setq message-setup-hook mail-setup-hook)
-(setq message-mode-hook mail-mode-hook)
-;(setq message-indentation-spaces mail-indentation-spaces)
-;(setq message-signature mail-signature)
-;(setq message-signature-file mail-signature-file)
-(setq message-default-headers mail-default-headers)
-(setq message-send-hook mail-send-hook)
-(setq message-send-mail-function send-mail-function)
-
-(provide 'messcompat)
-
-;;; messcompat.el ends here
-
-;; Local Variables:
-;; no-byte-compile: t
-;; End:
+++ /dev/null
-;;; rcompile.el --- run a compilation on a remote machine -*- lexical-binding: t; -*-
-
-;; Copyright (C) 1993-1994, 2001-2024 Free Software Foundation, Inc.
-
-;; Author: Alon Albert <alon@milcse.rtsg.mot.com>
-;; Maintainer: emacs-devel@gnu.org
-;; Created: 1993 Oct 6
-;; Keywords: tools, processes
-;; Obsolete-since: 24.4
-
-;; 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 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; 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. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This package is for running a remote compilation and using emacs to parse
-;; the error messages. It works by rsh'ing the compilation to a remote host
-;; and parsing the output. If the file visited at the time remote-compile was
-;; called was loaded remotely (ange-ftp), the host and user name are obtained
-;; by the calling ange-ftp-ftp-name on the current directory. In this case the
-;; next-error command will also ange-ftp the files over. This is achieved
-;; automatically because the compilation-parse-errors function uses
-;; default-directory to build its file names. If however the file visited was
-;; loaded locally, remote-compile prompts for a host and user and assumes the
-;; files mounted locally (otherwise, how was the visited file loaded).
-
-;; See the user defined variables section for more info.
-
-;; I was contemplating redefining "compile" to "remote-compile" automatically
-;; if the file visited was ange-ftp'ed but decided against it for now. If you
-;; feel this is a good idea, let me know and I'll consider it again.
-
-;; Installation:
-
-;; To use rcompile, you also need to give yourself permission to connect to
-;; the remote host. You do this by putting lines like:
-
-;; monopoly alon
-;; vme33
-;;
-;; in a file named .rhosts in the home directory (of the remote machine).
-;; Be careful what you put in this file. A line like:
-;;
-;; +
-;;
-;; Will allow anyone access to your account without a password. I suggest you
-;; read the rhosts(5) manual page before you edit this file (if you are not
-;; familiar with it already)
-\f
-;;; Code:
-
-(provide 'rcompile)
-(require 'compile)
-;;; The following should not be needed.
-;;; (eval-when-compile (require 'ange-ftp))
-
-;;;; user defined variables
-
-(defgroup remote-compile nil
- "Run a compilation on a remote machine."
- :group 'processes
- :group 'tools)
-
-
-(defcustom remote-compile-host nil
- "Host for remote compilations."
- :type '(choice string (const nil)))
-
-(defcustom remote-compile-user nil
- "User for remote compilations.
-nil means use the value returned by \\[user-login-name]."
- :type '(choice string (const nil)))
-
-(defcustom remote-compile-run-before nil
- "Command to run before compilation.
-This can be used for setting up environment variables,
-since rsh does not invoke the shell as a login shell and files like .login
-\(tcsh) and .bash_profile \(bash) are not run.
-nil means run no commands."
- :type '(choice string (const nil)))
-
-(defcustom remote-compile-prompt-for-host nil
- "Non-nil means prompt for host if not available from filename."
- :type 'boolean)
-
-(defcustom remote-compile-prompt-for-user nil
- "Non-nil means prompt for user if not available from filename."
- :type 'boolean)
-
-;;;; internal variables
-
-;; History of remote compile hosts and users
-(defvar remote-compile-host-history nil)
-(defvar remote-compile-user-history nil)
-
-\f
-;;;; entry point
-
-;; We use the Tramp internal function `tramp-make-tramp-file-name'.
-;; It has changed its signature in Emacs 27.1, supporting still the
-;; old calling convention. Let's assume rcompile.el has been removed
-;; once Tramp does not support it any longer.
-;; Better would be, if there are functions to provide user, host and
-;; localname of a remote filename, independent of Tramp's implementation.
-;; The function calls are wrapped by `funcall' in order to pacify the byte
-;; compiler. ange-ftp check removed, because it is handled also by Tramp.
-;;;###autoload
-(defun remote-compile (host user command)
- "Compile the current buffer's directory on HOST. Log in as USER.
-See \\[compile]."
- (interactive
- (let (host user command prompt) ;; l l-host l-user
- (setq prompt (if (stringp remote-compile-host)
- (format "Compile on host (default %s): "
- remote-compile-host)
- "Compile on host: ")
- host (if (or remote-compile-prompt-for-host
- (null remote-compile-host))
- (read-from-minibuffer prompt
- "" nil nil
- 'remote-compile-host-history)
- remote-compile-host)
- user (if remote-compile-prompt-for-user
- (read-from-minibuffer (format
- "Compile by user (default %s): "
- (or remote-compile-user
- (user-login-name)))
- "" nil nil
- 'remote-compile-user-history)
- remote-compile-user))
- (setq command (read-from-minibuffer "Compile command: "
- compile-command nil nil
- '(compile-history . 1)))
- (list (if (string= host "") remote-compile-host host)
- (if (string= user "") remote-compile-user user)
- command)))
- (setq compile-command command)
- (cond (user
- (setq remote-compile-user user))
- ((null remote-compile-user)
- (setq remote-compile-user (user-login-name))))
- (let* (;; localname ;; Pacify byte-compiler.
- (compile-command
- (format "%s %s -l %s \"(%scd %s; %s)\""
- remote-shell-program
- host
- remote-compile-user
- (if remote-compile-run-before
- (concat remote-compile-run-before "; ")
- "")
- ""
- compile-command)))
- (setq remote-compile-host host)
- (save-some-buffers nil nil)
- (compilation-start compile-command)
- ;; Set comint-file-name-prefix in the compilation buffer so
- ;; compilation-parse-errors will find referenced files by Tramp.
- (with-current-buffer next-error-last-buffer
- (when (fboundp 'tramp-make-tramp-file-name)
- (setq-local comint-file-name-prefix
- (funcall
- #'tramp-make-tramp-file-name
- nil ;; method.
- remote-compile-user
- remote-compile-host
- ""))))))
-
-;;; rcompile.el ends here
+++ /dev/null
-;;; sup-mouse.el --- supdup mouse support for lisp machines -*- lexical-binding: t; -*-
-
-;; Copyright (C) 1985-1986, 2001-2024 Free Software Foundation, Inc.
-
-;; Author: Wolfgang Rupprecht
-;; Maintainer: emacs-devel@gnu.org
-;; Created: 21 Nov 1986
-;; Keywords: hardware
-;; Obsolete-since: 24.4
-
-;; (from code originally written by John Robinson@bbn for the bitgraph)
-
-;; 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 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; 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. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-
-;;; User customization option:
-
-(defcustom sup-mouse-fast-select-window nil
- "Non-nil means mouse hits select new window, then execute.
-Otherwise just select."
- :type 'boolean
- :group 'mouse)
-
-(defconst mouse-left 0)
-(defconst mouse-center 1)
-(defconst mouse-right 2)
-
-(defconst mouse-2left 4)
-(defconst mouse-2center 5)
-(defconst mouse-2right 6)
-
-(defconst mouse-3left 8)
-(defconst mouse-3center 9)
-(defconst mouse-3right 10)
-
-;;; Defuns:
-
-(defun sup-mouse-report ()
- "This function is called directly by the mouse, it parses and
-executes the mouse commands.
-
- L move point * |---- These apply for mouse click in a window.
-2L delete word |
-3L copy word | If sup-mouse-fast-select-window is nil,
- C move point and yank * | just selects that window.
-2C yank pop |
- R set mark * |
-2R delete region |
-3R copy region |
-
-on mode line on \"scroll bar\" in minibuffer
- L scroll-up line to top execute-extended-command
- C proportional goto-char line to middle mouse-help
- R scroll-down line to bottom eval-expression"
-
- (interactive)
- (let*
-;; expect a string of <esc>:<buttons>;<x-pos>;<y-pos>c
- ((buttons (sup-get-tty-num ?\;))
- (x (sup-get-tty-num ?\;))
- (y (sup-get-tty-num ?c))
- (window (sup-pos-to-window x y))
- (edges (window-edges window))
- (old-window (selected-window))
- (in-minibuf-p (eq y (1- (frame-height))))
- (same-window-p (and (not in-minibuf-p) (eq window old-window)))
- (in-mode-line-p (eq y (1- (nth 3 edges))))
- (in-scrollbar-p (>= x (1- (nth 2 edges)))))
- (setq x (- x (nth 0 edges)))
- (setq y (- y (nth 1 edges)))
-
-; (error "mouse-hit %d %d %d" buttons x y) ;;;; debug
-
- (cond (in-mode-line-p
- (select-window window)
- (cond ((= buttons mouse-left)
- (scroll-up))
- ((= buttons mouse-right)
- (scroll-down))
- ((= buttons mouse-center)
- (goto-char (/ (* x
- (- (point-max) (point-min)))
- (1- (window-width))))
- (beginning-of-line)
- (what-cursor-position)))
- (select-window old-window))
- (in-scrollbar-p
- (select-window window)
- (scroll-up
- (cond ((= buttons mouse-left)
- y)
- ((= buttons mouse-right)
- (+ y (- 2 (window-height))))
- ((= buttons mouse-center)
- (/ (+ 2 y y (- (window-height))) 2))
- (t
- 0)))
- (select-window old-window))
- (same-window-p
- (cond ((= buttons mouse-left)
- (sup-move-point-to-x-y x y))
- ((= buttons mouse-2left)
- (sup-move-point-to-x-y x y)
- (kill-word 1))
- ((= buttons mouse-3left)
- (sup-move-point-to-x-y x y)
- (save-excursion
- (copy-region-as-kill
- (point) (progn (forward-word 1) (point))))
- (setq this-command 'yank)
- )
- ((= buttons mouse-right)
- (push-mark)
- (sup-move-point-to-x-y x y)
- (exchange-point-and-mark))
- ((= buttons mouse-2right)
- (push-mark)
- (sup-move-point-to-x-y x y)
- (kill-region (mark) (point)))
- ((= buttons mouse-3right)
- (push-mark)
- (sup-move-point-to-x-y x y)
- (copy-region-as-kill (mark) (point))
- (setq this-command 'yank))
- ((= buttons mouse-center)
- (sup-move-point-to-x-y x y)
- (setq this-command 'yank)
- (yank))
- ((= buttons mouse-2center)
- (yank-pop 1))
- )
- )
- (in-minibuf-p
- (cond ((= buttons mouse-right)
- (call-interactively 'eval-expression))
- ((= buttons mouse-left)
- (call-interactively 'execute-extended-command))
- ((= buttons mouse-center)
- (describe-function 'sup-mouse-report)); silly self help
- ))
- (t ;in another window
- (select-window window)
- (cond ((not sup-mouse-fast-select-window))
- ((= buttons mouse-left)
- (sup-move-point-to-x-y x y))
- ((= buttons mouse-right)
- (push-mark)
- (sup-move-point-to-x-y x y)
- (exchange-point-and-mark))
- ((= buttons mouse-center)
- (sup-move-point-to-x-y x y)
- (setq this-command 'yank)
- (yank))
- ))
- )))
-\f
-
-(defun sup-get-tty-num (term-char)
- "Read from terminal until TERM-CHAR is read, and return intervening number.
-Upon non-numeric not matching TERM-CHAR signal an error."
- (let
- ((num 0)
- (char (read-char)))
- (while (and (>= char ?0)
- (<= char ?9))
- (setq num (+ (* num 10) (- char ?0)))
- (setq char (read-char)))
- (or (eq term-char char)
- (error "Invalid data format in mouse command"))
- num))
-
-(defun sup-move-point-to-x-y (x y)
- "Position cursor in window coordinates.
-X and Y are 0-based character positions in the window."
- (move-to-window-line y)
- (move-to-column x)
- )
-
-(defun sup-pos-to-window (x y)
- "Find window corresponding to frame coordinates.
-X and Y are 0-based character positions on the frame."
- (get-window-with-predicate (lambda (w)
- (coordinates-in-window-p (cons x y) w))))
-
-(provide 'sup-mouse)
-
-;;; sup-mouse.el ends here
+++ /dev/null
-;;; tpu-edt.el --- Emacs emulating TPU emulating EDT -*- lexical-binding: t; -*-
-
-;; Copyright (C) 1993-1995, 2000-2024 Free Software Foundation, Inc.
-
-;; Author: Rob Riepel <riepel@networking.stanford.edu>
-;; Version: 4.5
-;; Keywords: emulations
-;; Obsolete-since: 24.5
-
-;; 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 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; 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. If not, see <https://www.gnu.org/licenses/>.
-
-;; 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-mapper command creates this map and stores it in a
-;; file. See the tpu-mapper command help for more information, or just
-;; run it and follow the directions.
-
-
-;; %% 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. In cases where the selected region cannot be shown in
-;; inverse video an at sign (@) appears in the mode line when 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's 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 add
-;; the following line to your init file:
-
-;; (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's 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 tpu-gold-map [kp_f1] 'universal-argument) ; Gold-PF1
-
-;; ; Make KP7 move by paragraphs, instead of pages.
-;; (define-key tpu-global-map [kf_7] 'tpu-paragraph) ; KP7
-
-;; ; Repeat the preceding mappings for X-windows.
-;; (cond
-;; (window-system
-;; (define-key tpu-global-map [kp_7] 'tpu-paragraph) ; KP7
-;; (define-key tpu-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.
-
-;;; Todo/Bugs:
-
-;; We shouldn't use vt100 ESC sequences since it is uselessly fighting
-;; against function-key-map. Better use real key names.
-
-;;; Code:
-
-;; we use picture-mode functions
-(require 'picture)
-
-(defgroup tpu nil
- "Emacs emulating TPU emulating EDT."
- :prefix "tpu-"
- :group 'emulations)
-
-
-;;;
-;;; Version Information
-;;;
-(defconst tpu-version "4.5" "TPU-edt version number.")
-
-
-;;;
-;;; User Configurable Variables
-;;;
-(defcustom tpu-kill-buffers-silently nil
- "If non-nil, TPU-edt kills modified buffers without asking."
- :type 'boolean)
-
-(defcustom tpu-percent-scroll 75
- "Percentage of the screen to scroll for next/previous screen commands."
- :type 'integer)
-
-(defcustom tpu-pan-columns 16
- "Number of columns the tpu-pan functions scroll left or right."
- :type 'integer)
-
-
-;;;
-;;; Global Keymaps
-;;;
-
-(defvar tpu-gold-map
- (let ((map (make-keymap)))
- ;; Previously we used escape sequences here. We now instead presume
- ;; that term/*.el does its job to map the escape sequence to the right
- ;; key-symbol.
-
- (define-key map [up] #'tpu-move-to-beginning) ; up-arrow
- (define-key map [down] #'tpu-move-to-end) ; down-arrow
- (define-key map [right] #'end-of-line) ; right-arrow
- (define-key map [left] #'beginning-of-line) ; left-arrow
-
- ;; (define-key map [find] nil) ; Find
- ;; (define-key map [insert] nil) ; Insert Here
- (define-key map [delete] #'tpu-store-text) ; Remove
- (define-key map [select] #'tpu-unselect) ; Select
- (define-key map [prior] #'tpu-previous-window) ; Prev Screen
- (define-key map [next] #'tpu-next-window) ; Next Screen
-
- ;; (define-key map [f1] nil) ; F1
- ;; (define-key map [f2] nil) ; F2
- ;; (define-key map [f3] nil) ; F3
- ;; (define-key map [f4] nil) ; F4
- ;; (define-key map [f5] nil) ; F5
- ;; (define-key map [f6] nil) ; F6
- ;; (define-key map [f7] nil) ; F7
- ;; (define-key map [f8] nil) ; F8
- ;; (define-key map [f9] nil) ; F9
- ;; (define-key map [f10] nil) ; F10
- ;; (define-key map [f11] nil) ; F11
- ;; (define-key map [f12] nil) ; F12
- ;; (define-key map [f13] nil) ; F13
- ;; (define-key map [f14] nil) ; F14
- (define-key map [help] #'describe-bindings) ; HELP
- ;; (define-key map [menu] nil) ; DO
- (define-key map [f17] #'tpu-drop-breadcrumb) ; F17
- ;; (define-key map [f18] nil) ; F18
- ;; (define-key map [f19] nil) ; F19
- ;; (define-key map [f20] nil) ; F20
-
- (define-key map [kp-f1] #'keyboard-quit) ; PF1
- (define-key map [kp-f3] #'tpu-search) ; PF3
- (define-key map [kp-f4] #'tpu-undelete-lines) ; PF4
- (define-key map [kp-0] #'open-line) ; KP0
- (define-key map [kp-1] #'tpu-change-case) ; KP1
- (define-key map [kp-2] #'tpu-delete-to-eol) ; KP2
- (define-key map [kp-3] #'tpu-special-insert) ; KP3
- (define-key map [kp-4] #'tpu-move-to-end) ; KP4
- (define-key map [kp-5] #'tpu-move-to-beginning) ; KP5
- (define-key map [kp-6] #'tpu-paste) ; KP6
- (define-key map [kp-7] #'execute-extended-command) ; KP7
- (define-key map [kp-8] #'tpu-fill) ; KP8
- (define-key map [kp-9] #'tpu-replace) ; KP9
- (define-key map [kp-subtract] #'tpu-undelete-words) ; KP-
- (define-key map [kp-separator] #'tpu-undelete-char) ; KP,
- (define-key map [kp-decimal] #'tpu-unselect) ; KP.
- (define-key map [kp-enter] #'tpu-substitute) ; KPenter
-
- ;;
- (define-key map "\C-A" #'tpu-toggle-overwrite-mode) ; ^A
- ;; (define-key map "\C-B" nil) ; ^B
- ;; (define-key map "\C-C" nil) ; ^C
- ;; (define-key map "\C-D" nil) ; ^D
- ;; (define-key map "\C-E" nil) ; ^E
- (define-key map "\C-F" #'set-visited-file-name) ; ^F
- (define-key map "\C-g" #'keyboard-quit) ; safety first
- (define-key map "\C-h" #'delete-other-windows) ; BS
- (define-key map "\C-i" #'other-window) ; TAB
- ;; (define-key map "\C-J" nil) ; ^J
- (define-key map "\C-K" #'tpu-define-macro-key) ; ^K
- (define-key map "\C-l" #'downcase-region) ; ^L
- ;; (define-key map "\C-M" nil) ; ^M
- ;; (define-key map "\C-N" nil) ; ^N
- ;; (define-key map "\C-O" nil) ; ^O
- ;; (define-key map "\C-P" nil) ; ^P
- ;; (define-key map "\C-Q" nil) ; ^Q
- ;; (define-key map "\C-R" nil) ; ^R
- ;; (define-key map "\C-S" nil) ; ^S
- (define-key map "\C-T" #'tpu-toggle-control-keys) ; ^T
- (define-key map "\C-u" #'upcase-region) ; ^U
- ;; (define-key map "\C-V" nil) ; ^V
- (define-key map "\C-w" #'tpu-write-current-buffers) ; ^W
- ;; (define-key map "\C-X" nil) ; ^X
- ;; (define-key map "\C-Y" nil) ; ^Y
- ;; (define-key map "\C-Z" nil) ; ^Z
- (define-key map " " #'undo) ; SPC
- ;; (define-key map "!" nil) ; !
- ;; (define-key map "#" nil) ; #
- (define-key map "$" #'tpu-add-at-eol) ; $
- (define-key map "%" #'tpu-goto-percent) ; %
- ;; (define-key map "&" nil) ; &
- ;; (define-key map "(" nil) ; (
- ;; (define-key map ")" nil) ; )
- (define-key map "*" #'tpu-toggle-regexp) ; *
- ;; (define-key map "+" nil) ; +
- (define-key map "," #'tpu-goto-breadcrumb) ; ,
- (define-key map "-" #'negative-argument) ; -
- (define-key map "." #'tpu-drop-breadcrumb) ; .
- (define-key map "/" #'tpu-emacs-replace) ; /
- (define-key map "0" #'digit-argument) ; 0
- (define-key map "1" #'digit-argument) ; 1
- (define-key map "2" #'digit-argument) ; 2
- (define-key map "3" #'digit-argument) ; 3
- (define-key map "4" #'digit-argument) ; 4
- (define-key map "5" #'digit-argument) ; 5
- (define-key map "6" #'digit-argument) ; 6
- (define-key map "7" #'digit-argument) ; 7
- (define-key map "8" #'digit-argument) ; 8
- (define-key map "9" #'digit-argument) ; 9
- ;; (define-key map ":" nil) ; :
- (define-key map ";" #'tpu-trim-line-ends) ; ;
- ;; (define-key map "<" nil) ; <
- ;; (define-key map "=" nil) ; =
- ;; (define-key map ">" nil) ; >
- (define-key map "?" #'tpu-spell-check) ; ?
- ;; (define-key map "A" #'tpu-toggle-newline-and-indent) ; A
- ;; (define-key map "B" #'tpu-next-buffer) ; B
- ;; (define-key map "C" #'repeat-complex-command) ; C
- ;; (define-key map "D" #'shell-command) ; D
- ;; (define-key map "E" #'tpu-exit) ; E
- ;; (define-key map "F" #'tpu-cursor-free-mode) ; F
- ;; (define-key map "G" #'tpu-get) ; G
- ;; (define-key map "H" nil) ; H
- ;; (define-key map "I" #'tpu-include) ; I
- ;; (define-key map "K" #'tpu-kill-buffer) ; K
- (define-key map "L" #'tpu-what-line) ; L
- ;; (define-key map "M" #'buffer-menu) ; M
- ;; (define-key map "N" #'tpu-next-file-buffer) ; N
- ;; (define-key map "O" #'occur) ; O
- (define-key map "P" #'lpr-buffer) ; P
- ;; (define-key map "Q" #'tpu-quit) ; Q
- ;; (define-key map "R" #'tpu-toggle-rectangle) ; R
- ;; (define-key map "S" #'replace) ; S
- ;; (define-key map "T" #'tpu-line-to-top-of-window) ; T
- ;; (define-key map "U" #'undo) ; U
- ;; (define-key map "V" #'tpu-version) ; V
- ;; (define-key map "W" #'save-buffer) ; W
- ;; (define-key map "X" #'tpu-save-all-buffers-kill-emacs) ; X
- ;; (define-key map "Y" #'copy-region-as-kill) ; Y
- ;; (define-key map "Z" #'suspend-emacs) ; Z
- (define-key map "[" #'blink-matching-open) ; [
- ;; (define-key map "\\" nil) ; \
- (define-key map "]" #'blink-matching-open) ; ]
- (define-key map "^" #'tpu-add-at-bol) ; ^
- (define-key map "_" #'split-window-below) ; -
- (define-key map "`" #'what-line) ; `
- (define-key map "a" #'tpu-toggle-newline-and-indent) ; a
- (define-key map "b" #'tpu-next-buffer) ; b
- (define-key map "c" #'repeat-complex-command) ; c
- (define-key map "d" #'shell-command) ; d
- (define-key map "e" #'tpu-exit) ; e
- (define-key map "f" #'tpu-cursor-free-mode) ; f
- (define-key map "g" #'tpu-get) ; g
- ;; (define-key map "h" nil) ; h
- (define-key map "i" #'tpu-include) ; i
- (define-key map "k" #'tpu-kill-buffer) ; k
- (define-key map "l" #'goto-line) ; l
- (define-key map "m" #'buffer-menu) ; m
- (define-key map "n" #'tpu-next-file-buffer) ; n
- (define-key map "o" #'occur) ; o
- (define-key map "p" #'lpr-region) ; p
- (define-key map "q" #'tpu-quit) ; q
- (define-key map "r" #'tpu-toggle-rectangle) ; r
- (define-key map "s" #'replace) ; s
- (define-key map "t" #'tpu-line-to-top-of-window) ; t
- (define-key map "u" #'undo) ; u
- (define-key map "v" #'tpu-version) ; v
- (define-key map "w" #'save-buffer) ; w
- (define-key map "x" #'tpu-save-all-buffers-kill-emacs) ; x
- (define-key map "y" #'copy-region-as-kill) ; y
- (define-key map "z" #'suspend-emacs) ; z
- ;; (define-key map "{" nil) ; {
- (define-key map "|" #'split-window-right) ; |
- ;; (define-key map "}" nil) ; }
- (define-key map "~" #'exchange-point-and-mark) ; ~
- (define-key map "\177" #'delete-window) ; <X]
- map)
- "Maps the function keys on the VT100 keyboard preceded by PF1.
-GOLD is the ASCII 7-bit escape sequence <ESC>OP.")
-
-(defvar tpu-global-map
- (let ((map (make-sparse-keymap)))
-
- ;; Previously defined in CSI-map. We now presume that term/*.el does
- ;; its job to map the escape sequence to the right key-symbol.
- (define-key map [find] #'tpu-search) ; Find
- (define-key map [insert] #'tpu-paste) ; Insert Here
- (define-key map [delete] #'tpu-cut) ; Remove
- (define-key map [select] #'tpu-select) ; Select
- (define-key map [prior] #'tpu-scroll-window-down) ; Prev Screen
- (define-key map [next] #'tpu-scroll-window-up) ; Next Screen
-
- ;; (define-key map [f1] nil) ; F1
- ;; (define-key map [f2] nil) ; F2
- ;; (define-key map [f3] nil) ; F3
- ;; (define-key map [f4] nil) ; F4
- ;; (define-key map [f5] nil) ; F5
- ;; (define-key map [f6] nil) ; F6
- ;; (define-key map [f7] nil) ; F7
- ;; (define-key map [f8] nil) ; F8
- ;; (define-key map [f9] nil) ; F9
- (define-key map [f10] #'tpu-exit) ; F10
- (define-key map [f11] #'tpu-insert-escape) ; F11 (ESC)
- (define-key map [f12] #'tpu-next-beginning-of-line) ; F12 (BS)
- (define-key map [f13] #'tpu-delete-previous-word) ; F13 (LF)
- (define-key map [f14] #'tpu-toggle-overwrite-mode) ; F14
- (define-key map [help] #'tpu-help) ; HELP
- (define-key map [menu] #'execute-extended-command) ; DO
- (define-key map [f17] #'tpu-goto-breadcrumb) ; F17
- ;; (define-key map [f18] nil) ; F18
- ;; (define-key map [f19] nil) ; F19
- ;; (define-key map [f20] nil) ; F20
-
-
- ;; Previously defined in SS3-map. We now presume that term/*.el does
- ;; its job to map the escape sequence to the right key-symbol.
- (define-key map [kp-f1] tpu-gold-map) ; GOLD map
- ;;
- (define-key map [up] #'tpu-previous-line) ; up
- (define-key map [down] #'tpu-next-line) ; down
- (define-key map [right] #'tpu-forward-char) ; right
- (define-key map [left] #'tpu-backward-char) ; left
-
- (define-key map [kp-f2] #'tpu-help) ; PF2
- (define-key map [kp-f3] #'tpu-search-again) ; PF3
- (define-key map [kp-f4] #'tpu-delete-current-line) ; PF4
- (define-key map [kp-0] #'tpu-line) ; KP0
- (define-key map [kp-1] #'tpu-word) ; KP1
- (define-key map [kp-2] #'tpu-end-of-line) ; KP2
- (define-key map [kp-3] #'tpu-char) ; KP3
- (define-key map [kp-4] #'tpu-advance-direction) ; KP4
- (define-key map [kp-5] #'tpu-backup-direction) ; KP5
- (define-key map [kp-6] #'tpu-cut) ; KP6
- (define-key map [kp-7] #'tpu-page) ; KP7
- (define-key map [kp-8] #'tpu-scroll-window) ; KP8
- (define-key map [kp-9] #'tpu-append-region) ; KP9
- (define-key map [kp-subtract] #'tpu-delete-current-word) ; KP-
- (define-key map [kp-separator] #'tpu-delete-current-char) ; KP,
- (define-key map [kp-decimal] #'tpu-select) ; KP.
- (define-key map [kp-enter] #'newline) ; KPenter
-
- map)
- "TPU-edt global keymap.")
-
-
-;;;
-;;; Global Variables
-;;;
-(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-search-overlay (make-overlay 1 1)
- "Search highlight overlay.")
-(overlay-put tpu-search-overlay 'face 'bold)
-
-(defvar tpu-replace-overlay (make-overlay 1 1)
- "Replace highlight overlay.")
-(overlay-put tpu-replace-overlay 'face 'highlight)
-
-(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 Mark state.
-;;; o Direction of motion.
-;;; o Active rectangle mode.
-;;; o Active auto indent mode.
-;;;
-(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 `minor-mode-alist' for TPU-edt, or reset it to default Emacs."
- (let ((entries '((tpu-newline-and-indent-p tpu-newline-and-indent-string)
- (tpu-rectangular-p tpu-rectangle-string)
- (tpu-direction-string tpu-direction-string)
- (tpu-mark-flag tpu-mark-flag))))
- (dolist (entry entries)
- (if for-tpu
- (add-to-list 'minor-mode-alist entry)
- (setq minor-mode-alist (remove entry 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 transient-mark-mode "" (if (tpu-mark) " @" " ")))
- (force-mode-line-update))
-
-(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 (match-beginning 0) t))
- (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
- "Return the location of the last match beginning."
- (marker-position tpu-match-beginning-mark))
-
-(defun tpu-match-end nil
- "Return the location of the last match end."
- (marker-position tpu-match-end-mark))
-
-(defun tpu-check-match nil
- "Return 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) (marker-position tpu-match-beginning-mark))
- (or
- (< (point) (marker-position tpu-match-end-mark))
- (and (= (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)
- (message "(%s, %s) in %s -- current %s in %s"
- (marker-position tpu-match-beginning-mark)
- (marker-position tpu-match-end-mark)
- (marker-buffer tpu-match-end-mark)
- (point) (current-buffer))))
-
-
-;;;
-;;; Utilities
-;;;
-
-(defun tpu-mark nil
- "TPU-edt version of the mark function.
-Return the appropriate value of the mark for the current
-version of Emacs."
- (and mark-active (mark (not transient-mark-mode))))
-
-(defun tpu-set-mark (pos)
- "TPU-edt version of the `set-mark' function.
-Sets the mark at POS and activates the region according to the
-current version of Emacs."
- (set-mark pos))
-
-(defun tpu-string-prompt (prompt history-symbol)
- "Read a string with PROMPT."
- (read-from-minibuffer prompt nil nil nil history-symbol))
-
-(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 ()
- "Return the vertical position of point in the selected window.
-Top line is 0. Counts each text line only once, even if it wraps."
- (or
- (cdr (nth 6 (posn-at-point)))
- (if (eq (window-start) (point)) 0
- (1- (count-screen-lines (window-start) (point) 'count-final-newline)))))
-
-
-;;;
-;;; 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)
- "Return 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 (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)
- "Set the screen size."
- (interactive "nnew screen height: \nnnew screen width: ")
- (set-frame-height (selected-frame) height)
- (set-frame-width (selected-frame) 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 (called-interactively-p 'interactive)
- (message "Carriage return inserts a newline%s"
- (if tpu-newline-and-indent-p " and indents." "."))))
-
-(defun tpu-spell-check nil
- "Check the spelling of the region, or of the entire buffer,
-if no region is selected."
- (interactive)
- (let ((m (tpu-mark)))
- (apply #'ispell-region
- (if m
- (if (> m (point)) (list (point) m)
- (list m (point)))
- (list (point-min) (point-max))))
- (if m (tpu-unselect t))))
-
-(defun tpu-toggle-overwrite-mode nil
- "Switch 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 (or 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: ")
- (insert-file-contents file)
- (message ""))
-
-(defun tpu-get (file)
- "TPU-like get file."
- (interactive "FFile to get: ")
- (find-file file find-file-wildcards))
-
-(defun tpu-what-line nil
- "Tell 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)))
- (let* ((cur (count-lines 1 (1+ (point))))
- (max (count-lines 1 (point-max)))
- (pct (/ (* 100 (+ cur (/ max 200))) max)))
- (message "You are on line %d out of %d (%d%%)." cur max pct))))
-
-(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
-(define-minor-mode tpu-edt-mode
- "Toggle TPU/edt emulation on or off."
- :global t
- (if tpu-edt-mode (tpu-edt-on) (tpu-edt-off)))
-
-(defalias 'TPU-EDT-MODE #'tpu-edt-mode)
-
-;;;###autoload
-(defalias 'tpu-edt #'tpu-edt-on)
-(defalias 'TPU-EDT #'tpu-edt-on)
-
-;; Note: The following functions have no `tpu-' prefix. This is unavoidable.
-;; The real TPU/edt editor has interactive commands with these names,
-;; so tpu-edt.el users expect things like M-x exit RET and M-x help RET
-;; to work. Therefore it really is necessary to define these functions,
-;; even in cases where they redefine existing Emacs functions.
-
-(defalias 'exit #'tpu-exit)
-(defalias 'EXIT #'tpu-exit)
-
-(defalias 'Get #'tpu-get)
-(defalias 'GET #'tpu-get)
-
-(defalias 'include #'tpu-include)
-(defalias 'INCLUDE #'tpu-include)
-
-(defalias 'quit #'tpu-quit)
-(defalias 'QUIT #'tpu-quit)
-
-(defalias 'spell #'tpu-spell-check)
-(defalias 'SPELL #'tpu-spell-check)
-
-(defalias 'what\ line #'tpu-what-line)
-(defalias 'WHAT\ LINE #'tpu-what-line)
-
-(defalias 'replace #'tpu-lm-replace)
-(defalias 'REPLACE #'tpu-lm-replace)
-
-(defalias 'help #'tpu-help)
-(defalias 'HELP #'tpu-help)
-
-(defalias 'set\ cursor\ free #'tpu-set-cursor-free)
-(defalias 'SET\ CURSOR\ FREE #'tpu-set-cursor-free)
-
-(defalias 'set\ cursor\ bound #'tpu-set-cursor-bound)
-(defalias 'SET\ CURSOR\ BOUND #'tpu-set-cursor-bound)
-
-(defalias 'set\ scroll\ margins #'tpu-set-scroll-margins)
-(defalias 'SET\ SCROLL\ MARGINS #'tpu-set-scroll-margins)
-
-;; Real TPU error messages end in periods.
-;; Define this to avoid openly flouting Emacs coding standards.
-(defalias 'tpu-error #'error)
-
-
-;;;
-;;; Help
-;;;
-(defvar 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 | |
- |_______________|_______|_______|
-")
-
-(defvar 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
- (forward-line -1)
- (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
- "Insert an escape character, and so becomes the escape-key alias."
- (interactive)
- (insert "\e"))
-
-(defun tpu-insert-formfeed nil
- "Insert 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)
- "End 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
- "Kill the current buffer.
-If `tpu-kill-buffers-silently' is non-nil,
-kill 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) (tpu-error "No other buffers."))
- (switch-to-buffer (car (reverse list)))))
-
-(defun tpu-make-file-buffer-list (buffer-list)
- "Return names from BUFFER-LIST excluding those beginning with a space or star."
- (delq nil (mapcar (lambda (b)
- (if (or (= (aref (buffer-name b) 0) ?\s)
- (= (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
- "Switch in and out of regular expression search and replace mode."
- (interactive)
- (setq tpu-regexp-p (not tpu-regexp-p))
- (tpu-set-search)
- (and (called-interactively-p 'interactive)
- (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)))
- (read-from-minibuffer re-prompt nil nil nil 'tpu-regexp-prompt-hist)))
-
-(defun tpu-search-highlight nil
- (if (tpu-check-match)
- (move-overlay tpu-search-overlay
- (tpu-match-beginning) (tpu-match-end) (current-buffer))
- (unless (equal (overlay-start tpu-search-overlay)
- (overlay-end tpu-search-overlay))
- (move-overlay tpu-search-overlay 1 1 (current-buffer)))))
-
-(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)
-
-(declare-function tpu-emacs-search "tpu-edt")
-(declare-function tpu-emacs-rev-search "tpu-edt")
-
-(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 tpu-advance))
- (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)))))))))
-
-(defalias 'tpu-search-internal-core (symbol-function 'tpu-search-internal))
-
-(defun tpu-check-search-case (string)
- "Return 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-search "\\\\" pat)) (aset pat (+ 1 pos) ?.))
- (while (setq pos (string-search "\\B" pat)) (aset pat (+ 1 pos) ?.))
- (while (setq pos (string-search "\\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 (called-interactively-p 'interactive)
- (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)
- "Set 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)
- "Remove the mark to unselect the current region."
- (interactive "P")
- (deactivate-mark)
- (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 (called-interactively-p 'interactive)
- (message "Rectangular cut and paste %sabled."
- (if tpu-rectangular-p "en" "dis"))))
-
-(defun tpu-arrange-rectangle nil
- "Adjust point and mark to 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 mc t) ; point -> lower-right
- (exchange-point-and-mark) ; point -> upper-right
- (move-to-column pc t)))) ; point -> upper-left
-
- (t ; point on upper line
- (cond ((> pc mc) ; point @ upper-right
- (move-to-column mc t) ; point -> upper-left
- (exchange-point-and-mark) ; point -> lower-left
- (move-to-column pc t) ; 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
- (tpu-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
- (tpu-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
- (tpu-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 the 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 the 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
- (tpu-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
- (tpu-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) (tpu-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
- (move-overlay tpu-replace-overlay
- (tpu-match-beginning) (tpu-match-end) (current-buffer))
- (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))
- (tpu-unset-match)
- (setq doit nil)))))))
-
- (move-overlay tpu-replace-overlay 1 1 (current-buffer))
- (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) (tpu-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) (tpu-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
- "Remove trailing whitespace from every line in the buffer."
- (interactive)
- (save-match-data
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward "[ \t][ \t]*$" nil t)
- (delete-region (match-beginning 0) (match-end 0))))))
-
-
-;;;
-;;; 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
-;;;
-(defvar tpu-word-separator-list '()
- "List of additional word separators.")
-(defvar 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")
- (line-move num)
- (setq this-command 'next-line))
-
-(defun tpu-previous-line (num)
- "Move to previous line.
-Prefix argument serves as a repeat count."
- (interactive "p")
- (line-move (- 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-visible-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))))
- (line-move (- 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))))
- (line-move 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))
- (tpu-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))
-
-(defun tpu-toggle-direction nil
- "Change the current TPU direction."
- (interactive)
- (if tpu-advance (tpu-backup-direction) (tpu-advance-direction)))
-
-
-;;;
-;;; Minibuffer map additions to make KP_enter = RET
-;;;
-;; Standard Emacs settings under xterm in function-key-map map
-;; "\eOM" to [kp-enter] and [kp-enter] to RET, but since the output of the map
-;; is not fed back into the map, the key stays as kp-enter :-(.
-(define-key minibuffer-local-map [kp-enter] #'exit-minibuffer)
-;; These are not necessary because they are inherited.
-;; (define-key minibuffer-local-ns-map [kp-enter] 'exit-minibuffer)
-;; (define-key minibuffer-local-completion-map [kp-enter] 'exit-minibuffer)
-(define-key minibuffer-local-must-match-map [kp-enter] #'minibuffer-complete-and-exit)
-
-
-;;;
-;;; Minibuffer map additions to set search direction
-;;;
-(define-key minibuffer-local-map [kp-4] #'tpu-search-forward-exit) ;KP4
-(define-key minibuffer-local-map [kp-5] #'tpu-search-backward-exit) ;KP5
-
-
-;;;
-;;; Functions to set, reset, and toggle the control key bindings
-;;;
-
-(defvar tpu-control-keys-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-\\" #'quoted-insert) ; ^\
- (define-key map "\C-a" #'tpu-toggle-overwrite-mode) ; ^A
- (define-key map "\C-b" #'repeat-complex-command) ; ^B
- (define-key map "\C-e" #'tpu-current-end-of-line) ; ^E
- (define-key map "\C-h" #'tpu-next-beginning-of-line) ; ^H (BS)
- (define-key map "\C-j" #'tpu-delete-previous-word) ; ^J (LF)
- (define-key map "\C-k" #'tpu-define-macro-key) ; ^K
- (define-key map "\C-l" #'tpu-insert-formfeed) ; ^L (FF)
- (define-key map "\C-r" #'recenter) ; ^R
- (define-key map "\C-u" #'tpu-delete-to-bol) ; ^U
- (define-key map "\C-v" #'tpu-quoted-insert) ; ^V
- (define-key map "\C-w" #'redraw-display) ; ^W
- (define-key map "\C-z" #'tpu-exit) ; ^Z
- map))
-
-(defun tpu-set-control-keys ()
- "Set control keys to TPU style functions."
- (tpu-reset-control-keys 'tpu))
-
-(defun tpu-reset-control-keys (tpu-style)
- "Set control keys to TPU or Emacs style functions."
- (let ((parent (keymap-parent tpu-global-map)))
- (if tpu-style
- (if (eq parent tpu-control-keys-map)
- nil ;All done already.
- ;; Insert tpu-control-keys-map in the global map.
- (set-keymap-parent tpu-control-keys-map parent)
- (set-keymap-parent tpu-global-map tpu-control-keys-map))
- (if (not (eq parent tpu-control-keys-map))
- nil ;All done already.
- ;; Remove tpu-control-keys-map from the global map.
- (set-keymap-parent tpu-global-map (keymap-parent parent))
- (set-keymap-parent tpu-control-keys-map nil)))
- (setq tpu-control-keys tpu-style)))
-
-(defun tpu-toggle-control-keys nil
- "Toggle control key bindings between TPU-edt and Emacs."
- (interactive)
- (tpu-reset-control-keys (not tpu-control-keys))
- (and (called-interactively-p 'interactive)
- (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)
- (dolist (cur (where-is-internal #'tpu-previous-line))
- (define-key read-expression-map cur #'tpu-previous-history-element)
- (define-key minibuffer-local-map cur #'tpu-previous-history-element)
- ;; These are inherited anyway. --Stef
- ;; (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)
- )
-
- (dolist (cur (where-is-internal #'tpu-next-line))
- (define-key read-expression-map cur #'tpu-next-history-element)
- (define-key minibuffer-local-map cur #'tpu-next-history-element)
- ;; These are inherited anyway. --Stef
- ;; (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)
- ))
-
-
-;;;
-;;; 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 name is
-`~/.tpu-keys'."
- (interactive "fX key definition file: ")
- (cond (file
- (setq file (expand-file-name file)))
- (tpu-xkeys-file
- (setq file (expand-file-name tpu-xkeys-file)))
- (t
- (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
- ;; This used to force the user to build `file'. With the
- ;; new code, such a file may not be necessary. In case it
- ;; is, issue a message giving a hint as to how to build it.
- (message "%s not found: use M-x tpu-mapper to create it"
- (abbreviate-file-name file)))))
-
-(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? ")
- (with-demoted-errors "Sorry, couldn't copy - %s."
- (copy-file oldname newname)))
- (kill-buffer "*TPU-Notice*")))
-
-(defvar tpu-edt-old-global-values nil)
-
-;;;
-;;; Start and Stop TPU-edt
-;;;
-;;;###autoload
-(defun tpu-edt-on ()
- "Turn on TPU/edt emulation."
- (interactive)
- ;; To clean things up (and avoid cycles in the global map).
- (tpu-edt-off)
- ;; First, activate tpu-global-map, while protecting the original keymap.
- (set-keymap-parent tpu-global-map global-map)
- (setq global-map tpu-global-map)
- (use-global-map global-map)
- ;; Then do the normal TPU setup.
- (transient-mark-mode t)
- (add-hook 'post-command-hook #'tpu-search-highlight)
- (tpu-set-mode-line t)
- (tpu-advance-direction)
- ;; set page delimiter, display line truncation, and scrolling like TPU
- (dolist (varval '((page-delimiter . "\f")
- (truncate-lines . t)
- (scroll-step . 1)))
- (push (cons (car varval) (default-value (car varval)))
- tpu-edt-old-global-values)
- (set-default (car varval) (cdr varval)))
- (tpu-set-control-keys)
- (and window-system (tpu-load-xkeys nil))
- (tpu-arrow-history)
- ;; Then protect tpu-global-map from user modifications.
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map global-map)
- (setq global-map map)
- (use-global-map map))
- (setq tpu-edt-mode t))
-
-(defun tpu-edt-off ()
- "Turn off TPU/edt emulation. Note that the keypad is left on."
- (interactive)
- (tpu-reset-control-keys nil)
- (remove-hook 'post-command-hook #'tpu-search-highlight)
- (tpu-set-mode-line nil)
- (while tpu-edt-old-global-values
- (let ((varval (pop tpu-edt-old-global-values)))
- (set-default (car varval) (cdr varval))))
- ;; Remove tpu-global-map from the global map.
- (let ((map global-map))
- (while map
- (let ((parent (keymap-parent map)))
- (if (eq tpu-global-map parent)
- (set-keymap-parent map (keymap-parent parent))
- (setq map parent)))))
- ;; Only has an effect if the advice in tpu-extras has been activated.
- (condition-case nil
- (with-no-warnings (ad-disable-regexp "\\`tpu-"))
- (error nil))
- (setq tpu-edt-mode nil))
-
-\f
-;;;### (autoloads nil "tpu-extras" "tpu-extras.el" "cbbb448cff48fab904ac19805aa6f36a")
-;;; Generated autoloads from tpu-extras.el
-
-(autoload 'tpu-cursor-free-mode "tpu-extras" "\
-Minor mode to allow the cursor to move freely about the screen.
-With a prefix argument ARG, enable the mode if ARG is positive,
-and disable it otherwise. If called from Lisp, enable the mode
-if ARG is omitted or nil.
-
-\(fn &optional ARG)" t nil)
-
-(autoload 'tpu-set-scroll-margins "tpu-extras" "\
-Set scroll margins.
-
-\(fn TOP BOTTOM)" t nil)
-
-(autoload 'tpu-set-cursor-free "tpu-extras" "\
-Allow the cursor to move freely about the screen.
-
-\(fn)" t nil)
-
-(autoload 'tpu-set-cursor-bound "tpu-extras" "\
-Constrain the cursor to the flow of the text.
-
-\(fn)" t nil)
-
-;;;***
-\f
-(provide 'tpu-edt)
-
-;;; tpu-edt.el ends here
+++ /dev/null
-;;; tpu-extras.el --- scroll margins and free cursor mode for TPU-edt -*- lexical-binding: t; -*-
-
-;; Copyright (C) 1993-1995, 2000-2024 Free Software Foundation, Inc.
-
-;; Author: Rob Riepel <riepel@networking.stanford.edu>
-;; Keywords: emulations
-;; Package: tpu-edt
-;; Obsolete-since: 24.5
-
-;; 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 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; 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. If not, see <https://www.gnu.org/licenses/>.
-
-;;; 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 init 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
-
-(defcustom tpu-top-scroll-margin 0
- "Scroll margin at the top of the screen.
-Interpreted as a percent of the current window size."
- :type 'integer
- :group 'tpu)
-(defcustom tpu-bottom-scroll-margin 0
- "Scroll margin at the bottom of the screen.
-Interpreted as a percent of the current window size."
- :type 'integer
- :group 'tpu)
-
-(defcustom 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."
- :type 'boolean
- :group 'tpu)
-
-
-;;; Global variables
-
-;;;###autoload
-(define-minor-mode tpu-cursor-free-mode
- "Minor mode to allow the cursor to move freely about the screen."
- :init-value nil
- (if (not tpu-cursor-free-mode)
- (tpu-trim-line-ends))
- (if (not tpu-cursor-free-mode)
- (message "The cursor is now bound to the flow of your text.")
- (message "The cursor will now move freely about the screen.")))
-
-
-;;; 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-trim-line-ends-if-needed ()
- "Eliminate whitespace at ends of lines, if the cursor is free."
- (if (and (buffer-modified-p) tpu-cursor-free-mode) (tpu-trim-line-ends)))
-(add-hook 'before-save-hook #'tpu-trim-line-ends-if-needed)
-
-
-;;; 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-mode (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-mode)
- (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-mode (or (eobp) (picture-move-down num))
- (line-move 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-mode (picture-move-up num) (line-move (- 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-visible-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-mode
- (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-mode
- (picture-end-of-line (- 1 num)))
- (t
- (end-of-line (- 1 num))))
- (tpu-top-check beg num)))
-
-(defun tpu-current-end-of-line ()
- "Move point to end of current line."
- (interactive)
- (let ((beg (point)))
- (if tpu-cursor-free-mode (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)))
- (forward-line num)
- (tpu-bottom-check beg num)))
-
-(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)))
- (forward-line (- num))
- (tpu-top-check beg num)))
-
-
-;;; Movement by paragraph
-
-;; Cf edt-with-position.
-(defmacro tpu-with-position (&rest body)
- "Execute BODY with some position-related variables bound."
- `(let* ((left nil)
- (beg (tpu-current-line))
- (height (window-height))
- (top-percent
- (if (zerop tpu-top-scroll-margin) 10 tpu-top-scroll-margin))
- (bottom-percent
- (if (zerop 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)
- (line-beginning-position (1- height)))))
- ,@body))
-
-(defun tpu-paragraph (num)
- "Move to the next paragraph in the current direction.
-A repeat count means move that many paragraphs."
- (interactive "p")
- (tpu-with-position
- (if tpu-advance
- (progn
- (tpu-next-paragraph num)
- (if (> (point) far)
- (if (zerop (setq left (save-excursion (forward-line height))))
- (recenter top-margin)
- (recenter (- left bottom-up-margin)))
- (and (> (point) bottom) (recenter bottom-margin))))
- (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")
- (tpu-with-position
- (if tpu-advance
- (progn
- (forward-page num)
- (if (> (point) far)
- (if (zerop (setq left (save-excursion (forward-line height))))
- (recenter top-margin)
- (recenter (- left bottom-up-margin)))
- (and (> (point) bottom) (recenter bottom-margin))))
- (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))))
- (line-move (- 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))))
- (line-move 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."
- (tpu-with-position
- (tpu-search-internal-core pat quiet)
- (if tpu-searching-forward
- (progn
- (if (> (point) far)
- (if (zerop (setq left (save-excursion (forward-line height))))
- (recenter top-margin)
- (recenter (- left bottom-up-margin)))
- (and (> (point) bottom) (recenter bottom-margin))))
- (and (< (point) top) (recenter (min beg top-margin))))))
-
-;; Advise the newline, newline-and-indent, and do-auto-fill functions.
-(defun tpu--respect-bottom-scroll-margin (orig-fun &optional &rest args)
- "Respect `tpu-bottom-scroll-margin'."
- (let ((beg (tpu-current-line))
- (num (prefix-numeric-value (car args))))
- (apply orig-fun args)
- (tpu-bottom-check beg num)))
-
-;;; Function to set scroll margins
-
-;;;###autoload
-(defun tpu-set-scroll-margins (top bottom &optional emit-msg)
- "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): \
-\np")
- ;; set top scroll margin
- (or (string= top "")
- (setq tpu-top-scroll-margin
- (if (string= "%" (substring top -1))
- (string-to-number top)
- (/ (1- (+ (* (string-to-number top) 100) (window-height)))
- (window-height)))))
- ;; set bottom scroll margin
- (or (string= bottom "")
- (setq tpu-bottom-scroll-margin
- (if (string= "%" (substring bottom -1))
- (string-to-number bottom)
- (/ (1- (+ (* (string-to-number bottom) 100) (window-height)))
- (window-height)))))
- (dolist (f '(newline newline-and-indent do-auto-fill))
- (advice-add f :around #'tpu--respect-bottom-scroll-margin))
- ;; report scroll margin settings if running interactively
- (and emit-msg
- (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 ()
- "Allow the cursor to move freely about the screen."
- (interactive)
- (tpu-cursor-free-mode 1))
-
-;;;###autoload
-(defun tpu-set-cursor-bound ()
- "Constrain the cursor to the flow of the text."
- (interactive)
- (tpu-cursor-free-mode -1))
-
-(provide 'tpu-extras)
-
-;; Local Variables:
-;; generated-autoload-file: "tpu-edt.el"
-;; End:
-
-;;; tpu-extras.el ends here
+++ /dev/null
-;;; tpu-mapper.el --- create a TPU-edt X-windows keymap file -*- lexical-binding: t; -*-
-
-;; Copyright (C) 1993-1995, 2001-2024 Free Software Foundation, Inc.
-
-;; Author: Rob Riepel <riepel@networking.stanford.edu>
-;; Keywords: emulations
-;; Package: tpu-edt
-;; Obsolete-since: 24.5
-
-;; 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 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; 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. If not, see <https://www.gnu.org/licenses/>.
-
-;;; 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.
-
-;;; Code:
-
-;;;
-;;; 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)
-
-;;;
-;;; Key mapping function
-;;;
-(defun tpu-map-key (ident descrip func gold-func)
- (interactive)
- (message "Press %s%s: " ident descrip)
- (setq tpu-key-seq (read-event)
- tpu-key (format "[%s]" tpu-key-seq))
- (unless (equal tpu-key tpu-return)
- (set-buffer "Keys")
- (insert (format"(define-key tpu-global-map %s %s)\n" tpu-key func))
- (set-buffer "Gold-Keys")
- (insert (format "(define-key tpu-gold-map %s %s)\n" tpu-key gold-func)))
- (set-buffer "Directions")
- tpu-key)
-
-;;;###autoload
-(defun tpu-mapper ()
- "Create an Emacs Lisp file defining the TPU-edt keypad for X-windows.
-
-This command displays an instruction screen showing the TPU-edt keypad
-and asks you to press the TPU-edt editing keys. It 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 init 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."
- (interactive)
-
- ;; Make sure we're running X-windows
-
- (if (not window-system)
- (error "tpu-mapper requires running Emacs with an X display"))
-
- ;; Make sure the window is big enough to display the instructions
-
- (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
-
- (message "Hit carriage-return <CR> to continue ")
- (setq tpu-return-seq (read-event))
- (setq tpu-return (concat "[" (format "%s" tpu-return-seq) "]"))
-
- ;; Build the keymap file
-
- (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" "tpu-gold-map" "'keyboard-quit")
- (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))
- ;; These are not necessary because they are inherited.
- ;; (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
-;;
-")
-
- (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 "~/.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
-
- (require 'tpu-edt)
- (eval-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
+++ /dev/null
-;;; uce.el --- facilitate reply to unsolicited commercial email -*- lexical-binding: t; -*-
-
-;; Copyright (C) 1996, 1998, 2000-2024 Free Software Foundation, Inc.
-
-;; Author: stanislav shalunov <shalunov@mccme.ru>
-;; Created: 10 Dec 1996
-;; Keywords: mail, uce, unsolicited commercial email
-;; Obsolete-since: 29.1
-
-;; 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 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; 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. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; The code in this file provides a semi-automatic means of replying
-;; to unsolicited commercial email (UCE) you might get. Currently, it
-;; only works with Rmail and Gnus. If you would like to make it work
-;; with other mail readers, see the mail-client dependent section of
-;; uce-reply-to-uce. Please let me know about your changes so I can
-;; incorporate them. I'd appreciate it.
-
-;; NOTE: We don't recommend using this feature; see the message in
-;; 'uce-reply-to-uce' for the reasons.
-
-;; The command uce-reply-to-uce, if called when the current message
-;; buffer is a UCE, will setup a reply *mail* buffer as follows. It
-;; scans the full headers of the message for: 1) the normal return
-;; address of the sender (From, Reply-To lines), and puts these
-;; addresses into the To: header, along with abuse@offenders.host; 2)
-;; the mailhub that first saw this message, and adds the address of
-;; its postmaster into the To: header; and 3), finally, it looks at
-;; the Message-Id and adds the postmaster of that host to the list of
-;; addresses.
-
-;; Then, we add an "Errors-To: nobody@localhost" header, so that if
-;; some of these addresses are not actually correct, we will never see
-;; bounced mail. Also, mail-self-blind and mail-archive-file-name
-;; take no effect: the ideology is that we don't want to save junk or
-;; replies to junk.
-
-;; Then we insert a template into the buffer (a customizable message
-;; that explains what has happened), customizable signature, and the
-;; original message with full headers and envelope for postmasters.
-;; Then the buffer is left for editing.
-
-;; The reason that the function uce-reply-to-uce is mail-client
-;; dependent is that we want the full headers of the original message,
-;; nothing stripped. If we use the normal means of inserting the
-;; original message into the *mail* buffer, headers like Received:
-;; (not really headers, but envelope lines) will be stripped, while
-;; they bear valuable information for us and postmasters. I do wish
-;; that there would be some portable way to write this function, but I
-;; am not aware of any.
-
-;; Usage:
-
-;; Place uce.el in your load-path (and optionally byte-compile it).
-;; Add the following line to your init file:
-;; (autoload 'uce-reply-to-uce "uce" "Reply to UCEs" t nil)
-;; If you want to use it with Gnus rather than Rmail:
-;; (setq uce-mail-reader 'gnus)
-
-;; Options:
-
-;; uce-message-text is a template that will be inserted into buffer.
-;; It has a reasonable default. If you want to write some scarier
-;; one, please do so and send it to me. Please keep it polite.
-
-;; uce-signature behaves just like mail-signature. If nil, nothing is
-;; inserted, if t, file ~/.signature is used, if a string, its
-;; contents are inserted into buffer.
-
-;; uce-uce-separator is a line that separates your message from the
-;; UCE that you enclose.
-
-;; uce-subject-line will be used as the subject of the outgoing message.
-
-
-;;; Change Log:
-
-;; Dec 10, 1996 -- posted draft version to gnu.sources.emacs
-
-;; Dec 11, 1996 -- fixed some typos, and Francesco Potortì
-;; <F.Potorti@cnuce.cnr.it> pointed out that my use of defvar was
-;; weird, suggested fix, and added let form.
-
-;; Dec 17, 1996 -- made scanning for host names little bit more clever
-;; (obviously bogus stuff like localhost is now ignored).
-
-;; Nov 11, 1997 -- incorporated changes from Mikael Djurfeldt
-;; <mdj@nada.kth.se> to make uce.el work with Gnus. Changed the text
-;; of message that is sent.
-
-;; Dec 3, 1997 -- changes from Gareth Jones <gdj1@gdjones.demon.co.uk>
-;; handling Received headers following some line like `From:'.
-
-;; Aug 16, 2000 -- changes from Detlev Zundel
-;; <detlev.zundel@stud.uni-karlsruhe.de> to make uce.el work with the
-;; latest Gnus. Lars told him it should work for all versions of Gnus
-;; younger than three years.
-
-
-;;; Code:
-
-(defvar gnus-original-article-buffer)
-(defvar mail-reply-buffer)
-
-(require 'sendmail)
-;; Those sections of code which are dependent upon
-;; RMAIL are only evaluated if we have received a message with RMAIL...
-;;(require 'rmail)
-
-(defgroup uce nil
- "Facilitate reply to unsolicited commercial email."
- :prefix "uce-"
- :group 'mail)
-
-(defcustom uce-mail-reader 'rmail
- "A symbol indicating which mail reader you are using.
-Choose from: `gnus', `rmail'."
- :type '(choice (const gnus) (const rmail))
- :version "20.3")
-
-(defcustom uce-setup-hook nil
- "Hook to run after UCE rant message is composed.
-This hook is run after `mail-setup-hook', which is run as well."
- :type 'hook)
-
-(defcustom uce-message-text
- "Recently, I have received an Unsolicited Commercial E-mail from you.
-I do not like UCE's and I would like to inform you that sending
-unsolicited messages to someone while he or she may have to pay for
-reading your message may be illegal. Anyway, it is highly annoying
-and not welcome by anyone. It is rude, after all.
-
-If you think that this is a good way to advertise your products or
-services you are mistaken. Spamming will only make people hate you, not
-buy from you.
-
-If you have any list of people you send unsolicited commercial emails to,
-REMOVE me from such list immediately. I suggest that you make this list
-just empty.
-
- ----------------------------------------------------
-
-If you are not an administrator of any site and still have received
-this message then your email address is being abused by some spammer.
-They fake your address in From: or Reply-To: header. In this case,
-you might want to show this message to your system administrator, and
-ask him/her to investigate this matter.
-
-Note to the postmaster(s): I append the text of UCE in question to
-this message; I would like to hear from you about action(s) taken.
-This message has been sent to postmasters at the host that is
-mentioned as original sender's host (I do realize that it may be
-faked, but I think that if your domain name is being abused this way
-you might want to learn about it, and take actions) and to the
-postmaster whose host was used as mail relay for this message. If
-message was sent not by your user, could you please compare time when
-this message was sent (use time in Received: field of the envelope
-rather than Date: field) with your sendmail logs and see what host was
-using your sendmail at this moment of time.
-
-Thank you."
-
- "This is the text that `uce-reply-to-uce' command will put in reply buffer.
-Some of spamming programs in use will be set up to read all incoming
-to spam address email, and will remove people who put the word `remove'
-on beginning of some line from the spamming list. So, when you set it
-up, it might be a good idea to actually use this feature.
-
-Value nil means insert no text by default, lets you type it in."
- :type '(choice (const nil) string))
-
-(defcustom uce-uce-separator
- "----- original unsolicited commercial email follows -----"
- "Line that will begin quoting of the UCE.
-Value nil means use no separator."
- :type '(choice (const nil) string))
-
-(defcustom uce-signature mail-signature
-"Text to put as your signature after the note to UCE sender.
-Value nil means none, t means insert `~/.signature' file (if it happens
-to exist), if this variable is a string this string will be inserted
-as your signature."
- :type '(choice (const nil) (const t) string))
-
-(defcustom uce-default-headers
- "Errors-To: nobody@localhost\nPrecedence: bulk\n"
- "Additional headers to use when responding to a UCE with \\[uce-reply-to-uce].
-These are mostly meant for headers that prevent delivery errors reporting."
- :type '(choice (const nil) string))
-
-(defcustom uce-subject-line
- "Spam alert: unsolicited commercial e-mail"
- "Subject of the message that will be sent in response to a UCE."
- :type 'string)
-
-;; End of user options.
-
-
-(defvar rmail-buffer)
-(declare-function rmail-msg-is-pruned "rmail" ())
-(declare-function mail-strip-quoted-names "mail-utils" (address))
-(declare-function rmail-maybe-set-message-counters "rmail" ())
-(declare-function rmail-toggle-header "rmail" (&optional arg))
-
-(defvar uce--usage-warning-displayed nil)
-
-;;;###autoload
-(defun uce-reply-to-uce (&optional _ignored)
- "Compose a reply to unsolicited commercial email (UCE).
-Sets up a reply buffer addressed to: the sender, his postmaster,
-his abuse@ address, and the postmaster of the mail relay used.
-You might need to set `uce-mail-reader' before using this."
- (interactive)
- ;; Start of mail-client dependent section.
- (let ((message-buffer
- (cond ((eq uce-mail-reader 'gnus) gnus-original-article-buffer)
- ((eq uce-mail-reader 'rmail) (bound-and-true-p rmail-buffer))
- (t (error
- "Variable uce-mail-reader set to unrecognized value"))))
- pruned)
- (or (and message-buffer (get-buffer message-buffer))
- (error "No mail buffer, cannot find UCE"))
- (switch-to-buffer message-buffer)
- ;; We need the message with headers pruned.
- ;; Why? All we do is get the from and reply-to headers. ?
- (and (eq uce-mail-reader 'rmail)
- (not (setq pruned (rmail-msg-is-pruned)))
- (rmail-toggle-header 1))
- (let ((to (mail-strip-quoted-names (mail-fetch-field "from" t)))
- (reply-to (mail-fetch-field "reply-to"))
- temp)
- ;; Initial setting of the list of recipients of our message; that's
- ;; what they are pretending to be.
- (setq to (if to
- (format "%s" (mail-strip-quoted-names to))
- ""))
- (if reply-to
- (setq to (format "%s, %s" to (mail-strip-quoted-names reply-to))))
- (let (first-at-sign end-of-hostname sender-host)
- (setq first-at-sign (string-search "@" to)
- end-of-hostname (string-match "[ ,>]" to first-at-sign)
- sender-host (substring to first-at-sign end-of-hostname))
- (if (string-search "." sender-host)
- (setq to (format "%s, postmaster%s, abuse%s"
- to sender-host sender-host))))
- (setq mail-send-actions nil)
- (setq mail-reply-buffer nil)
- (when (eq uce-mail-reader 'rmail)
- (rmail-toggle-header 0)
- (rmail-maybe-set-message-counters)) ; why?
- (copy-region-as-kill (point-min) (point-max))
- ;; Restore the initial header state we found.
- (and pruned (rmail-toggle-header 1))
- (switch-to-buffer "*mail*")
- (erase-buffer)
- (yank)
- (goto-char (point-min))
- ;; Delete any internal Rmail headers.
- (when (eq uce-mail-reader 'rmail)
- (search-forward "\n\n")
- (while (re-search-backward "^X-RMAIL" nil t)
- (delete-region (point) (line-beginning-position 2)))
- (goto-char (point-min)))
- ;; Now find the mail hub that first accepted this message.
- ;; This should try to find the last Received: header.
- ;; Sometimes there may be other headers in between Received: headers.
- (cond ((eq uce-mail-reader 'gnus)
- ;; Does Gnus always have Lines: in the end?
- (re-search-forward "^Lines:")
- (beginning-of-line))
- ((eq uce-mail-reader 'rmail)
- (search-forward "\n\n")))
- (re-search-backward "^Received:")
- ;; Is this always good? It's the only thing I saw when I checked
- ;; a few messages.
- ;;(if (not (re-search-forward ": \\(from\\|by\\) " eol t))
- (unless (re-search-forward "\\(from\\|by\\) " (line-end-position) 'move)
- (if (looking-at "[ \t\n]+\\(from\\|by\\) ")
- (goto-char (match-end 0))
- (error "Failed to extract hub address")))
- (setq temp (point))
- (search-forward " ")
- (forward-char -1)
- ;; And add its postmaster to the list of addresses.
- (if (string-search "." (buffer-substring temp (point)))
- (setq to (format "%s, postmaster@%s"
- to (buffer-substring temp (point)))))
- ;; Also look at the message-id, it helps *very* often.
- (and (search-forward "\nMessage-Id: " nil t)
- ;; Not all Message-Id:'s have an `@' sign.
- (search-forward "@" (line-end-position) t)
- (progn
- (setq temp (point))
- (search-forward ">")
- (forward-char -1)
- (if (string-search "." (buffer-substring temp (point)))
- (setq to (format "%s, postmaster@%s"
- to (buffer-substring temp (point)))))))
- (when (eq uce-mail-reader 'gnus)
- ;; Does Gnus always have Lines: in the end?
- (re-search-forward "^Lines:")
- (beginning-of-line)
- (setq temp (point))
- (search-forward "\n\n" nil t)
- (forward-line -1)
- (delete-region temp (point)))
- ;; End of mail-client dependent section.
- (auto-save-mode auto-save-default)
- (mail-mode)
- (goto-char (point-min))
- (insert "To: ")
- (save-excursion
- (if to
- (let ((fill-prefix "\t")
- (address-start (point)))
- (insert to "\n")
- (fill-region-as-paragraph address-start (point)))
- (newline))
- (insert "Subject: " uce-subject-line "\n")
- (if uce-default-headers
- (insert uce-default-headers))
- (if mail-default-headers
- (insert mail-default-headers))
- (if mail-default-reply-to
- (insert "Reply-To: " mail-default-reply-to "\n"))
- (insert mail-header-separator "\n")
- ;; Insert all our text. Then go back to the place where we started.
- (if to (setq to (point)))
- ;; Text of ranting.
- (if uce-message-text
- (insert uce-message-text))
- ;; Signature.
- (cond ((eq uce-signature t)
- (if (file-exists-p "~/.signature")
- (progn
- (insert "\n\n-- \n")
- (forward-char (cadr (insert-file-contents "~/.signature"))))))
- (uce-signature
- (insert "\n\n-- \n" uce-signature)))
- ;; And text of the original message.
- (if uce-uce-separator
- (insert "\n\n" uce-uce-separator "\n"))
- ;; If message doesn't end with a newline, insert it.
- (goto-char (point-max))
- (or (bolp) (newline)))
- ;; And go back to the beginning of text.
- (if to (goto-char to))
- (or to (set-buffer-modified-p nil))
- ;; Run hooks before we leave buffer for editing. Reasonable usage
- ;; might be to set up special key bindings, replace standard
- ;; functions in mail-mode, etc.
- (run-hooks 'mail-setup-hook 'uce-setup-hook)))
- (unless uce--usage-warning-displayed
- (setq uce--usage-warning-displayed t)
- (pop-to-buffer (get-buffer-create "uce-reply-to-uce warning"))
- (insert "\
--- !!! NOTE !!! ---------------------------------------------
-
-Replying to spam is at best pointless, but most likely actively
-harmful.
-
-- You will confirm that your email address is valid, thus ensuring
- you get more spam.
-
-- You will leak information and open yourself up for further
- attack. For example, they could use your \"geolocation\" to find
- your home address and phone number.
-
-- The sender address is likely fake.
-
-- You help them refine their methods of spamming.
-
-Therefore, we strongly recommend that you do not use this package.
-Use a spam filter instead, or just delete the spam.
-
--------------------------------------------------------------
-")))
-
-(defun uce-insert-ranting (&optional _ignored)
- "Insert text of the usual reply to UCE into current buffer."
- (interactive "P")
- (insert uce-message-text))
-
-(provide 'uce)
-
-;;; uce.el ends here
+++ /dev/null
-;;; vi.el --- major mode for emulating "vi" editor under GNU Emacs -*- lexical-binding: t; -*-
-
-;; This file is in the public domain because the authors distributed it
-;; without a copyright notice before the US signed the Bern Convention.
-
-;; This file is part of GNU Emacs.
-
-;; Author: Neal Ziring <nz@rsch.wisc.edu>
-;; Felix S. T. Wu <wu@crys.wisc.edu>
-;; Keywords: emulations
-;; Obsolete-since: 24.5
-
-;;; Commentary:
-
-;; This file is obsolete. Consider using viper instead.
-
-;; 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-hook" to enter "vi" automatically
-;; after a file is loaded into the buffer. For example, I defined it as:
-;; (setq find-file-hook (list
-;; (function (lambda ()
-;; (if (not (or (eq major-mode 'Info-mode)
-;; (eq major-mode 'vi-mode)))
-;; (vi-mode))))))
-;; 3) In your init 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:
-
-(defvar vi-mode-old-major-mode)
-(defvar vi-mode-old-mode-name)
-(defvar vi-mode-old-local-map)
-(defvar vi-mode-old-case-fold)
-
-(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))
-\f
-(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}"))
- (with-current-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
-
-\f
-(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-first-indent-point) ; 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-command) ; 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-]" #'xref-find-definitions)
- (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 'c-mark-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-mode-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)
- (progn (ding) (message "Already in vi-mode."))
- (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))
- (with-current-buffer standard-output
- (help-mode))))
-
-(defun vi-undefined ()
- (interactive)
- (message "Command key \"%s\" is undefined in Evi."
- (single-key-description last-command-event))
- (ding))
-
-(defun vi-unimplemented ()
- (interactive)
- (message "Command key \"%s\" is not implemented in Evi."
- (single-key-description last-command-event))
- (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))
- (with-no-warnings
- (end-of-buffer))
- (with-no-warnings (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)
- (isearch-update-ring string arg))
- (funcall vi-search-last-command 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)
- (isearch-update-ring string arg))
- (funcall vi-search-last-command 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
- (car (if (memq search-command
- '(re-search-forward re-search-backward))
- regexp-search-ring
- search-ring))))
- (if (null search-command)
- (progn (ding) (message "No last search command to repeat."))
- (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
- (car (if (memq search-command
- '(re-search-forward re-search-backward))
- regexp-search-ring
- search-ring))))
- (if (null search-command)
- (progn (ding) (message "No last search command to repeat."))
- (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)
- (let ((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) (progn (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")
- (forward-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-event) ; `` 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)
- (progn (vi-ding) (message "Mark register undefined."))
- (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)
- (progn (ding) (message "No last find char to repeat."))
- (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)
- (progn (ding) (message "No last find char to repeat."))
- (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 up to 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 up to 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-event 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-event))
- (setq last-command-event (read-char))
- (setq this-command (lookup-key vi-com-map (char-to-string last-command-event)))
- (if (not (eq this-command 'vi-digit-argument))
- (setq prefix-arg arg)
- (vi-digit-argument arg)
- (setq last-command-event (read-char))
- (setq this-command (lookup-key vi-com-map (char-to-string last-command-event))))
- (cond ((char-equal this-op-char last-command-event) ; 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) (forward-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 (forward-line 1) (beginning-of-line))
- (beginning-of-line))
- (if after-p (forward-char 1)))
- (push-mark)
- (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))
- (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)))
- (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 (point-marker)))
- (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))))
-
-(declare-function c-mark-function "cc-cmds" ())
-
-(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) (with-no-warnings (mark-whole-buffer)))
- ((char-equal region ?p) (mark-paragraph))
- ((char-equal region ?P) (mark-page arg))
- ((char-equal region ?f) (c-mark-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
- (ding)
- (message "No definition for \"%s\" in current file." name)
- (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))
-
-(provide 'vi)
-
-;;; vi.el ends here
+++ /dev/null
-;;; vip.el --- a VI Package for GNU Emacs -*- lexical-binding: t; -*-
-
-;; Copyright (C) 1986-1988, 1992-1993, 1998, 2001-2024 Free Software
-;; Foundation, Inc.
-
-;; Author: Masahiko Sato <ms@sail.stanford.edu>
-;; Keywords: emulations
-;; Obsolete-since: 24.5
-
-;; 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 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; 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. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file is obsolete. Consider using viper instead.
-
-;; 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:
-
-(defgroup vip nil
- "A VI Package for GNU Emacs."
- :prefix "vip-"
- :group 'emulations)
-
-;; 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).")
-
-(defcustom vip-shift-width 8
- "The number of columns shifted by > and < command."
- :type 'integer)
-
-(defcustom vip-re-replace nil
- "If t then do regexp replace, if nil then do string replace."
- :type 'boolean)
-
-(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.")
-
-(defcustom vip-search-wrap-around t
- "If t, search wraps around."
- :type 'boolean)
-
-(defcustom vip-re-search nil
- "If t, search is reg-exp search, otherwise vanilla search."
- :type 'boolean)
-
-(defvar vip-s-string nil
- "Last vip search string.")
-
-(defvar vip-s-forward nil
- "If t, search is forward.")
-
-(defcustom vip-case-fold-search nil
- "If t, search ignores cases."
- :type 'boolean)
-
-(defcustom vip-re-query-replace nil
- "If t then do regexp replace, if nil then do string replace."
- :type 'boolean)
-
-(defcustom vip-open-with-indent nil
- "If t, indent when open a new line."
- :type 'boolean)
-
-(defcustom 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'."
- :type 'boolean)
-
-(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 (locate-user-emacs-file "vip" ".vip")
- "Filename used as startup file for vip.")
-\f
-;; key bindings
-
-(defvar vip-mode-map
- (let ((map (make-keymap)))
- (define-key map "\C-a" #'beginning-of-line)
- (define-key map "\C-b" #'vip-scroll-back)
- (define-key map "\C-c" #'vip-ctl-c)
- (define-key map "\C-d" #'vip-scroll-up)
- (define-key map "\C-e" #'vip-scroll-up-one)
- (define-key map "\C-f" #'vip-scroll)
- (define-key map "\C-g" #'vip-keyboard-quit)
- (define-key map "\C-h" #'help-command)
- (define-key map "\C-m" #'vip-scroll-back)
- (define-key map "\C-n" #'vip-other-window)
- (define-key map "\C-o" #'vip-open-line-at-point)
- (define-key map "\C-u" #'vip-scroll-down)
- (define-key map "\C-x" #'vip-ctl-x)
- (define-key map "\C-y" #'vip-scroll-down-one)
- (define-key map "\C-z" #'vip-change-mode-to-emacs)
- (define-key map "\e" #'vip-ESC)
-
- (define-key map [?\S-\ ] #'vip-scroll-back)
- (define-key map " " #'vip-scroll)
- (define-key map "!" #'vip-command-argument)
- (define-key map "\"" #'vip-command-argument)
- (define-key map "#" #'vip-command-argument)
- (define-key map "$" #'vip-goto-eol)
- (define-key map "%" #'vip-paren-match)
- (define-key map "&" #'vip-nil)
- (define-key map "'" #'vip-goto-mark-and-skip-white)
- (define-key map "(" #'vip-backward-sentence)
- (define-key map ")" #'vip-forward-sentence)
- (define-key map "*" #'call-last-kbd-macro)
- (define-key map "+" #'vip-next-line-at-bol)
- (define-key map "," #'vip-repeat-find-opposite)
- (define-key map "-" #'vip-previous-line-at-bol)
- (define-key map "." #'vip-repeat)
- (define-key map "/" #'vip-search-forward)
-
- (define-key map "0" #'vip-beginning-of-line)
- (define-key map "1" #'vip-digit-argument)
- (define-key map "2" #'vip-digit-argument)
- (define-key map "3" #'vip-digit-argument)
- (define-key map "4" #'vip-digit-argument)
- (define-key map "5" #'vip-digit-argument)
- (define-key map "6" #'vip-digit-argument)
- (define-key map "7" #'vip-digit-argument)
- (define-key map "8" #'vip-digit-argument)
- (define-key map "9" #'vip-digit-argument)
-
- (define-key map ":" #'vip-ex)
- (define-key map ";" #'vip-repeat-find)
- (define-key map "<" #'vip-command-argument)
- (define-key map "=" #'vip-command-argument)
- (define-key map ">" #'vip-command-argument)
- (define-key map "?" #'vip-search-backward)
- (define-key map "@" #'vip-nil)
-
- (define-key map "A" #'vip-Append)
- (define-key map "B" #'vip-backward-Word)
- (define-key map "C" #'vip-ctl-c-equivalent)
- (define-key map "D" #'vip-kill-line)
- (define-key map "E" #'vip-end-of-Word)
- (define-key map "F" #'vip-find-char-backward)
- (define-key map "G" #'vip-goto-line)
- (define-key map "H" #'vip-window-top)
- (define-key map "I" #'vip-Insert)
- (define-key map "J" #'vip-join-lines)
- (define-key map "K" #'vip-kill-buffer)
- (define-key map "L" #'vip-window-bottom)
- (define-key map "M" #'vip-window-middle)
- (define-key map "N" #'vip-search-Next)
- (define-key map "O" #'vip-Open-line)
- (define-key map "P" #'vip-Put-back)
- (define-key map "Q" #'vip-query-replace)
- (define-key map "R" #'vip-replace-string)
- (define-key map "S" #'vip-switch-to-buffer-other-window)
- (define-key map "T" #'vip-goto-char-backward)
- (define-key map "U" #'vip-nil)
- (define-key map "V" #'vip-find-file-other-window)
- (define-key map "W" #'vip-forward-Word)
- (define-key map "X" #'vip-ctl-x-equivalent)
- (define-key map "Y" #'vip-yank-line)
- (define-key map "ZZ" #'save-buffers-kill-emacs)
-
- (define-key map "[" #'vip-nil)
- (define-key map "\\" #'vip-escape-to-emacs)
- (define-key map "]" #'vip-nil)
- (define-key map "^" #'vip-bol-and-skip-white)
- (define-key map "_" #'vip-nil)
- (define-key map "`" #'vip-goto-mark)
-
- (define-key map "a" #'vip-append)
- (define-key map "b" #'vip-backward-word)
- (define-key map "c" #'vip-command-argument)
- (define-key map "d" #'vip-command-argument)
- (define-key map "e" #'vip-end-of-word)
- (define-key map "f" #'vip-find-char-forward)
- (define-key map "g" #'vip-info-on-file)
- (define-key map "h" #'vip-backward-char)
- (define-key map "i" #'vip-insert)
- (define-key map "j" #'vip-next-line)
- (define-key map "k" #'vip-previous-line)
- (define-key map "l" #'vip-forward-char)
- (define-key map "m" #'vip-mark-point)
- (define-key map "n" #'vip-search-next)
- (define-key map "o" #'vip-open-line)
- (define-key map "p" #'vip-put-back)
- (define-key map "q" #'vip-nil)
- (define-key map "r" #'vip-replace-char)
- (define-key map "s" #'vip-switch-to-buffer)
- (define-key map "t" #'vip-goto-char-forward)
- (define-key map "u" #'vip-undo)
- (define-key map "v" #'vip-find-file)
- (define-key map "w" #'vip-forward-word)
- (define-key map "x" #'vip-delete-char)
- (define-key map "y" #'vip-command-argument)
- (define-key map "zH" #'vip-line-to-top)
- (define-key map "zM" #'vip-line-to-middle)
- (define-key map "zL" #'vip-line-to-bottom)
- (define-key map "z\C-m" #'vip-line-to-top)
- (define-key map "z." #'vip-line-to-middle)
- (define-key map "z-" #'vip-line-to-bottom)
-
- (define-key map "{" #'vip-backward-paragraph)
- (define-key map "|" #'vip-goto-col)
- (define-key map "}" #'vip-forward-paragraph)
- (define-key map "~" #'vip-nil)
- (define-key map "\177" #'vip-delete-backward-char)
- map))
-
-(defun vip-version ()
- (interactive)
- (message "VIP version 3.5 of September 15, 1987"))
-
-\f
-;; basic set up
-
-;;;###autoload
-(defun vip-setup ()
- "Set up bindings for C-x 7 and C-z that are useful for VIP users."
- (define-key ctl-x-map "7" #'vip-buffer-in-two-windows)
- (global-set-key "\C-z" #'vip-change-mode-to-vi))
-
-(defmacro vip-loop (count body)
- "(COUNT BODY) Execute BODY COUNT times."
- `(let ((count ,count))
- (while (> count 0)
- ,body
- (setq count (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)))
-
-\f
-;; 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
- (with-current-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))
-
-\f
-;; 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 (old-map (current-local-map)))
- (if events (setq unread-command-events
- (append events unread-command-events)))
- (setq prefix-arg arg)
- (use-local-map vip-emacs-local-map)
- (unwind-protect
- (setq com (key-binding (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)))
-
-\f
-;; 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)))
- (push char unread-command-events))
-
-(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)))
- (push char unread-command-events))
- ;; 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-event nil
- (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-event
- (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))))
-
-\f
-;; 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 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) (ispell-region vip-com-point (point)))))
-
-\f
-;; 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))
-
-\f
-;; 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))) (with-no-warnings (next-line 1)))
- (beginning-of-line)
- (if (> beg end) (exchange-point-and-mark)))
-
-(defun vip-global-execute ()
- "Call last keyboard 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= string "")
- (= (aref string (1- (length string))) ?\n)))
-
-(defvar vip-save-minibuffer-local-map)
-
-(defun vip-read-string (prompt &optional init)
- (setq vip-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 nil
- (setq str (read-string prompt init))
- (quit
- (setq minibuffer-local-map vip-save-minibuffer-local-map)
- (signal 'quit nil)))
- (setq minibuffer-local-map vip-save-minibuffer-local-map)
- str))
-
-\f
-;; 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)))
-
-\f
-;; line command
-
-(defun vip-line (arg)
- (let ((val (car arg)) (com (cdr arg)))
- (move-marker vip-com-point (point))
- (with-no-warnings (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))))
-
-\f
-;; 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))
- (with-no-warnings
- (replace-string
- str
- (vip-read-string (format "Replace \"%s\" with: " str))))))))
-
-\f
-;; 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))))
-
-\f
-;; 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)))
- (with-no-warnings (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)))
- (with-no-warnings (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)))
- (with-no-warnings (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)))
-
-\f
-;; 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 (with-no-warnings (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 behavior 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)))))
-
-\f
-;; 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))))
-
-\f
-;; 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 ""))))))
-
-\f
-;; 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))))
-
-\f
-;; 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))
-
-\f
-;; splitting window
-
-(defun vip-buffer-in-two-windows ()
- "Show current buffer in two windows."
- (interactive)
- (delete-other-windows)
- (split-window-below))
-
-\f
-;; 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))))
-
-\f
-;; 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)))))
-
-\f
-;; 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
- (with-no-warnings (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)))
- (with-no-warnings (delete-backward-char val t))))
-
-\f
-;; 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)))))))
-
-\f
-;; making small changes
-
-(defvar vip-c-string)
-
-(defun vip-change (beg end)
- (setq vip-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 vip-c-string))
-
-\f
-;; 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)))))))
-
-\f
-;; 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))))
-\f
-;; 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))))
-
-\f
-;; 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."
- (with-current-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-number (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 ((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 ((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 "%s" "Marks are ' and a-z")))
- (forward-char 1))
- ((looking-at "\n")
- (setq ex-token-type "end-mark")
- (setq ex-token "goto"))
- (t
- (error "Invalid 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)))
- (with-current-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)
- (with-current-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 "%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"
- (with-current-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"
- (with-current-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"
- (with-current-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)
- (with-current-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-number (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 "Invalid extra characters"))))
-
-(defun vip-get-ex-count ()
- (setq ex-variant nil
- ex-count nil
- ex-flag nil)
- (with-current-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-number (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 "Invalid 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)
- (with-current-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)
- (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 nil
- (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
- (with-current-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)))))
- (with-current-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 nil
- (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)))
- (with-current-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)
- (with-current-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))
- (with-no-warnings
- (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
- (lambda (count)
- (interactive "p")
- (execute-kbd-macro string count)))))
-
-(defun ex-unmap ()
- "ex unmap"
- (let (char)
- (with-current-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)
- (with-current-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)) (with-no-warnings (next-line 1)))
- (beginning-of-line)
- (with-current-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)
- (with-no-warnings
- (insert-file file)))))
-
-(defalias 'ex-set #'set-variable)
-
-(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)))
- eol-mark) ;;(cont t)
- (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)
- (with-current-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
- (with-suppressed-warnings ((obsolete find-tag find-tag-other-window))
- (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)
- (with-current-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 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))
-
-(provide 'vip)
-
-;;; vip.el ends here
+++ /dev/null
-;;; ws-mode.el --- WordStar emulation mode for GNU Emacs -*- lexical-binding: t -*-
-
-;; Copyright (C) 1991, 2001-2024 Free Software Foundation, Inc.
-
-;; Author: Juergen Nickelsen <nickel@cs.tu-berlin.de>
-;; Version: 0.7
-;; Keywords: emulations
-;; Obsolete-since: 24.5
-
-;; 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 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; 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. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This provides emulation of WordStar with a minor mode.
-
-;;; Code:
-
-(defgroup wordstar nil
- "WordStar emulation within Emacs."
- :prefix "wordstar-"
- :prefix "ws-"
- :group 'emulations)
-
-(defcustom wordstar-mode-lighter " WordStar"
- "Lighter shown in the modeline for `wordstar' mode."
- :type 'string)
-
-(defvar wordstar-C-k-map
- (let ((map (make-keymap)))
- (define-key map " " ())
- (define-key map "0" #'ws-set-marker-0)
- (define-key map "1" #'ws-set-marker-1)
- (define-key map "2" #'ws-set-marker-2)
- (define-key map "3" #'ws-set-marker-3)
- (define-key map "4" #'ws-set-marker-4)
- (define-key map "5" #'ws-set-marker-5)
- (define-key map "6" #'ws-set-marker-6)
- (define-key map "7" #'ws-set-marker-7)
- (define-key map "8" #'ws-set-marker-8)
- (define-key map "9" #'ws-set-marker-9)
- (define-key map "b" #'ws-begin-block)
- (define-key map "\C-b" #'ws-begin-block)
- (define-key map "c" #'ws-copy-block)
- (define-key map "\C-c" #'ws-copy-block)
- (define-key map "d" #'save-buffers-kill-emacs)
- (define-key map "\C-d" #'save-buffers-kill-emacs)
- (define-key map "f" #'find-file)
- (define-key map "\C-f" #'find-file)
- (define-key map "h" #'ws-show-markers)
- (define-key map "\C-h" #'ws-show-markers)
- (define-key map "i" #'ws-indent-block)
- (define-key map "\C-i" #'ws-indent-block)
- (define-key map "k" #'ws-end-block)
- (define-key map "\C-k" #'ws-end-block)
- (define-key map "p" #'ws-print-block)
- (define-key map "\C-p" #'ws-print-block)
- (define-key map "q" #'kill-emacs)
- (define-key map "\C-q" #'kill-emacs)
- (define-key map "r" #'insert-file)
- (define-key map "\C-r" #'insert-file)
- (define-key map "s" #'save-some-buffers)
- (define-key map "\C-s" #'save-some-buffers)
- (define-key map "t" #'ws-mark-word)
- (define-key map "\C-t" #'ws-mark-word)
- (define-key map "u" #'ws-exdent-block)
- (define-key map "\C-u" #'keyboard-quit)
- (define-key map "v" #'ws-move-block)
- (define-key map "\C-v" #'ws-move-block)
- (define-key map "w" #'ws-write-block)
- (define-key map "\C-w" #'ws-write-block)
- (define-key map "x" #'save-buffers-kill-emacs)
- (define-key map "\C-x" #'save-buffers-kill-emacs)
- (define-key map "y" #'ws-delete-block)
- (define-key map "\C-y" #'ws-delete-block)
- map))
-
-(defvar wordstar-C-o-map
- (let ((map (make-keymap)))
- (define-key map " " ())
- (define-key map "c" #'wordstar-center-line)
- (define-key map "\C-c" #'wordstar-center-line)
- (define-key map "b" #'switch-to-buffer)
- (define-key map "\C-b" #'switch-to-buffer)
- (define-key map "j" #'justify-current-line)
- (define-key map "\C-j" #'justify-current-line)
- (define-key map "k" #'kill-buffer)
- (define-key map "\C-k" #'kill-buffer)
- (define-key map "l" #'list-buffers)
- (define-key map "\C-l" #'list-buffers)
- (define-key map "m" #'auto-fill-mode)
- (define-key map "\C-m" #'auto-fill-mode)
- (define-key map "r" #'set-fill-column)
- (define-key map "\C-r" #'set-fill-column)
- (define-key map "\C-u" #'keyboard-quit)
- (define-key map "wd" #'delete-other-windows)
- (define-key map "wh" #'split-window-right)
- (define-key map "wo" #'other-window)
- (define-key map "wv" #'split-window-below)
- map))
-
-(defvar wordstar-C-q-map
- (let ((map (make-keymap)))
- (define-key map " " ())
- (define-key map "0" #'ws-find-marker-0)
- (define-key map "1" #'ws-find-marker-1)
- (define-key map "2" #'ws-find-marker-2)
- (define-key map "3" #'ws-find-marker-3)
- (define-key map "4" #'ws-find-marker-4)
- (define-key map "5" #'ws-find-marker-5)
- (define-key map "6" #'ws-find-marker-6)
- (define-key map "7" #'ws-find-marker-7)
- (define-key map "8" #'ws-find-marker-8)
- (define-key map "9" #'ws-find-marker-9)
- (define-key map "a" #'ws-query-replace)
- (define-key map "\C-a" #'ws-query-replace)
- (define-key map "b" #'ws-goto-block-begin)
- (define-key map "\C-b" #'ws-goto-block-begin)
- (define-key map "c" #'end-of-buffer)
- (define-key map "\C-c" #'end-of-buffer)
- (define-key map "d" #'end-of-line)
- (define-key map "\C-d" #'end-of-line)
- (define-key map "f" #'ws-search)
- (define-key map "\C-f" #'ws-search)
- (define-key map "k" #'ws-goto-block-end)
- (define-key map "\C-k" #'ws-goto-block-end)
- (define-key map "l" #'ws-undo)
- (define-key map "\C-l" #'ws-undo)
- ;; (define-key map "p" #'ws-last-cursorp)
- ;; (define-key map "\C-p" #'ws-last-cursorp)
- (define-key map "r" #'beginning-of-buffer)
- (define-key map "\C-r" #'beginning-of-buffer)
- (define-key map "s" #'beginning-of-line)
- (define-key map "\C-s" #'beginning-of-line)
- (define-key map "\C-u" #'keyboard-quit)
- (define-key map "w" #'ws-last-error)
- (define-key map "\C-w" #'ws-last-error)
- (define-key map "y" #'ws-kill-eol)
- (define-key map "\C-y" #'ws-kill-eol)
- (define-key map "\177" #'ws-kill-bol)
- map))
-
-(defvar wordstar-mode-map
- (let ((map (make-keymap)))
- (define-key map "\C-a" #'backward-word)
- (define-key map "\C-b" #'fill-paragraph)
- (define-key map "\C-c" #'scroll-up-command)
- (define-key map "\C-d" #'forward-char)
- (define-key map "\C-e" #'previous-line)
- (define-key map "\C-f" #'forward-word)
- (define-key map "\C-g" #'delete-char)
- (define-key map "\C-h" #'backward-char)
- (define-key map "\C-i" #'indent-for-tab-command)
- (define-key map "\C-k" wordstar-C-k-map)
- (define-key map "\C-l" #'ws-repeat-search)
- (define-key map "\C-n" #'open-line)
- (define-key map "\C-o" wordstar-C-o-map)
- (define-key map "\C-p" #'quoted-insert)
- (define-key map "\C-q" wordstar-C-q-map)
- (define-key map "\C-r" #'scroll-down-command)
- (define-key map "\C-s" #'backward-char)
- (define-key map "\C-t" #'kill-word)
- (define-key map "\C-u" #'keyboard-quit)
- (define-key map "\C-v" #'overwrite-mode)
- (define-key map "\C-w" #'scroll-down-line)
- (define-key map "\C-x" #'next-line)
- (define-key map "\C-y" #'kill-complete-line)
- (define-key map "\C-z" #'scroll-up-line)
- map))
-
-;; wordstar-C-j-map not yet implemented
-(defvar wordstar-C-j-map nil)
-
-;;;###autoload
-(define-minor-mode wordstar-mode
- "Minor 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."
- :group 'wordstar
- :lighter wordstar-mode-lighter
- :keymap wordstar-mode-map)
-
-(defun turn-on-wordstar-mode ()
- (when (and (not (minibufferp))
- (not wordstar-mode))
- (wordstar-mode 1)))
-
-(define-globalized-minor-mode global-wordstar-mode wordstar-mode
- turn-on-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))))))
-
-;;;;;;;;;;;
-;; 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-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
- (progn
- (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
- (progn
- (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)
- (progn
- (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)
- (progn
- (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-goto-block-begin ()
- "In WordStar mode: Go to block begin marker."
- (interactive)
- (if ws-block-begin-marker
- (progn
- (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
- (progn
- (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: Go to position before last search."
- (interactive)
- (if ws-last-cursorposition
- (progn
- (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 "%s" 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: \n\
-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)
- (progn
- (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")))))
-
-(defmacro ws-set-marker (&rest indices)
- (let (n forms)
- (while indices
- (setq n (pop indices))
- (push `(defun ,(intern (format "ws-set-marker-%d" n)) ()
- ,(format "In WordStar mode: Set marker %d to current cursor position" n)
- (interactive)
- (setq ,(intern (format "ws-marker-%d" n)) (point-marker))
- (message ,(format "Marker %d set" n)))
- forms))
- `(progn ,@(nreverse forms))))
-
-(ws-set-marker 0 1 2 3 4 5 6 7 8 9)
-
-(defmacro ws-find-marker (&rest indices)
- (let (n forms)
- (while indices
- (setq n (pop indices))
- (push `(defun ,(intern (format "ws-find-marker-%d" n)) ()
- ,(format "In WordStar mode: Go to marker %d." n)
- (interactive)
- (if ,(intern (format "ws-marker-%d" n))
- (progn (setq ws-last-cursorposition (point-marker))
- (goto-char ,(intern (format "ws-marker-%d" n))))
- (ws-error ,(format "Marker %d not set" n))))
- forms))
- `(progn ,@(nreverse forms))))
-
-(ws-find-marker 0 1 2 3 4 5 6 7 8 9)
-
-(provide 'ws-mode)
-
-;;; ws-mode.el ends here
+++ /dev/null
-;;; yow.el --- quote random zippyisms -*- lexical-binding: t; -*-
-
-;; Copyright (C) 1993-1995, 2000-2024 Free Software Foundation, Inc.
-
-;; Author: Richard Mlynarik
-;; Maintainer: emacs-devel@gnu.org
-;; Keywords: games
-;; Obsolete-since: 24.4
-
-;; 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 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; 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. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Important pinheadery for GNU Emacs.
-;; This file is obsolete. For similar functionality, see
-;; fortune.el and cookie1.el.
-
-;;; Code:
-
-(require 'cookie1)
-
-(defgroup yow nil
- "Quote random zippyisms."
- :prefix "yow-"
- :group 'games)
-
-(defcustom yow-file (expand-file-name "yow.lines" data-directory)
- "File containing pertinent pinhead phrases."
- :type 'file)
-
-(defconst yow-load-message "Am I CONSING yet?...")
-(defconst yow-after-load-message "I have SEEN the CONSING!!")
-
-;;;###autoload
-(defun yow (&optional insert display)
- "Return or display a random Zippy quotation. With prefix arg, insert it."
- (interactive "P\np")
- (let ((yow (cookie yow-file yow-load-message yow-after-load-message)))
- (cond (insert
- (insert yow))
- ((not display)
- yow)
- (t
- (message "%s" yow)))))
-
-(defsubst read-zippyism (prompt &optional require-match)
- "Read a Zippyism from the minibuffer with completion, prompting with PROMPT.
-If optional second arg is non-nil, require input to match a completion."
- (cookie-read prompt yow-file yow-load-message yow-after-load-message
- require-match))
-
-;;;###autoload
-(defun insert-zippyism (&optional zippyism)
- "Prompt with completion for a known Zippy quotation, and insert it at point."
- (interactive (list (read-zippyism "Pinhead wisdom: " t)))
- (insert zippyism))
-
-;;;###autoload
-(defun apropos-zippy (regexp)
- "Return a list of all Zippy quotes matching REGEXP.
-If called interactively, display a list of matches."
- (interactive "sApropos Zippy (regexp): ")
- (cookie-apropos regexp yow-file (called-interactively-p 'interactive)))
-
-\f
-;; Yowza!! Feed zippy quotes to the doctor. Watch results.
-;; fun, fun, fun. Entertainment for hours...
-;;
-;; written by Kayvan Aghaiepour
-
-(declare-function doctor-ret-or-read "doctor" (arg))
-
-;;;###autoload
-(defun psychoanalyze-pinhead ()
- "Zippy goes to the analyst."
- (interactive)
- (cookie-doctor yow-file))
-
-(provide 'yow)
-
-;;; yow.el ends here
projects / emacs.git / commitdiff