(define-module (jd features emacs-xyz)
  #:use-module (rde features)
  #:use-module (rde features emacs)

  #:export (feature-emacs-org-uni))

(define* (feature-emacs-org-uni
          #:key
          (capture-key "u")
          (org-uni-task-olp (list "Tasks"))
          (org-uni-class-prop-name "UNI-CLASS")
          (org-uni-course-prop-name "COURSE"))
  (ensure-pred string? capture-key)
  (ensure-pred list? org-uni-task-olp)
  (ensure-pred string? org-uni-course-prop-name)

  (ensure-pred string? org-uni-class-prop-name)

  (define emacs-f-name 'org-uni)
  (define f-name (symbol-append 'emacs- emacs-f-name))

  (define (get-home-services config)
    (list
     (rde-elisp-configuration-service
      emacs-f-name
      config
      `((defvar org-uni-class-prop-name ,org-uni-class-prop-name)
        (defvar org-uni-task-olp (list ,@org-uni-task-olp)
          "An outline path to task heading, that start from uni class heading.")
        (defun org-uni-normalize (s)
          (let ((replacements
                 '(("ą" . "a") ("ć" . "c") ("ę" . "e") ("ł" . "l")
                   ("ń" . "n") ("ó" . "o") ("ś" . "s") ("ź" . "z") ("ż" . "z")
                   ("Ą" . "A") ("Ć" . "C") ("Ę" . "E") ("Ł" . "L")
                   ("Ń" . "N") ("Ó" . "O") ("Ś" . "S") ("Ź" . "Z") ("Ż" . "Z"))))
            (dolist (pair replacements s)
                    (setq s (replace-regexp-in-string (car pair) (cdr pair) s)))))
        (defun org-uni-select-class ()
          (require 'dash)
          (let* ((choices
                  (-non-nil
                   (org-map-entries
                    (lambda ()
                      (let* ((heading (nth 4 (org-heading-components)))
                             (file (buffer-file-name))
                             (heading-path (org-get-outline-path t))
                             (heading-norm (replace-regexp-in-string
                                            "[^a-z0-9]+" "_"
                                            (org-uni-normalize (downcase heading)))))
                        (when (org-entry-get (point) org-uni-class-prop-name)
                          (cons (format "[%s] %s"
                                        (file-name-nondirectory file)
                                        heading)
                                (list :file file
                                      :heading-path heading-path
                                      :heading heading
                                      :heading-norm heading-norm)))))
                    nil
                    'agenda)))
                 (selection (completing-read "Select class: "
                                             (mapcar 'car choices) nil t)))
            (cdr (assoc selection choices))))
        (defun org-uni-goto-class ()
          (interactive)
          (let* ((sel (org-uni-select-class))
                 (file (plist-get sel :file))
                 (olp (plist-get sel :heading-path)))
            (find-file file)
            (let ((m (org-find-olp olp t)))
              (when m
                (widen)
                (goto-char m)
                (org-narrow-to-subtree)
                (org-show-subtree)
                (set-marker m nil)))))
        (defun org-uni-open-course-link ()
          (interactive)
          (let* ((sel (org-uni-select-class))
                 (file (plist-get sel :file))
                 (olp (plist-get sel :heading-path)))
            (with-temp-buffer
             (insert-file-contents file)
             (org-mode)
             (let ((m (org-find-olp olp t)))
               (when m
                 (goto-char m)
                 (let ((course-link (org-entry-get (point) ,org-uni-course-prop-name)))
                   (when course-link
                     (org-link-open-from-string course-link))))))))
        (defun org-uni-capture-task-function ()
          (let* ((sel (org-uni-select-class))
                 (file (plist-get sel :file))
                 (heading (plist-get sel :heading))
                 (heading-path (plist-get sel :heading-path))
                 (heading-norm (plist-get sel :heading-norm))
                 (olp (append heading-path org-uni-task-olp))
                 (path (org-capture-expand-file file))
                 (m (org-find-olp (cons path olp))))
            (org-capture-put :uni-class-tag heading-norm)
            (set-buffer (marker-buffer m))
            (org-capture-put-target-region-and-position)
            (widen)
            (goto-char m)
            (set-marker m nil)))
        (defvar org-uni-map (make-sparse-keymap)
          "Keymap for org-uni commands.")
        (define-key org-uni-map (kbd "u") 'org-uni-goto-class)
        (define-key org-uni-map (kbd "c") 'org-uni-open-course-link)
        (define-key rde-app-map (kbd "u") org-uni-map)
        (with-eval-after-load
            'org-capture
          (add-to-list
           'org-capture-templates
           '(,capture-key
             "University task" entry
             (function org-uni-capture-task-function)
             "* TODO %? :%(org-capture-get :uni-class-tag):\n:PROPERTIES:\n:CREATED: %U\n:END:\n"))))
      #:summary "This Emacs Lisp script enhances =org-mode= with a feature for managing university tasks."
      #:commentary "This Emacs Lisp script enhances =org-mode= with a feature for managing university tasks."
      #:authors (list "Jakub Dlugosz <jakub@jdlugosz.com>")
      #:url "https://jdlugosz.com/"
      #:keywords '(convenience))))

  (feature
   (name f-name)
   (values '())
   (home-services-getter get-home-services)))