cgit.sxemacs.org Git - packages/blob - xemacs-packages/hyperbole/hsys-www.el

   1 ;;; hsys-www.el --- Hyperbole support for old CERN command line WWW browsing.
   2
   3 ;; Copyright (C) 1991-1995 Free Software Foundation, Inc.
   4 ;; Developed with support from Motorola Inc.
   5
   6 ;; Author: Bob Weiner, Brown U.
   7 ;; Maintainer: Mats Lidell <matsl@contactor.se>
   8 ;; Keywords: comm, help, hypermedia
   9
  10 ;; This file is part of GNU Hyperbole.
  11
  12 ;; GNU Hyperbole is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License as
  14 ;; published by the Free Software Foundation; either version 3, or (at
  15 ;; your option) any later version.
  16
  17 ;; GNU Hyperbole is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28 ;;
  29 ;;   You must first build the www line mode browser executable before you can
  30 ;;   use this system encapsulation.  The browser MUST be configured so that
  31 ;;   the final part of its prompt is a line beginning with "==> " without a
  32 ;;   trailing newline, like so:
  33 ;;
  34 ;;   <ref.number>, Back, Quit, or Help.
  35 ;;   ==>
  36 ;;
  37 ;;
  38 ;;   Then, a Hyperbole button should be created that has 'hwww:start' as its
  39 ;;   action type.  It may optionally contain a file name argument as
  40 ;;   the initial file to display.  When selected, it starts a 'www'
  41 ;;   process and displays the initial file.
  42 ;;
  43 ;;   The 'hwww:link-follow' implicit button type is then used when the
  44 ;;   user clicks inside the buffer containing the 'www' output.  It
  45 ;;   passes commands to the 'hwww:link-follow' action type.
  46 ;;
  47
  48 ;;; Code:
  49
  50 ;;;
  51 ;;; Other required Elisp libraries
  52 ;;;
  53
  54 ;;; Requires external 'www' executable available via anonymous ftp
  55 ;;; from info.cern.ch.
  56
  57 ;;;
  58 ;;; Public variables
  59 ;;;
  60
  61 (defib hwww:link-follow ()
  62   "When in a www buffer, returns a link follow or history recall command."
  63   (let* ((www (get-buffer-process (current-buffer)))
  64          (www-proc-nm (and www (process-name www)))
  65          (selection)
  66          (act (function
  67                (lambda (&optional prefix)
  68                  (setq selection
  69                        (buffer-substring (match-beginning 1)
  70                                          (match-end 1)))
  71                  (ibut:label-set selection (match-beginning 1)
  72                                  (match-end 1))
  73                  (hact 'hwww:link-follow (concat prefix selection))))))
  74     (if (and www-proc-nm (equal (string-match "www" www-proc-nm) 0))
  75         (cond (;; Hyper ref
  76                (save-excursion
  77                  (skip-chars-backward "^ \t\n")
  78                  (looking-at "[^][ \t\n]*\\[\\([0-9]+\\)\\]"))
  79                (funcall act))
  80               (;; History list entry
  81                (save-excursion
  82                  (beginning-of-line)
  83                  (looking-at "[ \t]*\\([0-9]+\\)\)[ \t]+[^ \t\n]"))
  84                (funcall act "recall "))
  85               (;; Hyper ref list
  86                (save-excursion
  87                  (beginning-of-line)
  88                  (looking-at "[ \t]*\\[\\([0-9]+\\)\\][ \t]+[^ \t\n]"))
  89                (funcall act ))))))
  90
  91 (defact hwww:link-follow (link-num-str)
  92   "Follows a link given by LINK-NUM-STR or displays a www history list."
  93   (interactive "sNumber of WWW link to follow: ")
  94   (or (stringp link-num-str)
  95       (error "(hwww:link-follow): Link number must be given as a string."))
  96   (let ((www (get-buffer-process (current-buffer))))
  97     (if www
  98         (progn
  99           (setq buffer-read-only nil)
 100           (erase-buffer)
 101           (process-send-string www (concat link-num-str "\n"))
 102           )
 103       (error "(hwww:link-follow): No current WWW process.  Use 'hwww:start'."))))
 104
 105 (defun hwww:link-follow:help (&optional but)
 106   "Displays history list of www nodes previously visited."
 107   (interactive)
 108   (hact 'hwww:link-follow "recall"))
 109
 110 (defact hwww:start (&optional file)
 111   "Starts a www process and displays optional FILE.
 112 Without FILE (an empty string), displays default initial www file."
 113   (interactive "FWWW file to start with: ")
 114   (or (stringp file)
 115       (error "(hwww:start): FILE argument is not a string."))
 116   (let ((www-buf (get-buffer-create "WWW"))
 117         (www-proc (get-process "www")))
 118     (save-excursion
 119       (set-buffer www-buf)
 120       (setq buffer-read-only nil)
 121       (erase-buffer)
 122       )
 123     (if www-proc
 124         (pop-to-buffer www-buf)
 125       (if (setq www-proc
 126                 (if (or (equal file "") (equal file "\"\""))
 127                     (start-process "www" www-buf "www" "-p")
 128                   (start-process "www" www-buf "www" "-p" file)))
 129           (progn (set-process-sentinel www-proc 'hwww:sentinel)
 130                  (set-process-filter www-proc 'hwww:filter)
 131                  (process-kill-without-query www-proc)
 132                  (pop-to-buffer www-buf)
 133                  (shell-mode)
 134                  (make-local-variable 'explicit-shell-file-name)
 135                  (setq explicit-shell-file-name "www")
 136                  (use-local-map hwww:mode-map)
 137                  (if hwww:mode-map
 138                      nil
 139                    (setq hwww:mode-map (copy-keymap shell-mode-map))
 140                    (define-key hwww:mode-map "\C-m" 'hwww:send-input)
 141                    (define-key hwww:mode-map " " 'hwww:scroll-up)
 142                    (define-key hwww:mode-map "\177" 'hwww:scroll-down)
 143                    )
 144                  (goto-char (point-min))
 145                  )))))
 146
 147 ;;;
 148 ;;; Private functions
 149 ;;;
 150
 151 (defun hwww:filter (process str)
 152   (if (and (> (length str) 3)
 153            (equal "==> " (substring str -4)))
 154       (progn
 155         (insert str)
 156         (goto-char (point-min))
 157         (hproperty:but-create (concat "\\([^ \t\n]*\\[[0-9]+\\]\\|"
 158                                       "^[ \t]*\\[\\([0-9]+\\)\\][ \t]+[^ \t\n]+\\|"
 159                                       "^[ ]+[0-9]+\).*\\)")
 160                               'regexp))
 161     (insert str)))
 162
 163 (defun hwww:scroll-up (&optional arg)
 164   "If on last line of buffer, insert space, else scroll up a page."
 165   (interactive "P")
 166   (if (last-line-p) (insert " ") (scroll-up arg)))
 167
 168 (defun hwww:scroll-down (&optional arg)
 169   "If on last line of buffer, delete char backwards, else scroll down a page."
 170   (interactive "P")
 171   (if (last-line-p) (backward-delete-char-untabify (or arg 1))
 172     (scroll-down arg)))
 173
 174 (defun hwww:send-input ()
 175   (interactive)
 176   (cond ((eobp)
 177          (let ((www (get-buffer-process (current-buffer))))
 178            (if www
 179                (progn
 180                  (beginning-of-line)
 181                  ;; Exclude the shell prompt, if any.
 182                  (re-search-forward shell-prompt-pattern
 183                                     (save-excursion (end-of-line) (point))
 184                                     t)
 185                  (let ((cmd (concat (buffer-substring (point)
 186                                                       (progn (forward-line 1)
 187                                                              (point)))
 188                                     "\n")))
 189                    (erase-buffer)
 190                    (process-send-string www cmd)
 191                    ))
 192              (error "(hwww:link-follow): No current WWW process.  Use 'hwww:start'."))))
 193         ((ibut:at-p) (hui:hbut-act))
 194         (t (end-of-buffer))
 195         ))
 196
 197 (defun hwww:sentinel (process signal)
 198   (princ
 199    (format "Process: %s received the msg: %s" process signal))
 200   (or (string-match "killed" signal)
 201       (pop-to-buffer (process-buffer process))))
 202
 203 ;;;
 204 ;;; Private variables
 205 ;;;
 206
 207 (defvar hwww:mode-map nil)
 208
 209 (provide 'hsys-www)
 210
 211 ;;; hsys-www.el ends here