Fix display of local file links

[elpher.git] / elpher.el

diff --git a/elpher.el b/elpher.el
index 80fb146..1c19259 100644 (file)
--- a/elpher.el
+++ b/elpher.el
@@ -332,7 +332,6 @@ is not explicitly given."
     (unwind-protect
         (let ((url (url-generic-parse-url url-string)))
           (unless (and (not (url-fullness url)) (url-type url))
-            (setf (url-fullness url) t)
             (unless (url-type url)
               (setf (url-type url) default-scheme))
             (unless (url-host url)
@@ -342,7 +341,8 @@ is not explicitly given."
                       (if (cdr p)
                           (concat "/" (mapconcat #'identity (cdr p) "/"))
                         ""))))
-            (when (url-host url)
+            (when (not (string-empty-p (url-host url)))
+              (setf (url-fullness url) t)
               (setf (url-host url) (puny-encode-domain (url-host url))))
             (when (or (equal "gopher" (url-type url))
                       (equal "gophers" (url-type url)))
@@ -1463,7 +1463,7 @@ Returns the url portion in the event that the display-string portion is empty."
          (idx (string-match "[ \t]" rest)))
     (string-trim (if idx
                      (substring rest (+ idx 1))
-                   rest))))
+                   (elpher-address-to-iri (elpher-address-from-url (elpher-decode (url-unhex-string rest))))))))
 
 (defun elpher-collapse-dot-sequences (filename)
   "Collapse dot sequences in the (absolute) FILENAME.
@@ -1489,11 +1489,11 @@ treatment that a separate function is warranted."
   (let ((address (url-generic-parse-url url))
         (current-address (elpher-page-address elpher-current-page)))
     (unless (and (url-type address) (not (url-fullness address))) ;avoid mangling mailto: urls
-      (setf (url-fullness address) t)
       (if (url-host address) ;if there is an explicit host, filenames are absolute
           (if (string-empty-p (url-filename address))
               (setf (url-filename address) "/")) ;ensure empty filename is marked as absolute
         (setf (url-host address) (url-host current-address))
+        (setf (url-fullness address) (not (string-empty-p (url-host address)))) ; set fullness to t if host is set
         (setf (url-portspec address) (url-portspec current-address)) ; (url-port) too slow!
         (unless (string-prefix-p "/" (url-filename address)) ;deal with relative links
           (setf (url-filename address)
@@ -1514,7 +1514,8 @@ treatment that a separate function is warranted."
          (display-string (elpher-gemini-get-link-display-string link-line))
          (address (elpher-address-from-gemini-url url))
          (type (if address (elpher-address-type address) nil))
-         (type-map-entry (cdr (assoc type elpher-type-map))))
+         (type-map-entry (cdr (assoc type elpher-type-map)))
+        (fill-prefix (make-string (+ 1 (length elpher-gemini-link-string)) ?\s)))
     (when display-string
       (insert elpher-gemini-link-string)
       (if type-map-entry
@@ -1528,10 +1529,7 @@ treatment that a separate function is warranted."
                                 'follow-link t
                                 'help-echo #'elpher--page-button-help))
         (insert (propertize display-string 'face 'elpher-unknown)))
-      (insert "\n"))))
-
-(defvar elpher--gemini-page-headings nil
-  "List of headings on the page.")
+      (newline))))
 
 (defun elpher-gemini-insert-header (header-line)
   "Insert header described by HEADER-LINE into a text/gemini document.
@@ -1549,11 +1547,12 @@ by HEADER-LINE."
                             (/ (* fill-column
                                   (font-get (font-spec :name (face-font 'default)) :size))
                                (font-get (font-spec :name (face-font face)) :size)) fill-column)))
-      (setq elpher--gemini-page-headings (cons (cons header (point))
-                                               elpher--gemini-page-headings))
       (unless (display-graphic-p)
         (insert (make-string level ?#) " "))
-      (insert (propertize header 'face face 'rear-nonsticky t))
+      (insert (propertize header
+                          'face face
+                          'gemini-heading t
+                          'rear-nonsticky t))
       (newline))))
 
 (defun elpher-gemini-insert-text (text-line)
@@ -1592,7 +1591,6 @@ width defined by `elpher-gemini-max-fill-width'."
 (defun elpher-render-gemini-map (data _parameters)
   "Render DATA as a gemini map file, PARAMETERS is currently unused."
   (elpher-with-clean-buffer
-   (setq elpher--gemini-page-headings nil)
    (let ((preformatted nil))
      (auto-fill-mode 1)
      (setq-local fill-column (min (window-width) elpher-gemini-max-fill-width))
@@ -1606,7 +1604,6 @@ width defined by `elpher-gemini-max-fill-width'."
          (elpher-gemini-insert-link line))
         ((string-prefix-p "#" line) (elpher-gemini-insert-header line))
         (t (elpher-gemini-insert-text line)))))
-   (setq elpher--gemini-page-headings (nreverse elpher--gemini-page-headings))
    (elpher-cache-content
     (elpher-page-address elpher-current-page)
     (buffer-string))))
@@ -1619,6 +1616,18 @@ width defined by `elpher-gemini-max-fill-width'."
     (elpher-page-address elpher-current-page)
     (buffer-string))))
 
+(defun elpher-build-current-imenu-index ()
+  (save-excursion
+    (goto-char (point-min))
+    (let ((match nil)
+          (headers nil))
+      (while (setq match (text-property-search-forward 'gemini-heading t t))
+        (push (cons
+               (buffer-substring-no-properties (prop-match-beginning match)
+                                               (prop-match-end match))
+               (prop-match-beginning match))
+              headers))
+      (reverse headers))))
 
 ;; Finger page connection
 
@@ -2391,12 +2400,11 @@ When run interactively HOST-OR-URL is read from the minibuffer."
 This mode is automatically enabled by the interactive
 functions which initialize the client, namely
 `elpher', and `elpher-go'."
-  (setq-local elpher--gemini-page-headings nil)
   (setq-local elpher-current-page nil)
   (setq-local elpher-history nil)
   (setq-local elpher-buffer-name (buffer-name))
   (setq-local bookmark-make-record-function #'elpher-bookmark-make-record)
-  (setq-local imenu-create-index-function (lambda () elpher--gemini-page-headings))
+  (setq-local imenu-create-index-function #'elpher-build-current-imenu-index)
   (setq-local xterm-color-preserve-properties t))
 
 (when (fboundp 'evil-set-initial-state)