ambevar-dotfiles/.config/nyxt/init.lisp

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

(defun old-reddit-handler (request-data)
  (let ((uri (url request-data)))
    (setf (url request-data)
          (if (search "reddit.com" (quri:uri-host uri))
              (progn
                (setf (quri:uri-host uri) "old.reddit.com")
                (log:info "Switching to old Reddit: ~s" (object-display uri))
                uri)
              uri)))
  request-data)

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

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

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

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

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

(define-configuration buffer
  ((default-modes (append
                   '(my-mode vi-normal-mode
                     ;; my-blocker-mode
                     blocker-mode
                     ;; proxy-mode
                     )
                   %slot-default))
   (request-resource-hook
    (reduce #'hooks:add-hook
            (mapcar #'make-handler-resource (list
                                             #'auto-proxy-handler
                                             #'old-reddit-handler))
            :initial-value %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)))))

(defmethod deserialize-eww-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 '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))))

(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 browser
  ((search-engines (append my-search-engines %slot-default))
   (session-restore-prompt :always-restore)
   (bookmarks-path (make-instance 'bookmarks-data-path
                                  :basename "~/personal/bookmarks/bookmarks.lisp.gpg"))
   ;; (bookmarks-restore-function #'restore-eww-bookmarks)
   ))

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

(defun my-format-status (window)
  (declare (ignore window))
  (let* ((buffer (current-buffer))
         (buffer-count (1+ (or (position buffer
                                         (sort (buffer-list)
                                               #'<
                                               :key #'id))
                               0))))
    (str:concat
     (markup:markup
      (:b (format nil "[~{~a~^ ~}]"
                  (mapcar (lambda (m) (str:replace-all "-mode" ""
                                                       (str:downcase
                                                        (class-name (class-of m)))))
                          (modes buffer)))))
     (format nil " (~a/~a) ~a — ~a"
             buffer-count
             (length (buffer-list))
             (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/")))