Fixed handling of spartan urls in elpher-go.

[elpher.git] / elpher.el

diff --git a/elpher.el b/elpher.el
index e0b28f9..f582e45 100644 (file)
--- 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)