271 lines
10 KiB
Common Lisp
271 lines
10 KiB
Common 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)
|
|
|
|
(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"))))
|
|
|
|
(load-system :invidious-handler)
|
|
|
|
(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
|
|
(append
|
|
(when (find-package :invidious-handler) ; TODO: Add helper.
|
|
(list (symbol-value (find-symbol (string 'invidious-handler)
|
|
(find-package :invidious-handler)))))
|
|
(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/")))
|