![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to novice.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / lisp|
Return to novice.el CVS log | Up to [Apple XNU] / GNUtools / emacs / lisp |
1.1 root 1: ;; Handling of disabled commands ("novice mode") for Emacs.
2: ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
3:
4: ;; This file is part of GNU Emacs.
5:
6: ;; GNU Emacs is free software; you can redistribute it and/or modify
7: ;; it under the terms of the GNU General Public License as published by
8: ;; the Free Software Foundation; either version 1, or (at your option)
9: ;; any later version.
10:
11: ;; GNU Emacs is distributed in the hope that it will be useful,
12: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14: ;; GNU General Public License for more details.
15:
16: ;; You should have received a copy of the GNU General Public License
17: ;; along with GNU Emacs; see the file COPYING. If not, write to
18: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
19:
20:
21: ;; This function is called (by autoloading)
22: ;; to handle any disabled command.
23: ;; The command is found in this-command
24: ;; and the keys are returned by (this-command-keys).
25:
26: (defun disabled-command-hook (&rest ignore)
27: (let (char)
28: (save-window-excursion
29: (with-output-to-temp-buffer "*Help*"
30: (if (= (aref (this-command-keys) 0) ?\M-x)
31: (princ "You have invoked the disabled command ")
32: (princ "You have typed ")
33: (princ (key-description (this-command-keys)))
34: (princ ", invoking disabled command "))
35: (princ this-command)
36: (princ ":\n")
37: ;; Print any special message saying why the command is disabled.
38: (if (stringp (get this-command 'disabled))
39: (princ (get this-command 'disabled)))
40: (princ (or (condition-case ()
41: (documentation this-command)
42: (error nil))
43: "<< not documented >>"))
44: ;; Keep only the first paragraph of the documentation.
45: (save-excursion
46: (set-buffer "*Help*")
47: (goto-char (point-min))
48: (if (search-forward "\n\n" nil t)
49: (delete-region (1- (point)) (point-max))
50: (goto-char (point-max))))
51: (princ "\n\n")
52: (princ "You can now type
53: Space to try the command just this once,
54: but leave it disabled,
55: Y to try it and enable it (no questions if you use it again),
56: N to do nothing (command remains disabled)."))
57: (message "Type y, n or Space: ")
58: (let ((cursor-in-echo-area t))
59: (while (not (memq (setq char (downcase (read-char)))
60: '(? ?y ?n)))
61: (ding)
62: (message "Please type y, n or Space: "))))
63: (if (= char ?y)
64: (if (y-or-n-p "Enable command for future editing sessions also? ")
65: (enable-command this-command)
66: (put this-command 'disabled nil)))
67: (if (/= char ?n)
68: (call-interactively this-command))))
69:
70: (defun enable-command (command)
71: "Allow COMMAND to be executed without special confirmation from now on.
72: The user's .emacs file is altered so that this will apply
73: to future sessions."
74: (interactive "CEnable command: ")
75: (put command 'disabled nil)
76: (save-excursion
77: (set-buffer (find-file-noselect (substitute-in-file-name "~/.emacs")))
78: (goto-char (point-min))
79: (if (search-forward (concat "(put '" (symbol-name command) " ") nil t)
80: (delete-region
81: (progn (beginning-of-line) (point))
82: (progn (forward-line 1) (point)))
83: ;; Must have been disabled by default.
84: (goto-char (point-max))
85: (insert "\n(put '" (symbol-name command) " 'disabled nil)\n"))
86: (setq foo (buffer-modified-p))
87: (save-buffer)))
88:
89: (defun disable-command (command)
90: "Require special confirmation to execute COMMAND from now on.
91: The user's .emacs file is altered so that this will apply
92: to future sessions."
93: (interactive "CDisable command: ")
94: (put command 'disabled t)
95: (save-excursion
96: (set-buffer (find-file-noselect (substitute-in-file-name "~/.emacs")))
97: (goto-char (point-min))
98: (if (search-forward (concat "(put '" (symbol-name command) " ") nil t)
99: (delete-region
100: (progn (beginning-of-line) (point))
101: (progn (forward-line 1) (point))))
102: (goto-char (point-max))
103: (insert "(put '" (symbol-name command) " 'disabled t)\n")
104: (save-buffer)))
105:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.