|
|
1.1 ! root 1: ;; Copyright (C) 1985 Free Software Foundation ! 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: (put 'file-locked 'error-conditions '(file-locked file-error error)) ! 22: ! 23: (defun ask-user-about-lock (fn opponent) ! 24: "Ask user what to do when he wants to edit FILE but it is locked by USER. ! 25: This function has a choice of three things to do: ! 26: do (signal 'buffer-file-locked (list FILE USER)) ! 27: to refrain from editing the file ! 28: return t (grab the lock on the file) ! 29: return nil (edit the file even though it is locked). ! 30: You can rewrite it to use any criterion you like to choose which one to do." ! 31: (discard-input) ! 32: (save-window-excursion ! 33: (let (answer) ! 34: (while (null answer) ! 35: (message "%s is locking %s: action (s, q, p, ?)? :" opponent fn) ! 36: (let ((tem (let ((inhibit-quit t)) ! 37: (prog1 (downcase (read-char)) ! 38: (setq quit-flag nil))))) ! 39: (if (= tem help-char) ! 40: (ask-user-about-lock-help) ! 41: (setq answer (assoc tem '((?s . t) ! 42: (?q . yield) ! 43: (?\C-g . yield) ! 44: (?p . nil) ! 45: (?? . help)))) ! 46: (cond ((null answer) ! 47: (message "Please type q, s, or p; or ? for help") ! 48: (sit-for 3)) ! 49: ((eq (cdr answer) 'help) ! 50: (ask-user-about-lock-help) ! 51: (setq answer nil)) ! 52: ((eq (cdr answer) 'yield) ! 53: (signal 'file-locked (list "File is locked" fn opponent))))))) ! 54: (cdr answer)))) ! 55: ! 56: (defun ask-user-about-lock-help () ! 57: (with-output-to-temp-buffer "*Help*" ! 58: (princ "It has been detected that you want to modify a file that someone else has ! 59: already started modifying in EMACS. ! 60: ! 61: You can steal the file (s); (S)he becomes the intruder if (s)he ever ! 62: unmodifies the file and tries again. ! 63: You can proceed (p); you edit at your own (and his/her) risk. ! 64: You can quit (q).")))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.