[bug#68010] [PATCH] home: services: Add home-zathura-service-type.

[lgcoelho--- via Guix-patches via <guix-patches@gnu.org>]

[-- Attachment #1.1: Type: text/plain, Size: 95 bytes --]

This service enables a declarative configuration of zathura, the 
customizable document viewer.

[-- Attachment #1.2: Type: text/html, Size: 281 bytes --]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-home-services-Add-home-zathura-service-type.patch --]
[-- Type: text/x-diff; name=0001-home-services-Add-home-zathura-service-type.patch, Size: 25023 bytes --]

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

diff --git a/gnu/home/services/zathura.scm b/gnu/home/services/zathura.scm
new file mode 100644
index 0000000000..0695ce1614
--- /dev/null
+++ b/gnu/home/services/zathura.scm
@@ -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