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