Initial revision

2 files changed, 456 insertions, 0 deletions

diff --git a/lisp/abbrev.el b/lisp/abbrev.el
new file mode 100644
index 00000000000..9bd311290fb
--- /dev/null
+++ b/lisp/abbrev.el
@@ -0,0 +1,289 @@
+;; Abbrev mode commands for Emacs
+
+;; Copyright (C) 1985-1991 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;;;###autoload
+(defconst only-global-abbrevs nil "\
+*t means user plans to use global abbrevs only.
+Makes the commands to define mode-specific abbrevs define global ones instead.")
+
+(defun abbrev-mode (arg)
+  "Toggle abbrev mode.
+With arg, turn abbrev mode on iff arg is positive.
+In abbrev mode, inserting an abbreviation causes it to expand
+and be replaced by its expansion."
+  (interactive "P")
+  (setq abbrev-mode
+        (if (null arg) (not abbrev-mode)
+          (> (prefix-numeric-value arg) 0)))
+  (set-buffer-modified-p (buffer-modified-p))) ;No-op, but updates mode line.
+
+(defvar edit-abbrevs-map nil
+  "Keymap used in edit-abbrevs.")
+(if edit-abbrevs-map
+    nil
+  (setq edit-abbrevs-map (make-sparse-keymap))
+  (define-key edit-abbrevs-map "\C-x\C-s" 'edit-abbrevs-redefine)
+  (define-key edit-abbrevs-map "\C-c\C-c" 'edit-abbrevs-redefine))
+
+(defun kill-all-abbrevs ()
+  "Undefine all defined abbrevs."
+  (interactive)
+  (let ((tables abbrev-table-name-list))
+    (while tables
+      (clear-abbrev-table (symbol-value (car tables)))
+      (setq tables (cdr tables)))))
+
+(defun insert-abbrevs ()
+  "Insert after point a description of all defined abbrevs.
+Mark is set after the inserted text."
+  (interactive)
+  (push-mark
+   (save-excursion
+    (let ((tables abbrev-table-name-list))
+      (while tables
+        (insert-abbrev-table-description (car tables) t)
+        (setq tables (cdr tables))))
+    (point))))
+
+(defun list-abbrevs ()
+  "Display a list of all defined abbrevs."
+  (interactive)
+  (display-buffer (prepare-abbrev-list-buffer)))
+
+(defun prepare-abbrev-list-buffer ()
+  (save-excursion
+    (set-buffer (get-buffer-create "*Abbrevs*"))
+    (erase-buffer)
+    (let ((tables abbrev-table-name-list))
+      (while tables
+        (insert-abbrev-table-description (car tables) t)
+        (setq tables (cdr tables))))
+    (goto-char (point-min))
+    (set-buffer-modified-p nil)
+    (edit-abbrevs-mode))
+  (get-buffer-create "*Abbrevs*"))
+
+(defun edit-abbrevs-mode ()
+  "Major mode for editing the list of abbrev definitions.
+\\{edit-abbrevs-map}"
+  (interactive)
+  (setq major-mode 'edit-abbrevs-mode)
+  (setq mode-name "Edit-Abbrevs")
+  (use-local-map edit-abbrevs-map))
+
+(defun edit-abbrevs ()
+  "Alter abbrev definitions by editing a list of them.
+Selects a buffer containing a list of abbrev definitions.
+You can edit them and type \\<edit-abbrevs-map>\\[edit-abbrevs-redefine] to redefine abbrevs
+according to your editing.
+Buffer contains a header line for each abbrev table,
+ which is the abbrev table name in parentheses.
+This is followed by one line per abbrev in that table:
+NAME   USECOUNT   EXPANSION   HOOK
+where NAME and EXPANSION are strings with quotes,
+USECOUNT is an integer, and HOOK is any valid function
+or may be omitted (it is usually omitted)."
+  (interactive)
+  (switch-to-buffer (prepare-abbrev-list-buffer)))
+
+(defun edit-abbrevs-redefine ()
+  "Redefine abbrevs according to current buffer contents."
+  (interactive)
+  (define-abbrevs t)
+  (set-buffer-modified-p nil))
+
+(defun define-abbrevs (&optional arg)
+  "Define abbrevs according to current visible buffer contents.
+See documentation of `edit-abbrevs' for info on the format of the
+text you must have in the buffer.
+With argument, eliminate all abbrev definitions except
+the ones defined from the buffer now."
+  (interactive "P")
+  (if arg (kill-all-abbrevs))
+  (save-excursion
+   (goto-char (point-min))
+   (while (and (not (eobp)) (re-search-forward "^(" nil t))
+     (let* ((buf (current-buffer))
+            (table (read buf))
+            abbrevs)
+       (forward-line 1)
+       (while (progn (forward-line 1)
+                     (not (eolp)))
+         (setq name (read buf) count (read buf) exp (read buf))
+         (skip-chars-backward " \t\n\f")
+         (setq hook (if (not (eolp)) (read buf)))
+         (skip-chars-backward " \t\n\f")
+         (setq abbrevs (cons (list name exp hook count) abbrevs)))
+       (define-abbrev-table table abbrevs)))))
+
+(defun read-abbrev-file (&optional file quietly)
+  "Read abbrev definitions from file written with `write-abbrev-file'.
+Optional argument FILE is the name of the file to read;
+it defaults to the value of `abbrev-file-name'.
+Optional second argument QUIETLY non-nil means don't print anything."
+  (interactive "fRead abbrev file: ")
+  (load (if (and file (> (length file) 0)) file abbrev-file-name)
+        nil quietly)
+  (setq save-abbrevs t abbrevs-changed nil))
+
+(defun quietly-read-abbrev-file (&optional file)
+  "Read abbrev definitions from file written with write-abbrev-file.
+Optional argument FILE is the name of the file to read;
+it defaults to the value of `abbrev-file-name'.
+Does not print anything."
+  ;(interactive "fRead abbrev file: ")
+  (read-abbrev-file file t))
+
+(defun write-abbrev-file (file)
+  "Write all abbrev definitions to file of Lisp code.
+The file written can be loaded in another session to define the same abbrevs.
+The argument FILE is the file name to write."
+  (interactive
+   (list
+    (read-file-name "Write abbrev file: "
+                    (file-name-directory (expand-file-name abbrev-file-name))
+                    abbrev-file-name)))
+  (interactive "FWrite abbrev file: ")
+  (or (and file (> (length file) 0))
+      (setq file abbrev-file-name))
+  (save-excursion
+   (set-buffer (get-buffer-create " write-abbrev-file"))
+   (erase-buffer)
+   (let ((tables abbrev-table-name-list))
+     (while tables
+       (insert-abbrev-table-description (car tables) nil)
+       (setq tables (cdr tables))))
+   (write-region 1 (point-max) file)
+   (erase-buffer)))
+
+(defun add-mode-abbrev (arg)
+  "Define mode-specific abbrev for last word(s) before point.
+Argument is how many words before point form the expansion;
+or zero means the region is the expansion.
+A negative argument means to undefine the specified abbrev.
+Reads the abbreviation in the minibuffer.
+
+Don't use this function in a Lisp program; use `define-abbrev' instead."
+  (interactive "p")
+  (add-abbrev
+   (if only-global-abbrevs
+       global-abbrev-table 
+     (or local-abbrev-table
+         (error "No per-mode abbrev table")))
+   "Mode" arg))
+
+(defun add-global-abbrev (arg)
+  "Define global (all modes) abbrev for last word(s) before point.
+The prefix argument specifies the number of words before point that form the
+expansion; or zero means the region is the expansion.
+A negative argument means to undefine the specified abbrev.
+This command uses the minibuffer to read the abbreviation.
+
+Don't use this function in a Lisp program; use `define-abbrev' instead."
+  (interactive "p")
+  (add-abbrev global-abbrev-table "Global" arg))
+
+(defun add-abbrev (table type arg)
+  (let ((exp (and (>= arg 0)
+                  (buffer-substring
+                   (point)
+                   (if (= arg 0) (mark)
+                     (save-excursion (forward-word (- arg)) (point))))))
+        name)
+    (setq name
+          (read-string (format (if exp "%s abbrev for \"%s\": "
+                                 "Undefine %s abbrev: ")
+                               type exp)))
+    (if (or (null exp)
+            (not (abbrev-expansion name table))
+            (y-or-n-p (format "%s expands to \"%s\"; redefine? "
+                              name (abbrev-expansion name table))))
+        (define-abbrev table (downcase name) exp))))
+        
+(defun inverse-add-mode-abbrev (arg)
+  "Define last word before point as a mode-specific abbrev.
+With prefix argument N, defines the Nth word before point.
+This command uses the minibuffer to read the expansion.
+Expands the abbreviation after defining it."
+  (interactive "p")
+  (inverse-add-abbrev
+   (if only-global-abbrevs
+       global-abbrev-table 
+     (or local-abbrev-table
+         (error "No per-mode abbrev table")))
+   "Mode" arg))
+
+(defun inverse-add-global-abbrev (arg)
+  "Define last word before point as a global (mode-independent) abbrev.
+With prefix argument N, defines the Nth word before point.
+This command uses the minibuffer to read the expansion.
+Expands the abbreviation after defining it."
+  (interactive "p")
+  (inverse-add-abbrev global-abbrev-table "Global" arg))
+
+(defun inverse-add-abbrev (table type arg)
+  (let (name nameloc exp)
+    (save-excursion
+     (forward-word (- arg))
+     (setq name (buffer-substring (point) (progn (forward-word 1)
+                                               (setq nameloc (point))))))
+    (setq exp (read-string (format "%s expansion for \"%s\": "
+                                   type name)))
+    (if (or (not (abbrev-expansion name table))
+            (y-or-n-p (format "%s expands to \"%s\"; redefine? "
+                              name (abbrev-expansion name table))))
+        (progn
+         (define-abbrev table (downcase name) exp)
+         (save-excursion
+          (goto-char nameloc)
+          (expand-abbrev))))))
+
+(defun abbrev-prefix-mark (&optional arg)
+  "Mark current point as the beginning of an abbrev.
+Abbrev to be expanded starts here rather than at beginning of word.
+This way, you can expand an abbrev with a prefix: insert the prefix,
+use this command, then insert the abbrev."
+  (interactive "P")
+  (or arg (expand-abbrev))
+  (setq abbrev-start-location (point-marker)
+        abbrev-start-location-buffer (current-buffer))
+  (insert "-"))
+
+(defun expand-region-abbrevs (start end &optional noquery)
+  "For abbrev occurrence in the region, offer to expand it.
+The user is asked to type y or n for each occurrence.
+A prefix argument means don't query; expand all abbrevs.
+If called from a Lisp program, arguments are START END &optional NOQUERY."
+  (interactive "r\nP")
+  (save-excursion
+    (goto-char start)
+    (let ((lim (- (point-max) end))
+          pnt string)
+      (while (and (not (eobp))
+                  (progn (forward-word 1)
+                         (<= (setq pnt (point)) (- (point-max) lim))))
+        (if (abbrev-expansion
+             (setq string
+                   (buffer-substring
+                    (save-excursion (forward-word -1) (point))
+                    pnt)))
+            (if (or noquery (y-or-n-p (format "Expand `%s'? " string)))
+                (expand-abbrev)))))))
diff --git a/lisp/chistory.el b/lisp/chistory.el
new file mode 100644
index 00000000000..3a8bcb6d7c9
--- /dev/null
+++ b/lisp/chistory.el
@@ -0,0 +1,167 @@
+;; chistory -- List command history
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+;; Principal author K. Shane Hartman
+
+;; 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 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(provide 'chistory)
+
+;; This really has nothing to do with list-command-history per se, but
+;; its a nice alternative to C-x ESC (repeat-complex-command) and
+;; functions as a lister if given no pattern.  It's not important
+;; enough to warrant a file of its own.
+
+;;;###autoload
+(defun repeat-matching-complex-command (&optional pattern)
+  "Edit and re-evaluate complex command with name matching PATTERN.
+Matching occurrences are displayed, most recent first, until you select
+a form for evaluation.  If PATTERN is empty (or nil), every form in the
+command history is offered.  The form is placed in the minibuffer for
+editing and the result is evaluated."
+  (interactive "sRedo Command (regexp): ")
+  (if pattern
+      (if (equal (setq pattern
+                       (substring pattern
+                                  (or (string-match "[ \t]*[^ \t]" pattern)
+                                      (length pattern))))
+                 "")
+          (setq pattern nil)))
+  (let ((history command-history)
+        (temp)
+        (what))
+    (while (and history (not what))
+      (setq temp (car history))
+      (if (and (or (not pattern) (string-match pattern (symbol-name (car temp))))
+               (y-or-n-p (format "Redo %s? " (setq temp (prin1-to-string temp)))))
+          (setq what (car history))
+        (setq history (cdr history))))
+    (if (not what)
+        (error "Command history exhausted")
+      ;; Try to remove any useless command history element for this command.
+      (if (eq (car (car command-history)) 'repeat-matching-complex-command)
+          (setq command-history (cdr command-history)))
+      (edit-and-eval-command "Redo: " what))))
+
+(defvar default-command-history-filter-garbage
+  '(command-history-mode
+    list-command-history
+    electric-command-history)
+  "*A list of symbols.  If `default-list-command-history-filter' is
+given a list whose car is an element of this list, then it will return
+non-nil (indicating the list should be discarded from the history).
+Initially, all commands related to the command history are discarded.")
+
+(defvar list-command-history-filter 'default-command-history-filter
+  "If non-nil, should be the name of a function of one argument.
+It is passed each element of the command history when
+\\[list-command-history] is called.  If the filter returns non-nil for
+some element, that element is excluded from the history listing.  The
+default filter removes commands associated with the command-history.")
+
+(defun default-command-history-filter (frob)
+  "Filter commands matching `default-command-history-filter-garbage' list
+from the command history."
+  (or (not (consp frob))
+      (memq (car frob) default-command-history-filter-garbage)))
+
+(defvar list-command-history-max 32
+  "*If non-nil, should be a positive number which specifies the maximum
+length of the Command History listing produced by `list-command-history'.")
+
+;;;###autoload
+(defun list-command-history ()
+  "List history of commands typed to minibuffer.
+The number of commands listed is controlled by `list-command-history-max'.
+Calls value of `list-command-history-filter' (if non-nil) on each history
+element to judge if that element should be excluded from the list.
+
+The buffer is left in Command History mode."
+  (interactive)
+  (with-output-to-temp-buffer
+      "*Command History*"
+    (let ((history command-history)
+          (buffer-read-only nil)
+          (count (or list-command-history-max -1)))
+      (while (and (/= count 0) history)
+        (if (and (boundp 'list-command-history-filter)
+                 list-command-history-filter
+                 (funcall list-command-history-filter (car history)))
+            nil
+          (setq count (1- count))
+          (prin1 (car history))
+          (terpri))
+        (setq history (cdr history))))
+    (save-excursion
+      (set-buffer "*Command History*")
+      (goto-char (point-min))
+      (if (eobp)
+          (error "No command history")
+        (Command-history-setup)))))
+
+(defun Command-history-setup (&optional majormode modename keymap)
+  (set-buffer "*Command History*")
+  (use-local-map (or keymap command-history-map))
+  (lisp-mode-variables nil)
+  (set-syntax-table emacs-lisp-mode-syntax-table)
+  (setq buffer-read-only t)
+  (use-local-map (or keymap command-history-map))
+  (setq major-mode (or majormode 'command-history-mode))
+  (setq mode-name (or modename "Command History")))
+
+(defvar command-history-hook nil
+  "If non-nil, its value is called on entry to `command-history-mode'.")
+
+(defvar command-history-map nil)
+(if command-history-map
+    nil
+  (setq command-history-map
+        (nconc (make-sparse-keymap) shared-lisp-mode-map))
+  (suppress-keymap command-history-map)
+  (define-key command-history-map "x" 'command-history-repeat)
+  (define-key command-history-map "\n" 'next-line)
+  (define-key command-history-map "\r" 'next-line)
+  (define-key command-history-map "\177" 'previous-line))
+
+(defun command-history-repeat ()
+  "Repeat the command shown on the current line.
+The buffer for that command is the previous current buffer."
+  (interactive)
+  (save-excursion
+    (eval (prog1
+              (save-excursion
+                (beginning-of-line)
+                (read (current-buffer)))
+            (set-buffer
+             (cdr (buffer-list)))))))
+
+;;;###autoload
+(defun command-history-mode ()
+  "Major mode for examining commands from `command-history'.
+The number of commands listed is controlled by `list-command-history-max'.
+The command history is filtered by `list-command-history-filter' if non-nil.
+Use \\<command-history-map>\\[command-history-repeat] to repeat the command on the current line.
+
+Otherwise much like Emacs-Lisp Mode except that there is no self-insertion
+and digits provide prefix arguments.  Tab does not indent.
+\\{command-history-map}
+Calls the value of `command-history-hook' if that is non-nil.
+The Command History listing is recomputed each time this mode is invoked."
+  (interactive)
+  (list-command-history)
+  (pop-to-buffer "*Command History*")
+  (run-hooks 'command-history-hook))