summary refs log tree commit diff
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)
downloadguix-2e269860c48696ca6fd0a76315a85ca3fd1ee3bc.tar.gz
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)