diff lisp/hm--html-menus/html-view.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/hm--html-menus/html-view.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,184 @@
+;;; html-view.el --- routines for communicating with a NCSA Mosaic process
+;;;
+;;; Some routines for communicating with a NCSA Mosaic process.
+;;; 
+;;; Copyright (C) 1993 Ron Tapia tapia@hydra.unm.edu
+;;; Copyright (C) 1994, 1995 Heiko Münkel muenkel@tnt.uni-hannover.de
+;;;
+;;; VERSION: 1.10
+;;; LAST MODIFIED: 20/07/95
+;;; Keywords: comm unix wp help
+;;;
+;;; Adapted to the lemacs: 19.07.1993 Heiko Muenkel 
+;;;			   (muenkel@tnt.uni-hannover.de)
+;;; Changed: 19.07.1993 by Heiko Muenkel
+;;; Changed: 28.12.1993 by Heiko Muenkel
+;;;	Changed (signal-process id 30)
+;;;	to	(signal-process id html-sigusr1-signal-value)
+;;;	Addapted the file for the new Mosaic-2.1
+;;;	Thanks to Neal Becker, who has reported this problem.
+;;;	The file now requires the package hm--html-menus.
+;;;	But you can also delete the line (require 'hm--html) and
+;;;	add a line like (setq html-sigusr1-signal-value 30)
+;;; Changed: 10.01.1994 by Heiko Muenkel
+;;;	Fixed a bug.
+;;; Changed: 16.12.1994 by Heiko Münkel
+;;;     Addapted the file for Mosaic-2.4.
+;;; Changed: 03.02.1995 by Heiko Münkel
+;;;	The "view-buffer" is now different from the original buffer.
+;;;	So the name of the original buffer isn't change anymore. 
+;;; Changed: 02.04.1995 by Heiko Münkel
+;;;	Integrated the changes from the XEmacs distribution.
+;;; Changed: 20.07.1995 by Heiko Münkel
+;;;	Fixed a bug in html-view-goto-url.
+;;; 
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License as
+;;; published by the Free Software Foundation; either version 2, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;;
+;;; Commentary: 
+;;; To use, just set the value of html-view-mosaic-command to whatever you
+;;; use to run NCSA Mosaic. You may have to set html-view-tmp-file.
+;;; Type M-x html-view-start-mosaic <ret>. 
+;;; Afterwards, view files/buffers with html-view-view-file/
+;;; html-view-view-buffer. There's also a command, of dubious utility,
+;;; for jumping to particular documents: html-view-goto-url
+;;;
+;;; If you have any questions or comments mail to tapia@hydra.unm.edu.
+
+
+(require 'hm--html)
+
+(defvar html-view-mosaic-process nil "The NCSA Mosaic Process")
+
+(defvar html-view-mosaic-command "mosaic"  
+  "The command that runs Mosaic on your system")
+
+(defvar html-view-mosaic-tmp-file-prefix "/tmp/Mosaic."
+  "Prefix for the temp files, which are used by Mosaic.
+For old versions this must be \"/tmp/xmosaic.\".
+For new versions it is \"/tmp/Mosaic.\".")
+
+(defvar html-view-tmp-file (concat "/tmp/mosaic.html-" 
+				   (user-login-name)
+				   (emacs-pid))
+  "File where buffers are saved for viewing by Mosaic")
+
+(defvar html-view-display nil "The display that Mosaic is using.")
+
+(defvar html-view-wait-counter 100000
+  "*Counter for a wait loop.
+The wait loop is beween the start of the Mosaic and the command 
+`set-process-sentinel'. If Mosaic don't start, then you must set
+this value higher. You can try to set it to a lower number otherwise.")
+
+;;;###autoload
+(defun html-view-start-mosaic ()
+  "Start Mosaic."
+  (interactive)
+  (or (stringp html-view-display)
+      (call-interactively 'html-view-get-display))
+  (or (and (processp html-view-mosaic-process)
+	   (eq (process-status html-view-mosaic-process) 'run))
+      (progn (setq html-view-mosaic-process 
+		   (start-process "mosaic" "mosaic" 
+				  html-view-mosaic-command 
+				  "-display" html-view-display))
+	     (let ((i html-view-wait-counter))
+	       (while (> i 0)
+		 (setq i (1- i))))
+	     (set-process-sentinel html-view-mosaic-process
+				   'html-view-mosaic-process-sentinel))))
+ 
+;;;###autoload
+(defun html-view-view-file (filename)
+  "View an html file with Mosaic."
+  (interactive "fFile to view: ")
+  (or (and (processp html-view-mosaic-process)
+	   (eq (process-status html-view-mosaic-process) 'run))
+      (html-view-start-mosaic))
+  (if (and (processp html-view-mosaic-process)
+	   (eq (process-status html-view-mosaic-process) 'run))
+      (progn
+	(let ((buffer (process-buffer html-view-mosaic-process))
+	      (id (process-id html-view-mosaic-process))
+	      (file nil))
+	  (save-excursion
+	    (set-buffer buffer)
+	    (erase-buffer)
+	    (setq file (format "%s%s" html-view-mosaic-tmp-file-prefix id))
+	    (set-visited-file-name file)
+	    ;;	  (set-visited-file-name (concat "/tmp/Mosaic."
+	    ;;					 (number-to-string id)))
+	    (insert-before-markers "goto\n")
+	    (insert-before-markers (concat
+				    "file://"
+				    (expand-file-name filename)))
+	    (save-buffer)
+	    (signal-process id html-sigusr1-signal-value))))
+    (message "Can't start mosaic process.")))
+	    
+;;;###autoload
+(defun html-view-view-buffer (&optional buffer-to-view)
+  "View html buffer with Mosaic.
+If BUFFER-TO-VIEW is nil, then the current buffer is used."
+  (interactive)
+  (or (bufferp buffer-to-view)
+      (setq buffer-to-view (current-buffer)))
+  (save-excursion
+    (find-file html-view-tmp-file)
+    (insert-buffer buffer-to-view)
+    (write-file html-view-tmp-file)
+    (html-view-view-file html-view-tmp-file)))
+ 
+;;;###autoload
+(defun html-view-goto-url (url)
+  "Goto an URL in Mosaic."
+  (interactive "sURL: ")
+  (or (processp html-view-mosaic-process)
+  (html-view-start-mosaic))
+  (if (processp html-view-mosaic-process)
+  (progn
+    (let ((buffer (process-buffer html-view-mosaic-process))
+	  (id (process-id html-view-mosaic-process))
+	  (file nil))
+      (save-excursion
+	(set-buffer buffer)
+	(erase-buffer)
+;;	(setq file (format "%s%s" "/tmp/xmosaic." id))
+	(setq file (format "%s%s" html-view-mosaic-tmp-file-prefix id))
+	(set-visited-file-name file)
+	;;	  (set-visited-file-name (concat "/tmp/Mosaic."
+	;;					 (number-to-string id)))
+	(insert-before-markers "goto\n")
+	(insert-before-markers url)
+	(save-buffer)
+	(signal-process id html-sigusr1-signal-value))))
+  (message "Can't start mosaic process.")))
+ 
+;;;###autoload
+(defun html-view-get-display (display)
+  "Get the display for Mosaic."
+  (interactive "sDisplay: ")
+  (setq html-view-display display))
+ 
+ 
+(defun html-view-mosaic-process-sentinel (proc, event)
+  (cond ((or (string-match "exited abnormally with code" event)
+	     (string-match "finished" event))
+	 (message event)
+	 (setq html-view-mosaic-process nil))
+	(t (message event))))
+	
+	 
+(provide 'html-view)