X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=elpher.git;a=blobdiff_plain;f=elpher.el;h=e503a5c8748b07fb7c2118a3b6033f8f590a68ef;hp=e0b28f93a7b44c620e8d98bed98d14d883655308;hb=refs%2Fheads%2Fspartan;hpb=3a54597f9c4a900db0c94349fd9301a54e68d090 diff --git a/elpher.el b/elpher.el index e0b28f9..e503a5c 100644 --- a/elpher.el +++ b/elpher.el @@ -276,7 +276,11 @@ meaningfully." "Face used for Gemini type directory records.") (defface elpher-spartan - '((t :inherit font-lock-constant-face)) + '((t :inherit font-lock-type-face)) + "Face used for Spartan type directory records.") + +(defface elpher-spartan-post + '((t :inherit font-lock-string-face)) "Face used for Spartan type directory records.") (defface elpher-other-url @@ -359,8 +363,8 @@ is not explicitly given." (when (or (equal (url-filename url) "") (equal (url-filename url) "/")) (setf (url-filename url) "/1"))) - (when (equal "gemini" (url-type url)) - ;; Gemini defaults + (when (member (url-type url) '("gemini" "spartan")) + ;; Gemini and Spartan defaults (if (equal (url-filename url) "") (setf (url-filename url) "/")))) (elpher-remove-redundant-ports url)) @@ -1486,7 +1490,7 @@ Returns nil in the event that the contents of the line following the (defun elpher-gemini-get-link-display-string (link-line) "Extract the display string portion of LINK-LINE, a gemini map file link line. Return nil if this portion is not provided." - (let* ((rest (string-trim (elt (split-string link-line "=>") 1))) + (let* ((rest (string-trim (substring link-line 2))) (idx (string-match "[ \t]" rest))) (and idx (elpher-color-filter-apply (string-trim (substring rest (+ idx 1))))))) @@ -1529,7 +1533,7 @@ treatment that a separate function is warranted." (setf (url-host address) (puny-encode-domain (url-host address)))) (unless (url-type address) (setf (url-type address) (url-type current-address))) - (when (equal (url-type address) "gemini") + (when (member (url-type address) '("gemini" "spartan")) (setf (url-filename address) (elpher-collapse-dot-sequences (url-filename address))))) (elpher-remove-redundant-ports address))) @@ -1668,6 +1672,8 @@ can be used to toggle the display of the preformatted text." (elpher-gemini-insert-preformatted-line line preformatted)) ((pred (string-prefix-p "=>")) (elpher-gemini-insert-link line)) + ((pred (string-prefix-p "=:")) + (elpher-spartan-insert-query line)) ((pred (string-prefix-p "#")) (elpher-gemini-insert-header line)) (_ (elpher-gemini-insert-text line)))) @@ -1720,12 +1726,18 @@ can be used to toggle the display of the preformatted text." (defun elpher-get-spartan-response (address renderer) "Get response string from spartan server at ADDRESS and render using RENDERER." - (elpher-get-host-response address 300 - (concat (elpher-address-host address) " " - (elpher-address-filename address) " " - "0\r\n") ; No uploads for now - (lambda (response-string) - (elpher-process-spartan-response response-string renderer)))) + (let* ((host (elpher-address-host address)) + (path-and-query (url-path-and-query address)) + (filename (car path-and-query)) + (data (cdr path-and-query)) + (data-len (length data))) + (elpher-get-host-response address 300 + (concat host " " + filename " " + (number-to-string data-len) "\r\n" + data) + (lambda (response-string) + (elpher-process-spartan-response response-string renderer))))) (defun elpher-parse-spartan-response (response) "Parse the RESPONSE string and return a list of components. @@ -1766,7 +1778,7 @@ that the response was malformed." (if (member redirect-address elpher-spartan-redirect-chain) (error "Redirect loop detected")) (elpher-page-set-address elpher-current-page redirect-address) - (add-to-list 'elpher-gemini-redirect-chain redirect-address) + (add-to-list 'elpher-spartan-redirect-chain redirect-address) (elpher-get-spartan-response redirect-address renderer))) (?4 ; Client error (error "Spartan server reports CLIENT ERROR for this request: %s %s" @@ -1778,6 +1790,33 @@ that the response was malformed." (error "Spartan server response unknown: %s %s" response-code response-meta)))))) +(defun elpher-spartan-insert-query (query-line) + "Insert link described by QUERY-LINE into a text/gemini document." + (let ((url (elpher-gemini-get-link-url query-line))) + (when url + (let* ((address (elpher-address-from-gemini-url url)) + (given-display-string (elpher-gemini-get-link-display-string query-line)) + (fill-prefix (make-string (+ 1 (length elpher-gemini-link-string)) ?\s))) + (insert elpher-gemini-link-string) + (let ((display-string (or given-display-string url))) + (insert-text-button display-string + 'face 'elpher-spartan-post + 'display-string display-string + 'url (elpher-address-to-url address) + 'action #'elpher-spartan-post + 'follow-link t + 'help-echo #'elpher--page-button-help)) + (newline))))) + +(defun elpher-spartan-post (button) + "Function called when the spartan post link BUTTON is clicked." + (let* ((display-string (button-get button 'display-string)) + (url (button-get button 'url)) + (post-url (concat url "?" (url-hexify-string (read-string "Text to post: "))))) + (elpher-visit-page (elpher-make-page + display-string + (elpher-address-from-url post-url))))) + ;; Finger page connection (defun elpher-get-finger-page (renderer) @@ -2188,9 +2227,10 @@ of gemini, gopher or finger." (let* ((url (elpher-info-current)) (desc (car elpher-current-page)) (protocol (cond - ((string-prefix-p "gemini:" url) "gemini") ((string-prefix-p "gopher:" url) "gopher") ((string-prefix-p "finger:" url) "finger") + ((string-prefix-p "gemini:" url) "gemini") + ((string-prefix-p "spartan:" url) "spartan") (t "elpher")))) (when (equal "elpher" protocol) ;; Weird link. Or special inner link? @@ -2226,6 +2266,11 @@ supports the old protocol elpher, where the link is self-contained." :export (lambda (link description format _plist) (elpher-org-export-link link description format "gopher")) :follow (lambda (link _arg) (elpher-org-follow-link link "gopher"))) + (org-link-set-parameters + "spartan" + :export (lambda (link description format _plist) + (elpher-org-export-link link description format "spartan")) + :follow (lambda (link _arg) (elpher-org-follow-link link "spartan"))) (org-link-set-parameters "finger" :export (lambda (link description format _plist) @@ -2247,7 +2292,7 @@ supports the old protocol elpher, where the link is self-contained." (if (boundp 'browse-url-default-handlers) (add-to-list 'browse-url-default-handlers - '("^\\(gopher\\|finger\\|gemini\\)://" . elpher-browse-url-elpher)) + '("^\\(gopher\\|finger\\|gemini\\|spartan\\)://" . elpher-browse-url-elpher)) ;; Patch `browse-url-browser-function' for older ones. The value of ;; that variable is `browse-url-default-browser' by default, so ;; that's the function that gets advised. If the value is an alist, @@ -2258,7 +2303,7 @@ supports the old protocol elpher, where the link is self-contained." (lambda (url &rest _args) "Handle gemini, gopher, and finger schemes using Elpher." (let ((scheme (downcase (car (split-string url ":" t))))) - (if (member scheme '("gemini" "gopher" "finger")) + (if (member scheme '("gopher" "gemini" "spartan" "finger")) ;; `elpher-go' always returns nil, which will stop the ;; advice chain here in a before-while (elpher-go url) @@ -2273,13 +2318,13 @@ supports the old protocol elpher, where the link is self-contained." ;; Make mu4e aware of the gemini world (setq mu4e~view-beginning-of-url-regexp - "\\(?:https?\\|gopher\\|finger\\|gemini\\)://\\|mailto:") + "\\(?:https?\\|gopher\\|finger\\|gemini\\|spartan\\)://\\|mailto:") ;;; eww: ;; Let elpher handle gemini, gopher links in eww buffer. (setq eww-use-browse-url - "\\`mailto:\\|\\(\\`gemini\\|\\`gopher\\|\\`finger\\)://") + "\\`mailto:\\|\\(\\`gemini\\|\\`gopher\\|\\`finger\\|\\`spartan\\)://") ;;; Interactive procedures