Mercurial > hg > xemacs-beta
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)