Added mouseover text.
[elpher.git] / elopher.el
1 ;;; elopher.el --- gopher client
2
3 ;;; Commentary:
4
5 ;; Simple gopher client in elisp.
6
7 ;;; Code:
8
9 ;; (defvar elopher-mode-map nil "Keymap for gopher client.")
10 ;; (define-key elopher-mode-map (kbd "p") 'elopher-quit)
11
12 ;; (define-derived-mode elopher-mode special-mode "elopher"
13 ;;   "Major mode for elopher, an elisp gopher client.")
14
15 ;; (global-set-key (kbd "C-c C-b") 'eval-buffer)
16
17 (defvar elopher-type-margin-width 5)
18
19 (defun elopher-type-margin (&optional type-name)
20   (if type-name
21       (insert (propertize
22                (format (concat "%" (number-to-string elopher-type-margin-width) "s")
23                        (concat "[" type-name "] "))
24                'face '(foreground-color . "yellow")))
25     (insert (make-string elopher-type-margin-width ?\s))))
26
27 (defun elopher-format-i (display-string)
28   (elopher-type-margin)
29   (insert (propertize display-string 'face '(foreground-color . "white")))
30   (insert "\n"))
31
32 (defun elopher-format-0 (display-string selector hostname port)
33   (elopher-type-margin "T")
34   (insert (propertize display-string 'face '(foreground-color . "gray")))
35   (insert "\n"))
36
37 (defun elopher-format-1 (display-string selector hostname port)
38   (elopher-type-margin "/")
39   (let ((map (make-sparse-keymap)))
40     (define-key map [mouse-1]
41       (eval `(lambda () (interactive) (elopher-get-index ,hostname ,port ,selector))))
42     (insert (propertize display-string
43                         'face '(foreground-color . "cyan")
44                         'mouse-face 'highlight
45                         'help-echo (format "mouse-1: follow link to \"%s\" on %s port %s"
46                                            selector hostname port)
47                         'keymap map))
48     (insert "\n")))
49
50 (defun elopher-process-record (line)
51   (let* ((type (elt line 0))
52          (fields (split-string (substring line 1) "\t"))
53          (g-display-string (elt fields 0))
54          (g-selector (elt fields 1))
55          (g-hostname (elt fields 2))
56          (g-port (elt fields 3)))
57     (pcase type
58       (?i (elopher-format-i g-display-string))
59       (?0 (elopher-format-0 g-display-string g-selector g-hostname g-port))
60       (?1 (elopher-format-1 g-display-string g-selector g-hostname g-port)))))
61
62 (defvar elopher-incomplete-record "")
63
64 (defun elopher-process-complete-records (string)
65   (let* ((til-now (string-join (list elopher-incomplete-record string)))
66          (lines (split-string til-now "\r\n")))
67     (dotimes (idx (length lines))
68       (if (< idx (- (length lines) 1))
69           (elopher-process-record (elt lines idx))
70         (setq elopher-incomplete-record (elt lines idx))))))
71
72 (defun elopher-filter (proc string)
73   (with-current-buffer (get-buffer "*elopher*")
74     (let ((marker (process-mark proc)))
75       (if (not (marker-position marker))
76           (set-marker marker 0 (current-buffer)))
77       (save-excursion
78         (goto-char marker)
79         (elopher-process-complete-records string)
80         (set-marker marker (point))))))
81     
82 (defun elopher-get-index (host &optional port path)
83   (switch-to-buffer "*elopher*")
84   (erase-buffer)
85   (make-network-process
86    :name "elopher-process"
87    :host host
88    :service (if port port 70)
89    :filter #'elopher-filter)
90   (process-send-string "elopher-process" (concat path "\n")))
91
92 (defun elopher ()
93   "Start gopher client."
94   (interactive)
95   (elopher-get-index (read-from-minibuffer "Gopher host: ") 70))
96
97 ;; (elopher-get-index "cosmic.voyage")
98 (elopher-get-index "gopher.floodgap.com")
99 ;; (elopher-get-index "maurits.id.au")
100
101 (defun elopher-quit ()
102   (interactive)
103   (kill-buffer "*elopher*"))
104
105 ;;; elopher.el ends here