cgit.sxemacs.org Git - packages/blob - xemacs-packages/hm--html-menus/html-view.el

   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 ;;; Changed: 05.11.1998 by Heiko Münkel
  35 ;;;     Added (require 'adapt)
  36 ;;;
  37 ;;; This program is free software; you can redistribute it and/or
  38 ;;; modify it under the terms of the GNU General Public License as
  39 ;;; published by the Free Software Foundation; either version 2, or
  40 ;;; (at your option) any later version.
  41 ;;;
  42 ;;; This program is distributed in the hope that it will be useful,
  43 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  44 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  45 ;;; General Public License for more details.
  46 ;;;
  47 ;;; You should have received a copy of the GNU General Public License
  48 ;;; along with GNU Emacs; see the file COPYING.  If not, write to the
  49 ;;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  50 ;;;
  51 ;;; Commentary:
  52 ;;; To use, just set the value of html-view-mosaic-command to whatever you
  53 ;;; use to run NCSA Mosaic. You may have to set html-view-tmp-file.
  54 ;;; Type M-x html-view-start-mosaic <ret>.
  55 ;;; Afterwards, view files/buffers with html-view-view-file/
  56 ;;; html-view-view-buffer. There's also a command, of dubious utility,
  57 ;;; for jumping to particular documents: html-view-goto-url
  58 ;;;
  59 ;;; If you have any questions or comments mail to tapia@hydra.unm.edu.
  60
  61 (require 'adapt)
  62 (require 'hm--html)
  63
  64 (defvar html-view-mosaic-process nil "The NCSA Mosaic Process")
  65
  66 (defvar html-view-mosaic-command "mosaic"
  67   "The command that runs Mosaic on your system")
  68
  69 (defvar html-view-mosaic-tmp-file-prefix "/tmp/Mosaic."
  70   "Prefix for the temp files, which are used by Mosaic.
  71 For old versions this must be \"/tmp/xmosaic.\".
  72 For new versions it is \"/tmp/Mosaic.\".")
  73
  74 (defvar html-view-tmp-file (concat "/tmp/mosaic.html-"
  75                                    (user-login-name)
  76                                    (emacs-pid))
  77   "File where buffers are saved for viewing by Mosaic")
  78
  79 (defvar html-view-display nil "The display that Mosaic is using.")
  80
  81 (defvar html-view-wait-counter 100000
  82   "*Counter for a wait loop.
  83 The wait loop is between the start of the Mosaic and the command
  84 `set-process-sentinel'. If Mosaic don't start, then you must set
  85 this value higher. You can try to set it to a lower number otherwise.")
  86
  87 ;;;###autoload
  88 (defun html-view-start-mosaic ()
  89   "Start Mosaic."
  90   (interactive)
  91   (or (stringp html-view-display)
  92       (call-interactively 'html-view-get-display))
  93   (or (and (processp html-view-mosaic-process)
  94            (eq (process-status html-view-mosaic-process) 'run))
  95       (progn (setq html-view-mosaic-process
  96                    (start-process "mosaic" "mosaic"
  97                                   html-view-mosaic-command
  98                                   "-display" html-view-display))
  99              (let ((i html-view-wait-counter))
 100                (while (> i 0)
 101                  (setq i (1- i))))
 102              (set-process-sentinel html-view-mosaic-process
 103                                    'html-view-mosaic-process-sentinel))))
 104
 105 ;;;###autoload
 106 (defun html-view-view-file (filename)
 107   "View an html file with Mosaic."
 108   (interactive "fFile to view: ")
 109   (or (and (processp html-view-mosaic-process)
 110            (eq (process-status html-view-mosaic-process) 'run))
 111       (html-view-start-mosaic))
 112   (if (and (processp html-view-mosaic-process)
 113            (eq (process-status html-view-mosaic-process) 'run))
 114       (progn
 115         (let ((buffer (process-buffer html-view-mosaic-process))
 116               (id (process-id html-view-mosaic-process))
 117               (file nil))
 118           (save-excursion
 119             (set-buffer buffer)
 120             (erase-buffer)
 121             (setq file (format "%s%s" html-view-mosaic-tmp-file-prefix id))
 122             (set-visited-file-name file)
 123             ;;    (set-visited-file-name (concat "/tmp/Mosaic."
 124             ;;                                   (number-to-string id)))
 125             (insert-before-markers "goto\n")
 126             (insert-before-markers (concat
 127                                     "file://"
 128                                     (expand-file-name filename)))
 129             (save-buffer)
 130             (signal-process id html-sigusr1-signal-value))))
 131     (message "Can't start mosaic process.")))
 132
 133 ;;;###autoload
 134 (defun html-view-view-buffer (&optional buffer-to-view)
 135   "View html buffer with Mosaic.
 136 If BUFFER-TO-VIEW is nil, then the current buffer is used."
 137   (interactive)
 138   (or (bufferp buffer-to-view)
 139       (setq buffer-to-view (current-buffer)))
 140   (save-excursion
 141     (find-file html-view-tmp-file)
 142     (insert-buffer buffer-to-view)
 143     (write-file html-view-tmp-file)
 144     (html-view-view-file html-view-tmp-file)))
 145
 146 ;;;###autoload
 147 (defun html-view-goto-url (url)
 148   "Goto an URL in Mosaic."
 149   (interactive "sURL: ")
 150   (or (processp html-view-mosaic-process)
 151   (html-view-start-mosaic))
 152   (if (processp html-view-mosaic-process)
 153   (progn
 154     (let ((buffer (process-buffer html-view-mosaic-process))
 155           (id (process-id html-view-mosaic-process))
 156           (file nil))
 157       (save-excursion
 158         (set-buffer buffer)
 159         (erase-buffer)
 160 ;;      (setq file (format "%s%s" "/tmp/xmosaic." id))
 161         (setq file (format "%s%s" html-view-mosaic-tmp-file-prefix id))
 162         (set-visited-file-name file)
 163         ;;        (set-visited-file-name (concat "/tmp/Mosaic."
 164         ;;                                       (number-to-string id)))
 165         (insert-before-markers "goto\n")
 166         (insert-before-markers url)
 167         (save-buffer)
 168         (signal-process id html-sigusr1-signal-value))))
 169   (message "Can't start mosaic process.")))
 170
 171 ;;;###autoload
 172 (defun html-view-get-display (display)
 173   "Get the display for Mosaic."
 174   (interactive "sDisplay: ")
 175   (setq html-view-display display))
 176
 177
 178 (defun html-view-mosaic-process-sentinel (proc, event)
 179   (cond ((or (string-match "exited abnormally with code" event)
 180              (string-match "finished" event))
 181          (message event)
 182          (setq html-view-mosaic-process nil))
 183         (t (message event))))
 184
 185
 186 (provide 'html-view)