Mercurial > hg > xemacs-beta

comparison lisp/prim/novice.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children b82b59fe008d
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; novice.el --- handling of disabled commands ("novice mode") for XEmacs.
2
3 ;; Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994
4 ;; Free Software Foundation, Inc.
5
6 ;; Maintainer: FSF
7 ;; Keywords: internal, help
8
9 ;; This file is part of XEmacs.
10
11 ;; XEmacs is free software; you can redistribute it and/or modify it
12 ;; under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; any later version.
15
16 ;; XEmacs is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details.
20
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with XEmacs; see the file COPYING. If not, write to the Free
23 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
24
25 ;;; Synched up with: FSF 19.30.
26
27 ;;; Commentary:
28
29 ;; This mode provides a hook which is, by default, attached to various
30 ;; putatively dangerous commands in a (probably futile) attempt to
31 ;; prevent lusers from shooting themselves in the feet.
32
33 ;;; Code:
34
35 ;; This function is called (by autoloading)
36 ;; to handle any disabled command.
37 ;; The command is found in this-command
38 ;; and the keys are returned by (this-command-keys).
39
40 ;;;###autoload
41 ;(setq disabled-command-hook 'disabled-command-hook)
42
43 ;;;###autoload
44 (defun disabled-command-hook (&rest ignore)
45 (let (char)
46 (save-window-excursion
47 (with-output-to-temp-buffer "*Help*"
48 (let ((keys (this-command-keys)))
49 (if (or (equal keys []) ;XEmacs kludge
50 (eq (event-to-character (aref keys 0)) ?\r))
51 (princ "You have invoked the disabled command ")
52 (princ "You have typed ")
53 (princ (key-description keys))
54 (princ ", invoking disabled command ")))
55 (princ this-command)
56 (princ ":\n")
57 ;; Print any special message saying why the command is disabled.
58 (if (stringp (get this-command 'disabled))
59 (princ (get this-command 'disabled)))
60 (princ (or (condition-case ()
61 (documentation this-command)
62 (error nil))
63 "<< not documented >>"))
64 ;; Keep only the first paragraph of the documentation.
65 (save-excursion
66 (set-buffer "*Help*")
67 (goto-char (point-min))
68 (if (search-forward "\n\n" nil t)
69 (delete-region (1- (point)) (point-max))
70 (goto-char (point-max))))
71 (princ "\n\n")
72 (princ "You can now type
73 Space to try the command just this once,
74 but leave it disabled,
75 Y to try it and enable it (no questions if you use it again),
76 N to do nothing (command remains disabled).")
77 (save-excursion
78 (set-buffer standard-output)
79 (help-mode)))
80 (message "Type y, n or Space: ")
81 (let ((cursor-in-echo-area t)
82 (inhibit-quit t)
83 event)
84 (while (null char)
85 (if (progn
86 (setq event (next-command-event))
87 (prog1
88 (or quit-flag (eq 'keyboard-quit (key-binding event)))
89 (setq quit-flag nil)))
90 (progn
91 (setq quit-flag nil)
92 (signal 'quit '())))
93 (let* ((key (and (key-press-event-p event) (event-key event)))
94 (rchar (and key (event-to-character event))))
95 (if rchar (setq rchar (downcase rchar)))
96 (cond ((eq rchar ?y)
97 (setq char rchar))
98 ((eq rchar ?n)
99 (setq char rchar))
100 ((eq rchar ? )
101 (setq char rchar))
102 (t
103 (ding nil 'y-or-n-p)
104 (discard-input)
105 (message "Please type y, n or Space: ")))))))
106 (message nil)
107 (if (= char ?y)
108 (if (and user-init-file
109 (not (string= "" user-init-file))
110 (y-or-n-p "Enable command for future editing sessions also? "))
111 (enable-command this-command)
112 (put this-command 'disabled nil)))
113 (if (/= char ?n)
114 (call-interactively this-command))))
115
116 ;;;###autoload
117 (defun enable-command (command)
118 "Allow COMMAND to be executed without special confirmation from now on.
119 The user's .emacs file is altered so that this will apply
120 to future sessions."
121 (interactive "CEnable command: ")
122 (put command 'disabled nil)
123 (save-excursion
124 (set-buffer (find-file-noselect
125 (substitute-in-file-name user-init-file)))
126 (goto-char (point-min))
127 (if (search-forward (concat "(put '" (symbol-name command) " ") nil t)
128 (delete-region
129 (progn (beginning-of-line) (point))
130 (progn (forward-line 1) (point))))
131 ;; Explicitly enable, in case this command is disabled by default
132 ;; or in case the code we deleted was actually a comment.
133 (goto-char (point-max))
134 (insert "\n(put '" (symbol-name command) " 'disabled nil)\n")
135 (save-buffer)))
136
137 ;;;###autoload
138 (defun disable-command (command)
139 "Require special confirmation to execute COMMAND from now on.
140 The user's .emacs file is altered so that this will apply
141 to future sessions."
142 (interactive "CDisable command: ")
143 (if (not (commandp command))
144 (error "Invalid command name `%s'" command))
145 (put command 'disabled t)
146 (save-excursion
147 (set-buffer (find-file-noselect
148 (substitute-in-file-name user-init-file)))
149 (goto-char (point-min))
150 (if (search-forward (concat "(put '" (symbol-name command) " ") nil t)
151 (delete-region
152 (progn (beginning-of-line) (point))
153 (progn (forward-line 1) (point))))
154 (goto-char (point-max))
155 (insert "\n(put '" (symbol-name command) " 'disabled t)\n")
156 (save-buffer)))
157
158 ;;; novice.el ends here