"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
(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))
(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)))))))
(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)))
(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))))
headers))
(reverse headers))))
+
;; Spartan page retrieval
(defvar elpher-spartan-redirect-chain)
(insert content)
(elpher-restore-pos))
(elpher-with-clean-buffer
- (insert "LOADING GEMINI... (use 'u' to cancel)\n"))
+ (insert "LOADING SPARTAN... (use 'u' to cancel)\n"))
(setq elpher-spartan-redirect-chain nil)
(elpher-get-spartan-response address renderer))
(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.
(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)))
(message "Following redirect to %s" response-meta)
(if (>= (length elpher-spartan-redirect-chain) 5)
(error "More than 5 consecutive redirects followed"))
- (let* ((current-address (elpher-page-address current-page))
+ (let* ((current-address (elpher-page-address elpher-current-page))
(redirect-address (elpher-address-from-url
(concat "spartan://"
(elpher-address-host current-address)
(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 ; Temporary failure
+ (?4 ; Client error
(error "Spartan server reports CLIENT ERROR for this request: %s %s"
response-code response-meta))
- (?5 ; Permanent failure
+ (?5 ; Server error
(error "Spartan server reports SERVER ERROR for this request: %s %s"
response-code response-meta))
(_other
(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)
(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?
: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)
(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,
(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)
;; 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
The Lambda Lab / projects / elpher.git / blobdiff