;; tinmop: an humble gemini and pleroma client
;; Copyright © cage

;; This program 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.

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

(in-package :client-configuration)

;; see src/software-configuration for the grammar

(defparameter *client-configuration* ())

(a:define-constant +client-conf-filename+ "gui.conf" :test #'string=)

(swconf::gen-key-constants text
                           font
                           size
                           weight
                           slant
                           underline
                           preformatted-text
                           justification
                           keybinding
                           quit
                           stream
                           certificates
                           tour
                           type-address
                           next
                           shuffle
                           manage
                           up
                           bookmark
                           toggle
                           show
                           select
                           emphasize
                           wrapped
                           asterisk
                           autoresize
                           gemtext
                           scaling
                           increase
                           decrease
                           reset)

(defun load-config-file (&optional (virtual-filepath +client-conf-filename+)
                           (perform-missing-value-check nil))
  (let* ((file (res:get-config-file virtual-filepath))
         (tree (swconf:parse-config (fs:namestring->pathname file))))
    (loop for entry in tree do
      (let ((key   (first  entry))
            (value (second entry)))
        (cond
          ((keywordp key)
           (setf (access:accesses *client-configuration* key) value))
          (t
           (multiple-value-bind (rest all)
               (apply #'access:set-accesses value *client-configuration* key)
             (declare (ignore rest))
             (setf *client-configuration* all))))))
    (when perform-missing-value-check
      (swconf:perform-missing-value-check file))
    (if *client-configuration*
        (values *client-configuration* file)
        (error (format nil (_ "fatal error: The file ~a is empty") file)))))

;;;; end of parser

(defun gemini-default-favicon ()
  (swconf:access-non-null-conf-value *client-configuration*
                                     swconf:+key-gemini+
                                     swconf:+key-favicon+))

(defun gemini-window-colors ()
  (values (gui-goodies:parse-color (access:accesses *client-configuration*
                                                    swconf:+key-gemini+
                                                    swconf:+key-main-window+
                                                    swconf:+key-background+))
          (gui-goodies:parse-color (access:accesses *client-configuration*
                                                    swconf:+key-gemini+
                                                    swconf:+key-main-window+
                                                    swconf:+key-foreground+))))

(defun font-configuration (key)
  (gui-goodies:make-font (access:accesses *client-configuration*
                                          swconf:+key-gemini+
                                          key
                                          +key-font+)
                         (access:accesses *client-configuration*
                                          swconf:+key-gemini+
                                          key
                                          +key-size+)
                         (access:accesses *client-configuration*
                                          swconf:+key-gemini+
                                          key
                                          +key-weight+)
                         (access:accesses *client-configuration*
                                          swconf:+key-gemini+
                                          key
                                          +key-slant+)
                         (not (swconf:false-value-p (access:accesses *client-configuration*
                                                                     swconf:+key-gemini+
                                                                     key
                                                                     +key-underline+)))))

(defmacro gen-font-configuration (key)
  (let* ((no-key  (cl-ppcre:regex-replace-all "key-" (string-downcase (symbol-name key)) ""))
         (no-plus (text-utils:trim-blanks no-key '(#\+))))
    `(defun ,(misc:format-fn-symbol t "gemini-~a-font-configuration" no-plus) ()
       (font-configuration ,key))))

(defun gemini-text-font-configuration ()
  (format t "key ~a~%"
          (access:accesses *client-configuration*
                           swconf:+key-gemini+
                           swconf:+key-main-window+
                           +key-text+
                           +key-font+))
  (gui-goodies:make-font (access:accesses *client-configuration*
                                          swconf:+key-gemini+
                                          swconf:+key-main-window+
                                          +key-text+
                                          +key-font+)
                         (access:accesses *client-configuration*
                                          swconf:+key-gemini+
                                          swconf:+key-main-window+
                                          +key-text+
                                          +key-size+)
                         (access:accesses *client-configuration*
                                          swconf:+key-gemini+
                                          swconf:+key-main-window+
                                          +key-text+
                                          +key-weight+)
                         (access:accesses *client-configuration*
                                          swconf:+key-gemini+
                                          swconf:+key-main-window+
                                          +key-text+
                                          +key-slant+)
                         (not (swconf:false-value-p (access:accesses *client-configuration*
                                                                     swconf:+key-gemini+
                                                                     swconf:+key-main-window+
                                                                     +key-text+
                                                                     +key-underline+)))))

(defun font-text-bold ()
  (gui-goodies:make-font (access:accesses *client-configuration*
                                          swconf:+key-gemini+
                                          +key-text+
                                          +key-font+)
                         (access:accesses *client-configuration*
                                          swconf:+key-gemini+
                                          +key-text+
                                          +key-size+)
                         "bold"
                         nil
                         nil))

(defun font-text-italic ()
  (gui-goodies:make-font (access:accesses *client-configuration*
                                          swconf:+key-gemini+
                                          +key-text+
                                          +key-font+)
                         (access:accesses *client-configuration*
                                          swconf:+key-gemini+
                                          +key-text+
                                          +key-size+)
                         nil
                         "italic"
                         nil))

(defun font-text-underlined ()
  (gui-goodies:make-font (access:accesses *client-configuration*
                                          swconf:+key-gemini+
                                          +key-text+
                                          +key-font+)
                         (access:accesses *client-configuration*
                                          swconf:+key-gemini+
                                          +key-text+
                                          +key-size+)
                         nil
                         nil
                         t))

(gen-font-configuration swconf:+key-link+)

(gen-font-configuration swconf:+key-quote+)

(gen-font-configuration swconf:+key-h1+)

(gen-font-configuration swconf:+key-h2+)

(gen-font-configuration swconf:+key-h3+)

(gen-font-configuration swconf:+key-preformatted-text+)

(defun conf-colors (key)
  (values (gui-goodies:parse-color (access:accesses *client-configuration*
                                                    swconf:+key-gemini+
                                                    key
                                                    swconf:+key-background+))
          (gui-goodies:parse-color (access:accesses *client-configuration*
                                                    swconf:+key-gemini+
                                                    key
                                                    swconf:+key-foreground+))))

(defmacro gen-conf-color (prefix key)
  (let* ((no-key  (cl-ppcre:regex-replace-all "key-" (string-downcase (symbol-name key)) ""))
         (no-plus (text-utils:trim-blanks no-key '(#\+))))
    `(defun ,(misc:format-fn-symbol t "~a-~a-colors" prefix no-plus) ()
       (conf-colors ,key))))

(gen-conf-color gemini swconf:+key-link+)

(gen-conf-color gemini swconf:+key-quote+)

(gen-conf-color gemini swconf:+key-h1+)

(gen-conf-color gemini swconf:+key-h2+)

(gen-conf-color gemini swconf:+key-h3+)

(gen-conf-color gemini swconf:+key-preformatted-text+)

(defun gemini-link-prefix (scheme)
  (swconf:access-non-null-conf-value *client-configuration*
                                     swconf:+key-gemini+
                                     swconf:+key-link+
                                     swconf:+key-scheme+
                                     scheme
                                     swconf:+key-prefix+))

(defun gemini-link-prefix-to-gemini ()
  (gemini-link-prefix swconf:+key-gemini+))

(defun gemini-link-prefix-to-other ()
  (gemini-link-prefix swconf:+key-other+))

(defun gemini-link-prefix-to-http ()
  (gemini-link-prefix swconf:+key-http+))

(defun gemini-quote-prefix ()
  (swconf:access-non-null-conf-value *client-configuration*
                                     swconf:+key-gemini+
                                     swconf:+key-quote+
                                     swconf:+key-prefix+))

(defun gemini-h*-prefix (level)
  (swconf:access-non-null-conf-value *client-configuration*
                                     swconf:+key-gemini+
                                     level
                                     swconf:+key-prefix+))

(defun gemini-h1-prefix ()
  (gemini-h*-prefix swconf:+key-h1+))

(defun gemini-h2-prefix ()
  (gemini-h*-prefix swconf:+key-h2+))

(defun gemini-h3-prefix ()
  (gemini-h*-prefix swconf:+key-h3+))

(defun gemini-bullet-prefix ()
  (swconf:access-non-null-conf-value *client-configuration*
                                     swconf:+key-gemini+
                                     swconf:+key-bullet+
                                     swconf:+key-prefix+))

(defun conf-justification (key)
  (let ((conf-value (access:accesses *client-configuration*
                                     swconf:+key-gemini+
                                     key
                                     +key-justification+)))
    (or conf-value
        :left)))

(defmacro gen-conf-justification (prefix key)
  (let* ((no-key  (cl-ppcre:regex-replace-all "key-" (string-downcase (symbol-name key)) ""))
         (no-plus (text-utils:trim-blanks no-key '(#\+))))
    `(defun ,(misc:format-fn-symbol t "~a-~a-justification" prefix no-plus) ()
       (conf-justification ,key))))

(gen-conf-justification gemini swconf:+key-link+)

(gen-conf-justification gemini swconf:+key-quote+)

(gen-conf-justification gemini swconf:+key-h1+)

(gen-conf-justification gemini swconf:+key-h2+)

(gen-conf-justification gemini swconf:+key-h3+)

(gen-conf-justification gemini swconf:+key-preformatted-text+)

(swconf:gen-simple-access (toc-maximum-width
                           :transform-value-fn (lambda (a)
                                                 (truncate (or (num-utils:safe-parse-number a)
                                                               20)))
                           :configuration-tree *client-configuration*)
                          swconf:+key-toc+
                          swconf:+key-maximum+
                          swconf:+key-width+)

(swconf:gen-simple-access (toc-minimum-width
                           :transform-value-fn (lambda (a)
                                                 (truncate (or (num-utils:safe-parse-number a)
                                                               80)))
                           :configuration-tree *client-configuration*)
                          swconf:+key-toc+
                          swconf:+key-minimum+
                          swconf:+key-width+)

(swconf:gen-simple-access (toc-autoresize-p
                           :transform-value-fn (lambda (a) (not (swconf:false-value-p a)))
                           :configuration-tree *client-configuration*)
                          swconf:+key-toc+
                          +key-autoresize+)

(swconf:gen-simple-access (gemtext-padding
                           :transform-value-fn (lambda (a) (parse-integer a))
                           :configuration-tree *client-configuration*)
                          swconf:+key-gemini+
                          swconf:+key-main-window+
                          +key-text+
                          swconf:+key-padding+)

(defun toc-font-configuration ()
  (gui-goodies:make-font (access:accesses *client-configuration*
                                          swconf:+key-toc+
                                          +key-font+)
                         (access:accesses *client-configuration*
                                          swconf:+key-toc+
                                          +key-size+)
                         (access:accesses *client-configuration*
                                          swconf:+key-toc+
                                          +key-weight+)
                         (access:accesses *client-configuration*
                                          swconf:+key-toc+
                                          +key-slant+)
                         (not (swconf:false-value-p (access:accesses *client-configuration*
                                                                     swconf:+key-toc+
                                                                     +key-underline+)))))

(defun keybinding->tk-event (keys)
  (nodgui.event-parser:parse-event (strcat "<" keys ">")))

(defun get-keybinding (key)
  (keybinding->tk-event (access:accesses *client-configuration*
                                         +key-keybinding+
                                         key)))

(swconf:gen-simple-access (keybinding-tour-next
                           :transform-value-fn keybinding->tk-event
                           :configuration-tree *client-configuration*)
                          +key-keybinding+
                          +key-tour+
                          +key-next+)

(swconf:gen-simple-access (keybinding-tour-shuffle
                           :transform-value-fn keybinding->tk-event
                           :configuration-tree *client-configuration*)
                          +key-keybinding+
                          +key-tour+
                          +key-shuffle+)

(swconf:gen-simple-access (keybinding-tour-manage
                           :transform-value-fn keybinding->tk-event
                           :configuration-tree *client-configuration*)
                          +key-keybinding+
                          +key-tour+
                          +key-manage+)

(swconf:gen-simple-access (keybinding-bookmark-toggle
                           :transform-value-fn (lambda (a) (keybinding->tk-event a))
                           :configuration-tree *client-configuration*)
                          +key-keybinding+
                          +key-bookmark+
                          +key-toggle+)

(swconf:gen-simple-access (keybinding-bookmark-show
                           :transform-value-fn (lambda (a) (keybinding->tk-event a))
                           :configuration-tree *client-configuration*)
                          +key-keybinding+
                          +key-bookmark+
                          +key-show+)

(swconf:gen-simple-access (keybinding-gemtext-scaling-increase
                           :transform-value-fn (lambda (a) (keybinding->tk-event a))
                           :configuration-tree *client-configuration*)
                          +key-keybinding+
                          +key-gemtext+
                          +key-scaling+
                          +key-increase+)

(swconf:gen-simple-access (keybinding-gemtext-scaling-decrease
                           :transform-value-fn (lambda (a) (keybinding->tk-event a))
                           :configuration-tree *client-configuration*)
                          +key-keybinding+
                          +key-gemtext+
                          +key-scaling+
                          +key-decrease+)

(swconf:gen-simple-access (keybinding-gemtext-scaling-reset
                           :transform-value-fn (lambda (a) (keybinding->tk-event a))
                           :configuration-tree *client-configuration*)
                          +key-keybinding+
                          +key-gemtext+
                          +key-scaling+
                          +key-reset+)

(defun main-window-select-colors ()
  (values (gui-goodies:parse-color (access:accesses *client-configuration*
                                                    swconf:+key-gemini+
                                                    swconf:+key-main-window+
                                                    +key-select+
                                                    swconf:+key-background+))
          (gui-goodies:parse-color (access:accesses *client-configuration*
                                                    swconf:+key-gemini+
                                                    swconf:+key-main-window+
                                                    +key-select+
                                                    swconf:+key-foreground+))))

(defun emphasize-wrapped-asterisk-p ()
  (let ((value (access:accesses *client-configuration*
                                +key-emphasize+
                                +key-wrapped+
                                +key-asterisk+)))
    (not (swconf:false-value-p value))))