]> git.eshelyaron.com Git - emacs.git/commitdiff
Simplify 'ask-user-about-lock'
authorEshel Yaron <me@eshelyaron.com>
Wed, 12 Jun 2024 10:03:01 +0000 (12:03 +0200)
committerEshel Yaron <me@eshelyaron.com>
Wed, 12 Jun 2024 10:03:48 +0000 (12:03 +0200)
lisp/userlock.el

index db94bb214e6f64337d9eecad925dd076932cb447..7231ee8df22ebad796cd071b2beea89c3233f10f 100644 (file)
 ;;;###autoload
 (defun ask-user-about-lock (file opponent)
   "Ask user what to do when he wants to edit FILE but it is locked by OPPONENT.
-This function has a choice of three things to do:
-  do (signal \\='file-locked (list FILE OPPONENT))
-    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 redefine this function to choose among those three alternatives
-in any way you like."
+This function has a choice of three things to do: signal `file-locked'
+to refrain from editing the file, return t to grab the lock on the file,
+or return nil toedit the file even though it is locked."
   (discard-input)
-  (save-window-excursion
-    (let (answer short-opponent short-file)
-      (setq short-file
-           (if (> (length file) 22)
-               (concat "..." (substring file (- (length file) 22)))
-             file))
-      (setq short-opponent
-           (if (> (length opponent) 25)
-               (save-match-data
-                 (string-match " (pid [0-9]+)" opponent)
-                 (concat (substring opponent 0 13) "..."
-                         (match-string 0 opponent)))
-             opponent))
-      (while (null answer)
-       (when noninteractive
-          (signal 'file-locked (list file opponent "Cannot resolve lock conflict in batch mode")))
-        (message (substitute-command-keys
-                  "%s locked by %s: (\\`s', \\`q', \\`p', \\`?')? ")
-                 short-file short-opponent)
-       (let ((tem (let ((inhibit-quit t)
-                        (cursor-in-echo-area t))
-                    (prog1 (downcase (read-char))
-                           (setq quit-flag nil)))))
-         (if (= tem help-char)
-             (ask-user-about-lock-help)
-           (setq answer (assoc tem '((?s . t)
-                                     (?q . yield)
-                                     (?\C-g . yield)
-                                     (?p . nil)
-                                     (?? . help))))
-           (cond ((null answer)
-                  (beep)
-                   ;; FIXME: Why do we use "?" here and "C-h" below?
-                   (message (substitute-command-keys
-                             "Please type \\`q', \\`s', or \\`p'; or \\`?' for help"))
-                  (sit-for 3))
-                 ((eq (cdr answer) 'help)
-                  (ask-user-about-lock-help)
-                  (setq answer nil))
-                 ((eq (cdr answer) 'yield)
-                  (signal 'file-locked (list file opponent)))))))
-      (cdr answer))))
-
-(defun ask-user-about-lock-help ()
-  (with-output-to-temp-buffer "*Help*"
-    (with-current-buffer standard-output
-      (insert
-       (substitute-command-keys
-        "It has been detected that you want to modify a file that someone else has
-already started modifying in Emacs.
-
-You can <\\`s'>teal the file; the other user becomes the
-  intruder if (s)he ever unmodifies the file and then changes it again.
-You can <\\`p'>roceed; you edit at your own (and the other user's) risk.
-You can <\\`q'>uit; don't modify this file."))
-      (help-mode))))
+  (let (c)
+    (if (or noninteractive
+            (= ?q
+               (setq c (car (read-multiple-choice
+                             (format
+                              "%s locked by %s"
+                              (truncate-string-to-width file     25 nil nil t)
+                              (truncate-string-to-width opponent 25 nil nil t))
+                             '((?s "steal") (?p "proceed") (?q "quit")))))))
+        (signal 'file-locked (list file opponent))
+      (= c ?s))))
 
 (define-error 'file-supersession nil 'file-error)