emacs: Support font-locking.
Avoid breaking highlighting after adding new font-lock keywords. * emacs/guix-base.el (guix-insert-package-strings): Use 'propertize' instead of 'guix-get-string'. * emacs/guix-info.el (guix, guix-action, guix-file, guix-url, guix-package-location, guix-package-name): New button types. (guix-info-insert-action-button, guix-info-insert-file-path, guix-info-insert-url, guix-package-info-insert-location, guix-package-info-insert-full-names, guix-package-info-insert-non-unique-text): Adjust for 'guix-insert-button' and button types. (guix-package-info-name-button): New face. (guix-package-info-define-insert-inputs): Use it. Add new button types. (guix-package-info-insert-full-name): Remove. * emacs/guix-utils.el (guix-get-string): Replace 'face' with 'font-lock-face'. (guix-insert-button): Adjust for using button types.master
parent
ce8b295352
commit
2e269860c4
|
@ -673,7 +673,7 @@ ENTRIES is a list of package entries to get info about packages."
|
||||||
(defun guix-insert-package-strings (strings action)
|
(defun guix-insert-package-strings (strings action)
|
||||||
"Insert information STRINGS at point for performing package ACTION."
|
"Insert information STRINGS at point for performing package ACTION."
|
||||||
(when strings
|
(when strings
|
||||||
(insert "Package(s) to " (guix-get-string action 'bold) ":\n")
|
(insert "Package(s) to " (propertize action 'face 'bold) ":\n")
|
||||||
(mapc (lambda (str)
|
(mapc (lambda (str)
|
||||||
(insert " " str "\n"))
|
(insert " " str "\n"))
|
||||||
strings)
|
strings)
|
||||||
|
|
|
@ -291,35 +291,72 @@ VAL is a list, call the function on each element of this list."
|
||||||
(guix-split-insert val face-or-fun
|
(guix-split-insert val face-or-fun
|
||||||
guix-info-fill-column prefix)))))
|
guix-info-fill-column prefix)))))
|
||||||
|
|
||||||
(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'."
|
|
||||||
(apply #'guix-insert-button
|
|
||||||
label 'guix-info-action-button action message
|
|
||||||
'mouse-face 'guix-info-action-button-mouse
|
|
||||||
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"))
|
|
||||||
|
|
||||||
(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 _)
|
(defun guix-info-insert-time (seconds &optional _)
|
||||||
"Insert formatted time string using SECONDS at point."
|
"Insert formatted time string using SECONDS at point."
|
||||||
(guix-info-insert-val-default (guix-get-time-string seconds)
|
(guix-info-insert-val-default (guix-get-time-string seconds)
|
||||||
'guix-info-time))
|
'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.
|
||||||
|
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-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-file))
|
||||||
|
|
||||||
|
(defun guix-info-insert-url (url &optional _)
|
||||||
|
"Make button from URL and insert it at point."
|
||||||
|
(guix-insert-button url 'guix-url))
|
||||||
|
|
||||||
|
|
||||||
(defvar guix-info-mode-map
|
(defvar guix-info-mode-map
|
||||||
(let ((map (make-sparse-keymap)))
|
(let ((map (make-sparse-keymap)))
|
||||||
|
@ -343,6 +380,11 @@ For the meaning of ACTION, MESSAGE and PROPERTIES, see
|
||||||
"Face used for a name of a package."
|
"Face used for a name of a package."
|
||||||
:group 'guix-package-info)
|
: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
|
(defface guix-package-info-version
|
||||||
'((t :inherit font-lock-builtin-face))
|
'((t :inherit font-lock-builtin-face))
|
||||||
"Face used for a version of a package."
|
"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 _)
|
(defun guix-package-info-insert-location (location &optional _)
|
||||||
"Make button from file LOCATION and insert it at point."
|
"Make button from file LOCATION and insert it at point."
|
||||||
(guix-insert-button
|
(guix-insert-button location 'guix-package-location))
|
||||||
location 'guix-package-info-location
|
|
||||||
(lambda (btn) (guix-find-location (button-label btn)))
|
|
||||||
"Find location of this package"))
|
|
||||||
|
|
||||||
(defmacro guix-package-info-define-insert-inputs (&optional type)
|
(defmacro guix-package-info-define-insert-inputs (&optional type)
|
||||||
"Define a face and a function for inserting package inputs.
|
"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-name (and type (concat type-str "-")))
|
||||||
(type-desc (and type (concat type-str " ")))
|
(type-desc (and type (concat type-str " ")))
|
||||||
(face (intern (concat "guix-package-info-" type-name "inputs")))
|
(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"))))
|
(fun (intern (concat "guix-package-info-insert-" type-name "inputs"))))
|
||||||
`(progn
|
`(progn
|
||||||
(defface ,face
|
(defface ,face
|
||||||
'((t :inherit button))
|
'((t :inherit guix-package-info-name-button))
|
||||||
,(concat "Face used for " type-desc "inputs of a package.")
|
,(concat "Face used for " type-desc "inputs of a package.")
|
||||||
:group 'guix-package-info)
|
:group 'guix-package-info)
|
||||||
|
|
||||||
|
(define-button-type ',btn
|
||||||
|
:supertype 'guix-package-name
|
||||||
|
'face ',face)
|
||||||
|
|
||||||
(defun ,fun (inputs &optional _)
|
(defun ,fun (inputs &optional _)
|
||||||
,(concat "Make buttons from " type-desc "INPUTS and insert them at point.")
|
,(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)
|
||||||
(guix-package-info-define-insert-inputs native)
|
(guix-package-info-define-insert-inputs native)
|
||||||
(guix-package-info-define-insert-inputs propagated)
|
(guix-package-info-define-insert-inputs propagated)
|
||||||
|
|
||||||
(defun guix-package-info-insert-full-names (names face)
|
(defun guix-package-info-insert-full-names (names button-type)
|
||||||
"Make buttons from package NAMES and insert them at point.
|
"Make BUTTON-TYPE buttons from package NAMES and insert them at point.
|
||||||
NAMES is a list of strings.
|
NAMES is a list of strings."
|
||||||
Propertize buttons with FACE."
|
|
||||||
(if names
|
(if names
|
||||||
(guix-info-insert-val-default
|
(guix-info-insert-val-default
|
||||||
(with-temp-buffer
|
(with-temp-buffer
|
||||||
(guix-mapinsert (lambda (name)
|
(guix-mapinsert (lambda (name)
|
||||||
(guix-package-info-insert-full-name
|
(guix-insert-button name button-type))
|
||||||
name face))
|
|
||||||
names
|
names
|
||||||
guix-list-separator)
|
guix-list-separator)
|
||||||
(buffer-substring (point-min) (point-max))))
|
(buffer-substring (point-min) (point-max))))
|
||||||
(guix-format-insert nil)))
|
(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
|
;;; Inserting outputs and installed parameters
|
||||||
|
|
||||||
|
@ -485,8 +517,7 @@ formatted with this string, an action button is inserted.")
|
||||||
(insert "\n")
|
(insert "\n")
|
||||||
(guix-info-insert-indent)
|
(guix-info-insert-indent)
|
||||||
(insert "Installed outputs are displayed for a non-unique ")
|
(insert "Installed outputs are displayed for a non-unique ")
|
||||||
(guix-package-info-insert-full-name full-name
|
(guix-insert-button full-name 'guix-package-name)
|
||||||
'guix-package-info-inputs)
|
|
||||||
(insert " package."))
|
(insert " package."))
|
||||||
|
|
||||||
(defun guix-package-info-insert-output (output entry)
|
(defun guix-package-info-insert-output (output entry)
|
||||||
|
|
|
@ -23,7 +23,7 @@
|
||||||
|
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
;; (require 'cl-lib)
|
(require 'cl-lib)
|
||||||
|
|
||||||
(defvar guix-true-string "Yes")
|
(defvar guix-true-string "Yes")
|
||||||
(defvar guix-false-string "–")
|
(defvar guix-false-string "–")
|
||||||
|
@ -52,7 +52,7 @@ If FACE is non-nil, propertize returned string with this FACE."
|
||||||
val guix-list-separator))
|
val guix-list-separator))
|
||||||
(t (prin1-to-string val)))))
|
(t (prin1-to-string val)))))
|
||||||
(if (and val face)
|
(if (and val face)
|
||||||
(propertize str 'face face)
|
(propertize str 'font-lock-face face)
|
||||||
str)))
|
str)))
|
||||||
|
|
||||||
(defun guix-get-time-string (seconds)
|
(defun guix-get-time-string (seconds)
|
||||||
|
@ -84,22 +84,13 @@ at point between each FUNCTION call."
|
||||||
(funcall function obj))
|
(funcall function obj))
|
||||||
(cdr sequence))))
|
(cdr sequence))))
|
||||||
|
|
||||||
(defun guix-insert-button (label face action &optional message
|
(defun guix-insert-button (label &optional type &rest properties)
|
||||||
&rest properties)
|
"Make button of TYPE with LABEL and insert it at point.
|
||||||
"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.
|
|
||||||
See `insert-text-button' for the meaning of PROPERTIES."
|
See `insert-text-button' for the meaning of PROPERTIES."
|
||||||
(if (null label)
|
(if (null label)
|
||||||
(guix-format-insert nil)
|
(guix-format-insert nil)
|
||||||
(apply #'insert-text-button
|
(apply #'insert-text-button label
|
||||||
label
|
:type (or type 'button)
|
||||||
'face face
|
|
||||||
'action action
|
|
||||||
'follow-link t
|
|
||||||
'help-echo message
|
|
||||||
properties)))
|
properties)))
|
||||||
|
|
||||||
(defun guix-split-insert (val &optional face col separator)
|
(defun guix-split-insert (val &optional face col separator)
|
||||||
|
|
Reference in New Issue