summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlex Kost <alezost@gmail.com>2014-09-28 00:59:08 +0400
committerAlex Kost <alezost@gmail.com>2014-09-28 22:46:15 +0400
commit2e269860c48696ca6fd0a76315a85ca3fd1ee3bc (patch)
treea863018103f087c44cd8ed6e0d2e312915418c1e
parentce8b295352516ea2effd259401635a7cdd06cc6f (diff)
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.
-rw-r--r--emacs/guix-base.el2
-rw-r--r--emacs/guix-info.el113
-rw-r--r--emacs/guix-utils.el21
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)