Return to userlock.el CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp

Annotation of 43BSD/contrib/emacs/lisp/userlock.el, revision 1.1.1.1

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.