Updated start page with keys for new commands.
[elpher.git] / elpher.el
1 ;;; elpher.el --- Full-featured gopher client.
2
3 ;; Copyright (C) 2019 Tim Vaughan
4
5 ;; Author: Tim Vaughan <tgvaughan@gmail.com>
6 ;; Created: 11 April 2019
7 ;; Version: 1.1.0
8 ;; Keywords: comm gopher
9 ;; Homepage: https://github.com/tgvaughan/elpher
10 ;; Package-Requires: ((emacs "25"))
11
12 ;; This file is not part of GNU Emacs.
13
14 ;; This program is free software: you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
18
19 ;; This program is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
22 ;; GNU General Public License for more details.
23
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with this file.  If not, see <http://www.gnu.org/licenses/>.
26
27 ;;; Commentary:
28
29 ;; Elpher aims to provide a full-featured gopher client for GNU Emacs.
30 ;; It supports:
31
32 ;; - intuitive keyboard and mouse-driven interface,
33 ;; - caching of visited sites (both content and cursor position),
34 ;; - pleasant and configurable colouring of Gopher directories,
35 ;; - direct visualisation of image files,
36 ;; - (m)enu key support, similar to Emacs' info browser,
37 ;; - clickable web and gopher links in plain text.
38
39 ;; Visited pages are stored as a hierarchy rather than a linear history,
40 ;; meaning that navigation between these pages is quick and easy.
41
42 ;; To launch Elpher, simply use 'M-x elpher'.  This will open a start
43 ;; page containing information on key bindings and suggested starting
44 ;; points for your gopher exploration.
45
46 ;; Faces, caching options and start page can be configured via
47 ;; the Elpher customization group in Applications.
48
49 ;;; Code:
50
51 (provide 'elpher)
52 (require 'seq)
53 (require 'pp)
54
55 ;;; Global constants
56 ;;
57
58 (defconst elpher-version "1.1.0"
59   "Current version of elpher.")
60
61 (defconst elpher-margin-width 6
62   "Width of left-hand margin used when rendering indicies.")
63
64 (defconst elpher-start-index
65   (mapconcat
66    'identity
67    (list "i\tfake\tfake\t1"
68          "i     --------------------------------------------\tfake\tfake\t1"
69          "i                Elpher Gopher Client             \tfake\tfake\t1"
70          (format "i                   version %s\tfake\tfake\t1" elpher-version)
71          "i     --------------------------------------------\tfake\tfake\t1"
72          "i\tfake\tfake\t1"
73          "iUsage:\tfake\tfake\t1"
74          "i\tfake\tfake\t1"
75          "i - tab/shift-tab: next/prev item on current page\tfake\tfake\t1"
76          "i - RET/mouse-1: open item under cursor\tfake\tfake\t1"
77          "i - m: select an item on current page by name (autocompletes)\tfake\tfake\t1"
78          "i - u: return to parent\tfake\tfake\t1"
79          "i - O: visit the root menu of the current server\tfake\tfake\t1"
80          "i - g: go to a particular menu or item\tfake\tfake\t1"
81          "i - i/I: info on item under cursor or current page\tfake\tfake\t1"
82          "i - c/C: copy URL representation of item under cursor or current page\tfake\tfake\t1"
83          "i - a/A: bookmark the item under cursor or current page\tfake\tfake\t1"
84          "i - x/X: remove bookmark for item under cursor or current page\tfake\tfake\t1"
85          "i - B: visit the bookmarks page\tfake\tfake\t1"
86          "i - r: redraw current page (using cached contents if available)\tfake\tfake\t1"
87          "i - R: reload current page (regenerates cache)\tfake\tfake\t1"
88          "i - d: download directory entry under cursor\tfake\tfake\t1"
89          "i - w: display the raw server response for the current page\tfake\tfake\t1"
90          "i\tfake\tfake\t1"
91          "iWhere to start exploring Gopherspace:\tfake\tfake\t1"
92          "i\tfake\tfake\t1"
93          "1Floodgap Systems Gopher Server\t/\tgopher.floodgap.com\t70"
94          "i\tfake\tfake\t1"
95          "iAlternatively, select the following item and enter some\tfake\tfake\t1"
96          "isearch terms:\tfake\tfake\t1"
97          "i\tfake\tfake\t1"
98          "7Veronica-2 Gopher Search Engine\t/v2/vs\tgopher.floodgap.com\t70"
99          ".\r\n")
100    "\r\n")
101   "Source for elpher start page.")
102
103 (defconst elpher-type-map
104   '((?0 elpher-get-text-node "T" elpher-text)
105     (?1 elpher-get-index-node "/" elpher-index)
106     (?4 elpher-get-node-download "B" elpher-binary)
107     (?5 elpher-get-node-download "B" elpher-binary)
108     (?7 elpher-get-search-node "?" elpher-search)
109     (?8 elpher-get-telnet-node "?" elpher-telnet)
110     (?9 elpher-get-node-download "B" elpher-binary)
111     (?g elpher-get-image-node "im" elpher-image)
112     (?p elpher-get-image-node "im" elpher-image)
113     (?I elpher-get-image-node "im" elpher-image)
114     (?h elpher-get-url-node "W" elpher-url)
115     (bookmarks elpher-get-bookmarks-node "#" elpher-index)
116     (start elpher-get-start-node "#" elpher-index))
117   "Association list from types to getters, margin codes and index faces.")
118
119
120 ;;; Customization group
121 ;;
122
123 (defgroup elpher nil
124   "A gopher client."
125   :group 'applications)
126
127 ;; Face customizations
128
129 (defface elpher-index
130   '((t :inherit font-lock-keyword-face))
131   "Face used for directory type directory records.")
132
133 (defface elpher-text
134   '((t :inherit bold))
135   "Face used for text type directory records.")
136
137 (defface elpher-info
138   '((t :inherit default))
139   "Face used for info type directory records.")
140
141 (defface elpher-image
142   '((t :inherit font-lock-string-face))
143   "Face used for image type directory records.")
144
145 (defface elpher-search
146   '((t :inherit warning))
147   "Face used for search type directory records.")
148
149 (defface elpher-url
150   '((t :inherit font-lock-comment-face))
151   "Face used for url type directory records.")
152
153 (defface elpher-telnet
154   '((t :inherit font-lock-function-name-face))
155   "Face used for telnet type directory records.")
156
157 (defface elpher-binary
158   '((t :inherit font-lock-doc-face))
159   "Face used for binary type directory records.")
160
161 (defface elpher-unknown
162   '((t :inherit error))
163   "Face used for directory records with unknown/unsupported types.")
164
165 (defface elpher-margin-key
166   '((t :inherit bold))
167   "Face used for directory margin key.")
168
169 (defface elpher-margin-brackets
170   '((t :inherit shadow))
171   "Face used for brackets around directory margin key.")
172
173 ;; Other customizations
174
175 (defcustom elpher-open-urls-with-eww nil
176   "If non-nil, open URL selectors using eww.
177 Otherwise, use the system browser via the BROWSE-URL function."
178   :type '(boolean))
179
180 (defcustom elpher-buttonify-urls-in-directories nil
181   "If non-nil, turns URLs matched in directories into clickable buttons."
182   :type '(boolean))
183
184 (defcustom elpher-cache-images nil
185   "If non-nil, cache images in memory in the same way as other content."
186   :type '(boolean))
187
188 (defcustom elpher-use-header t
189   "If non-nil, display current node information in buffer header."
190   :type '(boolean))
191
192 ;;; Model
193 ;;
194
195 ;; Address
196
197 (defun elpher-make-address (type &optional selector host port)
198   "Create an address of a gopher object with TYPE, SELECTOR, HOST and PORT.
199 Although selector host and port are optional, they are only omitted for
200 special address types, such as 'start for the start page."
201   (list type selector host port))
202
203 (defun elpher-address-type (address)
204   "Retrieve type from ADDRESS."
205   (elt address 0))
206
207 (defun elpher-address-selector (address)
208   "Retrieve selector from ADDRESS."
209   (elt address 1))
210
211 (defun elpher-address-host (address)
212   "Retrieve host from ADDRESS."
213   (elt address 2))
214
215 (defun elpher-address-port (address)
216   "Retrieve port from ADDRESS."
217   (elt address 3))
218
219 ;; Node
220
221 (defun elpher-make-node (display-string parent address)
222   "Create a node in the gopher page hierarchy.
223
224 DISPLAY-STRING records the display string used for the page.
225
226 PARENT specifies the parent of the node, and ADDRESS specifies the
227 address of the gopher page."
228   (list display-string parent address))
229
230 (defun elpher-node-display-string (node)
231   "Retrieve the display string of NODE."
232   (elt node 0))
233
234 (defun elpher-node-parent (node)
235   "Retrieve the parent node of NODE."
236   (elt node 1))
237
238 (defun elpher-node-address (node)
239   "Retrieve the address of NODE."
240   (elt node 2))
241
242 ;; Cache
243
244 (defvar elpher-content-cache (make-hash-table :test 'equal))
245 (defvar elpher-pos-cache (make-hash-table :test 'equal))
246
247 (defun elpher-get-cached-content (address)
248   "Retrieve the cached content for ADDRESS, or nil if none exists."
249   (gethash address elpher-content-cache))
250
251 (defun elpher-cache-content (address content)
252   "Set the content cache for ADDRESS to CONTENT."
253   (puthash address content elpher-content-cache))
254
255 (defun elpher-get-cached-pos (address)
256   "Retrieve the cached cursor position for ADDRESS, or nil if none exists."
257   (gethash address elpher-pos-cache))
258
259 (defun elpher-cache-pos (address pos)
260   "Set the cursor position cache for ADDRESS to POS."
261   (puthash address pos elpher-pos-cache))
262
263 ;; Node graph traversal
264
265 (defvar elpher-current-node nil)
266
267 (defun elpher-visit-node (node &optional getter)
268   "Visit NODE using its own getter or GETTER, if non-nil."
269   (elpher-save-pos)
270   (elpher-process-cleanup)
271   (setq elpher-current-node node)
272   (if getter
273       (funcall getter)
274     (let* ((address (elpher-node-address node))
275            (type (elpher-address-type address)))
276       (funcall (car (alist-get type elpher-type-map))))))
277
278 (defun elpher-visit-parent-node ()
279   "Visit the parent of the current node."
280   (let ((parent-node (elpher-node-parent elpher-current-node)))
281     (when parent-node
282       (elpher-visit-node parent-node))))
283       
284 (defun elpher-reload-current-node ()
285   "Reload the current node, discarding any existing cached content."
286   (elpher-cache-content (elpher-node-address elpher-current-node) nil)
287   (elpher-visit-node elpher-current-node))
288
289 (defun elpher-save-pos ()
290   "Save the current position of point to the current node."
291   (when elpher-current-node
292     (elpher-cache-pos (elpher-node-address elpher-current-node) (point))))
293
294 (defun elpher-restore-pos ()
295   "Restore the position of point to that cached in the current node."
296   (let ((pos (elpher-get-cached-pos (elpher-node-address elpher-current-node))))
297     (if pos
298         (goto-char pos)
299       (goto-char (point-min)))))
300
301
302 ;;; Buffer preparation
303 ;;
304
305 (defun elpher-update-header ()
306   "If `elpher-use-header' is true, display current node info in window header."
307   (if elpher-use-header
308       (setq header-line-format (elpher-node-display-string elpher-current-node))))
309
310 (defmacro elpher-with-clean-buffer (&rest args)
311   "Evaluate ARGS with a clean *elpher* buffer as current."
312   (list 'with-current-buffer "*elpher*"
313         '(elpher-mode)
314         (append (list 'let '((inhibit-read-only t))
315                       '(erase-buffer)
316                       '(elpher-update-header))
317                 args)))
318
319
320 ;;; Index rendering
321 ;;
322
323 (defun elpher-preprocess-text-response (string)
324   "Clear away CRs and terminating period from STRING."
325   (replace-regexp-in-string "\n\.\n$" "\n"
326                             (replace-regexp-in-string "\r" ""
327                                                       string)))
328
329 (defun elpher-insert-index (string)
330   "Insert the index corresponding to STRING into the current buffer."
331   ;; Should be able to split directly on CRLF, but some non-conformant
332   ;; LF-only servers sadly exist, hence the following.
333   (let ((str-processed (elpher-preprocess-text-response string)))
334     (dolist (line (split-string str-processed "\n"))
335       (unless (= (length line) 0)
336         (let* ((type (elt line 0))
337                (fields (split-string (substring line 1) "\t"))
338                (display-string (elt fields 0))
339                (selector (elt fields 1))
340                (host (elt fields 2))
341                (port (if (elt fields 3)
342                          (string-to-number (elt fields 3))
343                        nil)))
344           (elpher-insert-index-record display-string type selector host port))))))
345
346 (defun elpher-insert-margin (&optional type-name)
347   "Insert index margin, optionally containing the TYPE-NAME, into the current buffer."
348   (if type-name
349       (progn
350         (insert (format (concat "%" (number-to-string (- elpher-margin-width 1)) "s")
351                         (concat
352                          (propertize "[" 'face 'elpher-margin-brackets)
353                          (propertize type-name 'face 'elpher-margin-key)
354                          (propertize "]" 'face 'elpher-margin-brackets))))
355         (insert " "))
356     (insert (make-string elpher-margin-width ?\s))))
357
358 (defun elpher-node-button-help (node)
359   "Return a string containing the help text for a button corresponding to NODE."
360   (let ((address (elpher-node-address node)))
361     (if (eq (elpher-address-type address) ?h)
362         (let ((url (cadr (split-string (elpher-address-selector address) "URL:"))))
363           (format "mouse-1, RET: open url '%s'" url))
364       (format "mouse-1, RET: open '%s' on %s port %s"
365               (elpher-address-selector address)
366               (elpher-address-host address)
367               (elpher-address-port address)))))
368
369 (defun elpher-insert-index-record (display-string type selector host port)
370   "Function to insert an index record into the current buffer.
371 The contents of the record are dictated by TYPE, DISPLAY-STRING, SELECTOR, HOST
372 and PORT."
373   (let ((address (elpher-make-address type selector host port))
374         (type-map-entry (alist-get type elpher-type-map)))
375     (if type-map-entry
376         (let* ((margin-code (cadr type-map-entry))
377                (face (elt type-map-entry 2))
378                (node (elpher-make-node display-string elpher-current-node address)))
379           (elpher-insert-margin margin-code)
380           (insert-text-button display-string
381                               'face face
382                               'elpher-node node
383                               'action #'elpher-click-link
384                               'follow-link t
385                               'help-echo (elpher-node-button-help node)))
386       (pcase type
387         (?i ;; Information
388          (elpher-insert-margin)
389          (insert (propertize
390                   (if elpher-buttonify-urls-in-directories
391                       (elpher-buttonify-urls display-string)
392                     display-string)
393                   'face 'elpher-info)))
394         (other ;; Unknown
395          (elpher-insert-margin (concat (char-to-string type) "?"))
396          (insert (propertize display-string
397                              'face 'elpher-unknown-face)))))
398     (insert "\n")))
399
400 (defun elpher-click-link (button)
401   "Function called when the gopher link BUTTON is activated (via mouse or keypress)."
402   (let ((node (button-get button 'elpher-node)))
403     (elpher-visit-node node)))
404
405
406 ;;; Selector retrieval (all kinds)
407 ;;
408
409 (defun elpher-process-cleanup ()
410   "Immediately shut down any extant elpher process."
411   (let ((p (get-process "elpher-process")))
412     (if p (delete-process p))))
413
414 (defvar elpher-selector-string)
415
416 (defun elpher-get-selector (address after)
417   "Retrieve selector specified by ADDRESS, then execute AFTER.
418 The result is stored as a string in the variable â€˜elpher-selector-string’."
419   (setq elpher-selector-string "")
420   (make-network-process
421    :name "elpher-process"
422    :host (elpher-address-host address)
423    :service (elpher-address-port address)
424    :filter (lambda (proc string)
425              (setq elpher-selector-string (concat elpher-selector-string string)))
426    :sentinel after)
427   (process-send-string "elpher-process"
428                        (concat (elpher-address-selector address) "\n")))
429
430 ;; Index retrieval
431
432 (defun elpher-get-index-node ()
433   "Getter which retrieves the current node contents as an index."
434   (let* ((address (elpher-node-address elpher-current-node))
435          (content (elpher-get-cached-content address)))
436     (if content
437         (progn
438           (elpher-with-clean-buffer
439            (insert content)
440            (elpher-restore-pos)))
441       (elpher-with-clean-buffer
442        (insert "LOADING DIRECTORY..."))
443       (elpher-get-selector address
444                            (lambda (proc event)
445                              (unless (string-prefix-p "deleted" event)
446                                (elpher-with-clean-buffer
447                                 (elpher-insert-index elpher-selector-string)
448                                 (elpher-restore-pos)
449                                 (elpher-cache-content
450                                  (elpher-node-address elpher-current-node)
451                                  (buffer-string)))))))))
452
453 ;; Text retrieval
454
455 (defconst elpher-url-regex
456   "\\([a-zA-Z]+\\)://\\([a-zA-Z0-9.\-]+\\)\\(?3::[0-9]+\\)?\\(?4:/[^ \r\n\t(),]*\\)?"
457   "Regexp used to locate and buttinofy URLs in text files loaded by elpher.")
458
459 (defun elpher-make-node-from-matched-url (parent &optional string)
460   "Convert most recent `elpher-url-regex' match to a node.
461
462 PARENT defines the node to set as the parent to the new node.
463
464 If STRING is non-nil, this is given as an argument to all `match-string'
465 calls, as is necessary if the match is performed by `string-match'."
466   (let ((url (match-string 0 string))
467         (protocol (downcase (match-string 1 string))))
468     (if (string= protocol "gopher")
469         (let* ((host (match-string 2 string))
470                (port (if (> (length (match-string 3 string))  1)
471                          (string-to-number (substring (match-string 3 string) 1))
472                        70))
473                (type-and-selector (match-string 4 string))
474                (type (if (> (length type-and-selector) 1)
475                          (elt type-and-selector 1)
476                        ?1))
477                (selector (if (> (length type-and-selector) 1)
478                              (substring type-and-selector 2)
479                            ""))
480                (address (elpher-make-address type selector host port)))
481           (elpher-make-node url elpher-current-node address))
482       (let* ((host (match-string 2 string))
483              (port (if (> (length (match-string 3 string)) 1)
484                        (string-to-number (substring (match-string 3 string) 1))
485                      70))
486              (selector (concat "URL:" url))
487              (address (elpher-make-address ?h selector host port)))
488         (elpher-make-node url elpher-current-node address)))))
489
490
491 (defun elpher-buttonify-urls (string)
492   "Turn substrings which look like urls in STRING into clickable buttons."
493   (with-temp-buffer
494     (insert string)
495     (goto-char (point-min))
496     (while (re-search-forward elpher-url-regex nil t)
497         (let ((node (elpher-make-node-from-matched-url elpher-current-node)))
498           (make-text-button (match-beginning 0)
499                             (match-end 0)
500                             'elpher-node  node
501                             'action #'elpher-click-link
502                             'follow-link t
503                             'help-echo (elpher-node-button-help node))))
504     (buffer-string)))
505
506 (defun elpher-get-text-node ()
507   "Getter which retrieves the current node contents as a text document."
508   (let* ((address (elpher-node-address elpher-current-node))
509          (content (elpher-get-cached-content address)))
510     (if content
511         (progn
512           (elpher-with-clean-buffer
513            (insert content)
514            (elpher-restore-pos)))
515       (progn
516         (elpher-with-clean-buffer
517          (insert "LOADING TEXT..."))
518         (elpher-get-selector address
519                               (lambda (proc event)
520                                 (unless (string-prefix-p "deleted" event)
521                                   (elpher-with-clean-buffer
522                                    (insert (elpher-buttonify-urls
523                                             (elpher-preprocess-text-response
524                                              elpher-selector-string)))
525                                    (elpher-restore-pos)
526                                    (elpher-cache-content
527                                     (elpher-node-address elpher-current-node)
528                                     (buffer-string))))))))))
529
530 ;; Image retrieval
531
532 (defun elpher-get-image-node ()
533   "Getter which retrieves the current node contents as an image to view."
534   (let* ((address (elpher-node-address elpher-current-node))
535          (content (elpher-get-cached-content address)))
536     (if content
537         (progn
538           (elpher-with-clean-buffer
539            (insert-image content)
540            (elpher-restore-pos)))
541       (if (display-images-p)
542           (progn
543             (elpher-with-clean-buffer
544              (insert "LOADING IMAGE..."))
545             (elpher-get-selector address
546                                  (lambda (proc event)
547                                    (unless (string-prefix-p "deleted" event)
548                                      (let ((image (create-image
549                                                    (encode-coding-string
550                                                     elpher-selector-string
551                                                     'no-conversion)
552                                                    nil t)))
553                                        (elpher-with-clean-buffer
554                                         (insert-image image)
555                                         (elpher-restore-pos))
556                                        (if elpher-cache-images
557                                            (elpher-cache-content
558                                             (elpher-node-address elpher-current-node)
559                                             image)))))))
560         (elpher-get-node-download)))))
561
562 ;; Search retrieval
563
564 (defun elpher-get-search-node ()
565   "Getter which submits a search query to the address of the current node."
566   (let* ((address (elpher-node-address elpher-current-node))
567          (content (elpher-get-cached-content address))
568          (aborted t))
569     (if content
570         (progn
571           (elpher-with-clean-buffer
572            (insert content)
573            (elpher-restore-pos))
574           (message "Displaying cached search results.  Reload to perform a new search."))
575       (unwind-protect
576           (let* ((query-string (read-string "Query: "))
577                  (query-selector (concat (elpher-address-selector address) "\t" query-string))
578                  (search-address (elpher-make-address ?1
579                                                       query-selector
580                                                       (elpher-address-host address)
581                                                       (elpher-address-port address))))
582             (setq aborted nil)
583             (elpher-with-clean-buffer
584              (insert "LOADING RESULTS..."))
585             (elpher-get-selector search-address
586                                   (lambda (proc event)
587                                     (unless (string-prefix-p "deleted" event)
588                                       (elpher-with-clean-buffer
589                                        (elpher-insert-index elpher-selector-string))
590                                       (goto-char (point-min))
591                                       (elpher-cache-content
592                                        (elpher-node-address elpher-current-node)
593                                        (buffer-string))))))
594         (if aborted
595             (elpher-visit-parent-node))))))
596
597 ;; Raw server response retrieval
598
599 (defun elpher-get-node-raw ()
600   "Getter which retrieves the raw server response for the current node."
601   (let ((address (elpher-node-address elpher-current-node)))
602     (elpher-with-clean-buffer
603      (insert "LOADING RAW SERVER RESPONSE..."))
604     (if address
605         (elpher-get-selector address
606                               (lambda (proc event)
607                                 (unless (string-prefix-p "deleted" event)
608                                   (elpher-with-clean-buffer
609                                    (insert elpher-selector-string)
610                                    (goto-char (point-min))))))
611       (progn
612         (elpher-with-clean-buffer
613          (insert elpher-start-index))
614         (goto-char (point-min)))))
615   (message "Displaying raw server response.  Reload or redraw to return to standard view."))
616  
617 ;; File export retrieval
618
619 (defvar elpher-download-filename)
620
621 (defun elpher-get-node-download ()
622   "Getter which retrieves the current node and writes the result to a file."
623   (let* ((address (elpher-node-address elpher-current-node))
624          (selector (elpher-address-selector address)))
625     (elpher-visit-parent-node) ; Do first in case of non-local exits.
626     (let* ((filename-proposal (file-name-nondirectory selector))
627            (filename (read-file-name "Save file as: "
628                                      nil nil nil
629                                      (if (> (length filename-proposal) 0)
630                                          filename-proposal
631                                        "gopher.file"))))
632       (message "Downloading...")
633       (setq elpher-download-filename filename)
634       (elpher-get-selector address
635                             (lambda (proc event)
636                               (let ((coding-system-for-write 'binary))
637                                 (with-temp-file elpher-download-filename
638                                   (insert elpher-selector-string)
639                                   (message (format "Download complate, saved to file %s."
640                                                    elpher-download-filename)))))))))
641
642 ;; URL retrieval
643
644 (defun elpher-get-url-node ()
645   "Getter which attempts to open the URL specified by the current node."
646   (let* ((address (elpher-node-address elpher-current-node))
647          (selector (elpher-address-selector address)))
648     (elpher-visit-parent-node) ; Do first in case of non-local exits.
649     (let ((url (elt (split-string selector "URL:") 1)))
650       (if elpher-open-urls-with-eww
651           (browse-web url)
652         (browse-url url)))))
653
654 ;; Telnet node connection
655
656 (defun elpher-get-telnet-node ()
657   "Getter which opens a telnet connection to the server specified by the current node."
658   (let* ((address (elpher-node-address elpher-current-node))
659          (host (elpher-address-host address))
660          (port (elpher-address-port address)))
661     (elpher-visit-parent-node)
662     (telnet host port)))
663
664 ;; Start page node retrieval
665
666 (defun elpher-get-start-node ()
667   "Getter which displays the start page."
668   (elpher-with-clean-buffer
669    (elpher-insert-index elpher-start-index)
670    (elpher-restore-pos)))
671
672 ;; Bookmarks page node retrieval
673
674 (defun elpher-get-bookmarks-node ()
675   "Getter which loads and displays the current bookmark list."
676   (elpher-with-clean-buffer
677    (insert "Use 'u' to return to the previous page.\n\n"
678            "---- Bookmark list ----\n\n")
679    (let ((bookmarks (elpher-load-bookmarks)))
680      (if bookmarks
681          (dolist (bookmark bookmarks)
682            (let ((display-string (elpher-bookmark-display-string bookmark))
683                  (address (elpher-bookmark-address bookmark)))
684              (elpher-insert-index-record display-string
685                                          (elpher-address-type address)
686                                          (elpher-address-selector address)
687                                          (elpher-address-host address)
688                                          (elpher-address-port address))))
689        (insert "No bookmarks found.\n")))
690    (insert "\n-----------------------")
691    (elpher-restore-pos)))
692   
693
694 ;;; Bookmarks
695 ;;
696
697 (defun elpher-make-bookmark (display-string address)
698   "Make an elpher bookmark.
699 DISPLAY-STRING determines how the bookmark will appear in the
700 bookmark list, while ADDRESS is the address of the entry."
701   (list display-string address))
702   
703 (defun elpher-bookmark-display-string (bookmark)
704   "Get the display string of BOOKMARK."
705   (elt bookmark 0))
706
707 (defun elpher-bookmark-address (bookmark)
708   "Get the address for BOOKMARK."
709   (elt bookmark 1))
710
711 (defun elpher-save-bookmarks (bookmarks)
712   "Record the bookmark list BOOKMARKS to the user's bookmark file.
713 Beware that this completely replaces the existing contents of the file."
714   (with-temp-file (locate-user-emacs-file "elpher-bookmarks")
715     (erase-buffer)
716     (pp bookmarks (current-buffer))))
717
718 (defun elpher-load-bookmarks ()
719   "Get the list of bookmarks from the users's bookmark file."
720   (with-temp-buffer
721     (ignore-errors
722       (insert-file-contents (locate-user-emacs-file "elpher-bookmarks"))
723       (goto-char (point-min))
724       (read (current-buffer)))))
725
726 (defun elpher-add-node-bookmark (node)
727   "Add bookmark to NODE to the saved list of bookmarks."
728   (let ((bookmark (elpher-make-bookmark (elpher-node-display-string node)
729                                         (elpher-node-address node)))
730         (bookmarks (elpher-load-bookmarks)))
731     (add-to-list 'bookmarks bookmark)
732     (elpher-save-bookmarks bookmarks)))
733
734 (defun elpher-remove-node-bookmark (node)
735   "Remove bookmark to NODE from the saved list of bookmarks."
736   (let ((bookmark (elpher-make-bookmark (elpher-node-display-string node)
737                                         (elpher-node-address node))))
738     (elpher-save-bookmarks
739      (seq-filter (lambda (this-bookmark)
740                    (not (equal bookmark this-bookmark)))
741                  (elpher-load-bookmarks)))))
742      
743
744 ;;; Interactive procedures
745 ;;
746
747 (defun elpher-next-link ()
748   "Move point to the next link on the current page."
749   (interactive)
750   (forward-button 1))
751
752 (defun elpher-prev-link ()
753   "Move point to the previous link on the current page."
754   (interactive)
755   (backward-button 1))
756
757 (defun elpher-follow-current-link ()
758   "Open the link or url at point."
759   (interactive)
760   (push-button))
761
762 (defun elpher-go ()
763   "Go to a particular gopher site."
764   (interactive)
765   (let ((node
766          (let ((host-or-url (read-string "Gopher host or URL: ")))
767            (if (string-match elpher-url-regex host-or-url)
768                (elpher-make-node-from-matched-url elpher-current-node
769                                                   host-or-url)
770              (let ((selector (read-string "Selector (default none): " nil nil ""))
771                    (port-string (read-string "Port (default 70): " nil nil "70")))
772                (elpher-make-node (concat "gopher://" host-or-url
773                                          ":" port-string
774                                          "/1" selector)
775                                  elpher-current-node
776                                  (elpher-make-address ?1 selector host-or-url
777                                                       (string-to-number port-string))))))))
778     (switch-to-buffer "*elpher*")
779     (elpher-visit-node node)))
780
781 (defun  elpher-redraw ()
782   "Redraw current page."
783   (interactive)
784   (if elpher-current-node
785       (elpher-visit-node elpher-current-node)
786     (message "No current site.")))
787
788 (defun  elpher-reload ()
789   "Reload current page."
790   (interactive)
791   (if elpher-current-node
792       (elpher-reload-current-node)
793     (message "No current site.")))
794
795 (defun elpher-view-raw ()
796   "View current page as plain text."
797   (interactive)
798   (if elpher-current-node
799       (elpher-visit-node elpher-current-node
800                          #'elpher-get-node-raw)
801     (message "No current site.")))
802
803 (defun elpher-back ()
804   "Go to previous site."
805   (interactive)
806   (if (elpher-node-parent elpher-current-node)
807       (elpher-visit-parent-node)
808     (error "No previous site")))
809
810 (defun elpher-download ()
811   "Download the link at point."
812   (interactive)
813   (let ((button (button-at (point))))
814     (if button
815         (let ((node (button-get button 'elpher-node)))
816           (if node
817               (elpher-visit-node (button-get button 'elpher-node)
818                                  #'elpher-get-node-download)
819             (error "Can only download gopher links, not general URLs")))
820       (error "No link selected"))))
821
822 (defun elpher-build-link-map ()
823   "Build alist mapping link names to destination nodes in current buffer."
824   (let ((link-map nil)
825         (b (next-button (point-min) t)))
826     (while b
827       (add-to-list 'link-map (cons (button-label b) b))
828       (setq b (next-button (button-start b))))
829     link-map))
830
831 (defun elpher-jump ()
832   "Select a directory entry by name.  Similar to the info browser (m)enu command."
833   (interactive)
834   (let* ((link-map (elpher-build-link-map)))
835     (if link-map
836         (let ((key (let ((completion-ignore-case t))
837                      (completing-read "Directory entry/link (tab to autocomplete): "
838                                       link-map nil t))))
839           (if (and key (> (length key) 0))
840               (let ((b (cdr (assoc key link-map))))
841                 (goto-char (button-start b))
842                 (button-activate b)))))))
843
844 (defun elpher-root-dir ()
845   "Visit root of current server."
846   (interactive)
847   (let* ((address (elpher-node-address elpher-current-node))
848          (host (elpher-address-host address)))
849     (if host
850         (let ((host (elpher-address-host address))
851               (selector (elpher-address-selector address))
852               (port (elpher-address-port address)))
853           (if (> (length selector) 0)
854               (let ((root-address (elpher-make-address ?1 "" host port)))
855                 (elpher-visit-node
856                  (elpher-make-node (concat "gopher://" host
857                                            ":" (number-to-string port)
858                                            "/1/")
859                                    elpher-current-node
860                                    root-address)))
861             (error "Already at root directory of current server")))
862       (error "Command invalid for this page"))))
863
864 (defun elpher-bookmarks-current-p ()
865   "Return true if current node is a bookmarks page."
866   (eq (elpher-address-type (elpher-node-address elpher-current-node)) 'bookmarks))
867
868 (defun elpher-reload-bookmarks ()
869   "Reload bookmarks if current node is a bookmarks page."
870   (if (elpher-bookmarks-current-p)
871       (elpher-reload-current-node)))
872
873 (defun elpher-bookmark-current ()
874   "Bookmark the current node."
875   (interactive)
876   (if (not (elpher-bookmarks-current-p))
877       (elpher-add-node-bookmark elpher-current-node)))
878
879 (defun elpher-bookmark-link ()
880   "Bookmark the link at point."
881   (interactive)
882   (let ((button (button-at (point))))
883     (if button
884         (progn
885           (elpher-add-node-bookmark (button-get button 'elpher-node))
886           (elpher-reload-bookmarks))
887       (error "No link selected"))))
888
889 (defun elpher-unbookmark-current ()
890   "Remove bookmark for the current node."
891   (interactive)
892   (if (not (elpher-bookmarks-current-p))
893       (elpher-remove-node-bookmark elpher-current-node)))
894
895 (defun elpher-unbookmark-link ()
896   "Remove bookmark for the link at point."
897   (interactive)
898   (let ((button (button-at (point))))
899     (if button
900         (progn
901           (elpher-remove-node-bookmark (button-get button 'elpher-node))
902           (elpher-reload-bookmarks))
903       (error "No link selected"))))
904
905 (defun elpher-bookmarks ()
906   "Visit bookmarks."
907   (interactive)
908   (elpher-visit-node
909    (elpher-make-node "Bookmarks"
910                      elpher-current-node
911                      (elpher-make-address 'bookmarks))))
912
913 (defun elpher-info-node (node)
914   "Display information on NODE."
915   (let ((display-string (elpher-node-display-string node))
916         (address (elpher-node-address node)))
917     (if address
918         (message "`%s' on %s port %s"
919                 (elpher-address-selector address)
920                 (elpher-address-host address)
921                 (elpher-address-port address))
922       (message "%s" display-string))))
923
924 (defun elpher-info-link ()
925   "Display information on node corresponding to link at point."
926   (interactive)
927   (let ((button (button-at (point))))
928     (if button
929         (elpher-info-node (button-get button 'elpher-node))
930       (error "No item selected"))))
931   
932 (defun elpher-info-current ()
933   "Display information on current node."
934   (interactive)
935   (elpher-info-node elpher-current-node))
936
937 (defun elpher-get-address-url (address)
938   "Get URL representation of ADDRESS."
939   (concat "gopher://"
940           (elpher-address-host address)
941           (let ((port (elpher-address-port address)))
942             (if (equal port 70)
943                 ""
944               (format ":%d" port)))
945           "/" (string (elpher-address-type address))
946           (elpher-address-selector address)))
947
948 (defun elpher-copy-node-url (node)
949   "Copy URL representation of address of NODE to `kill-ring'."
950   (let ((address (elpher-node-address node)))
951     (if address
952         (let ((url (elpher-get-address-url address)))
953           (message url)
954           (kill-new url))
955       (error (format "Cannot represent %s as URL" (elpher-node-display-string node))))))
956
957 (defun elpher-copy-link-url ()
958   "Copy URL of item at point to `kill-ring'."
959   (interactive)
960   (let ((button (button-at (point))))
961     (if button
962         (elpher-copy-node-url (button-get button 'elpher-node))
963       (error "No item selected"))))
964
965 (defun elpher-copy-current-url ()
966   "Copy URL of current node to `kill-ring'."
967   (interactive)
968   (elpher-copy-node-url elpher-current-node))
969
970 ;;; Mode and keymap
971 ;;
972
973 (defvar elpher-mode-map
974   (let ((map (make-sparse-keymap)))
975     (define-key map (kbd "TAB") 'elpher-next-link)
976     (define-key map (kbd "<backtab>") 'elpher-prev-link)
977     (define-key map (kbd "u") 'elpher-back)
978     (define-key map (kbd "O") 'elpher-root-dir)
979     (define-key map (kbd "g") 'elpher-go)
980     (define-key map (kbd "r") 'elpher-redraw)
981     (define-key map (kbd "R") 'elpher-reload)
982     (define-key map (kbd "w") 'elpher-view-raw)
983     (define-key map (kbd "d") 'elpher-download)
984     (define-key map (kbd "m") 'elpher-jump)
985     (define-key map (kbd "i") 'elpher-info-link)
986     (define-key map (kbd "I") 'elpher-info-current)
987     (define-key map (kbd "c") 'elpher-copy-link-url)
988     (define-key map (kbd "C") 'elpher-copy-current-url)
989     (define-key map (kbd "a") 'elpher-bookmark-link)
990     (define-key map (kbd "A") 'elpher-bookmark-current)
991     (define-key map (kbd "x") 'elpher-unbookmark-link)
992     (define-key map (kbd "X") 'elpher-unbookmark-current)
993     (define-key map (kbd "B") 'elpher-bookmarks)
994     (when (fboundp 'evil-define-key)
995       (evil-define-key 'motion map
996         (kbd "TAB") 'elpher-next-link
997         (kbd "C-]") 'elpher-follow-current-link
998         (kbd "C-t") 'elpher-back
999         (kbd "u") 'elpher-back
1000         (kbd "O") 'elpher-root-dir
1001         (kbd "g") 'elpher-go
1002         (kbd "r") 'elpher-redraw
1003         (kbd "R") 'elpher-reload
1004         (kbd "w") 'elpher-view-raw
1005         (kbd "d") 'elpher-download
1006         (kbd "m") 'elpher-jump
1007         (kbd "i") 'elpher-info-link
1008         (kbd "I") 'elpher-info-current
1009         (kbd "c") 'elpher-copy-link-url
1010         (kbd "C") 'elpher-copy-current-url
1011         (kbd "a") 'elpher-bookmark-link
1012         (kbd "A") 'elpher-bookmark-current
1013         (kbd "x") 'elpher-unbookmark-link
1014         (kbd "X") 'elpher-unbookmark-current
1015         (kbd "B") 'elpher-bookmarks))
1016     map)
1017   "Keymap for gopher client.")
1018
1019 (define-derived-mode elpher-mode special-mode "elpher"
1020   "Major mode for elpher, an elisp gopher client.")
1021
1022 (when (fboundp 'evil-set-initial-state)
1023   (evil-set-initial-state 'elpher-mode 'motion))
1024
1025 ;;; Main start procedure
1026 ;;
1027
1028 ;;;###autoload
1029 (defun elpher ()
1030   "Start elpher with default landing page."
1031   (interactive)
1032   (if (get-buffer "*elpher*")
1033       (switch-to-buffer "*elpher*")
1034     (switch-to-buffer "*elpher*")
1035     (setq elpher-current-node nil)
1036     (let ((start-node (elpher-make-node "Elpher Start Page" nil (elpher-make-address 'start))))
1037       (elpher-visit-node start-node)))
1038   "Started Elpher.") ; Otherwise (elpher) evaluates to start page string.
1039
1040 ;;; elpher.el ends here