magit-key-mode.el

;;; magit-key-mode.el --- interactively tune git invocation

;; Copyright (C) 2010-2014  The Magit Project Developers
;;
;; For a full list of contributors, see the AUTHORS.md file
;; at the top-level directory of this distribution and at
;; https://raw.github.com/magit/magit/master/AUTHORS.md

;; Author: Phil Jackson <phil@shellarchive.co.uk>
;; Package: magit

;; Magit is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; Magit is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
;; License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Magit.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This library implements `magit-key-mode' which is used throughout
;; Magit to let the user interactively select the command, switches
;; and options to call Git with.  It can be though of as a way to
;; provide "postfix" arguments.

;;; Code:

(require 'magit)

(eval-when-compile (require 'cl-lib))

(defvar magit-key-mode-keymaps)
(defvar magit-key-mode-last-buffer)
(defvar magit-pre-key-mode-window-conf)

;;; Options

(defcustom magit-key-mode-show-usage t
  "Whether to show usage information when entering a popup."
  :group 'magit
  :type 'boolean)

;;; Faces

(defface magit-key-mode-header-face
  '((t :inherit font-lock-keyword-face))
  "Face for key mode header lines."
  :group 'magit-faces)

(defface magit-key-mode-button-face
  '((t :inherit font-lock-builtin-face))
  "Face for key mode buttons."
  :group 'magit-faces)

(defface magit-key-mode-switch-face
  '((t :inherit font-lock-warning-face))
  "Face for key mode switches."
  :group 'magit-faces)

(defface magit-key-mode-args-face
  '((t :inherit widget-field))
  "Face for key mode switch arguments."
  :group 'magit-faces)

;;; Keygroups
;;;###autoload
(defvar magit-key-mode-groups
  '((dispatch
     (actions
      ("b" "Branching"       magit-key-mode-popup-branching)
      ("B" "Bisecting"       magit-key-mode-popup-bisecting)
      ("c" "Committing"      magit-key-mode-popup-committing)
      ("d" "Diff worktree"   magit-diff-working-tree)
      ("D" "Diff"            magit-diff)
      ("f" "Fetching"        magit-key-mode-popup-fetching)
      ("F" "Pulling"         magit-key-mode-popup-pulling)
      ("g" "Refresh Buffers" magit-refresh-all)
      ("l" "Logging"         magit-key-mode-popup-logging)
      ("m" "Merging"         magit-key-mode-popup-merging)
      ("M" "Remoting"        magit-key-mode-popup-remoting)
      ("P" "Pushing"         magit-key-mode-popup-pushing)
      ("o" "Submoduling"     magit-key-mode-popup-submodule)
      ("r" "Rewriting"       magit-key-mode-popup-rewriting)
      ("R" "Rebasing"        magit-rebase-step)
      ("s" "Show Status"     magit-status)
      ("S" "Stage all"       magit-stage-all)
      ("t" "Tagging"         magit-key-mode-popup-tagging)
      ("U" "Unstage all"     magit-unstage-all)
      ("v" "Show Commit"     magit-show-commit)
      ("V" "Show File"       magit-show)
      ("w" "Wazzup"          magit-wazzup)
      ("X" "Reset worktree"  magit-reset-working-tree)
      ("y" "Cherry"          magit-cherry)
      ("z" "Stashing"        magit-key-mode-popup-stashing)
      ("!" "Running"         magit-key-mode-popup-running)
      ("$" "Show Process"    magit-process)))

    (logging
     (man-page "git-log")
     (actions
      ("l" "Short" magit-log)
      ("L" "Long" magit-log-long)
      ("h" "Head Reflog" magit-reflog-head)
      ("f" "File log" magit-file-log)
      ("rl" "Ranged short" magit-log-ranged)
      ("rL" "Ranged long" magit-log-long-ranged)
      ("rh" "Reflog" magit-reflog))
     (switches
      ("-m" "Only merge commits" "--merges")
      ("-s" "No merge commits" "--no-merges")
      ("-do" "Date Order" "--date-order")
      ("-f" "First parent" "--first-parent")
      ("-i" "Case insensitive patterns" "-i")
      ("-pr" "Pickaxe regex" "--pickaxe-regex")
      ("-g" "Show Graph" "--graph")
      ("-n" "Name only" "--name-only")
      ("-am" "All match" "--all-match")
      ("-al" "All" "--all"))
     (arguments
      ("=r" "Relative" "--relative=" read-directory-name)
      ("=c" "Committer" "--committer=" read-from-minibuffer)
      ("=>" "Since" "--since=" read-from-minibuffer)
      ("=<" "Before" "--before=" read-from-minibuffer)
      ("=a" "Author" "--author=" read-from-minibuffer)
      ("=g" "Grep messages" "--grep=" read-from-minibuffer)
      ("=G" "Grep patches" "-G" read-from-minibuffer)
      ("=L" "Trace evolution of line range [long log only]"
       "-L" magit-read-file-trace)
      ("=s" "Pickaxe search" "-S" read-from-minibuffer)
      ("=b" "Branches" "--branches=" read-from-minibuffer)
      ("=R" "Remotes" "--remotes=" read-from-minibuffer)))

    (running
     (actions
      ("!" "Git Subcommand (from root)" magit-git-command-topdir)
      (":" "Git Subcommand (from pwd)" magit-git-command)
      ("g" "Git Gui" magit-run-git-gui)
      ("k" "Gitk" magit-run-gitk)))

    (fetching
     (man-page "git-fetch")
     (actions
      ("f" "Current" magit-fetch-current)
      ("a" "All" magit-remote-update)
      ("o" "Other" magit-fetch))
     (switches
      ("-p" "Prune" "--prune")))

    (pushing
     (man-page "git-push")
     (actions
      ("P" "Push" magit-push)
      ("t" "Push tags" magit-push-tags))
     (switches
      ("-f" "Force" "--force")
      ("-d" "Dry run" "-n")
      ("-u" "Set upstream" "-u")))

    (pulling
     (man-page "git-pull")
     (actions
      ("F" "Pull" magit-pull))
     (switches
      ("-f" "Force" "--force")
      ("-r" "Rebase" "--rebase")))

    (branching
     (man-page "git-branch")
     (actions
      ("v" "Branch manager" magit-branch-manager)
      ("b" "Checkout" magit-checkout)
      ("c" "Create" magit-create-branch)
      ("r" "Rename" magit-rename-branch)
      ("k" "Delete" magit-delete-branch))
     (switches
      ("-t" "Set upstream configuration" "--track")
      ("-m" "Merged to HEAD" "--merged")
      ("-M" "Merged to master" "--merged=master")
      ("-n" "Not merged to HEAD" "--no-merged")
      ("-N" "Not merged to master" "--no-merged=master"))
     (arguments
      ("=c" "Contains" "--contains=" magit-read-rev-with-default)
      ("=m" "Merged" "--merged=" magit-read-rev-with-default)
      ("=n" "Not merged" "--no-merged=" magit-read-rev-with-default)))

    (remoting
     (man-page "git-remote")
     (actions
      ("v" "Remote manager" magit-branch-manager)
      ("a" "Add" magit-add-remote)
      ("r" "Rename" magit-rename-remote)
      ("k" "Remove" magit-remove-remote)))

    (tagging
     (man-page "git-tag")
     (actions
      ("t" "Create" magit-tag)
      ("k" "Delete" magit-delete-tag))
     (switches
      ("-a" "Annotate" "--annotate")
      ("-f" "Force" "--force")
      ("-s" "Sign" "--sign")))

    (stashing
     (man-page "git-stash")
     (actions
      ("v" "View" magit-diff-stash)
      ("z" "Save" magit-stash)
      ("s" "Snapshot" magit-stash-snapshot)
      ("a" "Apply" magit-stash-apply)
      ("p" "Pop" magit-stash-pop)
      ("k" "Drop" magit-stash-drop))
     (switches
      ("-k" "Keep index" "--keep-index")
      ("-u" "Include untracked files" "--include-untracked")
      ("-a" "Include all files" "--all")))

    (committing
     (man-page "git-commit")
     (actions
      ("c" "Commit" magit-commit)
      ("a" "Amend"  magit-commit-amend)
      ("e" "Extend" magit-commit-extend)
      ("r" "Reword" magit-commit-reword)
      ("f" "Fixup"  magit-commit-fixup)
      ("s" "Squash" magit-commit-squash))
     (switches
      ("-a" "Stage all modified and deleted files" "--all")
      ("-e" "Allow empty commit" "--allow-empty")
      ("-v" "Show diff of changes to be committed" "--verbose")
      ("-n" "Bypass git hooks" "--no-verify")
      ("-s" "Add Signed-off-by line" "--signoff")
      ("-R" "Claim authorship and reset author date" "--reset-author"))
     (arguments
      ("=A" "Override the author" "--author=" read-from-minibuffer)
      ("=S" "Sign using gpg" "--gpg-sign=" magit-read-gpg-secret-key)))

    (merging
     (man-page "git-merge")
     (actions
      ("m" "Merge" magit-merge)
      ("A" "Abort" magit-merge-abort))
     (switches
      ("-ff" "Fast-forward only" "--ff-only")
      ("-nf" "No fast-forward" "--no-ff")
      ("-sq" "Squash" "--squash"))
     (arguments
      ("-st" "Strategy" "--strategy=" read-from-minibuffer)))

    (rewriting
     (actions
      ("b" "Begin" magit-rewrite-start)
      ("s" "Stop" magit-rewrite-stop)
      ("a" "Abort" magit-rewrite-abort)
      ("f" "Finish" magit-rewrite-finish)
      ("d" "Diff pending" magit-rewrite-diff-pending)
      ("*" "Set unused" magit-rewrite-set-unused)
      ("." "Set used" magit-rewrite-set-used)))

    (apply-mailbox
     (man-page "git-am")
     (actions
      ("J" "Apply Mailbox" magit-apply-mailbox))
     (switches
      ("-s" "add a Signed-off-by line to the commit message" "--signoff")
      ("-3" "allow fall back on 3way merging if needed" "--3way")
      ("-k" "pass -k flag to git-mailinfo" "--keep")
      ("-c" "strip everything before a scissors line" "--scissors")
      ("-p" "pass it through git-apply" "-p")
      ("-r" "override error message when patch failure occurs" "--resolvemsg")
      ("-d" "lie about committer date" "--committer-date-is-author-date")
      ("-D" "use current timestamp for author date" "--ignore-date")
      ("-b" "pass -b flag to git-mailinfo" "--keep-non-patch"))
     (arguments
      ("=p" "format the patch(es) are in" "--patch-format=" read-from-minibuffer)))

    (submodule
     (man-page "git-submodule")
     (actions
      ("u" "Update" magit-submodule-update)
      ("b" "Both update and init" magit-submodule-update-init)
      ("i" "Init" magit-submodule-init)
      ("s" "Sync" magit-submodule-sync)))

    (bisecting
     (man-page "git-bisect")
     (actions
      ("b" "Bad" magit-bisect-bad)
      ("g" "Good" magit-bisect-good)
      ("k" "Skip" magit-bisect-skip)
      ("r" "Reset" magit-bisect-reset)
      ("s" "Start" magit-bisect-start)
      ("u" "Run" magit-bisect-run)))

    (diff-options
     (actions
      ("s" "Set" magit-set-diff-options)
      ("d" "Set default" magit-set-default-diff-options)
      ("c" "Save default" magit-save-default-diff-options)
      ("r" "Reset to default" magit-reset-diff-options)
      ("h" "Toggle Hunk Refinement" magit-diff-toggle-refine-hunk))
     (switches
      ("-m" "Show smallest possible diff" "--minimal")
      ("-p" "Use patience diff algorithm" "--patience")
      ("-h" "Use histogram diff algorithm" "--histogram")
      ("-b" "Ignore whitespace changes" "--ignore-space-change")
      ("-w" "Ignore all whitespace" "--ignore-all-space")
      ("-W" "Show surrounding functions" "--function-context"))
     ))
  "Holds the key, help, function mapping for the log-mode.
If you modify this make sure you reset `magit-key-mode-keymaps'
to nil.")

(defun magit-key-mode-delete-group (group)
  "Delete a group from `magit-key-mode-keymaps'."
  (let ((items (assoc group magit-key-mode-groups)))
    (when items
      ;; reset the cache
      (setq magit-key-mode-keymaps nil)
      ;; delete the whole group
      (setq magit-key-mode-groups
            (delq items magit-key-mode-groups))
      ;; unbind the defun
      (magit-key-mode-de-generate group))
    magit-key-mode-groups))

(defun magit-key-mode-add-group (group)
  "Add a new group to `magit-key-mode-keymaps'.
If there already is a group of that name then this will
completely remove it and put in its place an empty one of the
same name."
  (when (assoc group magit-key-mode-groups)
    (magit-key-mode-delete-group group))
  (setq magit-key-mode-groups
        (cons (list group (list 'actions) (list 'switches) (list 'arguments))
              magit-key-mode-groups)))

(defun magit-key-mode-key-defined-p (for-group key)
  "Return t if KEY is defined as any option within FOR-GROUP.
The option may be a switch, argument or action."
  (catch 'result
    (let ((options (magit-key-mode-options-for-group for-group)))
      (dolist (type '(actions switches arguments))
        (when (assoc key (assoc type options))
          (throw 'result t))))))

(defun magit-key-mode-update-group (for-group thing &rest args)
  "Abstraction for setting values in `magit-key-mode-keymaps'."
  (let* ((options (magit-key-mode-options-for-group for-group))
         (things (assoc thing options))
         (key (car args)))
    (if (cdr things)
        (if (magit-key-mode-key-defined-p for-group key)
            (error "%s is already defined in the %s group." key for-group)
          (setcdr (cdr things) (cons args (cddr things))))
      (setcdr things (list args)))
    (setq magit-key-mode-keymaps nil)
    things))

(defun magit-key-mode-insert-argument (for-group key desc arg read-func)
  "Add a new binding KEY in FOR-GROUP which will use READ-FUNC
to receive input to apply to argument ARG git is run.  DESC should
be a brief description of the binding."
  (magit-key-mode-update-group for-group 'arguments key desc arg read-func))

(defun magit-key-mode-insert-switch (for-group key desc switch)
  "Add a new binding KEY in FOR-GROUP which will add SWITCH to git's
command line when it runs.  DESC should be a brief description of
the binding."
  (magit-key-mode-update-group for-group 'switches key desc switch))

(defun magit-key-mode-insert-action (for-group key desc func)
  "Add a new binding KEY in FOR-GROUP which will run command FUNC.
DESC should be a brief description of the binding."
  (magit-key-mode-update-group for-group 'actions key desc func))

(defun magit-key-mode-options-for-group (for-group)
  "Retrieve the options for the group FOR-GROUP.
This includes switches, commands and arguments."
  (or (cdr (assoc for-group magit-key-mode-groups))
      (error "Unknown group '%s'" for-group)))

;;; Commands

(defun magit-key-mode-help (for-group)
  "Provide help for a key within FOR-GROUP.
The user is prompted for the key."
  (let* ((opts (magit-key-mode-options-for-group for-group))
         (man-page (cadr (assoc 'man-page opts)))
         (seq (read-key-sequence
               (format "Enter command prefix%s: "
                       (if man-page
                           (format ", `?' for man `%s'" man-page)
                         ""))))
         (actions (cdr (assoc 'actions opts))))
    (cond
      ;; if it is an action popup the help for the to-be-run function
      ((assoc seq actions) (describe-function (nth 2 (assoc seq actions))))
      ;; if there is "?" show a man page if there is one
      ((equal seq "?")
       (if man-page
           (man man-page)
         (error "No man page associated with `%s'" for-group)))
      (t (error "No help associated with `%s'" seq)))))

(defun magit-key-mode-exec-at-point ()
  "Run action/args/option at point."
  (interactive)
  (let ((key (or (get-text-property (point) 'key-group-executor)
                 (error "Nothing at point to do."))))
    (call-interactively (lookup-key (current-local-map) key))))

(defun magit-key-mode-jump-to-next-exec ()
  "Jump to the next action/args/option point."
  (interactive)
  (let* ((oldp (point))
         (old  (get-text-property oldp 'key-group-executor))
         (p    (if (= oldp (point-max)) (point-min) (1+ oldp))))
    (while (let ((new (get-text-property p 'key-group-executor)))
             (and (not (= p oldp)) (or (not new) (eq new old))))
      (setq p (if (= p (point-max)) (point-min) (1+ p))))
    (goto-char p)
    (skip-chars-forward " ")))

;;; Keymaps

(defvar magit-key-mode-keymaps nil
  "This will be filled lazily with proper keymaps.
These keymaps are created using `define-key' as they're requested.")

(defun magit-key-mode-build-keymap (for-group)
  "Construct a normal looking keymap for the key mode to use.
Put it in `magit-key-mode-keymaps' for fast lookup."
  (let* ((options (magit-key-mode-options-for-group for-group))
         (actions (cdr (assoc 'actions options)))
         (switches (cdr (assoc 'switches options)))
         (arguments (cdr (assoc 'arguments options)))
         (map (make-sparse-keymap)))
    (suppress-keymap map 'nodigits)
    ;; ret dwim
    (define-key map (kbd "RET") 'magit-key-mode-exec-at-point)
    ;; tab jumps to the next "button"
    (define-key map (kbd "TAB") 'magit-key-mode-jump-to-next-exec)

    ;; all maps should `quit' with `C-g' or `q'
    (define-key map (kbd "C-g") `(lambda ()
                                   (interactive)
                                   (magit-key-mode-command nil)))
    (define-key map (kbd "q")   `(lambda ()
                                   (interactive)
                                   (magit-key-mode-command nil)))
    ;; run help
    (define-key map (kbd "?") `(lambda ()
                                 (interactive)
                                 (magit-key-mode-help ',for-group)))

    (let ((defkey (lambda (k action)
                    (when (and (lookup-key map (car k))
                               (not (numberp (lookup-key map (car k)))))
                      (message "Warning: overriding binding for `%s' in %S"
                               (car k) for-group)
                      (ding)
                      (sit-for 2))
                    (define-key map (car k)
                      `(lambda () (interactive) ,action)))))
      (dolist (k actions)
        (funcall defkey k `(magit-key-mode-command ',(nth 2 k))))
      (dolist (k switches)
        (funcall defkey k `(magit-key-mode-toggle-option ',for-group ,(nth 2 k))))
      (dolist (k arguments)
        (funcall defkey k `(magit-key-mode-add-argument
                            ',for-group ,(nth 2 k) ',(nth 3 k)))))

    (push (cons for-group map) magit-key-mode-keymaps)
    map))

;;; Toggling and Running

(defvar magit-key-mode-prefix nil
  "Prefix argument to the command that brought up the key-mode window.
For internal use.  Used by the command that's eventually invoked.")

(defvar magit-key-mode-current-args nil
  "A hash-table of current argument set.
These will eventually make it to the git command-line.")

(defvar magit-key-mode-current-options nil
  "Current option set.
These will eventually make it to the git command-line.")

(defvar magit-custom-options nil
  "List of custom options to pass to Git.
Do not customize this (used in the `magit-key-mode' implementation).")

(defun magit-key-mode-command (func)
  (let ((current-prefix-arg (or current-prefix-arg magit-key-mode-prefix))
        (magit-custom-options magit-key-mode-current-options))
    (maphash (lambda (k v)
               (push (concat k v) magit-custom-options))
             magit-key-mode-current-args)
    (set-window-configuration magit-pre-key-mode-window-conf)
    (kill-buffer magit-key-mode-last-buffer)
    (when func
      (setq this-command func)
      (call-interactively this-command))))

(defun magit-key-mode-add-argument (for-group arg-name input-func)
  (let ((input (funcall input-func (concat arg-name ": "))))
    (puthash arg-name input magit-key-mode-current-args)
    (magit-key-mode-redraw for-group)))

(defun magit-key-mode-toggle-option (for-group option-name)
  "Toggles the appearance of OPTION-NAME in `magit-key-mode-current-options'."
  (if (member option-name magit-key-mode-current-options)
      (setq magit-key-mode-current-options
            (delete option-name magit-key-mode-current-options))
    (add-to-list 'magit-key-mode-current-options option-name))
  (magit-key-mode-redraw for-group))

;;; Mode

(defvar magit-key-mode-buf-name "*magit-key: %s*"
  "Format string to create the name of the magit-key buffer.")

(defvar magit-key-mode-last-buffer nil
  "Store the last magit-key buffer used.")

(defvar magit-pre-key-mode-window-conf nil
  "Will hold the pre-menu configuration of magit.")

(defun magit-key-mode (for-group &optional original-opts)
  "Mode for magit key selection.
All commands, switches and options can be toggled/actioned with
the key combination highlighted before the description."
  (interactive)
  ;; save the window config to restore it as was (no need to make this
  ;; buffer local)
  (setq magit-pre-key-mode-window-conf
        (current-window-configuration))
  ;; setup the mode, draw the buffer
  (let ((buf (get-buffer-create (format magit-key-mode-buf-name
                                        (symbol-name for-group)))))
    (setq magit-key-mode-last-buffer buf)
    (split-window-vertically)
    (other-window 1)
    (switch-to-buffer buf)
    (kill-all-local-variables)
    (set (make-local-variable 'scroll-margin) 0)
    (set (make-local-variable
          'magit-key-mode-current-options)
         original-opts)
    (set (make-local-variable
          'magit-key-mode-current-args)
         (make-hash-table))
    (set (make-local-variable 'magit-key-mode-prefix) current-prefix-arg)
    (magit-key-mode-redraw for-group))
  (when magit-key-mode-show-usage
    (message (concat "Type a prefix key to toggle it. "
                     "Run 'actions' with their prefixes. "
                     "'?' for more help."))))

(defun magit-key-mode-get-key-map (for-group)
  "Get or build the keymap for FOR-GROUP."
  (or (cdr (assoc for-group magit-key-mode-keymaps))
      (magit-key-mode-build-keymap for-group)))

(defun magit-key-mode-redraw (for-group)
  "(re)draw the magit key buffer."
  (let ((buffer-read-only nil)
        (current-exec (get-text-property (point) 'key-group-executor))
        (new-exec-pos)
        (old-point (point))
        (is-first (zerop (buffer-size)))
        (actions-p nil))
    (erase-buffer)
    (make-local-variable 'font-lock-defaults)
    (use-local-map (magit-key-mode-get-key-map for-group))
    (setq actions-p (magit-key-mode-draw for-group))
    (delete-trailing-whitespace)
    (setq mode-name "magit-key-mode" major-mode 'magit-key-mode)
    (when current-exec
      (setq new-exec-pos
            (cdr (assoc current-exec
                        (magit-key-mode-build-exec-point-alist)))))
    (cond ((and is-first actions-p)
           (goto-char actions-p)
           (magit-key-mode-jump-to-next-exec))
          (new-exec-pos
           (goto-char new-exec-pos)
           (skip-chars-forward " "))
          (t
           (goto-char old-point))))
  (setq buffer-read-only t)
  (fit-window-to-buffer))

(defun magit-key-mode-build-exec-point-alist ()
  (save-excursion
    (goto-char (point-min))
    (let* ((exec (get-text-property (point) 'key-group-executor))
           (exec-alist (and exec `((,exec . ,(point))))))
      (cl-do nil ((eobp) (nreverse exec-alist))
        (when (not (eq exec (get-text-property (point) 'key-group-executor)))
          (setq exec (get-text-property (point) 'key-group-executor))
          (when exec (push (cons exec (point)) exec-alist)))
        (forward-char)))))

;;; Draw Buffer

(defun magit-key-mode-draw-header (header)
  "Draw a header with the correct face."
  (insert (propertize header 'face 'magit-key-mode-header-face) "\n"))

(defvar magit-key-mode-args-in-cols nil
  "When true, draw arguments in columns as with switches and options.")

(defun magit-key-mode-draw-args (args)
  "Draw the args part of the menu."
  (magit-key-mode-draw-buttons
   "Args"
   args
   (lambda (x)
     (format "(%s) %s"
             (nth 2 x)
             (propertize (gethash (nth 2 x) magit-key-mode-current-args "")
                         'face 'magit-key-mode-args-face)))
   (not magit-key-mode-args-in-cols)))

(defun magit-key-mode-draw-switches (switches)
  "Draw the switches part of the menu."
  (magit-key-mode-draw-buttons
   "Switches"
   switches
   (lambda (x)
     (format "(%s)" (let ((s (nth 2 x)))
                      (if (member s magit-key-mode-current-options)
                          (propertize s 'face 'magit-key-mode-switch-face)
                        s))))))

(defun magit-key-mode-draw-actions (actions)
  "Draw the actions part of the menu."
  (magit-key-mode-draw-buttons "Actions" actions nil))

(defun magit-key-mode-draw-buttons (section xs maker
                                    &optional one-col-each)
  (when xs
    (magit-key-mode-draw-header section)
    (magit-key-mode-draw-in-cols
     (mapcar (lambda (x)
               (let* ((head (propertize (car x) 'face 'magit-key-mode-button-face))
                      (desc (nth 1 x))
                      (more (and maker (funcall maker x)))
                      (text (format " %s: %s%s%s"
                                    head desc (if more " " "") (or more ""))))
                 (propertize text 'key-group-executor (car x))))
             xs)
     one-col-each)))

(defun magit-key-mode-draw-in-cols (strings one-col-each)
  "Given a list of strings, print in columns (using `insert').
If ONE-COL-EACH is true then don't columify, but rather, draw
each item on one line."
  (let ((longest-act (apply 'max (mapcar 'length strings))))
    (while strings
      (let ((str (car strings)))
        (let ((padding (make-string (- (+ longest-act 3) (length str)) ? )))
          (insert str)
          (if (or one-col-each
                  (and (> (+ (length padding) ;
                             (current-column)
                             longest-act)
                          (window-width))
                       (cdr strings)))
              (insert "\n")
            (insert padding))))
      (setq strings (cdr strings))))
  (insert "\n"))

(defun magit-key-mode-draw (for-group)
  "Draw actions, switches and parameters.
Return the point before the actions part, if any, nil otherwise."
  (let* ((options (magit-key-mode-options-for-group for-group))
         (switches (cdr (assoc 'switches options)))
         (arguments (cdr (assoc 'arguments options)))
         (actions (cdr (assoc 'actions options)))
         (p nil))
    (magit-key-mode-draw-switches switches)
    (magit-key-mode-draw-args arguments)
    (when actions (setq p (point-marker)))
    (magit-key-mode-draw-actions actions)
    (insert "\n")
    p))

;;; Generate Groups

(defun magit-key-mode-de-generate (group)
  "Unbind the function for GROUP."
  (fmakunbound
   (intern (concat "magit-key-mode-popup-" (symbol-name group)))))

(defun magit-key-mode-generate (group)
  "Generate the key-group menu for GROUP."
  (let ((opts (magit-key-mode-options-for-group group)))
    (eval
     `(defun ,(intern (concat "magit-key-mode-popup-" (symbol-name group))) nil
        ,(concat "Key menu for " (symbol-name group))
        (interactive)
        (magit-key-mode
         (quote ,group)
         ;; As a tempory kludge it is okay to do this here.
         ,(cl-case group
            (logging
             '(list "--graph"))
            (diff-options
             '(when (local-variable-p 'magit-diff-options)
                magit-diff-options))))))))

;; create the interactive functions for the key mode popups (which are
;; applied in the top-level key maps)
(mapc (lambda (g)
        (magit-key-mode-generate (car g)))
      magit-key-mode-groups)

;;;###autoload (mapc (lambda (g) (eval `(autoload ',(intern (concat "magit-key-mode-popup-" (symbol-name (car g)))) "magit-key-mode" ,(concat "Key menu for " (symbol-name (car g))) t))) magit-key-mode-groups)

(provide 'magit-key-mode)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; magit-key-mode.el ends here