Re: Magit-inspired Emacs interface for Sapling (sl)

diff --git a/sl.el b/sl.el
index a0b5f0d..c5dec05 100644
--- a/sl.el
+++ b/sl.el
@@ -53,111 +53,87 @@
 
 (defcustom sl-program "sl"
   "Name of or path to the Sapling executable."
-  :type 'string
-  :group 'sl)
+  :type 'string)
 
 (defcustom sl-status-buffer-name "*sl*"
   "Name of the Sapling status buffer."
-  :type 'string
-  :group 'sl)
+  :type 'string)
 
 (defcustom sl-smartlog-buffer-name "*sl-smartlog*"
   "Name of the Sapling smartlog buffer."
-  :type 'string
-  :group 'sl)
-
-(defcustom sl-log-buffer-name "*sl-log*"
-  "Name of the Sapling graph log buffer."
-  :type 'string
-  :group 'sl)
+  :type 'string)
 
 (defcustom sl-diff-buffer-name "*sl-diff*"
   "Name of the Sapling diff buffer."
-  :type 'string
-  :group 'sl)
+  :type 'string)
 
 (defcustom sl-output-buffer-name "*sl-output*"
   "Name of the generic Sapling output buffer."
-  :type 'string
-  :group 'sl)
+  :type 'string)
 
 (defcustom sl-log-limit 100
   "Number of commits to show in `sl-log'."
-  :type 'integer
-  :group 'sl)
+  :type 'natnum)
 
-(defcustom sl-w32-pipe-read-delay 0
+(defcustom sl-w32-pipe-read-delay (or (bound-and-true-p w32-pipe-read-delay) 0)
   "Value for `w32-pipe-read-delay' while reading `sl' output.
 Lower values make process output significantly faster on Windows."
-  :type 'integer
-  :group 'sl)
+  :type 'integer)
 
 (defcustom sl-use-color t
   "When non-nil, colorize Sapling command output.
 Sl commands that display text are run with ANSI color enabled and
 `ansi-color' translates the SGR sequences into Emacs faces.  This
 works on Windows as well as on Unix."
-  :type 'boolean
-  :group 'sl)
+  :type 'boolean)
 
 (defcustom sl-diff-use-diff-mode t
   "When non-nil, show `sl-diff' output in `diff-mode'.
 This gives Emacs-native diff coloring (removed lines in red, added
 lines in green) without parsing Sapling's terminal color codes."
-  :type 'boolean
-  :group 'sl)
+  :type 'boolean)
 
 (defface sl-header-face
   '((t :inherit bold))
-  "Face for Sapling section headers."
-  :group 'sl)
+  "Face for Sapling section headers.")
 
 (defface sl-status-modified-face
   '((t :foreground "orange"))
-  "Face for modified files."
-  :group 'sl)
+  "Face for modified files.")
 
 (defface sl-status-added-face
-  '((t :foreground "green"))
-  "Face for added files."
-  :group 'sl)
+  '((t :foreground "green"))	 ;perhaps inherit from diff-mode faces?
+  "Face for added files.")
 
 (defface sl-status-removed-face
   '((t :foreground "red"))
-  "Face for removed files."
-  :group 'sl)
+  "Face for removed files.")
 
 (defface sl-status-missing-face
   '((t :foreground "red" :weight bold))
-  "Face for missing files."
-  :group 'sl)
+  "Face for missing files.")
 
 (defface sl-status-unknown-face
   '((t :foreground "magenta"))
-  "Face for untracked files."
-  :group 'sl)
+  "Face for untracked files.")
 
 (defface sl-status-ignored-face
   '((t :foreground "gray"))
-  "Face for ignored files."
-  :group 'sl)
+  "Face for ignored files.")
 
 (defface sl-status-clean-face
   '((t :foreground "gray"))
-  "Face for clean files."
-  :group 'sl)
+  "Face for clean files.")
 
 (defface sl-marked-face
   '((t :weight bold :box (:line-width 1)))
-  "Face for marked files in the status buffer."
-  :group 'sl)
+  "Face for marked files in the status buffer.")
 
 (defface sl-log-changeset-face
   '((t :foreground "yellow"))
-  "Face for changeset identifiers in Sapling smartlog output."
-  :group 'sl)
+  "Face for changeset identifiers in Sapling smartlog output.")
 
-;;; Buffer-local state
+;;;; Buffer-local state
 
 (defvar-local sl--repo-root nil
   "Root directory of the Sapling repository for the current buffer.")
@@ -188,7 +164,7 @@ lines in green) without parsing Sapling's terminal color codes."
 
 ;;; Process helpers
 
-(defun sl--windows-p ()
+(defun sl--windows-p ()		 ;this is not used?
   "Return non-nil when running on a Windows system."
   (memq system-type '(ms-dos windows-nt cygwin)))
 
@@ -202,8 +178,8 @@ lines in green) without parsing Sapling's terminal color codes."
   "Return a process command list for running `sl' with ARGS.
 On Windows, `.bat'/`.cmd' wrappers need to be run through the shell."
   (let* ((program (sl--sl-program))
-         (extension (downcase (or (file-name-extension program) ""))))
-    (if (member extension '("bat" "cmd" "com"))
+         (extension (file-name-extension program)))
+    (if (member-ignore-case extension '("bat" "cmd" "com"))
         (list shell-file-name shell-command-switch
               (mapconcat #'shell-quote-argument (cons program args) " "))
       (cons program args))))
@@ -219,6 +195,7 @@ where Sapling may otherwise use the native console color API."
 When `sl-use-color' is non-nil, allow colored output under Sapling's
 automation mode."
   (let ((env (copy-sequence process-environment)))
+    ;; a comment explaining these variables would be useful.
     (dolist (var '("HGPLAIN=1" "SL_AUTOMATION=1"))
       (unless (member var env)
         (push var env)))
@@ -227,6 +204,7 @@ automation mode."
         (push "SL_AUTOMATION_EXCEPT=color" env)))
     env))
 
+;; please fix the checkdoc error!
 (cl-defun sl--run-async (args &key name callback directory color)
   "Run `sl' with ARGS asynchronously.
 
@@ -240,6 +218,10 @@ enabled."
          (process-environment (sl--process-environment)))
     ;; `w32-pipe-read-delay' is a global variable, so bindings around
     ;; `make-process' do not affect later reads.  Set it directly here.
+    ;;
+    ;; This seems rather invasive, and something that the user should
+    ;; be made aware of in some sense, if it were to happen to break
+    ;; some other scripts.
     (when (and (boundp 'w32-pipe-read-delay)
                sl-w32-pipe-read-delay)
       (setq w32-pipe-read-delay sl-w32-pipe-read-delay))
@@ -267,6 +249,9 @@ enabled."
          (when callback
            (funcall callback out code)))))))
 
+;; I would suggest making the signature (directory &rest args)
+;;
+;; Or perhaps turn this into a macro (sl--with-output (dir &rest args) &rest body) so that you don't have to turn everything into a string
 (defun sl--call-output (args &optional directory)
   "Run `sl' with ARGS synchronously in DIRECTORY and return its output.
 Signal an error if the command exits unsuccessfully."
@@ -341,7 +326,6 @@ Signal an error if the command exits unsuccessfully."
   "Major mode for Sapling status output.
 
 \\{sl-mode-map}"
-  :group 'sl
   (setq-local buffer-read-only t)
   (setq-local truncate-lines t)
   (setq-local revert-buffer-function #'sl-refresh)
@@ -367,12 +351,12 @@ Signal an error if the command exits unsuccessfully."
           sl--smartlog nil)
     (sl-refresh)))
 
-(defun sl-quit ()
+(defun sl-quit ()		 ;why are you redefiniting this?
   "Quit the current Sapling buffer."
   (interactive)
   (quit-window))
 
-(defun sl-help ()
+(defun sl-help ()		 ;here as well?
   "Show help for the current Sapling mode."
   (interactive)
   (describe-mode))
@@ -424,7 +408,7 @@ Signal an error if the command exits unsuccessfully."
            (sl--finish-refresh buffer root smartlog files info)))))))
 
 (defun sl--finish-refresh (buffer root smartlog files info)
-  "Populate BUFFER with refreshed Sapling data."
+  "Populate BUFFER with refreshed Sapling data." ;please fix the checkdoc issues!
   (when (buffer-live-p buffer)
     (with-current-buffer buffer
       (setq sl--repo-root root
@@ -442,9 +426,7 @@ Signal an error if the command exits unsuccessfully."
 
 (defun sl--strip-cr (string)
   "Return STRING without a trailing carriage return, if any."
-  (if (string-suffix-p "\r" string)
-      (substring string 0 -1)
-    string))
+  (string-trim-right string "\r"))
 
 (defun sl--parse-status (text)
   "Parse `sl status' output TEXT into a list of (STATUS FILE)."
@@ -459,6 +441,7 @@ Signal an error if the command exits unsuccessfully."
   "Parse commit info line TEXT into (HASH BOOKMARK PHASE)."
   (let ((line (sl--strip-cr (car (split-string text "\n" t)))))
     (when line
+      ;; you might be able to simplify this to (take 3 (split-string line "\t"))
       (let ((parts (split-string line "\t")))
         (list (nth 0 parts) (nth 1 parts) (nth 2 parts))))))
 
@@ -472,7 +455,7 @@ Signal an error if the command exits unsuccessfully."
     (?? 'sl-status-unknown-face)
     (?I 'sl-status-ignored-face)
     (?C 'sl-status-clean-face)
-    (t nil)))
+    (t nil)))			 ;isn't this an unexpected state?
 
 (defun sl--insert-smartlog (text)
   "Insert smartlog TEXT with changeset hashes colored."
@@ -541,8 +524,7 @@ Signal an error if the command exits unsuccessfully."
 (defun sl--goto-file (file)
   "Move point to FILE in the current status buffer."
   (goto-char (point-min))
-  (while (and (not (eobp))
-              (not (equal (get-text-property (point) 'sl-file) file)))
+  (unless (or (eobp) (equal (get-text-property (point) 'sl-file) file))
     (forward-line 1)))
 
 (defun sl-mark ()
@@ -599,8 +581,8 @@ Signal an error if the command exits unsuccessfully."
 (defvar sl-output-mode-map
   (let ((map (make-sparse-keymap)))
     (set-keymap-parent map special-mode-map)
-    (define-key map (kbd "g") #'sl-output-refresh)
-    (define-key map (kbd "q") #'quit-window)
+    (define-key map (kbd "g") #'sl-output-refresh) ;This shouldn't be necessary, as you are already setting `revert-buffer-function'
+    (define-key map (kbd "q") #'quit-window) ;you are inheriting from `special-mode', this binding is already there
     map)
   "Keymap for `sl-output-mode'.")
 
@@ -617,7 +599,6 @@ Signal an error if the command exits unsuccessfully."
   "Major mode for Sapling command output.
 
 \\{sl-output-mode-map}"
-  :group 'sl
   (setq-local buffer-read-only t)
   (setq-local truncate-lines t)
   (setq-local revert-buffer-function #'sl-output-refresh))
@@ -625,7 +606,7 @@ Signal an error if the command exits unsuccessfully."
 (defvar sl-diff-mode-map
   (let ((map (make-sparse-keymap)))
     (set-keymap-parent map diff-mode-map)
-    (define-key map (kbd "g") #'sl-output-refresh)
+    (define-key map (kbd "g") #'sl-output-refresh) ;same comments here as above, just with diff-mode
     (define-key map (kbd "q") #'quit-window)
     map)
   "Keymap for `sl-diff-mode'.")
@@ -634,9 +615,9 @@ Signal an error if the command exits unsuccessfully."
   "Major mode for Sapling diff output.
 
 \\{sl-diff-mode-map}"
-  :group 'sl
   (setq-local buffer-read-only t)
   (setq-local truncate-lines t)
+  ;; is this the only meaningful difference between this mode and `diff-mode'?
   (setq-local revert-buffer-function #'sl-output-refresh))
 
 (defun sl--render-output-loading ()
@@ -659,7 +640,7 @@ Signal an error if the command exits unsuccessfully."
   (let ((inhibit-read-only t)
         (text-beg nil))
     (erase-buffer)
-    (insert (propertize (format "%s\n" title) 'face 'sl-header-face))
+    (insert (propertize title 'face 'sl-header-face) "\n")
     (when text
       (setq text-beg (point))
       (insert text)
@@ -720,7 +701,7 @@ ANSI colors enabled."
 (defun sl--refresh-status-buffer ()
   "Refresh the Sapling status buffer if it exists."
   (let ((buffer (get-buffer sl-status-buffer-name)))
-    (when (and buffer (buffer-live-p buffer))
+    (when (and buffer (buffer-live-p buffer)) ;is this racy?
       (with-current-buffer buffer
         (when (derived-mode-p 'sl-mode)
           (sl-refresh))))))
@@ -775,7 +756,7 @@ Returns nil when the current buffer is not a status buffer."
       (push file files))
     (nreverse files)))
 
-;;; Commands
+;;;; Commands
 
 ;;;###autoload
 (defun sl-smartlog ()
@@ -874,6 +855,7 @@ called outside the status buffer."
           (when previous-message
             (insert previous-message)
             (unless (bolp) (insert "\n")))
+	  ;; iconing scissors left to right ("8<") seems slightly more intuitive to me
           (insert "\n# ------------------------ >8 ------------------------\n")
           (insert (sl--commit-comment root files amend)))
         (goto-char (point-min)))
@@ -899,6 +881,8 @@ called outside the status buffer."
   (let ((cut (save-excursion
                (goto-char (point-min))
                (re-search-forward
+		;; if you are re-using the string, you really should
+		;; move this into a constant!
                 "^# ------------------------ >8 ------------------------$" nil t))))
     (string-trim
      (if cut
@@ -948,8 +932,8 @@ called outside the status buffer."
                     (insert out))
                   (current-buffer)))))))))))
 
-(defun sl-commit-cancel ()
-  "Cancel the commit or amend in the current message buffer."
+(defun sl-commit-cancel ()	 ;again, why a new command?
+  "Cancel the commit or amend in the current message buffer." ;the doc string doesn't appear to match the implementation?
   (interactive)
   (kill-buffer))
 
@@ -1096,7 +1080,7 @@ the confirmation prompt."
   (interactive (list (sl--marked-or-point-files)))
   (when (and (null files)
              (not current-prefix-arg)
-             (not (y-or-n-p "Revert all pending changes? ")))
+             (not (y-or-n-p "Revert all pending changes? "))) ;please use `yes-or-no-p', in case people prefer verbose answers!
     (user-error "Aborted"))
   (sl--run-and-show (append '("revert") files) "Sl Revert"))
 
@@ -1106,7 +1090,7 @@ the confirmation prompt."
 With a prefix argument, print what would be deleted instead."
   (interactive "P")
   (unless dry-run
-    (unless (y-or-n-p "Delete all untracked files? ")
+    (unless (y-or-n-p "Delete all untracked files? ") ;here again, users can set `use-short-answers' if they prefer `y-or-n-p'
       (user-error "Aborted")))
   (sl--run-and-show
    (if dry-run '("clean" "--print") '("clean"))
@@ -1165,9 +1149,7 @@ With a prefix argument, print what would be deleted instead."
   "Undo the last local Sapling command.
 With a prefix argument, undo that many local commands."
   (interactive "P")
-  (let ((args (if arg
-                  (list "undo" (number-to-string (prefix-numeric-value arg)))
-                '("undo"))))
+  (let ((args (cons "undo" (and arg (list (number-to-string (prefix-numeric-value arg)))))))
     (sl--run-and-show args "Sl Undo")))
 
 ;;;###autoload
@@ -1221,8 +1203,8 @@ the file at point is used as the initial FILE."
      (list (read-string "Revision (empty for current): ") file)))
   (let* ((root (or sl--repo-root (sl--find-root default-directory)))
          (args (append '("annotate")
-                       (unless (string-empty-p revision)
-                         (list "-r" revision))
+                       (and (not (string-empty-p revision))
+                            (list "-r" revision))
                        (list file))))
     (unless root
       (user-error "Not inside a Sl repository"))
@@ -1309,72 +1291,45 @@ An empty DIRECTORY initializes the current directory."
    "Sl Init"
    default-directory))
 
+
+
 ;;;###autoload
 (defun sl-menu ()
   "Display a Magit-style dispatch menu for Sapling commands."
   (interactive)
-  (let* ((entry (read-multiple-choice
-                 "Sl"
-                 '((?s "status" "Show working copy status")
-                   (?l "smartlog" "Show smartlog")
-                   (?L "log" "Show graph log")
-                   (?d "diff" "Show diff")
-                   (?c "commit" "Commit changes")
-                   (?a "amend" "Amend current commit")
-                   (?x "absorb" "Absorb changes into stack")
-                   (?r "rebase" "Rebase onto revision")
-                   (?f "fold" "Fold commits")
-                   (?g "graft" "Graft a commit")
-                   (?h "hide" "Hide a commit")
-                   (?H "unhide" "Unhide a commit")
-                   (?z "shelve" "Shelve changes")
-                   (?Z "unshelve" "Unshelve changes")
-                   (?n "next" "Check out next commit")
-                   (?p "previous" "Check out previous commit")
-                   (?u "undo" "Undo local command")
-                   (?R "redo" "Redo local command")
-                   (?A "add" "Add files")
-                   (?D "remove" "Remove files")
-                   (?K "forget" "Forget files")
-                   (?V "revert" "Revert files")
-                   (?e "metaedit" "Edit commit message")
-                   (?o "show" "Show current commit")
-                   (?J "journal" "Show journal")
-                   (?B "bookmark" "Create bookmark")
-                   (?F "pull" "Pull changes")
-                   (?P "push" "Push changes")
-                   (?q "quit" "Quit"))))
-         (choice (if (consp entry) (car entry) entry)))
-    (cl-case choice
-      (?s (sl-status))
-      (?l (sl-smartlog))
-      (?L (sl-log))
-      (?d (sl-diff))
-      (?c (sl-commit))
-      (?a (sl-amend))
-      (?x (sl-absorb))
-      (?r (call-interactively #'sl-rebase))
-      (?f (call-interactively #'sl-fold))
-      (?g (call-interactively #'sl-graft))
-      (?h (call-interactively #'sl-hide))
-      (?H (call-interactively #'sl-unhide))
-      (?z (sl-shelve))
-      (?Z (sl-unshelve))
-      (?n (sl-next))
-      (?p (sl-previous))
-      (?u (sl-undo))
-      (?R (sl-redo))
-      (?A (sl-add))
-      (?D (sl-remove))
-      (?K (sl-forget))
-      (?V (sl-revert))
-      (?e (call-interactively #'sl-metaedit))
-      (?o (sl-show))
-      (?J (call-interactively #'sl-journal))
-      (?B (call-interactively #'sl-bookmark-create))
-      (?F (sl-pull))
-      (?P (sl-push))
-      (?q nil))))
+  (let ((table
+	 '((?s "status" "Show working copy status" sl-status)
+	   (?l "smartlog" "Show smartlog" sl-smartlog)
+	   (?L "log" "Show graph log" sl-log)
+	   (?d "diff" "Show diff" sl-diff)
+	   (?c "commit" "Commit changes" sl-commit)
+	   (?a "amend" "Amend current commit" sl-amend)
+	   (?x "absorb" "Absorb changes into stack" sl-absorb)
+	   (?r "rebase" "Rebase onto revision" sl-rebase t)
+	   (?f "fold" "Fold commits" sl-fold t)
+	   (?g "graft" "Graft a commit" sl-graft t)
+	   (?h "hide" "Hide a commit" sl-graft t)
+	   (?H "unhide" "Unhide a commit" sl-hide t)
+	   (?z "shelve" "Shelve changes" sl-shelve)
+	   (?Z "unshelve" "Unshelve changes" sl-unshelve)
+	   (?n "next" "Check out next commit" sl-next)
+	   (?p "previous" "Check out previous commit" sl-previous)
+	   (?u "undo" "Undo local command" sl-undo)
+	   (?R "redo" "Redo local command" sl-redo)
+	   (?A "add" "Add files" sl-add)
+	   (?D "remove" "Remove files" sl-remove)
+	   (?K "forget" "Forget files" sl-forget)
+	   (?V "revert" "Revert files" sl-revert)
+	   (?e "metaedit" "Edit commit message" sl-metaedit t)
+	   (?o "show" "Show current commit" sl-show)
+	   (?J "journal" "Show journal" sl-journal t)
+	   (?B "bookmark" "Create bookmark" sl-bookmark-create t)
+	   (?F "pull" "Pull changes" sl-pull)
+	   (?P "push" "Push changes" sl-push)
+	   (?q "quit" "Quit"))))
+    (pcase-exhaustive (read-multiple-choice "Sl" table)
+      (`(,_ ,_ ,_ ,fn t) (funcall-interactively fn))
+      (`(,_ ,_ ,_ ,fn) (funcall fn)))))
 
 (provide 'sl)