dotfiles/.config/nyxt/init.lisp

(in-package :nyxt-user) ; While implicit, this allows SLY to know which package we are in.

(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 (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)))))

(defun personal-file (path)
  (str:concat (uiop:getenv "PERSONAL") "/" path))

(defvar my-search-engines
  (loop for file in `("~/.emacs.d/lisp/init-engine.el"
                      ,(personal-file "/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-file "bookmarks/bookmarks.lisp.gpg")))
   (auto-mode-rules-path
    (make-instance 'auto-mode-rules-data-path :basename (personal-file "bookmarks/auto-mode-rules.lisp.gpg")))))

(define-configuration web-buffer
  ((default-modes (append
                   '(auto-mode
                     blocker-mode
                     force-https-mode
                     noimage-mode
                     noscript-mode
                     proxy-mode
                     reduce-tracking-mode)
                   %slot-default))))

(defvar *my-request-resource-handlers*
  (list
   magnet-handler
   old-reddit-handler))

;; (load-after-system :invidious-handler
;;                    (nyxt-init-file "invidious.lisp"))

(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-file "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"))

(defun my-status-style (&key (mode-background-color "rgb(120,120,120)"))
  (cl-css:css
   `((body
      :background "rgb(160, 160, 160)"
      :font-size "14px"
      :color "rgb(32, 32, 32)"
      :padding 0
      :margin 0
      :line-height "20px")
     (".arrow"
      :width "10px"
      :height "20px")
     (".arrow-right"
      :clip-path "polygon(0 100%, 100% 50%, 0 0)")
     (".arrow-left"
      :clip-path "polygon(0 50%, 100% 100%, 100% 0)")
     ("#container"
      :display "grid"
      ;; Columns: controls, arrow, url, arrow, modes
      :grid-template-columns "115px 10px auto 10px auto"
      :overflow-y "hidden")
     ("#controls"
      :background-color "rgb(80,80,80)"
      :padding-left "5px"
      :overflow "hidden"
      :white-space "nowrap")
     ("#url"
      :background-color "rgb(160,160,160)"
      :min-width "100px"
      :text-overflow "ellipsis"
      :overflow-x "hidden"
      :white-space "nowrap"
      :padding-left "15px"
      :padding-right "10px"
      :margin-left "-10px")
     ("#modes"
      :background-color ,mode-background-color
      :color "rgb(230, 230, 230)"
      :text-align "right"
      :padding-right "5px"
      ;; Uncomment the following to trim the mode list.
      ;; :text-overflow "ellipsis"
      ;; :overflow-x "hidden"
      :white-space "nowrap")
     (.button
      :color "rgb(230, 230, 230)"
      :text-decoration "none"
      :padding-left "2px"
      :padding-right "2px"
      :margin-left "2px"
      :margin-right "2px")
     (|.button:hover|
      :color "black"))))

(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))
              (my-status-style))
        (setf (style (status-buffer window))
              (my-status-style :mode-background-color "rgb(255,0,0)")))
    (markup:markup
     (:div :id "container"
           (:div :id "controls"
                 (markup:raw (format-status-buttons)))
           (:div :class "arrow arrow-right"
                 :style "background-color:rgb(80,80,80)" "")
           (:div :id "url"
                 (markup:raw
                  (format-status-load-status buffer)
                  (format-status-url buffer)))
           (:div :class "arrow arrow-left"
                 :style "background-color:rgb(220,120,120);background-color:rgb(120,120,120)" "")
           (:div :id "modes"
                 (format-status-modes buffer))))))

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

(load-after-system :slynk (nyxt-init-file "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/")))

;; After init:
(load (nyxt-init-file "config.lisp"))