From: plugd <plugd@thelambdalab.xyz>
Date: Fri, 6 May 2022 08:48:51 +0000 (+0200)
Subject: Crummy attempt at getting posting to work.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;ds=inline;h=3056f982158c00e5c73e8963bb5f685432950d84;p=elpher.git

Crummy attempt at getting posting to work.
---

diff --git a/elpher.el b/elpher.el
index e0b28f9..bb628de 100644
--- a/elpher.el
+++ b/elpher.el
@@ -279,6 +279,10 @@ meaningfully."
   '((t :inherit font-lock-constant-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
   '((t :inherit font-lock-comment-face))
   "Face used for other URL type links records.")
@@ -471,6 +475,12 @@ If no address is defined, returns 0.  (This is for compatibility with
 the URL library.)"
   (url-port address))
 
+(defun elpher-address-path-and-query (address)
+  "Retrieve path and query portion of ADDRESS as a pair."
+  (let ((path-and-query (url-path-and-query address)))
+    (cons (car path-and-query)
+          (url-unhex-string (cdr path-and-query)))))
+
 (defun elpher-gopher-address-selector (address)
   "Retrieve gopher selector from ADDRESS object."
   (if (member (url-filename address) '("" "/"))
@@ -1486,7 +1496,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)))))))
@@ -1668,6 +1678,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 +1732,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 (elpher-address-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 +1784,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 +1796,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)