Mercurial > hg > xemacs-beta

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-36
author cvs
date Mon, 13 Aug 2007 11:35:02 +0200
parents 3ecd8885ac67
children 576fb035e263
comparison
equal deleted inserted replaced
441:72a7cfa4a488 442:abe6d1db359e
130 (help-mode)))) 130 (help-mode))))
131 131
132 ;;; dialog-box versions [XEmacs] 132 ;;; dialog-box versions [XEmacs]
133 133
134 (defun ask-user-about-lock-dbox (fn opponent) 134 (defun ask-user-about-lock-dbox (fn opponent)
135 (let ((echo-keystrokes 0) 135 (let ((echo-keystrokes 0))
136 (dbox 136 (make-dialog-box
137 (cons 137 'question
138 (format "%s is locking %s\n 138 :question (format "%s is locking %s\n
139 It has been detected that you want to modify a file that 139 It has been detected that you want to modify a file that
140 someone else has already started modifying in XEmacs." 140 someone else has already started modifying in XEmacs."
141 opponent fn) 141 opponent fn)
142 '(["Steal Lock\n\nThe other user will\nbecome the intruder" steal t] 142 :buttons
143 ["Proceed\n\nEdit file at your own\n\(and the other user's) risk" 143 '(["Steal Lock\n\nThe other user will\nbecome the intruder" steal t]
144 proceed t] 144 ["Proceed\n\nEdit file at your own\n\(and the other user's) risk"
145 nil 145 proceed t]
146 ["Abort\n\nDon't modify the buffer\n" yield t])))) 146 nil
147 (popup-dialog-box dbox) 147 ["Abort\n\nDon't modify the buffer\n" yield t]))
148 (catch 'aual-done 148 (catch 'aual-done
149 (while t 149 (while t
150 (let ((event (next-command-event))) 150 (let ((event (next-command-event)))
151 (cond ((and (misc-user-event-p event) (eq (event-object event) 'proceed)) 151 (cond ((and (misc-user-event-p event)
152 (eq (event-object event) 'proceed))
152 (throw 'aual-done nil)) 153 (throw 'aual-done nil))
153 ((and (misc-user-event-p event) (eq (event-object event) 'steal)) 154 ((and (misc-user-event-p event)
155 (eq (event-object event) 'steal))
154 (throw 'aual-done t)) 156 (throw 'aual-done t))
155 ((and (misc-user-event-p event) (eq (event-object event) 'yield)) 157 ((and (misc-user-event-p event)
158 (eq (event-object event) 'yield))
156 (signal 'file-locked (list "File is locked" fn opponent))) 159 (signal 'file-locked (list "File is locked" fn opponent)))
157 ((and (misc-user-event-p event) 160 ((and (misc-user-event-p event)
158 (eq (event-object event) 'menu-no-selection-hook)) 161 (eq (event-object event) 'menu-no-selection-hook))
162 (signal 'quit nil))
163 ;; safety check, so we're not endlessly stuck when no
164 ;; dialog box up
165 ((not (popup-up-p))
159 (signal 'quit nil)) 166 (signal 'quit nil))
160 ((button-release-event-p event) ;; don't beep twice 167 ((button-release-event-p event) ;; don't beep twice
161 nil) 168 nil)
162 (t 169 (t
163 (beep) 170 (beep)
164 (message "please answer the dialog box")))))))) 171 (message "please answer the dialog box"))))))))
165 172
166 (defun ask-user-about-supersession-threat-dbox (fn) 173 (defun ask-user-about-supersession-threat-dbox (fn)
167 (let ((echo-keystrokes 0) 174 (let ((echo-keystrokes 0))
168 (dbox 175 (make-dialog-box
169 (cons 176 'question
170 (format "File %s has changed on disk 177 :question
178 (format "File %s has changed on disk
171 since its buffer was last read in or saved. 179 since its buffer was last read in or saved.
172 180
173 Do you really want to edit the buffer? " fn) 181 Do you really want to edit the buffer? " fn)
174 '(["Yes\n\nEdit the buffer anyway,\nignoring the disk file" 182 :buttons
175 proceed t] 183 '(["Yes\n\nEdit the buffer anyway,\nignoring the disk file"
176 ["No\n\nDon't modify the buffer\n" yield t] 184 proceed t]
177 nil 185 ["No\n\nDon't modify the buffer\n" yield t]
178 ["No\n\nDon't modify the buffer\nbut revert it" revert t] 186 nil
179 )))) 187 ["No\n\nDon't modify the buffer\nbut revert it" revert t]
180 (popup-dialog-box dbox) 188 ))
181 (catch 'auast-done 189 (catch 'auast-done
182 (while t 190 (while t
183 (let ((event (next-command-event))) 191 (let ((event (next-command-event)))
184 (cond ((and (misc-user-event-p event) (eq (event-object event) 'proceed)) 192 (cond ((and (misc-user-event-p event) (eq (event-object event) 'proceed))
185 (throw 'auast-done nil)) 193 (throw 'auast-done nil))
193 (signal 'file-supersession 201 (signal 'file-supersession
194 (list fn "(reverted)"))) 202 (list fn "(reverted)")))
195 ((and (misc-user-event-p event) 203 ((and (misc-user-event-p event)
196 (eq (event-object event) 'menu-no-selection-hook)) 204 (eq (event-object event) 'menu-no-selection-hook))
197 (signal 'quit nil)) 205 (signal 'quit nil))
206 ;; safety check, so we're not endlessly stuck when no
207 ;; dialog box up
208 ((not (popup-up-p))
209 (signal 'quit nil))
198 ((button-release-event-p event) ;; don't beep twice 210 ((button-release-event-p event) ;; don't beep twice
199 nil) 211 nil)
200 (t 212 (t
201 (beep) 213 (beep)
202 (message "please answer the dialog box")))))))) 214 (message "please answer the dialog box"))))))))
212 to refrain from editing the file 224 to refrain from editing the file
213 return t (grab the lock on the file) 225 return t (grab the lock on the file)
214 return nil (edit the file even though it is locked). 226 return nil (edit the file even though it is locked).
215 You can rewrite it to use any criterion you like to choose which one to do." 227 You can rewrite it to use any criterion you like to choose which one to do."
216 (discard-input) 228 (discard-input)
217 (if (and (fboundp 'popup-dialog-box) 229 (if (should-use-dialog-box-p)
218 (or (button-press-event-p last-command-event)
219 (button-release-event-p last-command-event)
220 (misc-user-event-p last-command-event)))
221 (ask-user-about-lock-dbox fn opponent) 230 (ask-user-about-lock-dbox fn opponent)
222 (ask-user-about-lock-minibuf fn opponent))) 231 (ask-user-about-lock-minibuf fn opponent)))
223 232
224 ;;;###autoload 233 ;;;###autoload
225 (defun ask-user-about-supersession-threat (fn) 234 (defun ask-user-about-supersession-threat (fn)
229 in which case the proposed buffer modification will not be made. 238 in which case the proposed buffer modification will not be made.
230 239
231 You can rewrite this to use any criterion you like to choose which one to do. 240 You can rewrite this to use any criterion you like to choose which one to do.
232 The buffer in question is current when this function is called." 241 The buffer in question is current when this function is called."
233 (discard-input) 242 (discard-input)
234 (if (and (fboundp 'popup-dialog-box) 243 (if (should-use-dialog-box-p)
235 (or (button-press-event-p last-command-event)
236 (button-release-event-p last-command-event)
237 (misc-user-event-p last-command-event)))
238 (ask-user-about-supersession-threat-dbox fn) 244 (ask-user-about-supersession-threat-dbox fn)
239 (ask-user-about-supersession-threat-minibuf fn))) 245 (ask-user-about-supersession-threat-minibuf fn)))
240 246
241 ;;; userlock.el ends here 247 ;;; userlock.el ends here