(in-package :next-user)

;; Use development platform port.
(when (boundp '+platform-port-command+)
  (setf +platform-port-command+
        "~/common-lisp/next/ports/gtk-webkit/next-gtk-webkit"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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)
  "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 :keymap *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 :keymap *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 :keymap *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-schemes :initform (list :emacs-map *my-keymap*
                                   :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)

(defun old-reddit-handler (url)
  (let* ((uri (quri:uri url)))
    (if (search "reddit.com" (quri:uri-host uri))
        (progn
          (setf (quri:uri-host uri) "old.reddit.com")
          (let ((new-url (quri:render-uri uri)))
            (log:info "Switching to old Reddit: ~a" new-url)
            new-url))
        url)))

(defvar *my-unproxied-domains*
  '("jit.si"
    "steampowered.com"))

(defun auto-proxy-handler (url)
  (let* ((uri (quri:uri url))
         (domain (and uri (quri:uri-domain uri))))
    ;; TODO: Turn on/off proxy, not mode.
    (when domain
      (next/proxy-mode:proxy-mode
       :activate
       (not (member-string domain *my-unproxied-domains*)))))
  url)

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

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

(defun no-cookies-handler (buffer)
  ;; TODO: Disable cookies for known hosts.
  (setf (cookies-path buffer) #P""))

(define-mode my-blocker-mode (next/blocker-mode:blocker-mode)
  "Blocker mode with custom hosts from `*my-blocked-hosts*'."
  ((next/blocker-mode::hostlists :initform (list *my-blocked-hosts* next/blocker-mode:*default-host-list*))))

(if (find-class 'gtk-buffer nil)
    (defclass my-buffer (gtk-buffer)
      ((default-modes :initform (append
                                 '(my-mode vi-normal-mode
                                   my-blocker-mode
                                   proxy-mode)
                                 (get-default 'buffer 'default-modes)))
       (load-hook :initform (next-hooks:make-hook-string->string
                             :handlers (list #'old-reddit-handler
                                             #'auto-proxy-handler)
                             :combination #'next-hooks:combine-composed-hook))))
    (defclass my-buffer (buffer)
      ((default-modes :initform (append
                                 '(my-mode vi-normal-mode
                                   my-blocker-mode
                                   proxy-mode)
                                 (get-default 'buffer 'default-modes)))
       (load-hook :initform (next-hooks:make-hook-string->string
                             :handlers (list #'old-reddit-handler
                                             #'auto-proxy-handler)
                             :combination #'next-hooks:combine-composed-hook)))))

(setf *buffer-class* 'my-buffer)

(defvar my-search-engines
  '(("aa" . "https://aur.archlinux.org/packages.php?O=0&K=~a&do_Search=Go")
    ("ap" . "https://www.archlinux.org/packages/?sort=&q=~a&maintainer=&flagged=")
    ("aw" . "https://wiki.archlinux.org/index.php?search=~a")
    ("ctan" . "http://www.ctan.org/search?phrase=~a")
    ("dd" . "http://devdocs.io/#q=~a")
    ("dg" . "https://duckduckgo.com/?q=~a")
    ("eb" . "https://debbugs.gnu.org/cgi/pkgreport.cgi?package=emacs;include=subject%3A~a;repeatmerged=on;archive=both")
    ("ed" . "https://lists.gnu.org/archive/cgi-bin/namazu.cgi?idxname=emacs-devel&submit=Search&query=~a")
    ("ee" . "https://lists.gnu.org/archive/cgi-bin/namazu.cgi?idxname=emms-help&submit=Search!&query=~a")
    ("ge" . "https://wiki.gentoo.org/index.php?title=Special%3ASearch&search=~a&go=Go")
    ("gh" . "https://github.com/search?ref=simplesearch&q=~a")
    ("gr" . "https://www.goodreads.com/search?q=~a")
    ("gm" . "https://maps.google.com/maps?q=~a")
    ("gud" . "https://lists.gnu.org/archive/cgi-bin/namazu.cgi?idxname=guix-devel&submit=Search&query=~a")
    ("guh" . "https://lists.gnu.org/archive/cgi-bin/namazu.cgi?idxname=help-guix&submit=Search!&query=~a")
    ("gup" . "https://guix-hpc.bordeaux.inria.fr/package/~a")
    ("i" . "http://www.imdb.com/find?q=~a&s=all")
    ("mba" . "http://musicbrainz.org/search?query=~a&type=artist&method=indexed")
    ("mbr" . "http://musicbrainz.org/search?query=~a&type=release&method=indexed")
    ("osm" . "https://www.openstreetmap.org/search?query=~a")
    ("q" . "http://quickdocs.org/search?q=~a")
    ("s" . "http://stackoverflow.com/search?q=~a")
    ("wp" . "http://www.wikipedia.org/search-redirect.php?language=en&go=Go&search=~a")
    ("wb" . "http://en.wikibooks.org/wiki/Special:Search?search=~a")
    ("wk" . "http://en.wiktionary.org/wiki/Special:Search?search=~a")
    ("wa" . "http://www.winehq.org/search/?q=~a")
    ("yt" . "https://www.youtube.com/results?search_query=~a")))

(if (find-class 'remote-interface nil)
    (defclass my-remote-interface (remote-interface)
      ;; TODO: Fetch from Emacs' engine.el automatically?
      ((search-engines :initform
                       (append
                        my-search-engines
                        (get-default 'remote-interface 'search-engines)))))
    (defclass my-browser (gtk-browser)
      ;; TODO: Fetch from Emacs' engine.el automatically?
      ((search-engines :initform
                       (append
                        my-search-engines
                        (get-default 'browser 'search-engines))))))

(if (boundp '*remote-interface-class*)
    (setf *remote-interface-class* 'my-remote-interface)
    (setf *browser-class* 'my-browser))

(defmethod deserialize-bookmarks (stream)
  "This version of deserialize-bookmarks is compatibly 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 'bookmark-entry
                           entry))
                  entries)))
    (error (c)
      (log:error "Error during bookmark deserialization: ~a" c)
      nil)))

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