Merge branch 'master' into bookmarks-history
[elpher.git] / elpher.el
index 40e21dc..c6b94ad 100644 (file)
--- a/elpher.el
+++ b/elpher.el
@@ -4,7 +4,7 @@
 
 ;; Author: Tim Vaughan <plugd@thelambdalab.xyz>
 ;; Created: 11 April 2019
-;; Version: 2.10.0
+;; Version: 2.10.2
 ;; Keywords: comm gopher
 ;; Homepage: http://thelambdalab.xyz/elpher
 ;; Package-Requires: ((emacs "26.2"))
@@ -71,7 +71,7 @@
 ;;; Global constants
 ;;
 
-(defconst elpher-version "2.10.0"
+(defconst elpher-version "2.10.2"
   "Current version of elpher.")
 
 (defconst elpher-margin-width 6
@@ -209,7 +209,7 @@ some servers which do not support IPv6 can take a long time to time-out."
   "Face used for html type directory records.")
 
 (defface elpher-gemini
-  '((t :inherit font-lock-regexp-grouping-backslash))
+  '((t :inherit font-lock-constant-face))
   "Face used for Gemini type directory records.")
 
 (defface elpher-other-url
@@ -280,8 +280,8 @@ some servers which do not support IPv6 can take a long time to time-out."
                 (setf (url-host url) (url-filename url))
                 (setf (url-filename url) ""))
               (when (or (equal (url-filename url) "")
-                        (equal (url-filename url) "/"))
-                (setf (url-filename url) "/1")))
+                        (equal (url-filename url) "/1"))
+                (setf (url-filename url) "/")))
             (when (equal "gemini" (url-type url))
               ;; Gemini defaults
               (if (equal (url-filename url) "")
@@ -403,6 +403,17 @@ If no address is defined, returns 0.  (This is for compatibility with the URL li
 
 ;; Cache
 
+;; We use the following pair of hashmaps to form the cache: one
+;; for the content (rendered server responses), and one for the
+;; position of point within the content.
+;;
+;; The keys for both of these hashmaps are the page addresses, and
+;; the cache persists for as long as the emacs session.
+;;
+;; Whether or not to use cached content is a decision made by the
+;; specific renderer.  Some renderers, such as elpher-render-download,
+;; never cache.
+
 (defvar elpher-content-cache (make-hash-table :test 'equal))
 (defvar elpher-pos-cache (make-hash-table :test 'equal))
 
@@ -425,6 +436,11 @@ If no address is defined, returns 0.  (This is for compatibility with the URL li
 
 ;; Page
 
+;; In our model, a "page" merely represents a combination of a
+;; display string and an elpher address.  The distinction exists
+;; because caching, server response acquisition, etc deal only
+;; with addresses.
+
 (defun elpher-make-page (display-string address)
   "Create a page with DISPLAY-STRING and ADDRESS."
   (list display-string address))
@@ -510,7 +526,7 @@ unless NO-HISTORY is non-nil."
                                           '("gophers" "gemini")))
                              " [TLS encryption]"
                            ""))
-             (header (concat display-string
+             (header (concat (replace-regexp-in-string "%" "%%" display-string)
                              (propertize tls-string 'face 'bold))))
         (setq header-line-format header))))
 
@@ -804,6 +820,8 @@ base for the installed key and certificate files."
 
 (defun elpher-list-existing-certificates ()
   "Return a list of the persistent certificates in `elpher-certificate-directory'."
+  (unless (file-directory-p elpher-certificate-directory)
+    (make-directory elpher-certificate-directory))
   (mapcar
    (lambda (file)
      (file-name-sans-extension file))
@@ -1363,17 +1381,20 @@ treatment that a separate function is warranted."
 The gemini map file line describing the header is given
 by HEADER-LINE."
   (when (string-match "^\\(#+\\)[ \t]*" header-line)
-    (let ((level (length (match-string 1 header-line)))
-          (header (substring header-line (match-end 0))))
+    (let* ((level (length (match-string 1 header-line)))
+           (header (substring header-line (match-end 0)))
+          (face (pcase level
+                   (1 'elpher-gemini-heading1)
+                   (2 'elpher-gemini-heading2)
+                   (3 'elpher-gemini-heading3)
+                   (_ 'default)))
+          (fill-column (/ (* fill-column
+                             (font-get (font-spec :name (face-font 'default)) :size))
+                          (font-get (font-spec :name (face-font face)) :size))))
       (unless (display-graphic-p)
         (insert (make-string level ?#) " "))
-      (insert (propertize header 'face
-                          (pcase level
-                            (1 'elpher-gemini-heading1)
-                            (2 'elpher-gemini-heading2)
-                            (3 'elpher-gemini-heading3)
-                            (_ 'default)))
-              "\n"))))
+      (insert (propertize header 'face face))
+      (newline))))
 
 (defun elpher-gemini-insert-text (text-line)
   "Insert a plain non-preformatted TEXT-LINE into a text/gemini document.
@@ -1553,22 +1574,101 @@ The result is rendered using RENDERER."
             'face 'shadow))
    (elpher-restore-pos)))
 
+
 ;; Bookmarks page page retrieval
 
+(defvar elpher-bookmark-group-status (make-hash-table :test 'equal))
+
+(defun elpher-make-bookmark-group-status (group-path)
+  (let ((existing (gethash group-path elpher-bookmark-group-status)))
+    (unless existing
+      (puthash group-path (list nil nil nil) elpher-bookmark-group-status))))
+
+(defun elpher-bookmark-group-start (group-path)
+    (car (gethash group-path elpher-bookmark-group-status)))
+
+(defun elpher-bookmark-group-end (group-path)
+    (cadr (gethash group-path elpher-bookmark-group-status)))
+
+(defun elpher-bookmark-group-expanded-p (group-path)
+    (caddr (gethash group-path elpher-bookmark-group-status)))
+
+(defun elpher-bookmark-group-expanded-toggle (group-path)
+  (setcar (cddr (gethash group-path elpher-bookmark-group-status))
+          (not (elpher-bookmark-group-expanded-p group-path))))
+
+(defun elpher--bookmark-indent (group-path)
+  (insert (make-string (+ 1 (* 2 (length group-path))) ?\s)))
+
+(defun elpher--bookmark-group-starts-here (group-path)
+  (setcar (gethash group-path elpher-bookmark-group-status) (point)))
+
+(defun elpher--bookmark-group-ends-here (group-path)
+  (setcar (cdr (gethash group-path elpher-bookmark-group-status)) (point)))
+
+(defun elpher--update-bookmark-group-visibility (group-path)
+  (let ((start (elpher-bookmark-group-start group-path))
+        (end (elpher-bookmark-group-end group-path))
+        (inhibit-read-only t))
+    (put-text-property start end 'invisible
+                       (not (elpher-bookmark-group-expanded-p group-path)))))
+
+(defun elpher--expand-or-collapse-bookmark-group (button)
+  (let ((group-path (button-get button 'elpher-bookmark-group-path)))
+    (elpher-bookmark-group-expanded-toggle group-path)
+    (elpher--update-bookmark-group-visibility group-path)))
+    
+(defun elpher--insert-bookmark (bookmark &optional group-path)
+  (let* ((display-string (elpher-bookmark-display-string bookmark))
+         (address (elpher-address-from-url (elpher-bookmark-url bookmark)))
+         (type (if address (elpher-address-type address) nil))
+         (type-map-entry (cdr (assoc type elpher-type-map))))
+    (if type-map-entry
+        (let* ((face (elt type-map-entry 3))
+               (filtered-display-string (ansi-color-filter-apply display-string))
+               (page (elpher-make-page filtered-display-string address)))
+          (insert-text-button filtered-display-string
+                              'face face
+                              'elpher-page page
+                              'action #'elpher-click-link
+                              'follow-link t
+                              'help-echo #'elpher--page-button-help))
+      (insert (propertize display-string 'face 'elpher-unknown)))
+    (insert "\n")))
+
+(defun elpher--insert-bookmark-group (group-entries &optional group-path)
+  (if group-entries
+      (dolist (entry group-entries)
+        (elpher--bookmark-indent group-path)
+        (if (elpher-bookmark-p entry)
+            (elpher--insert-bookmark entry group-path)
+          (let* ((subgroup-name (elpher-bookmark-group-name entry))
+                 (subgroup-entries (elpher-bookmark-group-entries entry))
+                 (subgroup-path (cons subgroup-name group-path)))
+            (elpher-make-bookmark-group-status subgroup-path)
+            (insert-text-button subgroup-name
+                                'action #'elpher--expand-or-collapse-bookmark-group
+                                'elpher-bookmark-group-path subgroup-path
+                                'follow-link t
+                                'help-echo "Expand or collapse group.")
+            (insert "\n")
+            (elpher--bookmark-group-starts-here subgroup-path)
+            (elpher--insert-bookmark-group subgroup-entries subgroup-path)
+            (elpher--bookmark-group-ends-here subgroup-path)
+            (elpher--update-bookmark-group-visibility subgroup-path))))
+    (elpher--bookmark-indent group-path)
+    (insert "No bookmarks found.\n")))
+
 (defun elpher-get-bookmarks-page (renderer)
   "Getter to load and display the current bookmark list (RENDERER must be nil)."
   (when renderer
     (elpher-visit-previous-page)
     (error "Command not supported for bookmarks page"))
   (elpher-with-clean-buffer
+   ;; (setq buffer-invisibility-spec '((expanded . t)))
    (insert "---- Bookmark list ----\n\n")
    (let ((bookmarks (elpher-load-bookmarks)))
-     (if bookmarks
-         (dolist (bookmark bookmarks)
-           (let ((display-string (elpher-bookmark-display-string bookmark))
-                 (address (elpher-address-from-url (elpher-bookmark-url bookmark))))
-             (elpher-insert-index-record display-string address)))
-       (insert "No bookmarks found.\n")))
+     (elpher--insert-bookmark-group bookmarks))
    (insert "\n-----------------------\n"
            "\n"
            "- u: return to previous page\n"
@@ -1586,6 +1686,13 @@ The result is rendered using RENDERER."
                          'follow-link t
                          'help-echo help-string))
    (insert "\n")
+   (insert "\n--- Recently visited ---\n\n")
+   (maphash (lambda (address _)
+              (unless (elpher-address-special-p address)
+                (let ((url (elpher-address-to-url address)))
+                  (elpher--insert-bookmark (elpher-make-bookmark url url)))))
+            elpher-content-cache)
+   (insert "\n------------------------\n")
    (elpher-restore-pos)))
   
 
@@ -1597,7 +1704,7 @@ The result is rendered using RENDERER."
 DISPLAY-STRING determines how the bookmark will appear in the
 bookmark list, while URL is the url of the entry."
   (list display-string url))
-  
+
 (defun elpher-bookmark-display-string (bookmark)
   "Get the display string of BOOKMARK."
   (elt bookmark 0))
@@ -1610,6 +1717,28 @@ bookmark list, while URL is the url of the entry."
   "Get the address for BOOKMARK."
   (elt bookmark 1))
 
+(defun elpher-bookmark-p (entry)
+  "Determine if entry describes a bookmark.
+Otherwise, it will be treated as a bookmark group."
+  (and (listp entry)
+       (= (length entry) 2)
+       (stringp (cadr entry))))
+
+(defun elpher-make-bookmark-group (group-name &optional bookmarks)
+  "Make an elpher bookmark group.
+GROUP-NAME is the name of the group.  If non-nil, BOOKMARKS is a
+list of one or more bookmarks or subgroups to appear within this
+group."
+  (cons diplay-string bookmarks))
+
+(defun elpher-bookmark-group-name (group)
+  "Returns the name of bookmark group GROUP."
+  (car group))
+
+(defun elpher-bookmark-group-entries (group)
+  "Returns the entries held in bookmark group GROUP."
+  (cdr group))
+
 (defun elpher-save-bookmarks (bookmarks)
   "Record the bookmark list BOOKMARKS to the user's bookmark file.
 Beware that this completely replaces the existing contents of the file."
@@ -1629,15 +1758,15 @@ Beware that this completely replaces the existing contents of the file."
              (insert-file-contents elpher-bookmarks-file)
              (goto-char (point-min))
              (read (current-buffer))))))
-    (if (and bookmarks (listp (cadar bookmarks)))
-        (progn
-          (message "Reading old bookmark file. (Will be updated on write.)")
-          (mapcar (lambda (old-bm)
-                    (list (car old-bm)
-                          (elpher-address-to-url (apply #'elpher-make-gopher-address
-                                                        (cadr old-bm)))))
-                  bookmarks))
-      bookmarks)))
+    ;; (if (and bookmarks (listp (cadar bookmarks)))
+    ;;     (progn
+    ;;       (message "Reading old bookmark file. (Will be updated on write.)")
+    ;;       (mapcar (lambda (old-bm)
+    ;;                 (list (car old-bm)
+    ;;                       (elpher-address-to-url (apply #'elpher-make-gopher-address
+    ;;                                                     (cadr old-bm)))))
+    ;;               bookmarks))
+      bookmarks))
 
 (defun elpher-add-address-bookmark (address display-string)
   "Save a bookmark for ADDRESS with label DISPLAY-STRING.)))
@@ -1664,12 +1793,18 @@ If ADDRESS is already bookmarked, update the label only."
 (defun elpher-next-link ()
   "Move point to the next link on the current page."
   (interactive)
-  (forward-button 1))
+  (while
+      (let ((next-button (forward-button 1)))
+        (or (not next-button)
+            (button-get next-button 'invisible)))))
 
 (defun elpher-prev-link ()
   "Move point to the previous link on the current page."
   (interactive)
-  (backward-button 1))
+  (while
+      (let ((prev-button (backward-button 1)))
+        (or (not prev-button)
+            (button-get prev-button 'invisible)))))
 
 (defun elpher-follow-current-link ()
   "Open the link or url at point."
@@ -1881,7 +2016,10 @@ When run interactively HOST-OR-URL is read from the minibuffer."
   (interactive)
   (let ((button (button-at (point))))
     (if button
-        (elpher-info-page (button-get button 'elpher-page))
+        (let ((page (button-get button 'elpher-page)))
+          (if page
+              (elpher-info-page (button-get button 'elpher-page))
+            (error "Not an Elpher page")))
       (error "No item selected"))))
   
 (defun elpher-info-current ()