Browse Source

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.
gn-latest-20200428
Alex Kost 6 years ago
parent
commit
2e269860c4
3 changed files with 79 additions and 57 deletions
  1. +1
    -1
      emacs/guix-base.el
  2. +72
    -41
      emacs/guix-info.el
  3. +6
    -15
      emacs/guix-utils.el

+ 1
- 1
emacs/guix-base.el View File

@@ -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)


+ 72
- 41
emacs/guix-info.el View File

@@ -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)


+ 6
- 15
emacs/guix-utils.el View File

@@ -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…
Cancel
Save