;;;; sgmls.el --- LISP front end for SGMLS and a postprocessor. ;;; Copyright (C) 1994 David Megginson ;;; Author: David Megginson <dmeggins@aix1.uottawa.ca> ;;; Like Gnu Emacs, 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 of the License, 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, which is required to run it; if not, write to ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA ;;; 02139, USA. ;;;; Commentary ;;; A LISP front end for the SGMLS parser and any postprocessors. ;;; This package provides a convenient front end for the free SGMLS ;;; parser and any postprocessors (such as perl scripts or the simple ;;; SGMLSASP program supplied with SGMLS). With a single command, ;;; emacs will cause an SGML source file to be parsed and processed in ;;; the background, placing the final output in a separate buffer. ;;;; USAGE ;;; Place this file somewhere in your load path, byte-compile it if ;;; you wish (it is not speed-critical), and add one of the following ;;; sequences to your default.el or .emacs file: ;;; ;;; (autoload 'sgmls "sgmls" nil t) ;;; (autoload 'sgmls-edit-spec "sgmls" nil t) ;;; (autoload 'sgmls-start-process "sgmls") ;;; ;;; __OR__ ;;; ;;; (require 'sgmls) ;;; ;;; The first will load sgmls.el only upon demand, while the second ;;; will load it unconditionally whenever emacs starts. You may then ;;; run the package simply by typing "M-x sgmls" (you may, of course, ;;; prefer to bind it to a keystroke). ;;;; CONFIGURATION ;;; This package is highly configurable, but its default setup should ;;; work well for the average user. All of the options are documented ;;; in the next section under "User Options" -- the most important are ;;; `sgmls-spec', which contains the name of the file containing a ;;; specification for the postprocessor; `sgmls-spec-directory', which ;;; contains a default directory for the specs; `sgmls-postprocessor', ;;; which contains the name of the postprocessor program ("sgmlsasp" ;;; by default); and `sgmls-decl' (or `sgml-declaration' from ;;; psgml.el), which contains the name of the file containing an SGML ;;; declaration. All of these options are buffer-local, and may be ;;; set in the "Local Variables:" section of a file. ;;; ;;; If you call `sgmls' with prefix argument, you will be given an ;;; opportunity to review and override all of the default settings. ;;;; KNOWN BUGS ;;; Because of the way that Emacs and this package handles the ;;; processes, errors are not handled cleanly. The exit status ;;; displayed when the process terminates applies only to the ;;; postprocessor; the exit status of the SGMLS parser itself, which ;;; is the first element in the pipeline, is not indicated unless the ;;; postprocessor is smart enough to notice that something is wrong. ;;; Furthermore, since Emacs always mixes the stdout and stderr of its ;;; subprocesses together, any error messages will simply be embedded ;;; in the middle of the output buffer. ;;;; User Options. (defvar sgmls-parser-command nil "*Command for running SGMLS.") (make-variable-buffer-local 'sgmls-parser-command) (defvar sgmls-postprocessor-command nil "*Command for running SGMLS postprocessor") (make-variable-buffer-local 'sgmls-postprocessor-command) (defvar sgmls-parser "sgmls" "*Name of SGMLS program on local system (buffer-local).") (make-variable-buffer-local 'sgmls-parser) (defvar sgmls-parser-options "" "*Options for SGMLS parser.") (make-variable-buffer-local 'sgmls-parser-options) (defvar sgmls-declaration nil "*Default SGML declaration (buffer-local). If this variable is not set, the variable `sgml-declaration' (from psgml.el) will be tried.") (make-variable-buffer-local 'sgmls-declaration) (defvar sgmls-source-file nil "*Default SGML source file (buffer-local). By default, this will usually be the file associated with the current buffer, but it can also be generated from the `sgml-parent-document' variable (from psgml.el), or set manually.") (make-variable-buffer-local 'sgmls-source-file) (defvar sgmls-postprocessor "sgmlsasp" "*Name of SGMLS postprocessor on local system (buffer-local).") (make-variable-buffer-local 'sgmls-postprocessor) (defvar sgmls-postprocessor-options "" "*Options for SGMLS postprocessor.") (make-variable-buffer-local 'sgmls-postprocessor-options) (defvar sgmls-spec nil "*Default specification file or argument for postprocessor (buffer-local). This may be specified relative to `sgmls-spec-directory'.") (make-variable-buffer-local 'sgmls-spec) (defvar sgmls-spec-directory nil "*Default directory for sgmls-spec.") (make-variable-buffer-local 'sgmls-spec-directory) (defvar sgmls-output-file nil "*Default file name for sgmls output file (buffer-local). This may be specified relative to `sgmls-output-directory', and may be generated automatically from the source file using `sgmls-output-file-ext'.") (make-variable-buffer-local 'sgmls-output-file) (defvar sgmls-output-file-ext nil "*Default extension for sgmls output file (buffer-local). If `sgmls-output-file' is not set, it will be generated from the source file using the extension provided here.") (make-variable-buffer-local 'sgmls-output-file-ext) (defvar before-sgmls-hooks nil "*Hooks to run on the output buffer before SGMLS starts (buffer-local).") (make-variable-buffer-local 'before-sgmls-hooks) (defvar after-sgmls-hooks nil "*Hooks to run on the output buffer after SGMLS finishes (buffer-local).") (make-variable-buffer-local 'after-sgmls-hooks) ;;; Internal variables. (defvar sgmls::parser-error-file nil) (make-variable-buffer-local 'sgmls::parser-error-file) (defvar sgmls::postprocessor-error-file) (make-variable-buffer-local 'sgmls::postprocessor-error-file) ;;;; User-level commands and functions. ;; ;; Interactive function to set up command line and run sgmls. ;; (defun sgmls (flag) "Run sgmls and a postprocessor, putting the output into a file buffer. With a prefix argument, allow the caller to review and override any default values. The variables `sgmls-parser' and `sgmls-postprocessor' contain the actual names of the programs which will be run (in a shell command sent to `shell-file-name')." (interactive "P") (if (or flag (not sgmls-parser-command)) (setq sgmls-parser-command (format "%s %s %s %s" sgmls-parser sgmls-parser-options (sgmls::generate-declaration) (sgmls::generate-source-file)))) (setq sgmls-parser-command (read-string "Parser command: " (cons sgmls-parser-command 1))) (if (or flag (not sgmls-postprocessor-command)) (setq sgmls-postprocessor-command (format "%s %s %s" sgmls-postprocessor sgmls-postprocessor-options (sgmls::generate-spec flag)))) (setq sgmls-postprocessor-command (read-string "Postprocessor command: " (cons sgmls-postprocessor-command 1))) (sgmls-start-process (format "%s 2>%s | %s 2>%s" sgmls-parser-command (sgmls::generate-parser-error-file) sgmls-postprocessor-command (sgmls::generate-postprocessor-error-file)) (find-file-noselect (sgmls::generate-output-file flag)))) ;; ;; Edit the spec associated with a buffer. ;; (defun sgmls-edit-spec () "Edit the SGMLS spec associated with a buffer. If the local variable `sgmls-spec' is set, the file will be loaded with `find-file-other-window'; otherwise, an error will be signaled." (interactive) (if sgmls-spec (find-file-other-window (expand-file-name sgmls-spec sgmls-spec-directory)) (error "No spec is currently assigned (see `sgmls-spec')."))) ;; ;; Actually run sgmls and the sgmls post-processor. ;; (defun sgmls-start-process (command buffer) "Run an SGMLS command, placing its output into the given buffer. The command should be a string which will be passed to the shell." (save-some-buffers) (let ((old-buffer (current-buffer)) (parser-error-file sgmls::parser-error-file) (postprocessor-error-file sgmls::postprocessor-error-file) (before-hooks before-sgmls-hooks) (after-hooks after-sgmls-hooks) proc) (set-buffer buffer) (display-buffer buffer) (setq sgmls::parser-error-file parser-error-file) (setq sgmls::postprocessor-error-file postprocessor-error-file) (setq before-sgmls-hooks before-hooks) (setq after-sgmls-hooks after-hooks) (if (and (> (point-max) (point-min)) (yes-or-no-p (format "Discard current contents of buffer %s? " (buffer-name buffer)))) (erase-buffer)) (goto-char (point-max)) (run-hooks 'before-sgmls-hooks) (set-buffer old-buffer) (setq proc (start-process "sgmls" buffer "nice" shell-file-name "-c" command)) (set-process-sentinel proc (function sgmls::process-sentinel)) (message "Converting from %s to %s (process: %s)..." (file-name-nondirectory sgmls-source-file) (file-name-nondirectory sgmls-output-file) (process-name proc)) proc)) ;;;; Internal functions. ;; ;; Sentinel for end of program run. ;; (defun sgmls::process-sentinel (proc message) (let ((old-buffer (current-buffer)) (stat (process-status proc)) msg) (unwind-protect (progn (set-buffer (process-buffer proc)) (cond ((eq stat 'exit) (setq msg (format "SGMLS: process \"%s\" finished with status %d." (process-name proc) (process-exit-status proc))) (goto-char (point-min)) (run-hooks 'after-sgmls-hooks) (display-buffer (process-buffer proc))) ((or (eq stat 'signal) (eq stat 'closed)) (error "SGMLS: %S %s." proc message))) (sgmls::check-error-files proc sgmls::parser-error-file sgmls::postprocessor-error-file)) (delete-file sgmls::parser-error-file) (delete-file sgmls::postprocessor-error-file) (set-buffer old-buffer) (if msg (message msg))))) ;; ;; Check whether there is anything in the error files. ;; (defun sgmls::check-error-files (proc parser-file postprocessor-file) (let ((old-buffer (current-buffer)) (parser-buffer (get-buffer-create (concat "**" (buffer-name (process-buffer proc)) ": parser errors**"))) (postprocessor-buffer (get-buffer-create (concat "**" (buffer-name (process-buffer proc)) ": postprocessor errors**"))) window) (set-buffer parser-buffer) (erase-buffer) (insert-file parser-file) (if (> (point-max) (point-min)) (setq window (display-buffer parser-buffer)) (kill-buffer parser-buffer)) (if window (set-window-dedicated-p window t)) (set-buffer postprocessor-buffer) (erase-buffer) (insert-file postprocessor-file) (if (> (point-max) (point-min)) (display-buffer postprocessor-buffer) (kill-buffer postprocessor-buffer)) (set-buffer old-buffer) (cond (window (set-window-dedicated-p window nil) (balance-windows))))) ;; ;; Generate a declaration to use for sgmls. By default, return the ;; empty string unless `sgmls-decl' or `sgml-declaration' is set to ;; something. Flag currently has no effect. ;; (defun sgmls::generate-declaration () (cond (sgmls-declaration) ((and (boundp 'sgml-declaration) sgml-declaration) sgml-declaration) (t ""))) ;; ;; Return the name of a source file to use. Will try ;; `sgml-parent-document' (from psgml.el) first, then will look for ;; the buffer's file name, then will prompt only if all else fails. ;; (defun sgmls::generate-source-file () (cond ((boundp 'sgmls-parent-document) (if (consp sgml-parent-document) (setq sgmls-source-file (car sgml-parent-document)) (setq sgmls-source-file sgml-parent-document))) (t (setq sgmls-source-file (file-name-nondirectory (buffer-file-name))))) sgmls-source-file) ;; ;; Return the name of a spec to use. ;; (defun sgmls::generate-spec (flag) (let ((buffer-file-name nil)) (if sgmls-spec-directory (setq sgmls-spec-directory (file-name-as-directory sgmls-spec-directory))) (if (or flag (null sgmls-spec)) (setq sgmls-spec (read-file-name "SGMLS spec: " (if sgmls-spec (file-name-directory sgmls-spec) sgmls-spec-directory) nil 1 (if sgmls-spec (file-name-nondirectory sgmls-spec))))) (if (and (file-readable-p sgmls-spec) (not (file-directory-p sgmls-spec))) sgmls-spec (if (and (file-readable-p (expand-file-name sgmls-spec sgmls-spec-directory)) (not (file-directory-p (expand-file-name sgmls-spec sgmls-spec-directory)))) (setq sgmls-spec (expand-file-name sgmls-spec sgmls-spec-directory)) (error "SGMLS spec \"%s\" is not readable or is a directory." sgmls-spec))))) ;; ;; Return the name of a temporary file to use for recording errors ;; from the parser or the postprocessor. ;; (defun sgmls::generate-parser-error-file () (setq sgmls::parser-error-file (make-temp-name "/tmp/sgmlspa"))) ;; ;; Return the name of a file for SGMLS postprocessor output. ;; (defun sgmls::generate-output-file (flag) ;; Try to set up default values. (if (and (not sgmls-output-file) sgmls-output-file-ext (buffer-file-name) (or (string-match "^\\(.*\\)\\(\\.[^.]*\\)$" (buffer-file-name)) (string-match "^\\(.+\\)$" (buffer-file-name)))) (setq sgmls-output-file (expand-file-name (concat (substring (buffer-file-name) (match-beginning 1) (match-end 1)) "." sgmls-output-file-ext)))) ;; Prompt if necessary. (setq sgmls-output-file (read-file-name "SGMLS output file: " nil sgmls-output-file nil (if sgmls-output-file (file-name-nondirectory sgmls-output-file)))) (if (string= (expand-file-name sgmls-source-file) (expand-file-name sgmls-output-file)) (progn (setq sgmls-output-file nil) (error "SGMLS: source file and output file are the same."))) sgmls-output-file) ;; ;; Generate the name of a temporary file to use for postprocessor errors. ;; (defun sgmls::generate-postprocessor-error-file () (setq sgmls::postprocessor-error-file (make-temp-name (concat "/tmp/sgmlspp")))) (provide 'sgmls)