guix-derivation.el 4.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131
  1. ;;; guix-derivation.el --- Guix derivation mode
  2. ;; Copyright © 2017 Oleg Pykhalov <go.wigust@gmail.com>
  3. ;; Copyright © 2017 Alex Kost <alezost@gmail.com>
  4. ;; This file is part of Emacs-Guix.
  5. ;; Emacs-Guix is free software; you can redistribute it and/or modify
  6. ;; it under the terms of the GNU General Public License as published by
  7. ;; the Free Software Foundation, either version 3 of the License, or
  8. ;; (at your option) any later version.
  9. ;;
  10. ;; Emacs-Guix is distributed in the hope that it will be useful,
  11. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. ;; GNU General Public License for more details.
  14. ;;
  15. ;; You should have received a copy of the GNU General Public License
  16. ;; along with Emacs-Guix. If not, see <http://www.gnu.org/licenses/>.
  17. ;;; Commentary:
  18. ;; This file provides `guix-derivation-mode', the major mode for Guix
  19. ;; derivation files (*.drv).
  20. ;;; Code:
  21. (require 'cl-lib)
  22. (require 'guix-auto-mode) ; for `guix-store-directory'
  23. (require 'guix-utils)
  24. (defgroup guix-derivation nil
  25. "Settings for `guix-derivation-mode'."
  26. :prefix "guix-derivation-"
  27. :group 'guix)
  28. (defgroup guix-derivation-faces nil
  29. "Faces for `guix-derivation-mode'."
  30. :group 'guix-derivation
  31. :group 'guix-faces)
  32. (defface guix-derivation-file-name
  33. '((t :inherit link :underline nil))
  34. "Face for store file names."
  35. :group 'guix-derivation-faces)
  36. (defface guix-derivation-drv-file-name
  37. '((default :inherit guix-derivation-file-name)
  38. (((class color) (background light)) :foreground "SpringGreen4")
  39. (((class color) (background dark)) :foreground "SpringGreen3"))
  40. "Face for '*.drv' store file names."
  41. :group 'guix-derivation-faces)
  42. (defcustom guix-derivation-file-regexp
  43. (rx-to-string `(and ,guix-store-directory "/"
  44. (+ (not (any "\" "))))
  45. t)
  46. "Regexp matching Guix derivation file name."
  47. :type 'regexp
  48. :group 'guix-derivation)
  49. (defcustom guix-derivation-file-regexp-group 0
  50. "Regexp group in `guix-derivation-file-regexp'."
  51. :type 'integer
  52. :group 'guix-derivation)
  53. (define-button-type 'guix-derivation-file
  54. 'follow-link t
  55. 'face nil
  56. 'help-echo "Visit this file"
  57. 'action #'guix-derivation-button)
  58. (defvar guix-derivation-file-name-faces
  59. '(("\\.drv\\'" . guix-derivation-drv-file-name)
  60. ("" . guix-derivation-file-name))
  61. "Alist used to define faces to highlight store file names.
  62. Each element of the list has a form:
  63. (REGEXP . FACE)
  64. If any substring of the file name matches REGEXP, this file name
  65. will be highlighted with FACE.")
  66. (defun guix-derivation-file-name-face (file-name)
  67. "Return a face to highlight FILE-NAME.
  68. See `guix-derivation-file-name-faces'."
  69. (cdr (cl-find-if (lambda (assoc)
  70. (string-match-p (car assoc) file-name))
  71. guix-derivation-file-name-faces)))
  72. (defun guix-derivation-button (button)
  73. "View file Guix derivation BUTTON."
  74. (guix-find-file (buffer-substring (button-start button)
  75. (button-end button))))
  76. (defun guix-derivation-make-buttons ()
  77. "Create buttons in the current Guix derivation buffer."
  78. (guix-while-search guix-derivation-file-regexp
  79. (let* ((beg (match-beginning guix-derivation-file-regexp-group))
  80. (end (match-end guix-derivation-file-regexp-group))
  81. (string (substring-no-properties
  82. (match-string guix-derivation-file-regexp-group)))
  83. (face (guix-derivation-file-name-face string)))
  84. (apply #'make-text-button
  85. beg end
  86. :type 'guix-derivation-file
  87. (and face `(font-lock-face ,face))))))
  88. (defvar guix-derivation-mode-map
  89. (let ((map (make-sparse-keymap)))
  90. (define-key map (kbd "<tab>") 'forward-button)
  91. (define-key map (kbd "<backtab>") 'backward-button)
  92. map)
  93. "Keymap for `guix-derivation-mode' buffers.")
  94. ;;;###autoload
  95. (define-derived-mode guix-derivation-mode special-mode "Guix-Derivation"
  96. "Major mode for viewing Guix derivations.
  97. \\{guix-derivation-mode-map}"
  98. ;; Set `font-lock-defaults' to make `global-guix-prettify-mode' work.
  99. (setq font-lock-defaults '(nil t))
  100. (let ((inhibit-read-only t))
  101. (guix-pretty-print-buffer)
  102. (guix-derivation-make-buttons))
  103. (set-buffer-modified-p nil))
  104. (provide 'guix-derivation)
  105. ;;; guix-derivation.el ends here