diff options
Diffstat (limited to 'emacs')
| -rw-r--r-- | emacs/guix-base.el | 2 | ||||
| -rw-r--r-- | emacs/guix-info.el | 113 | ||||
| -rw-r--r-- | emacs/guix-utils.el | 21 |
3 files changed, 79 insertions, 57 deletions
diff --git a/emacs/guix-base.el b/emacs/guix-base.el index 98ee315688..98ce0bcb49 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -673,7 +673,7 @@ ENTRIES is a list of package entries to get info about packages." (defun guix-insert-package-strings (strings action) "Insert information STRINGS at point for performing package ACTION." (when strings - (insert "Package(s) to " (guix-get-string action 'bold) ":\n") + (insert "Package(s) to " (propertize action 'face 'bold) ":\n") (mapc (lambda (str) (insert " " str "\n")) strings) diff --git a/emacs/guix-info.el b/emacs/guix-info.el index f9c17b2d13..aefb32adb5 100644 --- a/emacs/guix-info.el +++ b/emacs/guix-info.el @@ -291,34 +291,71 @@ VAL is a list, call the function on each element of this list." (guix-split-insert val face-or-fun guix-info-fill-column prefix))))) +(defun guix-info-insert-time (seconds &optional _) + "Insert formatted time string using SECONDS at point." + (guix-info-insert-val-default (guix-get-time-string seconds) + 'guix-info-time)) + + +;;; Buttons + +(define-button-type 'guix + 'follow-link t) + +(define-button-type 'guix-action + :supertype 'guix + 'face 'guix-info-action-button + 'mouse-face 'guix-info-action-button-mouse) + +(define-button-type 'guix-file + :supertype 'guix + 'face 'guix-info-file-path + 'help-echo "Find file" + 'action (lambda (btn) + (find-file (button-label btn)))) + +(define-button-type 'guix-url + :supertype 'guix + 'face 'guix-info-url + 'help-echo "Browse URL" + 'action (lambda (btn) + (browse-url (button-label btn)))) + +(define-button-type 'guix-package-location + :supertype 'guix + 'face 'guix-package-info-location + 'help-echo "Find location of this package" + 'action (lambda (btn) + (guix-find-location (button-label btn)))) + +(define-button-type 'guix-package-name + :supertype 'guix + 'face 'guix-package-info-name-button + 'help-echo "Describe this package" + 'action (lambda (btn) + (guix-get-show-entries 'info guix-package-info-type 'name + (button-label btn)))) + (defun guix-info-insert-action-button (label action &optional message &rest properties) "Make action button with LABEL and insert it at point. -For the meaning of ACTION, MESSAGE and PROPERTIES, see -`guix-insert-button'." +ACTION is a function called when the button is pressed. It +should accept button as the argument. +MESSAGE is a button message. +See `insert-text-button' for the meaning of PROPERTIES." (apply #'guix-insert-button - label 'guix-info-action-button action message - 'mouse-face 'guix-info-action-button-mouse + label 'guix-action + 'action action + 'help-echo message properties)) (defun guix-info-insert-file-path (path &optional _) "Make button from file PATH and insert it at point." - (guix-insert-button - path 'guix-info-file-path - (lambda (btn) (find-file (button-label btn))) - "Find file")) + (guix-insert-button path 'guix-file)) (defun guix-info-insert-url (url &optional _) "Make button from URL and insert it at point." - (guix-insert-button - url 'guix-info-url - (lambda (btn) (browse-url (button-label btn))) - "Browse URL")) - -(defun guix-info-insert-time (seconds &optional _) - "Insert formatted time string using SECONDS at point." - (guix-info-insert-val-default (guix-get-time-string seconds) - 'guix-info-time)) + (guix-insert-button url 'guix-url)) (defvar guix-info-mode-map @@ -343,6 +380,11 @@ For the meaning of ACTION, MESSAGE and PROPERTIES, see "Face used for a name of a package." :group 'guix-package-info) +(defface guix-package-info-name-button + '((t :inherit button)) + "Face used for a full name that can be used to describe a package." + :group 'guix-package-info) + (defface guix-package-info-version '((t :inherit font-lock-builtin-face)) "Face used for a version of a package." @@ -396,10 +438,7 @@ For the meaning of ACTION, MESSAGE and PROPERTIES, see (defun guix-package-info-insert-location (location &optional _) "Make button from file LOCATION and insert it at point." - (guix-insert-button - location 'guix-package-info-location - (lambda (btn) (guix-find-location (button-label btn))) - "Find location of this package")) + (guix-insert-button location 'guix-package-location)) (defmacro guix-package-info-define-insert-inputs (&optional type) "Define a face and a function for inserting package inputs. @@ -410,46 +449,39 @@ Face name is `guix-package-info-TYPE-inputs'." (type-name (and type (concat type-str "-"))) (type-desc (and type (concat type-str " "))) (face (intern (concat "guix-package-info-" type-name "inputs"))) + (btn (intern (concat "guix-package-" type-name "input"))) (fun (intern (concat "guix-package-info-insert-" type-name "inputs")))) `(progn (defface ,face - '((t :inherit button)) + '((t :inherit guix-package-info-name-button)) ,(concat "Face used for " type-desc "inputs of a package.") :group 'guix-package-info) + (define-button-type ',btn + :supertype 'guix-package-name + 'face ',face) + (defun ,fun (inputs &optional _) ,(concat "Make buttons from " type-desc "INPUTS and insert them at point.") - (guix-package-info-insert-full-names inputs ',face))))) + (guix-package-info-insert-full-names inputs ',btn))))) (guix-package-info-define-insert-inputs) (guix-package-info-define-insert-inputs native) (guix-package-info-define-insert-inputs propagated) -(defun guix-package-info-insert-full-names (names face) - "Make buttons from package NAMES and insert them at point. -NAMES is a list of strings. -Propertize buttons with FACE." +(defun guix-package-info-insert-full-names (names button-type) + "Make BUTTON-TYPE buttons from package NAMES and insert them at point. +NAMES is a list of strings." (if names (guix-info-insert-val-default (with-temp-buffer (guix-mapinsert (lambda (name) - (guix-package-info-insert-full-name - name face)) + (guix-insert-button name button-type)) names guix-list-separator) (buffer-substring (point-min) (point-max)))) (guix-format-insert nil))) -(defun guix-package-info-insert-full-name (name face) - "Make button and insert package NAME at point. -Propertize package button with FACE." - (guix-insert-button - name face - (lambda (btn) - (guix-get-show-entries 'info 'package 'name - (button-label btn))) - "Describe this package")) - ;;; Inserting outputs and installed parameters @@ -485,8 +517,7 @@ formatted with this string, an action button is inserted.") (insert "\n") (guix-info-insert-indent) (insert "Installed outputs are displayed for a non-unique ") - (guix-package-info-insert-full-name full-name - 'guix-package-info-inputs) + (guix-insert-button full-name 'guix-package-name) (insert " package.")) (defun guix-package-info-insert-output (output entry) diff --git a/emacs/guix-utils.el b/emacs/guix-utils.el index c1fe1a3a38..f99c2ba884 100644 --- a/emacs/guix-utils.el +++ b/emacs/guix-utils.el @@ -23,7 +23,7 @@ ;;; Code: -;; (require 'cl-lib) +(require 'cl-lib) (defvar guix-true-string "Yes") (defvar guix-false-string "–") @@ -52,7 +52,7 @@ If FACE is non-nil, propertize returned string with this FACE." val guix-list-separator)) (t (prin1-to-string val))))) (if (and val face) - (propertize str 'face face) + (propertize str 'font-lock-face face) str))) (defun guix-get-time-string (seconds) @@ -84,22 +84,13 @@ at point between each FUNCTION call." (funcall function obj)) (cdr sequence)))) -(defun guix-insert-button (label face action &optional message - &rest properties) - "Make button with LABEL and insert it at point. -Propertize button with FACE. -ACTION is a function called when the button is pressed. It -should accept button as the argument. -MESSAGE is a button message. +(defun guix-insert-button (label &optional type &rest properties) + "Make button of TYPE with LABEL and insert it at point. See `insert-text-button' for the meaning of PROPERTIES." (if (null label) (guix-format-insert nil) - (apply #'insert-text-button - label - 'face face - 'action action - 'follow-link t - 'help-echo message + (apply #'insert-text-button label + :type (or type 'button) properties))) (defun guix-split-insert (val &optional face col separator) |