Whitespace change.
[bpt/emacs.git] / lisp / novice.el
CommitLineData
6594deb0
ER
1;;; novice.el --- handling of disabled commands ("novice mode") for Emacs.
2
8f1204db 3;; Copyright (C) 1985, 1986, 1987, 1994 Free Software Foundation, Inc.
9750e079 4
e5167999 5;; Maintainer: FSF
d7b4d18f 6;; Keywords: internal, help
e5167999 7
a2535589
JA
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
e5167999 12;; the Free Software Foundation; either version 2, or (at your option)
a2535589
JA
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
b578f267
EN
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.
a2535589 24
edbd2f74
ER
25;;; Commentary:
26
27;; This mode provides a hook which is, by default, attached to various
28;; putatively dangerous commands in a (probably futile) attempt to
29;; prevent lusers from shooting themselves in the feet.
30
aae56ea7 31;;; Code:
a2535589
JA
32
33;; This function is called (by autoloading)
34;; to handle any disabled command.
35;; The command is found in this-command
36;; and the keys are returned by (this-command-keys).
37
7229064d 38;;;###autoload
4442951c
EN
39(defvar disabled-command-hook 'disabled-command-hook
40 "Function to call to handle disabled commands.
41If nil, the feature is disabled, i.e., all commands work normally.")
73fa8346 42
1c599895 43;;;###autoload
a2535589
JA
44(defun disabled-command-hook (&rest ignore)
45 (let (char)
46 (save-window-excursion
47 (with-output-to-temp-buffer "*Help*"
be29d453
KH
48 (let ((keys (this-command-keys)))
49 (if (or (eq (aref keys 0)
50 (if (stringp keys)
51 (aref "\M-x" 0)
52 ?\M-x))
53 (and (>= (length keys) 2)
54 (eq (aref keys 0) meta-prefix-char)
55 (eq (aref keys 1) ?x)))
56 (princ "You have invoked the disabled command ")
57 (princ "You have typed ")
58 (princ (key-description keys))
59 (princ ", invoking disabled command ")))
a2535589
JA
60 (princ this-command)
61 (princ ":\n")
62 ;; Print any special message saying why the command is disabled.
63 (if (stringp (get this-command 'disabled))
64 (princ (get this-command 'disabled)))
a2535589
JA
65 ;; Keep only the first paragraph of the documentation.
66 (save-excursion
67 (set-buffer "*Help*")
082f6929
RS
68 (goto-char (point-max))
69 (save-excursion
70 (princ (or (condition-case ()
71 (documentation this-command)
72 (error nil))
73 "<< not documented >>")))
a2535589
JA
74 (if (search-forward "\n\n" nil t)
75 (delete-region (1- (point)) (point-max))
76 (goto-char (point-max))))
77 (princ "\n\n")
78 (princ "You can now type
4442951c 79Space to try the command just this once, but leave it disabled,
a2535589 80Y to try it and enable it (no questions if you use it again),
4442951c 81! to try it and enable all commands in this session, or
ea165072
KH
82N to do nothing (command remains disabled).")
83 (save-excursion
84 (set-buffer standard-output)
85 (help-mode)))
4442951c 86 (message "Type y, n, ! or Space: ")
a2535589
JA
87 (let ((cursor-in-echo-area t))
88 (while (not (memq (setq char (downcase (read-char)))
4442951c 89 '(?! ? ?y ?n)))
a2535589 90 (ding)
4442951c
EN
91 (message "Please type y, n, ! or Space: "))))
92 (if (= char ?!)
93 (setq disabled-command-hook nil))
a2535589 94 (if (= char ?y)
7435bd25
RS
95 (if (and user-init-file
96 (not (string= "" user-init-file))
97 (y-or-n-p "Enable command for future editing sessions also? "))
a2535589
JA
98 (enable-command this-command)
99 (put this-command 'disabled nil)))
100 (if (/= char ?n)
101 (call-interactively this-command))))
102
7229064d 103;;;###autoload
a2535589
JA
104(defun enable-command (command)
105 "Allow COMMAND to be executed without special confirmation from now on.
106The user's .emacs file is altered so that this will apply
107to future sessions."
108 (interactive "CEnable command: ")
109 (put command 'disabled nil)
110 (save-excursion
7435bd25 111 (set-buffer (find-file-noselect
bb79850e 112 (substitute-in-file-name user-init-file)))
a2535589
JA
113 (goto-char (point-min))
114 (if (search-forward (concat "(put '" (symbol-name command) " ") nil t)
115 (delete-region
116 (progn (beginning-of-line) (point))
020c97d2
RS
117 (progn (forward-line 1) (point))))
118 ;; Explicitly enable, in case this command is disabled by default
119 ;; or in case the code we deleted was actually a comment.
120 (goto-char (point-max))
121 (insert "\n(put '" (symbol-name command) " 'disabled nil)\n")
a2535589
JA
122 (save-buffer)))
123
7229064d 124;;;###autoload
a2535589
JA
125(defun disable-command (command)
126 "Require special confirmation to execute COMMAND from now on.
127The user's .emacs file is altered so that this will apply
128to future sessions."
129 (interactive "CDisable command: ")
5b817cf2
RS
130 (if (not (commandp command))
131 (error "Invalid command name `%s'" command))
a2535589
JA
132 (put command 'disabled t)
133 (save-excursion
7435bd25 134 (set-buffer (find-file-noselect
bb79850e 135 (substitute-in-file-name user-init-file)))
a2535589
JA
136 (goto-char (point-min))
137 (if (search-forward (concat "(put '" (symbol-name command) " ") nil t)
138 (delete-region
139 (progn (beginning-of-line) (point))
140 (progn (forward-line 1) (point))))
141 (goto-char (point-max))
020c97d2 142 (insert "\n(put '" (symbol-name command) " 'disabled t)\n")
a2535589
JA
143 (save-buffer)))
144
6594deb0 145;;; novice.el ends here