- fixed gopher URL parser.

doc/tinmop.man

@@ -1420,6 +1420,15 @@ file-explorer-go-up
 file-explorer-expand-path
 .SS "Gopher window"
 .TP
+\fBC-g\fP
+close-gopher-window
+.TP
+\fBC-q\fP
+close-gopher-window
+.TP
+\fBq  \fP
+close-gopher-window
+.TP
 \fBC-J (key \fIenter\fP)  \fP
 gopher-window:open-menu-link
 .TP

doc/tinmop.org

@@ -712,6 +712,9 @@
 
 ** Gopher window
 
+- C-g :: close-gopher-window
+- C-q :: close-gopher-window
+- q   :: close-gopher-window
 - C-J (key /enter/)   :: gopher-window:open-menu-link
 - C-b a :: bookmark-gopher-page
 - C-b d :: delete-gemini-bookmark

etc/init.lisp

@@ -834,6 +834,15 @@
 
 ;; gopher viewer keymap
 
+(defun close-gopher-window ()
+  (ui-goodies::close-window-and-return-to-threads specials:*gopher-window*))
+
+(define-key "C-g"       #'close-gopher-window                        *gopher-keymap*)
+
+(define-key "C-q"       #'close-gopher-window                        *gopher-keymap*)
+
+(define-key "q"         #'close-gopher-window                        *gopher-keymap*)
+
 (define-key "C-J"       #'gopher-window:open-menu-link               *gopher-keymap*)
 
 (define-key "C-b a"     #'bookmark-gopher-page                       *gopher-keymap*)

src/command-line.lisp

@@ -222,6 +222,8 @@
       (set-option-variable options :gemini-gui-server          *rpc-server-mode*)
       (set-option-variable options :gemini-gui                 *rpc-client-mode*)
       (set-option-variable options :folder                     *start-folder*)
+      (when (string-not-empty-p *start-folder*)
+        (setf *start-folder* (db:add-folder-prefix *start-folder*)))
       (set-option-variable options :open-net-address           *net-address*)
       (set-option-variable options :timeline                   *start-timeline*)
       (set-option-variable options :reset-timeline-pagination  *reset-timeline-pagination*)

src/db.lisp

@@ -3527,3 +3527,12 @@ Note: `status-id' must identify at least a row in the database."
           (progn
             (db:update-db (api-client:get-remote-status parent-id))
             (get-cache parent-id))))))
+
+(defun has-folder-prefix-p (string)
+  (starts-with-prefix-p +folder-tag-prefix+ string))
+
+(defun add-folder-prefix (folder-name)
+  (add-prefix-once +folder-tag-prefix+ folder-name))
+
+(defun strip-folder-prefix (maybe-folder)
+  (strip-prefix +folder-tag-prefix+ maybe-folder))

src/gopher/parser.lisp

@@ -275,6 +275,25 @@
 (defrule gopher-menu (and (* gopher-dir-entity) (? gopher-last-line))
   (:function first))
 
+(defun has-line-type-p (data)
+  (or (%line-type-file-p data)
+      (%line-type-dir-p data)
+      (%line-type-cso-p data)
+      (%line-type-error-p data)
+      (%line-type-mac-hex-file-p data)
+      (%line-type-dos-archive-file-p data)
+      (%line-type-uuencoded-file-p data)
+      (%line-type-index-search-p data)
+      (%line-type-telnet-session-p data)
+      (%line-type-binary-file-p data)
+      (%line-type-redundant-server-p data)
+      (%line-type-tn3270-session-p data)
+      (%line-type-gif-file-p data)
+      (%line-type-image-file-p data)
+      (%line-type-info-p data)
+      (%line-type-uri-p data)
+      (%line-type-empty-p data)))
+
 (defun parse-menu (data)
   (let ((menu (parse 'gopher-menu data)))
     (loop for entry in menu
@@ -349,11 +368,10 @@
                  (list host port)))))
 
 (defrule gopher-gopher-url (and (+ (not #\:))
-                         "://"
-                         gopher-gopher-url-authority
-                         (? (and (not #\/)
-                                 (& #\/)))
-                         (* (character-ranges (#\u0000 #\uffff))))
+                                "://"
+                                gopher-gopher-url-authority
+                                (? (character-ranges (#\u0000 #\uffff)))
+                                (* (character-ranges (#\u0000 #\uffff))))
   (:function (lambda (a)
                (let* ((host-port (third a))
                       (host (coerce (first host-port) 'string))
@@ -361,14 +379,14 @@
                                 (parse-integer (coerce (third host-port) 'string))
                                 70))
                       (type-path (fourth a))
-                      (type      (if (car type-path)
-                                     (string (car type-path))
+                      (type      (if type-path
+                                     type-path
                                      +line-type-dir+))
                       (path      (coerce (fifth a) 'string)))
-                 (when (and (string-not-empty-p path)
-                            (not (car type-path)))
-                   (setf path (strcat "/" path)))
-               (list host port path type)))))
+                 (list host
+                       port
+                       (percent-decode path)
+                       (string type))))))
 
 (defun parse-iri (iri)
   (let* ((parsed   (parse 'gopher-gopher-url iri))

src/message-rendering-utils.lisp

@@ -19,18 +19,13 @@
 (define-constant +temp-mention-prefix+ "/at/" :test #'string=)
 
 (defun mention-p (maybe-mention)
-  (scan (strcat "^" +mention-prefix+)
-        maybe-mention))
+  (starts-with-prefix-p +mention-prefix+ maybe-mention))
 
 (defun add-mention-prefix (username)
-  (if (mention-p username)
-      username
-      (strcat +mention-prefix+ username)))
+  (add-prefix-once +mention-prefix+ username))
 
 (defun strip-mention-prefix (maybe-mention)
-  (if (not (mention-p maybe-mention))
-      maybe-mention
-      (subseq maybe-mention (length +mention-prefix+))))
+  (strip-prefix +mention-prefix+ maybe-mention))
 
 (defun find-first-mention-in-message (message-body)
   (when message-body

src/package.lisp

@@ -455,6 +455,9 @@
    :+integer-regexp+
    :*blanks*
    :uchar-length
+   :starts-with-prefix-p
+   :strip-prefix
+   :add-prefix-once
    :utf8-encoded-p
    :clean-unprintable-chars
    :to-s
@@ -1205,7 +1208,10 @@
    :gempub-metadata-find
    :gempub-metadata-id->path
    :gempub-metadata-id->row
-   :get-parent-status-row))
+   :get-parent-status-row
+   :has-folder-prefix-p
+   :add-folder-prefix
+   :strip-folder-prefix))
 
 (defpackage :date-formatter
   (:use

src/text-utils.lisp

@@ -38,6 +38,19 @@
 
 (a:define-constant +integer-regexp+ "0|[1-9][0-9]+|[1-9]"                 :test 'string=)
 
+(defun starts-with-prefix-p (prefix string)
+  (cl-ppcre:scan (strcat "^" prefix) string))
+
+(defun strip-prefix (prefix string)
+  (if (starts-with-prefix-p prefix string)
+      (subseq string (length prefix))
+      string))
+
+(defun add-prefix-once (prefix string)
+  (if (starts-with-prefix-p prefix string)
+      string
+      (strcat prefix string)))
+
 (defun uchar-length (leading-byte)
   (let ((ones (do* ((ct 7 (1- ct))
                     (bit (ldb (byte 1 ct) leading-byte)
@@ -110,10 +123,6 @@
   (declare (optimize (debug 0) (safety 0) (speed 3)))
   (reduce (lambda (a b) (concatenate 'string a b)) chunks))
 
-(defun strip-prefix (string prefix)
-  (let ((re (strcat "^" prefix)))
-    (cl-ppcre:regex-replace re string "")))
-
 (defun strip-withespaces (string)
   (let ((re "\\s"))
     (cl-ppcre:regex-replace re string "")))