Added transfer progress feedback.

[elpher.git] / elpher.el

diff --git a/elpher.el b/elpher.el
index f1fe8ea..b5373f4 100644 (file)
--- a/elpher.el
+++ b/elpher.el
@@ -2,9 +2,9 @@
 
 ;; Copyright (C) 2019 Tim Vaughan
 
 
 ;; Copyright (C) 2019 Tim Vaughan
 

-;; Author: Tim Vaughan <timv@ughan.xyz>
+;; Author: Tim Vaughan <plugd@thelambdalab.xyz>

 ;; Created: 11 April 2019
 ;; Created: 11 April 2019

-;; Version: 2.7.0
+;; Version: 2.7.4

 ;; Keywords: comm gopher
 ;; Homepage: http://thelambdalab.xyz/elpher
 ;; Package-Requires: ((emacs "26"))
 ;; Keywords: comm gopher
 ;; Homepage: http://thelambdalab.xyz/elpher
 ;; Package-Requires: ((emacs "26"))


@@ -70,7 +70,7 @@
 ;;; Global constants
 ;;
 
 ;;; Global constants
 ;;
 

-(defconst elpher-version "2.7.0"
+(defconst elpher-version "2.7.4"

   "Current version of elpher.")
 
 (defconst elpher-margin-width 6
   "Current version of elpher.")
 
 (defconst elpher-margin-width 6


@@ -148,6 +148,10 @@ The actual width used is the minimum of this value and the window width at
 the time when the text is rendered."
   :type '(integer))
 
 the time when the text is rendered."
   :type '(integer))
 

+(defcustom elpher-bookmarks-file (locate-user-emacs-file "elpher-bookmarks")
+  "Specify the name of the file where elpher bookmarks will be saved."
+  :type '(file))
+

 ;; Face customizations
 
 (defgroup elpher-faces nil
 ;; Face customizations
 
 (defgroup elpher-faces nil


@@ -208,15 +212,15 @@ the time when the text is rendered."
 
 (defface elpher-gemini-heading1
   '((t :inherit bold :height 1.8))
 
 (defface elpher-gemini-heading1
   '((t :inherit bold :height 1.8))

-  "Face used for brackets around directory margin key.")
+  "Face used for gemini heading level 1.")

 
 (defface elpher-gemini-heading2
   '((t :inherit bold :height 1.5))
 
 (defface elpher-gemini-heading2
   '((t :inherit bold :height 1.5))

-  "Face used for brackets around directory margin key.")
+  "Face used for gemini heading level 2.")

 
 (defface elpher-gemini-heading3
   '((t :inherit bold :height 1.2))
 
 (defface elpher-gemini-heading3
   '((t :inherit bold :height 1.2))

-  "Face used for brackets around directory margin key.")
+  "Face used for gemini heading level 3.")

 
 ;;; Model
 ;;
 
 ;;; Model
 ;;


@@ -388,6 +392,10 @@ If no address is defined, returns 0.  (This is for compatibility with the URL li
   "Retrieve the address corresponding to PAGE."
   (elt page 1))
 
   "Retrieve the address corresponding to PAGE."
   (elt page 1))
 

+(defun elpher-page-set-address (page new-address)
+  "Set the address corresponding to PAGE to NEW-ADDRESS."
+  (setcar (cdr page) new-address))
+

 (defvar elpher-current-page nil)
 (defvar elpher-history nil)
 
 (defvar elpher-current-page nil)
 (defvar elpher-history nil)
 


@@ -541,6 +549,8 @@ to ADDRESS."
              (port (elpher-address-port address))
              (host (elpher-address-host address))
              (selector-string-parts nil)
              (port (elpher-address-port address))
              (host (elpher-address-host address))
              (selector-string-parts nil)

+             (bytes-received 0)
+             (hkbytes-received 0)

              (proc (open-network-stream "elpher-process"
                                         nil
                                         (if force-ipv4 (dns-query host) host)
              (proc (open-network-stream "elpher-process"
                                         nil
                                         (if force-ipv4 (dns-query host) host)


@@ -571,7 +581,21 @@ to ADDRESS."
         (set-process-coding-system proc 'binary)
         (set-process-filter proc
                             (lambda (_proc string)
         (set-process-coding-system proc 'binary)
         (set-process-filter proc
                             (lambda (_proc string)

-                              (cancel-timer timer)
+                              (when timer
+                                (cancel-timer timer)
+                                (setq timer nil))
+                              (setq bytes-received (+ bytes-received (length string)))
+                              (let ((new-hkbytes-received (/ bytes-received 102400)))
+                                (when (> new-hkbytes-received hkbytes-received)
+                                  (setq hkbytes-received new-hkbytes-received)
+                                  (with-current-buffer "*elpher*"
+                                    (let ((inhibit-read-only t))
+                                      (goto-char (point-min))
+                                      (beginning-of-line 2)
+                                      (delete-region (point) (point-max))
+                                      (insert "("
+                                              (number-to-string (/ hkbytes-received 10.0))
+                                              " MB read)")))))

                               (setq selector-string-parts
                                     (cons string selector-string-parts))))
         (set-process-sentinel proc
                               (setq selector-string-parts
                                     (cons string selector-string-parts))))
         (set-process-sentinel proc


@@ -586,7 +610,9 @@ to ADDRESS."
                                          (concat (elpher-gopher-address-selector address)
                                                  "\r\n"))))
                                      (t
                                          (concat (elpher-gopher-address-selector address)
                                                  "\r\n"))))
                                      (t

-                                      (cancel-timer timer)
+                                      (when timer
+                                        (cancel-timer timer)
+                                        (setq timer nil))

                                       (funcall renderer (apply #'concat
                                                                (reverse selector-string-parts)))
                                       (elpher-restore-pos)))
                                       (funcall renderer (apply #'concat
                                                                (reverse selector-string-parts)))
                                       (elpher-restore-pos)))


@@ -606,7 +632,7 @@ once they are retrieved from the gopher server."
          (insert content)
          (elpher-restore-pos))
       (elpher-with-clean-buffer
          (insert content)
          (elpher-restore-pos))
       (elpher-with-clean-buffer

-       (insert "LOADING... (use 'u' to cancel)"))
+       (insert "LOADING... (use 'u' to cancel)\n"))

       (condition-case the-error
           (elpher-get-selector address renderer)
         (error
       (condition-case the-error
           (elpher-get-selector address renderer)
         (error


@@ -805,7 +831,9 @@ The response is rendered using the rendering function RENDERER."
   (if (not data)
       nil
     (let* ((address (elpher-page-address elpher-current-page))
   (if (not data)
       nil
     (let* ((address (elpher-page-address elpher-current-page))

-           (selector (elpher-gopher-address-selector address)))
+           (selector (if (elpher-address-gopher-p address)
+                         (elpher-gopher-address-selector address)
+                       (elpher-address-filename address))))

       (elpher-visit-previous-page) ; Do first in case of non-local exits.
       (let* ((filename-proposal (file-name-nondirectory selector))
              (filename (read-file-name "Download complete. Save file as: "
       (elpher-visit-previous-page) ; Do first in case of non-local exits.
       (let* ((filename-proposal (file-name-nondirectory selector))
              (filename (read-file-name "Download complete. Save file as: "


@@ -849,6 +877,8 @@ to ADDRESS."
                (port (elpher-address-port address))
                (host (elpher-address-host address))
                (response-string-parts nil)
                (port (elpher-address-port address))
                (host (elpher-address-host address))
                (response-string-parts nil)

+               (bytes-received 0)
+               (hkbytes-received 0)

                (proc (open-network-stream "elpher-process"
                                           nil
                                           (if force-ipv4 (dns-query host) host)
                (proc (open-network-stream "elpher-process"
                                           nil
                                           (if force-ipv4 (dns-query host) host)


@@ -869,6 +899,18 @@ to ADDRESS."
                                 (when timer
                                   (cancel-timer timer)
                                   (setq timer nil))
                                 (when timer
                                   (cancel-timer timer)
                                   (setq timer nil))

+                                (setq bytes-received (+ bytes-received (length string)))
+                                (let ((new-hkbytes-received (/ bytes-received 102400)))
+                                  (when (> new-hkbytes-received hkbytes-received)
+                                    (setq hkbytes-received new-hkbytes-received)
+                                    (with-current-buffer "*elpher*"
+                                      (let ((inhibit-read-only t))
+                                        (goto-char (point-min))
+                                        (beginning-of-line 2)
+                                        (delete-region (point) (point-max))
+                                        (insert "("
+                                                (number-to-string (/ hkbytes-received 10.0))
+                                                " MB read)")))))

                                 (setq response-string-parts
                                       (cons string response-string-parts))))
           (set-process-sentinel proc
                                 (setq response-string-parts
                                       (cons string response-string-parts))))
           (set-process-sentinel proc


@@ -894,7 +936,7 @@ to ADDRESS."
                                                  renderer)
                                         (elpher-restore-pos)))
                                     (error
                                                  renderer)
                                         (elpher-restore-pos)))
                                     (error

-                                           (elpher-network-error address the-error))))))
+                                     (elpher-network-error address the-error))))))

       (error
        (error "Error initiating connection to server")))))
 
       (error
        (error "Error initiating connection to server")))))
 


@@ -940,6 +982,7 @@ that the response was malformed."
                              "gemini"))
                (error "Server tried to automatically redirect to non-gemini URL: %s"
                       response-meta))
                              "gemini"))
                (error "Server tried to automatically redirect to non-gemini URL: %s"
                       response-meta))

+           (elpher-page-set-address elpher-current-page redirect-address)

            (add-to-list 'elpher-gemini-redirect-chain redirect-address)
            (elpher-get-gemini-response redirect-address renderer)))
         (?4 ; Temporary failure
            (add-to-list 'elpher-gemini-redirect-chain redirect-address)
            (elpher-get-gemini-response redirect-address renderer)))
         (?4 ; Temporary failure


@@ -964,7 +1007,7 @@ that the response was malformed."
               (insert content)
               (elpher-restore-pos))
           (elpher-with-clean-buffer
               (insert content)
               (elpher-restore-pos))
           (elpher-with-clean-buffer

-           (insert "LOADING GEMINI... (use 'u' to cancel)"))
+           (insert "LOADING GEMINI... (use 'u' to cancel)\n"))

           (setq elpher-gemini-redirect-chain nil)
           (elpher-get-gemini-response address renderer))
       (error
           (setq elpher-gemini-redirect-chain nil)
           (elpher-get-gemini-response address renderer))
       (error


@@ -1005,17 +1048,23 @@ that the response was malformed."
         (_other
          (error "Unsupported MIME type %S" mime-type))))))
 
         (_other
          (error "Unsupported MIME type %S" mime-type))))))
 

-(defun elpher-gemini-get-link-url (line)
-  "Extract the url portion of LINE, a gemini map file link line."
-  (string-trim (elt (split-string (substring line 2)) 0)))
-
-(defun elpher-gemini-get-link-display-string (line)
-  "Extract the display string portion of LINE, a gemini map file link line."
-  (let* ((rest (string-trim (elt (split-string line "=>") 1)))
+(defun elpher-gemini-get-link-url (link-line)
+  "Extract the url portion of LINK-LINE, a gemini map file link line.
+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))
+      nil)))
+
+(defun elpher-gemini-get-link-display-string (link-line)
+  "Extract the display string portion of LINK-LINE, a gemini map file link line.
+Returns the url portion in the event that the display-string portion is empty."
+  (let* ((rest (string-trim (elt (split-string link-line "=>") 1)))

          (idx (string-match "[ \t]" rest)))
          (idx (string-match "[ \t]" rest)))

-    (if idx
-        (string-trim (substring rest (+ idx 1)))
-      "")))
+    (string-trim (if idx
+                     (substring rest (+ idx 1))
+                   rest))))

 
 (defun elpher-collapse-dot-sequences (filename)
   "Collapse dot sequences in FILENAME.
 
 (defun elpher-collapse-dot-sequences (filename)
   "Collapse dot sequences in FILENAME.


@@ -1054,24 +1103,24 @@ For instance, the filename /a/b/../c/./d will reduce to /a/c/d"
 (defun elpher-gemini-insert-link (link-line)
   "Insert link described by LINK-LINE into a text/gemini document."
   (let* ((url (elpher-gemini-get-link-url link-line))
 (defun elpher-gemini-insert-link (link-line)
   "Insert link described by LINK-LINE into a text/gemini document."
   (let* ((url (elpher-gemini-get-link-url link-line))

-         (display-string (let ((s (elpher-gemini-get-link-display-string link-line)))
-                           (if (string-empty-p s) url s)))
+         (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))))
          (address (elpher-address-from-gemini-url url))
          (type (if address (elpher-address-type address) nil))
          (type-map-entry (cdr (assoc type elpher-type-map))))

-    (insert "→ ")
-    (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 page)))
-      (insert (propertize display-string 'face 'elpher-unknown)))
-    (insert "\n")))
+    (when display-string
+      (insert "→ ")
+      (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 page)))
+        (insert (propertize display-string 'face 'elpher-unknown)))
+      (insert "\n"))))

   
 (defun elpher-gemini-insert-header (header-line)
   "Insert header described by HEADER-LINE into a text/gemini document.
   
 (defun elpher-gemini-insert-header (header-line)
   "Insert header described by HEADER-LINE into a text/gemini document.


@@ -1126,7 +1175,7 @@ by HEADER-LINE."
          (insert content)
          (elpher-restore-pos))
       (elpher-with-clean-buffer
          (insert content)
          (elpher-restore-pos))
       (elpher-with-clean-buffer

-       (insert "LOADING... (use 'u' to cancel)"))
+       (insert "LOADING... (use 'u' to cancel)\n"))

       (condition-case the-error
           (let* ((kill-buffer-query-functions nil)
                  (user (let ((filename (elpher-address-filename address)))
       (condition-case the-error
           (let* ((kill-buffer-query-functions nil)
                  (user (let ((filename (elpher-address-filename address)))


@@ -1156,7 +1205,9 @@ by HEADER-LINE."
             (set-process-coding-system proc 'binary)
             (set-process-filter proc
                                 (lambda (_proc string)
             (set-process-coding-system proc 'binary)
             (set-process-filter proc
                                 (lambda (_proc string)

-                                  (cancel-timer timer)
+                                  (when timer
+                                    (cancel-timer timer)
+                                    (setq timer nil))

                                   (setq selector-string-parts
                                         (cons string selector-string-parts))))
             (set-process-sentinel proc
                                   (setq selector-string-parts
                                         (cons string selector-string-parts))))
             (set-process-sentinel proc


@@ -1170,7 +1221,9 @@ by HEADER-LINE."
                                              proc
                                              (concat user "\r\n"))))
                                          (t
                                              proc
                                              (concat user "\r\n"))))
                                          (t

-                                          (cancel-timer timer)
+                                          (when timer
+                                            (cancel-timer timer)
+                                            (setq timer nil))

                                           (funcall renderer (apply #'concat
                                                                    (reverse selector-string-parts)))
                                           (elpher-restore-pos)))))))
                                           (funcall renderer (apply #'concat
                                                                    (reverse selector-string-parts)))
                                           (elpher-restore-pos)))))))


@@ -1299,7 +1352,7 @@ by HEADER-LINE."
            "- a: rename selected bookmark\n"
            "\n"
            "Bookmarks are stored in the file ")
            "- a: rename selected bookmark\n"
            "\n"
            "Bookmarks are stored in the file ")

-   (let ((filename (locate-user-emacs-file "elpher-bookmarks"))
+   (let ((filename elpher-bookmarks-file)

          (help-string "RET,mouse-1: Open bookmarks file in new buffer for editing."))
      (insert-text-button filename
                          'face 'link
          (help-string "RET,mouse-1: Open bookmarks file in new buffer for editing."))
      (insert-text-button filename
                          'face 'link


@@ -1336,7 +1389,7 @@ bookmark list, while URL is the url of the entry."
 (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."
 (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."

-  (with-temp-file (locate-user-emacs-file "elpher-bookmarks")
+  (with-temp-file elpher-bookmarks-file

     (erase-buffer)
     (insert "; Elpher bookmarks file\n\n"
             "; Bookmarks are stored as a list of (label URL) items.\n"
     (erase-buffer)
     (insert "; Elpher bookmarks file\n\n"
             "; Bookmarks are stored as a list of (label URL) items.\n"


@@ -1349,7 +1402,7 @@ Beware that this completely replaces the existing contents of the file."
   (let ((bookmarks
          (with-temp-buffer
            (ignore-errors
   (let ((bookmarks
          (with-temp-buffer
            (ignore-errors

-             (insert-file-contents (locate-user-emacs-file "elpher-bookmarks"))
+             (insert-file-contents elpher-bookmarks-file)

              (goto-char (point-min))
              (read (current-buffer))))))
     (if (and bookmarks (listp (cadar bookmarks)))
              (goto-char (point-min))
              (read (current-buffer))))))
     (if (and bookmarks (listp (cadar bookmarks)))