Add IRI support

[elpher.git] / elpher.el

diff --git a/elpher.el b/elpher.el
index 1178bfc..925afa3 100644 (file)
--- a/elpher.el
+++ b/elpher.el
@@ -20,7 +20,7 @@
 
 ;; Author: Tim Vaughan <plugd@thelambdalab.xyz>
 ;; Created: 11 April 2019
-;; Version: 3.2.1
+;; Version: 3.2.2
 ;; Keywords: comm gopher
 ;; Homepage: https://thelambdalab.xyz/elpher
 ;; Package-Requires: ((emacs "27.1"))
@@ -85,7 +85,7 @@
 ;;; Global constants
 ;;
 
-(defconst elpher-version "3.2.1"
+(defconst elpher-version "3.2.2"
   "Current version of elpher.")
 
 (defconst elpher-margin-width 6
@@ -225,7 +225,7 @@ Otherwise, \\[elpher-show-bookmarks] will visit a special elpher bookmark
 page within which all of the standard elpher keybindings are active."
   :type '(boolean))
 
-(defcustom elpher-start-page "about:welcome"
+(defcustom elpher-start-page-url "about:welcome"
   "Specify the page displayed initially by elpher.
 The default welcome screen is \"about:welcome\", while the bookmarks list
 is \"about:bookmarks\".  You can also specify local files via \"file:\".
@@ -332,7 +332,7 @@ the start page."
           (unless (and (not (url-fullness url)) (url-type url))
             (setf (url-fullness url) t)
             (unless (url-type url)
-              (setf (url-type url) elpher-default-url-type))
+              (setf (url-type url) (elpher-get-default-url-type)))
             (unless (url-host url)
               (let ((p (split-string (url-filename url) "/" nil nil)))
                 (setf (url-host url) (car p))
@@ -353,6 +353,18 @@ the start page."
           (elpher-remove-redundant-ports url))
       (set-match-data data))))
 
+(defun elpher-get-default-url-type ()
+  "Get the current URL type or `elpher-default-url-type'.
+If no scheme is provided for a URL, the current context specifies
+the scheme to use, so if we're looking at a gemini page, then the
+default type is \"gemini\" even if `elpher-default-url-type' is
+\"gopher\"."
+  (or (and elpher-current-page
+          (symbol-name
+           (elpher-address-type
+            (elpher-page-address elpher-current-page))))
+      elpher-default-url-type))
+
 (defun elpher-remove-redundant-ports (address)
   "Remove redundant port specifiers from ADDRESS.
 Here 'redundant' means that the specified port matches the default
@@ -482,9 +494,9 @@ If no address is defined, returns 0.  (This is for compatibility with the URL li
   (list display-string address))
 
 (defun elpher-make-start-page ()
-  "Create the welcome page."
+  "Create the start page."
   (elpher-make-page "Start Page"
-                    (elpher-address-from-url elpher-start-page)))
+                    (elpher-address-from-url elpher-start-page-url)))
 
 (defun elpher-page-display-string (page)
   "Retrieve the display string corresponding to PAGE."
@@ -502,9 +514,32 @@ If no address is defined, returns 0.  (This is for compatibility with the URL li
   "Create a page with address and display string defined by URL.
 The URL is unhexed prior to its use as a display string to improve
 readability."
-  (elpher-make-page (elpher-decode (url-unhex-string url))
+  (elpher-make-page (elpher-url-to-iri url)
                     (elpher-address-from-url url)))
 
+(defun elpher-url-to-iri (url)
+  "Return an IRI for URL.
+Decode percent-escapes and handle punycode in the domain name.
+Drop the password, if any."
+  (let* ((address (elpher-address-from-url (elpher-decode (url-unhex-string url))))
+        (host (url-host address))
+        (pass (url-password address)))
+    (when host
+      (setf (url-host address) (puny-decode-domain host)))
+    (when pass                          ; RFC 3986 says we should not render
+      (setf (url-password address) nil)) ; the password as clear text
+    (url-recreate-url address)))
+
+(defun elpher-encode-url (iri)
+  "Return an URL for the IRI.
+Encode and use percent-escapes, use punycode for the domain name
+if necessary."
+  (let* ((address (url-generic-parse-url iri))
+        (host (url-host address)))
+    (when host
+      (setf (url-host address) (puny-encode-domain host)))
+    (url-recreate-url address)))
+
 (defvar elpher-current-page nil
   "The current page for this Elpher buffer.")
 
@@ -582,7 +617,7 @@ previously-visited pages,unless NO-HISTORY is non-nil."
 
 (defun elpher-update-header ()
   "If `elpher-use-header' is true, display current page info in window header."
-  (if elpher-use-header
+  (if (and elpher-use-header elpher-current-page)
       (let* ((display-string (elpher-page-display-string elpher-current-page))
              (sanitized-display-string (replace-regexp-in-string "%" "%%" display-string))
              (address (elpher-page-address elpher-current-page))
@@ -1053,9 +1088,7 @@ displayed.  The _WINDOW argument is currently unused."
       (when button
         (let* ((page (button-get button 'elpher-page))
                (address (elpher-page-address page)))
-          (format "mouse-1, RET: open '%s'" (if (elpher-address-about-p address)
-                                                address
-                                              (elpher-address-to-url address))))))))
+          (format "mouse-1, RET: open '%s'" (elpher-address-to-url address)))))))
 
 (defun elpher-insert-index-record (display-string &optional address)
   "Function to insert an index record into the current buffer.
@@ -1418,7 +1451,7 @@ Returns nil in the event that the contents of the line following the
 => prefix are empty."
   (let ((l (split-string (substring link-line 2))))
     (if l
-        (string-trim (elt l 0))
+        (elpher-encode-url (string-trim (elt l 0)))
       nil)))
 
 (defun elpher-gemini-get-link-display-string (link-line)
@@ -1428,7 +1461,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-url-to-iri rest)))))
 
 (defun elpher-collapse-dot-sequences (filename)
   "Collapse dot sequences in FILENAME.
@@ -1721,11 +1754,12 @@ Assumes UTF-8 encoding for all text files."
    (let ((help-string "RET,mouse-1: Open bookmark list"))
      (insert-text-button "bookmark list"
                          'face 'link
-                         'action (lambda (_)
-                                   (interactive)
-                                   (call-interactively #'elpher-show-bookmarks))
+                         'action #'elpher-click-link
                          'follow-link t
-                         'help-echo help-string))
+                         'help-echo #'elpher--page-button-help
+                         'elpher-page
+                         (elpher-make-page "Elpher Bookmarks"
+                                           (elpher-make-about-address 'bookmarks))))
    (insert ".\n")
    (insert (propertize
             "(Bookmarks from legacy elpher-bookmarks files will be automatically imported.)\n"