diff lisp/hyperbole/hsys-www.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/hyperbole/hsys-www.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,201 @@
+;;!emacs
+;;
+;; FILE:         hsys-www.el
+;; SUMMARY:      Hyperbole support for old CERN command line WWW browsing.
+;; USAGE:        GNU Emacs Lisp Library
+;; KEYWORDS:     comm, help, hypermedia
+;;
+;; AUTHOR:       Bob Weiner
+;; ORG:          Brown U.
+;;
+;; ORIG-DATE:    12-Oct-91 at 03:48:23
+;; LAST-MOD:     14-Apr-95 at 16:09:23 by Bob Weiner
+;;
+;; This file is part of Hyperbole.
+;; Available for use and distribution under the same terms as GNU Emacs.
+;;
+;; Copyright (C) 1991-1995, Free Software Foundation, Inc.
+;; Developed with support from Motorola Inc.
+;;
+;; DESCRIPTION:  
+;;
+;;   You must first build the www line mode browser executable before you can
+;;   use this system encapsulation.  The browser MUST be configured so that
+;;   the final part of its prompt is a line beginning with "==> " without a
+;;   trailing newline, like so:
+;;
+;;   <ref.number>, Back, Quit, or Help.
+;;   ==> 
+;;
+;;
+;;   Then, a Hyperbole button should be created that has 'hwww:start' as its
+;;   action type.  It may optionally contain a file name argument as
+;;   the initial file to display.  When selected, it starts a 'www'
+;;   process and displays the initial file.
+;;
+;;   The 'hwww:link-follow' implicit button type is then used when the
+;;   user clicks inside the buffer containing the 'www' output.  It
+;;   passes commands to the 'hwww:link-follow' action type.
+;;
+;; DESCRIP-END.
+
+;;; ************************************************************************
+;;; Other required Elisp libraries
+;;; ************************************************************************
+
+;;; Requires external 'www' executable available via anonymous ftp
+;;; from info.cern.ch.
+
+;;; ************************************************************************
+;;; Public variables
+;;; ************************************************************************
+
+(defib hwww:link-follow ()
+  "When in a www buffer, returns a link follow or history recall command."
+  (let* ((www (get-buffer-process (current-buffer)))
+	 (www-proc-nm (and www (process-name www)))
+	 (selection)
+	 (act (function
+	       (lambda (&optional prefix)
+		 (setq selection
+		       (buffer-substring (match-beginning 1)
+					 (match-end 1)))
+		 (ibut:label-set selection (match-beginning 1)
+				 (match-end 1))
+		 (hact 'hwww:link-follow (concat prefix selection))))))
+    (if (and www-proc-nm (equal (string-match "www" www-proc-nm) 0))
+	(cond (;; Hyper ref
+	       (save-excursion
+		 (skip-chars-backward "^ \t\n")
+		 (looking-at "[^][ \t\n]*\\[\\([0-9]+\\)\\]"))
+	       (funcall act))
+	      (;; History list entry
+	       (save-excursion
+		 (beginning-of-line)
+		 (looking-at "[ \t]*\\([0-9]+\\)\)[ \t]+[^ \t\n]"))
+	       (funcall act "recall "))
+	      (;; Hyper ref list
+	       (save-excursion
+		 (beginning-of-line)
+		 (looking-at "[ \t]*\\[\\([0-9]+\\)\\][ \t]+[^ \t\n]"))
+	       (funcall act ))))))
+
+(defact hwww:link-follow (link-num-str)
+  "Follows a link given by LINK-NUM-STR or displays a www history list."
+  (interactive "sNumber of WWW link to follow: ")
+  (or (stringp link-num-str)
+      (error "(hwww:link-follow): Link number must be given as a string."))
+  (let ((www (get-buffer-process (current-buffer))))
+    (if www
+	(progn
+	  (setq buffer-read-only nil)
+	  (erase-buffer)
+	  (process-send-string www (concat link-num-str "\n"))
+	  )
+      (error "(hwww:link-follow): No current WWW process.  Use 'hwww:start'."))))
+
+(defun hwww:link-follow:help (&optional but)
+  "Displays history list of www nodes previously visited."
+  (interactive)
+  (hact 'hwww:link-follow "recall"))
+
+(defact hwww:start (&optional file)
+  "Starts a www process and displays optional FILE.
+Without FILE (an empty string), displays default initial www file."
+  (interactive "FWWW file to start with: ")
+  (or (stringp file)
+      (error "(hwww:start): FILE argument is not a string."))
+  (let ((www-buf (get-buffer-create "WWW"))
+	(www-proc (get-process "www")))
+    (save-excursion
+      (set-buffer www-buf)
+      (setq buffer-read-only nil)
+      (erase-buffer)
+      )
+    (if www-proc
+	(pop-to-buffer www-buf)
+      (if (setq www-proc
+		(if (or (equal file "") (equal file "\"\""))
+		    (start-process "www" www-buf "www" "-p")
+		  (start-process "www" www-buf "www" "-p" file)))
+	  (progn (set-process-sentinel www-proc 'hwww:sentinel)
+		 (set-process-filter www-proc 'hwww:filter)
+		 (process-kill-without-query www-proc)
+		 (pop-to-buffer www-buf)
+		 (shell-mode)
+		 (make-local-variable 'explicit-shell-file-name)
+		 (setq explicit-shell-file-name "www")
+		 (use-local-map hwww:mode-map)
+		 (if hwww:mode-map
+		     nil
+		   (setq hwww:mode-map (copy-keymap shell-mode-map))
+		   (define-key hwww:mode-map "\C-m" 'hwww:send-input)
+		   (define-key hwww:mode-map " " 'hwww:scroll-up)
+		   (define-key hwww:mode-map "\177" 'hwww:scroll-down)
+		   )
+		 (goto-char (point-min))
+		 )))))
+
+;;; ************************************************************************
+;;; Private functions
+;;; ************************************************************************
+
+(defun hwww:filter (process str)
+  (if (and (> (length str) 3)
+	   (equal "==> " (substring str -4)))
+      (progn
+	(insert str)
+	(goto-char (point-min))
+	(hproperty:but-create (concat "\\([^ \t\n]*\\[[0-9]+\\]\\|"
+				      "^[ \t]*\\[\\([0-9]+\\)\\][ \t]+[^ \t\n]+\\|"
+				      "^[ ]+[0-9]+\).*\\)")
+			      'regexp))
+    (insert str)))
+
+(defun hwww:scroll-up (&optional arg)
+  "If on last line of buffer, insert space, else scroll up a page."
+  (interactive "P")
+  (if (last-line-p) (insert " ") (scroll-up arg)))
+
+(defun hwww:scroll-down (&optional arg)
+  "If on last line of buffer, delete char backwards, else scroll down a page."
+  (interactive "P")
+  (if (last-line-p) (backward-delete-char-untabify (or arg 1))
+    (scroll-down arg)))
+
+(defun hwww:send-input ()
+  (interactive)
+  (cond ((eobp)
+	 (let ((www (get-buffer-process (current-buffer))))
+	   (if www
+	       (progn
+		 (beginning-of-line)
+		 ;; Exclude the shell prompt, if any.
+		 (re-search-forward shell-prompt-pattern
+				    (save-excursion (end-of-line) (point))
+				    t)
+		 (let ((cmd (concat (buffer-substring (point)
+						      (progn (forward-line 1)
+							     (point)))
+				    "\n")))
+		   (erase-buffer)
+		   (process-send-string www cmd)
+		   ))
+	     (error "(hwww:link-follow): No current WWW process.  Use 'hwww:start'."))))
+	((ibut:at-p) (hui:hbut-act))
+	(t (end-of-buffer))
+	))
+
+(defun hwww:sentinel (process signal)
+  (princ
+   (format "Process: %s received the msg: %s" process signal))
+  (or (string-match "killed" signal)
+      (pop-to-buffer (process-buffer process))))
+
+;;; ************************************************************************
+;;; Private variables
+;;; ************************************************************************
+
+(defvar hwww:mode-map nil)
+
+(provide 'hsys-www)