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