home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / prim / novice.el < prev    next >
Encoding:
Text File  |  1995-08-28  |  5.1 KB  |  154 lines
  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.28.
  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.        (if (or (equal (this-command-keys) []) ;XEmacs kludge
  49.            (eq (event-to-character (aref (this-command-keys) 0)) ?\r))
  50.        (princ "You have invoked the disabled command ")
  51.      (princ "You have typed ")
  52.      (princ (key-description (this-command-keys)))
  53.      (princ ", invoking disabled command "))
  54.        (princ this-command)
  55.        (princ ":\n")
  56.        ;; Print any special message saying why the command is disabled.
  57.        (if (stringp (get this-command 'disabled))
  58.        (princ (get this-command 'disabled)))
  59.        (princ (or (condition-case ()
  60.               (documentation this-command)
  61.             (error nil))
  62.           "<< not documented >>"))
  63.        ;; Keep only the first paragraph of the documentation.
  64.        (save-excursion
  65.      (set-buffer "*Help*")
  66.      (goto-char (point-min))
  67.      (if (search-forward "\n\n" nil t)
  68.          (delete-region (1- (point)) (point-max))
  69.        (goto-char (point-max))))
  70.        (princ "\n\n")
  71.        (princ "You can now type
  72. Space to try the command just this once,
  73.       but leave it disabled,
  74. Y to try it and enable it (no questions if you use it again),
  75. N to do nothing (command remains disabled)."))
  76.      (message "Type y, n or Space: ")
  77.      (let ((cursor-in-echo-area t)
  78.        (inhibit-quit t)
  79.        event)
  80.        (while (null char)
  81.      (if (progn
  82.            (setq event (next-command-event))
  83.            (prog1
  84.            (or quit-flag (eq 'keyboard-quit (key-binding event)))
  85.          (setq quit-flag nil)))
  86.          (progn
  87.            (setq quit-flag nil)
  88.            (signal 'quit '())))
  89.      (let* ((key (and (key-press-event-p event) (event-key event)))
  90.         (rchar (and key (event-to-character event))))
  91.        (if rchar (setq rchar (downcase rchar)))
  92.        (cond ((eq rchar ?y)
  93.           (setq char rchar))
  94.          ((eq rchar ?n)
  95.           (setq char rchar))
  96.          ((eq rchar ? )
  97.           (setq char rchar))
  98.          (t
  99.           (ding nil 'y-or-n-p)
  100.           (discard-input)
  101.           (message "Please type y, n or Space: ")))))))
  102.     (message nil)
  103.     (if (= char ?y)
  104.     (if (and user-init-file
  105.          (not (string= "" user-init-file))
  106.          (y-or-n-p "Enable command for future editing sessions also? "))
  107.         (enable-command this-command)
  108.             (put this-command 'disabled nil)))
  109.     (if (/= char ?n)
  110.     (call-interactively this-command))))
  111.  
  112. ;;;###autoload
  113. (defun enable-command (command)
  114.   "Allow COMMAND to be executed without special confirmation from now on.
  115. The user's .emacs file is altered so that this will apply
  116. to future sessions."
  117.   (interactive "CEnable command: ")
  118.   (put command 'disabled nil)
  119.   (save-excursion
  120.    (set-buffer (find-file-noselect
  121.         (substitute-in-file-name user-init-file)))
  122.    (goto-char (point-min))
  123.    (if (search-forward (concat "(put '" (symbol-name command) " ") nil t)
  124.        (delete-region
  125.     (progn (beginning-of-line) (point))
  126.     (progn (forward-line 1) (point)))
  127.      ;; Must have been disabled by default.
  128.      (goto-char (point-max))
  129.      (insert "\n(put '" (symbol-name command) " 'disabled nil)\n"))
  130.    (save-buffer)))
  131.  
  132. ;;;###autoload
  133. (defun disable-command (command)
  134.   "Require special confirmation to execute COMMAND from now on.
  135. The user's .emacs file is altered so that this will apply
  136. to future sessions."
  137.   (interactive "CDisable command: ")
  138.   (if (not (commandp command))
  139.       (error "Invalid command name `%s'" command))
  140.   (put command 'disabled t)
  141.   (save-excursion
  142.    (set-buffer (find-file-noselect
  143.         (substitute-in-file-name user-init-file)))
  144.    (goto-char (point-min))
  145.    (if (search-forward (concat "(put '" (symbol-name command) " ") nil t)
  146.        (delete-region
  147.     (progn (beginning-of-line) (point))
  148.     (progn (forward-line 1) (point))))
  149.    (goto-char (point-max))
  150.    (insert "(put '" (symbol-name command) " 'disabled t)\n")
  151.    (save-buffer)))
  152.  
  153. ;;; novice.el ends here
  154.