;;; daselt-stump.el --- Generator for StumpWM configs from daselt bindlists  -*- lexical-binding: t; -*-

;; Copyright (C) 2025  Alexander Prähauser

;; Author: Alexander Prähauser <ahprae@protonmail.com>
;; Keywords: tools, external
;; URL: https://gitlab.com/nameiwillforget/d-emacs/-/tree/master/daselt-stump

;; This file is part of Daselt.

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

;;; Commentary:

;; daselt-stump an Emacs package designed to streamline the integration
;; between Emacs and the StumpWM window manager. It automates the generation of
;; StumpWM configuration files based on daselt-bindlists, allowing users
;; to define and manage keybindings, modules, and custom settings within Emacs,
;; and provides a standard-configuration in the `stump-configs'-directory.

;; Key Features:
;; - **Automatic Configuration Generation**: Transforms daselt-bind-bindlists
;;   into StumpWM-compatible initialization files.

;; - **Modular Support**: Includes configurations of modules such as binwarp,
;;   spatial-groups, swm-emacs, winner-mode, clipboard-history, and more, which
;;   can be selectively enabled or disabled.

;; - **Customizable Options**: Users can specify the initialization directory,
;;   keymaps to include, and toggle the use of contrib functions.

;; - **Advanced Key Remapping**: Provides mechanisms to define exceptional key
;;   bindings and manage complex key remapping scenarios based on specific modes
;;   or conditions.

;; - **Extensible Architecture**: Easily accommodates additional modules and
;;   custom keybinding configurations through pkg-config files.

;; By leveraging daselt-stump.el, users can maintain a consistent and efficient
;; workflow between Emacs and StumpWM, ensuring that their window management
;; configurations are both powerful and easy to manage from within their Emacs
;; environment.

;; Usage:
;; The main function is `daselt-stump-generate-init'. Its output can be
;; configured using d-stumps `stump-configs'-directory and the options in the
;; group `daselt-stump'.

;;; Code:
;;;; Preamble
;; (declare-function daselt-base-flatten-until "daselt-base" (lst cnd))
;; (declare-function daselt-bind-p "daselt-bind" (cns))
;; (declare-function daselt-xkb--format-special-key "daselt-xkb" (str))
;; (declare-function daselt-base-powerlist "daselt-base" (list &optional elt))
;; (declare-function daselt-bind-string "daselt-bind" (binding &optional translate csectoshft doublebind))
;; (declare-function daselt-bind-head "daselt-bind" (list))
;; (declare-function daselt-base-read-region "daselt-base" (&optional properties))
;; (declare-function daselt-dirs-act-on-sexps-in-file "nil" (filepath function &optional untangle))
;; (declare-function daselt-dirs--act-on-pkg-files-by-type-and-maybe-kill "nil" (funtypes &optional dir customt))
;; (declare-function daselt-dirs-act-on-pkg-files-by-type-and-maybe-kill "daselt-dirs" (funtypes &optional dir customt))
;; (declare-function daselt-base-remove-surrounding-brackets "daselt-base" (str))
;; (declare-function daselt-dirs-create-pkg-customization-options-by-variable "daselt-dirs" (&optional dirvar pfx))

;; (defvar daselt-xkb-special-key-names)

;; Automatically generated by functions
(defvar daselt-stump-binwarp)
(defvar daselt-stump-iresize)
(defvar daselt-stump-binwarp)
(defvar daselt-xkb-layouts)

(defvar daselt-emacs-dir)
(require 'daselt-coords)
(require 'daselt-xkb)
(require 'daselt-bind)
(require 'daselt-dirs)

;;;; Constants
(defconst daselt-stump-modules
  '("binwarp" "spatial-groups" "swm-emacs" "winner-mode" "clipboard-history" "pamixer" "screenshot-maim" "acpi-backlight" "notifications")
  "Modules for which daselt-stump-configurations exist.")

;;;; Customs
(defcustom daselt-stump-init-directory
  "~/.stumpwm.d/d-stump/"
  "Directory where the configs generated by daselt-stump shouLd be placed in."
  :type 'directory
  :group 'daselt-stump)

(defcustom daselt-stump-keymaps
  '(*emacs-map* *run-app-map* *quit-map*)
  "List of maps that should be defined in the daselt-stump-init."
  :type '(repeat symbol)
  :group 'daselt-stump)

(defcustom daselt-stump-contrib
        t
        "Toggle if you want to use daselt-stump's contrib-functions."
        :type 'boolean
        :group 'daselt-stump)


(defcustom daselt-stump-remap-exceptions-alist
  '(nil)
  "List of cons cells defining exceptions for key remapping in StumpWM modes.

Each cons cell consists of a string representing a directory name in
`stump-configs' \(without its path\) and a symbol representing a
mode for which key remappings should be suspended.

If this option is set to (nil), then it is re-set by
`daselt-stump-set-remap-exceptions-alist' in `daselt-stump-initialize'."
  :type '(repeat (alist :key-type string :value-type symbol))
  :group 'daselt-stump)


;;;;; Set-configs directory
(defun daselt-stump--pkg-configs-directory-test (dir)
  "Test whether DIR looks like daselt-stump's pkg-configs-directory."
  (declare (ftype (function (str) boolean))
           (side-effect-free t))
  (and dir
       (file-exists-p dir)
       (file-exists-p (concat dir "stumpwm"))))

(defcustom daselt-stump-pkg-configs-directory
  (if (bound-and-true-p daselt-emacs-dir)
      (concat daselt-emacs-dir "stump-configs/"))
  "Pkg-configs directory for `daselt-stump'.

This is the directory all `dbl' and `dcn' files for the daselt-stump-config
should be in."
  :type 'directory
  :group 'daselt-stump)

(defun daselt-stump--pkg-configs-directory-enter-manually ()
  "Specify manually where the pkg-configs-directory is."
  (declare (ftype (function () string)))
  (let* ((use-file-dialog nil) ; Dialog box doesn't let you select folder (or I was doing something wrong).
         (filename (read-file-name "Please point daselt-stump to its pkg-configs directory (it's called stump-configs and in the daselt-root directory, include trailing backslash): "
                                   nil nil
                                   #'daselt-stump--pkg-configs-directory-test)))
    (customize-save-variable 'daselt-stump-pkg-configs-directory
                             filename)
    filename))

(defun daselt-stump--find-pkg-configs-directory ()
  "Find daselt-stump's pkg-configs-directory.

Set the corresponding option so it's saved for future sessions.

If the option already points to something that looks like the right directory,
don't do anything."
  (declare (ftype (function () string)))
  (unless (daselt-stump--pkg-configs-directory-test daselt-stump-pkg-configs-directory)
    (condition-case nil (let ((current-pkg-dir
                               (concat daselt-emacs-dir "stump-configs/")))
                          (if (daselt-stump--pkg-configs-directory-test current-pkg-dir)
                              (customize-set-variable 'daselt-stump-pkg-configs-directory
                                                      current-pkg-dir)
                            (daselt-stump--pkg-configs-directory-enter-manually)))
      (error (daselt-stump--pkg-configs-directory-enter-manually)))))

;;;; Functions
;;;;; Initial Customization
(defun daselt-stump-initialize ()
  "Initialize daselt-stump.

Set daselt-stump's pkg-configs directory, create customization options, set
remap exceptions and present the options to the user."
  (declare (ftype (function () t)))
  (daselt-stump--find-pkg-configs-directory)

  (daselt-dirs-create-pkg-customization-options-function
   daselt-stump-pkg-configs-directory 'daselt-stump
   (lambda (pkg)
     (if (string= (symbol-name pkg) "stumpwm")
         t
       daselt-stump-contrib)))

  (if (equal '(nil) daselt-stump-remap-exceptions-alist)
      (daselt-stump-set-remap-exceptions-alist))
  ;;   (customize-group-other-window "daselt-stump")
  ;;   (message "Customization options created. Check the defaults, re-set and save them.
  ;; Then continue with the command exit-recursive-edit.")
  ;;   (recursive-edit)
  )

(defun daselt-stump-set-remap-exceptions-alist ()
  "Automatically set `daselt-stump-remap-exceptions-alist'.

Sets this option according to whether daselt-stump-binwarp is set to t."
  (declare (ftype (function () t)))
  (setopt daselt-stump-remap-exceptions-alist
          (list (remq nil (if (and (boundp daselt-stump-binwarp)
                                   daselt-stump-binwarp)
                              `("binwarp" . 'binwarp:*binwarp-mode-p*))))))

;;;;; Main function
(defun daselt-stump-generate-init (&optional filename official)
  "Generate a daselt-stump initialization file.

Use the files in `daselt-stump-pkg-configs-directory' for config. Call the
resulting file FILENAME. The default for FILENAME is `d-stump.lisp'.

If OFFICIAL is t, don't include user-files."
  (declare (ftype (function (&optional string) string)))
  (interactive)

  (unless (bound-and-true-p daselt-stump-initialized)
    (daselt-stump-initialize))
  
  (let* ((print-level nil)
         (print-length nil)
         (filename (or filename "d-stump.lisp"))
         (filebuf (find-file-noselect (concat daselt-stump-init-directory
                                              filename)))
         ;; Generate keybinds from regular bindlists.
         (bindingstring
          (daselt-base-remove-surrounding-brackets
           (format
            "%s"
            (flatten-list
             (daselt-dirs-act-on-pkg-files-by-type-and-maybe-kill
              `(((lambda (filename)
                   (set-buffer (find-file-noselect filename))
                   (daselt-base-goto-min)
                   (daselt-dirs-act-on-sexps-in-file
                    filename
                    (lambda ()
                      (daselt-bind--generate-define-key-strings-from-bindlist
                       (daselt-base-read-region)))
                    t))
                 . ("dbl" "-special" ,(if official "-user-defined" ""))))
              daselt-stump-pkg-configs-directory)))))

         ;; Get all lisp-code from init files. Again we have to remove initial and final brackets.
         (otherstring (daselt-base-remove-surrounding-brackets
                       (format "%s"
                               (remq nil
                                     (flatten-list
                                      (daselt-dirs-act-on-pkg-files-by-type-and-maybe-kill
                                       `((daselt-base-lisp-file-code . (nil "init")))
                                       daselt-stump-pkg-configs-directory)))))))
    (set-buffer filebuf)
    (delete-region (point-min) (point-max))
    (insert ";;;; daselt-stump-init.lisp\n\n")
    (insert "(stumpwm:set-prefix-key (stumpwm:kbd \"F11\"))\n")
    (daselt-stump--generate-keymaps-code)
    (insert bindingstring)
    (insert otherstring)

    (insert ";;; Module-specific code\n")
    (daselt-stump--generate-module-code)
    (if daselt-stump-iresize (daselt-stump--generate-iresize-map-code))
    (if daselt-stump-binwarp (daselt-stump--generate-binwarp-mode-code))
    (daselt-stump--generate-remap-list-code)
    (save-buffer)))

;;;;;; Generation for other layouts
(defun daselt-stump-generate-all-inits (&optional official)
  "Execute `daselt-stump-generate-init' for each layout in `daselt-xkb-layouts'.

Add in layer 0 to each layout first, just to be sure.

If OFFICIAL is t, don't include user-files."
  (declare (ftype (function ()
                            ;; (list string) ; Compiler complains.
                            list)))

  (daselt-xkb-generate-layouts)
  (daselt-coords-for-layouts-in
   (lambda (layoutsym)
     (let ((namecore (daselt-base-namecore
                      layoutsym "daselt-dfk-" "-layout")))
       (daselt-stump-generate-init (concat "d-stump-" namecore
                                           ".lisp")
                                   official)))
   (mapcar (lambda (layoutsym) (eval `(daselt-dfk-import-layout ,layoutsym)))
           daselt-xkb-layouts)))

;;;;; Modules
(defun daselt-stump--generate-module-code ()
  "Generate code to load modules in `daselt-stump-modules'.

A module is loaded if and only if its corresponding custom is set to t."
  (declare (ftype (function ()
                            ;; void  ; Compiler complains.
                            t)))
  (mapc (lambda (module)
          (if (intern (concat "daselt-stump-" module))
              (insert (format "(load-module \"%s\")\n" module))))
        daselt-stump-modules))

(defun daselt-stump--generate-keymaps-code ()
  "Generate code to initialize keymaps.

Each keymap in `daselt-stump-keymaps' is initialized."
  (declare (ftype (function ()
                            ;; void  ; Compiler complains.
                            t)))
  (mapc (lambda (map)
          (insert (format "(defparameter %s (make-sparse-keymap))\n" map)))
        daselt-stump-keymaps))

(defun daselt-stump--generate-iresize-map-code ()
  "This function generates the code for the iresize map."
  (declare (ftype (function ()
                            ;; void  ; Compiler complains.
                            t)))
  (let* ((blist (car (daselt-dirs-act-on-sexps-in-file
                      (concat daselt-stump-pkg-configs-directory "iresize/iresize-special.dbl")
                      (lambda () (daselt-base-read-region)))))
         (head (daselt-bind-head blist))
         (body (cdr blist)))
    (cl-flet* ((kbd-car (bind) `(kbd ,(daselt-bind-string bind)))
               (kbd-conss (bblist) (mapcar (lambda (bind)
                                             (cons (kbd-car bind)
                                                   (cdr bind)))
                                           bblist)))
      (insert (format "%S\n\n" (append `(define-interactive-keymap)
                                       `((iresize tile-group))
                                       `((:on-enter #'setup-iresize
                                                    :on-exit #'resize-unhide
                                                    :abort-if #'abort-resize-p
                                                    :exit-on ,(mapcar (lambda (bind) (kbd-car bind)) head)))
                                       (kbd-conss body)))))))

(defun daselt-stump--generate-binwarp-mode-code ()
      "Generate the code for the binwarp mode."
      (declare (ftype (function ()
                            ;; void  ; Compiler complains.
                            t)))
      (let* ((blist (car (daselt-dirs-act-on-sexps-in-file
                      (concat daselt-stump-pkg-configs-directory
                              "binwarp/binwarp-special.dbl")
                      (lambda () (daselt-base-read-region)))))
         (head (daselt-bind-head blist))
         (headhead (daselt-bind-head head))
         (headbody (cdr head))
         (body (cdr blist)))
    (cl-flet* ((kbd-car (bind) `(kbd ,(daselt-bind-string bind)))
               (kbd-lists (bblist) (mapcar (lambda (bind)
                                                 (list (kbd-car bind)
                                                   (cdr bind)))
                                           bblist)))
      (insert (format "%S\n\n" (append `(binwarp:define-binwarp-mode binwarp-mode ,headhead)
                                       `((:map *top-map*
                                               :redefine-bindings t
                                               :exit-keys ,(mapcar (lambda (bind) (kbd-car bind)) headbody)))
                                       (kbd-lists body)))))))

;;;;; Remapped Keys
(defun daselt-stump--exceptional-bindings ()
  "Return exceptional bindings from the marked bindlist.

This includes the head escape bindings."
  (declare (ftype (function () list)))
  (let* ((blist (daselt-base-read-region))
         (head (daselt-bind-head blist))
         (headhead (daselt-bind-head head))
         (headbinds (if head
                        (if headhead
                            (cdr head)
                          head))))
    (if head (append headbinds (cdr blist))
      blist)))

(defun daselt-stump--non-exceptional-bindings (excp-bindings)
  "Given a list of exceptional bindings EXCP-BINDINGS, return the
non-exceptional-bindings in a marked bindlist.

These are those that are not in EXCP-BINDINGS."
  (declare (ftype
            ;; (function ((list t)) (list cons)) ; Compiler complains.
            (function (list) list))
           (side-effect-free t))
  (let* ((blist (daselt-base-read-region))
         (head (daselt-bind-head blist))
         (body (if head (cdr blist) blist))
         (non-excp-binds (remq nil (mapcar
                                    (lambda (bind)
                                      (unless (cl-member
                                               bind excp-bindings
                                               :test (lambda (bind excpbind)
                                                       (string= (daselt-bind-string bind)
                                                                (daselt-bind-string excpbind))))
                                        (cons (daselt-bind-string bind)
                                              (cdr bind))))
                                    body))))
    non-excp-binds))

(defun daselt-stump--excp-bindings (excps)
  "Return exceptional bindings from a list of exceptions EXCPS."
  (declare (ftype (function (t)
                            ;; (list cons) ; Compiler complains.
                            t)))
  (apply #'append ; Append bindings of all exceptions.
         (mapcar
          (lambda (excp)
            (daselt-base-flatten-until
             (remq nil
                   (daselt-dirs-act-on-pkg-files-by-type-and-maybe-kill
                    `(((lambda (file)
                         (daselt-dirs-act-on-sexps-in-file
                          file
                          #'daselt-stump--exceptional-bindings))
                       . "dbl"))
                    (concat daselt-stump-pkg-configs-directory (car excp))))
             (lambda (lst)
               (daselt-bind-p (car lst)))))
          excps)))

(defun daselt-stump--format-remap-list-code (lst)
  "Format a list of remapped keys LST into a string suitable for Lisp."
  (declare (ftype (function (string) string))
           (pure t))
  ;; (replace-regexp-in-string
  ;;  (rx (one-or-more (and (zero-or-more space) "\n" (zero-or-more space)))) "\n"
  (string-replace
   "\"\n\"" "\n"
   (string-replace
    "\\\"" "\""
    (string-replace
     "\\\"" "\""
     (string-replace
      ")\"" ")"
      (string-replace
       "\"(" "("
       (string-replace
        "\n\"" "\n"
        (format "%S" lst))))))))

(defun daselt-stump--format-remap-bindlist-code (binds modes &optional head)
  "Format bindings BINDS for use in a remap list, including optional HEAD list.

MODES are included for conditional mappings."
  (declare (ftype (function (
                             ;; (list cons) ; Compiler complains.
                             list string &optional string)
                            string))
           (pure t))
  (concat (string-replace "\",\" " ","
                          (format
                           "%S"
                           (cons ","
                                 (cons
                                  (cons `lambda
                                        (cons
                                         `(win)
                                         (list
                                          (if head `(d-stump-test-for-window-name-and-modes
                                                     win
                                                     (list ,head)
                                                     ,(if modes (append (list 'list)
                                                                        modes)))
                                            `(d-stump-test-for-modes
                                              ,(if modes (append (list 'list)
                                                                 modes)))))))
                                  binds))))))

(defun daselt-stump--generate-remap-list-code ()
  "Generate the list of key translations for daselt-stump's init file.

It processes each bindlist in `daselt-stump-pkg-configs-directory'/stumpwm/remapped-keys-special.dbl
and
`daselt-stump-pkg-configs-directory'/stumpwm/remapped-keys-user-defined-special.dbl
and combines them with the exceptions defined in
`daselt-stump-remap-exceptions-alist`, producing remapped keys that meet the
specified conditions."
  (declare (ftype (function ()
                            ;; void  ; Compiler complains.
                            t)))

  (if (equal '(nil)  daselt-stump-remap-exceptions-alist)
      (error "Please set daselt-stump-remap-exceptions-alist or run daselt-stump-set-remap-exceptions-alist"))
  
  (let* ((base-file-path (concat daselt-stump-pkg-configs-directory
                                 "stumpwm/remapped-keys-special.dbl"))
         (user-file-path (concat daselt-stump-pkg-configs-directory
                                 "stumpwm/remapped-keys-user-defined-special.dbl"))
         (file-path (if (file-exists-p user-file-path)
                        user-file-path
                      base-file-path))

         (remapped-keys-list
          (apply
           #'append ; Append listlists for all exceptions.
           (mapcar ; For all exceptions
            (lambda (excps)
              (let ((modes (mapcar (lambda (excp)
                                     (cdr excp))
                                   excps))
                    (excp-bindings (daselt-stump--excp-bindings excps)))

                (daselt-dirs-act-on-sexps-in-file
                 file-path
                 (lambda () (let* ((blist (daselt-base-read-region))
                              (head (daselt-bind-head blist))
                              (non-excp-binds (daselt-stump--non-exceptional-bindings
                                               excp-bindings)))

                         (concat (daselt-stump--format-remap-bindlist-code
                                  non-excp-binds modes head)
                                 "\n"))))))
            (reverse (daselt-base-powerlist daselt-stump-remap-exceptions-alist)))))

         (remapped-keys-str (daselt-stump--format-remap-list-code remapped-keys-list))
         (overallstr (concat "(define-remapped-keys `"
                             remapped-keys-str
                             ")")))
    (insert overallstr)))

;;;;;; Retrieve Emacs translations
(defun daselt-stump-translate-daselt-keys ()
  "Return the key translations from Stump to Emacs.

Used for `daselt--emacs-key-translations-alist'."
  (declare (ftype (function ()
                            ;; (list (cons string string)) ; Compiler complains.
                            t))
           (side-effect-free t))
  (let* ((base-file-path (concat daselt-stump-pkg-configs-directory
                                 "stumpwm/remapped-keys-special.dbl"))
         (user-file-path (concat daselt-stump-pkg-configs-directory
                                 "stumpwm/remapped-keys-user-defined-special.dbl"))
         (file-path (if (file-exists-p user-file-path)
                        user-file-path
                      base-file-path))
         (blist (car (remq nil (daselt-dirs-act-on-sexps-in-file
                                file-path
                                (lambda () (let* ((blist (daselt-base-read-region))
                                                  (head (daselt-bind-head blist)))
                                             (if (string= head "emacs")
                                                 blist)))))))
         (body (cdr blist))
         (transconses
          (mapcar (lambda (bind)
                    (cons (daselt-bind-string bind)
                          (let* ((val (cdr bind))
                                 (formval (if (member val
                                                      daselt-xkb-special-key-names)
                                              (daselt-xkb--format-special-key val)
                                            val)))
                            formval)))
                  body)))

    transconses))

;;;; Provide
(provide 'daselt-stump)
;;; daselt-stump.el ends here
