310 lines
11 KiB
Common Lisp
310 lines
11 KiB
Common Lisp
(in-package :nyxt-user) ; While implicit, this allows SLY to know which package we are in.
|
|
|
|
(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 (keymap:make-scheme
|
|
scheme:cua *my-keymap*
|
|
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"
|
|
(quri:render-uri 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))
|
|
:fallback-url (let* ((url (nth 2 object))
|
|
(pos (position #\/ url :from-end t)))
|
|
(str:substring 0 (1+ pos) url)) )))
|
|
|
|
(defun personal-file (path)
|
|
(str:concat (uiop:getenv "PERSONAL") "/" path))
|
|
|
|
(defvar my-search-engines
|
|
(loop for file in `("~/.emacs.d/lisp/init-engine.el"
|
|
,(personal-file "/bookmarks/engines.el"))
|
|
append (nyxt::with-maybe-gpg-file (s file)
|
|
(read-emacs-engines s))))
|
|
|
|
(define-configuration buffer ; Multiple configurations work!
|
|
((search-engines (append my-search-engines %slot-default%))
|
|
(bookmarks-path (make-instance 'bookmarks-data-path
|
|
:basename (personal-file "bookmarks/bookmarks.lisp.gpg")))
|
|
(auto-mode-rules-path
|
|
(make-instance 'auto-mode-rules-data-path :basename (personal-file "bookmarks/auto-mode-rules.lisp.gpg")))))
|
|
|
|
(define-configuration (buffer web-buffer nosave-buffer)
|
|
((default-modes (append '(;; dark-mode
|
|
vi-normal-mode
|
|
my-mode)
|
|
%slot-default%))))
|
|
|
|
(define-configuration (prompt-buffer)
|
|
((default-modes (append '(vi-insert-mode) %slot-default%))))
|
|
|
|
(define-configuration (web-buffer nosave-buffer)
|
|
((default-modes (append
|
|
'(auto-mode
|
|
blocker-mode
|
|
force-https-mode
|
|
noimage-mode
|
|
noscript-mode
|
|
proxy-mode
|
|
reduce-tracking-mode)
|
|
%slot-default%))))
|
|
|
|
(defvar *my-request-resource-handlers*
|
|
(list
|
|
magnet-handler
|
|
old-reddit-handler))
|
|
|
|
;; (load-after-system :invidious-handler
|
|
;; (nyxt-init-file "invidious.lisp"))
|
|
|
|
(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-file "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)))
|
|
|
|
;; TODO: This has been removed in 2-pre-release-7. Restore when back.
|
|
;; (setf nyxt/vcs:*vcs-projects-roots* '("~/projects"
|
|
;; "~/common-lisp"
|
|
;; "~/.local/share/emacs/site-lisp"))
|
|
|
|
(defun my-status-style (&key (mode-background-color "rgb(120,120,120)"))
|
|
(cl-css:css
|
|
`((body
|
|
:background "rgb(160, 160, 160)"
|
|
:font-size "14px"
|
|
:color "rgb(32, 32, 32)"
|
|
:padding 0
|
|
:margin 0
|
|
:line-height "20px")
|
|
(".arrow"
|
|
:width "10px"
|
|
:height "20px")
|
|
(".arrow-right"
|
|
:clip-path "polygon(0 100%, 100% 50%, 0 0)")
|
|
(".arrow-left"
|
|
:clip-path "polygon(0 50%, 100% 100%, 100% 0)")
|
|
("#container"
|
|
:display "grid"
|
|
;; Columns: controls, arrow, url, arrow, modes
|
|
:grid-template-columns "115px 10px auto 10px auto"
|
|
:overflow-y "hidden")
|
|
("#controls"
|
|
:background-color "rgb(80,80,80)"
|
|
:padding-left "5px"
|
|
:overflow "hidden"
|
|
:white-space "nowrap")
|
|
("#url"
|
|
:background-color "rgb(160,160,160)"
|
|
:min-width "100px"
|
|
:text-overflow "ellipsis"
|
|
:overflow-x "hidden"
|
|
:white-space "nowrap"
|
|
:padding-left "15px"
|
|
:padding-right "10px"
|
|
:margin-left "-10px")
|
|
("#modes"
|
|
:background-color ,mode-background-color
|
|
:color "rgb(230, 230, 230)"
|
|
:text-align "right"
|
|
:padding-right "5px"
|
|
;; Uncomment the following to trim the mode list.
|
|
;; :text-overflow "ellipsis"
|
|
;; :overflow-x "hidden"
|
|
:white-space "nowrap")
|
|
(.button
|
|
:color "rgb(230, 230, 230)"
|
|
:text-decoration "none"
|
|
:padding-left "2px"
|
|
:padding-right "2px"
|
|
:margin-left "2px"
|
|
:margin-right "2px")
|
|
(|.button:hover|
|
|
:color "black"))))
|
|
|
|
(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))
|
|
(my-status-style))
|
|
(setf (style (status-buffer window))
|
|
(my-status-style :mode-background-color "rgb(255,0,0)")))
|
|
(markup:markup
|
|
(:div :id "container"
|
|
(:div :id "controls"
|
|
(markup:raw (format-status-buttons)))
|
|
(:div :class "arrow arrow-right"
|
|
:style "background-color:rgb(80,80,80)" "")
|
|
(:div :id "url"
|
|
(markup:raw
|
|
(format-status-load-status buffer)
|
|
(format-status-url buffer)))
|
|
(:div :class "arrow arrow-left"
|
|
:style "background-color:rgb(220,120,120);background-color:rgb(120,120,120)" "")
|
|
(:div :id "modes"
|
|
(format-status-modes buffer window))))))
|
|
|
|
;; (define-configuration status-buffer
|
|
;; ((glyph-mode-presentation-p t)))
|
|
|
|
(define-configuration window
|
|
((status-formatter #'my-format-status)))
|
|
|
|
(load-after-system :slynk (nyxt-init-file "slynk.lisp"))
|
|
|
|
(define-class dev-data-profile (data-profile)
|
|
((name :initform "dev"))
|
|
(:documentation "Development profile."))
|
|
|
|
(defmethod nyxt:expand-data-path ((profile 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/")))
|
|
|
|
;; After init:
|
|
(load (nyxt-init-file "config.lisp"))
|