| 1 | ;;; chistory.el --- list command history |
| 2 | |
| 3 | ;; Copyright (C) 1985 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: K. Shane Hartman |
| 6 | ;; Maintainer: FSF |
| 7 | |
| 8 | ;; This file is part of GNU Emacs. |
| 9 | |
| 10 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 11 | ;; it under the terms of the GNU General Public License as published by |
| 12 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 13 | ;; any later version. |
| 14 | |
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 18 | ;; GNU General Public License for more details. |
| 19 | |
| 20 | ;; You should have received a copy of the GNU General Public License |
| 21 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 22 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 23 | ;; Boston, MA 02111-1307, USA. |
| 24 | |
| 25 | ;;; Commentary: |
| 26 | |
| 27 | ;; This really has nothing to do with list-command-history per se, but |
| 28 | ;; its a nice alternative to C-x ESC ESC (repeat-complex-command) and |
| 29 | ;; functions as a lister if given no pattern. It's not important |
| 30 | ;; enough to warrant a file of its own. |
| 31 | |
| 32 | ;;; Code: |
| 33 | |
| 34 | (defgroup chistory nil |
| 35 | "List command history." |
| 36 | :group 'keyboard) |
| 37 | |
| 38 | ;;;###autoload |
| 39 | (defun repeat-matching-complex-command (&optional pattern) |
| 40 | "Edit and re-evaluate complex command with name matching PATTERN. |
| 41 | Matching occurrences are displayed, most recent first, until you select |
| 42 | a form for evaluation. If PATTERN is empty (or nil), every form in the |
| 43 | command history is offered. The form is placed in the minibuffer for |
| 44 | editing and the result is evaluated." |
| 45 | (interactive "sRedo Command (regexp): ") |
| 46 | (if pattern |
| 47 | (if (string-match "[^ \t]" pattern) |
| 48 | (setq pattern (substring pattern (match-beginning 0))) |
| 49 | (setq pattern nil))) |
| 50 | (let ((history command-history) |
| 51 | (temp) |
| 52 | (what)) |
| 53 | (while (and history (not what)) |
| 54 | (setq temp (car history)) |
| 55 | (if (and (or (not pattern) (string-match pattern (symbol-name (car temp)))) |
| 56 | (y-or-n-p (format "Redo %S? " temp))) |
| 57 | (setq what (car history)) |
| 58 | (setq history (cdr history)))) |
| 59 | (if (not what) |
| 60 | (error "Command history exhausted") |
| 61 | ;; Try to remove any useless command history element for this command. |
| 62 | (if (eq (car (car command-history)) 'repeat-matching-complex-command) |
| 63 | (setq command-history (cdr command-history))) |
| 64 | (edit-and-eval-command "Redo: " what)))) |
| 65 | |
| 66 | (defcustom default-command-history-filter-garbage |
| 67 | '(command-history-mode |
| 68 | list-command-history |
| 69 | electric-command-history) |
| 70 | "*A list of symbols to be ignored by `default-command-history-filter'. |
| 71 | If that function is given a list whose car is an element of this list, |
| 72 | then it will return non-nil (indicating the list should be discarded from |
| 73 | the history). |
| 74 | Initially, all commands related to the command history are discarded." |
| 75 | :type '(repeat symbol) |
| 76 | :group 'chistory) |
| 77 | |
| 78 | (defvar list-command-history-filter 'default-command-history-filter |
| 79 | "Predicate to test which commands should be excluded from the history listing. |
| 80 | If non-nil, should be the name of a function of one argument. |
| 81 | It is passed each element of the command history when |
| 82 | \\[list-command-history] is called. If the filter returns non-nil for |
| 83 | some element, that element is excluded from the history listing. The |
| 84 | default filter removes commands associated with the command-history.") |
| 85 | |
| 86 | (defun default-command-history-filter (frob) |
| 87 | "Filter commands matching `default-command-history-filter-garbage' list |
| 88 | from the command history." |
| 89 | (or (not (consp frob)) |
| 90 | (memq (car frob) default-command-history-filter-garbage))) |
| 91 | |
| 92 | (defcustom list-command-history-max 32 |
| 93 | "*If non-nil, maximum length of the listing produced by `list-command-history'." |
| 94 | :type '(choice integer (const nil)) |
| 95 | :group 'chistory) |
| 96 | |
| 97 | ;;;###autoload |
| 98 | (defun list-command-history () |
| 99 | "List history of commands typed to minibuffer. |
| 100 | The number of commands listed is controlled by `list-command-history-max'. |
| 101 | Calls value of `list-command-history-filter' (if non-nil) on each history |
| 102 | element to judge if that element should be excluded from the list. |
| 103 | |
| 104 | The buffer is left in Command History mode." |
| 105 | (interactive) |
| 106 | (with-output-to-temp-buffer |
| 107 | "*Command History*" |
| 108 | (let ((history command-history) |
| 109 | (buffer-read-only nil) |
| 110 | (count (or list-command-history-max -1))) |
| 111 | (while (and (/= count 0) history) |
| 112 | (if (and (boundp 'list-command-history-filter) |
| 113 | list-command-history-filter |
| 114 | (funcall list-command-history-filter (car history))) |
| 115 | nil |
| 116 | (setq count (1- count)) |
| 117 | (prin1 (car history)) |
| 118 | (terpri)) |
| 119 | (setq history (cdr history)))) |
| 120 | (save-excursion |
| 121 | (set-buffer "*Command History*") |
| 122 | (goto-char (point-min)) |
| 123 | (if (eobp) |
| 124 | (error "No command history") |
| 125 | (command-history-mode))))) |
| 126 | |
| 127 | (defun command-history-mode () |
| 128 | "Major mode for listing and repeating recent commands." |
| 129 | (Command-history-setup) |
| 130 | (setq major-mode 'command-history-mode) |
| 131 | (setq mode-name "Command History") |
| 132 | (use-local-map command-history-map) |
| 133 | (run-hooks 'command-history-mode-hook)) |
| 134 | |
| 135 | (defun Command-history-setup () |
| 136 | (kill-all-local-variables) |
| 137 | (use-local-map (or keymap command-history-map)) |
| 138 | (lisp-mode-variables nil) |
| 139 | (set-syntax-table emacs-lisp-mode-syntax-table) |
| 140 | (setq buffer-read-only t)) |
| 141 | |
| 142 | (defcustom command-history-hook nil |
| 143 | "If non-nil, its value is called on entry to `command-history-mode'." |
| 144 | :type 'hook |
| 145 | :group 'chistory) |
| 146 | |
| 147 | (defvar command-history-map nil) |
| 148 | (unless command-history-map |
| 149 | (setq command-history-map (make-sparse-keymap)) |
| 150 | (set-keymap-parent command-history-map lisp-mode-shared-map) |
| 151 | (suppress-keymap command-history-map) |
| 152 | (define-key command-history-map "x" 'command-history-repeat) |
| 153 | (define-key command-history-map "\n" 'next-line) |
| 154 | (define-key command-history-map "\r" 'next-line) |
| 155 | (define-key command-history-map "\177" 'previous-line)) |
| 156 | |
| 157 | (defun command-history-repeat () |
| 158 | "Repeat the command shown on the current line. |
| 159 | The buffer for that command is the previous current buffer." |
| 160 | (interactive) |
| 161 | (save-excursion |
| 162 | (eval (prog1 |
| 163 | (save-excursion |
| 164 | (beginning-of-line) |
| 165 | (read (current-buffer))) |
| 166 | (set-buffer |
| 167 | (car (cdr (buffer-list)))))))) |
| 168 | |
| 169 | ;;;###autoload |
| 170 | (defun command-history () |
| 171 | "Examine commands from `command-history' in a buffer. |
| 172 | The number of commands listed is controlled by `list-command-history-max'. |
| 173 | The command history is filtered by `list-command-history-filter' if non-nil. |
| 174 | Use \\<command-history-map>\\[command-history-repeat] to repeat the command on the current line. |
| 175 | |
| 176 | Otherwise much like Emacs-Lisp Mode except that there is no self-insertion |
| 177 | and digits provide prefix arguments. Tab does not indent. |
| 178 | \\{command-history-map} |
| 179 | |
| 180 | This command always recompiles the Command History listing |
| 181 | and runs the normal hook `command-history-hook'." |
| 182 | (interactive) |
| 183 | (list-command-history) |
| 184 | (pop-to-buffer "*Command History*") |
| 185 | (run-hooks 'command-history-hook)) |
| 186 | |
| 187 | (provide 'chistory) |
| 188 | |
| 189 | ;;; chistory.el ends here |