home *** CD-ROM | disk | FTP | other *** search
/ Education Sampler 1992 [NeXTSTEP] / Education_1992_Sampler.iso / NeXT / GnuSource / emacs-15.0.3 / lisp / userlock.el < prev    next >
Lisp/Scheme  |  1990-07-19  |  5KB  |  125 lines
  1. ;; Copyright (C) 1985, 1986 Free Software Foundation, inc.
  2.  
  3. ;; This file is part of GNU Emacs.
  4.  
  5. ;; GNU Emacs is distributed in the hope that it will be useful,
  6. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  7. ;; accepts responsibility to anyone for the consequences of using it
  8. ;; or for whether it serves any particular purpose or works at all,
  9. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  10. ;; License for full details.
  11.  
  12. ;; Everyone is granted permission to copy, modify and redistribute
  13. ;; GNU Emacs, but only under the conditions described in the
  14. ;; GNU Emacs General Public License.   A copy of this license is
  15. ;; supposed to have been given to you along with GNU Emacs so you
  16. ;; can know your rights and responsibilities.  It should be in a
  17. ;; file named COPYING.  Among other things, the copyright notice
  18. ;; and this notice must be preserved on all copies.
  19.  
  20.  
  21. ;; This file is autloaded to handle certain conditions
  22. ;; detected by the file-locking code within Emacs.
  23. ;; The two entry points are `ask-user-about-lock' and
  24. ;; `ask-user-about-supersession-threat'.
  25.  
  26.  
  27. (put 'file-locked 'error-conditions '(file-locked file-error error))
  28.  
  29. (defun ask-user-about-lock (fn opponent)
  30.   "Ask user what to do when he wants to edit FILE but it is locked by USER.
  31. This function has a choice of three things to do:
  32.   do (signal 'buffer-file-locked (list FILE USER))
  33.     to refrain from editing the file
  34.   return t (grab the lock on the file)
  35.   return nil (edit the file even though it is locked).
  36. You can rewrite it to use any criterion you like to choose which one to do."
  37.   (discard-input)
  38.   (save-window-excursion
  39.     (let (answer)
  40.       (while (null answer)
  41.     (message "%s is locking %s: action (s, q, p, ?)? " opponent fn)
  42.     (let ((tem (let ((inhibit-quit t)
  43.              (cursor-in-echo-area t))
  44.              (prog1 (downcase (read-char))
  45.                     (setq quit-flag nil)))))
  46.       (if (= tem help-char)
  47.           (ask-user-about-lock-help)
  48.         (setq answer (assoc tem '((?s . t)
  49.                       (?q . yield)
  50.                       (?\C-g . yield)
  51.                       (?p . nil)
  52.                       (?? . help))))
  53.         (cond ((null answer)
  54.            (beep)
  55.            (message "Please type q, s, or p; or ? for help")
  56.            (sit-for 3))
  57.           ((eq (cdr answer) 'help)
  58.            (ask-user-about-lock-help)
  59.            (setq answer nil))
  60.           ((eq (cdr answer) 'yield)
  61.            (signal 'file-locked (list "File is locked" fn opponent)))))))
  62.       (cdr answer))))
  63.  
  64. (defun ask-user-about-lock-help ()
  65.   (with-output-to-temp-buffer "*Help*"
  66.     (princ "It has been detected that you want to modify a file that someone else has
  67. already started modifying in EMACS.
  68.  
  69. You can <s>teal the file; The other user becomes the
  70.   intruder if (s)he ever unmodifies the file and then changes it again.
  71. You can <p>roceed; you edit at your own (and the other user's) risk.
  72. You can <q>uit; don't modify this file.")))
  73.  
  74. (put
  75.  'file-supersession 'error-conditions '(file-supersession file-error error))
  76.  
  77. (defun ask-user-about-supersession-threat (fn)
  78.   "Ask a user who is about to modify an obsolete buffer what to do.
  79. This function has two choices: it can return, in which case the modification
  80. of the buffer will proceed, or it can (signal 'file-supersession (file)),
  81. in which case the proposed buffer modification will not be made.
  82. You can rewrite this to use any criterion you like to choose which one to do."
  83.   (discard-input)
  84.   (save-window-excursion
  85.     (let (answer)
  86.       (while (null answer)
  87.     (message "File has changed on disk; really want to edit the buffer? (y, n or C-h) ")
  88.     (let ((tem (downcase (let ((cursor-in-echo-area t))
  89.                    (read-char)))))
  90.       (setq answer
  91.         (if (= tem help-char)
  92.             'help
  93.           (cdr (assoc tem '((?n . yield)
  94.                     (?\C-g . yield)
  95.                     (?y . proceed)
  96.                     (?? . help))))))
  97.       (cond ((null answer)
  98.          (beep)
  99.          (message "Please type y or n; or ? for help")
  100.          (sit-for 3))
  101.         ((eq answer 'help)
  102.          (ask-user-about-supersession-help)
  103.          (setq answer nil))
  104.         ((eq answer 'yield)
  105.          (signal 'file-supersession
  106.              (list "File changed on disk" fn))))))
  107.       (message
  108.         "File on disk now will become a backup file if you save these changes.")
  109.       (setq buffer-backed-up nil))))
  110.  
  111. (defun ask-user-about-supersession-help ()
  112.   (with-output-to-temp-buffer "*Help*"
  113.     (princ "You want to modify a buffer whose disk file has changed
  114. since you last read it in or saved it with this buffer.
  115.  
  116. If you say `y' to go ahead and modify this buffer,
  117. you risk ruining the work of whoever rewrote the file.
  118. If you say `n', the change you started to make will be aborted.
  119.  
  120. You might consider answering `n', running `M-x revert-buffer' to
  121. bring the text in Emacs into accord with what is on disk, and then
  122. making the change again.")))
  123.  
  124.  
  125.