Return to userlock.el CVS log

Up to [Apple XNU] / GNUtools / emacs / lisp

Annotation of GNUtools/emacs/lisp/userlock.el, revision 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 free software; you can redistribute it and/or modify
        !             6: ;; it under the terms of the GNU General Public License as published by
        !             7: ;; the Free Software Foundation; either version 1, or (at your option)
        !             8: ;; any later version.
        !             9: 
        !            10: ;; GNU Emacs is distributed in the hope that it will be useful,
        !            11: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
        !            12: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
        !            13: ;; GNU General Public License for more details.
        !            14: 
        !            15: ;; You should have received a copy of the GNU General Public License
        !            16: ;; along with GNU Emacs; see the file COPYING.  If not, write to
        !            17: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
        !            18: 
        !            19: 
        !            20: ;; This file is autloaded to handle certain conditions
        !            21: ;; detected by the file-locking code within Emacs.
        !            22: ;; The two entry points are `ask-user-about-lock' and
        !            23: ;; `ask-user-about-supersession-threat'.
        !            24: 
        !            25: 
        !            26: (put 'file-locked 'error-conditions '(file-locked file-error error))
        !            27: 
        !            28: (defun ask-user-about-lock (fn opponent)
        !            29:   "Ask user what to do when he wants to edit FILE but it is locked by USER.
        !            30: This function has a choice of three things to do:
        !            31:   do (signal 'buffer-file-locked (list FILE USER))
        !            32:     to refrain from editing the file
        !            33:   return t (grab the lock on the file)
        !            34:   return nil (edit the file even though it is locked).
        !            35: You can rewrite it to use any criterion you like to choose which one to do."
        !            36:   (discard-input)
        !            37:   (save-window-excursion
        !            38:     (let (answer)
        !            39:       (while (null answer)
        !            40:        (message "%s is locking %s: action (s, q, p, ?)? " opponent fn)
        !            41:        (let ((tem (let ((inhibit-quit t)
        !            42:                         (cursor-in-echo-area t))
        !            43:                     (prog1 (downcase (read-char))
        !            44:                            (setq quit-flag nil)))))
        !            45:          (if (= tem help-char)
        !            46:              (ask-user-about-lock-help)
        !            47:            (setq answer (assoc tem '((?s . t)
        !            48:                                      (?q . yield)
        !            49:                                      (?\C-g . yield)
        !            50:                                      (?p . nil)
        !            51:                                      (?? . help))))
        !            52:            (cond ((null answer)
        !            53:                   (beep)
        !            54:                   (message "Please type q, s, or p; or ? for help")
        !            55:                   (sit-for 3))
        !            56:                  ((eq (cdr answer) 'help)
        !            57:                   (ask-user-about-lock-help)
        !            58:                   (setq answer nil))
        !            59:                  ((eq (cdr answer) 'yield)
        !            60:                   (signal 'file-locked (list "File is locked" fn opponent)))))))
        !            61:       (cdr answer))))
        !            62: 
        !            63: (defun ask-user-about-lock-help ()
        !            64:   (with-output-to-temp-buffer "*Help*"
        !            65:     (princ "It has been detected that you want to modify a file that someone else has
        !            66: already started modifying in EMACS.
        !            67: 
        !            68: You can <s>teal the file; The other user becomes the
        !            69:   intruder if (s)he ever unmodifies the file and then changes it again.
        !            70: You can <p>roceed; you edit at your own (and the other user's) risk.
        !            71: You can <q>uit; don't modify this file.")))
        !            72: 
        !            73: (put
        !            74:  'file-supersession 'error-conditions '(file-supersession file-error error))
        !            75: 
        !            76: (defun ask-user-about-supersession-threat (fn)
        !            77:   "Ask a user who is about to modify an obsolete buffer what to do.
        !            78: This function has two choices: it can return, in which case the modification
        !            79: of the buffer will proceed, or it can (signal 'file-supersession (file)),
        !            80: in which case the proposed buffer modification will not be made.
        !            81: You can rewrite this to use any criterion you like to choose which one to do."
        !            82:   (discard-input)
        !            83:   (save-window-excursion
        !            84:     (let (answer)
        !            85:       (while (null answer)
        !            86:        (message "File has changed on disk; really want to edit the buffer? (y, n or C-h) ")
        !            87:        (let ((tem (downcase (let ((cursor-in-echo-area t))
        !            88:                               (read-char)))))
        !            89:          (setq answer
        !            90:                (if (= tem help-char)
        !            91:                    'help
        !            92:                  (cdr (assoc tem '((?n . yield)
        !            93:                                    (?\C-g . yield)
        !            94:                                    (?y . proceed)
        !            95:                                    (?? . help))))))
        !            96:          (cond ((null answer)
        !            97:                 (beep)
        !            98:                 (message "Please type y or n; or ? for help")
        !            99:                 (sit-for 3))
        !           100:                ((eq answer 'help)
        !           101:                 (ask-user-about-supersession-help)
        !           102:                 (setq answer nil))
        !           103:                ((eq answer 'yield)
        !           104:                 (signal 'file-supersession
        !           105:                         (list "File changed on disk" fn))))))
        !           106:       (message
        !           107:         "File on disk now will become a backup file if you save these changes.")
        !           108:       (setq buffer-backed-up nil))))
        !           109: 
        !           110: (defun ask-user-about-supersession-help ()
        !           111:   (with-output-to-temp-buffer "*Help*"
        !           112:     (princ "You want to modify a buffer whose disk file has changed
        !           113: since you last read it in or saved it with this buffer.
        !           114: 
        !           115: If you say `y' to go ahead and modify this buffer,
        !           116: you risk ruining the work of whoever rewrote the file.
        !           117: If you say `n', the change you started to make will be aborted.
        !           118: 
        !           119: You might consider answering `n', running `M-x revert-buffer' to
        !           120: bring the text in Emacs into accord with what is on disk, and then
        !           121: making the change again.")))
        !           122: 
        !           123: 

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