X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=elpher.git;a=blobdiff_plain;f=elpher.el;h=e503a5c8748b07fb7c2118a3b6033f8f590a68ef;hp=2a115e74fd60f2d49f63ddc377cbc05320698362;hb=refs%2Fheads%2Fspartan;hpb=87b89f4cf8ee9d6cfe0b189115b64a816e7227e2 diff --git a/elpher.el b/elpher.el index 2a115e7..e503a5c 100644 --- a/elpher.el +++ b/elpher.el @@ -91,7 +91,7 @@ ((gopher ?s) elpher-get-gopher-page elpher-render-download "snd" elpher-binary) ((gopher ?h) elpher-get-gopher-page elpher-render-html "htm" elpher-html) (gemini elpher-get-gemini-page elpher-render-gemini "gem" elpher-gemini) - (spartan elpher-get-spartan-page elpher-render-spartan "spt" elpher-spartan) + (spartan elpher-get-spartan-page elpher-render-gemini "spt" elpher-spartan) (finger elpher-get-finger-page elpher-render-text "txt" elpher-text) (telnet elpher-get-telnet-page nil "tel" elpher-telnet) (other-url elpher-get-other-url-page nil "url" elpher-other-url) @@ -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)) @@ -424,6 +428,7 @@ address refers to, via the table `elpher-type-map'." ?1 (string-to-char (substring (url-filename address) 1))))) ("gemini" 'gemini) + ("spartan" 'spartan) ("telnet" 'telnet) ("finger" 'finger) ("file" 'file) @@ -1485,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))))))) @@ -1528,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))) @@ -1667,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)))) @@ -1696,8 +1703,11 @@ can be used to toggle the display of the preformatted text." headers)) (reverse headers)))) + ;; Spartan page retrieval +(defvar elpher-spartan-redirect-chain) + (defun elpher-get-spartan-page (renderer) "Getter which retrieves and renders a Spartan page and renders it using RENDERER." (let* ((address (elpher-page-address elpher-current-page)) @@ -1708,20 +1718,26 @@ can be used to toggle the display of the preformatted text." (insert content) (elpher-restore-pos)) (elpher-with-clean-buffer - (insert "LOADING GEMINI... (use 'u' to cancel)\n")) - (setq elpher-gemini-redirect-chain nil) + (insert "LOADING SPARTAN... (use 'u' to cancel)\n")) + (setq elpher-spartan-redirect-chain nil) (elpher-get-spartan-response address renderer)) (error (elpher-network-error address the-error))))) (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. @@ -1739,8 +1755,8 @@ that the response was malformed." (error "Malformed response: No CRLF-delimited header found in response %s" response)))) (defun elpher-process-spartan-response (response-string renderer) - "Process the gemini response RESPONSE-STRING and pass the result to RENDERER." - (let ((response-components (elpher-parse-gemini-response response-string))) + "Process the spartan response RESPONSE-STRING and pass the result to RENDERER." + (let ((response-components (elpher-parse-spartan-response response-string))) (let ((response-code (elt response-components 0)) (response-meta (elt response-components 1)) (response-body (elt response-components 2))) @@ -1749,40 +1765,58 @@ that the response was malformed." (funcall renderer response-body response-meta)) (?3 ; Redirect (message "Following redirect to %s" response-meta) - (if (>= (length elpher-gemini-redirect-chain) 5) + (if (>= (length elpher-spartan-redirect-chain) 5) (error "More than 5 consecutive redirects followed")) - (let ((redirect-address (elpher-address-from-gemini-url response-meta))) - (if (member redirect-address elpher-gemini-redirect-chain) + (let* ((current-address (elpher-page-address elpher-current-page)) + (redirect-address (elpher-address-from-url + (concat "spartan://" + (elpher-address-host current-address) + ":" + (elpher-address-port current-address) + "/" + response-meta)))) + (if (member redirect-address elpher-spartan-redirect-chain) (error "Redirect loop detected")) - (if (not (eq (elpher-address-type redirect-address) 'gemini)) - (error "Server tried to automatically redirect to non-gemini URL: %s" - response-meta)) (elpher-page-set-address elpher-current-page redirect-address) - (add-to-list 'elpher-gemini-redirect-chain redirect-address) - (elpher-get-gemini-response redirect-address renderer))) - (?4 ; Temporary failure - (error "Gemini server reports TEMPORARY FAILURE for this request: %s %s" + (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" response-code response-meta)) - (?5 ; Permanent failure - (error "Gemini server reports PERMANENT FAILURE for this request: %s %s" + (?5 ; Server error + (error "Spartan server reports SERVER ERROR for this request: %s %s" response-code response-meta)) - (?6 ; Client certificate required - (elpher-with-clean-buffer - (if elpher-client-certificate - (insert "Gemini server does not recognise the provided TLS certificate:\n\n") - (insert "Gemini server is requesting a valid TLS certificate:\n\n")) - (auto-fill-mode 1) - (elpher-gemini-insert-text response-meta)) - (let ((chosen-certificate (elpher-choose-client-certificate))) - (unless chosen-certificate - (error "Gemini server requires a client certificate and none was provided")) - (setq elpher-client-certificate chosen-certificate)) - (elpher-with-clean-buffer) - (elpher-get-gemini-response (elpher-page-address elpher-current-page) renderer)) (_other - (error "Gemini server response unknown: %s %s" + (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) @@ -2193,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? @@ -2231,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) @@ -2252,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, @@ -2263,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) @@ -2278,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