cgit.sxemacs.org Git - packages/blob - xemacs-packages/xemacs-base/chistory.el

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