;;; guix-info.el --- 'Info' buffer interface for displaying data -*- lexical-binding: t -*- ;; Copyright © 2014, 2015 Alex Kost ;; Copyright © 2015 Ludovic Courtès ;; This file is part of GNU Guix. ;; GNU Guix is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; GNU Guix is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; This file provides 'info' (help-like) buffer interface for displaying ;; an arbitrary data. ;;; Code: (require 'guix-buffer) (require 'guix-entry) (require 'guix-utils) (guix-define-buffer-type info) (defface guix-info-heading '((((type tty pc) (class color)) :weight bold) (t :height 1.6 :weight bold :inherit variable-pitch)) "Face for headings." :group 'guix-info-faces) (defface guix-info-param-title '((t :inherit font-lock-type-face)) "Face used for titles of parameters." :group 'guix-info-faces) (defface guix-info-file-name '((t :inherit link)) "Face used for file names." :group 'guix-info-faces) (defface guix-info-url '((t :inherit link)) "Face used for URLs." :group 'guix-info-faces) (defface guix-info-time '((t :inherit font-lock-constant-face)) "Face used for timestamps." :group 'guix-info-faces) (defface guix-info-action-button '((((type x w32 ns) (class color)) :box (:line-width 2 :style released-button) :background "lightgrey" :foreground "black") (t :inherit button)) "Face used for action buttons." :group 'guix-info-faces) (defface guix-info-action-button-mouse '((((type x w32 ns) (class color)) :box (:line-width 2 :style released-button) :background "grey90" :foreground "black") (t :inherit highlight)) "Mouse face used for action buttons." :group 'guix-info-faces) (defcustom guix-info-ignore-empty-values nil "If non-nil, do not display parameters with nil values." :type 'boolean :group 'guix-info) (defcustom guix-info-fill t "If non-nil, fill string parameters to fit the window. If nil, insert text parameters (like synopsis or description) in a raw form." :type 'boolean :group 'guix-info) (defvar guix-info-param-title-format "%-18s: " "String used to format a title of a parameter. It should be a '%s'-sequence. After inserting a title formatted with this string, a value of the parameter is inserted. This string is used by `guix-info-insert-title-format'.") (defvar guix-info-multiline-prefix (make-string (length (format guix-info-param-title-format " ")) ?\s) "String used to format multi-line parameter values. If a value occupies more than one line, this string is inserted in the beginning of each line after the first one. This string is used by `guix-info-insert-value-format'.") (defvar guix-info-indent 2 "Number of spaces used to indent various part2021-04-23file-systems: read-partition-{uuid,label} don't swallow ENOENT & co....Ludovic Courtès value for ENTRY-TYPE from `guix-info-data'." (symbol-value (guix-assq-value guix-info-data entry-type symbol))) (defun guix-info-param-title (entry-type param) "Return a title of an ENTRY-TYPE parameter PARAM." (guix-buffer-param-title 'info entry-type param)) (defun guix-info-format (entry-type) "Return 'info' format for ENTRY-TYPE." (guix-info-value entry-type 'format)) (defun guix-info-displayed-params (entry-type) "Return a list of ENTRY-TYPE parameters that should be displayed." (delq nil (mapcar (lambda (spec) (pcase spec (`(,param . ,_) param))) (guix-info-format entry-type)))) ;;; Inserting entries (defvar guix-info-title-aliases '((format . guix-info-insert-title-format) (simple . guix-info-insert-title-simple)) "Alist of aliases and functions to insert titles.") (defvar guix-info-value-aliases '((format . guix-info-insert-value-format) (indent . guix-info-insert-value-indent) (simple . guix-info-insert-value-simple) (time . guix-info-insert-time)) "Alist of aliases and functions to insert values.") (defun guix-info-title-function (fun-or-alias) "Convert FUN-OR-ALIAS into a function to insert a title." (or (guix-assq-value guix-info-title-aliases fun-or-alias) fun-or-alias)) (defun guix-info-value-function (fun-or-alias) "Convert FUN-OR-ALIAS into a function to insert a value." (or (guix-assq-value guix-info-value-aliases fun-or-alias) fun-or-alias)) (defun guix-info-title-method->function (method) "Convert title METHOD into a function to insert a title." (pcase method ((pred null) #'ignore) ((pred symbolp) (guix-info-title-function method)) (`(,fun-or-alias . ,rest-args) (lambda (title) (apply (guix-info-title-function fun-or-alias) title rest-args))) (_ (error "Unknown title method '%S'" method)))) (defun guix-info-value-method->function (method) "Convert value METHOD into a function to insert a value." (pcase method ((pred null) #'ignore) ((pred functionp) method) (`(,fun-or-alias . ,rest-args) (lambda (value _) (apply (guix-info-value-function fun-or-alias) value rest-args))) (_ (error "Unknown value method '%S'" method)))) (defun guix-info-fill-column () "Return fill column for the current window." (min (window-width) fill-column)) (defun guix-info-get-indent (&optional level) "Return `guix-info-indent' \"multiplied\" by LEVEL spaces. LEVEL is 1 by default." (make-string (* guix-info-indent (or level 1)) ?\s)) (defun guix-info-insert-indent (&optional level) "Insert `guix-info-indent' spaces LEVEL times (1 by default)." (insert (guix-info-get-indent level))) (defun guix-info-insert-entries (entries entry-type) "Display ENTRY-TYPE ENTRIES in the current info buffer." (guix-mapinsert (lambda (entry) (guix-info-insert-entry entry entry-type)) entries guix-info-delimiter)) (defun guix-info-insert-entry (entry entry-type &optional indent-level) "Insert ENTRY of ENTRY-TYPE into the current info buffer. If INDENT-LEVEL is non-nil, indent displayed data by this number of `guix-info-indent' spaces." (guix-with-indent (* (or indent-level 0) guix-info-indent) (dolist (spec (guix-info-format entry-type)) (guix-info-insert-entry-unit spec entry entry-type)))) (defun guix-info-insert-entry-unit (format-spec entry entry-type) "Insert title and value of a PARAM at point. ENTRY is alist with parameters and their values. ENTRY-TYPE is a type of ENTRY." (pcase format-spec ((pred functionp) (funcall format-spec entry) (insert "\n")) (`(,param ,title-method ,value-method) (let ((value (guix-entry-value entry param))) (unless (and guix-info-ignore-empty-values (null value)) (let ((title (guix-info-param-title entry-type param)) (insert-title (guix-info-title-method->function title-method)) (insert-value (guix-info-value-method->function value-method))) (funcall insert-title title) (funcall insert-value value entry) (insert "\n"))))) (_ (error "Unknown format specification '%S'" format-spec)))) (defun guix-info-insert-title-simple (title &optional face) "Insert \"TITLE: \" string at point. If FACE is nil, use `guix-info-param-title'." (guix-format-insert title (or face 'guix-info-param-title) "%s: ")) (defun guix-info-insert-title-format (title &optional face) "Insert TITLE using `guix-info-param-title-format' at point. If FACE is nil, use `guix-info-param-title'." (guix-format-insert title (or face 'guix-info-param-title) guix-info-param-title-format)) (defun guix-info-insert-value-simple (value &optional button-or-face indent) "Format and insert parameter VALUE at point. VALUE may be split into several short lines to fit the current window, depending on `guix-info-fill', and each line is indented with INDENT number of spaces. If BUTTON-OR-FACE is a button type symbol, transform VALUE into this (these) button(s) and insert each one on a new line. If it is a face symbol, propertize inserted line(s) with this face." (or indent (setq indent 0)) (guix-with-indent indent (let* ((button? (guix-button-type? button-or-face)) (face (unless button? button-or-face)) (fill-col (unless (or button? (and (stringp value) (not guix-info-fill))) (- (guix-info-fill-column) indent))) (value (if (and value button?) (guix-buttonize value button-or-face "\n") value))) (guix-split-insert value face fill-col "\n")))) (defun guix-info-insert-value-indent (value &optional button-or-face) "Format and insert parameter VALUE at point. This function is intended to be called after inserting a title with `guix-info-insert-title-simple'. VALUE may be split into several short lines to fit the current window, depending on `guix-info-fill', and each line is indented with `guix-info-indent'. For the meaning of BUTTON-OR-FACE, see `guix-info-insert-value-simple'." (when value (insert "\n")) (guix-info-insert-value-simple value button-or-face guix-info-indent)) (defun guix-info-insert-value-format (value &optional button-or-face &rest button-properties) "Format and insert parameter VALUE at point. This function is intended to be called after inserting a title with `guix-info-insert-title-format'. VALUE may be split into several short lines to fit the current window, depending on `guix-info-fill' and `guix-info-multiline-prefix'. If VALUE is a list, its elements will be separated with `guix-list-separator'. If BUTTON-OR-FACE is a button type symbol, transform VALUE into this (these) button(s). If it is a face symbol, propertize inserted line(s) with this face. BUTTON-PROPERTIES are passed to `guix-buttonize' (only if BUTTON-OR-FACE is a button type)." (let* ((button? (guix-button-type? button-or-face)) (face (unless button? button-or-face)) (fill-col (when (or button? guix-info-fill (not (stringp value))) (- (guix-info-fill-column) (length guix-info-multiline-prefix)))) (value (if (and value button?) (apply #'guix-buttonize value button-or-face guix-list-separator button-properties) value))) (guix-split-insert value face fill-col (concat "\n" guix-info-multiline-prefix)))) (defun guix-info-insert-time (seconds &optional face) "Insert formatted time string using SECONDS at point." (guix-format-insert (guix-get-time-string seconds) (or face 'guix-info-time))) ;;; Buttons (defvar guix-info-button-map (let ((map (make-sparse-keymap))) (set-keymap-parent map button-map) (define-key map (kbd "c") 'guix-info-button-copy-label) map) "Keymap for buttons in info buffers.") (define-button-type 'guix 'keymap guix-info-button-map '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-name 'help-echo "Find file" 'action (lambda (btn) (guix-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)))) (defun guix-info-button-copy-label (&optional pos) "Copy a label of the button at POS into kill ring. If POS is nil, use the current point position." (interactive) (let ((button (button-at (or pos (point))))) (when button (guix-copy-as-kill (button-label button))))) (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)) ;;; Major mode and interface definer (defvar guix-info-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map (make-composed-keymap (list guix-buffer-map button-buffer-map) special-mode-map)) map) "Keymap for `guix-info-mode' buffers.") (define-derived-mode guix-info-mode special-mode "Guix-Info" "Parent mode for displaying data in 'info' form." (setq-local revert-buffer-function 'guix-buffer-revert)) (defun guix-info-mode-initialize () "Set up the current 'info' buffer." ;; Without this, syntactic fontification is performed, and it may ;; break our highlighting. For example, description of "emacs-typo" ;; package contains a single " (double-quote) character, so the ;; default syntactic fontification highlights the rest text after it ;; as a string. See (info "(elisp) Font Lock Basics") for details. (setq font-lock-defaults '(nil t))) (defmacro guix-info-define-interface (entry-type &rest args) "Define 'info' interface for displaying ENTRY-TYPE entries. Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... Required keywords: - `:format' - default value of the generated `guix-ENTRY-TYPE-info-format' variable. The rest keyword arguments are passed to `guix-buffer-define-interface' macro." (declare (indent 1)) (let* ((entry-type-str (symbol-name entry-type)) (prefix (concat "guix-" entry-type-str "-info")) (group (intern prefix)) (format-var (intern (concat prefix "-format")))) (guix-keyword-args-let args ((show-entries-val :show-entries-function) (format-val :format)) `(progn (defcustom ,format-var ,format-val ,(format "\ List of methods for inserting '%s' entry. Each METHOD should be either a function or should have the following form: (PARAM INSERT-TITLE INSERT-VALUE) If METHOD is a function, it is called with an entry as argument. PARAM is a name of '%s' entry parameter. INSERT-TITLE may be either a symbol or a list. If it is a symbol, it should be a function or an alias from `guix-info-title-aliases', in which case it is called with title as argument. If it is a list, it should have a form (FUN-OR-ALIAS [ARGS ...]), in which case FUN-OR-ALIAS is called with title and ARGS as arguments. INSERT-VALUE may be either a symbol or a list. If it is a symbol, it should be a function or an alias from `guix-info-value-aliases', in which case it is called with value and entry as arguments. If it is a list, it should have a form (FUN-OR-ALIAS [ARGS ...]), in which case FUN-OR-ALIAS is called with value and ARGS as arguments. Parameters are inserted in the same order as defined by this list. After calling each METHOD, a new line is inserted." entry-type-str entry-type-str) :type 'sexp :group ',group) (guix-alist-put! '((format . ,format-var)) 'guix-info-data ',entry-type) ,(if show-entries-val `(guix-buffer-define-interface info ,entry-type :show-entries-function ,show-entries-val ,@%foreign-args) (let ((insert-fun (intern (concat prefix "-insert-entries")))) `(progn (defun ,insert-fun (entries) ,(format "\ Print '%s' ENTRIES in the current 'info' buffer." entry-type-str) (guix-info-insert-entries entries ',entry-type)) (guix-buffer-define-interface info ,entry-type :insert-entries-function ',insert-fun :mode-init-function 'guix-info-mode-initialize ,@%foreign-args)))))))) (defvar guix-info-font-lock-keywords (eval-when-compile `((,(rx "(" (group "guix-info-define-interface") symbol-end) . 1)))) (font-lock-add-keywords 'emacs-lisp-mode guix-info-font-lock-keywords) (provide 'guix-info) ;;; guix-info.el ends here