214 lines
8.1 KiB
Common Lisp
214 lines
8.1 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* (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* ((url (url request-data))
|
|
(uri (quri:uri url)))
|
|
(setf (url request-data)
|
|
(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)))
|
|
request-data)
|
|
|
|
(defvar *my-unproxied-domains*
|
|
'("jit.si"
|
|
"steampowered.com"))
|
|
|
|
(defun auto-proxy-handler (request-data)
|
|
(let* ((url (url request-data))
|
|
(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*)))))
|
|
request-data)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defvar *my-blocked-hosts*
|
|
(next/blocker-mode:make-hostlist
|
|
:hosts '("platform.twitter.com"
|
|
"syndication.twitter.com"
|
|
"m.media-amazon.com")))
|
|
|
|
(define-configuration next/blocker-mode:blocker-mode
|
|
((next/blocker-mode:hostlists (append (list *my-blocked-hosts*) %slot-default))))
|
|
|
|
;; (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-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 #'old-reddit-handler #'auto-proxy-handler))
|
|
;; :initial-value %slot-default))
|
|
))
|
|
|
|
(defmacro with-maybe-gpg-file ((stream filespec) &body body)
|
|
"Evaluate BODY with STREAM bound to FILESPEC.
|
|
FILESPEC may be a GPG-encrypted file."
|
|
`(let ((clear-data (handler-case
|
|
(with-output-to-string (out)
|
|
(uiop:run-program (list "gpg" "-d" ,filespec) :output out))
|
|
(error ()
|
|
(alexandria:read-file-into-string ,filespec)))))
|
|
(with-input-from-string (,stream clear-data)
|
|
,@body)))
|
|
|
|
(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 (list ;; (nth 1 object) ; No need for name?
|
|
(getf (nthcdr 3 object) :keybinding)
|
|
(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 (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)))
|
|
|
|
(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"))
|
|
|
|
(defun my-format-status (window)
|
|
(declare (ignore window))
|
|
(let* ((buffer (current-buffer))
|
|
(buffer-count (1+ (or (position buffer
|
|
(sort (alexandria:hash-table-values (buffers *browser*))
|
|
#'<
|
|
: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
|
|
(hash-table-count (buffers *browser*))
|
|
(url buffer)
|
|
(title buffer)))))
|
|
|
|
(define-configuration window
|
|
((status-formatter #'my-format-status)))
|
|
|