cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-01-31 04:24:48 +01:00
Code Issues

- added configuration directive to use a specific program to open a

Browse Source 
link (e.g. open all mp3 files with program mpv).
This commit is contained in:
cage 2021-02-10 17:43:40 +01:00
parent 1b6c94196f
commit 3df833b248
5 changed files with 85 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
etc/default-theme.conf
View File

@ -542,3 +542,10 @@ gemini-subscription-window.foreground = cyan
gemini-subscription-window.input.selected.background = cyan
gemini-subscription-window.input.selected.foreground = black
# you can instruct the program to open some non gemini link with a
# program installed with your system like below
# syntax open "REGEXP" with "PROGRAM-NAME"
# example:
#
# open "https?://.+mp3" with "mpv"

5
src/open-message-link-window.lisp
View File

@ -82,7 +82,10 @@
(program-events:push-event event))
(gemini-viewer:request url :enqueue enqueue
:use-cached-file-if-exists t))
(os-utils:xdg-open url)))
(let ((program (swconf:link-regex->program-to-use url)))
(if program
(os-utils:open-link-with-program program url)
(os-utils:xdg-open url)))))
(defclass open-links-window ()
((links

8
src/os-utils.lisp
View File

@ -118,3 +118,11 @@
:input stream
:output t
:error t))))
(defun open-link-with-program (program link)
(sb-ext:run-program program
(list link)
:search t
:wait nil
:output nil
:error :output))

2
src/package.lisp
View File

@ -323,6 +323,7 @@
:+ssl-key-name+
:cpu-number
:xdg-open
:open-link-with-program
:getenv
:default-temp-dir
:open-with-editor
@ -1116,6 +1117,7 @@
:config-username
:config-password-echo-character
:config-win-focus-mark
:link-regex->program-to-use
:thread-message-symbol
:thread-message-read-colors
:thread-message-unread-colors

66
src/software-configuration.lisp
View File

@ -24,10 +24,12 @@
;; | COLOR-RE-ASSIGN
;; | SERVER-ASSIGN
;; | USERNAME-ASSIGN
;; | OPEN-LINK-HELPER
;; | GENERIC-ASSIGN)
;; COMMENT*
;; SERVER-ASSIGN := SERVER-KEY BLANKS ASSIGN BLANKS GENERIC-VALUE BLANKS
;; USERNAME-ASSIGN := USERNAME-KEY BLANKS ASSIGN BLANKS GENERIC-VALUE BLANKS
;; USERNAME-ASSIGN := USERNAME-KEY BLANKS WITH BLANKS GENERIC-VALUE BLANKS
;; OPEN-LINK-HELPER := OPEN-LINK-HELPER-KEY BLANKS ASSIGN BLANKS REGEXP PROGRAM-NAME
;; GENERIC-ASSIGN := (and key blanks assign blanks
;; (or quoted-string
;; hexcolor
@ -40,11 +42,15 @@
;; KEY := FIELD (FIELD-SEPARATOR KEY)*
;; BLANKS := (BLANK)*
;; FILEPATH := QUOTED-STRING
;; PROGRAM-NAME := QUOTED-STRING
;; USE := "use"
;; SERVER-KEY := "server"
;; USERNAME-KEY := "username"
;; COLOR-RE-KEY := "color-regexp"
;; IGNORE-USER-RE-KEY := "ignore-user-regexp"
;; OPEN := "open"
;; OPEN-LINK-HELPER-KEY := OPEN
;; WITH-KEY := "with"
;; REGEXP := QUOTED-STRING
;; QUOTED-STRING := #\" (not #\") #\"
;; FIELD := ( (or ESCAPED-CHARACTER
@ -257,6 +263,14 @@
(defrule username-key "username"
(:constant :username))
(defrule open "open"
(:constant :open))
(defrule open-link-helper-key open)
(defrule with "with"
(:constant :with))
(defrule server-assign
(and server-key blanks assign blanks generic-value blanks)
(:function remove-if-null))
@ -265,6 +279,43 @@
(and username-key blanks assign blanks generic-value blanks)
(:function remove-if-null))
(defclass open-link-helper ()
((re
:initform nil
:initarg :re
:accessor re)
(program-name
:initform nil
:initarg :program-name
:accessor program-name))
(:documentation "When a gemini link matches `re' try to open it with 'program-name'"))
(defmethod print-object ((object open-link-helper) stream)
(print-unreadable-object (object stream :type t :identity nil)
(with-accessors ((re re)
(program-name program-name)) object
(format stream "re: ~s program: ~s" re program-name))))
(defun make-open-link-helper (re program-name)
(assert (stringp program-name))
(assert (stringp re))
(make-instance 'open-link-helper
:re re
:program-name program-name))
(defrule open-link-helper
(and open-link-helper-key
blanks
regexp ; 2
blanks
with
blanks
regexp ; 6
blanks)
(:function (lambda (args)
(list :open-link-helper
(make-open-link-helper (elt args 2) (elt args 6))))))
(defrule filepath quoted-string)
(defparameter *already-included-files* ())
@ -286,6 +337,7 @@
ignore-user-re-assign
server-assign
username-assign
open-link-helper
generic-assign)
(* comment))
(:function second))
@ -356,6 +408,7 @@
mark
vote-vertical-bar
crypted
open-link-helper
histogram
error-dialog
info-dialog
@ -437,7 +490,8 @@
(value (second entry)))
(cond
((or (eq +key-color-re+ key)
(eq +key-ignore-user-re+ key))
(eq +key-ignore-user-re+ key)
(eq +key-open-link-helper+ key))
(setf (access:accesses *software-configuration* key)
(append (access:accesses *software-configuration* key)
(list value))))
@ -712,6 +766,14 @@
(gen-simple-access (password-echo-character)
+key-password-echo-character+)
(gen-simple-access (all-link-open-program) +key-open-link-helper+)
(defun link-regex->program-to-use (link)
(let ((found (find-if (lambda (a)
(cl-ppcre:scan (re a) link))
(config-all-link-open-program))))
(program-name found)))
(defun config-win-focus-mark ()
(values (access:accesses *software-configuration*
+key-window+