(if (>= emacs-major-version 24)
(progn
(add-to-list 'load-path "~/.emacs.d/elpa")
- (add-to-list 'load-path "~/.emacs.d/elpa/popup-20151222.1339")
+ (add-to-list 'load-path "~/.emacs.d/elpa/popup-20160709.1429")
(require 'package)
(package-initialize)
(add-to-list 'package-archives '("melpa" . "http://melpa.org/packages/"))
--- /dev/null
+This is the file .../info/dir, which contains the
+topmost node of the Info hierarchy, called (dir)Top.
+The first time you invoke Info you start off looking at this node.
+\1f
+File: dir, Node: Top This is the top of the INFO tree
+
+ This (the Directory node) gives a menu of major topics.
+ Typing "q" exits, "H" lists all Info commands, "d" returns here,
+ "h" gives a primer for first-timers,
+ "mEmacs<Return>" visits the Emacs manual, etc.
+
+ In Emacs, you can click mouse button 2 on a menu item or cross reference
+ to select it.
+
+* Menu:
+
+Emacs
+* Magit-Popup: (magit-popup). Infix arguments with feedback.
--- /dev/null
+;;; magit-popup-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+
+(add-to-list 'load-path (directory-file-name
+ (or (file-name-directory #$) (car load-path))))
+
+\f
+;;;### (autoloads nil "magit-popup" "magit-popup.el" (0 0 0 0))
+;;; Generated autoloads from magit-popup.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "magit-popup" '("magit-")))
+
+;;;***
+\f
+;;;### (autoloads nil nil ("magit-popup-pkg.el") (0 0 0 0))
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; magit-popup-autoloads.el ends here
--- /dev/null
+(define-package "magit-popup" "20181003.921" "Define prefix-infix-suffix command combos"
+ '((emacs "24.4")
+ (async "1.9.2")
+ (dash "2.13.0"))
+ :keywords
+ '("bindings")
+ :authors
+ '(("Jonas Bernoulli" . "jonasNOSPAMbernoul.li"))
+ :maintainer
+ '("Jonas Bernoulli" . "jonasNOSPAMbernoul.li")
+ :url "https://github.com/magit/magit-popup")
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
--- /dev/null
+;;; magit-popup.el --- Define prefix-infix-suffix command combos -*- lexical-binding: t -*-
+
+;; Copyright (C) 2010-2018 The Magit Project Contributors
+;;
+;; You should have received a copy of the AUTHORS.md file which
+;; lists all contributors. If not, see http://magit.vc/authors.
+
+;; This library was inspired by and replaces library `magit-key-mode',
+;; which was written by Phil Jackson <philNOSPAMshellarchive.co.uk> and is
+;; distributed under the GNU General Public License version 3 or later.
+
+;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+;; Package-Requires: ((emacs "24.4") (async "1.9.2") (dash "2.13.0"))
+;; Keywords: bindings
+;; Homepage: https://github.com/magit/magit-popup
+
+;; Magit-Popup 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-Popup 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-Popup. If not, see http://www.gnu.org/licenses.
+
+;;; Commentary:
+
+;; This package implements a generic interface for toggling switches
+;; and setting options and then invoking an Emacs command which does
+;; something with these arguments. The prototypical use is for the
+;; command to call an external process, passing on the arguments as
+;; command line arguments. But this is only one of many possible
+;; uses (though the one this library is optimized for).
+
+;; With the Emacs concept of "prefix arguments" in mind this could be
+;; described as "infix arguments with feedback in a buffer".
+
+;; Commands that set the prefix argument for the subsequent command do
+;; not limit what that next command could be. But entering a command
+;; console popup does limit the selection to the commands defined for
+;; that popup, and so we use the term "infix" instead of "prefix".
+
+;;; Code:
+
+(require 'button)
+(require 'cl-lib)
+(require 'dash)
+(require 'format-spec)
+(eval-when-compile (require 'subr-x))
+
+(and (require 'async-bytecomp nil t)
+ (cl-intersection '(all magit)
+ (bound-and-true-p async-bytecomp-allowed-packages))
+ (fboundp 'async-bytecomp-package-mode)
+ (async-bytecomp-package-mode 1))
+
+(declare-function info 'info)
+(declare-function Man-find-section 'man)
+(declare-function Man-next-section 'man)
+
+;; For branch actions.
+(declare-function magit-branch-set-face 'magit-git)
+
+;;; Settings
+;;;; Custom Groups
+
+(defgroup magit-popup nil
+ "Infix arguments with a popup as feedback."
+ :link '(info-link "(magit-popup)")
+ :group 'bindings)
+
+(defgroup magit-popup-faces nil
+ "Faces used by Magit-Popup."
+ :group 'magit-popup)
+
+;;;; Custom Options
+
+(defcustom magit-popup-display-buffer-action '((display-buffer-below-selected))
+ "The action used to display a popup buffer.
+
+Popup buffers are displayed using `display-buffer' with the value
+of this option as ACTION argument. You can also set this to nil
+and instead add an entry to `display-buffer-alist'."
+ :package-version '(magit-popup . "2.4.0")
+ :group 'magit-popup
+ :type 'sexp)
+
+(defcustom magit-popup-manpage-package
+ (if (memq system-type '(windows-nt ms-dos)) 'woman 'man)
+ "The package used to display manpages.
+One of `man' or `woman'."
+ :group 'magit-popup
+ :type '(choice (const man) (const woman)))
+
+(defcustom magit-popup-show-help-echo t
+ "Show usage information in the echo area."
+ :group 'magit-popup
+ :type 'boolean)
+
+(defcustom magit-popup-show-common-commands nil
+ "Whether to initially show section with commands common to all popups.
+This section can also be toggled temporarily using \
+\\<magit-popup-mode-map>\\[magit-popup-toggle-show-common-commands]."
+ :package-version '(magit-popup . "2.9.0")
+ :group 'magit-popup
+ :type 'boolean)
+
+(defcustom magit-popup-use-prefix-argument 'default
+ "Control how prefix arguments affect infix argument popups.
+
+This option controls the effect that the use of a prefix argument
+before entering a popup has.
+
+`default' With a prefix argument directly invoke the popup's
+ default action (an Emacs command), instead of bringing
+ up the popup.
+
+`popup' With a prefix argument bring up the popup, otherwise
+ directly invoke the popup's default action.
+
+`nil' Ignore prefix arguments."
+ :group 'magit-popup
+ :type '(choice
+ (const :tag "Call default action instead of showing popup" default)
+ (const :tag "Show popup instead of calling default action" popup)
+ (const :tag "Ignore prefix argument" nil)))
+
+;;;; Custom Faces
+
+(defface magit-popup-heading
+ '((t :inherit font-lock-keyword-face))
+ "Face for key mode header lines."
+ :group 'magit-popup-faces)
+
+(defface magit-popup-key
+ '((t :inherit font-lock-builtin-face))
+ "Face for key mode buttons."
+ :group 'magit-popup-faces)
+
+(defface magit-popup-argument
+ '((t :inherit font-lock-warning-face))
+ "Face used to display enabled arguments in popups."
+ :group 'magit-popup-faces)
+
+(defface magit-popup-disabled-argument
+ '((t :inherit shadow))
+ "Face used to display disabled arguments in popups."
+ :group 'magit-popup-faces)
+
+(defface magit-popup-option-value
+ '((t :inherit font-lock-string-face))
+ "Face used to display option values in popups."
+ :group 'magit-popup-faces)
+
+;;;; Keymap
+
+(defvar magit-popup-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [remap self-insert-command] 'magit-invoke-popup-action)
+ (define-key map (kbd "- <t>") 'magit-invoke-popup-switch)
+ (define-key map (kbd "= <t>") 'magit-invoke-popup-option)
+ (define-key map (kbd "C-g") 'magit-popup-quit)
+ (define-key map (kbd "?") 'magit-popup-help)
+ (define-key map (kbd "C-h k") 'magit-popup-help)
+ (define-key map (kbd "C-h i") 'magit-popup-info)
+ (define-key map (kbd "C-t") 'magit-popup-toggle-show-common-commands)
+ (define-key map (kbd "C-c C-c") 'magit-popup-set-default-arguments)
+ (define-key map (kbd "C-x C-s") 'magit-popup-save-default-arguments)
+ (cond ((featurep 'jkl)
+ (define-key map (kbd "C-p") 'universal-argument)
+ (define-key map [return] 'push-button)
+ (define-key map (kbd "C-i") 'backward-button)
+ (define-key map (kbd "C-k") 'forward-button))
+ (t
+ (define-key map (kbd "C-m") 'push-button)
+ (define-key map (kbd "DEL") 'backward-button)
+ (define-key map (kbd "C-p") 'backward-button)
+ (define-key map (kbd "C-i") 'forward-button)
+ (define-key map (kbd "C-n") 'forward-button)))
+ map)
+ "Keymap for `magit-popup-mode'.
+
+\\<magit-popup-mode-map>\
+This keymap contains bindings common to all popups. A section
+listing these commands can be shown or hidden using \
+\\[magit-popup-toggle-show-common-commands].
+
+The prefix used to toggle any switch can be changed by binding
+another key to `magit-invoke-popup-switch'. Likewise binding
+another key to `magit-invoke-popup-option' changes the prefixed
+used to set any option. The two prefixes have to be different.
+If you change these bindings, you should also change the `prefix'
+property of the button types `magit-popup-switch-button' and
+`magit-popup-option-button'.
+
+If you change any other binding, then you might have to also edit
+`magit-popup-common-commands' for things to align correctly in
+the section listing these commands.
+
+Never bind an alphabetic character in this keymap or you might
+make it impossible to invoke certain actions.")
+
+(defvar magit-popup-common-commands
+ '(("Set defaults" magit-popup-set-default-arguments)
+ ("View popup manual" magit-popup-info)
+ ("Toggle this section" magit-popup-toggle-show-common-commands)
+ ("Save defaults" magit-popup-save-default-arguments)
+ (" Popup help prefix" magit-popup-help)
+ ("Abort" magit-popup-quit)))
+
+;;;; Buttons
+
+(define-button-type 'magit-popup-button
+ 'face nil
+ 'action (lambda (button)
+ (funcall (button-get button 'function)
+ (button-get button 'event))))
+
+(define-button-type 'magit-popup-switch-button
+ 'supertype 'magit-popup-button
+ 'function 'magit-invoke-popup-switch
+ 'property :switches
+ 'heading "Switches\n"
+ 'formatter 'magit-popup-format-argument-button
+ 'format " %k %d (%a)"
+ 'prefix ?-
+ 'maxcols 1)
+
+(define-button-type 'magit-popup-option-button
+ 'supertype 'magit-popup-button
+ 'function 'magit-invoke-popup-option
+ 'property :options
+ 'heading "Options\n"
+ 'formatter 'magit-popup-format-argument-button
+ 'format " %k %d (%a%v)"
+ 'prefix ?=
+ 'maxcols 1)
+
+(define-button-type 'magit-popup-variable-button
+ 'supertype 'magit-popup-button
+ 'function 'magit-invoke-popup-action
+ 'property :variables
+ 'heading "Variables\n"
+ 'formatter 'magit-popup-format-variable-button
+ 'format " %k %d"
+ 'prefix nil
+ 'maxcols 1)
+
+(define-button-type 'magit-popup-action-button
+ 'supertype 'magit-popup-button
+ 'function 'magit-invoke-popup-action
+ 'property :actions
+ 'heading "Actions\n"
+ 'formatter 'magit-popup-format-action-button
+ 'format " %k %d"
+ 'prefix nil
+ 'maxcols :max-action-columns)
+
+(define-button-type 'magit-popup-command-button
+ 'supertype 'magit-popup-action-button
+ 'formatter 'magit-popup-format-command-button
+ 'action (lambda (button)
+ (let ((command (button-get button 'function)))
+ (unless (eq command 'push-button)
+ (call-interactively command)))))
+
+(define-button-type 'magit-popup-internal-command-button
+ 'supertype 'magit-popup-command-button
+ 'heading "Common Commands\n"
+ 'maxcols 3)
+
+;;; Events
+
+(defvar-local magit-this-popup nil
+ "The popup which is currently active.
+This is intended for internal use only.
+Don't confuse this with `magit-current-popup'.")
+
+(defvar-local magit-this-popup-events nil
+ "The events known to the active popup.
+This is intended for internal use only.
+Don't confuse this with `magit-current-popup-args'.")
+
+(defvar-local magit-previous-popup nil)
+
+(defvar-local magit-pre-popup-buffer nil
+ "The buffer that was current before invoking the active popup.")
+
+(defun magit-popup-get (prop)
+ "While a popup is active, get the value of PROP."
+ (if (memq prop '(:switches :options :variables :actions))
+ (plist-get magit-this-popup-events prop)
+ (plist-get (symbol-value magit-this-popup) prop)))
+
+(defun magit-popup-put (prop val)
+ "While a popup is active, set the value of PROP to VAL."
+ (if (memq prop '(:switches :options :variables :actions))
+ (setq magit-this-popup-events
+ (plist-put magit-this-popup-events prop val))
+ (error "Property %s isn't supported" prop)))
+
+(defvar magit-current-popup nil
+ "The popup from which this editing command was invoked.
+
+Use this inside the `interactive' form of a popup aware command
+to determine whether it was invoked from a popup and if so from
+which popup. If the current command was invoked without the use
+of a popup, then this is nil.")
+
+(defvar magit-current-popup-action nil
+ "The popup action now being executed.")
+
+(defvar magit-current-popup-args nil
+ "The value of the popup arguments for this editing command.
+
+If the current command was invoked from a popup, then this is
+a list of strings of all the set switches and options. This
+includes arguments which are set by default not only those
+explicitly set during this invocation.
+
+When the value is nil, then that can be because no argument is
+set, or because the current command wasn't invoked from a popup;
+consult `magit-current-popup' to tell the difference.
+
+Generally it is better to use `NAME-arguments', which is created
+by `magit-define-popup', instead of this variable or the function
+by the same name, because `NAME-argument' uses the default value
+for the arguments when the editing command is invoked directly
+instead of from a popup. When the command is bound in several
+popups that might not be feasible though.")
+
+(defun magit-current-popup-args (&rest filter)
+ "Return the value of the popup arguments for this editing command.
+
+The value is the same as that of the variable by the same name
+\(which see), except that FILTER is applied. FILTER is a list
+of regexps; only arguments that match one of them are returned.
+The first element of FILTER may also be `:not' in which case
+only arguments that don't match any of the regexps are returned,
+or `:only' which doesn't change the behaviour."
+ (let ((-compare-fn (lambda (a b) (magit-popup-arg-match b a))))
+ (-filter (if (eq (car filter) :not)
+ (lambda (arg) (not (-contains-p (cdr filter) arg)))
+ (when (eq (car filter) :only)
+ (pop filter))
+ (lambda (arg) (-contains-p filter arg)))
+ magit-current-popup-args)))
+
+(defvar magit-current-pre-popup-buffer nil
+ "The buffer that was current before invoking the active popup.
+This is bound when invoking an action or variable.")
+
+(defmacro magit-with-pre-popup-buffer (&rest body)
+ "Execute the forms in BODY in the buffer that current before the popup.
+If `magit-current-pre-popup-buffer' is non-nil use that, else if
+`magit-pre-popup-buffer' is non-nil use that, otherwise (when no
+popup is involved) execute the forms in the current buffer."
+ (declare (indent 0))
+ `(--if-let (or magit-current-pre-popup-buffer magit-pre-popup-buffer)
+ (with-current-buffer it ,@body)
+ ,@body))
+
+(defun magit-popup-arg-match (pattern string)
+ (if (or (string-match-p "=$" pattern)
+ (string-match-p "^-[A-Z]$" pattern))
+ (string-match (format "^%s\\(.*\\)$" pattern) string)
+ (string-equal string pattern)))
+
+(cl-defstruct magit-popup-event key dsc arg fun use val)
+
+(defun magit-popup-event-keydsc (ev)
+ (let ((key (magit-popup-event-key ev)))
+ (key-description (if (vectorp key) key (vector key)))))
+
+(defun magit-popup-lookup (event type)
+ (--first (equal (magit-popup-event-key it) event)
+ (-filter 'magit-popup-event-p (magit-popup-get type))))
+
+(defun magit-popup-get-args ()
+ (--mapcat (when (and (magit-popup-event-p it)
+ (magit-popup-event-use it))
+ (list (format "%s%s"
+ (magit-popup-event-arg it)
+ (or (magit-popup-event-val it) ""))))
+ (append (magit-popup-get :switches)
+ (magit-popup-get :options))))
+
+(defmacro magit-popup-convert-events (def form)
+ (declare (indent 1) (debug (form form)))
+ `(--map (if (or (null it) (stringp it) (functionp it)) it ,form) ,def))
+
+(defun magit-popup-convert-switches (val def)
+ (magit-popup-convert-events def
+ (let ((a (nth 2 it)))
+ (make-magit-popup-event
+ :key (car it) :dsc (cadr it) :arg a
+ :use (and (member a val) t)
+ ;; For arguments implemented in lisp, this function's
+ ;; doc-string is used by `magit-popup-help'. That is
+ ;; the only thing it is used for.
+ :fun (and (string-prefix-p "\+\+" a) (nth 3 it))))))
+
+(defun magit-popup-convert-options (val def)
+ (magit-popup-convert-events def
+ (let* ((a (nth 2 it))
+ (r (format "^%s\\(.*\\)" a))
+ (v (--first (string-match r it) val)))
+ (make-magit-popup-event
+ :key (car it) :dsc (cadr it) :arg a
+ :use (and v t) :val (and v (match-string 1 v))
+ :fun (or (nth 3 it) 'read-from-minibuffer)))))
+
+(defun magit-popup-convert-variables (_val def)
+ (magit-popup-convert-events def
+ (make-magit-popup-event
+ :key (car it) :dsc (cadr it) :fun (nth 2 it) :arg (nth 3 it))))
+
+(defun magit-popup-convert-actions (_val def)
+ (magit-popup-convert-events def
+ (make-magit-popup-event
+ :key (car it) :dsc (cadr it) :fun (nth 2 it))))
+
+;;; Define
+
+(defmacro magit-define-popup (name doc &rest args)
+ "Define a popup command named NAME.
+
+NAME should begin with the package prefix and by convention end
+with `-popup'. That name is used for the actual command as well
+as for a variable used internally. DOC is used as the doc-string
+of that command.
+
+Also define an option and a function named `SHORTNAME-arguments',
+where SHORTNAME is NAME with the trailing `-popup' removed. The
+name of this option and this function can be overwritten using
+the optional argument OPTION, but that is rarely advisable. As a
+special case if OPTION is specified but nil, do not define this
+option and this function at all.
+
+The option `SHORTNAME-arguments' holds the default value for the
+popup arguments. It can be customized from within the popup or
+using the Custom interface.
+
+The function `SHORTNAME-arguments' is a wrapper around the
+variable `magit-current-popup-args', both of which are intended
+to be used inside the `interactive' form of commands commonly
+invoked from the popup `NAME'. When such a command is invoked
+from that popup, then the function `SHORTNAME-arguments' returns
+the value of the variable `magit-current-popup-args'; however
+when the command is invoked directly, then it returns the default
+value of the variable `SHORTNAME-arguments'.
+
+Optional argument GROUP specifies the Custom group into which the
+option is placed. If omitted, then the option is placed into some
+group the same way it is done when directly using `defcustom' and
+omitting the group, except when NAME begins with \"magit-\", in
+which case the group `magit-git-arguments' is used.
+
+Optional argument MODE is deprecated, instead use the keyword
+arguments `:setup-function' and/or `:refresh-function'. If MODE
+is non-nil, then it specifies the mode used by the popup buffer,
+instead of the default, which is `magit-popup-mode'.
+
+The remaining arguments should have the form
+
+ [KEYWORD VALUE]...
+
+The following keywords are meaningful (and by convention are
+usually specified in that order):
+
+`:actions'
+ The actions which can be invoked from the popup. VALUE is a
+ list whose members have the form (KEY DESC COMMAND), see
+ `magit-define-popup-action' for details.
+
+ Actions are regular Emacs commands, which usually have an
+ `interactive' form setup to consume the values of the popup
+ `:switches' and `:options' when invoked from the corresponding
+ popup, else when invoked as the default action or directly
+ without using the popup, the default value of the variable
+ `SHORTNAME-arguments'. This is usually done by calling the
+ function `SHORTNAME-arguments'.
+
+ Members of VALUE may also be strings and functions, assuming
+ the first member is a string or function. In that case the
+ members are split into sections and these special elements are
+ used as headings. If such an element is a function then it is
+ called with no arguments and must return either a string, which
+ is used as the heading, or nil, in which case the section is
+ not inserted.
+
+ Members of VALUE may also be nil. This should only be used
+ together with `:max-action-columns' and allows having gaps in
+ the action grid, which can help arranging actions sensibly.
+
+`:default-action'
+ The default action of the popup which is used directly instead
+ of displaying the popup buffer, when the popup is invoked with
+ a prefix argument. Also see `magit-popup-use-prefix-argument'
+ and `:use-prefix', which can be used to inverse the meaning of
+ the prefix argument.
+
+`:use-prefix'
+ Controls when to display the popup buffer and when to invoke
+ the default action (if any) directly. This overrides the
+ global default set using `magit-popup-use-prefix-argument'.
+ The value, if specified, should be one of `default' or `popup',
+ or a function that is called with no arguments and returns one
+ of these symbols.
+
+`:max-action-columns'
+ The maximum number of actions to display on a single line, a
+ number or a function that returns a number and takes the name
+ of the section currently being inserted as argument. If there
+ isn't enough room to display as many columns as specified here,
+ then fewer are used.
+
+`:switches'
+ The popup arguments which can be toggled on and off. VALUE
+ is a list whose members have the form (KEY DESC SWITCH), see
+ `magit-define-popup-switch' for details.
+
+ Members of VALUE may also be strings and functions, assuming
+ the first member is a string or function. In that case the
+ members are split into sections and these special elements are
+ used as headings. If such an element is a function then it is
+ called with no arguments and must return either a string, which
+ is used as the heading, or nil, in which case the section is
+ not inserted.
+
+`:options'
+ The popup arguments which take a value, as in \"--opt=OPTVAL\".
+ VALUE is a list whose members have the form (KEY DESC OPTION
+ READER), see `magit-define-popup-option' for details.
+
+ Members of VALUE may also be strings and functions, assuming
+ the first member is a string or function. In that case the
+ members are split into sections and these special elements are
+ used as headings. If such an element is a function then it is
+ called with no arguments and must return either a string, which
+ is used as the heading, or nil, in which case the section is
+ not inserted.
+
+`:default-arguments'
+ The default arguments, a list of switches (which are then
+ enabled by default) and options with there default values, as
+ in \"--OPT=OPTVAL\".
+
+`:variables'
+
+ Variables which can be set from the popup. VALUE is a list
+ whose members have the form (KEY DESC COMMAND FORMATTER), see
+ `magit-define-popup-variable' for details.
+
+ Members of VALUE may also be strings and functions, assuming
+ the first member is a string or function. In that case the
+ members are split into sections and these special elements are
+ used as headings. If such an element is a function then it is
+ called with no arguments and must return either a string, which
+ is used as the heading, or nil, in which case the section is
+ not inserted.
+
+ Members of VALUE may also be actions as described above for
+ `:actions'.
+
+ VALUE may also be a function that returns a list as describe
+ above.
+
+`:sequence-predicate'
+ When this function returns non-nil, then the popup uses
+ `:sequence-actions' instead of `:actions', and does not show
+ the `:switches' and `:options'.
+
+`:sequence-actions'
+ The actions which can be invoked from the popup, when
+ `:sequence-predicate' returns non-nil.
+
+`:setup-function'
+ When this function is specified, then it is used instead of
+ `magit-popup-default-setup'.
+
+`:refresh-function'
+ When this function is specified, then it is used instead of
+ calling `magit-popup-insert-section' three times with symbols
+ `magit-popup-switch-button', `magit-popup-option-button', and
+ finally `magit-popup-action-button' as argument.
+
+`:man-page'
+ The name of the manpage to be displayed when the user requests
+ help for a switch or argument.
+
+\(fn NAME DOC [GROUP [MODE [OPTION]]] :KEYWORD VALUE...)"
+ (declare (indent defun) (doc-string 2))
+ (let* ((str (symbol-name name))
+ (grp (if (keywordp (car args))
+ (and (string-prefix-p "magit-" str) ''magit-git-arguments)
+ (pop args)))
+ (mode (and (not (keywordp (car args))) (pop args)))
+ (opt (if (keywordp (car args))
+ (intern (concat (if (string-suffix-p "-popup" str)
+ (substring str 0 -6)
+ str)
+ "-arguments"))
+ (eval (pop args)))))
+ `(progn
+ (defun ,name (&optional arg) ,doc
+ (interactive "P")
+ (magit-invoke-popup ',name ,mode arg))
+ (defvar ,name
+ (list :variable ',opt ,@args))
+ (magit-define-popup-keys-deferred ',name)
+ ,@(when opt
+ `((defcustom ,opt (plist-get ,name :default-arguments)
+ ""
+ ,@(and grp (list :group grp))
+ :type '(repeat (string :tag "Argument")))
+ (defun ,opt ()
+ (if (eq magit-current-popup ',name)
+ magit-current-popup-args
+ ,opt))
+ (put ',opt 'definition-name ',name))))))
+
+(defun magit-define-popup-switch (popup key desc switch
+ &optional enable at prepend)
+ "In POPUP, define KEY as SWITCH.
+
+POPUP is a popup command defined using `magit-define-popup'.
+SWITCH is a string representing an argument that takes no value.
+KEY is a character representing the second event in the sequence
+of keystrokes used to toggle the argument. (The first event, the
+prefix, is shared among all switches, defaults to -, and can be
+changed in `magit-popup-mode-keymap').
+
+DESC is a string describing the purpose of the argument, it is
+displayed in the popup.
+
+If optional ENABLE is non-nil, then the switch is on by default.
+
+SWITCH is inserted after all other switches already defined for
+POPUP, unless optional PREPEND is non-nil, in which case it is
+placed first. If optional AT is non-nil, then it should be the
+KEY of another switch already defined for POPUP, the argument
+is then placed before or after AT, depending on PREPEND."
+ (declare (indent defun))
+ (magit-define-popup-key popup :switches key
+ (list desc switch enable) at prepend))
+
+(defun magit-define-popup-option (popup key desc option
+ &optional reader value at prepend)
+ "In POPUP, define KEY as OPTION.
+
+POPUP is a popup command defined using `magit-define-popup'.
+OPTION is a string representing an argument that takes a value.
+KEY is a character representing the second event in the sequence
+of keystrokes used to set the argument's value. (The first
+event, the prefix, is shared among all options, defaults to =,
+and can be changed in `magit-popup-mode-keymap').
+
+DESC is a string describing the purpose of the argument, it is
+displayed in the popup.
+
+If optional VALUE is non-nil then the option is on by default,
+and VALUE is its default value.
+
+READER is used to read a value from the user when the option is
+invoked and does not currently have a value. (When the option
+has a value, then invoking the option causes it to be unset.)
+This function must take two arguments but may choose to ignore
+them. The first argument is the name of the option (with \": \"
+appended, unless it ends with \"=\") and can be used as the
+prompt. The second argument is nil or the value that was in
+effect before the option was unset, which may be suitable as
+initial completion input. If no reader is specified, then
+`read-from-minibuffer' is used.
+
+OPTION is inserted after all other options already defined for
+POPUP, unless optional PREPEND is non-nil, in which case it is
+placed first. If optional AT is non-nil, then it should be the
+KEY of another option already defined for POPUP, the argument
+is then placed before or after AT, depending on PREPEND."
+ (declare (indent defun))
+ (magit-define-popup-key popup :options key
+ (list desc option reader value) at prepend))
+
+(defun magit-define-popup-variable (popup key desc command formatter
+ &optional at prepend)
+ "In POPUP, define KEY as COMMAND.
+
+POPUP is a popup command defined using `magit-define-popup'.
+COMMAND is a command which calls `magit-popup-set-variable'.
+FORMATTER is a function which calls `magit-popup-format-variable'.
+These two functions have to be called with the same arguments.
+
+KEY is a character representing the event used interactively call
+the COMMAND.
+
+DESC is the variable or a representation thereof. It's not
+actually used for anything.
+
+COMMAND is inserted after all other commands already defined for
+POPUP, unless optional PREPEND is non-nil, in which case it is
+placed first. If optional AT is non-nil, then it should be the
+KEY of another command already defined for POPUP, the command
+is then placed before or after AT, depending on PREPEND."
+ (declare (indent defun))
+ (magit-define-popup-key popup :variables key
+ (list desc command formatter) at prepend))
+
+(defun magit-define-popup-action (popup key desc command
+ &optional at prepend)
+ "In POPUP, define KEY as COMMAND.
+
+POPUP is a popup command defined using `magit-define-popup'.
+COMMAND can be any command but should usually consume the popup
+arguments in its `interactive' form.
+KEY is a character representing the event used invoke the action,
+i.e. to interactively call the COMMAND.
+
+DESC is a string describing the purpose of the action, it is
+displayed in the popup.
+
+COMMAND is inserted after all other commands already defined for
+POPUP, unless optional PREPEND is non-nil, in which case it is
+placed first. If optional AT is non-nil, then it should be the
+KEY of another command already defined for POPUP, the command
+is then placed before or after AT, depending on PREPEND."
+ (declare (indent defun))
+ (magit-define-popup-key popup :actions key
+ (list desc command) at prepend))
+
+(defun magit-define-popup-sequence-action
+ (popup key desc command &optional at prepend)
+ "Like `magit-define-popup-action' but for `:sequence-action'."
+ (declare (indent defun))
+ (magit-define-popup-key popup :sequence-actions key
+ (list desc command) at prepend))
+
+(defconst magit-popup-type-plural-alist
+ '((:switch . :switches)
+ (:option . :options)
+ (:variable . :variables)
+ (:action . :actions)
+ (:sequence-action . :sequence-actions)))
+
+(defun magit-popup-pluralize-type (type)
+ (or (cdr (assq type magit-popup-type-plural-alist))
+ type))
+
+(defun magit-define-popup-key
+ (popup type key def &optional at prepend)
+ "In POPUP, define KEY as an action, switch, or option.
+It's better to use one of the specialized functions
+ `magit-define-popup-action',
+ `magit-define-popup-sequence-action',
+ `magit-define-popup-switch',
+ `magit-define-popup-option', or
+ `magit-define-popup-variable'."
+ (declare (indent defun))
+ (setq type (magit-popup-pluralize-type type))
+ (if (memq type '(:switches :options :variables :actions :sequence-actions))
+ (if (boundp popup)
+ (let* ((plist (symbol-value popup))
+ (value (plist-get plist type))
+ (elt (assoc key value)))
+ (if elt
+ (setcdr elt def)
+ (setq elt (cons key def)))
+ (if at
+ (when (setq at (cl-member at value :key 'car-safe :test 'equal))
+ (setq value (cl-delete key value :key 'car-safe :test 'equal))
+ (if prepend
+ (progn (push (car at) (cdr at))
+ (setcar at elt))
+ (push elt (cdr at))))
+ (setq value (cl-delete key value :key 'car-safe :test 'equal)))
+ (unless (assoc key value)
+ (setq value (if prepend
+ (cons elt value)
+ (append value (list elt)))))
+ (set popup (plist-put plist type value)))
+ (push (list type key def at prepend)
+ (get popup 'magit-popup-deferred)))
+ (error "Unknown popup event type: %s" type)))
+
+(defun magit-define-popup-keys-deferred (popup)
+ (dolist (args (get popup 'magit-popup-deferred))
+ (condition-case err
+ (apply #'magit-define-popup-key popup args)
+ ((debug error)
+ (display-warning 'magit (error-message-string err) :error))))
+ (put popup 'magit-popup-deferred nil))
+
+(defun magit-change-popup-key (popup type from to)
+ "In POPUP, bind TO to what FROM was bound to.
+TYPE is one of `:action', `:sequence-action', `:switch', or
+`:option'. Bind TO and unbind FROM, both are characters."
+ (--if-let (assoc from (plist-get (symbol-value popup)
+ (magit-popup-pluralize-type type)))
+ (setcar it to)
+ (message "magit-change-popup-key: FROM key %c is unbound" from)))
+
+(defun magit-remove-popup-key (popup type key)
+ "In POPUP, remove KEY's binding of TYPE.
+POPUP is a popup command defined using `magit-define-popup'.
+TYPE is one of `:action', `:sequence-action', `:switch', or
+`:option'. KEY is the character which is to be unbound."
+ (setq type (magit-popup-pluralize-type type))
+ (let* ((plist (symbol-value popup))
+ (alist (plist-get plist type))
+ (value (assoc key alist)))
+ (set popup (plist-put plist type (delete value alist)))))
+
+;;; Invoke
+
+(defvar-local magit-popup-previous-winconf nil)
+
+(defun magit-invoke-popup (popup mode arg)
+ (let* ((def (symbol-value popup))
+ (val (symbol-value (plist-get def :variable)))
+ (default (plist-get def :default-action))
+ (local (plist-get def :use-prefix))
+ (local (if (functionp local)
+ (funcall local)
+ local))
+ (use-prefix (or local magit-popup-use-prefix-argument)))
+ (cond
+ ((or (and (eq use-prefix 'default) arg)
+ (and (eq use-prefix 'popup) (not arg)))
+ (if default
+ (let ((magit-current-popup (list popup 'default))
+ (magit-current-popup-args
+ (let ((magit-this-popup popup)
+ (magit-this-popup-events nil))
+ (magit-popup-default-setup val def)
+ (magit-popup-get-args))))
+ (when (and arg (listp arg))
+ (setq current-prefix-arg (and (not (= (car arg) 4))
+ (list (/ (car arg) 4)))))
+ (call-interactively default))
+ (message "%s has no default action; showing popup instead." popup)
+ (magit-popup-mode-setup popup mode)))
+ ((memq use-prefix '(default popup nil))
+ (magit-popup-mode-setup popup mode)
+ (when magit-popup-show-help-echo
+ (message
+ (format
+ "[%s] show common commands, [%s] describe events, [%s] show manual"
+ (propertize "C-t" 'face 'magit-popup-key)
+ (propertize "?" 'face 'magit-popup-key)
+ (propertize "C-h i" 'face 'magit-popup-key)))))
+ (local
+ (error "Invalid :use-prefix popup property value: %s" use-prefix))
+ (t
+ (error "Invalid magit-popup-use-prefix-argument value: %s" use-prefix)))))
+
+(defun magit-invoke-popup-switch (event)
+ (interactive (list last-command-event))
+ (--if-let (magit-popup-lookup event :switches)
+ (progn
+ (setf (magit-popup-event-use it)
+ (not (magit-popup-event-use it)))
+ (magit-refresh-popup-buffer))
+ (user-error "%c isn't bound to any switch" event)))
+
+(defun magit-invoke-popup-option (event)
+ (interactive (list last-command-event))
+ (--if-let (magit-popup-lookup event :options)
+ (progn
+ (if (magit-popup-event-use it)
+ (setf (magit-popup-event-use it) nil)
+ (let* ((arg (magit-popup-event-arg it))
+ (val (funcall
+ (magit-popup-event-fun it)
+ (concat arg (unless (string-match-p "=$" arg) ": "))
+ (magit-popup-event-val it))))
+ (setf (magit-popup-event-use it) t)
+ (setf (magit-popup-event-val it) val)))
+ (magit-refresh-popup-buffer))
+ (user-error "%c isn't bound to any option" event)))
+
+(defun magit-invoke-popup-action (event)
+ (interactive (list last-command-event))
+ (let ((action (magit-popup-lookup event :actions))
+ (variable (magit-popup-lookup event :variables)))
+ (when (and variable (not (magit-popup-event-arg variable)))
+ (setq action variable)
+ (setq variable nil))
+ (cond ((or action variable)
+ (let* ((magit-current-popup magit-this-popup)
+ (magit-current-popup-args (magit-popup-get-args))
+ (magit-current-pre-popup-buffer magit-pre-popup-buffer)
+ (command (magit-popup-event-fun (or action variable)))
+ (magit-current-popup-action command))
+ (when action
+ (magit-popup-quit))
+ (setq this-command command)
+ (call-interactively command)
+ (unless action
+ (magit-refresh-popup-buffer))))
+ ((eq event ?q)
+ (magit-popup-quit)
+ (when magit-previous-popup
+ (magit-popup-mode-setup magit-previous-popup nil)))
+ (t
+ (user-error "%c isn't bound to any action" event)))))
+
+(defun magit-popup-quit ()
+ "Quit the current popup command without invoking an action."
+ (interactive)
+ (let ((winconf magit-popup-previous-winconf))
+ (if (derived-mode-p 'magit-popup-mode)
+ (kill-buffer)
+ (magit-popup-help-mode -1)
+ (kill-local-variable 'magit-popup-previous-winconf))
+ (when winconf
+ (set-window-configuration winconf))))
+
+(defun magit-popup-read-number (prompt &optional default)
+ "Like `read-number' but DEFAULT may be a numeric string."
+ (read-number prompt (if (stringp default)
+ (string-to-number default)
+ default)))
+
+;;; Save
+
+(defun magit-popup-set-default-arguments (arg)
+ "Set default value for the arguments for the current popup.
+Then close the popup without invoking an action; unless a prefix
+argument is used in which case the popup remains open.
+
+For a popup named `NAME-popup' that usually means setting the
+value of the custom option `NAME-arguments'."
+ (interactive "P")
+ (-if-let (var (magit-popup-get :variable))
+ (progn (customize-set-variable var (magit-popup-get-args))
+ (unless arg (magit-popup-quit)))
+ (user-error "Nothing to set")))
+
+(defun magit-popup-save-default-arguments (arg)
+ "Save default value for the arguments for the current popup.
+Then close the popup without invoking an action; unless a prefix
+argument is used in which case the popup remains open.
+
+For a popup named `NAME-popup' that usually means saving the
+value of the custom option `NAME-arguments'."
+ (interactive "P")
+ (-if-let (var (magit-popup-get :variable))
+ (progn (customize-save-variable var (magit-popup-get-args))
+ (unless arg (magit-popup-quit)))
+ (user-error "Nothing to save")))
+
+;;; Help
+
+(defun magit-popup-toggle-show-common-commands ()
+ "Show or hide an additional section with common commands.
+The commands listed in this section are common to all popups
+and are defined in `magit-popup-mode-map' (which see)."
+ (interactive)
+ (setq magit-popup-show-common-commands
+ (not magit-popup-show-common-commands))
+ (magit-refresh-popup-buffer)
+ (fit-window-to-buffer))
+
+(defun magit-popup-help ()
+ "Show help for the argument or action at point."
+ (interactive)
+ (let* ((man (magit-popup-get :man-page))
+ (key (read-key-sequence
+ (concat "Describe key" (and man " (? for manpage)") ": ")))
+ (int (aref key (1- (length key))))
+ (def (or (lookup-key (current-local-map) key t)
+ (lookup-key (current-global-map) key))))
+ (pcase def
+ (`magit-invoke-popup-switch
+ (--if-let (magit-popup-lookup int :switches)
+ (if (and (string-prefix-p "++" (magit-popup-event-arg it))
+ (magit-popup-event-fun it))
+ (magit-popup-describe-function (magit-popup-event-fun it))
+ (magit-popup-manpage man it))
+ (user-error "%c isn't bound to any switch" int)))
+ (`magit-invoke-popup-option
+ (--if-let (magit-popup-lookup int :options)
+ (if (and (string-prefix-p "++" (magit-popup-event-arg it))
+ (magit-popup-event-fun it))
+ (magit-popup-describe-function (magit-popup-event-fun it))
+ (magit-popup-manpage man it))
+ (user-error "%c isn't bound to any option" int)))
+ (`magit-popup-help
+ (magit-popup-manpage man nil))
+ ((or `self-insert-command
+ `magit-invoke-popup-action)
+ (setq def (or (magit-popup-lookup int :actions)
+ (magit-popup-lookup int :variables)))
+ (if def
+ (magit-popup-describe-function (magit-popup-event-fun def))
+ (ding)
+ (message nil)))
+ (`nil (ding)
+ (message nil))
+ (_ (magit-popup-describe-function def)))))
+
+(defun magit-popup-manpage (topic arg)
+ (unless topic
+ (user-error "No man page associated with %s"
+ (magit-popup-get :man-page)))
+ (when arg
+ (setq arg (magit-popup-event-arg arg))
+ (when (string-prefix-p "--" arg)
+ ;; handle '--' option and the '--[no-]' shorthand
+ (setq arg (cond ((string= "-- " arg)
+ "\\(?:\\[--\\] \\)?<[^[:space:]]+>\\.\\.\\.")
+ ((string-prefix-p "--no-" arg)
+ (concat "--"
+ "\\[?no-\\]?"
+ (substring arg 5)))
+ (t
+ (concat "--"
+ "\\(?:\\[no-\\]\\)?"
+ (substring arg 2)))))))
+ (let ((winconf (current-window-configuration)) buffer)
+ (pcase magit-popup-manpage-package
+ (`woman (delete-other-windows)
+ (split-window-below)
+ (with-no-warnings ; display-buffer-function is obsolete
+ (let ((display-buffer-alist nil)
+ (display-buffer-function nil)
+ (display-buffer-overriding-action nil))
+ (woman topic)))
+ (setq buffer (current-buffer)))
+ (`man (cl-letf (((symbol-function #'fboundp) (lambda (_) nil)))
+ (setq buffer (man topic)))
+ (delete-other-windows)
+ (split-window-below)
+ (set-window-buffer (selected-window) buffer)))
+ (with-current-buffer buffer
+ (setq magit-popup-previous-winconf winconf)
+ (magit-popup-help-mode)
+ (fit-window-to-buffer (next-window))
+ (if (and arg
+ (Man-find-section "OPTIONS")
+ (let ((case-fold-search nil)
+ ;; This matches preceding/proceeding options.
+ ;; Options such as '-a', '-S[<keyid>]', and
+ ;; '--grep=<pattern>' are matched by this regex
+ ;; without the shy group. The '. ' in the shy
+ ;; group is for options such as '-m
+ ;; parent-number', and the '-[^[:space:]]+ ' is
+ ;; for options such as '--mainline parent-number'
+ (others "-\\(?:. \\|-[^[:space:]]+ \\)?[^[:space:]]+"))
+ (re-search-forward
+ ;; should start with whitespace, and may have any
+ ;; number of options before/after
+ (format "^[\t\s]+\\(?:%s, \\)*?\\(?1:%s\\)%s\\(?:, %s\\)*$"
+ others
+ ;; options don't necessarily end in an '='
+ ;; (e.g., '--gpg-sign[=<keyid>]')
+ (string-remove-suffix "=" arg)
+ ;; Simple options don't end in an '='.
+ ;; Splitting this into 2 cases should make
+ ;; getting false positives less likely.
+ (if (string-suffix-p "=" arg)
+ ;; [^[:space:]]*[^.[:space:]] matches
+ ;; the option value, which is usually
+ ;; after the option name and either '='
+ ;; or '[='. The value can't end in a
+ ;; period, as that means it's being used
+ ;; at the end of a sentence. The space
+ ;; is for options such as '--mainline
+ ;; parent-number'.
+ "\\(?: \\|\\[?=\\)[^[:space:]]*[^.[:space:]]"
+ ;; Either this doesn't match anything
+ ;; (e.g., '-a'), or the option is followed
+ ;; by a value delimited by a '[', '<', or
+ ;; ':'. A space might appear before this
+ ;; value, as in '-f <file>'. The space
+ ;; alternative is for options such as '-m
+ ;; parent-number'.
+ "\\(?:\\(?: \\| ?[\\[<:]\\)[^[:space:]]*[^.[:space:]]\\)?")
+ others)
+ nil
+ t)))
+ (goto-char (match-beginning 1))
+ (goto-char (point-min))))))
+
+(defun magit-popup-describe-function (function)
+ (let ((winconf (current-window-configuration)))
+ (delete-other-windows)
+ (split-window-below)
+ (other-window 1)
+ (with-no-warnings ; display-buffer-function is obsolete
+ (let ((display-buffer-alist '(("" display-buffer-use-some-window)))
+ (display-buffer-function nil)
+ (display-buffer-overriding-action nil)
+ (help-window-select nil))
+ (describe-function function)))
+ (fit-window-to-buffer)
+ (other-window 1)
+ (setq magit-popup-previous-winconf winconf)
+ (magit-popup-help-mode)))
+
+(defun magit-popup-info ()
+ "Show the popup manual."
+ (interactive)
+ (let ((winconf (current-window-configuration)))
+ (delete-other-windows)
+ (split-window-below)
+ (info "(magit-popup.info)Usage")
+ (magit-popup-help-mode)
+ (setq magit-popup-previous-winconf winconf))
+ (magit-popup-help-mode)
+ (fit-window-to-buffer (next-window)))
+
+(define-minor-mode magit-popup-help-mode
+ "Auxiliary minor mode used to restore previous window configuration.
+When some sort of help buffer is created from within a popup,
+then this minor mode is turned on in that buffer, so that when
+the user quits it, the previous window configuration is also
+restored."
+ :keymap '(([remap Man-quit] . magit-popup-quit)
+ ([remap Info-exit] . magit-popup-quit)
+ ([remap quit-window] . magit-popup-quit)))
+
+;;; Modes
+
+(define-derived-mode magit-popup-mode fundamental-mode "MagitPopup"
+ "Major mode for infix argument popups."
+ :mode 'magit-popup
+ (setq truncate-lines t)
+ (setq buffer-read-only t)
+ (setq-local scroll-margin 0)
+ (setq-local magit-popup-show-common-commands magit-popup-show-common-commands)
+ (hack-dir-local-variables-non-file-buffer))
+
+(put 'magit-popup-mode 'mode-class 'special)
+
+(defun magit-popup-default-setup (val def)
+ (if (--when-let (magit-popup-get :sequence-predicate)
+ (funcall it))
+ (magit-popup-put :actions (magit-popup-convert-actions
+ val (magit-popup-get :sequence-actions)))
+ (let ((vars (plist-get def :variables)))
+ (when (functionp vars)
+ (setq vars (funcall vars)))
+ (when vars
+ (magit-popup-put :variables (magit-popup-convert-variables val vars))))
+ (magit-popup-put :switches (magit-popup-convert-switches
+ val (plist-get def :switches)))
+ (magit-popup-put :options (magit-popup-convert-options
+ val (plist-get def :options)))
+ (magit-popup-put :actions (magit-popup-convert-actions
+ val (plist-get def :actions)))))
+
+(defun magit-popup-mode-setup (popup mode)
+ (setq magit-previous-popup magit-current-popup)
+ (let ((val (symbol-value (plist-get (symbol-value popup) :variable)))
+ (def (symbol-value popup))
+ (buf (current-buffer)))
+ (magit-popup-mode-display-buffer (get-buffer-create
+ (format "*%s*" popup))
+ (or mode 'magit-popup-mode))
+ (setq magit-this-popup popup)
+ (setq magit-pre-popup-buffer buf)
+ (if (bound-and-true-p magit-popup-setup-hook) ; obsolete
+ (run-hook-with-args 'magit-popup-setup-hook val def)
+ (funcall (or (magit-popup-get :setup-function)
+ 'magit-popup-default-setup)
+ val def)))
+ (magit-refresh-popup-buffer)
+ (fit-window-to-buffer nil nil (line-number-at-pos (point-max))))
+
+(defun magit-popup-mode-display-buffer (buffer mode)
+ (let ((winconf (current-window-configuration)))
+ (select-window (display-buffer buffer magit-popup-display-buffer-action))
+ (funcall mode)
+ (setq magit-popup-previous-winconf winconf)))
+
+(defvar magit-refresh-popup-buffer-hook nil
+ "Hook run by `magit-refresh-popup-buffer'.
+
+The hook is run right after inserting the representation of the
+popup events but before optionally inserting the representation
+of events shared by all popups and before point is adjusted.")
+
+(defun magit-refresh-popup-buffer ()
+ (let* ((inhibit-read-only t)
+ (button (button-at (point)))
+ (prefix (and button (button-get button 'prefix)))
+ (event (and button (button-get button 'event))))
+ (erase-buffer)
+ (save-excursion
+ (--if-let (magit-popup-get :refresh-function)
+ (funcall it)
+ (magit-popup-insert-section 'magit-popup-variable-button)
+ (magit-popup-insert-section 'magit-popup-switch-button)
+ (magit-popup-insert-section 'magit-popup-option-button)
+ (magit-popup-insert-section 'magit-popup-action-button))
+ (run-hooks 'magit-refresh-popup-buffer-hook)
+ (when magit-popup-show-common-commands
+ (magit-popup-insert-command-section
+ 'magit-popup-internal-command-button
+ magit-popup-common-commands)))
+ (set-buffer-modified-p nil)
+ (when event
+ (while (and (ignore-errors (forward-button 1))
+ (let ((b (button-at (point))))
+ (or (not (equal (button-get b 'prefix) prefix))
+ (not (equal (button-get b 'event) event)))))))))
+
+;;; Draw
+
+(defvar magit-popup-min-padding 3
+ "Minimal amount of whitespace between columns in popup buffers.")
+
+(defun magit-popup-insert-section (type &optional spec heading)
+ (if (not spec)
+ (progn (setq spec (magit-popup-get (button-type-get type 'property)))
+ (when spec
+ (if (or (stringp (car spec))
+ (functionp (car spec)))
+ (--each (--partition-by-header
+ (or (stringp it) (functionp it))
+ spec)
+ (magit-popup-insert-section type (cdr it) (car it)))
+ (magit-popup-insert-section type spec))))
+ (let* ((formatter (button-type-get type 'formatter))
+ (items (mapcar (lambda (ev)
+ (and ev (or (funcall formatter type ev) '(""))))
+ (or spec (magit-popup-get
+ (button-type-get type 'property)))))
+ (maxcols (button-type-get type 'maxcols))
+ (pred (magit-popup-get :sequence-predicate)))
+ (when items
+ (if (functionp heading)
+ (when (setq heading (funcall heading))
+ (insert heading ?\n))
+ (unless heading
+ (setq heading (button-type-get type 'heading)))
+ (insert (propertize heading 'face 'magit-popup-heading))
+ (unless (string-match "\n$" heading)
+ (insert "\n")))
+ (if (and pred (funcall pred))
+ (setq maxcols nil)
+ (cl-typecase maxcols
+ (keyword (setq maxcols (magit-popup-get maxcols)))
+ (symbol (setq maxcols (symbol-value maxcols)))))
+ (when (functionp maxcols)
+ (setq maxcols (funcall maxcols heading)))
+ (when heading
+ (let ((colwidth
+ (+ (apply 'max (mapcar (lambda (e) (length (car e))) items))
+ magit-popup-min-padding)))
+ (dolist (item items)
+ (unless (bolp)
+ (let ((padding (- colwidth (% (current-column) colwidth))))
+ (if (and (< (+ (current-column) padding colwidth)
+ (window-width))
+ (< (ceiling (/ (current-column) (* colwidth 1.0)))
+ (or maxcols 1000)))
+ (insert (make-string padding ?\s))
+ (insert "\n"))))
+ (unless (equal item '(""))
+ (if item
+ (apply 'insert-button item)
+ (insert ?\s)))))
+ (insert (if (= (char-before) ?\n) "\n" "\n\n")))))))
+
+(defun magit-popup-format-argument-button (type ev)
+ (list (format-spec
+ (button-type-get type 'format)
+ `((?k . ,(propertize (concat
+ (--when-let (button-type-get type 'prefix)
+ (char-to-string it))
+ (magit-popup-event-keydsc ev))
+ 'face 'magit-popup-key))
+ (?d . ,(magit-popup-event-dsc ev))
+ (?a . ,(propertize (magit-popup-event-arg ev)
+ 'face (if (magit-popup-event-use ev)
+ 'magit-popup-argument
+ 'magit-popup-disabled-argument)))
+ (?v . ,(let ((val (magit-popup-event-val ev)))
+ (if (and (magit-popup-event-use ev)
+ (not (equal val "")))
+ (propertize (format "\"%s\"" val)
+ 'face 'magit-popup-option-value)
+ "")))))
+ 'type type 'event (magit-popup-event-key ev)))
+
+(defun magit-popup-format-variable-button (type ev)
+ (if (not (magit-popup-event-arg ev))
+ (magit-popup-format-action-button 'magit-popup-action-button ev)
+ (list (format-spec
+ (button-type-get type 'format)
+ `((?k . ,(propertize (magit-popup-event-keydsc ev)
+ 'face 'magit-popup-key))
+ (?d . ,(funcall (magit-popup-event-arg ev)))))
+ 'type type 'event (magit-popup-event-key ev))))
+
+(defun magit-popup-format-action-button (type ev)
+ (let* ((cmd (magit-popup-event-fun ev))
+ (dsc (magit-popup-event-dsc ev))
+ (fun (and (functionp dsc) dsc)))
+ (unless (and disabled-command-function
+ (symbolp cmd)
+ (get cmd 'disabled))
+ (when fun
+ (setq dsc
+ (-when-let (branch (funcall fun))
+ (if (text-property-not-all 0 (length branch) 'face nil branch)
+ branch
+ (magit-branch-set-face branch)))))
+ (when dsc
+ (list (format-spec
+ (button-type-get type 'format)
+ `((?k . ,(propertize (magit-popup-event-keydsc ev)
+ 'face 'magit-popup-key))
+ (?d . ,dsc)
+ (?D . ,(if (and (not fun)
+ (eq cmd (magit-popup-get :default-action)))
+ (propertize dsc 'face 'bold)
+ dsc))))
+ 'type type 'event (magit-popup-event-key ev))))))
+
+(defun magit-popup-insert-command-section (type spec)
+ (magit-popup-insert-section
+ type (mapcar (lambda (elt)
+ (list (car (where-is-internal (cadr elt)
+ (current-local-map)))
+ (car elt)))
+ spec)))
+
+(defun magit-popup-format-command-button (type elt)
+ (nconc (magit-popup-format-action-button
+ type (make-magit-popup-event :key (car elt)
+ :dsc (cadr elt)))
+ (list 'function (lookup-key (current-local-map) (car elt)))))
+
+;;; Utilities
+
+(defun magit-popup-import-file-args (args files)
+ (if files
+ (cons (concat "-- " (mapconcat #'identity files ",")) args)
+ args))
+
+(defun magit-popup-export-file-args (args)
+ (let ((files (--first (string-prefix-p "-- " it) args)))
+ (when files
+ (setq args (remove files args))
+ (setq files (split-string (substring files 3) ",")))
+ (list args files)))
+
+(defconst magit-popup-font-lock-keywords
+ (eval-when-compile
+ `((,(concat "(\\(magit-define-popup\\)\\_>"
+ "[ \t'\(]*"
+ "\\(\\(?:\\sw\\|\\s_\\)+\\)?")
+ (1 'font-lock-keyword-face)
+ (2 'font-lock-function-name-face nil t)))))
+
+(font-lock-add-keywords 'emacs-lisp-mode magit-popup-font-lock-keywords)
+
+;;; _
+(provide 'magit-popup)
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
+;;; magit-popup.el ends here
--- /dev/null
+This is magit-popup.info, produced by makeinfo version 6.5 from
+magit-popup.texi.
+
+ Copyright (C) 2015-2018 Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+ You can redistribute this document and/or modify it under the terms
+ of the GNU General Public License as published by the Free Software
+ Foundation, either version 3 of the License, or (at your option)
+ any later version.
+
+ This document 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.
+INFO-DIR-SECTION Emacs
+START-INFO-DIR-ENTRY
+* Magit-Popup: (magit-popup). Infix arguments with feedback.
+END-INFO-DIR-ENTRY
+
+\1f
+File: magit-popup.info, Node: Top, Next: Introduction, Up: (dir)
+
+Magit-Popup User Manual
+***********************
+
+Taking inspiration from regular prefix commands and prefix arguments,
+this library implements a similar abstraction; a new kind of prefix
+command that is associated with a specific set of infix arguments and
+suffix commands.
+
+This manual is for Magit-Popup version 2.12.4 (v2.12.4+1).
+
+ Copyright (C) 2015-2018 Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+ You can redistribute this document and/or modify it under the terms
+ of the GNU General Public License as published by the Free Software
+ Foundation, either version 3 of the License, or (at your option)
+ any later version.
+
+ This document 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.
+
+* Menu:
+
+* Introduction::
+* Usage::
+* Defining Prefix and Suffix Commands::
+
+— The Detailed Node Listing —
+
+Usage
+
+* Customizing Existing Popups::
+* Other Options::
+
+Defining Prefix and Suffix Commands
+
+* Defining Prefix Commands::
+* Defining Suffix Commands::
+
+
+\1f
+File: magit-popup.info, Node: Introduction, Next: Usage, Prev: Top, Up: Top
+
+1 Introduction
+**************
+
+Taking inspiration from regular prefix commands and prefix arguments,
+this library implements a similar abstraction; a new kind of prefix
+command that is associated with a specific set of infix arguments and
+suffix commands.
+
+ Invoking such a prefix command displays a popup buffer which lists
+the associated infix arguments and suffix commands. In that buffer each
+argument is prefixed with the key sequence that can be used to toggle it
+or change its value. Likewise each suffix command is prefixed with the
+key used to invoke it. Such a popup buffer might look like this:
+
+ ,-----------------------------------------
+ |Switches
+ | -l Show graph (--graph)
+ | -d Show refnames (--decorate)
+ |
+ |Options
+ | =m Search messages (--grep="popup")
+ | =p Search patches (-G)
+ |
+ |Action
+ | l Show log for current branch
+ | o Show log for another branch
+ '-----------------------------------------
+
+ The user could then for example type ‘-l’ to toggle the ‘--graph’
+*switch* (when it is on then it is shown in green, otherwise in gray),
+or ‘=m’ to change the value of the *option* ‘--grep’.
+
+ Once all arguments are as desired one invokes a suffix command, which
+causes the popup buffer to disappear. The suffix command should then
+retrieve the infix arguments in its ‘interactive’ form like this is done
+for prefix arguments.
+
+ While such "prefix-infix-suffix" combos were inspired by regular
+prefix commands and prefix arguments, they are also quite different.
+This should illustrate the most basic differences:
+
+ • A regular prefix command
+
+ /- command1
+ prefix --- command2
+ \- command3
+
+ • Prefix arguments
+
+ /- command1
+ C-u ... --- command2
+ \- well any command
+
+ • A Prefix-Infix-Suffix combo
+
+ /- argument1 -\ /- suffix1
+ prefix----- argument2 --+-- suffix2
+ ^ \- argument3 -/
+ | |
+ '--------'
+ (refresh buffer)
+
+ This library was written as a replacement for ‘magit-key-mode’, which
+was used in Magit releases before 2.1.0. It is used to implement all
+"popups" in the current Magit release but a future release will switch
+to yet another implementation.
+
+ This library does not depend on any other Magit libraries and it is
+distributed as a separate package, which makes it possible to use it in
+packages that are not related to Magit. But keep in mind that it will
+be deprecated eventually.
+
+\1f
+File: magit-popup.info, Node: Usage, Next: Defining Prefix and Suffix Commands, Prev: Introduction, Up: Top
+
+2 Usage
+*******
+
+Every popup buffers created with a prefix command contains a section
+named "Actions" listing the available suffix commands. Most buffers
+also contain a "Switches" and/or an "Options" section which list the two
+types of infix arguments separately.
+
+ Switches are arguments that can be toggled on or off. When a switch
+is active then it is shown in color, when it is off then it is shown in
+gray (of course the details depend on the color theme in use).
+
+ Options are arguments that have a value. When an option has a value
+then that is shown after the option itself. Because for some options
+the empty string is a valid value, options are additionally colorized
+like switches to indicate whether they are active or not.
+
+ The events bound to suffix commands are always single alphabetic
+characters. The bindings for arguments are always two events long. For
+switches the first key is always ‘-’, for options it is always ‘=’. The
+second key is always an alphabetic character.
+
+ By default popup buffers also feature a section listing commands
+common to all popups. To avoid conflicts with suffix commands, the
+bindings of these common commands are not alphabetic characters. This
+section is shown by default so that documentation-resistant users get a
+chance to notice them.
+
+ -- User Option: magit-popup-show-common-commands
+
+ This option controls whether the section that lists the commands
+ that are common to all popups is initially shown.
+
+ By default this is not the case, but note that you can temporarily
+ show this section using ‘C-t’, which therefore is the only common
+ command you actually have to memorize.
+
+‘C-t’ (‘magit-popup-toggle-show-common-commands’)
+
+ Show or hide the section listing the commands shared by all popups.
+
+‘C-g’ (‘magit-popup-quit’)
+
+ Quit popup buffer without invoking a suffix command.
+
+ Without further action, setting arguments only affects the next
+suffix command. Invoking the same prefix command again resets the
+arguments to their default value, but the defaults can be changed
+directly from the popup buffer itself. For a prefix command named
+‘NAME-popup’ the default values are stored as the value of the custom
+option named ‘NAME-arguments’. While this option can be customized
+using the Custom interface, it is better to do so directly from the
+popup buffer.
+
+‘C-c C-c’ (‘magit-popup-set-default-arguments’)
+
+ This sets the default value for the arguments for the current
+ popup.
+
+ Then the popup buffer is closed without invoking a suffix command;
+ unless a prefix argument is used in which case the popup remains
+ open.
+
+‘C-x C-s’ (‘magit-popup-save-default-arguments’)
+
+ This sets the default value for the arguments for the current popup
+ and saves it for future Emacs sessions.
+
+ Then the popup buffer is closed without invoking an action; unless
+ a prefix argument is used in which case the popup remains open.
+
+ It is also possible to add additional arguments and commands to an
+existing popup, but that cannot be done directly from the popup (or the
+Custom interface). See *note Customizing Existing Popups::.
+
+ Documentation about a popup’s arguments and commands can be shown
+directly from the popup.
+
+‘C-h i’ (‘magit-popup-info’)
+
+ Show this manual.
+
+‘?’ (‘magit-popup-help’)
+
+ This command reads a key sequence and then shows the documentation
+ of the argument or command that sequence is bound to. In other
+ words type the same keys that you would use to invoke the argument
+ or command, but prefix the sequence with ‘?’.
+
+ For suffix commands this shows the doc-string. For arguments this
+ command can only show something for popups that have an associated
+ man-page. If the man-page is set, then this command displays it in
+ a separate buffer and puts point on the entry about the argument in
+ question.
+
+ The buffer which is used to display the documentation is selected.
+ Simply press ‘q’ to leave that buffer and restore the old window
+ configuration.
+
+ While it isn’t very useful, it is possible to move around in a popup
+buffer using ‘C-p’ and ‘C-n’, and to invoke the argument or command at
+point using ‘RET’. But it is much more efficient to use the dedicated
+key bindings instead, so these commands are not listed in popup buffers
+along with the other common commands.
+
+* Menu:
+
+* Customizing Existing Popups::
+* Other Options::
+
+\1f
+File: magit-popup.info, Node: Customizing Existing Popups, Next: Other Options, Up: Usage
+
+2.1 Customizing Existing Popups
+===============================
+
+It is possible to define additional infix arguments and suffix commands
+to an existing popup using the following functions.
+
+ You can find some examples which use the below commands at
+<https://github.com/magit/magit/wiki/Additional-proposed-infix-arguments-and-suffix-commands>.
+
+ -- Function: magit-define-popup-switch popup key desc switch &optional
+ enable at prepend
+
+ In POPUP, define KEY as SWITCH.
+
+ POPUP is a popup command defined using ‘magit-define-popup’.
+ SWITCH is a string representing an argument that takes no value.
+ KEY is a character representing the second event in the sequence of
+ keystrokes used to toggle the argument. (The first event, the
+ prefix, is shared among all switches, defaults to ‘-’, and can be
+ changed in ‘magit-popup-mode-keymap’).
+
+ DESC is a string describing the purpose of the argument, it is
+ displayed in the popup.
+
+ If optional ENABLE is non-nil then the switch is on by default.
+
+ SWITCH is inserted after all other switches already defined for
+ POPUP, unless optional PREPEND is non-nil, in which case it is
+ placed first. If optional AT is non-nil then it should be the KEY
+ of another switch already defined for POPUP, the argument is then
+ placed before or after AT, depending on PREPEND.
+
+ -- Function: magit-define-popup-option popup key desc option &optional
+ reader value at prepend
+
+ In POPUP, define KEY as OPTION.
+
+ POPUP is a popup command defined using ‘magit-define-popup’.
+ OPTION is a string representing an argument that takes a value.
+ KEY is a character representing the second event in the sequence of
+ keystrokes used to set the argument’s value. (The first event, the
+ prefix, is shared among all options, defaults to ‘=’, and can be
+ changed in ‘magit-popup-mode-keymap’).
+
+ DESC is a string describing the purpose of the argument, it is
+ displayed in the popup.
+
+ If optional VALUE is non-nil then the option is on by default, and
+ VALUE is its default value.
+
+ READER is used to read a value from the user when the option is
+ invoked and does not currently have a value. (When the option has
+ a value, then invoking the option causes it to be unset.) This
+ function must take two arguments but may choose to ignore them.
+ The first argument is the name of the option (with ": \" appended,
+ unless it ends with "=") and can be used as the prompt. The second
+ argument is nil or the value that was in effect before the option
+ was unset, which may be suitable as initial completion input. If
+ no reader is specified, then ‘read-from-minibuffer’ is used.
+
+ OPTION is inserted after all other options already defined for
+ POPUP, unless optional PREPEND is non-nil, in which case it is
+ placed first. If optional AT is non-nil then it should be the KEY
+ of another option already defined for POPUP, the argument is then
+ placed before or after AT, depending on PREPEND.
+
+ -- Function: magit-define-popup-action popup key desc command &optional
+ at prepend
+
+ In POPUP, define KEY as COMMAND.
+
+ POPUP is a popup command defined using ‘magit-define-popup’.
+ COMMAND can be any command but should usually consume the popup
+ arguments in its ‘interactive’ form. KEY is a character
+ representing the event used invoke the action, i.e. to
+ interactively call the COMMAND.
+
+ DESC is a string describing the purpose of the action, it is
+ displayed in the popup.
+
+ COMMAND is inserted after all other commands already defined for
+ POPUP, unless optional PREPEND is non-nil, in which case it is
+ placed first. If optional AT is non-nil then it should be the KEY
+ of another command already defined for POPUP, the command is then
+ placed before or after AT, depending on PREPEND.
+
+ -- Function: magit-define-popup-sequence-action popup key desc command
+ &optional at prepend
+
+ Like ‘magit-define-popup-action’, but modifies the value of the
+ ‘:sequence-actions’ property instead of ‘:actions’.
+
+ -- Function: magit-define-popup-variable popup key desc command
+ formatter &optional at prepend
+
+ In POPUP, define KEY as COMMAND.
+
+ POPUP is a popup command defined using ‘magit-define-popup’.
+ COMMAND is a command which calls ‘magit-popup-set-variable’.
+ FORMATTER is a function which calls ‘magit-popup-format-variable’.
+ These two functions have to be called with the same arguments.
+
+ KEY is a character representing the event used interactively call
+ the COMMAND.
+
+ DESC is the variable or a representation thereof. It’s not
+ actually used for anything.
+
+ COMMAND is inserted after all other commands already defined for
+ POPUP, unless optional PREPEND is non-nil, in which case it is
+ placed first. If optional AT is non-nil then it should be the KEY
+ of another command already defined for POPUP, the command is then
+ placed before or after AT, depending on PREPEND."
+
+ -- Function: magit-change-popup-key popup type from to
+
+ In POPUP, bind TO to what FROM was bound to. TYPE is one of
+ ‘:action’, ‘:sequence-action’, ‘:switch’, or ‘:option’. Bind TO
+ and unbind FROM, both are characters.
+
+ -- Function: magit-remove-popup-key popup type key
+
+ In POPUP, remove KEY’s binding of TYPE. POPUP is a popup command
+ defined using ‘magit-define-popup’. TYPE is one of ‘:action’,
+ ‘:sequence-action’, ‘:switch’, or ‘:option’. KEY is the character
+ which is to be unbound.
+
+ It is also possible to change other aspects of a popup by setting a
+property using ‘plist-put’. See *note Defining Prefix Commands:: for
+valid properties. The most likely change Magit users might want to make
+is:
+
+ (plist-put magit-show-refs-popup :use-prefix nil)
+
+\1f
+File: magit-popup.info, Node: Other Options, Prev: Customizing Existing Popups, Up: Usage
+
+2.2 Other Options
+=================
+
+ -- User Option: magit-popup-use-prefix-argument
+
+ This option controls the effect that the use of a prefix argument
+ before entering a popup has.
+
+ • ‘default’
+
+ With a prefix argument directly invoke the popup’s default
+ action (an Emacs command), instead of bringing up the popup.
+
+ • ‘popup’
+
+ With a prefix argument bring up the popup, otherwise directly
+ invoke the popup’s default action.
+
+ • ‘nil’
+
+ Ignore prefix arguments.
+
+ This option can be overridden for individual popups.
+ ‘magit-show-refs-popup’ for example defaults to invoking the
+ default action directly. It only shows the popup buffer when a
+ prefix argument is used. See *note Customizing Existing Popups::.
+
+ -- User Option: magit-popup-manpage-package
+
+ The Emacs package used to display man-pages, one of ‘man’ or
+ ‘woman’.
+
+ -- User Option: magit-popup-display-buffer-action
+
+ The option controls how the window used to display a popup buffer
+ is created. Popup buffers are displayed using ‘display-buffer’
+ with the value of this option as ACTION argument. You can also set
+ this to nil and instead add an entry to ‘display-buffer-alist’.
+
+ To emphasize the default action by making it bold use this:
+
+ (button-type-put 'magit-popup-action-button 'format " %k %D")
+
+\1f
+File: magit-popup.info, Node: Defining Prefix and Suffix Commands, Prev: Usage, Up: Top
+
+3 Defining Prefix and Suffix Commands
+*************************************
+
+If you write an extension for Magit then you should use this library now
+and later when ‘transient’ is released port to that.
+
+ If you are considering using this library to define popups for
+packages not related to Magit, then keep in mind that it will be
+superseded eventually. Once ‘transient’ has been released I will only
+fix bugs in ‘magit-popup’ but not implement any new features.
+
+ Also consider using ‘hydra’ instead. To some extend ‘magit-popup’
+and ‘hydra’ are similar but have a different focus. The main purpose of
+‘magit-popup’ is to pass infix arguments to suffix commands. If all you
+need is a command dispatcher then you are better of using ‘hydra’. Of
+course ‘hydra’ may also be a better fit not only because of the features
+it lacks, but also because of the features it provides, which are in
+turn missing from ‘magit-popup’.
+
+ Here is an example of how one defines a prefix command along with its
+infix arguments, and then also one of its suffix commands.
+
+ ;;;###autoload (autoload 'magit-tag-popup "magit" nil t)
+ (magit-define-popup magit-tag-popup
+ "Show popup buffer featuring tagging commands."
+ 'magit-commands
+ :man-page "git-tag"
+ :switches '((?a "Annotate" "--annotate")
+ (?s "Sign" "--sign")
+ (?f "Force" "--force"))
+ :actions '((?t "Create" magit-tag)
+ (?k "Delete" magit-tag-delete)
+ (?p "Prune" magit-tag-prune))
+ :default-action 'magit-tag)
+
+ ;;;###autoload
+ (defun magit-tag (name rev &optional args)
+ "Create a new tag with the given NAME at REV."
+ (interactive (list (magit-read-tag "Tag name")
+ (magit-read-branch-or-commit "Place tag on")
+ (magit-tag-arguments)))
+ (magit-run-git-with-editor "tag" args name rev))
+
+* Menu:
+
+* Defining Prefix Commands::
+* Defining Suffix Commands::
+
+\1f
+File: magit-popup.info, Node: Defining Prefix Commands, Next: Defining Suffix Commands, Up: Defining Prefix and Suffix Commands
+
+3.1 Defining Prefix Commands
+============================
+
+Prefix commands and their infix arguments are defined using the macro
+‘magit-define-popup’. The key bindings and descriptions of suffix
+commands are also defined using that macro, but the actual interactive
+commands have to be defined separately using plain ‘defun’.
+
+ -- Macro: magit-define-popup name doc [group [mode [option]]] :keyword
+ value...
+
+ This macro defines a popup named NAME. The NAME should begin with
+ the package prefix and by convention end with ‘-popup’, it is used
+ as the name of the command which shows the popup and for an
+ internal variable (whose value is used to store information about
+ the popup and should not be accessed directly). DOC is the
+ doc-string of the popup command.
+
+ This macro also defines an option and a function both named
+ ‘SHORTNAME-arguments’, where SHORTNAME is NAME with the trailing
+ ‘-popup’ removed. The name of this option and this function can be
+ overwritten using the optional argument OPTION, but that is rarely
+ advisable. As a special case if OPTION is specified but ‘nil’,
+ then this option and this function are not defined at all, which is
+ useful for popups that are used as simple dispatchers that offer no
+ arguments.
+
+ The option ‘SHORTNAME-arguments’ holds the value for the popup
+ arguments. It can be customized from within the popup or using the
+ Custom interface. It can also have a buffer local value in any
+ non-popup buffer. The local value for the buffer from which the
+ popup command was invoked, can be set from within the popup buffer.
+
+ The function ‘SHORTNAME-arguments’ returns the currently effective
+ value of the variable by the same name. See below for more
+ information.
+
+ Optional argument GROUP specifies the Custom group into which the
+ option is placed. If omitted then the option is placed into some
+ group the same way it is done when directly using ‘defcustom’ and
+ omitting the group, except when NAME begins with "magit-", in which
+ case the group ‘magit-git-arguments’ is used.
+
+ The optional argument MODE specifies the mode used by the popup
+ buffer. If it is omitted or ‘nil’ then ‘magit-popup-mode’ is used.
+
+ The remaining arguments should have the form ‘[KEYWORD VALUE]...’.
+
+ The following keywords are meaningful (and by convention are
+ usually specified in that order):
+
+ • ‘:actions’
+
+ The actions which can be invoked from the popup. VALUE is a
+ list whose members have the form (KEY DESC COMMAND), see
+ ‘magit-define-popup-action’ for details.
+
+ Actions are regular Emacs commands, which usually have an
+ ‘interactive’ form setup to consume the values of the popup
+ ‘:switches’ and ‘:options’ when invoked from the corresponding
+ popup, else when invoked as the default action or directly
+ without using the popup, the default value of the variable
+ ‘SHORTNAME-arguments’. This is usually done by calling the
+ function ‘SHORTNAME-arguments’.
+
+ Members of VALUE may also be strings and functions, assuming
+ the first member is a string or function. In that case the
+ members are split into sections and these special elements are
+ used as headings. If such an element is a function then it is
+ called with no arguments and must return either a string,
+ which is used as the heading, or nil, in which case the
+ section is not inserted.
+
+ Members of VALUE may also be nil. This should only be used
+ together with ‘:max-action-columns’ and allows having gaps in
+ the action grit, which can help arranging actions sensibly.
+
+ • ‘:default-action’
+
+ The default action of the popup which is used directly instead
+ of displaying the popup buffer, when the popup is invoked with
+ a prefix argument. Also see ‘magit-popup-use-prefix-argument’
+ and ‘:use-prefix’, which can be used to inverse the meaning of
+ the prefix argument.
+
+ • ‘:use-prefix’
+
+ Controls when to display the popup buffer and when to invoke
+ the default action (if any) directly. This overrides the
+ global default set using ‘magit-popup-use-prefix-argument’.
+ The value, if specified, should be one of ‘default’ or
+ ‘prefix’, or a function that is called with no arguments and
+ returns one of these symbols.
+
+ • ‘:max-action-columns’
+
+ The maximum number of actions to display on a single line, a
+ number or a function that return a number and takes the name
+ of the section currently being inserted as argument. If there
+ isn’t enough room to display as many columns as specified
+ here, then fewer are used.
+
+ • ‘:switches’
+
+ The popup arguments which can be toggled on and off. VALUE is
+ a list whose members have the form ‘(KEY DESC SWITCH)’, see
+ ‘magit-define-popup-switch’ for details.
+
+ Members of VALUE may also be strings and functions, assuming
+ the first member is a string or function. In that case the
+ members are split into sections and these special elements are
+ used as headings. If such an element is a function then it is
+ called with no arguments and must return either a string,
+ which is used as the heading, or nil, in which case the
+ section is not inserted.
+
+ • ‘:options’
+
+ The popup arguments which take a value, as in "–opt~OPTVAL".
+ VALUE is a list whose members have the form ‘(KEY DESC OPTION
+ READER)’, see ‘magit-define-popup-option’ for details.
+
+ Members of VALUE may also be strings and functions, assuming
+ the first member is a string or function. In that case the
+ members are split into sections and these special elements are
+ used as headings. If such an element is a function then it is
+ called with no arguments and must return either a string,
+ which is used as the heading, or nil, in which case the
+ section is not inserted.
+
+ • ‘:default-arguments’
+
+ The default arguments, a list of switches (which are then
+ enabled by default) and options with there default values, as
+ in ‘"--OPT=OPTVAL"’.
+
+ • ‘:variables’
+
+ Variables which can be set from the popup. VALUE is a list
+ whose members have the form ‘(KEY DESC COMMAND FORMATTER)’,
+ see ‘magit-define-popup-variable’ for details.
+
+ Members of VALUE may also be strings and functions, assuming
+ the first member is a string or function. In that case the
+ members are split into sections and these special elements are
+ used as headings. If such an element is a function then it is
+ called with no arguments and must return either a string,
+ which is used as the heading, or nil, in which case the
+ section is not inserted.
+
+ Members of VALUE may also be actions as described above for
+ ‘:actions’.
+
+ VALUE may also be a function that returns a list as describe
+ above.
+
+ • ‘:sequence-predicate’
+
+ When this function returns non-nil, then the popup uses
+ ‘:sequence-actions’ instead of ‘:actions’, and does not show
+ the ‘:switches’ and ‘:options’.
+
+ • ‘:sequence-actions’
+
+ The actions which can be invoked from the popup, when
+ ‘:sequence-predicate’ returns non-nil.
+
+ • ‘:setup-function’
+
+ When this function is specified, then it is used instead of
+ ‘magit-popup-default-setup’.
+
+ • ‘:refresh-function’
+
+ When this function is specified, then it is used instead of
+ calling ‘magit-popup-insert-section’ three times with symbols
+ ‘magit-popup-switch-button’, ‘magit-popup-option-button’, and
+ finally ‘magit-popup-action-button’ as argument.
+
+ • ‘:man-page’
+
+ The name of the manpage to be displayed when the user requests
+ help for an argument.
+
+\1f
+File: magit-popup.info, Node: Defining Suffix Commands, Prev: Defining Prefix Commands, Up: Defining Prefix and Suffix Commands
+
+3.2 Defining Suffix Commands
+============================
+
+Commands intended to be invoked from a particular popup should determine
+the currently effective arguments by calling the function
+‘SHORTNAME-arguments’ inside their ‘interactive’ form. This function is
+created by the ‘magit-define-popup’ macro. For a popup named
+‘prefix-foo-popup’ the name of this function is ‘prefix-foo-arguments’.
+
+ When the command was invoked as an action in the respective popup,
+then this function returns the arguments that were set in the popup.
+Otherwise when the command was invoked as the default of the popup (by
+calling the popup command with a prefix argument), or without using the
+popup command at all, then this function returns the buffer-local or
+global value of the variable ‘SHORTNAME-arguments’.
+
+ Internally arguments are handled as a list of strings. This might
+not be appropriate for the intended use inside commands, or it might be
+necessary to manipulate that list somehow, i.e. to split "–ARG=VAL"
+into "–ARG""VAL". This should be done by advising or redefining the
+function ‘SHORTNAME-arguments’.
+
+ Internally ‘SHORNAME-arguments’ used following variables and
+function. Except when redefining the former, you should not use these
+directly.
+
+ -- Variable: magit-current-popup
+
+ The popup from which this editing command was invoked.
+
+ -- Variable: magit-current-popup-args
+
+ The value of the popup arguments for this editing command.
+
+ If the current command was invoked from a popup, then this is a
+ list of strings of all the set switches and options. This includes
+ arguments which are set by default not only those explicitly set
+ during this invocation.
+
+ When the value is nil, then that can be because no argument is set,
+ or because the current command wasn’t invoked from a popup at all.
+
+ -- Function: magit-current-popup-args &rest args
+
+ This function returns the value of the popup arguments for this
+ editing command. The value is the same as that of the variable by
+ the same name, except that FILTER is applied. FILTER is a list of
+ regexps; only arguments that match one of them are returned. The
+ first element of FILTER may also be ‘:not’ in which case only
+ arguments that don’t match any of the regexps are returned, or
+ ‘:only’ which doesn’t change the behavior.
+
+
+\1f
+Tag Table:
+Node: Top\7f769
+Node: Introduction\7f2004
+Node: Usage\7f4703
+Node: Customizing Existing Popups\7f9400
+Node: Other Options\7f15541
+Node: Defining Prefix and Suffix Commands\7f17084
+Node: Defining Prefix Commands\7f19236
+Node: Defining Suffix Commands\7f27931
+\1f
+End Tag Table
+
+\1f
+Local Variables:
+coding: utf-8
+End:
+++ /dev/null
-;;; popup-autoloads.el --- automatically extracted autoloads
-;;
-;;; Code:
-(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
-\f
-;;;### (autoloads nil nil ("popup.el") (22215 5356 951539 0))
-
-;;;***
-\f
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; End:
-;;; popup-autoloads.el ends here
+++ /dev/null
-(define-package "popup" "20151222.1339" "Visual Popup User Interface" '((cl-lib "0.5")) :keywords '("lisp"))
+++ /dev/null
-;;; popup.el --- Visual Popup User Interface
-
-;; Copyright (C) 2009-2015 Tomohiro Matsuyama
-
-;; Author: Tomohiro Matsuyama <m2ym.pubNOSPAMgmail.com>
-;; Keywords: lisp
-;; Package-Version: 20151222.1339
-;; Version: 0.5.3
-;; Package-Requires: ((cl-lib "0.5"))
-
-;; This program 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 of the License, or
-;; (at your option) any later version.
-
-;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; popup.el is a visual popup user interface library for Emacs. This
-;; provides a basic API and common UI widgets such as popup tooltips
-;; and popup menus.
-;; See README.markdown for more information.
-
-;;; Code:
-
-(require 'cl-lib)
-
-(defconst popup-version "0.5.3")
-
-\f
-
-;;; Utilities
-
-(defun popup-calculate-max-width (max-width)
- "Determines whether the width desired is
-character or window proportion based, And returns the result."
- (cl-typecase max-width
- (integer max-width)
- (float (* (ceiling (/ (round (* max-width (window-width))) 10.0)) 10))))
-
-(defvar popup-use-optimized-column-computation t
- "Use the optimized column computation routine.
-If there is a problem, please set it nil.")
-
-(defmacro popup-aif (test then &rest else)
- "Anaphoric if."
- (declare (indent 2))
- `(let ((it ,test))
- (if it ,then ,@else)))
-
-(defmacro popup-awhen (test &rest body)
- "Anaphoric when."
- (declare (indent 1))
- `(let ((it ,test))
- (when it ,@body)))
-
-(defun popup-x-to-string (x)
- "Convert any object to string effeciently.
-This is faster than `prin1-to-string' in many cases."
- (cl-typecase x
- (string x)
- (symbol (symbol-name x))
- (integer (number-to-string x))
- (float (number-to-string x))
- (t (format "%s" x))))
-
-(defun popup-substring-by-width (string width)
- "Return a cons cell of substring and remaining string by
-splitting with WIDTH."
- ;; Expand tabs into 4 spaces
- (setq string (replace-regexp-in-string "\t" " " string))
- (cl-loop with len = (length string)
- with w = 0
- for l from 0
- for c in (append string nil)
- while (<= (cl-incf w (char-width c)) width)
- finally return
- (if (< l len)
- (cons (substring string 0 l) (substring string l))
- (list string))))
-
-(defun popup-fill-string (string &optional width max-width justify squeeze)
- "Split STRING into fixed width strings and return a cons cell
-like \(WIDTH . ROWS). Here, the car WIDTH indicates the actual
-maxim width of ROWS.
-
-The argument WIDTH specifies the width of filling each
-paragraph. WIDTH nil means don't perform any justification and
-word wrap. Note that this function doesn't add any padding
-characters at the end of each row.
-
-MAX-WIDTH, if WIDTH is nil, specifies the maximum number of
-columns.
-
-The optional fourth argument JUSTIFY specifies which kind of
-justification to do: `full', `left', `right', `center', or
-`none' (equivalent to nil). A value of t means handle each
-paragraph as specified by its text properties.
-
-SQUEEZE nil means leave whitespaces other than line breaks
-untouched."
- (if (eq width 0)
- (error "Can't fill string with 0 width"))
- (if width
- (setq max-width width))
- (with-temp-buffer
- (let ((tab-width 4)
- (fill-column width)
- (left-margin 0)
- (kinsoku-limit 1)
- indent-tabs-mode
- row rows)
- (insert string)
- (untabify (point-min) (point-max))
- (if width
- (fill-region (point-min) (point-max) justify (not squeeze)))
- (goto-char (point-min))
- (setq width 0)
- (while (prog2
- (let ((line (buffer-substring
- (point) (progn (end-of-line) (point)))))
- (if max-width
- (while (progn
- (setq row (truncate-string-to-width line max-width)
- width (max width (string-width row)))
- (push row rows)
- (if (not (= (length row) (length line)))
- (setq line (substring line (length row))))))
- (setq width (max width (string-width line)))
- (push line rows)))
- (< (point) (point-max))
- (beginning-of-line 2)))
- (cons width (nreverse rows)))))
-
-(defmacro popup-save-buffer-state (&rest body)
- (declare (indent 0))
- `(save-excursion
- (let ((buffer-undo-list t)
- (inhibit-read-only t)
- (modified (buffer-modified-p)))
- (unwind-protect
- (progn ,@body)
- (set-buffer-modified-p modified)))))
-
-(defun popup-vertical-motion (column direction)
- "A portable version of `vertical-motion'."
- (if (>= emacs-major-version 23)
- (vertical-motion (cons column direction))
- (vertical-motion direction)
- (move-to-column (+ (current-column) column))))
-
-(defun popup-last-line-of-buffer-p ()
- "Return non-nil if the cursor is at the last line of the
-buffer."
- (save-excursion (end-of-line) (/= (forward-line) 0)))
-
-(defun popup-lookup-key-by-event (function event)
- (or (funcall function (vector event))
- (if (symbolp event)
- (popup-aif (get event 'event-symbol-element-mask)
- (funcall function
- (vector (logior (or (get (car it) 'ascii-character)
- 0)
- (cadr it))))))))
-
-\f
-
-;;; Core
-
-(defgroup popup nil
- "Visual Popup User Interface"
- :group 'lisp
- :prefix "popup-")
-
-(defface popup-face
- '((t (:background "lightgray" :foreground "black")))
- "Face for popup."
- :group 'popup)
-
-(defface popup-summary-face
- '((t (:inherit popup-face :foreground "dimgray")))
- "Face for popup summary."
- :group 'popup)
-
-(defface popup-scroll-bar-foreground-face
- '((t (:background "black")))
- "Foreground face for scroll-bar."
- :group 'popup)
-
-(defface popup-scroll-bar-background-face
- '((t (:background "gray")))
- "Background face for scroll-bar."
- :group 'popup)
-
-(defvar popup-instances nil
- "Popup instances.")
-
-(defvar popup-scroll-bar-foreground-char
- (propertize " " 'face 'popup-scroll-bar-foreground-face)
- "Foreground character for scroll-bar.")
-
-(defvar popup-scroll-bar-background-char
- (propertize " " 'face 'popup-scroll-bar-background-face)
- "Background character for scroll-bar.")
-
-(cl-defstruct popup
- point row column width height min-height direction overlays keymap
- parent depth
- face mouse-face selection-face summary-face
- margin-left margin-right margin-left-cancel scroll-bar symbol
- cursor offset scroll-top current-height list newlines
- pattern original-list invis-overlays)
-
-(defun popup-item-propertize (item &rest properties)
- "Same as `propertize' except that this avoids overriding
-existed value with `nil' property."
- (cl-loop for (k v) on properties by 'cddr
- if v append (list k v) into props
- finally return
- (apply 'propertize
- (popup-x-to-string item)
- props)))
-
-(defun popup-item-property (item property)
- "Same as `get-text-property' except that this returns nil if
-ITEM is not string."
- (if (stringp item)
- (get-text-property 0 property item)))
-
-(cl-defun popup-make-item (name
- &key
- value
- face
- mouse-face
- selection-face
- sublist
- document
- symbol
- summary)
- "Utility function to make popup item. See also
-`popup-item-propertize'."
- (popup-item-propertize name
- 'value value
- 'popup-face face
- 'popup-mouse-face mouse-face
- 'selection-face selection-face
- 'document document
- 'symbol symbol
- 'summary summary
- 'sublist sublist))
-
-(defsubst popup-item-value (item) (popup-item-property item 'value))
-(defsubst popup-item-value-or-self (item) (or (popup-item-value item) item))
-(defsubst popup-item-face (item) (popup-item-property item 'popup-face))
-(defsubst popup-item-mouse-face (item) (popup-item-property item 'popup-mouse-face))
-(defsubst popup-item-selection-face (item) (popup-item-property item 'selection-face))
-(defsubst popup-item-document (item) (popup-item-property item 'document))
-(defsubst popup-item-summary (item) (popup-item-property item 'summary))
-(defsubst popup-item-symbol (item) (popup-item-property item 'symbol))
-(defsubst popup-item-sublist (item) (popup-item-property item 'sublist))
-
-(defun popup-item-documentation (item)
- (let ((doc (popup-item-document item)))
- (if (functionp doc)
- (setq doc (funcall doc (popup-item-value-or-self item))))
- doc))
-
-(defun popup-item-show-help-1 (item)
- (let ((doc (popup-item-documentation item)))
- (when doc
- (with-current-buffer (get-buffer-create " *Popup Help*")
- (erase-buffer)
- (insert doc)
- (goto-char (point-min))
- (display-buffer (current-buffer)))
- t)))
-
-(defun popup-item-show-help-with-event-loop (item)
- (save-window-excursion
- (when (popup-item-show-help-1 item)
- (cl-loop do (clear-this-command-keys)
- for key = (read-key-sequence-vector nil)
- do
- (cl-case (key-binding key)
- (scroll-other-window
- (scroll-other-window))
- (scroll-other-window-down
- (scroll-other-window-down nil))
- (otherwise
- (setq unread-command-events (append key unread-command-events))
- (cl-return)))))))
-
-(defun popup-item-show-help (item &optional persist)
- "Display the documentation of ITEM with `display-buffer'. If
-PERSIST is nil, the documentation buffer will be closed
-automatically, meaning interal event loop ensures the buffer to
-be closed. Otherwise, the buffer will be just displayed as
-usual."
- (when item
- (if (not persist)
- (popup-item-show-help-with-event-loop item)
- (popup-item-show-help-1 item))))
-
-(defun popup-set-list (popup list)
- (popup-set-filtered-list popup list)
- (setf (popup-pattern popup) nil)
- (setf (popup-original-list popup) list))
-
-(defun popup-set-filtered-list (popup list)
- (let ((offset
- (if (> (popup-direction popup) 0)
- 0
- (max (- (popup-height popup) (length list)) 0))))
- (setf (popup-list popup) list
- (popup-offset popup) offset)))
-
-(defun popup-selected-item (popup)
- (nth (popup-cursor popup) (popup-list popup)))
-
-(defun popup-selected-line (popup)
- (- (popup-cursor popup) (popup-scroll-top popup)))
-
-(defun popup-line-overlay (popup line)
- (aref (popup-overlays popup) line))
-
-(defun popup-selected-line-overlay (popup)
- (popup-line-overlay popup (popup-selected-line popup)))
-
-(defun popup-hide-line (popup line)
- (let ((overlay (popup-line-overlay popup line)))
- (overlay-put overlay 'display nil)
- (overlay-put overlay 'after-string nil)))
-
-(defun popup-line-hidden-p (popup line)
- (let ((overlay (popup-line-overlay popup line)))
- (and (eq (overlay-get overlay 'display) nil)
- (eq (overlay-get overlay 'after-string) nil))))
-
-(cl-defun popup-set-line-item (popup
- line
- &key
- item
- face
- mouse-face
- margin-left
- margin-right
- scroll-bar-char
- symbol
- summary
- summary-face
- keymap)
- (let* ((overlay (popup-line-overlay popup line))
- (content (popup-create-line-string popup (popup-x-to-string item)
- :margin-left margin-left
- :margin-right margin-right
- :symbol symbol
- :summary summary
- :summary-face summary-face))
- (start 0)
- (prefix (overlay-get overlay 'prefix))
- (postfix (overlay-get overlay 'postfix))
- end)
- (put-text-property 0 (length content) 'popup-item item content)
- (put-text-property 0 (length content) 'keymap keymap content)
- ;; Overlap face properties
- (when (get-text-property start 'face content)
- (setq start (next-single-property-change start 'face content)))
- (while (and start (setq end (next-single-property-change start 'face content)))
- (put-text-property start end 'face face content)
- (setq start (next-single-property-change end 'face content)))
- (when start
- (put-text-property start (length content) 'face face content))
- (when mouse-face
- (put-text-property 0 (length content) 'mouse-face mouse-face content))
- (let ((prop (if (overlay-get overlay 'dangle)
- 'after-string
- 'display)))
- (overlay-put overlay
- prop
- (concat prefix
- content
- scroll-bar-char
- postfix)))))
-
-(cl-defun popup-create-line-string (popup
- string
- &key
- margin-left
- margin-right
- symbol
- summary
- summary-face)
- (let* ((popup-width (popup-width popup))
- (summary-width (string-width summary))
- (content-width (max
- (min popup-width (string-width string))
- (- popup-width
- (if (> summary-width 0)
- (+ summary-width 2)
- 0))))
- (string (car (popup-substring-by-width string content-width)))
- (string-width (string-width string))
- (spacing (max (- popup-width string-width summary-width)
- (if (> popup-width string-width) 1 0)))
- (truncated-summary
- (car (popup-substring-by-width
- summary (max (- popup-width string-width spacing) 0)))))
- (when summary-face
- (put-text-property 0 (length truncated-summary)
- 'face summary-face truncated-summary))
- (concat margin-left
- string
- (make-string spacing ? )
- truncated-summary
- symbol
- margin-right)))
-
-(defun popup-live-p (popup)
- "Return non-nil if POPUP is alive."
- (and popup (popup-overlays popup) t))
-
-(defun popup-child-point (popup &optional offset)
- (overlay-end
- (popup-line-overlay
- popup
- (or offset
- (popup-selected-line popup)))))
-
-(defun popup-calculate-direction (height row)
- "Return a proper direction when displaying a popup on this
-window. HEIGHT is the a height of the popup, and ROW is a line
-number at the point."
- (let* ((remaining-rows (- (max 1 (- (window-height)
- (if mode-line-format 1 0)
- (if header-line-format 1 0)))
- (count-lines (window-start) (point))))
- (enough-space-above (> row height))
- (enough-space-below (<= height remaining-rows)))
- (if (and enough-space-above
- (not enough-space-below))
- -1
- 1)))
-
-(cl-defun popup-create (point
- width
- height
- &key
- min-height
- max-width
- around
- (face 'popup-face)
- mouse-face
- (selection-face face)
- (summary-face 'popup-summary-face)
- scroll-bar
- margin-left
- margin-right
- symbol
- parent
- parent-offset
- keymap)
- "Create a popup instance at POINT with WIDTH and HEIGHT.
-
-MIN-HEIGHT is a minimal height of the popup. The default value is
-0.
-
-MAX-WIDTH is the maximum width of the popup. The default value is
-nil (no limit). If a floating point, the value refers to the ratio of
-the window. If an integer, limit is in characters.
-
-If AROUND is non-nil, the popup will be displayed around the
-point but not at the point.
-
-FACE is a background face of the popup. The default value is POPUP-FACE.
-
-SELECTION-FACE is a foreground (selection) face of the popup The
-default value is POPUP-FACE.
-
-If SCROLL-BAR is non-nil, the popup will have a scroll bar at the
-right.
-
-If MARGIN-LEFT is non-nil, the popup will have a margin at the
-left.
-
-If MARGIN-RIGHT is non-nil, the popup will have a margin at the
-right.
-
-SYMBOL is a single character which indicates a kind of the item.
-
-PARENT is a parent popup instance. If PARENT is omitted, the
-popup will be a root instance.
-
-PARENT-OFFSET is a row offset from the parent popup.
-
-KEYMAP is a keymap that will be put on the popup contents."
- (or margin-left (setq margin-left 0))
- (or margin-right (setq margin-right 0))
- (unless point
- (setq point
- (if parent (popup-child-point parent parent-offset) (point))))
- (when max-width
- (setq width (min width (popup-calculate-max-width max-width))))
- (save-excursion
- (goto-char point)
- (let* ((col-row (posn-col-row (posn-at-point)))
- (row (cdr col-row))
- (column (car col-row))
- (overlays (make-vector height nil))
- (popup-width (+ width
- (if scroll-bar 1 0)
- margin-left
- margin-right
- (if symbol 2 0)))
- margin-left-cancel
- (window (selected-window))
- (window-start (window-start))
- (window-hscroll (window-hscroll))
- (window-width (window-width))
- (right (+ column popup-width))
- (overflow (and (> right window-width)
- (>= right popup-width)))
- (foldable (and (null parent)
- (>= column popup-width)))
- (direction (or
- ;; Currently the direction of cascade popup won't be changed
- (and parent (popup-direction parent))
-
- ;; Calculate direction
- (popup-calculate-direction height row)))
- (depth (if parent (1+ (popup-depth parent)) 0))
- (newlines (max 0 (+ (- height (count-lines point (point-max))) (if around 1 0))))
- invis-overlays
- current-column)
- ;; Case: no newlines at the end of the buffer
- (when (> newlines 0)
- (popup-save-buffer-state
- (goto-char (point-max))
- (insert (make-string newlines ?\n))))
-
- ;; Case: the popup overflows
- (if overflow
- (if foldable
- (progn
- (cl-decf column (- popup-width margin-left margin-right))
- (unless around (move-to-column column)))
- (when (not truncate-lines)
- ;; Truncate.
- (let ((d (1+ (- popup-width (- window-width column)))))
- (cl-decf popup-width d)
- (cl-decf width d)))
- (cl-decf column margin-left))
- (cl-decf column margin-left))
-
- ;; Case: no space at the left
- (when (and (null parent)
- (< column 0))
- ;; Cancel margin left
- (setq column 0)
- (cl-decf popup-width margin-left)
- (setq margin-left-cancel t))
-
- (dotimes (i height)
- (let (overlay begin w (dangle t) (prefix "") (postfix ""))
- (when around
- (popup-vertical-motion column direction))
- (cl-loop for ov in (overlays-in (save-excursion
- (beginning-of-visual-line)
- (point))
- (save-excursion
- (end-of-visual-line)
- (point)))
- when (and (not (overlay-get ov 'popup))
- (not (overlay-get ov 'popup-item))
- (or (overlay-get ov 'invisible)
- (overlay-get ov 'display)))
- do (progn
- (push (list ov (overlay-get ov 'display)) invis-overlays)
- (overlay-put ov 'display "")))
- (setq around t)
- (setq current-column (car (posn-col-row (posn-at-point))))
-
- (when (< current-column column)
- ;; Extend short buffer lines by popup prefix (line of spaces)
- (setq prefix (make-string
- (+ (if (= current-column 0)
- (- window-hscroll current-column)
- 0)
- (- column current-column))
- ? )))
-
- (setq begin (point))
- (setq w (+ popup-width (length prefix)))
- (while (and (not (eolp)) (> w 0))
- (setq dangle nil)
- (cl-decf w (char-width (char-after)))
- (forward-char))
- (if (< w 0)
- (setq postfix (make-string (- w) ? )))
-
- (setq overlay (make-overlay begin (point)))
- (overlay-put overlay 'popup t)
- (overlay-put overlay 'window window)
- (overlay-put overlay 'dangle dangle)
- (overlay-put overlay 'prefix prefix)
- (overlay-put overlay 'postfix postfix)
- (overlay-put overlay 'width width)
- (aset overlays
- (if (> direction 0) i (- height i 1))
- overlay)))
- (cl-loop for p from (- 10000 (* depth 1000))
- for overlay in (nreverse (append overlays nil))
- do (overlay-put overlay 'priority p))
- (let ((it (make-popup :point point
- :row row
- :column column
- :width width
- :height height
- :min-height min-height
- :direction direction
- :parent parent
- :depth depth
- :face face
- :mouse-face mouse-face
- :selection-face selection-face
- :summary-face summary-face
- :margin-left margin-left
- :margin-right margin-right
- :margin-left-cancel margin-left-cancel
- :scroll-bar scroll-bar
- :symbol symbol
- :cursor 0
- :offset 0
- :scroll-top 0
- :current-height 0
- :list nil
- :newlines newlines
- :overlays overlays
- :invis-overlays invis-overlays
- :keymap keymap)))
- (push it popup-instances)
- it))))
-
-(defun popup-delete (popup)
- "Delete POPUP instance."
- (when (popup-live-p popup)
- (popup-hide popup)
- (mapc 'delete-overlay (popup-overlays popup))
- (setf (popup-overlays popup) nil)
- (setq popup-instances (delq popup popup-instances))
- ;; Restore newlines state
- (let ((newlines (popup-newlines popup)))
- (when (> newlines 0)
- (popup-save-buffer-state
- (goto-char (point-max))
- (dotimes (i newlines)
- (if (and (char-before)
- (= (char-before) ?\n))
- (delete-char -1)))))))
- nil)
-
-(defun popup-draw (popup)
- "Draw POPUP."
- (cl-loop for (ov olddisplay) in (popup-invis-overlays popup)
- do (overlay-put ov 'display ""))
-
- (cl-loop with height = (popup-height popup)
- with min-height = (popup-min-height popup)
- with popup-face = (popup-face popup)
- with mouse-face = (popup-mouse-face popup)
- with selection-face = (popup-selection-face popup)
- with summary-face-0 = (popup-summary-face popup)
- with list = (popup-list popup)
- with length = (length list)
- with thum-size = (max (/ (* height height) (max length 1)) 1)
- with page-size = (/ (+ 0.0 (max length 1)) height)
- with scroll-bar = (popup-scroll-bar popup)
- with margin-left = (make-string (if (popup-margin-left-cancel popup) 0 (popup-margin-left popup)) ? )
- with margin-right = (make-string (popup-margin-right popup) ? )
- with symbol = (popup-symbol popup)
- with cursor = (popup-cursor popup)
- with scroll-top = (popup-scroll-top popup)
- with offset = (popup-offset popup)
- with keymap = (popup-keymap popup)
- for o from offset
- for i from scroll-top
- while (< o height)
- for item in (nthcdr scroll-top list)
- for page-index = (* thum-size (/ o thum-size))
- for face = (if (= i cursor)
- (or (popup-item-selection-face item) selection-face)
- (or (popup-item-face item) popup-face))
- for summary-face = (unless (= i cursor) summary-face-0)
- for empty-char = (propertize " " 'face face)
- for scroll-bar-char = (if scroll-bar
- (cond
- ((and (not (eq scroll-bar :always))
- (<= page-size 1))
- empty-char)
- ((and (> page-size 1)
- (>= cursor (* page-index page-size))
- (< cursor (* (+ page-index thum-size) page-size)))
- popup-scroll-bar-foreground-char)
- (t
- popup-scroll-bar-background-char))
- "")
- for sym = (if symbol
- (concat " " (or (popup-item-symbol item) " "))
- "")
- for summary = (or (popup-item-summary item) "")
-
- do
- ;; Show line and set item to the line
- (popup-set-line-item popup o
- :item item
- :face face
- :mouse-face mouse-face
- :margin-left margin-left
- :margin-right margin-right
- :scroll-bar-char scroll-bar-char
- :symbol sym
- :summary summary
- :summary-face summary-face
- :keymap keymap)
-
- finally
- ;; Remember current height
- (setf (popup-current-height popup) (- o offset))
-
- ;; Hide remaining lines
- (let ((scroll-bar-char (if scroll-bar (propertize " " 'face popup-face) ""))
- (symbol (if symbol " " "")))
- (if (> (popup-direction popup) 0)
- (progn
- (when min-height
- (while (< o min-height)
- (popup-set-line-item popup o
- :item ""
- :face popup-face
- :margin-left margin-left
- :margin-right margin-right
- :scroll-bar-char scroll-bar-char
- :symbol symbol
- :summary "")
- (cl-incf o)))
- (while (< o height)
- (popup-hide-line popup o)
- (cl-incf o)))
- (cl-loop with h = (if min-height (- height min-height) offset)
- for o from 0 below offset
- if (< o h)
- do (popup-hide-line popup o)
- if (>= o h)
- do (popup-set-line-item popup o
- :item ""
- :face popup-face
- :margin-left margin-left
- :margin-right margin-right
- :scroll-bar-char scroll-bar-char
- :symbol symbol
- :summary ""))))))
-
-(defun popup-hide (popup)
- "Hide POPUP."
- (cl-loop for (ov olddisplay) in (popup-invis-overlays popup)
- do (overlay-put ov 'display olddisplay))
- (dotimes (i (popup-height popup))
- (popup-hide-line popup i)))
-
-(defun popup-hidden-p (popup)
- "Return non-nil if POPUP is hidden."
- (let ((hidden t))
- (when (popup-live-p popup)
- (dotimes (i (popup-height popup))
- (unless (popup-line-hidden-p popup i)
- (setq hidden nil))))
- hidden))
-
-(defun popup-jump (popup cursor)
- "Jump to a position specified by CURSOR of POPUP and draw."
- (let ((scroll-top (popup-scroll-top popup)))
- ;; Do not change page as much as possible.
- (unless (and (<= scroll-top cursor)
- (< cursor (+ scroll-top (popup-height popup))))
- (setf (popup-scroll-top popup) cursor))
- (setf (popup-cursor popup) cursor)
- (popup-draw popup)))
-
-(defun popup-select (popup i)
- "Select the item at I of POPUP and draw."
- (setq i (+ i (popup-offset popup)))
- (when (and (<= 0 i) (< i (popup-height popup)))
- (setf (popup-cursor popup) i)
- (popup-draw popup)
- t))
-
-(defun popup-next (popup)
- "Select the next item of POPUP and draw."
- (let ((height (popup-height popup))
- (cursor (1+ (popup-cursor popup)))
- (scroll-top (popup-scroll-top popup))
- (length (length (popup-list popup))))
- (cond
- ((>= cursor length)
- ;; Back to first page
- (setq cursor 0
- scroll-top 0))
- ((= cursor (+ scroll-top height))
- ;; Go to next page
- (setq scroll-top (min (1+ scroll-top) (max (- length height) 0)))))
- (setf (popup-cursor popup) cursor
- (popup-scroll-top popup) scroll-top)
- (popup-draw popup)))
-
-(defun popup-previous (popup)
- "Select the previous item of POPUP and draw."
- (let ((height (popup-height popup))
- (cursor (1- (popup-cursor popup)))
- (scroll-top (popup-scroll-top popup))
- (length (length (popup-list popup))))
- (cond
- ((< cursor 0)
- ;; Go to last page
- (setq cursor (1- length)
- scroll-top (max (- length height) 0)))
- ((= cursor (1- scroll-top))
- ;; Go to previous page
- (cl-decf scroll-top)))
- (setf (popup-cursor popup) cursor
- (popup-scroll-top popup) scroll-top)
- (popup-draw popup)))
-
-(defun popup-page-next (popup)
- "Select next item of POPUP per `popup-height' range.
-Pages down through POPUP."
- (dotimes (counter (1- (popup-height popup)))
- (popup-next popup)))
-
-(defun popup-page-previous (popup)
- "Select previous item of POPUP per `popup-height' range.
-Pages up through POPUP."
- (dotimes (counter (1- (popup-height popup)))
- (popup-previous popup)))
-
-(defun popup-scroll-down (popup &optional n)
- "Scroll down N of POPUP and draw."
- (let ((scroll-top (min (+ (popup-scroll-top popup) (or n 1))
- (- (length (popup-list popup)) (popup-height popup)))))
- (setf (popup-cursor popup) scroll-top
- (popup-scroll-top popup) scroll-top)
- (popup-draw popup)))
-
-(defun popup-scroll-up (popup &optional n)
- "Scroll up N of POPUP and draw."
- (let ((scroll-top (max (- (popup-scroll-top popup) (or n 1))
- 0)))
- (setf (popup-cursor popup) scroll-top
- (popup-scroll-top popup) scroll-top)
- (popup-draw popup)))
-
-\f
-
-;;; Popup Incremental Search
-
-(defface popup-isearch-match
- '((t (:background "sky blue")))
- "Popup isearch match face."
- :group 'popup)
-
-(defvar popup-isearch-cursor-color "blue")
-
-(defvar popup-isearch-keymap
- (let ((map (make-sparse-keymap)))
- ;(define-key map "\r" 'popup-isearch-done)
- (define-key map "\C-g" 'popup-isearch-cancel)
- (define-key map "\C-b" 'popup-isearch-close)
- (define-key map [left] 'popup-isearch-close)
- (define-key map "\C-h" 'popup-isearch-delete)
- (define-key map (kbd "DEL") 'popup-isearch-delete)
- map))
-
-(defvar popup-menu-show-quick-help-function 'popup-menu-show-quick-help
- "Function used for showing quick help by `popup-menu*'.")
-
-(defcustom popup-isearch-regexp-builder-function #'regexp-quote
- "Function used to construct a regexp from a pattern. You may for instance
- provide a function that replaces spaces by '.+' if you like helm or ivy style
- of completion."
- :type 'function)
-
-(defsubst popup-isearch-char-p (char)
- (and (integerp char)
- (<= 32 char)
- (<= char 126)))
-
-(defun popup-isearch-filter-list (pattern list)
- (cl-loop with regexp = (funcall popup-isearch-regexp-builder-function pattern)
- for item in list
- do
- (unless (stringp item)
- (setq item (popup-item-propertize (popup-x-to-string item)
- 'value item)))
- if (string-match regexp item)
- collect
- (let ((beg (match-beginning 0))
- (end (match-end 0)))
- (alter-text-property 0 (length item) 'face
- (lambda (prop)
- (unless (eq prop 'popup-isearch-match)
- prop))
- item)
- (put-text-property beg end
- 'face 'popup-isearch-match
- item)
- item)))
-
-(defun popup-isearch-prompt (popup pattern)
- (format "Pattern: %s" (if (= (length (popup-list popup)) 0)
- (propertize pattern 'face 'isearch-fail)
- pattern)))
-
-(defun popup-isearch-update (popup filter pattern &optional callback)
- (setf (popup-cursor popup) 0
- (popup-scroll-top popup) 0
- (popup-pattern popup) pattern)
- (let ((list (funcall filter pattern (popup-original-list popup))))
- (popup-set-filtered-list popup list)
- (if callback
- (funcall callback list)))
- (popup-draw popup))
-
-(cl-defun popup-isearch (popup
- &key
- (filter 'popup-isearch-filter-list)
- (cursor-color popup-isearch-cursor-color)
- (keymap popup-isearch-keymap)
- callback
- help-delay)
- "Start isearch on POPUP. This function is synchronized, meaning
-event loop waits for quiting of isearch.
-
-FILTER is function with two argumenst to perform popup items filtering.
-
-CURSOR-COLOR is a cursor color during isearch. The default value
-is `popup-isearch-cursor-color'.
-
-KEYMAP is a keymap which is used when processing events during
-event loop. The default value is `popup-isearch-keymap'.
-
-CALLBACK is a function taking one argument. `popup-isearch' calls
-CALLBACK, if specified, after isearch finished or isearch
-canceled. The arguments is whole filtered list of items.
-
-HELP-DELAY is a delay of displaying helps."
- (let ((list (popup-original-list popup))
- (pattern (or (popup-pattern popup) ""))
- (old-cursor-color (frame-parameter (selected-frame) 'cursor-color))
- prompt key binding)
- (unwind-protect
- (cl-block nil
- (if cursor-color
- (set-cursor-color cursor-color))
- (while t
- (setq prompt (popup-isearch-prompt popup pattern))
- (setq key (popup-menu-read-key-sequence keymap prompt help-delay))
- (if (null key)
- (unless (funcall popup-menu-show-quick-help-function popup nil :prompt prompt)
- (clear-this-command-keys)
- (push (read-event prompt) unread-command-events))
- (setq binding (lookup-key keymap key))
- (cond
- ((and (stringp key)
- (popup-isearch-char-p (aref key 0)))
- (setq pattern (concat pattern key)))
- ((eq binding 'popup-isearch-done)
- (cl-return nil))
- ((eq binding 'popup-isearch-cancel)
- (popup-isearch-update popup filter "" callback)
- (cl-return t))
- ((eq binding 'popup-isearch-close)
- (popup-isearch-update popup filter "" callback)
- (setq unread-command-events
- (append (listify-key-sequence key) unread-command-events))
- (cl-return nil))
- ((eq binding 'popup-isearch-delete)
- (if (> (length pattern) 0)
- (setq pattern (substring pattern 0 (1- (length pattern))))))
- (t
- (setq unread-command-events
- (append (listify-key-sequence key) unread-command-events))
- (cl-return nil)))
- (popup-isearch-update popup filter pattern callback))))
- (if old-cursor-color
- (set-cursor-color old-cursor-color)))))
-
-\f
-
-;;; Popup Tip
-
-(defface popup-tip-face
- '((t (:background "khaki1" :foreground "black")))
- "Face for popup tip."
- :group 'popup)
-
-(defvar popup-tip-max-width 80)
-
-(cl-defun popup-tip (string
- &key
- point
- (around t)
- width
- (height 15)
- min-height
- max-width
- truncate
- margin
- margin-left
- margin-right
- scroll-bar
- parent
- parent-offset
- nowait
- nostrip
- prompt
- &aux tip lines)
- "Show a tooltip of STRING at POINT. This function is
-synchronized unless NOWAIT specified. Almost all arguments are
-the same as in `popup-create', except for TRUNCATE, NOWAIT, and
-PROMPT.
-
-If TRUNCATE is non-nil, the tooltip can be truncated.
-
-If NOWAIT is non-nil, this function immediately returns the
-tooltip instance without entering event loop.
-
-If `NOSTRIP` is non-nil, `STRING` properties are not stripped.
-
-PROMPT is a prompt string when reading events during event loop."
- (if (bufferp string)
- (setq string (with-current-buffer string (buffer-string))))
-
- (unless nostrip
- ;; TODO strip text (mainly face) properties
- (setq string (substring-no-properties string)))
-
- (and (eq margin t) (setq margin 1))
- (or margin-left (setq margin-left margin))
- (or margin-right (setq margin-right margin))
-
- (let ((it (popup-fill-string string width popup-tip-max-width)))
- (setq width (car it)
- lines (cdr it)))
-
- (setq tip (popup-create point width height
- :min-height min-height
- :max-width max-width
- :around around
- :margin-left margin-left
- :margin-right margin-right
- :scroll-bar scroll-bar
- :face 'popup-tip-face
- :parent parent
- :parent-offset parent-offset))
-
- (unwind-protect
- (when (> (popup-width tip) 0) ; not to be corrupted
- (when (and (not (eq width (popup-width tip))) ; truncated
- (not truncate))
- ;; Refill once again to lines be fitted to popup width
- (setq width (popup-width tip))
- (setq lines (cdr (popup-fill-string string width width))))
-
- (popup-set-list tip lines)
- (popup-draw tip)
- (if nowait
- tip
- (clear-this-command-keys)
- (push (read-event prompt) unread-command-events)
- t))
- (unless nowait
- (popup-delete tip))))
-
-\f
-
-;;; Popup Menu
-
-(defface popup-menu-face
- '((t (:inherit popup-face)))
- "Face for popup menu."
- :group 'popup)
-
-(defface popup-menu-mouse-face
- '((t (:background "blue" :foreground "white")))
- "Face for popup menu."
- :group 'popup)
-
-(defface popup-menu-selection-face
- '((t (:background "steelblue" :foreground "white")))
- "Face for popup menu selection."
- :group 'popup)
-
-(defface popup-menu-summary-face
- '((t (:inherit popup-summary-face)))
- "Face for popup summary."
- :group 'popup)
-
-(defvar popup-menu-show-tip-function 'popup-tip
- "Function used for showing tooltip by `popup-menu-show-quick-help'.")
-
-(defun popup-menu-show-help (menu &optional persist item)
- (popup-item-show-help (or item (popup-selected-item menu)) persist))
-
-(defun popup-menu-documentation (menu &optional item)
- (popup-item-documentation (or item (popup-selected-item menu))))
-
-(defun popup-menu-show-quick-help (menu &optional item &rest args)
- (let* ((point (plist-get args :point))
- (height (or (plist-get args :height) (popup-height menu)))
- (min-height (min height (popup-current-height menu)))
- (around nil)
- (parent-offset (popup-offset menu))
- (doc (popup-menu-documentation menu item)))
- (when (stringp doc)
- (if (popup-hidden-p menu)
- (setq around t
- menu nil
- parent-offset nil)
- (setq point nil))
- (let ((popup-use-optimized-column-computation nil)) ; To avoid wrong positioning
- (apply popup-menu-show-tip-function
- doc
- :point point
- :height height
- :min-height min-height
- :around around
- :parent menu
- :parent-offset parent-offset
- args)))))
-
-(defun popup-menu-item-of-mouse-event (event)
- (when (and (consp event)
- (memq (cl-first event) '(mouse-1 mouse-2 mouse-3 mouse-4 mouse-5)))
- (let* ((position (cl-second event))
- (object (elt position 4)))
- (when (consp object)
- (get-text-property (cdr object) 'popup-item (car object))))))
-
-(defun popup-menu-read-key-sequence (keymap &optional prompt timeout)
- (catch 'timeout
- (let ((timer (and timeout
- (run-with-timer timeout nil
- (lambda ()
- (if (zerop (length (this-command-keys)))
- (throw 'timeout nil))))))
- (old-global-map (current-global-map))
- (temp-global-map (make-sparse-keymap))
- (overriding-terminal-local-map (make-sparse-keymap)))
- (substitute-key-definition 'keyboard-quit 'keyboard-quit
- temp-global-map old-global-map)
- (define-key temp-global-map [menu-bar] (lookup-key old-global-map [menu-bar]))
- (define-key temp-global-map [tool-bar] (lookup-key old-global-map [tool-bar]))
- (set-keymap-parent overriding-terminal-local-map keymap)
- (if (current-local-map)
- (define-key overriding-terminal-local-map [menu-bar]
- (lookup-key (current-local-map) [menu-bar])))
- (unwind-protect
- (progn
- (use-global-map temp-global-map)
- (clear-this-command-keys)
- (with-temp-message prompt
- (read-key-sequence nil)))
- (use-global-map old-global-map)
- (if timer (cancel-timer timer))))))
-
-(defun popup-menu-fallback (event default))
-
-(cl-defun popup-menu-event-loop (menu
- keymap
- fallback
- &key
- prompt
- help-delay
- isearch
- isearch-filter
- isearch-cursor-color
- isearch-keymap
- isearch-callback
- &aux key binding)
- (cl-block nil
- (while (popup-live-p menu)
- (and isearch
- (popup-isearch menu
- :filter isearch-filter
- :cursor-color isearch-cursor-color
- :keymap isearch-keymap
- :callback isearch-callback
- :help-delay help-delay)
- (keyboard-quit))
- (setq key (popup-menu-read-key-sequence keymap prompt help-delay))
- (setq binding (and key (lookup-key keymap key)))
- (cond
- ((or (null key) (zerop (length key)))
- (unless (funcall popup-menu-show-quick-help-function menu nil :prompt prompt)
- (clear-this-command-keys)
- (push (read-event prompt) unread-command-events)))
- ((eq (lookup-key (current-global-map) key) 'keyboard-quit)
- (keyboard-quit)
- (cl-return))
- ((eq binding 'popup-close)
- (if (popup-parent menu)
- (cl-return)))
- ((memq binding '(popup-select popup-open))
- (let* ((item (or (popup-menu-item-of-mouse-event (elt key 0))
- (popup-selected-item menu)))
- (index (cl-position item (popup-list menu)))
- (sublist (popup-item-sublist item)))
- (unless index (cl-return))
- (if sublist
- (popup-aif (let (popup-use-optimized-column-computation)
- (popup-cascade-menu sublist
- :around nil
- :margin-left (popup-margin-left menu)
- :margin-right (popup-margin-right menu)
- :scroll-bar (popup-scroll-bar menu)
- :parent menu
- :parent-offset index
- :help-delay help-delay
- :isearch isearch
- :isearch-filter isearch-filter
- :isearch-cursor-color isearch-cursor-color
- :isearch-keymap isearch-keymap
- :isearch-callback isearch-callback))
- (and it (cl-return it)))
- (if (eq binding 'popup-select)
- (cl-return (popup-item-value-or-self item))))))
- ((eq binding 'popup-next)
- (popup-next menu))
- ((eq binding 'popup-previous)
- (popup-previous menu))
- ((eq binding 'popup-page-next)
- (popup-page-next menu))
- ((eq binding 'popup-page-previous)
- (popup-page-previous menu))
- ((eq binding 'popup-help)
- (popup-menu-show-help menu))
- ((eq binding 'popup-isearch)
- (popup-isearch menu
- :filter 'isearch-filter
- :cursor-color isearch-cursor-color
- :keymap isearch-keymap
- :callback isearch-callback
- :help-delay help-delay))
- ((commandp binding)
- (call-interactively binding))
- (t
- (funcall fallback key (key-binding key)))))))
-
-(defun popup-preferred-width (list)
- "Return the preferred width to show LIST beautifully."
- (cl-loop with tab-width = 4
- for item in list
- for summary = (popup-item-summary item)
- maximize (string-width (popup-x-to-string item)) into width
- if (stringp summary)
- maximize (+ (string-width summary) 2) into summary-width
- finally return
- (let ((total (+ (or width 0) (or summary-width 0))))
- (* (ceiling (/ total 10.0)) 10))))
-
-(defvar popup-menu-keymap
- (let ((map (make-sparse-keymap)))
- (define-key map "\r" 'popup-select)
- (define-key map "\C-f" 'popup-open)
- (define-key map [right] 'popup-open)
- (define-key map "\C-b" 'popup-close)
- (define-key map [left] 'popup-close)
-
- (define-key map "\C-n" 'popup-next)
- (define-key map [down] 'popup-next)
- (define-key map "\C-p" 'popup-previous)
- (define-key map [up] 'popup-previous)
-
- (define-key map [next] 'popup-page-next)
- (define-key map [prior] 'popup-page-previous)
-
- (define-key map [f1] 'popup-help)
- (define-key map (kbd "\C-?") 'popup-help)
-
- (define-key map "\C-s" 'popup-isearch)
-
- (define-key map [mouse-1] 'popup-select)
- (define-key map [mouse-4] 'popup-previous)
- (define-key map [mouse-5] 'popup-next)
- map))
-
-(cl-defun popup-menu* (list
- &key
- point
- (around t)
- (width (popup-preferred-width list))
- (height 15)
- max-width
- margin
- margin-left
- margin-right
- scroll-bar
- symbol
- parent
- parent-offset
- cursor
- (keymap popup-menu-keymap)
- (fallback 'popup-menu-fallback)
- help-delay
- nowait
- prompt
- isearch
- (isearch-filter 'popup-isearch-filter-list)
- (isearch-cursor-color popup-isearch-cursor-color)
- (isearch-keymap popup-isearch-keymap)
- isearch-callback
- initial-index
- &aux menu event)
- "Show a popup menu of LIST at POINT. This function returns a
-value of the selected item. Almost all arguments are the same as in
-`popup-create', except for KEYMAP, FALLBACK, HELP-DELAY, PROMPT,
-ISEARCH, ISEARCH-FILTER, ISEARCH-CURSOR-COLOR, ISEARCH-KEYMAP, and
-ISEARCH-CALLBACK.
-
-If KEYMAP is a keymap which is used when processing events during
-event loop.
-
-If FALLBACK is a function taking two arguments; a key and a
-command. FALLBACK is called when no special operation is found on
-the key. The default value is `popup-menu-fallback', which does
-nothing.
-
-HELP-DELAY is a delay of displaying helps.
-
-If NOWAIT is non-nil, this function immediately returns the menu
-instance without entering event loop.
-
-PROMPT is a prompt string when reading events during event loop.
-
-If ISEARCH is non-nil, do isearch as soon as displaying the popup
-menu.
-
-ISEARCH-FILTER is a filtering function taking two arguments:
-search pattern and list of items. Returns a list of matching items.
-
-ISEARCH-CURSOR-COLOR is a cursor color during isearch. The
-default value is `popup-isearch-cursor-color'.
-
-ISEARCH-KEYMAP is a keymap which is used when processing events
-during event loop. The default value is `popup-isearch-keymap'.
-
-ISEARCH-CALLBACK is a function taking one argument. `popup-menu'
-calls ISEARCH-CALLBACK, if specified, after isearch finished or
-isearch canceled. The arguments is whole filtered list of items.
-
-If `INITIAL-INDEX' is non-nil, this is an initial index value for
-`popup-select'. Only positive integer is valid."
- (and (eq margin t) (setq margin 1))
- (or margin-left (setq margin-left margin))
- (or margin-right (setq margin-right margin))
- (if (and scroll-bar
- (integerp margin-right)
- (> margin-right 0))
- ;; Make scroll-bar space as margin-right
- (cl-decf margin-right))
- (setq menu (popup-create point width height
- :max-width max-width
- :around around
- :face 'popup-menu-face
- :mouse-face 'popup-menu-mouse-face
- :selection-face 'popup-menu-selection-face
- :summary-face 'popup-menu-summary-face
- :margin-left margin-left
- :margin-right margin-right
- :scroll-bar scroll-bar
- :symbol symbol
- :parent parent
- :parent-offset parent-offset))
- (unwind-protect
- (progn
- (popup-set-list menu list)
- (if cursor
- (popup-jump menu cursor)
- (popup-draw menu))
- (when initial-index
- (dotimes (_i (min (- (length list) 1) initial-index))
- (popup-next menu)))
- (if nowait
- menu
- (popup-menu-event-loop menu keymap fallback
- :prompt prompt
- :help-delay help-delay
- :isearch isearch
- :isearch-filter isearch-filter
- :isearch-cursor-color isearch-cursor-color
- :isearch-keymap isearch-keymap
- :isearch-callback isearch-callback)))
- (unless nowait
- (popup-delete menu))))
-
-(defun popup-cascade-menu (list &rest args)
- "Same as `popup-menu' except that an element of LIST can be
-also a sub-menu if the element is a cons cell formed (ITEM
-. SUBLIST) where ITEM is an usual item and SUBLIST is a list of
-the sub menu."
- (apply 'popup-menu*
- (mapcar (lambda (item)
- (if (consp item)
- (popup-make-item (car item)
- :sublist (cdr item)
- :symbol ">")
- item))
- list)
- :symbol t
- args))
-
-(provide 'popup)
-;;; popup.el ends here
--- /dev/null
+;;; popup-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+
+(add-to-list 'load-path (directory-file-name
+ (or (file-name-directory #$) (car load-path))))
+
+\f
+;;;### (autoloads nil "popup" "popup.el" (0 0 0 0))
+;;; Generated autoloads from popup.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "popup" '("popup-")))
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; popup-autoloads.el ends here
--- /dev/null
+;;; -*- no-byte-compile: t -*-
+(define-package "popup" "20160709.1429" "Visual Popup User Interface" '((cl-lib "0.5")) :commit "80829dd46381754639fb764da11c67235fe63282" :keywords '("lisp") :authors '(("Tomohiro Matsuyama" . "m2ym.pubNOSPAMgmail.com")) :maintainer '("Tomohiro Matsuyama" . "m2ym.pubNOSPAMgmail.com"))
--- /dev/null
+;;; popup.el --- Visual Popup User Interface
+
+;; Copyright (C) 2009-2015 Tomohiro Matsuyama
+
+;; Author: Tomohiro Matsuyama <m2ym.pubNOSPAMgmail.com>
+;; Keywords: lisp
+;; Package-Version: 20160709.1429
+;; Version: 0.5.3
+;; Package-Requires: ((cl-lib "0.5"))
+
+;; This program 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 of the License, or
+;; (at your option) any later version.
+
+;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; popup.el is a visual popup user interface library for Emacs. This
+;; provides a basic API and common UI widgets such as popup tooltips
+;; and popup menus.
+;; See README.markdown for more information.
+
+;;; Code:
+
+(require 'cl-lib)
+
+(defconst popup-version "0.5.3")
+
+\f
+
+;;; Utilities
+
+(defun popup-calculate-max-width (max-width)
+ "Determines whether the width desired is
+character or window proportion based, And returns the result."
+ (cl-typecase max-width
+ (integer max-width)
+ (float (* (ceiling (/ (round (* max-width (window-width))) 10.0)) 10))))
+
+(defvar popup-use-optimized-column-computation t
+ "Use the optimized column computation routine.
+If there is a problem, please set it nil.")
+
+(defmacro popup-aif (test then &rest else)
+ "Anaphoric if."
+ (declare (indent 2))
+ `(let ((it ,test))
+ (if it ,then ,@else)))
+
+(defmacro popup-awhen (test &rest body)
+ "Anaphoric when."
+ (declare (indent 1))
+ `(let ((it ,test))
+ (when it ,@body)))
+
+(defun popup-x-to-string (x)
+ "Convert any object to string effeciently.
+This is faster than `prin1-to-string' in many cases."
+ (cl-typecase x
+ (string x)
+ (symbol (symbol-name x))
+ (integer (number-to-string x))
+ (float (number-to-string x))
+ (t (format "%s" x))))
+
+(defun popup-substring-by-width (string width)
+ "Return a cons cell of substring and remaining string by
+splitting with WIDTH."
+ ;; Expand tabs into 4 spaces
+ (setq string (replace-regexp-in-string "\t" " " string))
+ (cl-loop with len = (length string)
+ with w = 0
+ for l from 0
+ for c in (append string nil)
+ while (<= (cl-incf w (char-width c)) width)
+ finally return
+ (if (< l len)
+ (cons (substring string 0 l) (substring string l))
+ (list string))))
+
+(defun popup-fill-string (string &optional width max-width justify squeeze)
+ "Split STRING into fixed width strings and return a cons cell
+like \(WIDTH . ROWS). Here, the car WIDTH indicates the actual
+maxim width of ROWS.
+
+The argument WIDTH specifies the width of filling each
+paragraph. WIDTH nil means don't perform any justification and
+word wrap. Note that this function doesn't add any padding
+characters at the end of each row.
+
+MAX-WIDTH, if WIDTH is nil, specifies the maximum number of
+columns.
+
+The optional fourth argument JUSTIFY specifies which kind of
+justification to do: `full', `left', `right', `center', or
+`none' (equivalent to nil). A value of t means handle each
+paragraph as specified by its text properties.
+
+SQUEEZE nil means leave whitespaces other than line breaks
+untouched."
+ (if (eq width 0)
+ (error "Can't fill string with 0 width"))
+ (if width
+ (setq max-width width))
+ (with-temp-buffer
+ (let ((tab-width 4)
+ (fill-column width)
+ (left-margin 0)
+ (kinsoku-limit 1)
+ indent-tabs-mode
+ row rows)
+ (insert string)
+ (untabify (point-min) (point-max))
+ (if width
+ (fill-region (point-min) (point-max) justify (not squeeze)))
+ (goto-char (point-min))
+ (setq width 0)
+ (while (prog2
+ (let ((line (buffer-substring
+ (point) (progn (end-of-line) (point)))))
+ (if max-width
+ (while (progn
+ (setq row (truncate-string-to-width line max-width)
+ width (max width (string-width row)))
+ (push row rows)
+ (if (not (= (length row) (length line)))
+ (setq line (substring line (length row))))))
+ (setq width (max width (string-width line)))
+ (push line rows)))
+ (< (point) (point-max))
+ (beginning-of-line 2)))
+ (cons width (nreverse rows)))))
+
+(defmacro popup-save-buffer-state (&rest body)
+ (declare (indent 0))
+ `(save-excursion
+ (let ((buffer-undo-list t)
+ (inhibit-read-only t)
+ (modified (buffer-modified-p)))
+ (unwind-protect
+ (progn ,@body)
+ (set-buffer-modified-p modified)))))
+
+(defun popup-vertical-motion (column direction)
+ "A portable version of `vertical-motion'."
+ (if (>= emacs-major-version 23)
+ (vertical-motion (cons column direction))
+ (vertical-motion direction)
+ (move-to-column (+ (current-column) column))))
+
+(defun popup-last-line-of-buffer-p ()
+ "Return non-nil if the cursor is at the last line of the
+buffer."
+ (save-excursion (end-of-line) (/= (forward-line) 0)))
+
+(defun popup-lookup-key-by-event (function event)
+ (or (funcall function (vector event))
+ (if (symbolp event)
+ (popup-aif (get event 'event-symbol-element-mask)
+ (funcall function
+ (vector (logior (or (get (car it) 'ascii-character)
+ 0)
+ (cadr it))))))))
+
+\f
+
+;;; Core
+
+(defgroup popup nil
+ "Visual Popup User Interface"
+ :group 'lisp
+ :prefix "popup-")
+
+(defface popup-face
+ '((t (:inherit default :background "lightgray" :foreground "black")))
+ "Face for popup."
+ :group 'popup)
+
+(defface popup-summary-face
+ '((t (:inherit popup-face :foreground "dimgray")))
+ "Face for popup summary."
+ :group 'popup)
+
+(defface popup-scroll-bar-foreground-face
+ '((t (:background "black")))
+ "Foreground face for scroll-bar."
+ :group 'popup)
+
+(defface popup-scroll-bar-background-face
+ '((t (:background "gray")))
+ "Background face for scroll-bar."
+ :group 'popup)
+
+(defvar popup-instances nil
+ "Popup instances.")
+
+(defvar popup-scroll-bar-foreground-char
+ (propertize " " 'face 'popup-scroll-bar-foreground-face)
+ "Foreground character for scroll-bar.")
+
+(defvar popup-scroll-bar-background-char
+ (propertize " " 'face 'popup-scroll-bar-background-face)
+ "Background character for scroll-bar.")
+
+(cl-defstruct popup
+ point row column width height min-height direction overlays keymap
+ parent depth
+ face mouse-face selection-face summary-face
+ margin-left margin-right margin-left-cancel scroll-bar symbol
+ cursor offset scroll-top current-height list newlines
+ pattern original-list invis-overlays)
+
+(defun popup-item-propertize (item &rest properties)
+ "Same as `propertize' except that this avoids overriding
+existed value with `nil' property."
+ (cl-loop for (k v) on properties by 'cddr
+ if v append (list k v) into props
+ finally return
+ (apply 'propertize
+ (popup-x-to-string item)
+ props)))
+
+(defun popup-item-property (item property)
+ "Same as `get-text-property' except that this returns nil if
+ITEM is not string."
+ (if (stringp item)
+ (get-text-property 0 property item)))
+
+(cl-defun popup-make-item (name
+ &key
+ value
+ face
+ mouse-face
+ selection-face
+ sublist
+ document
+ symbol
+ summary)
+ "Utility function to make popup item. See also
+`popup-item-propertize'."
+ (popup-item-propertize name
+ 'value value
+ 'popup-face face
+ 'popup-mouse-face mouse-face
+ 'selection-face selection-face
+ 'document document
+ 'symbol symbol
+ 'summary summary
+ 'sublist sublist))
+
+(defsubst popup-item-value (item) (popup-item-property item 'value))
+(defsubst popup-item-value-or-self (item) (or (popup-item-value item) item))
+(defsubst popup-item-face (item) (popup-item-property item 'popup-face))
+(defsubst popup-item-mouse-face (item) (popup-item-property item 'popup-mouse-face))
+(defsubst popup-item-selection-face (item) (popup-item-property item 'selection-face))
+(defsubst popup-item-document (item) (popup-item-property item 'document))
+(defsubst popup-item-summary (item) (popup-item-property item 'summary))
+(defsubst popup-item-symbol (item) (popup-item-property item 'symbol))
+(defsubst popup-item-sublist (item) (popup-item-property item 'sublist))
+
+(defun popup-item-documentation (item)
+ (let ((doc (popup-item-document item)))
+ (if (functionp doc)
+ (setq doc (funcall doc (popup-item-value-or-self item))))
+ doc))
+
+(defun popup-item-show-help-1 (item)
+ (let ((doc (popup-item-documentation item)))
+ (when doc
+ (with-current-buffer (get-buffer-create " *Popup Help*")
+ (erase-buffer)
+ (insert doc)
+ (goto-char (point-min))
+ (display-buffer (current-buffer)))
+ t)))
+
+(defun popup-item-show-help-with-event-loop (item)
+ (save-window-excursion
+ (when (popup-item-show-help-1 item)
+ (cl-loop do (clear-this-command-keys)
+ for key = (read-key-sequence-vector nil)
+ do
+ (cl-case (key-binding key)
+ (scroll-other-window
+ (scroll-other-window))
+ (scroll-other-window-down
+ (scroll-other-window-down nil))
+ (otherwise
+ (setq unread-command-events (append key unread-command-events))
+ (cl-return)))))))
+
+(defun popup-item-show-help (item &optional persist)
+ "Display the documentation of ITEM with `display-buffer'. If
+PERSIST is nil, the documentation buffer will be closed
+automatically, meaning interal event loop ensures the buffer to
+be closed. Otherwise, the buffer will be just displayed as
+usual."
+ (when item
+ (if (not persist)
+ (popup-item-show-help-with-event-loop item)
+ (popup-item-show-help-1 item))))
+
+(defun popup-set-list (popup list)
+ (popup-set-filtered-list popup list)
+ (setf (popup-pattern popup) nil)
+ (setf (popup-original-list popup) list))
+
+(defun popup-set-filtered-list (popup list)
+ (let ((offset
+ (if (> (popup-direction popup) 0)
+ 0
+ (max (- (popup-height popup) (length list)) 0))))
+ (setf (popup-list popup) list
+ (popup-offset popup) offset)))
+
+(defun popup-selected-item (popup)
+ (nth (popup-cursor popup) (popup-list popup)))
+
+(defun popup-selected-line (popup)
+ (- (popup-cursor popup) (popup-scroll-top popup)))
+
+(defun popup-line-overlay (popup line)
+ (aref (popup-overlays popup) line))
+
+(defun popup-selected-line-overlay (popup)
+ (popup-line-overlay popup (popup-selected-line popup)))
+
+(defun popup-hide-line (popup line)
+ (let ((overlay (popup-line-overlay popup line)))
+ (overlay-put overlay 'display nil)
+ (overlay-put overlay 'after-string nil)))
+
+(defun popup-line-hidden-p (popup line)
+ (let ((overlay (popup-line-overlay popup line)))
+ (and (eq (overlay-get overlay 'display) nil)
+ (eq (overlay-get overlay 'after-string) nil))))
+
+(cl-defun popup-set-line-item (popup
+ line
+ &key
+ item
+ face
+ mouse-face
+ margin-left
+ margin-right
+ scroll-bar-char
+ symbol
+ summary
+ summary-face
+ keymap)
+ (let* ((overlay (popup-line-overlay popup line))
+ (content (popup-create-line-string popup (popup-x-to-string item)
+ :margin-left margin-left
+ :margin-right margin-right
+ :symbol symbol
+ :summary summary
+ :summary-face summary-face))
+ (start 0)
+ (prefix (overlay-get overlay 'prefix))
+ (postfix (overlay-get overlay 'postfix))
+ end)
+ (put-text-property 0 (length content) 'popup-item item content)
+ (put-text-property 0 (length content) 'keymap keymap content)
+ ;; Overlap face properties
+ (when (get-text-property start 'face content)
+ (setq start (next-single-property-change start 'face content)))
+ (while (and start (setq end (next-single-property-change start 'face content)))
+ (put-text-property start end 'face face content)
+ (setq start (next-single-property-change end 'face content)))
+ (when start
+ (put-text-property start (length content) 'face face content))
+ (when mouse-face
+ (put-text-property 0 (length content) 'mouse-face mouse-face content))
+ (let ((prop (if (overlay-get overlay 'dangle)
+ 'after-string
+ 'display)))
+ (overlay-put overlay
+ prop
+ (concat prefix
+ content
+ scroll-bar-char
+ postfix)))))
+
+(cl-defun popup-create-line-string (popup
+ string
+ &key
+ margin-left
+ margin-right
+ symbol
+ summary
+ summary-face)
+ (let* ((popup-width (popup-width popup))
+ (summary-width (string-width summary))
+ (content-width (max
+ (min popup-width (string-width string))
+ (- popup-width
+ (if (> summary-width 0)
+ (+ summary-width 2)
+ 0))))
+ (string (car (popup-substring-by-width string content-width)))
+ (string-width (string-width string))
+ (spacing (max (- popup-width string-width summary-width)
+ (if (> popup-width string-width) 1 0)))
+ (truncated-summary
+ (car (popup-substring-by-width
+ summary (max (- popup-width string-width spacing) 0)))))
+ (when summary-face
+ (put-text-property 0 (length truncated-summary)
+ 'face summary-face truncated-summary))
+ (concat margin-left
+ string
+ (make-string spacing ? )
+ truncated-summary
+ symbol
+ margin-right)))
+
+(defun popup-live-p (popup)
+ "Return non-nil if POPUP is alive."
+ (and popup (popup-overlays popup) t))
+
+(defun popup-child-point (popup &optional offset)
+ (overlay-end
+ (popup-line-overlay
+ popup
+ (or offset
+ (popup-selected-line popup)))))
+
+(defun popup-calculate-direction (height row)
+ "Return a proper direction when displaying a popup on this
+window. HEIGHT is the a height of the popup, and ROW is a line
+number at the point."
+ (let* ((remaining-rows (- (max 1 (- (window-height)
+ (if mode-line-format 1 0)
+ (if header-line-format 1 0)))
+ (count-lines (window-start) (point))))
+ (enough-space-above (> row height))
+ (enough-space-below (<= height remaining-rows)))
+ (if (and enough-space-above
+ (not enough-space-below))
+ -1
+ 1)))
+
+(cl-defun popup-create (point
+ width
+ height
+ &key
+ min-height
+ max-width
+ around
+ (face 'popup-face)
+ mouse-face
+ (selection-face face)
+ (summary-face 'popup-summary-face)
+ scroll-bar
+ margin-left
+ margin-right
+ symbol
+ parent
+ parent-offset
+ keymap)
+ "Create a popup instance at POINT with WIDTH and HEIGHT.
+
+MIN-HEIGHT is a minimal height of the popup. The default value is
+0.
+
+MAX-WIDTH is the maximum width of the popup. The default value is
+nil (no limit). If a floating point, the value refers to the ratio of
+the window. If an integer, limit is in characters.
+
+If AROUND is non-nil, the popup will be displayed around the
+point but not at the point.
+
+FACE is a background face of the popup. The default value is POPUP-FACE.
+
+SELECTION-FACE is a foreground (selection) face of the popup The
+default value is POPUP-FACE.
+
+If SCROLL-BAR is non-nil, the popup will have a scroll bar at the
+right.
+
+If MARGIN-LEFT is non-nil, the popup will have a margin at the
+left.
+
+If MARGIN-RIGHT is non-nil, the popup will have a margin at the
+right.
+
+SYMBOL is a single character which indicates a kind of the item.
+
+PARENT is a parent popup instance. If PARENT is omitted, the
+popup will be a root instance.
+
+PARENT-OFFSET is a row offset from the parent popup.
+
+KEYMAP is a keymap that will be put on the popup contents."
+ (or margin-left (setq margin-left 0))
+ (or margin-right (setq margin-right 0))
+ (unless point
+ (setq point
+ (if parent (popup-child-point parent parent-offset) (point))))
+ (when max-width
+ (setq width (min width (popup-calculate-max-width max-width))))
+ (save-excursion
+ (goto-char point)
+ (let* ((col-row (posn-col-row (posn-at-point)))
+ (row (cdr col-row))
+ (column (car col-row))
+ (overlays (make-vector height nil))
+ (popup-width (+ width
+ (if scroll-bar 1 0)
+ margin-left
+ margin-right
+ (if symbol 2 0)))
+ margin-left-cancel
+ (window (selected-window))
+ (window-start (window-start))
+ (window-hscroll (window-hscroll))
+ (window-width (window-width))
+ (right (+ column popup-width))
+ (overflow (and (> right window-width)
+ (>= right popup-width)))
+ (foldable (and (null parent)
+ (>= column popup-width)))
+ (direction (or
+ ;; Currently the direction of cascade popup won't be changed
+ (and parent (popup-direction parent))
+
+ ;; Calculate direction
+ (popup-calculate-direction height row)))
+ (depth (if parent (1+ (popup-depth parent)) 0))
+ (newlines (max 0 (+ (- height (count-lines point (point-max))) (if around 1 0))))
+ invis-overlays
+ current-column)
+ ;; Case: no newlines at the end of the buffer
+ (when (> newlines 0)
+ (popup-save-buffer-state
+ (goto-char (point-max))
+ (insert (make-string newlines ?\n))))
+
+ ;; Case: the popup overflows
+ (if overflow
+ (if foldable
+ (progn
+ (cl-decf column (- popup-width margin-left margin-right))
+ (unless around (move-to-column column)))
+ (when (not truncate-lines)
+ ;; Truncate.
+ (let ((d (1+ (- popup-width (- window-width column)))))
+ (cl-decf popup-width d)
+ (cl-decf width d)))
+ (cl-decf column margin-left))
+ (cl-decf column margin-left))
+
+ ;; Case: no space at the left
+ (when (and (null parent)
+ (< column 0))
+ ;; Cancel margin left
+ (setq column 0)
+ (cl-decf popup-width margin-left)
+ (setq margin-left-cancel t))
+
+ (dotimes (i height)
+ (let (overlay begin w (dangle t) (prefix "") (postfix ""))
+ (when around
+ (popup-vertical-motion column direction))
+ (cl-loop for ov in (overlays-in (save-excursion
+ (beginning-of-visual-line)
+ (point))
+ (save-excursion
+ (end-of-visual-line)
+ (point)))
+ when (and (not (overlay-get ov 'popup))
+ (not (overlay-get ov 'popup-item))
+ (or (overlay-get ov 'invisible)
+ (overlay-get ov 'display)))
+ do (progn
+ (push (list ov (overlay-get ov 'display)) invis-overlays)
+ (overlay-put ov 'display "")))
+ (setq around t)
+ (setq current-column (car (posn-col-row (posn-at-point))))
+
+ (when (< current-column column)
+ ;; Extend short buffer lines by popup prefix (line of spaces)
+ (setq prefix (make-string
+ (+ (if (= current-column 0)
+ (- window-hscroll current-column)
+ 0)
+ (- column current-column))
+ ? )))
+
+ (setq begin (point))
+ (setq w (+ popup-width (length prefix)))
+ (while (and (not (eolp)) (> w 0))
+ (setq dangle nil)
+ (cl-decf w (char-width (char-after)))
+ (forward-char))
+ (if (< w 0)
+ (setq postfix (make-string (- w) ? )))
+
+ (setq overlay (make-overlay begin (point)))
+ (overlay-put overlay 'popup t)
+ (overlay-put overlay 'window window)
+ (overlay-put overlay 'dangle dangle)
+ (overlay-put overlay 'prefix prefix)
+ (overlay-put overlay 'postfix postfix)
+ (overlay-put overlay 'width width)
+ (aset overlays
+ (if (> direction 0) i (- height i 1))
+ overlay)))
+ (cl-loop for p from (- 10000 (* depth 1000))
+ for overlay in (nreverse (append overlays nil))
+ do (overlay-put overlay 'priority p))
+ (let ((it (make-popup :point point
+ :row row
+ :column column
+ :width width
+ :height height
+ :min-height min-height
+ :direction direction
+ :parent parent
+ :depth depth
+ :face face
+ :mouse-face mouse-face
+ :selection-face selection-face
+ :summary-face summary-face
+ :margin-left margin-left
+ :margin-right margin-right
+ :margin-left-cancel margin-left-cancel
+ :scroll-bar scroll-bar
+ :symbol symbol
+ :cursor 0
+ :offset 0
+ :scroll-top 0
+ :current-height 0
+ :list nil
+ :newlines newlines
+ :overlays overlays
+ :invis-overlays invis-overlays
+ :keymap keymap)))
+ (push it popup-instances)
+ it))))
+
+(defun popup-delete (popup)
+ "Delete POPUP instance."
+ (when (popup-live-p popup)
+ (popup-hide popup)
+ (mapc 'delete-overlay (popup-overlays popup))
+ (setf (popup-overlays popup) nil)
+ (setq popup-instances (delq popup popup-instances))
+ ;; Restore newlines state
+ (let ((newlines (popup-newlines popup)))
+ (when (> newlines 0)
+ (popup-save-buffer-state
+ (goto-char (point-max))
+ (dotimes (i newlines)
+ (if (and (char-before)
+ (= (char-before) ?\n))
+ (delete-char -1)))))))
+ nil)
+
+(defun popup-draw (popup)
+ "Draw POPUP."
+ (cl-loop for (ov olddisplay) in (popup-invis-overlays popup)
+ do (overlay-put ov 'display ""))
+
+ (cl-loop with height = (popup-height popup)
+ with min-height = (popup-min-height popup)
+ with popup-face = (popup-face popup)
+ with mouse-face = (popup-mouse-face popup)
+ with selection-face = (popup-selection-face popup)
+ with summary-face-0 = (popup-summary-face popup)
+ with list = (popup-list popup)
+ with length = (length list)
+ with thum-size = (max (/ (* height height) (max length 1)) 1)
+ with page-size = (/ (+ 0.0 (max length 1)) height)
+ with scroll-bar = (popup-scroll-bar popup)
+ with margin-left = (make-string (if (popup-margin-left-cancel popup) 0 (popup-margin-left popup)) ? )
+ with margin-right = (make-string (popup-margin-right popup) ? )
+ with symbol = (popup-symbol popup)
+ with cursor = (popup-cursor popup)
+ with scroll-top = (popup-scroll-top popup)
+ with offset = (popup-offset popup)
+ with keymap = (popup-keymap popup)
+ for o from offset
+ for i from scroll-top
+ while (< o height)
+ for item in (nthcdr scroll-top list)
+ for page-index = (* thum-size (/ o thum-size))
+ for face = (if (= i cursor)
+ (or (popup-item-selection-face item) selection-face)
+ (or (popup-item-face item) popup-face))
+ for summary-face = (unless (= i cursor) summary-face-0)
+ for empty-char = (propertize " " 'face face)
+ for scroll-bar-char = (if scroll-bar
+ (cond
+ ((and (not (eq scroll-bar :always))
+ (<= page-size 1))
+ empty-char)
+ ((and (> page-size 1)
+ (>= cursor (* page-index page-size))
+ (< cursor (* (+ page-index thum-size) page-size)))
+ popup-scroll-bar-foreground-char)
+ (t
+ popup-scroll-bar-background-char))
+ "")
+ for sym = (if symbol
+ (concat " " (or (popup-item-symbol item) " "))
+ "")
+ for summary = (or (popup-item-summary item) "")
+
+ do
+ ;; Show line and set item to the line
+ (popup-set-line-item popup o
+ :item item
+ :face face
+ :mouse-face mouse-face
+ :margin-left margin-left
+ :margin-right margin-right
+ :scroll-bar-char scroll-bar-char
+ :symbol sym
+ :summary summary
+ :summary-face summary-face
+ :keymap keymap)
+
+ finally
+ ;; Remember current height
+ (setf (popup-current-height popup) (- o offset))
+
+ ;; Hide remaining lines
+ (let ((scroll-bar-char (if scroll-bar (propertize " " 'face popup-face) ""))
+ (symbol (if symbol " " "")))
+ (if (> (popup-direction popup) 0)
+ (progn
+ (when min-height
+ (while (< o min-height)
+ (popup-set-line-item popup o
+ :item ""
+ :face popup-face
+ :margin-left margin-left
+ :margin-right margin-right
+ :scroll-bar-char scroll-bar-char
+ :symbol symbol
+ :summary "")
+ (cl-incf o)))
+ (while (< o height)
+ (popup-hide-line popup o)
+ (cl-incf o)))
+ (cl-loop with h = (if min-height (- height min-height) offset)
+ for o from 0 below offset
+ if (< o h)
+ do (popup-hide-line popup o)
+ if (>= o h)
+ do (popup-set-line-item popup o
+ :item ""
+ :face popup-face
+ :margin-left margin-left
+ :margin-right margin-right
+ :scroll-bar-char scroll-bar-char
+ :symbol symbol
+ :summary ""))))))
+
+(defun popup-hide (popup)
+ "Hide POPUP."
+ (cl-loop for (ov olddisplay) in (popup-invis-overlays popup)
+ do (overlay-put ov 'display olddisplay))
+ (dotimes (i (popup-height popup))
+ (popup-hide-line popup i)))
+
+(defun popup-hidden-p (popup)
+ "Return non-nil if POPUP is hidden."
+ (let ((hidden t))
+ (when (popup-live-p popup)
+ (dotimes (i (popup-height popup))
+ (unless (popup-line-hidden-p popup i)
+ (setq hidden nil))))
+ hidden))
+
+(defun popup-jump (popup cursor)
+ "Jump to a position specified by CURSOR of POPUP and draw."
+ (let ((scroll-top (popup-scroll-top popup)))
+ ;; Do not change page as much as possible.
+ (unless (and (<= scroll-top cursor)
+ (< cursor (+ scroll-top (popup-height popup))))
+ (setf (popup-scroll-top popup) cursor))
+ (setf (popup-cursor popup) cursor)
+ (popup-draw popup)))
+
+(defun popup-select (popup i)
+ "Select the item at I of POPUP and draw."
+ (setq i (+ i (popup-offset popup)))
+ (when (and (<= 0 i) (< i (popup-height popup)))
+ (setf (popup-cursor popup) i)
+ (popup-draw popup)
+ t))
+
+(defun popup-next (popup)
+ "Select the next item of POPUP and draw."
+ (let ((height (popup-height popup))
+ (cursor (1+ (popup-cursor popup)))
+ (scroll-top (popup-scroll-top popup))
+ (length (length (popup-list popup))))
+ (cond
+ ((>= cursor length)
+ ;; Back to first page
+ (setq cursor 0
+ scroll-top 0))
+ ((= cursor (+ scroll-top height))
+ ;; Go to next page
+ (setq scroll-top (min (1+ scroll-top) (max (- length height) 0)))))
+ (setf (popup-cursor popup) cursor
+ (popup-scroll-top popup) scroll-top)
+ (popup-draw popup)))
+
+(defun popup-previous (popup)
+ "Select the previous item of POPUP and draw."
+ (let ((height (popup-height popup))
+ (cursor (1- (popup-cursor popup)))
+ (scroll-top (popup-scroll-top popup))
+ (length (length (popup-list popup))))
+ (cond
+ ((< cursor 0)
+ ;; Go to last page
+ (setq cursor (1- length)
+ scroll-top (max (- length height) 0)))
+ ((= cursor (1- scroll-top))
+ ;; Go to previous page
+ (cl-decf scroll-top)))
+ (setf (popup-cursor popup) cursor
+ (popup-scroll-top popup) scroll-top)
+ (popup-draw popup)))
+
+(defun popup-page-next (popup)
+ "Select next item of POPUP per `popup-height' range.
+Pages down through POPUP."
+ (dotimes (counter (1- (popup-height popup)))
+ (popup-next popup)))
+
+(defun popup-page-previous (popup)
+ "Select previous item of POPUP per `popup-height' range.
+Pages up through POPUP."
+ (dotimes (counter (1- (popup-height popup)))
+ (popup-previous popup)))
+
+(defun popup-scroll-down (popup &optional n)
+ "Scroll down N of POPUP and draw."
+ (let ((scroll-top (min (+ (popup-scroll-top popup) (or n 1))
+ (- (length (popup-list popup)) (popup-height popup)))))
+ (setf (popup-cursor popup) scroll-top
+ (popup-scroll-top popup) scroll-top)
+ (popup-draw popup)))
+
+(defun popup-scroll-up (popup &optional n)
+ "Scroll up N of POPUP and draw."
+ (let ((scroll-top (max (- (popup-scroll-top popup) (or n 1))
+ 0)))
+ (setf (popup-cursor popup) scroll-top
+ (popup-scroll-top popup) scroll-top)
+ (popup-draw popup)))
+
+\f
+
+;;; Popup Incremental Search
+
+(defface popup-isearch-match
+ '((t (:inherit default :background "sky blue")))
+ "Popup isearch match face."
+ :group 'popup)
+
+(defvar popup-isearch-cursor-color "blue")
+
+(defvar popup-isearch-keymap
+ (let ((map (make-sparse-keymap)))
+ ;(define-key map "\r" 'popup-isearch-done)
+ (define-key map "\C-g" 'popup-isearch-cancel)
+ (define-key map "\C-b" 'popup-isearch-close)
+ (define-key map [left] 'popup-isearch-close)
+ (define-key map "\C-h" 'popup-isearch-delete)
+ (define-key map (kbd "DEL") 'popup-isearch-delete)
+ (define-key map (kbd "C-y") 'popup-isearch-yank)
+ map))
+
+(defvar popup-menu-show-quick-help-function 'popup-menu-show-quick-help
+ "Function used for showing quick help by `popup-menu*'.")
+
+(defcustom popup-isearch-regexp-builder-function #'regexp-quote
+ "Function used to construct a regexp from a pattern. You may for instance
+ provide a function that replaces spaces by '.+' if you like helm or ivy style
+ of completion."
+ :type 'function)
+
+(defsubst popup-isearch-char-p (char)
+ (and (integerp char)
+ (<= 32 char)
+ (<= char 126)))
+
+(defun popup-isearch-filter-list (pattern list)
+ (cl-loop with regexp = (funcall popup-isearch-regexp-builder-function pattern)
+ for item in list
+ do
+ (unless (stringp item)
+ (setq item (popup-item-propertize (popup-x-to-string item)
+ 'value item)))
+ if (string-match regexp item)
+ collect
+ (let ((beg (match-beginning 0))
+ (end (match-end 0)))
+ (alter-text-property 0 (length item) 'face
+ (lambda (prop)
+ (unless (eq prop 'popup-isearch-match)
+ prop))
+ item)
+ (put-text-property beg end
+ 'face 'popup-isearch-match
+ item)
+ item)))
+
+(defun popup-isearch-prompt (popup pattern)
+ (format "Pattern: %s" (if (= (length (popup-list popup)) 0)
+ (propertize pattern 'face 'isearch-fail)
+ pattern)))
+
+(defun popup-isearch-update (popup filter pattern &optional callback)
+ (setf (popup-cursor popup) 0
+ (popup-scroll-top popup) 0
+ (popup-pattern popup) pattern)
+ (let ((list (funcall filter pattern (popup-original-list popup))))
+ (popup-set-filtered-list popup list)
+ (if callback
+ (funcall callback list)))
+ (popup-draw popup))
+
+(cl-defun popup-isearch (popup
+ &key
+ (filter 'popup-isearch-filter-list)
+ (cursor-color popup-isearch-cursor-color)
+ (keymap popup-isearch-keymap)
+ callback
+ help-delay)
+ "Start isearch on POPUP. This function is synchronized, meaning
+event loop waits for quiting of isearch.
+
+FILTER is function with two argumenst to perform popup items filtering.
+
+CURSOR-COLOR is a cursor color during isearch. The default value
+is `popup-isearch-cursor-color'.
+
+KEYMAP is a keymap which is used when processing events during
+event loop. The default value is `popup-isearch-keymap'.
+
+CALLBACK is a function taking one argument. `popup-isearch' calls
+CALLBACK, if specified, after isearch finished or isearch
+canceled. The arguments is whole filtered list of items.
+
+HELP-DELAY is a delay of displaying helps."
+ (let ((list (popup-original-list popup))
+ (pattern (or (popup-pattern popup) ""))
+ (old-cursor-color (frame-parameter (selected-frame) 'cursor-color))
+ prompt key binding)
+ (unwind-protect
+ (cl-block nil
+ (if cursor-color
+ (set-cursor-color cursor-color))
+ (while t
+ (setq prompt (popup-isearch-prompt popup pattern))
+ (setq key (popup-menu-read-key-sequence keymap prompt help-delay))
+ (if (null key)
+ (unless (funcall popup-menu-show-quick-help-function popup nil :prompt prompt)
+ (clear-this-command-keys)
+ (push (read-event prompt) unread-command-events))
+ (setq binding (lookup-key keymap key))
+ (cond
+ ((and (stringp key)
+ (popup-isearch-char-p (aref key 0)))
+ (setq pattern (concat pattern key)))
+ ((eq binding 'popup-isearch-done)
+ (cl-return nil))
+ ((eq binding 'popup-isearch-cancel)
+ (popup-isearch-update popup filter "" callback)
+ (cl-return t))
+ ((eq binding 'popup-isearch-close)
+ (popup-isearch-update popup filter "" callback)
+ (setq unread-command-events
+ (append (listify-key-sequence key) unread-command-events))
+ (cl-return nil))
+ ((eq binding 'popup-isearch-delete)
+ (if (> (length pattern) 0)
+ (setq pattern (substring pattern 0 (1- (length pattern))))))
+ ((eq binding 'popup-isearch-yank)
+ (popup-isearch-update popup filter (car kill-ring) callback)
+ (cl-return nil))
+ (t
+ (setq unread-command-events
+ (append (listify-key-sequence key) unread-command-events))
+ (cl-return nil)))
+ (popup-isearch-update popup filter pattern callback))))
+ (if old-cursor-color
+ (set-cursor-color old-cursor-color)))))
+
+\f
+
+;;; Popup Tip
+
+(defface popup-tip-face
+ '((t (:background "khaki1" :foreground "black")))
+ "Face for popup tip."
+ :group 'popup)
+
+(defvar popup-tip-max-width 80)
+
+(cl-defun popup-tip (string
+ &key
+ point
+ (around t)
+ width
+ (height 15)
+ min-height
+ max-width
+ truncate
+ margin
+ margin-left
+ margin-right
+ scroll-bar
+ parent
+ parent-offset
+ nowait
+ nostrip
+ prompt
+ &aux tip lines)
+ "Show a tooltip of STRING at POINT. This function is
+synchronized unless NOWAIT specified. Almost all arguments are
+the same as in `popup-create', except for TRUNCATE, NOWAIT, and
+PROMPT.
+
+If TRUNCATE is non-nil, the tooltip can be truncated.
+
+If NOWAIT is non-nil, this function immediately returns the
+tooltip instance without entering event loop.
+
+If `NOSTRIP` is non-nil, `STRING` properties are not stripped.
+
+PROMPT is a prompt string when reading events during event loop."
+ (if (bufferp string)
+ (setq string (with-current-buffer string (buffer-string))))
+
+ (unless nostrip
+ ;; TODO strip text (mainly face) properties
+ (setq string (substring-no-properties string)))
+
+ (and (eq margin t) (setq margin 1))
+ (or margin-left (setq margin-left margin))
+ (or margin-right (setq margin-right margin))
+
+ (let ((it (popup-fill-string string width popup-tip-max-width)))
+ (setq width (car it)
+ lines (cdr it)))
+
+ (setq tip (popup-create point width height
+ :min-height min-height
+ :max-width max-width
+ :around around
+ :margin-left margin-left
+ :margin-right margin-right
+ :scroll-bar scroll-bar
+ :face 'popup-tip-face
+ :parent parent
+ :parent-offset parent-offset))
+
+ (unwind-protect
+ (when (> (popup-width tip) 0) ; not to be corrupted
+ (when (and (not (eq width (popup-width tip))) ; truncated
+ (not truncate))
+ ;; Refill once again to lines be fitted to popup width
+ (setq width (popup-width tip))
+ (setq lines (cdr (popup-fill-string string width width))))
+
+ (popup-set-list tip lines)
+ (popup-draw tip)
+ (if nowait
+ tip
+ (clear-this-command-keys)
+ (push (read-event prompt) unread-command-events)
+ t))
+ (unless nowait
+ (popup-delete tip))))
+
+\f
+
+;;; Popup Menu
+
+(defface popup-menu-face
+ '((t (:inherit popup-face)))
+ "Face for popup menu."
+ :group 'popup)
+
+(defface popup-menu-mouse-face
+ '((t (:background "blue" :foreground "white")))
+ "Face for popup menu."
+ :group 'popup)
+
+(defface popup-menu-selection-face
+ '((t (:inherit default :background "steelblue" :foreground "white")))
+ "Face for popup menu selection."
+ :group 'popup)
+
+(defface popup-menu-summary-face
+ '((t (:inherit popup-summary-face)))
+ "Face for popup summary."
+ :group 'popup)
+
+(defvar popup-menu-show-tip-function 'popup-tip
+ "Function used for showing tooltip by `popup-menu-show-quick-help'.")
+
+(defun popup-menu-show-help (menu &optional persist item)
+ (popup-item-show-help (or item (popup-selected-item menu)) persist))
+
+(defun popup-menu-documentation (menu &optional item)
+ (popup-item-documentation (or item (popup-selected-item menu))))
+
+(defun popup-menu-show-quick-help (menu &optional item &rest args)
+ (let* ((point (plist-get args :point))
+ (height (or (plist-get args :height) (popup-height menu)))
+ (min-height (min height (popup-current-height menu)))
+ (around nil)
+ (parent-offset (popup-offset menu))
+ (doc (popup-menu-documentation menu item)))
+ (when (stringp doc)
+ (if (popup-hidden-p menu)
+ (setq around t
+ menu nil
+ parent-offset nil)
+ (setq point nil))
+ (let ((popup-use-optimized-column-computation nil)) ; To avoid wrong positioning
+ (apply popup-menu-show-tip-function
+ doc
+ :point point
+ :height height
+ :min-height min-height
+ :around around
+ :parent menu
+ :parent-offset parent-offset
+ args)))))
+
+(defun popup-menu-item-of-mouse-event (event)
+ (when (and (consp event)
+ (memq (cl-first event) '(mouse-1 mouse-2 mouse-3 mouse-4 mouse-5)))
+ (let* ((position (cl-second event))
+ (object (elt position 4)))
+ (when (consp object)
+ (get-text-property (cdr object) 'popup-item (car object))))))
+
+(defun popup-menu-read-key-sequence (keymap &optional prompt timeout)
+ (catch 'timeout
+ (let ((timer (and timeout
+ (run-with-timer timeout nil
+ (lambda ()
+ (if (zerop (length (this-command-keys)))
+ (throw 'timeout nil))))))
+ (old-global-map (current-global-map))
+ (temp-global-map (make-sparse-keymap))
+ (overriding-terminal-local-map (make-sparse-keymap)))
+ (substitute-key-definition 'keyboard-quit 'keyboard-quit
+ temp-global-map old-global-map)
+ (define-key temp-global-map [menu-bar] (lookup-key old-global-map [menu-bar]))
+ (define-key temp-global-map [tool-bar] (lookup-key old-global-map [tool-bar]))
+ (set-keymap-parent overriding-terminal-local-map keymap)
+ (if (current-local-map)
+ (define-key overriding-terminal-local-map [menu-bar]
+ (lookup-key (current-local-map) [menu-bar])))
+ (unwind-protect
+ (progn
+ (use-global-map temp-global-map)
+ (clear-this-command-keys)
+ (with-temp-message prompt
+ (read-key-sequence nil)))
+ (use-global-map old-global-map)
+ (if timer (cancel-timer timer))))))
+
+(defun popup-menu-fallback (event default))
+
+(cl-defun popup-menu-event-loop (menu
+ keymap
+ fallback
+ &key
+ prompt
+ help-delay
+ isearch
+ isearch-filter
+ isearch-cursor-color
+ isearch-keymap
+ isearch-callback
+ &aux key binding)
+ (cl-block nil
+ (while (popup-live-p menu)
+ (and isearch
+ (popup-isearch menu
+ :filter isearch-filter
+ :cursor-color isearch-cursor-color
+ :keymap isearch-keymap
+ :callback isearch-callback
+ :help-delay help-delay)
+ (keyboard-quit))
+ (setq key (popup-menu-read-key-sequence keymap prompt help-delay))
+ (setq binding (and key (lookup-key keymap key)))
+ (cond
+ ((or (null key) (zerop (length key)))
+ (unless (funcall popup-menu-show-quick-help-function menu nil :prompt prompt)
+ (clear-this-command-keys)
+ (push (read-event prompt) unread-command-events)))
+ ((eq (lookup-key (current-global-map) key) 'keyboard-quit)
+ (keyboard-quit)
+ (cl-return))
+ ((eq binding 'popup-close)
+ (if (popup-parent menu)
+ (cl-return)))
+ ((memq binding '(popup-select popup-open))
+ (let* ((item (or (popup-menu-item-of-mouse-event (elt key 0))
+ (popup-selected-item menu)))
+ (index (cl-position item (popup-list menu)))
+ (sublist (popup-item-sublist item)))
+ (unless index (cl-return))
+ (if sublist
+ (popup-aif (let (popup-use-optimized-column-computation)
+ (popup-cascade-menu sublist
+ :around nil
+ :margin-left (popup-margin-left menu)
+ :margin-right (popup-margin-right menu)
+ :scroll-bar (popup-scroll-bar menu)
+ :parent menu
+ :parent-offset index
+ :help-delay help-delay
+ :isearch isearch
+ :isearch-filter isearch-filter
+ :isearch-cursor-color isearch-cursor-color
+ :isearch-keymap isearch-keymap
+ :isearch-callback isearch-callback))
+ (and it (cl-return it)))
+ (if (eq binding 'popup-select)
+ (cl-return (popup-item-value-or-self item))))))
+ ((eq binding 'popup-next)
+ (popup-next menu))
+ ((eq binding 'popup-previous)
+ (popup-previous menu))
+ ((eq binding 'popup-page-next)
+ (popup-page-next menu))
+ ((eq binding 'popup-page-previous)
+ (popup-page-previous menu))
+ ((eq binding 'popup-help)
+ (popup-menu-show-help menu))
+ ((eq binding 'popup-isearch)
+ (popup-isearch menu
+ :filter isearch-filter
+ :cursor-color isearch-cursor-color
+ :keymap isearch-keymap
+ :callback isearch-callback
+ :help-delay help-delay))
+ ((commandp binding)
+ (call-interactively binding))
+ (t
+ (funcall fallback key (key-binding key)))))))
+
+(defun popup-preferred-width (list)
+ "Return the preferred width to show LIST beautifully."
+ (cl-loop with tab-width = 4
+ for item in list
+ for summary = (popup-item-summary item)
+ maximize (string-width (popup-x-to-string item)) into width
+ if (stringp summary)
+ maximize (+ (string-width summary) 2) into summary-width
+ finally return
+ (let ((total (+ (or width 0) (or summary-width 0))))
+ (* (ceiling (/ total 10.0)) 10))))
+
+(defvar popup-menu-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\r" 'popup-select)
+ (define-key map "\C-f" 'popup-open)
+ (define-key map [right] 'popup-open)
+ (define-key map "\C-b" 'popup-close)
+ (define-key map [left] 'popup-close)
+
+ (define-key map "\C-n" 'popup-next)
+ (define-key map [down] 'popup-next)
+ (define-key map "\C-p" 'popup-previous)
+ (define-key map [up] 'popup-previous)
+
+ (define-key map [next] 'popup-page-next)
+ (define-key map [prior] 'popup-page-previous)
+
+ (define-key map [f1] 'popup-help)
+ (define-key map (kbd "\C-?") 'popup-help)
+
+ (define-key map "\C-s" 'popup-isearch)
+
+ (define-key map [mouse-1] 'popup-select)
+ (define-key map [mouse-4] 'popup-previous)
+ (define-key map [mouse-5] 'popup-next)
+ map))
+
+(cl-defun popup-menu* (list
+ &key
+ point
+ (around t)
+ (width (popup-preferred-width list))
+ (height 15)
+ max-width
+ margin
+ margin-left
+ margin-right
+ scroll-bar
+ symbol
+ parent
+ parent-offset
+ cursor
+ (keymap popup-menu-keymap)
+ (fallback 'popup-menu-fallback)
+ help-delay
+ nowait
+ prompt
+ isearch
+ (isearch-filter 'popup-isearch-filter-list)
+ (isearch-cursor-color popup-isearch-cursor-color)
+ (isearch-keymap popup-isearch-keymap)
+ isearch-callback
+ initial-index
+ &aux menu event)
+ "Show a popup menu of LIST at POINT. This function returns a
+value of the selected item. Almost all arguments are the same as in
+`popup-create', except for KEYMAP, FALLBACK, HELP-DELAY, PROMPT,
+ISEARCH, ISEARCH-FILTER, ISEARCH-CURSOR-COLOR, ISEARCH-KEYMAP, and
+ISEARCH-CALLBACK.
+
+If KEYMAP is a keymap which is used when processing events during
+event loop.
+
+If FALLBACK is a function taking two arguments; a key and a
+command. FALLBACK is called when no special operation is found on
+the key. The default value is `popup-menu-fallback', which does
+nothing.
+
+HELP-DELAY is a delay of displaying helps.
+
+If NOWAIT is non-nil, this function immediately returns the menu
+instance without entering event loop.
+
+PROMPT is a prompt string when reading events during event loop.
+
+If ISEARCH is non-nil, do isearch as soon as displaying the popup
+menu.
+
+ISEARCH-FILTER is a filtering function taking two arguments:
+search pattern and list of items. Returns a list of matching items.
+
+ISEARCH-CURSOR-COLOR is a cursor color during isearch. The
+default value is `popup-isearch-cursor-color'.
+
+ISEARCH-KEYMAP is a keymap which is used when processing events
+during event loop. The default value is `popup-isearch-keymap'.
+
+ISEARCH-CALLBACK is a function taking one argument. `popup-menu'
+calls ISEARCH-CALLBACK, if specified, after isearch finished or
+isearch canceled. The arguments is whole filtered list of items.
+
+If `INITIAL-INDEX' is non-nil, this is an initial index value for
+`popup-select'. Only positive integer is valid."
+ (and (eq margin t) (setq margin 1))
+ (or margin-left (setq margin-left margin))
+ (or margin-right (setq margin-right margin))
+ (if (and scroll-bar
+ (integerp margin-right)
+ (> margin-right 0))
+ ;; Make scroll-bar space as margin-right
+ (cl-decf margin-right))
+ (setq menu (popup-create point width height
+ :max-width max-width
+ :around around
+ :face 'popup-menu-face
+ :mouse-face 'popup-menu-mouse-face
+ :selection-face 'popup-menu-selection-face
+ :summary-face 'popup-menu-summary-face
+ :margin-left margin-left
+ :margin-right margin-right
+ :scroll-bar scroll-bar
+ :symbol symbol
+ :parent parent
+ :parent-offset parent-offset))
+ (unwind-protect
+ (progn
+ (popup-set-list menu list)
+ (if cursor
+ (popup-jump menu cursor)
+ (popup-draw menu))
+ (when initial-index
+ (dotimes (_i (min (- (length list) 1) initial-index))
+ (popup-next menu)))
+ (if nowait
+ menu
+ (popup-menu-event-loop menu keymap fallback
+ :prompt prompt
+ :help-delay help-delay
+ :isearch isearch
+ :isearch-filter isearch-filter
+ :isearch-cursor-color isearch-cursor-color
+ :isearch-keymap isearch-keymap
+ :isearch-callback isearch-callback)))
+ (unless nowait
+ (popup-delete menu))))
+
+(defun popup-cascade-menu (list &rest args)
+ "Same as `popup-menu' except that an element of LIST can be
+also a sub-menu if the element is a cons cell formed (ITEM
+. SUBLIST) where ITEM is an usual item and SUBLIST is a list of
+the sub menu."
+ (apply 'popup-menu*
+ (mapcar (lambda (item)
+ (if (consp item)
+ (popup-make-item (car item)
+ :sublist (cdr item)
+ :symbol ">")
+ item))
+ list)
+ :symbol t
+ args))
+
+(provide 'popup)
+;;; popup.el ends here
projects / emacsconfig.git / commitdiff