(defun eval-in-emacs (&rest s-exps)
  "Evaluate S-exps with `emacsclient'."
  (let ((s-exps-string (cl-ppcre:regex-replace-all
                        ;; Discard the package prefix.
                        "next-user::?"
                        (write-to-string
                         `(progn ,@s-exps) :case :downcase)
                        "")))
    (log:debug "Sending to Emacs: ~s" s-exps-string)
    (ignore-errors (uiop:run-program
                    (list "emacsclient" "--eval" s-exps-string)))))

(defvar *my-keymap* (make-keymap "my-map")
  "Keymap for `my-mode'.")

(define-command org-capture (&optional (buffer (current-buffer)))
  "Org-capture current page."
  (eval-in-emacs
   `(org-link-set-parameters
     "next"
     :store (lambda ()
              (org-store-link-props
               :type "next"
               :link ,(url buffer)
               :description ,(title buffer))))
   `(org-capture)))
(define-key *my-keymap* "C-M-o" 'org-capture)

(define-command youtube-dl-current-page (&optional (buffer (current-buffer)))
  "Download a video in the currently open buffer."
  (eval-in-emacs
   (if (search "youtu" (url buffer))
       `(progn (youtube-dl ,(url buffer)) (youtube-dl-list))
       `(ambrevar/youtube-dl-url ,(url buffer)))))
(define-key *my-keymap* "C-M-c d" 'youtube-dl-current-page)

(define-command play-video-in-current-page (&optional (buffer (current-buffer)))
  "Play video in the currently open buffer."
  (uiop:run-program (list "mpv" (url buffer))))
(define-key *my-keymap* "C-M-c v" 'play-video-in-current-page)

(define-mode my-mode ()
  "Dummy mode for the custom key bindings in `*my-keymap*'."
  ((keymap-scheme :initform (keymap:make-scheme
                             scheme:emacs *my-keymap*
                             scheme:vi-normal *my-keymap*))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar +youtube-dl-command+ "youtube-dl"
  "Path to the 'youtube-dl' program.")

;; (defun auto-yt-dl-handler (url)
;;   "Download a Youtube URL asynchronously to /tmp/videos/.
;; Videos are downloaded with `+youtube-dl-command+'."
;;   (let ((uri (quri:uri url)))
;;     (when (and uri
;;                (member-string (quri:uri-domain uri) '("youtube.com" "youtu.be"))
;;                (string= (quri:uri-path uri) "/watch"))
;;       (log:info "Youtube: downloading ~a" url)
;;       (uiop:launch-program (list +youtube-dl-command+ url "-o" "/tmp/videos/%(title)s.%(ext)s"))))
;;   url)

(defparameter old-reddit-handler
  (url-dispatching-handler
   'old-reddit-dispatcher
   (match-host "www.reddit.com")
   (lambda (url)
     (quri:copy-uri url :host "old.reddit.com"))))

(defparameter magnet-handler
  (url-dispatching-handler
   'transmission-magnet-links
   (match-scheme "magnet")
   (lambda (url)
     (uiop:launch-program
      (list "transmission-remote" "--add"
            (object-string url)))
     (echo "Magnet link opened in Transmission.")
     nil)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar *my-blocked-hosts*
  (nyxt/blocker-mode:make-hostlist
   :hosts '("platform.twitter.com"
            "syndication.twitter.com"
            "m.media-amazon.com")))

(define-configuration nyxt/blocker-mode:blocker-mode
  ((nyxt/blocker-mode:hostlists (append (list *my-blocked-hosts*) %slot-default))))

(defun format-c->lisp (s)
  "Incomplete substitution of C format string to Lisp format string.
Recognized formats:
- %%
- %s"
  (str:join "%" (mapcar (lambda (s) (str:replace-all "%s" "~a" s))
                        (str:split "%%" s))))

(defun read-emacs-engines (stream)
  "Return a list of (NAME URL SHORTCUT)."
  (loop for object = (read stream nil :eof)
        until (eq object :eof)
        when (eq (car object) 'defengine)
          collect (make-instance 'search-engine
                                 :shortcut (getf (nthcdr 3 object) :keybinding)
                                 :search-url (format-c->lisp (nth 2 object)))))

(defvar my-search-engines
  (loop for file in '("~/.emacs.d/lisp/init-engine.el"
                      "~/personal/bookmarks/engines.el")
        append (nyxt::with-maybe-gpg-file (s file)
                 (read-emacs-engines s))))

(define-configuration (buffer web-buffer)
  ((default-modes (append '(my-mode vi-normal-mode) %slot-default))))
(define-configuration buffer            ; Multiple configurations work!
  ((search-engines (append my-search-engines %slot-default))
   (bookmarks-path (make-instance 'bookmarks-data-path
                                  :basename "~/personal/bookmarks/bookmarks.lisp.gpg"))
   (auto-mode-rules-path
    (make-instance 'auto-mode-rules-data-path :basename "~/personal/bookmarks/auto-mode-rules.lisp.gpg"))))

(define-configuration web-buffer
  ((default-modes (append
                   '(auto-mode
                     noimage-mode
                     noscript-mode
                     force-https-mode
                     proxy-mode
                     blocker-mode)
                   %slot-default))
   (request-resource-hook
    (reduce #'hooks:add-hook
            (list magnet-handler
                  old-reddit-handler)
            :initial-value %slot-default))))

(defmethod deserialize-eww-bookmarks (stream)
  "This version of deserialize-bookmarks is compatible with Ambrevar's EWW
format."
  (handler-case
      (let ((*standard-input* stream))
        (let ((entries (read stream)))
          (mapcar (lambda (entry)
                    (when (getf entry :date)
                      (setf (getf entry :date)
                            (local-time:parse-timestring (getf entry :date))))
                    (when (getf entry :time)
                      (let ((timestamp (asctime->timestamp (getf entry :time))))
                        (when timestamp
                          (setf (getf entry :date) timestamp)))
                      (remf entry :time))
                    (when (getf entry :search)
                      (setf (getf entry :search-url) (getf entry :search))
                      (remf entry :search))
                    (when (getf entry :mark)
                      (setf (getf entry :shortcut) (getf entry :mark))
                      (remf entry :mark))
                    (apply #'make-instance 'nyxt:bookmark-entry
                           entry))
                  entries)))
    (error (c)
      (log:error "During bookmark deserialization: ~a" c)
      nil)))

(defun restore-eww-bookmarks ()
  "Restore the bookmarks from EWW."
  (handler-case
      (let ((data (with-data-file (file (make-instance 'data-path
                                                       :basename "~/personal/bookmarks/eww-bookmarks.gpg")
                                        :direction :input
                                        :if-does-not-exist nil)
                    (when file
                      (deserialize-eww-bookmarks file)))))
        (when data
          (echo "Loading ~a bookmarks from ~s."
                (length data)
                (expand-path (bookmarks-path *browser*)))
          (setf (slot-value *browser* 'nyxt::bookmarks-data) data)))

    (error (c)
      (echo-warning "Failed to load bookmarks from ~s: ~a" (expand-path (bookmarks-path *browser*)) c))))

(define-configuration browser
  ((session-restore-prompt :always-restore)))

(setf nyxt/vcs:*vcs-projects-roots* '("~/projects"
                                      "~/common-lisp"
                                      "~/.local/share/emacs/site-lisp"))

(defvar my-status-style
  #.(cl-css:css
     '((body
        :background "rgb(200, 0, 0)"
        :font-size "12px"
        :color "rgb(32, 32, 32)"
        :padding 0
        :line-height "16px"
        :margin 0)
       ("#modes"
        :border-right "2px solid rgb(120, 120, 120)"
        :display "inline-block"
        :padding "0 5px 0 5px"
        :margin "0 5px 0 0")
       (.status-menu
        :padding-left "4px")
       (.button
        :background-color "rgb(160, 160, 160)"
        :color "black"
        :height "100%"
        :text-decoration "none"
        :border-radius "2px"
        :padding-left "2px"
        :padding-right "2px"
        :margin-left "2px"
        :margin-right "2px")
       (|.button:hover|
        :color "white"))))

(defun my-format-status (window)
  (let ((buffer (current-buffer window)))
    (if (or (internal-buffer-p buffer)
            (find-submode buffer 'proxy-mode))
        (setf (style (status-buffer window))
              (getf (mopu:slot-properties 'status-buffer 'style) :initform))
        (setf (style (status-buffer window))
              my-status-style))
    (markup:markup
     (:div :id "modes"
           (:b
            (format nil "~{~a~^ ~}"
                    (mapcar (lambda (m) (str:replace-all "-mode" "" (str:downcase (mode-name m))))
                            (modes buffer)))))
     (:a :class "button" :title "Backwards" :href (nyxt::lisp-url '(nyxt/web-mode:history-backwards)) "←")
     (:a :class "button" :title "Forwards" :href (nyxt::lisp-url '(nyxt/web-mode:history-forwards)) "→")
     (:a :class "button" :title "Reload" :href (nyxt::lisp-url '(nyxt:reload-current-buffer)) "↺")
     (:a :class "button" :title "Execute" :href (nyxt::lisp-url '(nyxt:execute-command)) "⚙")
     (:a :class "button" :title "Buffers" :href (nyxt::lisp-url '(nyxt::list-buffers)) "≡")
     (:span (if (and (web-buffer-p buffer)
                     (eq (slot-value buffer 'nyxt::load-status) :loading))
                "Loading: " ""))
     (:a :class "button"
         :href (nyxt::lisp-url '(nyxt:set-url-from-current-url))
         (format nil " ~a — ~a"
                 (object-display (url buffer))
                 (title buffer))))))

(define-configuration window
  ((status-formatter #'my-format-status)))

(load-system :slynk)
(when (find-package :slynk)
  (nyxt::load-lisp "/home/ambrevar/dotfiles/.config/nyxt/slynk.lisp"))

(defvar +dev-data-profile+ (make-instance 'data-profile :name "dev")
  "Development profile.")

(defmethod nyxt:expand-data-path ((profile (eql +dev-data-profile+)) (path data-path))
  "Persist data to /tmp/nyxt/."
  (expand-default-path (make-instance (class-name (class-of path))
                                      :basename (basename path)
                                      :dirname "/tmp/nyxt/")))