X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fuserlock.el;h=7f4657c5d2260cd1cce68a044eaa093b21ba9137;hb=818f224de6694aa92bf9ba77b52c8c8d0dd24999;hp=55a5830fb3b0fd0e4f9320441b36e0e3f7ba2042;hpb=6883ee56ec887c2c48abe5b06b5e66aa74031910;p=chise%2Fxemacs-chise.git.1

diff --git a/lisp/userlock.el b/lisp/userlock.el
index 55a5830..7f4657c 100644
--- a/lisp/userlock.el
+++ b/lisp/userlock.el
@@ -35,11 +35,11 @@
 
 (define-error 'file-locked "File is locked" 'file-error) ; XEmacs
 
-(defun ask-user-about-lock-minibuf (fn opponent)
+(defun ask-user-about-lock-minibuf (filename other-user)
   (save-window-excursion
     (let (answer)
       (while (null answer)
-	(message "%s is locking %s: action (s, q, p, ?)? " opponent fn)
+	(message "%s is locking %s: action (s, q, p, ?)? " other-user filename)
 	(let ((tem (let ((inhibit-quit t)
 			 (cursor-in-echo-area t))
 		     (prog1 (downcase (read-char))
@@ -59,7 +59,7 @@
 		   (ask-user-about-lock-help)
 		   (setq answer nil))
 		  ((eq (cdr answer) 'yield)
-		   (signal 'file-locked (list "File is locked" fn opponent)))))))
+		   (signal 'file-locked (list "File is locked" filename other-user)))))))
       (cdr answer))))
 
 (defun ask-user-about-lock-help ()
@@ -77,12 +77,12 @@ You can <q>uit; don't modify this file.")
 
 (define-error 'file-supersession "File changed on disk" 'file-error) ; XEmacs
 
-(defun ask-user-about-supersession-threat-minibuf (fn)
+(defun ask-user-about-supersession-threat-minibuf (filename)
   (save-window-excursion
     (let (answer)
       (while (null answer)
 	(message "%s changed on disk; really edit the buffer? (y, n, r or C-h) "
-                 (file-name-nondirectory fn))
+                 (file-name-nondirectory filename))
 	(let ((tem (downcase (let ((cursor-in-echo-area t))
 			       (read-char)))))
 	  (setq answer
@@ -104,10 +104,10 @@ You can <q>uit; don't modify this file.")
 		 (revert-buffer nil (not (buffer-modified-p)))
 		 ; ask confirmation iff buffer modified
 		 (signal 'file-supersession
-			 (list "File reverted" fn)))
+			 (list "File reverted" filename)))
 		((eq answer 'yield)
 		 (signal 'file-supersession
-			 (list "File changed on disk" fn))))))
+			 (list "File changed on disk" filename))))))
       (message
         "File on disk now will become a backup file if you save these changes.")
       (setq buffer-backed-up nil))))
@@ -131,64 +131,82 @@ to get the latest version of the file, then make the change again.")
 
 ;;; dialog-box versions [XEmacs]
 
-(defun ask-user-about-lock-dbox (fn opponent)
-  (let ((echo-keystrokes 0)
-	(dbox
-	 (cons
-	  (format "%s is locking %s\n
+(defun ask-user-about-lock-dbox (filename other-user)
+  (let ((echo-keystrokes 0))
+    (make-dialog-box
+     'question
+     :question (format "%s is locking %s\n
 	It has been detected that you want to modify a file that
 	someone else has already started modifying in XEmacs."
-		  opponent fn)
-	  '(["Steal Lock\n\nThe other user will\nbecome the intruder" steal t]
-	    ["Proceed\n\nEdit file at your own\n\(and the other user's) risk"
-	     proceed t]
-	    nil
-	    ["Abort\n\nDon't modify the buffer\n" yield t]))))
-    (popup-dialog-box dbox)
+		       other-user filename)
+     :buttons
+     '(["Steal Lock\n\nThe other user will\nbecome the intruder" steal t]
+       ["Proceed\n\nEdit file at your own\n\(and the other user's) risk"
+	proceed t]
+       nil
+       ["Abort\n\nDon't modify the buffer\n" yield t]))
     (catch 'aual-done
       (while t
 	(let ((event (next-command-event)))
-	  (cond ((and (misc-user-event-p event) (eq (event-object event) 'proceed))
+	  (cond ((and (misc-user-event-p event)
+		      (eq (event-object event) 'proceed))
 		 (throw 'aual-done nil))
-		((and (misc-user-event-p event) (eq (event-object event) 'steal))
+		((and (misc-user-event-p event)
+		      (eq (event-object event) 'steal))
 		 (throw 'aual-done t))
-		((and (misc-user-event-p event) (eq (event-object event) 'yield))
-		 (signal 'file-locked (list "File is locked" fn opponent)))
+		((and (misc-user-event-p event)
+		      (eq (event-object event) 'yield))
+		 (signal 'file-locked (list "File is locked" filename other-user)))
+		((and (misc-user-event-p event)
+		      (eq (event-object event) 'menu-no-selection-hook))
+		 (signal 'quit nil))
+		;; safety check, so we're not endlessly stuck when no
+		;; dialog box up
+		((not (popup-up-p))
+		 (signal 'quit nil))
 		((button-release-event-p event) ;; don't beep twice
 		 nil)
 		(t
 		 (beep)
 		 (message "please answer the dialog box"))))))))
 
-(defun ask-user-about-supersession-threat-dbox (fn)
-  (let ((echo-keystrokes 0)
-	(dbox
-	 (cons
-	  (format "File %s has changed on disk
+(defun ask-user-about-supersession-threat-dbox (filename)
+  (let ((echo-keystrokes 0))
+    (make-dialog-box
+     'question
+     :question
+     (format "File %s has changed on disk
 since its buffer was last read in or saved.
 
-Do you really want to edit the buffer? " fn)
-	  '(["Yes\n\nEdit the buffer anyway,\nignoring the disk file"
-	     proceed t]
-	    ["No\n\nDon't modify the buffer\n" yield t]
-	    nil
-	    ["No\n\nDon't modify the buffer\nbut revert it" revert t]
-	    ))))
-    (popup-dialog-box dbox)
+Do you really want to edit the buffer? " filename)
+     :buttons
+     '(["Yes\n\nEdit the buffer anyway,\nignoring the disk file"
+	proceed t]
+       ["No\n\nDon't modify the buffer\n" yield t]
+       nil
+       ["No\n\nDon't modify the buffer\nbut revert it" revert t]
+       ))
     (catch 'auast-done
       (while t
 	(let ((event (next-command-event)))
 	  (cond ((and (misc-user-event-p event) (eq (event-object event) 'proceed))
 		 (throw 'auast-done nil))
 		((and (misc-user-event-p event) (eq (event-object event) 'yield))
-		 (signal 'file-supersession (list fn)))
+		 (signal 'file-supersession (list filename)))
 		((and (misc-user-event-p event) (eq (event-object event) 'revert))
-		 (or (equal fn (buffer-file-name))
+		 (or (equal filename (buffer-file-name))
 		     (error
 		      "ask-user-about-supersession-threat called bogusly"))
 		 (revert-buffer nil t)
 		 (signal 'file-supersession
-			 (list fn "(reverted)")))
+			 (list filename "(reverted)")))
+		((and (misc-user-event-p event)
+		      (eq (event-object event) 'menu-no-selection-hook))
+		 (signal 'quit nil))
+		;; safety check, so we're not endlessly stuck when no
+		;; dialog box up
+		((not (popup-up-p))
+		 (signal 'quit nil))
 		((button-release-event-p event) ;; don't beep twice
 		 nil)
 		(t
@@ -199,37 +217,31 @@ Do you really want to edit the buffer? " fn)
 ;;; top-level
 
 ;;;###autoload
-(defun ask-user-about-lock (fn opponent)
-  "Ask user what to do when he wants to edit FILE but it is locked by USER.
+(defun ask-user-about-lock (filename other-user)
+  "Ask user wanting to edit FILENAME, locked by OTHER-USER, what to do.
 This function has a choice of three things to do:
-  do (signal 'file-locked (list FILE USER))
+  do (signal 'file-locked (list FILENAME OTHER-USER))
     to refrain from editing the file
   return t (grab the lock on the file)
   return nil (edit the file even though it is locked).
-You can rewrite it to use any criterion you like to choose which one to do."
+You can rewrite it to use any criteria you like to choose which one to do."
   (discard-input)
-  (if (and (fboundp 'popup-dialog-box)
-	   (or (button-press-event-p last-command-event)
-	       (button-release-event-p last-command-event)
-	       (misc-user-event-p last-command-event)))
-      (ask-user-about-lock-dbox fn opponent)
-    (ask-user-about-lock-minibuf fn opponent)))
+  (if (should-use-dialog-box-p)
+      (ask-user-about-lock-dbox filename other-user)
+    (ask-user-about-lock-minibuf filename other-user)))
 
 ;;;###autoload
-(defun ask-user-about-supersession-threat (fn)
-  "Ask a user who is about to modify an obsolete buffer what to do.
+(defun ask-user-about-supersession-threat (filename)
+  "Ask user who is about to modify an obsolete buffer what to do.
 This function has two choices: it can return, in which case the modification
-of the buffer will proceed, or it can (signal 'file-supersession (file)),
+of the buffer will proceed, or it can (signal 'file-supersession (FILENAME)),
 in which case the proposed buffer modification will not be made.
 
-You can rewrite this to use any criterion you like to choose which one to do.
+You can rewrite this to use any criteria you like to choose which one to do.
 The buffer in question is current when this function is called."
   (discard-input)
-  (if (and (fboundp 'popup-dialog-box)
-	   (or (button-press-event-p last-command-event)
-	       (button-release-event-p last-command-event)
-	       (misc-user-event-p last-command-event)))
-      (ask-user-about-supersession-threat-dbox fn)
-    (ask-user-about-supersession-threat-minibuf fn)))
+  (if (should-use-dialog-box-p)
+      (ask-user-about-supersession-threat-dbox filename)
+    (ask-user-about-supersession-threat-minibuf filename)))
 
 ;;; userlock.el ends here