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.
This commit is contained in:
Alex Kost
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)
|
||||
"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)
|
||||
|
||||
@ -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-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 _)
|
||||
"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.
|
||||
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
|
||||
(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."
|
||||
: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)
|
||||
|
||||
@ -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)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user