Mercurial > emacs
comparison lisp/novice.el @ 88155:d7ddb3e565de
sync with trunk
author | Henrik Enberg <henrik.enberg@telia.com> |
---|---|
date | Mon, 16 Jan 2006 00:03:54 +0000 |
parents | 28bd7ea81b05 |
children |
comparison
equal
deleted
inserted
replaced
88154:8ce476d3ba36 | 88155:d7ddb3e565de |
---|---|
1 ;;; novice.el --- handling of disabled commands ("novice mode") for Emacs | 1 ;;; novice.el --- handling of disabled commands ("novice mode") for Emacs |
2 | 2 |
3 ;; Copyright (C) 1985, 1986, 1987, 1994, 2002 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1985, 1986, 1987, 1994, 2002, 2003, 2004, |
4 ;; 2005 Free Software Foundation, Inc. | |
4 | 5 |
5 ;; Maintainer: FSF | 6 ;; Maintainer: FSF |
6 ;; Keywords: internal, help | 7 ;; Keywords: internal, help |
7 | 8 |
8 ;; This file is part of GNU Emacs. | 9 ;; This file is part of GNU Emacs. |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
18 ;; GNU General Public License for more details. | 19 ;; GNU General Public License for more details. |
19 | 20 |
20 ;; You should have received a copy of the GNU General Public License | 21 ;; 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 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
23 ;; Boston, MA 02111-1307, USA. | 24 ;; Boston, MA 02110-1301, USA. |
24 | 25 |
25 ;;; Commentary: | 26 ;;; Commentary: |
26 | 27 |
27 ;; This mode provides a hook which is, by default, attached to various | 28 ;; This mode provides a hook which is, by default, attached to various |
28 ;; putatively dangerous commands in a (probably futile) attempt to | 29 ;; putatively dangerous commands in a (probably futile) attempt to |
34 ;; to handle any disabled command. | 35 ;; to handle any disabled command. |
35 ;; The command is found in this-command | 36 ;; The command is found in this-command |
36 ;; and the keys are returned by (this-command-keys). | 37 ;; and the keys are returned by (this-command-keys). |
37 | 38 |
38 ;;;###autoload | 39 ;;;###autoload |
39 (defvar disabled-command-hook 'disabled-command-hook | 40 (defvar disabled-command-function 'disabled-command-function |
40 "Function to call to handle disabled commands. | 41 "Function to call to handle disabled commands. |
41 If nil, the feature is disabled, i.e., all commands work normally.") | 42 If nil, the feature is disabled, i.e., all commands work normally.") |
42 | 43 |
43 ;;;###autoload | 44 ;;;###autoload |
44 (defun disabled-command-hook (&rest ignore) | 45 (define-obsolete-variable-alias 'disabled-command-hook 'disabled-command-function "22.1") |
46 | |
47 ;;;###autoload | |
48 (defun disabled-command-function (&rest ignore) | |
45 (let (char) | 49 (let (char) |
46 (save-window-excursion | 50 (save-window-excursion |
47 (with-output-to-temp-buffer "*Help*" | 51 (with-output-to-temp-buffer "*Disabled Command*" |
48 (let ((keys (this-command-keys))) | 52 (let ((keys (this-command-keys))) |
49 (if (or (eq (aref keys 0) | 53 (if (or (eq (aref keys 0) |
50 (if (stringp keys) | 54 (if (stringp keys) |
51 (aref "\M-x" 0) | 55 (aref "\M-x" 0) |
52 ?\M-x)) | 56 ?\M-x)) |
61 (if (stringp (get this-command 'disabled)) | 65 (if (stringp (get this-command 'disabled)) |
62 (princ (get this-command 'disabled)) | 66 (princ (get this-command 'disabled)) |
63 (princ "It is disabled because new users often find it confusing.\n") | 67 (princ "It is disabled because new users often find it confusing.\n") |
64 (princ "Here's the first part of its description:\n\n") | 68 (princ "Here's the first part of its description:\n\n") |
65 ;; Keep only the first paragraph of the documentation. | 69 ;; Keep only the first paragraph of the documentation. |
66 (with-current-buffer "*Help*" | 70 (with-current-buffer "*Disabled Command*" |
67 (goto-char (point-max)) | 71 (goto-char (point-max)) |
68 (let ((start (point))) | 72 (let ((start (point))) |
69 (save-excursion | 73 (save-excursion |
70 (princ (or (condition-case () | 74 (princ (or (condition-case () |
71 (documentation this-command) | 75 (documentation this-command) |
84 (save-excursion | 88 (save-excursion |
85 (set-buffer standard-output) | 89 (set-buffer standard-output) |
86 (help-mode))) | 90 (help-mode))) |
87 (message "Type y, n, ! or SPC (the space bar): ") | 91 (message "Type y, n, ! or SPC (the space bar): ") |
88 (let ((cursor-in-echo-area t)) | 92 (let ((cursor-in-echo-area t)) |
89 (while (not (memq (setq char (downcase (read-char))) | 93 (while (progn (setq char (read-event)) |
90 '(?! ? ?y ?n))) | 94 (or (not (numberp char)) |
95 (not (memq (downcase char) | |
96 '(?! ?y ?n ?\ ?\C-g))))) | |
91 (ding) | 97 (ding) |
92 (message "Please type y, n, ! or SPC (the space bar): ")))) | 98 (message "Please type y, n, ! or SPC (the space bar): ")))) |
99 (setq char (downcase char)) | |
100 (if (= char ?\C-g) | |
101 (setq quit-flag t)) | |
93 (if (= char ?!) | 102 (if (= char ?!) |
94 (setq disabled-command-hook nil)) | 103 (setq disabled-command-function nil)) |
95 (if (= char ?y) | 104 (if (= char ?y) |
96 (if (and user-init-file | 105 (if (and user-init-file |
97 (not (string= "" user-init-file)) | 106 (not (string= "" user-init-file)) |
98 (y-or-n-p "Enable command for future editing sessions also? ")) | 107 (y-or-n-p "Enable command for future editing sessions also? ")) |
99 (enable-command this-command) | 108 (enable-command this-command) |
102 (call-interactively this-command)))) | 111 (call-interactively this-command)))) |
103 | 112 |
104 ;;;###autoload | 113 ;;;###autoload |
105 (defun enable-command (command) | 114 (defun enable-command (command) |
106 "Allow COMMAND to be executed without special confirmation from now on. | 115 "Allow COMMAND to be executed without special confirmation from now on. |
107 The user's .emacs file is altered so that this will apply | 116 COMMAND must be a symbol. |
117 This command alters the user's .emacs file so that this will apply | |
108 to future sessions." | 118 to future sessions." |
109 (interactive "CEnable command: ") | 119 (interactive "CEnable command: ") |
110 (put command 'disabled nil) | 120 (put command 'disabled nil) |
111 (let ((init-file user-init-file) | 121 (let ((init-file user-init-file) |
112 (default-init-file | 122 (default-init-file |
139 (save-buffer)))) | 149 (save-buffer)))) |
140 | 150 |
141 ;;;###autoload | 151 ;;;###autoload |
142 (defun disable-command (command) | 152 (defun disable-command (command) |
143 "Require special confirmation to execute COMMAND from now on. | 153 "Require special confirmation to execute COMMAND from now on. |
144 The user's .emacs file is altered so that this will apply | 154 COMMAND must be a symbol. |
155 This command alters the user's .emacs file so that this will apply | |
145 to future sessions." | 156 to future sessions." |
146 (interactive "CDisable command: ") | 157 (interactive "CDisable command: ") |
147 (if (not (commandp command)) | 158 (if (not (commandp command)) |
148 (error "Invalid command name `%s'" command)) | 159 (error "Invalid command name `%s'" command)) |
149 (put command 'disabled t) | 160 (put command 'disabled t) |
168 (substitute-in-file-name init-file))) | 179 (substitute-in-file-name init-file))) |
169 (goto-char (point-min)) | 180 (goto-char (point-min)) |
170 (if (search-forward (concat "(put '" (symbol-name command) " ") nil t) | 181 (if (search-forward (concat "(put '" (symbol-name command) " ") nil t) |
171 (delete-region | 182 (delete-region |
172 (progn (beginning-of-line) (point)) | 183 (progn (beginning-of-line) (point)) |
173 (progn (forward-line 1) (point)))) | 184 (progn (forward-line 1) (point))) |
174 (goto-char (point-max)) | 185 (goto-char (point-max)) |
175 (insert "\n(put '" (symbol-name command) " 'disabled t)\n") | 186 (insert ?\n)) |
187 (insert "(put '" (symbol-name command) " 'disabled t)\n") | |
176 (save-buffer)))) | 188 (save-buffer)))) |
177 | 189 |
178 (provide 'novice) | 190 (provide 'novice) |
179 | 191 |
192 ;; arch-tag: f83c0f96-497e-4db6-a430-8703716c6dd9 | |
180 ;;; novice.el ends here | 193 ;;; novice.el ends here |