lisp/novice.el

   1 ;;; novice.el --- handling of disabled commands ("novice mode") for Emacs
   2
   3 ;; Copyright (C) 1985, 1986, 1987, 1994, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
   5
   6 ;; Maintainer: FSF
   7 ;; Keywords: internal, help
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; This mode provides a hook which is, by default, attached to various
  27 ;; putatively dangerous commands in a (probably futile) attempt to
  28 ;; prevent lusers from shooting themselves in the feet.
  29
  30 ;;; Code:
  31
  32 ;; This function is called (by autoloading)
  33 ;; to handle any disabled command.
  34 ;; The command is found in this-command
  35 ;; and the keys are returned by (this-command-keys).
  36
  37 (eval-when-compile (require 'cl))
  38
  39 ;;;###autoload
  40 (defvar disabled-command-function 'disabled-command-function
  41   "Function to call to handle disabled commands.
  42 If nil, the feature is disabled, i.e., all commands work normally.")
  43
  44 ;;;###autoload
  45 (define-obsolete-variable-alias 'disabled-command-hook 'disabled-command-function "22.1")
  46
  47 ;; It is ok here to assume that this-command is a symbol
  48 ;; because we won't get called otherwise.
  49 ;;;###autoload
  50 (defun disabled-command-function (&optional cmd keys)
  51   (unless cmd (setq cmd this-command))
  52   (unless keys (setq keys (this-command-keys)))
  53   (let (char)
  54     (save-window-excursion
  55       (help-setup-xref (list 'disabled-command-function cmd keys) nil)
  56       (with-output-to-temp-buffer "*Disabled Command*" ;; (help-buffer)
  57          (if (or (eq (aref keys 0)
  58                      (if (stringp keys)
  59                          (aref "\M-x" 0)
  60                        ?\M-x))
  61                  (and (>= (length keys) 2)
  62                       (eq (aref keys 0) meta-prefix-char)
  63                       (eq (aref keys 1) ?x)))
  64             (princ (format "You have invoked the disabled command %s.\n" cmd))
  65            (princ (format "You have typed %s, invoking disabled command %s.\n"
  66                          (key-description keys) cmd)))
  67        ;; Print any special message saying why the command is disabled.
  68         (if (stringp (get cmd 'disabled))
  69             (princ (get cmd 'disabled))
  70          (princ "It is disabled because new users often find it confusing.\n")
  71          (princ "Here's the first part of its description:\n\n")
  72          ;; Keep only the first paragraph of the documentation.
  73           (with-current-buffer "*Disabled Command*" ;; standard-output
  74            (goto-char (point-max))
  75            (let ((start (point)))
  76              (save-excursion
  77                (princ (or (condition-case ()
  78                                (documentation cmd)
  79                             (error nil))
  80                           "<< not documented >>")))
  81              (if (search-forward "\n\n" nil t)
  82                  (delete-region (match-beginning 0) (point-max)))
  83              (goto-char (point-max))
  84              (indent-rigidly start (point) 3))))
  85        (princ "\n\nDo you want to use this command anyway?\n\n")
  86        (princ "You can now type
  87 y   to try it and enable it (no questions if you use it again).
  88 n   to cancel--don't try the command, and it remains disabled.
  89 SPC to try the command just this once, but leave it disabled.
  90 !   to try it, and enable all disabled commands for this session only.")
  91         ;; Redundant since with-output-to-temp-buffer will do it anyway.
  92         ;; (with-current-buffer standard-output
  93         ;;   (help-mode))
  94         )
  95      (fit-window-to-buffer (get-buffer-window "*Disabled Command*"))
  96      (message "Type y, n, ! or SPC (the space bar): ")
  97      (let ((cursor-in-echo-area t))
  98        (while (progn (setq char (read-event))
  99                      (or (not (numberp char))
 100                          (not (memq (downcase char)
 101                                     '(?! ?y ?n ?\s ?\C-g)))))
 102          (ding)
 103          (message "Please type y, n, ! or SPC (the space bar): "))))
 104     (setq char (downcase char))
 105     (case char
 106      (?\C-g (setq quit-flag t))
 107      (?! (setq disabled-command-function nil))
 108      (?y
 109         (if (and user-init-file
 110                  (not (string= "" user-init-file))
 111                  (y-or-n-p "Enable command for future editing sessions also? "))
 112           (enable-command cmd)
 113         (put cmd 'disabled nil)))
 114      (?n nil)
 115      (t (call-interactively cmd)))))
 116
 117 (defun en/disable-command (command disable)
 118   (unless (commandp command)
 119     (error "Invalid command name `%s'" command))
 120   (put command 'disabled disable)
 121   (let ((init-file user-init-file)
 122         (default-init-file
 123           (if (eq system-type 'ms-dos) "~/_emacs" "~/.emacs")))
 124     (unless init-file
 125       (if (or (file-exists-p default-init-file)
 126               (and (eq system-type 'windows-nt)
 127                    (file-exists-p "~/_emacs")))
 128           ;; Started with -q, i.e. the file containing
 129           ;; enabled/disabled commands hasn't been read.  Saving
 130           ;; settings there would overwrite other settings.
 131           (error "Saving settings from \"emacs -q\" would overwrite existing customizations"))
 132       (setq init-file default-init-file)
 133       (if (and (not (file-exists-p init-file))
 134                (eq system-type 'windows-nt)
 135                (file-exists-p "~/_emacs"))
 136           (setq init-file "~/_emacs")))
 137     (with-current-buffer (find-file-noselect
 138                           (substitute-in-file-name init-file))
 139       (goto-char (point-min))
 140       (if (search-forward (concat "(put '" (symbol-name command) " ") nil t)
 141           (delete-region
 142            (progn (beginning-of-line) (point))
 143            (progn (forward-line 1) (point))))
 144       ;; Explicitly enable, in case this command is disabled by default
 145       ;; or in case the code we deleted was actually a comment.
 146       (goto-char (point-max))
 147       (unless (bolp) (newline))
 148       (insert "(put '" (symbol-name command) " 'disabled "
 149               (symbol-name disable) ")\n")
 150       (save-buffer))))
 151
 152 ;;;###autoload
 153 (defun enable-command (command)
 154   "Allow COMMAND to be executed without special confirmation from now on.
 155 COMMAND must be a symbol.
 156 This command alters the user's .emacs file so that this will apply
 157 to future sessions."
 158   (interactive "CEnable command: ")
 159   (en/disable-command command nil))
 160
 161 ;;;###autoload
 162 (defun disable-command (command)
 163   "Require special confirmation to execute COMMAND from now on.
 164 COMMAND must be a symbol.
 165 This command alters the user's .emacs file so that this will apply
 166 to future sessions."
 167   (interactive "CDisable command: ")
 168   (en/disable-command command t))
 169
 170 (provide 'novice)
 171
 172 ;; arch-tag: f83c0f96-497e-4db6-a430-8703716c6dd9
 173 ;;; novice.el ends here