From c99fcd279af9086dbd3e8e15458ac6289e2e51e0 Mon Sep 17 00:00:00 2001
From: Luis Guilherme Coelho <lgcoelho@disroot.org>
Date: Sun, 24 Dec 2023 15:16:43 -0300
Subject: [PATCH] home: services: Add home-zathura-service-type
---
gnu/home/services/zathura.scm | 619 ++++++++++++++++++++++++++++++++++
1 file changed, 619 insertions(+)
create mode 100644 gnu/home/services/zathura.scm
new file mode 100644
@@ -0,0 +1,619 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2023 Luis Guilherme Coelho <lgcoelho@disroot.org>
+;;;
+;;; 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu home services zathura)
+ #:use-module (ice-9 match)
+ #:use-module (guix records)
+ #:use-module (gnu home services)
+ #:use-module (gnu services configuration)
+ #:use-module (srfi srfi-1)
+ #:use-module (guix gexp)
+ #:export (face
+ face?
+
+ recolor-configuration
+ recolor-configuration?
+
+ gui-configuration
+ gui-configuration?
+
+ key-map
+ key-map?
+
+ home-zathura-configuration
+ home-zathura-configuration-n-completion-items
+ home-zathura-configuration-completion-face
+ home-zathura-configuration-completion-group-face
+ home-zathura-configuration-completion-highlight-face
+ home-zathura-configuration-default-face
+ home-zathura-configuration-exec-command
+ home-zathura-configuration-font
+ home-zathura-configuration-gui-configuration
+ home-zathura-configuration-inputbar-face
+ home-zathura-configuration-notification-face
+ home-zathura-configuration-notification-error-face
+ home-zathura-configuration-notification-warning-face
+ home-zathura-configuration-statusbar-face
+ home-zathura-configuration-statusbar-h-padding
+ home-zathura-configuration-statusbar-v-padding
+ home-zathura-configuration-window-icon
+ home-zathura-configuration-window-height
+ home-zathura-configuration-window-width
+ home-zathura-configuration-abort-clear-search
+ home-zathura-configuration-adjust-open
+ home-zathura-configuration-advance-pages-per-row
+ home-zathura-configuration-continuous-hist-save
+ home-zathura-configuration-database
+ home-zathura-configuration-dbus-service
+ home-zathura-configuration-dbus-raise-window
+ home-zathura-configuration-filemonitor
+ home-zathura-configuration-incremental-search
+ home-zathura-configuration-highlight-color
+ home-zathura-configuration-highlight-active-color
+ home-zathura-configuration-highlight-transparency
+ home-zathura-configuration-page-padding
+ home-zathura-configuration-page-cache-size
+ home-zathura-configuration-page-thumbnail-size
+ home-zathura-configuration-pages-per-row
+ home-zathura-configuration-first-page-column
+ home-zathura-configuration-recolor
+ home-zathura-configuration-render-loading
+ home-zathura-configuration-render-loading-face
+ home-zathura-configuration-scroll-hstep
+ home-zathura-configuration-scroll-step
+ home-zathura-configuration-scroll-full-overlap
+ home-zathura-configuration-scroll-wrap
+ home-zathura-configuration-show-directories
+ home-zathura-configuration-show-hidden
+ home-zathura-configuration-show-recent
+ home-zathura-configuration-scroll-page-aware
+ home-zathura-configuration-link-zoom
+ home-zathura-configuration-link-hadjust
+ home-zathura-configuration-search-hadjust
+ home-zathura-configuration-window-title-basename
+ home-zathura-configuration-window-title-home-tilde
+ home-zathura-configuration-window-title-page
+ home-zathura-configuration-statusbar-basename
+ home-zathura-configuration-statusbar-page-percent
+ home-zathura-configuration-statusbar-home-tilde
+ home-zathura-configuration-zoom-center
+ home-zathura-configuration-vertical-center
+ home-zathura-configuration-zoom-max
+ home-zathura-configuration-zoom-min
+ home-zathura-configuration-zoom-step
+ home-zathura-configuration-selection-clipboard
+ home-zathura-configuration-selection-notification
+ home-zathura-configuration-synctex
+ home-zathura-configuration-synctex-editor-command
+ home-zathura-configuration-index-face
+ home-zathura-configuration-index-active-face
+ home-zathura-configuration-sandbox
+ home-zathura-configuration-window-icon-document
+ home-zathura-configuration-page-right-to-left
+ home-zathura-configuration-key-maps
+
+ home-zathura-service-type
+ home-zathura-extension))
+
+(define (zathura-mode? value)
+ (->bool (member value '(normal fullscreen presentation index))))
+
+(define-configuration/no-serialization key-map
+ (mode
+ (zathura-mode 'normal)
+ "The mode for which the key-map is being set.")
+ (binding
+ string ; improve this with regex
+ "The key combination that the key-map will use.")
+ (command string
+ "Function and, optionally, arguments separated by spaces."))
+
+(define list-of-key-maps?
+ (list-of key-map?))
+
+(define (serialize-list-of-key-maps field-name value)
+ (define snake-case
+ (@@ (guix import utils) snake-case))
+ (apply string-append
+ (map (match-record-lambda <key-map>
+ (mode binding command)
+ (format #f "~:[un~;~]map [~a] ~a~@[ ~a~]~%"
+ command
+ mode
+ binding
+ (and command
+ (match (string-split command #\ )
+ ((zathura-function . args)
+ (string-join (cons (snake-case zathura-function)
+ args)
+ " "))))))
+ value)))
+
+(define (zathura-selection-clipboard? value)
+ (->bool (member value '(clipboard primary))))
+
+(define (zathura-sandbox? value)
+ (->bool (member value '(normal strict #f))))
+
+(define (serialize-zathura-sandbox field-name value)
+ (format #f "set ~a ~:[none~;~a]~%" field-name value value))
+
+(define (zathura-database? value)
+ (->bool (member value '(plain sqlite #f))))
+
+(define (serialize-zathura-filemonitor field-name value)
+ (format #f "set ~a ~:[noop~;~a]~%" field-name value value))
+
+(define (serialize-zathura-database field-name value)
+ (format #f "set ~a ~:[null~;~a]~%" field-name value value))
+
+(define (zathura-filemonitor? value)
+ (->bool (member value '(glib signal #f))))
+
+(define (serialize-zathura-filemonitor? field-name value)
+ (format #f "set ~a ~:[noop~;~a]~%" field-name value value))
+
+(define (zathura-adjust-open? value)
+ (->bool (member value '(best-fit width))))
+
+(define-configuration/no-serialization gui-configuration
+ (command-line?
+ (boolean #f)
+ "Whether the zathura command line should be displayed or not.")
+ (statusbar?
+ (boolean #t)
+ "Whether the zathura statusbar should be displayed or not.")
+ (horizontal-scrollbar?
+ (boolean #f)
+ "Wheter the zathura horizontal scrollbar should be displayed.")
+ (vertical-scrollbar?
+ (boolean #f)
+ "Wheter the zathura vertical scrollbar should be displayed."))
+
+(define (serialize-gui-configuration field-name value)
+ (match-record value <gui-configuration>
+ (command-line? statusbar? horizontal-scrollbar? vertical-scrollbar?)
+ (format #f "set guioptions ~@[c~]~@[s~]~@[h~]~@[v~]~%"
+ command-line?
+ statusbar?
+ horizontal-scrollbar?
+ vertical-scrollbar?)))
+
+(define (hex-color? value)
+ (define (hex-digit? value)
+ (->bool (and (char? value)
+ (member value (char-set->list
+ char-set:hex-digit)))))
+ (match (string->list value)
+ ((\# . rest)
+ (null? (filter (negate hex-digit?) rest)))
+ (else #f)))
+
+(define-maybe hex-color)
+
+(define-configuration/no-serialization face
+ (foreground
+ maybe-hex-color
+ "Foreground color.")
+ (background
+ maybe-hex-color
+ "Background color."))
+
+(define (unset? val)
+ "Tests if VAL is unset."
+ (equal? val (@@ (gnu services configuration)
+ %unset-value)))
+
+(define* (if-set val #:optional (proc identity))
+ "Apply PROC to VAL if VAL is not unset, otherwise returns #f."
+ (if (not (unset? val)) (proc val) #f))
+
+(define (serialize-face field-name value)
+ (let ((str (string-drop-right (symbol->string field-name) 5)))
+ (match-record value <face>
+ (background foreground)
+ (format #f "~:[~;set ~a-fg \"~a\"~%~]~
+ ~:[~;set ~a-bg \"~a\"~%~]"
+ (if-set foreground) str foreground
+ (if-set background) str background))))
+
+(define-configuration/no-serialization recolor-configuration
+ (default?
+ (boolean #f)
+ "Whether recoloring should be enabled by default.")
+ (keephue?
+ (boolean #f)
+ "Enables or disables keeping original hue when recoloring.")
+ (darkcolor
+ (hex-color "#FFFFFF")
+ "Defines the color value that is used to represent dark colors in recoloring
+mode.")
+ (lightcolor
+ (hex-color "#000000")
+ "Defines the color value that is used to represent light colors in recoloring
+mode.")
+ (reverse-video?
+ (boolean #f)
+ "Defines if original image colors should be kept while recoloring."))
+
+(define (serialize-recolor-configuration field-name value)
+ (match-record value <recolor-configuration>
+ (default? keephue? darkcolor lightcolor reverse-video?)
+ (format #f "set recolor ~:[false~;true~]~%~
+ set recolor-keephue ~:[false~;true~]~%~
+ set recolor-darkcolor ~a~%~
+ set recolor-lightcolor ~a~%~
+ set recolor-reverse-video ~:[false~;true~]~%"
+ default?
+ keephue?
+ darkcolor
+ lightcolor
+ reverse-video?)))
+
+(define (serialize-boolean field-name value)
+ (define (strip-trailing-? name)
+ ;; field? -> field
+ (let ((str (symbol->string name)))
+ (if (string-suffix? "?" str)
+ (string-drop-right str 1)
+ str)))
+ (format #f "set ~a ~:[false~;true~]~%"
+ (strip-trailing-? field-name)
+ value))
+
+(define (serialize-string field-name value)
+ (format #f "set ~a \"~a\"~%" field-name value))
+
+(define (serialize-* field-name value)
+ (format #f "set ~a ~a~%" field-name value))
+(define serialize-exact-integer serialize-*)
+(define serialize-real serialize-*)
+(define serialize-zathura-adjust-open serialize-*)
+(define serialize-zathura-selection-clipboard serialize-*)
+
+(define-maybe string)
+
+(define-configuration home-zathura-configuration
+ (n-completion-items
+ (exact-integer 15)
+ "Defines the maximum number of displayed completion entries.")
+ (completion-face
+ (face (face
+ (background "#232323")
+ (foreground "#DDDDDD")))
+ "Defines the face used for command line completion entries.")
+ (completion-group-face
+ (face (face
+ (background "#000000")
+ (foreground "#DEDEDE")))
+ "Defines the face used for command line completion group elements.")
+ (completion-highlight-face
+ (face (face
+ (background "#9FBC00")
+ (foreground "#232323")))
+ "Defines the face used for the current command line completion element.")
+ (default-face
+ (face (face
+ (background "#000000")
+ (foreground "#DDDDDD")))
+ "Defines the default face.")
+ (exec-command
+ maybe-string
+ "Defines a command the should be prepended to any command run with exec.")
+ (font
+ (string "monospace normal 9")
+ "Defines the font that will be used.")
+ (gui-configuration
+ (gui-configuration (gui-configuration))
+ "Whether the command line should be displayed or not.")
+ (inputbar-face
+ (face (face
+ (background "#131313")
+ (foreground "#9FBC00")))
+ "Defines the face used for the inputbar.")
+ (notification-face
+ (face (face
+ (background "#FFFFFF")
+ (foreground "#000000")))
+ "Defines the face used for notifications.")
+ (notification-error-face
+ (face (face
+ (background "#FF1212")
+ (foreground "#000000")))
+ "Defines the face used for error notifications.")
+ (notification-warning-face
+ (face (face
+ (background "#FFF712")
+ (foreground "#000000")))
+ "Defines the face used for a warning notification.")
+ (statusbar-face
+ (face (face
+ (background "#000000")
+ (foreground "#FFFFFF")))
+ "Defines the face used for the statusbar.")
+ (statusbar-h-padding
+ (exact-integer 8)
+ "Defines the horizontal padding of the statusbar and notificationbar.")
+ (statusbar-v-padding
+ (exact-integer 2)
+ "Defines the vertical padding of the statusbar and notificationbar.")
+ (window-icon
+ maybe-string
+ "Defines the path for a icon to be used as window icon.")
+ (window-height
+ (exact-integer 600)
+ "Defines the window height on startup.")
+ (window-width
+ (exact-integer 800)
+ "Defines the window width on startup.")
+ (abort-clear-search?
+ (boolean #t)
+ "Defines if the search results should be cleared on abort.")
+ (adjust-open
+ (zathura-adjust-open 'best-fit)
+ "Defines which auto adjustment mode should be used if a document is
+loaded. Possible options are 'best-fit and 'width.")
+ (advance-pages-per-row?
+ (boolean #f)
+ "Defines if the number of pages per row should be honored when advancing a
+page.")
+ (continuous-hist-save?
+ (boolean #f)
+ "Tells zathura whether to save document history at each page change or only
+when closing a document.")
+ (database
+ (zathura-database 'plain)
+ "Defines the database backend to use for bookmarks and input history.
+Possible values are 'plain, 'sqlite (if built with sqlite support) and #f.
+If #f is used, bookmarks and input history will not be stored.")
+ (dbus-service?
+ (boolean #t)
+ "En/Disables the D-Bus service. If the services is disabled, SyncTeX forward
+synchronization is not available.")
+ (dbus-raise-window?
+ (boolean #t)
+ "Defines whether zathura's window should be raised when receiving certain
+commands via D-Bus.")
+ (filemonitor
+ (zathura-filemonitor 'glib)
+ "Defines the file monitor backend used to check for changes in files.
+Possible values are 'glib, 'signal (if signal handling is supported), and #f.
+When set to #f, file monitor does not trigger reloads.")
+ (incremental-search?
+ (boolean #t)
+ "En/Disables incremental search (search while typing).")
+ (highlight-color
+ (string "#9FBC00")
+ "Defines the color that is used for highlighting parts of the document
+(e.g.: show search results).")
+ (highlight-fg
+ (string "#9FBC00")
+ "Defines the color that is used for text when highlighting parts of the
+document (e.g.: number for links).")
+ (highlight-active-color
+ (string "#00BC00")
+ "Defines the color that is used to show the current selected highlighted
+element (e.g: current search result).")
+ (highlight-transparency
+ (real 0.5)
+ "Defines the opacity of a highlighted element.")
+ (page-padding
+ (exact-integer 1)
+ "The page padding defines the gap in pixels between each rendered page.")
+ (page-cache-size
+ (exact-integer 15)
+ "Defines the maximum number of pages that could be kept in the page cache.
+When the cache is full and a new page that isn't cached becomes visible, the
+least recently viewed page in the cache will be evicted to make room for
+the new one. Large values for this variable are NOT recommended, because this
+will lead to consuming a significant portion of the system memory.")
+ (page-thumbnail-size
+ (exact-integer 4194304)
+ "Defines the maximum size in pixels of the thumbnail that could be kept in
+the thumbnail cache per page. The thumbnail is scaled for a quick preview during
+zooming before the page is rendered. When the page is rendered, the result is
+saved as the thumbnail only if the size is no more than this value. A larger
+value increases quality but introduces longer delay in zooming and uses more
+system memory.")
+ (pages-per-row
+ (exact-integer 1)
+ "Defines the number of pages that are rendered next to each other in a row.")
+ (first-page-column
+ (string "1:2")
+ "Defines the column in which the first page will be displayed. This setting
+is stored separately for every value of pages-per-row according to the following
+pattern <1 page per row>:[<2 pages per row>[: ...]]. The last value in the
+list will be used for all other number of pages per row if not set explicitly.
+Per default, the first column is set to 2 for double-page layout, i.e. the
+value is set to 1:2. A value of 1:1:3 would put the first page in dual-page
+layout in the first column, and for layouts with more columns the first page
+would be put in the 3rd column.")
+ (recolor
+ (recolor-configuration (recolor-configuration))
+ "Configuration used for recoloring. Disabled when no value is supplied.")
+ (render-loading?
+ (boolean #t)
+ "Defines if the \"Loading...\" text should be displayed if a page is rendered.")
+ (render-loading-face
+ (face (face
+ (background "#FFFFFF")
+ (foreground "#000000")))
+ "Defines the face used for the \"Loading...\" text.")
+ (scroll-hstep
+ (real -1.0)
+ "Defines the horizontal step size of scrolling by calling the scroll command
+once.")
+ (scroll-step
+ (real 40)
+ "Defines the step size of scrolling by calling the scroll command once.")
+ (scroll-full-overlap
+ (real 0)
+ "Defines the proportion of the current viewing area that should be visible
+after scrolling a full page.")
+ (scroll-wrap?
+ (boolean #f)
+ "Defines if the last/first page should be wrapped.")
+ (show-directories?
+ (boolean #t)
+ "Defines if the directories should be displayed in completion.")
+ (show-hidden?
+ (boolean #f)
+ "Defines if hidden files and directories should be displayed in completion.")
+ (show-recent
+ (exact-integer 10)
+ "Defines the number of recent files that should be displayed in completion.
+If the value is negative, no upper bounds are applied. If the value is 0, no
+recent files are shown.")
+ (scroll-page-aware?
+ (boolean #f)
+ "Defines if scrolling by half or full pages stops at page boundaries.")
+ (link-zoom?
+ (boolean #t)
+ "En/Disables the ability of changing zoom when following links.")
+ (link-hadjust?
+ (boolean #t)
+ "En/Disables aligning to the left internal link targets, for example from the
+index.")
+ (search-hadjust?
+ (boolean #t)
+ "En/Disables horizontally centered search results.")
+ (window-title-basename?
+ (boolean #f)
+ "Use basename of the file in the window title.")
+ (window-title-home-tilde?
+ (boolean #f)
+ "Display a short version of the file path, which replaces $HOME with ~, in
+the window title.")
+ (window-title-page?
+ (boolean #f)
+ "Display the page number in the window title.")
+ (statusbar-basename?
+ (boolean #f)
+ "Use basename of the file in the statusbar.")
+ (statusbar-page-percent?
+ (boolean #f)
+ "Display (current page / total pages) as a percent in the statusbar.")
+ (statusbar-home-tilde?
+ (boolean #f)
+ "Display a short version of the file path, which replaces $HOME with ~, in
+the statusbar.")
+ (zoom-center?
+ (boolean #f)
+ "En/Disables horizontally centered zooming.")
+ (vertical-center?
+ (boolean #f)
+ "Center the screen at the vertical midpoint of the page by default.")
+ (zoom-max
+ (exact-integer 1000)
+ "Defines the maximum percentage that the zoom level can be.")
+ (zoom-min
+ (exact-integer 10)
+ "Defines the minimum percentage that the zoom level can be.")
+ (zoom-step
+ (exact-integer 10)
+ "Defines the amount of percent that is zoomed in or out on each command.")
+ (selection-clipboard
+ (zathura-selection-clipboard 'primary)
+ "Defines the X clipboard into which mouse-selected data will be written.
+When it is 'clipboard, selected data will be written to the CLIPBOARD clipboard,
+and can be pasted using the Ctrl+v key combination. When it is 'primary, se‐
+lected data will be written to the PRIMARY clipboard, and can be pasted using
+the middle mouse button, or the Shift-Insert key combination.")
+ (selection-notification?
+ (boolean #t)
+ "Defines if a notification should be displayed after selecting text.")
+ (synctex
+ (boolean #t)
+ "En/Disables SyncTeX backward synchronization support.")
+ (synctex-editor-command
+ maybe-string
+ "Defines the command executed for SyncTeX backward synchronization.")
+ (index-face
+ (face (face
+ (background "#232323")
+ (foreground "#DDDDDD")))
+ "Defines the face used for the index mode.")
+ (index-active-face
+ (face (face
+ (background "#9FBC00")
+ (foreground "#232323")))
+ "Defines the face used for selected elements in index mode.")
+ (sandbox
+ (zathura-sandbox 'normal)
+ "Defines the sandbox mode to use for the seccomp syscall filter. Possible
+values are 'none, 'normal and 'strict. If 'none is used, the sandbox will be
+disabled. The use of 'normal will provide minimal protection and allow normal
+use of zathura with support for all features. The 'strict mode is a read only
+sandbox that is intended for viewing documents only.
+Some features are disabled when using strict sandbox mode:
+@table @code
+ @item saving/writing files
+ @item use of input methods like ibus
+ @item printing
+ @item bookmarks and history
+@end table
+The strict sandbox mode is still experimental with some libc implementations.
+Currently supported and tested libc implementations: glibc
+No feature regressions are expected when using normal sandbox mode.
+When running under WSL, the default is 'none since seccomp is not supported
+in that environment.")
+ (window-icon-document?
+ (boolean #f)
+ "Defines whether the window document should be updated based on the first
+page of a document.")
+ (page-right-to-left?
+ (boolean #f)
+ "Defines whether pages in multi-column view should start from the right side.")
+ (key-maps
+ (list-of-key-maps '())
+ "Defines the list of key-maps for zathura. When shortcut-function is #f the
+key-map is unset."))
+
+(define (zathura-xdg-configuration-file-service configuration)
+ `(("zathura/zathurarc"
+ ,(mixed-text-file "zathurarc"
+ (serialize-configuration configuration
+ home-zathura-configuration-fields)))))
+
+
+(define-configuration/no-serialization home-zathura-extension
+ (key-maps
+ (list-of-key-maps '())
+ "List of key-map objects for extending the zathura configuration file."))
+
+(define (home-zathura-extensions original-config extension-configs)
+ (home-zathura-configuration
+ (inherit original-config)
+ (key-maps (append (home-zathura-configuration-key-maps original-config)
+ (append-map home-zathura-extension-key-maps
+ extension-configs)))))
+
+(define home-zathura-service-type
+ (service-type
+ (name 'zathura-service)
+ (extensions
+ (list (service-extension
+ home-xdg-configuration-files-service-type
+ zathura-xdg-configuration-file-service)))
+ (compose identity)
+ (extend home-zathura-extensions)
+ (default-value (home-zathura-configuration))
+ (description "Set ~/.config/zathura.conf")))
+
+(define (generate-doc)
+ (configuration->documentation 'home-zathura-configuration))
--
2.41.0