Mercurial > hg > xemacs-beta

comparison lisp/hm--html-menus/html-view.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; html-view.el --- routines for communicating with a NCSA Mosaic process
2 ;;;
3 ;;; Some routines for communicating with a NCSA Mosaic process.
4 ;;;
5 ;;; Copyright (C) 1993 Ron Tapia tapia@hydra.unm.edu
6 ;;; Copyright (C) 1994, 1995 Heiko Münkel muenkel@tnt.uni-hannover.de
7 ;;;
8 ;;; VERSION: 1.10
9 ;;; LAST MODIFIED: 20/07/95
10 ;;; Keywords: comm unix wp help
11 ;;;
12 ;;; Adapted to the lemacs: 19.07.1993 Heiko Muenkel
13 ;;; (muenkel@tnt.uni-hannover.de)
14 ;;; Changed: 19.07.1993 by Heiko Muenkel
15 ;;; Changed: 28.12.1993 by Heiko Muenkel
16 ;;; Changed (signal-process id 30)
17 ;;; to (signal-process id html-sigusr1-signal-value)
18 ;;; Addapted the file for the new Mosaic-2.1
19 ;;; Thanks to Neal Becker, who has reported this problem.
20 ;;; The file now requires the package hm--html-menus.
21 ;;; But you can also delete the line (require 'hm--html) and
22 ;;; add a line like (setq html-sigusr1-signal-value 30)
23 ;;; Changed: 10.01.1994 by Heiko Muenkel
24 ;;; Fixed a bug.
25 ;;; Changed: 16.12.1994 by Heiko Münkel
26 ;;; Addapted the file for Mosaic-2.4.
27 ;;; Changed: 03.02.1995 by Heiko Münkel
28 ;;; The "view-buffer" is now different from the original buffer.
29 ;;; So the name of the original buffer isn't change anymore.
30 ;;; Changed: 02.04.1995 by Heiko Münkel
31 ;;; Integrated the changes from the XEmacs distribution.
32 ;;; Changed: 20.07.1995 by Heiko Münkel
33 ;;; Fixed a bug in html-view-goto-url.
34 ;;;
35 ;;; This program is free software; you can redistribute it and/or
36 ;;; modify it under the terms of the GNU General Public License as
37 ;;; published by the Free Software Foundation; either version 2, or
38 ;;; (at your option) any later version.
39 ;;;
40 ;;; This program is distributed in the hope that it will be useful,
41 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
42 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
43 ;;; General Public License for more details.
44 ;;;
45 ;;; You should have received a copy of the GNU General Public License
46 ;;; along with GNU Emacs; see the file COPYING. If not, write to the
47 ;;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
48 ;;;
49 ;;; Commentary:
50 ;;; To use, just set the value of html-view-mosaic-command to whatever you
51 ;;; use to run NCSA Mosaic. You may have to set html-view-tmp-file.
52 ;;; Type M-x html-view-start-mosaic <ret>.
53 ;;; Afterwards, view files/buffers with html-view-view-file/
54 ;;; html-view-view-buffer. There's also a command, of dubious utility,
55 ;;; for jumping to particular documents: html-view-goto-url
56 ;;;
57 ;;; If you have any questions or comments mail to tapia@hydra.unm.edu.
58
59
60 (require 'hm--html)
61
62 (defvar html-view-mosaic-process nil "The NCSA Mosaic Process")
63
64 (defvar html-view-mosaic-command "mosaic"
65 "The command that runs Mosaic on your system")
66
67 (defvar html-view-mosaic-tmp-file-prefix "/tmp/Mosaic."
68 "Prefix for the temp files, which are used by Mosaic.
69 For old versions this must be \"/tmp/xmosaic.\".
70 For new versions it is \"/tmp/Mosaic.\".")
71
72 (defvar html-view-tmp-file (concat "/tmp/mosaic.html-"
73 (user-login-name)
74 (emacs-pid))
75 "File where buffers are saved for viewing by Mosaic")
76
77 (defvar html-view-display nil "The display that Mosaic is using.")
78
79 (defvar html-view-wait-counter 100000
80 "*Counter for a wait loop.
81 The wait loop is beween the start of the Mosaic and the command
82 `set-process-sentinel'. If Mosaic don't start, then you must set
83 this value higher. You can try to set it to a lower number otherwise.")
84
85 ;;;###autoload
86 (defun html-view-start-mosaic ()
87 "Start Mosaic."
88 (interactive)
89 (or (stringp html-view-display)
90 (call-interactively 'html-view-get-display))
91 (or (and (processp html-view-mosaic-process)
92 (eq (process-status html-view-mosaic-process) 'run))
93 (progn (setq html-view-mosaic-process
94 (start-process "mosaic" "mosaic"
95 html-view-mosaic-command
96 "-display" html-view-display))
97 (let ((i html-view-wait-counter))
98 (while (> i 0)
99 (setq i (1- i))))
100 (set-process-sentinel html-view-mosaic-process
101 'html-view-mosaic-process-sentinel))))
102
103 ;;;###autoload
104 (defun html-view-view-file (filename)
105 "View an html file with Mosaic."
106 (interactive "fFile to view: ")
107 (or (and (processp html-view-mosaic-process)
108 (eq (process-status html-view-mosaic-process) 'run))
109 (html-view-start-mosaic))
110 (if (and (processp html-view-mosaic-process)
111 (eq (process-status html-view-mosaic-process) 'run))
112 (progn
113 (let ((buffer (process-buffer html-view-mosaic-process))
114 (id (process-id html-view-mosaic-process))
115 (file nil))
116 (save-excursion
117 (set-buffer buffer)
118 (erase-buffer)
119 (setq file (format "%s%s" html-view-mosaic-tmp-file-prefix id))
120 (set-visited-file-name file)
121 ;; (set-visited-file-name (concat "/tmp/Mosaic."
122 ;; (number-to-string id)))
123 (insert-before-markers "goto\n")
124 (insert-before-markers (concat
125 "file://"
126 (expand-file-name filename)))
127 (save-buffer)
128 (signal-process id html-sigusr1-signal-value))))
129 (message "Can't start mosaic process.")))
130
131 ;;;###autoload
132 (defun html-view-view-buffer (&optional buffer-to-view)
133 "View html buffer with Mosaic.
134 If BUFFER-TO-VIEW is nil, then the current buffer is used."
135 (interactive)
136 (or (bufferp buffer-to-view)
137 (setq buffer-to-view (current-buffer)))
138 (save-excursion
139 (find-file html-view-tmp-file)
140 (insert-buffer buffer-to-view)
141 (write-file html-view-tmp-file)
142 (html-view-view-file html-view-tmp-file)))
143
144 ;;;###autoload
145 (defun html-view-goto-url (url)
146 "Goto an URL in Mosaic."
147 (interactive "sURL: ")
148 (or (processp html-view-mosaic-process)
149 (html-view-start-mosaic))
150 (if (processp html-view-mosaic-process)
151 (progn
152 (let ((buffer (process-buffer html-view-mosaic-process))
153 (id (process-id html-view-mosaic-process))
154 (file nil))
155 (save-excursion
156 (set-buffer buffer)
157 (erase-buffer)
158 ;; (setq file (format "%s%s" "/tmp/xmosaic." id))
159 (setq file (format "%s%s" html-view-mosaic-tmp-file-prefix id))
160 (set-visited-file-name file)
161 ;; (set-visited-file-name (concat "/tmp/Mosaic."
162 ;; (number-to-string id)))
163 (insert-before-markers "goto\n")
164 (insert-before-markers url)
165 (save-buffer)
166 (signal-process id html-sigusr1-signal-value))))
167 (message "Can't start mosaic process.")))
168
169 ;;;###autoload
170 (defun html-view-get-display (display)
171 "Get the display for Mosaic."
172 (interactive "sDisplay: ")
173 (setq html-view-display display))
174
175
176 (defun html-view-mosaic-process-sentinel (proc, event)
177 (cond ((or (string-match "exited abnormally with code" event)
178 (string-match "finished" event))
179 (message event)
180 (setq html-view-mosaic-process nil))
181 (t (message event))))
182
183
184 (provide 'html-view)