diff lisp/userlock.el @ 442:abe6d1db359e r21-2-36

Import from CVS: tag r21-2-36
author cvs
date Mon, 13 Aug 2007 11:35:02 +0200
parents 3ecd8885ac67
children 576fb035e263
line wrap: on
line diff
--- a/lisp/userlock.el	Mon Aug 13 11:33:40 2007 +0200
+++ b/lisp/userlock.el	Mon Aug 13 11:35:02 2007 +0200
@@ -132,31 +132,38 @@
 ;;; dialog-box versions [XEmacs]
 
 (defun ask-user-about-lock-dbox (fn opponent)
-  (let ((echo-keystrokes 0)
-	(dbox
-	 (cons
-	  (format "%s is locking %s\n
+  (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)
+		       opponent fn)
+     :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))
+		((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) '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
@@ -164,20 +171,21 @@
 		 (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
+  (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)
+     :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)))
@@ -195,6 +203,10 @@
 		((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
@@ -214,10 +226,7 @@
   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."
   (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)))
+  (if (should-use-dialog-box-p)
       (ask-user-about-lock-dbox fn opponent)
     (ask-user-about-lock-minibuf fn opponent)))
 
@@ -231,10 +240,7 @@
 You can rewrite this to use any criterion 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)))
+  (if (should-use-dialog-box-p)
       (ask-user-about-supersession-threat-dbox fn)
     (ask-user-about-supersession-threat-minibuf fn)))