aboutsummaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-10-04 08:57:20 +0200
committerLudovic Courtès <ludo@gnu.org>2017-10-11 11:12:33 +0200
commit03f66aea63d43ce31107605557c1cbfbb9d25a73 (patch)
treea80eb2a6357eb83aeb60d1ac9996322373a169de /gnu
parent88235675fce40d619850ac9bd676d86e42acb8b8 (diff)
downloadguix-03f66aea63d43ce31107605557c1cbfbb9d25a73.tar.gz
guix-03f66aea63d43ce31107605557c1cbfbb9d25a73.zip
uuid: Change "fat32" to "fat".
* gnu/system/uuid.scm (%fat32-endianness): Rename to... (%fat-endianness): ... this. (fat32-uuid->string): Rename to... (fat-uuid->string): ... this. (%fat32-uuid-rx): Rename to.. (%fat-uuid-rx): ... this. (string->fat32-uuid): Rename to... (string->fat-uuid): ... this. (%uuid-parsers, %uuid-printers): Add 'fat16.
Diffstat (limited to 'gnu')
-rw-r--r--gnu/system/uuid.scm30
1 files changed, 15 insertions, 15 deletions
diff --git a/gnu/system/uuid.scm b/gnu/system/uuid.scm
index e422e06a6d..eaddfaed05 100644
--- a/gnu/system/uuid.scm
+++ b/gnu/system/uuid.scm
@@ -42,7 +42,7 @@
string->ext3-uuid
string->ext4-uuid
string->btrfs-uuid
- string->fat32-uuid
+ string->fat-uuid
iso9660-uuid->string
;; XXX: For lack of a better place.
@@ -164,25 +164,25 @@ ISO9660 UUID representation."
;;;
-;;; FAT32.
+;;; FAT32/FAT16.
;;;
-(define-syntax %fat32-endianness
- ;; Endianness of FAT file systems.
+(define-syntax %fat-endianness
+ ;; Endianness of FAT32/FAT16 file systems.
(identifier-syntax (endianness little)))
-(define (fat32-uuid->string uuid)
- "Convert fat32 UUID, a 4-byte bytevector, to its string representation."
- (let ((high (bytevector-uint-ref uuid 0 %fat32-endianness 2))
- (low (bytevector-uint-ref uuid 2 %fat32-endianness 2)))
+(define (fat-uuid->string uuid)
+ "Convert FAT32/FAT16 UUID, a 4-byte bytevector, to its string representation."
+ (let ((high (bytevector-uint-ref uuid 0 %fat-endianness 2))
+ (low (bytevector-uint-ref uuid 2 %fat-endianness 2)))
(format #f "~:@(~x-~x~)" low high)))
-(define %fat32-uuid-rx
+(define %fat-uuid-rx
(make-regexp "^([[:xdigit:]]{4})-([[:xdigit:]]{4})$"))
-(define (string->fat32-uuid str)
- "Parse STR, which is in FAT32 format, and return a bytevector or #f."
- (match (regexp-exec %fat32-uuid-rx str)
+(define (string->fat-uuid str)
+ "Parse STR, which is in FAT32/FAT16 format, and return a bytevector or #f."
+ (match (regexp-exec %fat-uuid-rx str)
(#f
#f)
(rx-match
@@ -190,7 +190,7 @@ ISO9660 UUID representation."
(match:substring rx-match 2) 16)
(string->number
(match:substring rx-match 1) 16))
- %fat32-endianness
+ %fat-endianness
2))))
@@ -216,14 +216,14 @@ ISO9660 UUID representation."
(define %uuid-parsers
(vhashq
('dce 'ext2 'ext3 'ext4 'btrfs 'luks => string->dce-uuid)
- ('fat32 'fat => string->fat32-uuid)
+ ('fat32 'fat16 'fat => string->fat-uuid)
('iso9660 => string->iso9660-uuid)))
(define %uuid-printers
(vhashq
('dce 'ext2 'ext3 'ext4 'btrfs 'luks => dce-uuid->string)
('iso9660 => iso9660-uuid->string)
- ('fat32 'fat => fat32-uuid->string)))
+ ('fat32 'fat16 'fat => fat-uuid->string)))
(define* (string->uuid str #:optional (type 'dce))
"Parse STR as a UUID of the given TYPE. On success, return the
ef='#n253'>253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624
;;; guix-buffer.el --- Buffer interface for displaying data  -*- lexical-binding: t -*-

;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>

;; 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 <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This file provides a general 'buffer' interface for displaying an
;; arbitrary data.

;;; Code:

(require 'cl-lib)
(require 'guix-history)
(require 'guix-utils)

(defvar guix-buffer-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "l") 'guix-history-back)
    (define-key map (kbd "r") 'guix-history-forward)
    (define-key map (kbd "g") 'revert-buffer)
    (define-key map (kbd "R") 'guix-buffer-redisplay)
    map)
  "Parent keymap for Guix buffer modes.")


;;; Buffer item

(cl-defstruct (guix-buffer-item
               (:constructor nil)
               (:constructor guix-buffer-make-item
                             (entries buffer-type entry-type args))
               (:copier      nil))
  entries buffer-type entry-type args)

(defvar-local guix-buffer-item nil
  "Data (structure) for the current Guix buffer.
The structure consists of the following elements:

- `entries': list of the currently displayed entries.

  Each element of the list is an alist with an entry data of the
  following form:

    ((PARAM . VAL) ...)

  PARAM is a name of the entry parameter.
  VAL is a value of this parameter.

- `entry-type': type of the currently displayed entries.

- `buffer-type': type of the current buffer.

- `args': search arguments used to get the current entries.")
(put 'guix-buffer-item 'permanent-local t)

(defmacro guix-buffer-with-item (item &rest body)
  "Evaluate BODY using buffer ITEM.
The following local variables are available inside BODY:
`%entries', `%buffer-type', `%entry-type', `%args'.
See `guix-buffer-item' for details."
  (declare (indent 1) (debug t))
  (let ((item-var (make-symbol "item")))
    `(let ((,item-var ,item))
       (let ((%entries     (guix-buffer-item-entries     ,item-var))
             (%buffer-type (guix-buffer-item-buffer-type ,item-var))
             (%entry-type  (guix-buffer-item-entry-type  ,item-var))
             (%args        (guix-buffer-item-args        ,item-var)))
         ,@body))))

(defmacro guix-buffer-with-current-item (&rest body)
  "Evaluate BODY using `guix-buffer-item'.
See `guix-buffer-with-item' for details."
  (declare (indent 0) (debug t))
  `(guix-buffer-with-item guix-buffer-item
     ,@body))

(defmacro guix-buffer-define-current-item-accessor (name)
  "Define `guix-buffer-current-NAME' function to access NAME
element of `guix-buffer-item' structure.
NAME should be a symbol."
  (let* ((name-str (symbol-name name))
         (accessor (intern (concat "guix-buffer-item-" name-str)))
         (fun-name (intern (concat "guix-buffer-current-" name-str)))
         (doc      (format "\
Return '%s' of the current Guix buffer.
See `guix-buffer-item' for details."
                           name-str)))
    `(defun ,fun-name ()
       ,doc
       (and guix-buffer-item
            (,accessor guix-buffer-item)))))

(defmacro guix-buffer-define-current-item-accessors (&rest names)
  "Define `guix-buffer-current-NAME' functions for NAMES.
See `guix-buffer-define-current-item-accessor' for details."
  `(progn
     ,@(mapcar (lambda (name)
                 `(guix-buffer-define-current-item-accessor ,name))
               names)))

(guix-buffer-define-current-item-accessors
 entries entry-type buffer-type args)

(defmacro guix-buffer-define-current-args-accessor (n prefix name)
  "Define `PREFIX-NAME' function to access Nth element of 'args'
field of `guix-buffer-item' structure.
PREFIX and NAME should be strings."
  (let ((fun-name (intern (concat prefix "-" name)))
        (doc      (format "\
Return '%s' of the current Guix buffer.
'%s' is the element number %d in 'args' of `guix-buffer-item'."
                          name name n)))
    `(defun ,fun-name ()
       ,doc
       (nth ,n (guix-buffer-current-args)))))

(defmacro guix-buffer-define-current-args-accessors (prefix &rest names)
  "Define `PREFIX-NAME' functions for NAMES.
See `guix-buffer-define-current-args-accessor' for details."
  `(progn
     ,@(cl-loop for name in names
                for i from 0
                collect `(guix-buffer-define-current-args-accessor
                          ,i ,prefix ,name))))


;;; Wrappers for defined variables

(defvar guix-buffer-data nil
  "Alist with 'buffer' data.
This alist is filled by `guix-buffer-define-interface' macro.")

(defun guix-buffer-value (buffer-type entry-type symbol)
  "Return SYMBOL's value for BUFFER-TYPE/ENTRY-TYPE from `guix-buffer-data'."
  (symbol-value
   (guix-assq-value guix-buffer-data buffer-type entry-type symbol)))

(defun guix-buffer-get-entries (buffer-type entry-type args)
  "Return ENTRY-TYPE entries.
Call an appropriate 'get-entries' function from `guix-buffer'
using ARGS as its arguments."
  (apply (guix-buffer-value buffer-type entry-type 'get-entries)
         args))

(defun guix-buffer-mode-enable (buffer-type entry-type)
  "Turn on major mode to display ENTRY-TYPE ENTRIES in BUFFER-TYPE buffer."
  (funcall (guix-buffer-value buffer-type entry-type 'mode)))

(defun guix-buffer-mode-initialize (buffer-type entry-type)
  "Set up the current BUFFER-TYPE buffer to display ENTRY-TYPE entries."
  (let ((fun (guix-buffer-value buffer-type entry-type 'mode-init)))
    (when fun
      (funcall fun))))

(defun guix-buffer-insert-entries (entries buffer-type entry-type)
  "Show ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer."
  (funcall (guix-buffer-value buffer-type entry-type 'insert-entries)
           entries))

(defun guix-buffer-show-entries-default (entries buffer-type entry-type)
  "Show ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer."
  (let ((inhibit-read-only t))
    (erase-buffer)
    (guix-buffer-mode-enable buffer-type entry-type)
    (guix-buffer-insert-entries entries buffer-type entry-type)
    (goto-char (point-min))))

(defun guix-buffer-show-entries (entries buffer-type entry-type)
  "Show ENTRY-TYPE ENTRIES in the current BUFFER-TYPE buffer."
  (funcall (guix-buffer-value buffer-type entry-type 'show-entries)
           entries))

(defun guix-buffer-message (entries buffer-type entry-type args)
  "Display a message for BUFFER-ITEM after showing entries."
  (let ((fun (guix-buffer-value buffer-type entry-type 'message)))
    (when fun
      (apply fun entries args))))

(defun guix-buffer-name (buffer-type entry-type args)
  "Return name of BUFFER-TYPE buffer for displaying ENTRY-TYPE entries."
  (let ((str-or-fun (guix-buffer-value buffer-type entry-type
                                       'buffer-name)))
    (if (stringp str-or-fun)
        str-or-fun
      (apply str-or-fun args))))

(defun guix-buffer-param-title (buffer-type entry-type param)
  "Return PARAM title for BUFFER-TYPE/ENTRY-TYPE."
  (or (guix-assq-value (guix-buffer-value buffer-type entry-type 'titles)
                       param)
      ;; Fallback to a title defined in 'info' interface.
      (unless (eq buffer-type 'info)
        (guix-assq-value (guix-buffer-value 'info entry-type 'titles)
                         param))
      (guix-symbol-title param)))

(defun guix-buffer-history-size (buffer-type entry-type)
  "Return history size for BUFFER-TYPE/ENTRY-TYPE."
  (guix-buffer-value buffer-type entry-type 'history-size))

(defun guix-buffer-revert-confirm? (buffer-type entry-type)
  "Return 'revert-confirm' value for BUFFER-TYPE/ENTRY-TYPE."
  (guix-buffer-value buffer-type entry-type 'revert-confirm))


;;; Displaying entries

(defun guix-buffer-display (buffer)
  "Switch to a Guix BUFFER."
  (pop-to-buffer buffer
                 '((display-buffer-reuse-window
                    display-buffer-same-window))))

(defun guix-buffer-history-item (buffer-item)
  "Make and return a history item for displaying BUFFER-ITEM."
  (list #'guix-buffer-set buffer-item))

(defun guix-buffer-set (buffer-item &optional history)
  "Set up the current buffer for displaying BUFFER-ITEM.
HISTORY should be one of the following:

  `nil' - do not save BUFFER-ITEM in history,

  `add' - add it to history,

  `replace' - replace the current history item."
  (guix-buffer-with-item buffer-item
    (when %entries
      ;; Set buffer item before showing entries, so that its value can
      ;; be used by the code for displaying entries.
      (setq guix-buffer-item buffer-item)
      (guix-buffer-show-entries %entries %buffer-type %entry-type)
      (when history
        (funcall (cl-ecase history
                   (add     #'guix-history-add)
                   (replace #'guix-history-replace))
                 (guix-buffer-history-item buffer-item))))
    (guix-buffer-message %entries %buffer-type %entry-type %args)))

(defun guix-buffer-display-entries-current
    (entries buffer-type entry-type args &optional history)
  "Show ENTRIES in the current Guix buffer.
See `guix-buffer-item' for the meaning of BUFFER-TYPE, ENTRY-TYPE
and ARGS, and `guix-buffer-set' for the meaning of HISTORY."
  (let ((item (guix-buffer-make-item entries buffer-type
                                     entry-type args)))
    (guix-buffer-set item history)))

(defun guix-buffer-get-display-entries-current
    (buffer-type entry-type args &optional history)
  "Search for entries and show them in the current Guix buffer.
See `guix-buffer-display-entries-current' for details."
  (guix-buffer-display-entries-current
   (guix-buffer-get-entries buffer-type entry-type args)
   buffer-type entry-type args history))

(defun guix-buffer-display-entries
    (entries buffer-type entry-type args &optional history)
  "Show ENTRIES in a BUFFER-TYPE buffer.
See `guix-buffer-display-entries-current' for details."
  (let ((buffer (get-buffer-create
                 (guix-buffer-name buffer-type entry-type args))))
    (with-current-buffer buffer
      (guix-buffer-display-entries-current
       entries buffer-type entry-type args history))
    (when entries
      (guix-buffer-display buffer))))

(defun guix-buffer-get-display-entries
    (buffer-type entry-type args &optional history)
  "Search for entries and show them in a BUFFER-TYPE buffer.
See `guix-buffer-display-entries-current' for details."
  (guix-buffer-display-entries
   (guix-buffer-get-entries buffer-type entry-type args)
   buffer-type entry-type args history))

(defun guix-buffer-revert (_ignore-auto noconfirm)
  "Update the data in the current Guix buffer.
This function is suitable for `revert-buffer-function'.
See `revert-buffer' for the meaning of NOCONFIRM."
  (guix-buffer-with-current-item
    (when (or noconfirm
              (not (guix-buffer-revert-confirm? %buffer-type %entry-type))
              (y-or-n-p "Update the current buffer? "))
      (guix-buffer-get-display-entries-current
       %buffer-type %entry-type %args 'replace))))

(defvar guix-buffer-after-redisplay-hook nil
  "Hook run by `guix-buffer-redisplay'.
This hook is called before seting up a window position.")

(defun guix-buffer-redisplay ()
  "Redisplay the current Guix buffer.
Restore the point and window positions after redisplaying.

This function does not update the buffer data, use
'\\[revert-buffer]' if you want the full update."
  (interactive)
  (let* ((old-point (point))
         ;; For simplicity, ignore an unlikely case when multiple
         ;; windows display the same buffer.
         (window (car (get-buffer-window-list (current-buffer) nil t)))
         (window-start (and window (window-start window))))
    (guix-buffer-set guix-buffer-item)
    (goto-char old-point)
    (run-hooks 'guix-buffer-after-redisplay-hook)
    (when window
      (set-window-point window (point))
      (set-window-start window window-start))))

(defun guix-buffer-redisplay-goto-button ()
  "Redisplay the current buffer and go to the next button, if needed."
  (let ((guix-buffer-after-redisplay-hook
         (cons (lambda ()
                 (unless (button-at (point))
                   (forward-button 1)))
               guix-buffer-after-redisplay-hook)))
    (guix-buffer-redisplay)))


;;; Interface definers

(defmacro guix-define-groups (type &rest args)
  "Define `guix-TYPE' and `guix-TYPE-faces' custom groups.
Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...

Optional keywords:

  - `:parent-group' - name of a parent custom group.

  - `:parent-faces-group' - name of a parent custom faces group.

  - `:group-doc' - docstring of a `guix-TYPE' group.

  - `:faces-group-doc' - docstring of a `guix-TYPE-faces' group."
  (declare (indent 1))
  (let* ((type-str           (symbol-name type))
         (prefix             (concat "guix-" type-str))
         (group              (intern prefix))
         (faces-group        (intern (concat prefix "-faces"))))
    (guix-keyword-args-let args
        ((parent-group       :parent-group 'guix)
         (parent-faces-group :parent-faces-group 'guix-faces)
         (group-doc          :group-doc
                             (format "Settings for '%s' buffers."
                                     type-str))
         (faces-group-doc    :faces-group-doc
                             (format "Faces for '%s' buffers."
                                     type-str)))
      `(progn
         (defgroup ,group nil
           ,group-doc
           :group ',parent-group)

         (defgroup ,faces-group nil
           ,faces-group-doc
           :group ',group
           :group ',parent-faces-group)))))

(defmacro guix-define-entry-type (entry-type &rest args)
  "Define general code for ENTRY-TYPE.
See `guix-define-groups'."
  (declare (indent 1))
  `(guix-define-groups ,entry-type
     ,@args))

(defmacro guix-define-buffer-type (buffer-type &rest args)
  "Define general code for BUFFER-TYPE.
See `guix-define-groups'."
  (declare (indent 1))
  `(guix-define-groups ,buffer-type
     ,@args))

(defmacro guix-buffer-define-interface (buffer-type entry-type &rest args)
  "Define BUFFER-TYPE interface for displaying ENTRY-TYPE entries.
Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
In the following description TYPE means ENTRY-TYPE-BUFFER-TYPE.

Required keywords:

  - `:buffer-name' - default value of the generated
    `guix-TYPE-buffer-name' variable.

  - `:get-entries-function' - default value of the generated
    `guix-TYPE-get-function' variable.

  - `:show-entries-function' - default value of the generated
    `guix-TYPE-show-function' variable.

  Alternatively, if `:show-entries-function' is not specified, a
  default `guix-TYPE-show-entries' will be generated, and the
  following keyword should be specified instead:

  - `:insert-entries-function' - default value of the generated
    `guix-TYPE-insert-function' variable.

Optional keywords:

  - `:message-function' - default value of the generated
    `guix-TYPE-message-function' variable.

  - `:titles' - default value of the generated
    `guix-TYPE-titles' variable.

  - `:history-size' - default value of the generated
    `guix-TYPE-history-size' variable.

  - `:revert-confirm?' - default value of the generated
    `guix-TYPE-revert-confirm' variable.

  - `:mode-name' - name (a string appeared in the mode-line) of
     the generated `guix-TYPE-mode'.

  - `:mode-init-function' - default value of the generated
    `guix-TYPE-mode-initialize-function' variable.

  - `:reduced?' - if non-nil, generate only group, faces group
    and titles variable (if specified); all keywords become
    optional."
  (declare (indent 2))
  (let* ((entry-type-str     (symbol-name entry-type))
         (buffer-type-str    (symbol-name buffer-type))
         (prefix             (concat "guix-" entry-type-str "-"
                                     buffer-type-str))
         (group              (intern prefix))
         (faces-group        (intern (concat prefix "-faces")))
         (get-entries-var    (intern (concat prefix "-get-function")))
         (show-entries-var   (intern (concat prefix "-show-function")))
         (show-entries-fun   (intern (concat prefix "-show-entries")))
         (message-var        (intern (concat prefix "-message-function")))
         (buffer-name-var    (intern (concat prefix "-buffer-name")))
         (titles-var         (intern (concat prefix "-titles")))
         (history-size-var   (intern (concat prefix "-history-size")))
         (revert-confirm-var (intern (concat prefix "-revert-confirm"))))
    (guix-keyword-args-let args
        ((get-entries-val    :get-entries-function)
         (show-entries-val   :show-entries-function)
         (insert-entries-val :insert-entries-function)
         (mode-name          :mode-name (capitalize prefix))
         (mode-init-val      :mode-init-function)
         (message-val        :message-function)
         (buffer-name-val    :buffer-name)
         (titles-val         :titles)
         (history-size-val   :history-size 20)
         (revert-confirm-val :revert-confirm? t)
         (reduced?           :reduced?))
      `(progn
         (defgroup ,group nil
           ,(format "Displaying '%s' entries in '%s' buffer."
                    entry-type-str buffer-type-str)
           :group ',(intern (concat "guix-" entry-type-str))
           :group ',(intern (concat "guix-" buffer-type-str)))

         (defgroup ,faces-group nil
           ,(format "Faces for displaying '%s' entries in '%s' buffer."
                    entry-type-str buffer-type-str)
           :group ',group
           :group ',(intern (concat "guix-" entry-type-str "-faces"))
           :group ',(intern (concat "guix-" buffer-type-str "-faces")))

         (defcustom ,titles-var ,titles-val
           ,(format "Alist of titles of '%s' parameters."
                    entry-type-str)
           :type '(alist :key-type symbol :value-type string)
           :group ',group)

         ,(unless reduced?
            `(progn
               (defvar ,get-entries-var ,get-entries-val
                 ,(format "\
Function used to receive '%s' entries for '%s' buffer."
                          entry-type-str buffer-type-str))

               (defvar ,show-entries-var
                 ,(or show-entries-val `',show-entries-fun)
                 ,(format "\
Function used to show '%s' entries in '%s' buffer."
                          entry-type-str buffer-type-str))

               (defvar ,message-var ,message-val
                 ,(format "\
Function used to display a message after showing '%s' entries.
If nil, do not display messages."
                          entry-type-str))

               (defcustom ,buffer-name-var ,buffer-name-val
                 ,(format "\
Default name of '%s' buffer for displaying '%s' entries.
May be a string or a function returning a string.  The function
is called with the same arguments as `%S'."
                          buffer-type-str entry-type-str get-entries-var)
                 :type '(choice string function)
                 :group ',group)

               (defcustom ,history-size-var ,history-size-val
                 ,(format "\
Maximum number of items saved in history of `%S' buffer.
If 0, the history is disabled."
                          buffer-name-var)
                 :type 'integer
                 :group ',group)

               (defcustom ,revert-confirm-var ,revert-confirm-val
                 ,(format "\
If non-nil, ask to confirm for reverting `%S' buffer."
                          buffer-name-var)
                 :type 'boolean
                 :group ',group)

               (guix-alist-put!
                '((get-entries    . ,get-entries-var)
                  (show-entries   . ,show-entries-var)
                  (message        . ,message-var)
                  (buffer-name    . ,buffer-name-var)
                  (history-size   . ,history-size-var)
                  (revert-confirm . ,revert-confirm-var))
                'guix-buffer-data ',buffer-type ',entry-type)

               ,(unless show-entries-val
                  `(defun ,show-entries-fun (entries)
                     ,(format "\
Show '%s' ENTRIES in the current '%s' buffer."
                              entry-type-str buffer-type-str)
                     (guix-buffer-show-entries-default
                      entries ',buffer-type ',entry-type)))

               ,(when (or insert-entries-val
                          (null show-entries-val))
                  (let ((insert-entries-var
                         (intern (concat prefix "-insert-function"))))
                    `(progn
                       (defvar ,insert-entries-var ,insert-entries-val
                         ,(format "\
Function used to print '%s' entries in '%s' buffer."
                                  entry-type-str buffer-type-str))

                       (guix-alist-put!
                        ',insert-entries-var 'guix-buffer-data
                        ',buffer-type ',entry-type
                        'insert-entries))))

               ,(when (or mode-name
                          mode-init-val
                          (null show-entries-val))
                  (let* ((mode-str      (concat prefix "-mode"))
                         (mode-map-str  (concat mode-str "-map"))
                         (mode          (intern mode-str))
                         (parent-mode   (intern
                                         (concat "guix-" buffer-type-str
                                                 "-mode")))
                         (mode-var      (intern
                                         (concat mode-str "-function")))
                         (mode-init-var (intern
                                         (concat mode-str
                                                 "-initialize-function"))))
                    `(progn
                       (defvar ,mode-var ',mode
                         ,(format "\
Major mode for displaying '%s' entries in '%s' buffer."
                                  entry-type-str buffer-type-str))

                       (defvar ,mode-init-var ,mode-init-val
                         ,(format "\
Function used to set up '%s' buffer for displaying '%s' entries."
                                  buffer-type-str entry-type-str))

                       (define-derived-mode ,mode ,parent-mode ,mode-name
                         ,(format "\
Major mode for displaying '%s' entries in '%s' buffer.

\\{%s}"
                                  entry-type-str buffer-type-str mode-map-str)
                         (setq-local revert-buffer-function
                                     'guix-buffer-revert)
                         (setq-local guix-history-size
                                     (guix-buffer-history-size
                                      ',buffer-type ',entry-type))
                         (guix-buffer-mode-initialize
                          ',buffer-type ',entry-type))

                       (guix-alist-put!
                        ',mode-var 'guix-buffer-data
                        ',buffer-type ',entry-type 'mode)
                       (guix-alist-put!
                        ',mode-init-var 'guix-buffer-data
                        ',buffer-type ',entry-type
                        'mode-init))))))

         (guix-alist-put!
          ',titles-var 'guix-buffer-data
          ',buffer-type ',entry-type 'titles)))))


(defvar guix-buffer-font-lock-keywords
  (eval-when-compile
    `((,(rx "(" (group (or "guix-buffer-with-item"
                           "guix-buffer-with-current-item"
                           "guix-buffer-define-interface"
                           "guix-define-groups"
                           "guix-define-entry-type"
                           "guix-define-buffer-type"))
            symbol-end)
       . 1))))

(font-lock-add-keywords 'emacs-lisp-mode guix-buffer-font-lock-keywords)

(provide 'guix-buffer)

;;; guix-buffer.el ends here