Annotation of 43BSDReno/contrib/emacs-18.55/lisp/userlock.el, revision 1.1.1.1

1.1       root        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: 

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.