2019-10-02 16:31:34 +02:00
|
|
|
(defun eval-in-emacs (&rest s-exps)
|
|
|
|
"Evaluate S-exps with `emacsclient'."
|
2019-12-09 15:35:57 +01:00
|
|
|
(let ((s-exps-string (cl-ppcre:regex-replace-all
|
2019-10-02 16:31:34 +02:00
|
|
|
;; Discard the package prefix.
|
2019-12-09 15:35:57 +01:00
|
|
|
"next-user::?"
|
2019-10-02 16:31:34 +02:00
|
|
|
(write-to-string
|
2019-12-09 15:35:57 +01:00
|
|
|
`(progn ,@s-exps) :case :downcase)
|
|
|
|
"")))
|
|
|
|
(log:debug "Sending to Emacs: ~s" s-exps-string)
|
2019-10-02 16:31:34 +02:00
|
|
|
(ignore-errors (uiop:run-program
|
|
|
|
(list "emacsclient" "--eval" s-exps-string)))))
|
|
|
|
|
2020-05-05 14:30:34 +02:00
|
|
|
(defvar *my-keymap* (make-keymap "my-map")
|
2019-10-02 16:31:34 +02:00
|
|
|
"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)))
|
2020-05-09 11:46:19 +02:00
|
|
|
(define-key *my-keymap* "C-M-o" 'org-capture)
|
2019-10-02 16:31:34 +02:00
|
|
|
|
|
|
|
(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)))))
|
2020-05-09 11:46:19 +02:00
|
|
|
(define-key *my-keymap* "C-M-c d" 'youtube-dl-current-page)
|
2019-10-02 16:31:34 +02:00
|
|
|
|
|
|
|
(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))))
|
2020-05-09 11:46:19 +02:00
|
|
|
(define-key *my-keymap* "C-M-c v" 'play-video-in-current-page)
|
2019-10-02 16:31:34 +02:00
|
|
|
|
|
|
|
(define-mode my-mode ()
|
|
|
|
"Dummy mode for the custom key bindings in `*my-keymap*'."
|
2020-04-26 22:12:33 +02:00
|
|
|
((keymap-scheme :initform (keymap:make-scheme
|
|
|
|
scheme:emacs *my-keymap*
|
|
|
|
scheme:vi-normal *my-keymap*))))
|
2019-10-02 16:31:34 +02:00
|
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
2019-09-24 17:28:09 +02:00
|
|
|
(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)
|
|
|
|
|
2020-04-26 22:13:38 +02:00
|
|
|
(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)
|
2019-09-24 17:28:09 +02:00
|
|
|
|
|
|
|
(defvar *my-unproxied-domains*
|
|
|
|
'("jit.si"
|
2019-10-03 15:55:42 +02:00
|
|
|
"steampowered.com"))
|
2019-09-24 17:28:09 +02:00
|
|
|
|
2020-04-26 22:13:38 +02:00
|
|
|
(defun auto-proxy-handler (request-data)
|
|
|
|
(let* ((url (url request-data))
|
|
|
|
(uri (quri:uri url))
|
2019-09-24 17:28:09 +02:00
|
|
|
(domain (and uri (quri:uri-domain uri))))
|
2019-11-17 14:01:06 +01:00
|
|
|
;; TODO: Turn on/off proxy, not mode.
|
2019-09-24 17:28:09 +02:00
|
|
|
(when domain
|
|
|
|
(next/proxy-mode:proxy-mode
|
|
|
|
:activate
|
|
|
|
(not (member-string domain *my-unproxied-domains*)))))
|
2020-04-26 22:13:38 +02:00
|
|
|
request-data)
|
2019-09-24 17:28:09 +02:00
|
|
|
|
2019-10-02 16:31:34 +02:00
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
|
|
(defvar *my-blocked-hosts*
|
|
|
|
(next/blocker-mode:make-hostlist
|
|
|
|
:hosts '("platform.twitter.com"
|
|
|
|
"syndication.twitter.com"
|
|
|
|
"m.media-amazon.com")))
|
|
|
|
|
2020-04-21 19:54:48 +02:00
|
|
|
(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*))))
|
2019-10-02 16:31:34 +02:00
|
|
|
|
2020-04-15 11:51:50 +02:00
|
|
|
(define-configuration buffer
|
|
|
|
((default-modes (append
|
|
|
|
'(my-mode vi-normal-mode
|
2020-04-21 19:54:48 +02:00
|
|
|
;; my-blocker-mode
|
|
|
|
blocker-mode
|
2020-04-26 22:13:38 +02:00
|
|
|
;; proxy-mode
|
|
|
|
)
|
2020-04-21 19:54:48 +02:00
|
|
|
%slot-default))
|
2020-05-13 11:01:59 +02:00
|
|
|
(request-resource-hook
|
|
|
|
(reduce #'hooks:add-hook
|
|
|
|
(mapcar #'make-handler-resource (list
|
2020-06-11 09:25:36 +02:00
|
|
|
#'auto-proxy-handler
|
2020-05-13 11:01:59 +02:00
|
|
|
#'old-reddit-handler))
|
|
|
|
:initial-value %slot-default))))
|
2019-10-02 16:31:34 +02:00
|
|
|
|
2020-04-08 15:41:14 +02:00
|
|
|
(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)
|
2020-05-13 11:02:10 +02:00
|
|
|
collect (make-instance 'search-engine
|
|
|
|
:shortcut (getf (nthcdr 3 object) :keybinding)
|
|
|
|
:search-url (format-c->lisp (nth 2 object)))))
|
2020-04-08 15:41:14 +02:00
|
|
|
|
2020-05-03 16:42:52 +02:00
|
|
|
(defmethod deserialize-eww-bookmarks (stream)
|
2019-10-02 16:31:34 +02:00
|
|
|
"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))
|
2020-05-03 16:42:52 +02:00
|
|
|
(apply #'make-instance 'next:bookmark-entry
|
2019-10-02 16:31:34 +02:00
|
|
|
entry))
|
|
|
|
entries)))
|
|
|
|
(error (c)
|
2020-05-03 16:42:52 +02:00
|
|
|
(log:error "During bookmark deserialization: ~a" c)
|
2019-10-02 16:31:34 +02:00
|
|
|
nil)))
|
2020-02-22 15:39:48 +01:00
|
|
|
|
2020-05-03 16:42:52 +02:00
|
|
|
(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* 'next::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 (next::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)
|
2020-06-03 12:40:01 +02:00
|
|
|
(bookmarks-path (make-instance 'bookmarks-data-path
|
|
|
|
:basename "~/personal/bookmarks/bookmarks.lisp.gpg"))
|
2020-05-03 16:42:52 +02:00
|
|
|
;; (bookmarks-restore-function #'restore-eww-bookmarks)
|
|
|
|
))
|
|
|
|
|
2020-02-22 15:39:48 +01:00
|
|
|
(setf next/vcs:*vcs-projects-roots* '("~/projects"
|
|
|
|
"~/common-lisp"
|
|
|
|
"~/.local/share/emacs/site-lisp"))
|
2020-04-21 19:54:48 +02:00
|
|
|
|
|
|
|
(defun my-format-status (window)
|
|
|
|
(declare (ignore window))
|
|
|
|
(let* ((buffer (current-buffer))
|
2020-04-22 21:17:11 +02:00
|
|
|
(buffer-count (1+ (or (position buffer
|
2020-06-08 18:08:26 +02:00
|
|
|
(sort (buffer-list)
|
2020-04-22 21:17:11 +02:00
|
|
|
#'<
|
|
|
|
:key #'id))
|
|
|
|
0))))
|
2020-04-26 22:13:17 +02:00
|
|
|
(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
|
2020-06-08 18:08:26 +02:00
|
|
|
(length (buffer-list))
|
2020-04-26 22:13:17 +02:00
|
|
|
(url buffer)
|
|
|
|
(title buffer)))))
|
2020-04-21 19:54:48 +02:00
|
|
|
|
|
|
|
(define-configuration window
|
|
|
|
((status-formatter #'my-format-status)))
|
2020-04-26 22:13:17 +02:00
|
|
|
|
2020-05-02 18:03:23 +02:00
|
|
|
(load-system :slynk)
|
|
|
|
(when (find-package :slynk)
|
2020-05-09 11:46:32 +02:00
|
|
|
(next::load-lisp "/home/ambrevar/dotfiles/.config/next/slynk.lisp"))
|
2020-05-02 18:45:26 +02:00
|
|
|
|
|
|
|
|
|
|
|
(defvar +dev-data-profile+ (make-instance 'data-profile :name "dev")
|
|
|
|
"Development profile.")
|
|
|
|
|
2020-05-03 16:03:15 +02:00
|
|
|
(defmethod next:expand-data-path ((profile (eql +dev-data-profile+)) (path data-path))
|
2020-05-02 18:45:26 +02:00
|
|
|
"Persist data to /tmp/next/."
|
|
|
|
(expand-default-path (make-instance (class-name (class-of path))
|
|
|
|
:basename (basename path)
|
|
|
|
:dirname "/tmp/next/")))
|