From: Andreas Gerler Date: Tue, 13 Nov 2018 14:04:37 +0000 (+0100) Subject: update popup. add magit-popup. X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=5e1b46d9078a2ab872f132325f20fc10ae3f67c5;p=emacsconfig.git update popup. add magit-popup. Signed-off-by: Andreas Gerler --- diff --git a/bba.org b/bba.org index 873a703d..b2ded3aa 100644 --- a/bba.org +++ b/bba.org @@ -257,7 +257,7 @@ Keep track of your important stuff! (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/")) diff --git a/elpa/magit-popup-20181003.921/dir b/elpa/magit-popup-20181003.921/dir new file mode 100644 index 00000000..ecec7cb7 --- /dev/null +++ b/elpa/magit-popup-20181003.921/dir @@ -0,0 +1,18 @@ +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. + +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" 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. diff --git a/elpa/magit-popup-20181003.921/magit-popup-autoloads.el b/elpa/magit-popup-20181003.921/magit-popup-autoloads.el new file mode 100644 index 00000000..e6e027b2 --- /dev/null +++ b/elpa/magit-popup-20181003.921/magit-popup-autoloads.el @@ -0,0 +1,26 @@ +;;; magit-popup-autoloads.el --- automatically extracted autoloads +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (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-"))) + +;;;*** + +;;;### (autoloads nil nil ("magit-popup-pkg.el") (0 0 0 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; magit-popup-autoloads.el ends here diff --git a/elpa/magit-popup-20181003.921/magit-popup-pkg.el b/elpa/magit-popup-20181003.921/magit-popup-pkg.el new file mode 100644 index 00000000..dc89d651 --- /dev/null +++ b/elpa/magit-popup-20181003.921/magit-popup-pkg.el @@ -0,0 +1,14 @@ +(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" . "jonas@bernoul.li")) + :maintainer + '("Jonas Bernoulli" . "jonas@bernoul.li") + :url "https://github.com/magit/magit-popup") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/magit-popup-20181003.921/magit-popup.el b/elpa/magit-popup-20181003.921/magit-popup.el new file mode 100644 index 00000000..c5bed88e --- /dev/null +++ b/elpa/magit-popup-20181003.921/magit-popup.el @@ -0,0 +1,1372 @@ +;;; 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 and is +;; distributed under the GNU General Public License version 3 or later. + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; 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-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 "- ") 'magit-invoke-popup-switch) + (define-key map (kbd "= ") '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'. + +\\\ +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[]', and + ;; '--grep=' 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[=]') + (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 '. 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 diff --git a/elpa/magit-popup-20181003.921/magit-popup.info b/elpa/magit-popup-20181003.921/magit-popup.info new file mode 100644 index 00000000..2c1e18fb --- /dev/null +++ b/elpa/magit-popup-20181003.921/magit-popup.info @@ -0,0 +1,745 @@ +This is magit-popup.info, produced by makeinfo version 6.5 from +magit-popup.texi. + + Copyright (C) 2015-2018 Jonas Bernoulli + + 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 + + +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 + + 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:: + + + +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. + + +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:: + + +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 +. + + -- 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) + + +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") + + +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:: + + +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. + + +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. + + + +Tag Table: +Node: Top769 +Node: Introduction2004 +Node: Usage4703 +Node: Customizing Existing Popups9400 +Node: Other Options15541 +Node: Defining Prefix and Suffix Commands17084 +Node: Defining Prefix Commands19236 +Node: Defining Suffix Commands27931 + +End Tag Table + + +Local Variables: +coding: utf-8 +End: diff --git a/elpa/popup-20151222.1339/popup-autoloads.el b/elpa/popup-20151222.1339/popup-autoloads.el deleted file mode 100644 index 8b86d291..00000000 --- a/elpa/popup-20151222.1339/popup-autoloads.el +++ /dev/null @@ -1,15 +0,0 @@ -;;; popup-autoloads.el --- automatically extracted autoloads -;; -;;; Code: -(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) - -;;;### (autoloads nil nil ("popup.el") (22215 5356 951539 0)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; End: -;;; popup-autoloads.el ends here diff --git a/elpa/popup-20151222.1339/popup-pkg.el b/elpa/popup-20151222.1339/popup-pkg.el deleted file mode 100644 index 751942ac..00000000 --- a/elpa/popup-20151222.1339/popup-pkg.el +++ /dev/null @@ -1 +0,0 @@ -(define-package "popup" "20151222.1339" "Visual Popup User Interface" '((cl-lib "0.5")) :keywords '("lisp")) diff --git a/elpa/popup-20151222.1339/popup.el b/elpa/popup-20151222.1339/popup.el deleted file mode 100644 index c206c1f3..00000000 --- a/elpa/popup-20151222.1339/popup.el +++ /dev/null @@ -1,1428 +0,0 @@ -;;; popup.el --- Visual Popup User Interface - -;; Copyright (C) 2009-2015 Tomohiro Matsuyama - -;; Author: Tomohiro Matsuyama -;; 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 . - -;;; 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") - - - -;;; 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)))))))) - - - -;;; 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))) - - - -;;; 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))))) - - - -;;; 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)))) - - - -;;; 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 diff --git a/elpa/popup-20160709.1429/popup-autoloads.el b/elpa/popup-20160709.1429/popup-autoloads.el new file mode 100644 index 00000000..8389b0a1 --- /dev/null +++ b/elpa/popup-20160709.1429/popup-autoloads.el @@ -0,0 +1,22 @@ +;;; popup-autoloads.el --- automatically extracted autoloads +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (autoloads nil "popup" "popup.el" (0 0 0 0)) +;;; Generated autoloads from popup.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "popup" '("popup-"))) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; popup-autoloads.el ends here diff --git a/elpa/popup-20160709.1429/popup-pkg.el b/elpa/popup-20160709.1429/popup-pkg.el new file mode 100644 index 00000000..f2c937f4 --- /dev/null +++ b/elpa/popup-20160709.1429/popup-pkg.el @@ -0,0 +1,2 @@ +;;; -*- 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.pub@gmail.com")) :maintainer '("Tomohiro Matsuyama" . "m2ym.pub@gmail.com")) diff --git a/elpa/popup-20160709.1429/popup.el b/elpa/popup-20160709.1429/popup.el new file mode 100644 index 00000000..f112cbac --- /dev/null +++ b/elpa/popup-20160709.1429/popup.el @@ -0,0 +1,1432 @@ +;;; popup.el --- Visual Popup User Interface + +;; Copyright (C) 2009-2015 Tomohiro Matsuyama + +;; Author: Tomohiro Matsuyama +;; 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 . + +;;; 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") + + + +;;; 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)))))))) + + + +;;; 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))) + + + +;;; 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))))) + + + +;;; 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)))) + + + +;;; 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