cgit.sxemacs.org Git - packages/blob - xemacs-packages/xslt-process/lisp/xslt-process.el

   1 ;;;; xslt-process.el -- Invoke an XSLT processor on an Emacs buffer
   2
   3 ;; Package: xslt-process
   4 ;; Author: Ovidiu Predescu <ovidiu@cup.hp.com>
   5 ;; Created: December 2, 2000
   6 ;; Time-stamp: <April 30, 2001 22:39:27 ovidiu>
   7 ;; Keywords: XML, XSLT
   8 ;; URL: http://www.geocities.com/SiliconValley/Monitor/7464/
   9 ;; Compatibility: XEmacs 21.1, Emacs 20.4
  10
  11 ;; This file is not part of GNU Emacs
  12
  13 ;; Copyright (C) 2000, 2001 Ovidiu Predescu
  14
  15 ;; This program is free software; you can redistribute it and/or
  16 ;; modify it under the terms of the GNU General Public License as
  17 ;; published by the Free Software Foundation; either version 2 of the
  18 ;; License, or (at your option) any later version.
  19 ;;
  20 ;; This program is distributed in the hope that it will be useful,
  21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  23 ;; General Public License for more details.
  24 ;;
  25 ;; You should have received a copy of the GNU General Public License
  26 ;; along with this program; if not, write to the Free Software
  27 ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  28 ;; 02111-1307, USA.
  29
  30 ;;; Comentary:
  31
  32 ;; To use this package, put the lisp/ directory from this package in
  33 ;; your Emacs load-path and do:
  34 ;;
  35 ;; (autoload 'xslt-process-mode "xslt-process" "Run XSLT processor on buffer" t)
  36 ;;
  37 ;; Then, while being in an XML buffer, use C-cx to invoke the XSLT
  38 ;; processor of your choice. The result will be displayed in another
  39 ;; buffer.
  40
  41 (require 'jde)
  42 (require 'cl)
  43
  44 ;;; User defaults
  45
  46 (defgroup xslt-process nil
  47   "Run an XSLT processor on an Emacs buffer."
  48   :group 'tools)
  49
  50 (defcustom xslt-process-default-processor (list 'Saxon)
  51   "*The default XSLT processor to be applied to an XML document."
  52   :group 'xslt-process
  53   :type '(list
  54           (radio-button-choice
  55            (const :tag "Saxon" Saxon)
  56            (const :tag "Xalan 1.x" Xalan1)
  57            (const :tag "Generic TrAX processor (Saxon 6.1 and greater, Xalan2 etc.)" TrAX)
  58            (const :tag "Cocoon 1.x" Cocoon1))))
  59
  60 (defcustom xslt-process-cocoon1-properties-file ""
  61   "*The location of the Cocoon 1.x properties file."
  62   :group 'xslt-process
  63   :type '(file :must-match t :tag "Properties file"))
  64
  65 (defcustom xslt-process-jvm-arguments nil
  66   "*Additional arguments to be passed to the JVM.
  67 Use this option to pass additional arguments to the JVM that might be
  68 needed for the XSLT processor to function correctly."
  69   :group 'xslt-process
  70   :type '(repeat (string :tag "Argument")))
  71
  72 ;;;###autoload
  73 (defcustom xslt-process-additional-classpath nil
  74   "*Additional Java classpath to be passed when invoking Bean Shell.
  75 Note that modifying this won't have any effect until you restart the
  76 Bean Shell. You can do this by killing the *bsh* buffer."
  77   :group 'xslt-process
  78   :type '(repeat (file :must-match t :tag "Path")))
  79
  80 ;;;###autoload
  81 (defcustom xslt-process-key-binding "\C-c\C-x\C-v"
  82   "*Keybinding for invoking the XSLT processor.
  83 To enter a normal key, enter its corresponding character. To enter a
  84 key with a modifier, either type C-q followed by the desired modified
  85 keystroke, e.g. C-q C-c to enter Control c. To enter a function key,
  86 use the [f1], [f2] etc. notation."
  87   :group 'xslt-process
  88   :type '(string :tag "Key"))
  89
  90 ;;;###autoload
  91 (defcustom xslt-process-mode-line-string " XSLT"
  92   "*String displayed in the modeline when the xslt-process minor
  93 mode is active. Set this to nil if you don't want a modeline
  94 indicator."
  95   :group 'xslt-process
  96   :type 'string)
  97
  98 ;;; End of user customizations
  99
 100 ;;; Minor mode definitions
 101
 102 ;;;###autoload
 103 (defvar xslt-process-mode nil)
 104 ;;;###autoload
 105 (make-variable-buffer-local 'xslt-process-mode)
 106
 107 ;;;###autoload
 108 (defvar xslt-process-mode-map (make-sparse-keymap))
 109
 110 ;;;###autoload
 111 (defun xslt-process-mode (&optional arg)
 112   "Minor mode to invoke an XSLT processor on the current buffer.
 113
 114 This mode spawns off a Java Bean Shell process in the background to
 115 run an XSLT processor of your choice. This minor mode makes use of
 116 Emacs-Lisp functionality defined in JDE, the Java Development
 117 Environment for Emacs.
 118
 119 With no argument, this command toggles the xslt-process mode. With a
 120 prefix argument ARG, turn xslt-process minor mode on iff ARG is
 121 positive.
 122
 123 Bindings:
 124 \\[xslt-process-invoke]: Invoke the XSLT processor on the current buffer.
 125
 126 Hooks:
 127 xslt-process-hook is run after the xslt-process minor mode is entered.
 128
 129 For more information please check:
 130
 131 xslt-process:    http://www.geocities.com/SiliconValley/Monitor/7464/
 132 Emacs JDE:       http://sunsite.dk/jde/
 133 Java Bean Shell: http://www.beanshell.org/
 134 "
 135   (interactive "P")
 136   (setq xslt-process-mode
 137         (if (null arg) (not xslt-process-mode)
 138           (> (prefix-numeric-value arg) 0)))
 139   (define-key xslt-process-mode-map
 140     xslt-process-key-binding 'xslt-process-invoke)
 141                                         ; Force modeline to redisplay
 142   (set-buffer-modified-p (buffer-modified-p)))
 143
 144 (put 'Saxon 'additional-params 'xslt-saxon-additional-params)
 145 (put 'Xalan1 'additional-params 'xslt-xalan1-additional-params)
 146 (put 'TrAX 'additional-params 'xslt-trax-additional-params)
 147 (put 'Cocoon1 'additional-params 'xslt-cocoon1-additional-params)
 148
 149 (defun xslt-saxon-additional-params ())
 150 (defun xslt-xalan1-additional-params ())
 151 (defun xslt-trax-additional-params ())
 152
 153 (defun xslt-cocoon1-additional-params ()
 154   (if (or (null xslt-process-cocoon1-properties-file)
 155           (equal xslt-process-cocoon1-properties-file ""))
 156       (error "No Cocoon properties file specified."))
 157   (bsh-eval (concat "xslt.Cocoon1.setPropertyFilename(\""
 158                     xslt-process-cocoon1-properties-file "\");"))
 159   (setq cocoon-user-agent
 160         (if (and
 161              (local-variable-p 'user-agent (current-buffer))
 162              (boundp 'user-agent))
 163             (if (stringp user-agent)
 164                 user-agent
 165               (symbol-name user-agent))
 166           nil))
 167   (bsh-eval (concat "xslt.Cocoon1.setUserAgent(\""
 168                     cocoon-user-agent "\");"))
 169   (makunbound 'user-agent))
 170
 171 (defun xslt-process-find-xslt-directory ()
 172   "Return the path to the xslt-process directory. On XEmacs check
 173 whether XSLT-process is installed as a package, in which case the
 174 directory structure looks a little different."
 175   (let ((dir nil))
 176     (if (featurep 'xemacs)
 177         (setq dir (locate-data-directory "xslt-process")))
 178     (when (not dir)
 179       (setq dir (concat (file-name-directory (locate-library "xslt-process"))
 180                         ".." xslt-process-dir-separator)))
 181     (file-truename dir)))
 182
 183 (defun xslt-process-invoke ()
 184   "This is the main function which invokes the XSLT processor of your
 185 choice on the current buffer."
 186   (interactive)
 187   (let* ((temp-directory
 188           (or (if (fboundp 'temp-directory) (temp-directory))
 189               (if (boundp 'temporary-file-directory) temporary-file-directory)))
 190          (classpath
 191           (if (boundp 'jde-global-classpath)
 192               jde-global-classpath
 193             nil))
 194          (classpath-env (if (getenv "CLASSPATH")
 195                             (split-string (getenv "CLASSPATH")
 196                                           jde-classpath-separator)
 197                           nil))
 198          (out-buffer (get-buffer-create "*xslt output*"))
 199          (msg-buffer (get-buffer-create "*xslt messages*"))
 200          (filename (if (buffer-file-name)
 201                        (expand-file-name (buffer-file-name))
 202                      (error "No filename associated with this buffer.")))
 203          (xslt-jar (concat
 204                     (xslt-process-find-xslt-directory) "java/xslt.jar"))
 205          (tmpfile (make-temp-name (concat temp-directory "/xsltout")))
 206          ; Set the name of the XSLT processor. This is either specified
 207          ; in the local variables of the file or is the default one.
 208          (xslt-processor
 209           (progn
 210             ; Force evaluation of local variables
 211             (hack-local-variables t)
 212             (or
 213              (if (and
 214                   (local-variable-p 'processor (current-buffer))
 215                   (boundp 'processor))
 216                  (if (stringp processor)
 217                      processor
 218                    (symbol-name processor)))
 219              (symbol-name (car xslt-process-default-processor))))))
 220     (save-excursion
 221       ; Reset any local variables in the source buffer so the next
 222       ; time we execute we correctly pick up the default processor
 223       ; even if the user decides to remove the local variable
 224       (makunbound 'processor)
 225       ; Prepare to invoke the Java method to process the XML document
 226       (setq jde-global-classpath
 227             (mapcar 'expand-file-name
 228                     (union (append jde-global-classpath (list xslt-jar))
 229                            (union xslt-process-additional-classpath
 230                                   classpath-env))))
 231       ; Append the additional arguments to the arguments passed to bsh
 232       (setq bsh-vm-args (union xslt-process-jvm-arguments bsh-vm-args))
 233       ; Setup additional arguments to the processor
 234       (setq func (get (intern-soft xslt-processor) 'additional-params))
 235       (if (not (null func)) (funcall func))
 236       ; Prepare the buffers
 237       (save-some-buffers)
 238       (set-buffer msg-buffer)
 239       (erase-buffer)
 240       (set-buffer out-buffer)
 241       (erase-buffer)
 242       ; Invoke the processor, displaying the result in a buffer and
 243       ; any error messages in an additional buffer
 244       (condition-case nil
 245           (progn
 246             (setq messages (bsh-eval
 247                             (concat "xslt." xslt-processor ".invoke(\""
 248                                     filename "\", \"" tmpfile
 249                                     "\");")))
 250             (setq jde-global-classpath classpath)
 251             (if (file-exists-p tmpfile)
 252                 (progn
 253                   (set-buffer out-buffer)
 254                   (insert-file-contents tmpfile)
 255                   (delete-file tmpfile)
 256                   (display-buffer out-buffer)
 257                   (if (not (string= messages ""))
 258                       (xslt-process-display-messages messages
 259                                                      msg-buffer out-buffer))
 260                   (message "Done invoking %s." xslt-processor))
 261               (message (concat "Cannot process "
 262                                (file-name-nondirectory filename) "."))
 263               (xslt-process-display-messages messages msg-buffer out-buffer)))
 264         (error (progn
 265                  (message
 266                   (concat "Could not process file, most probably "
 267                           xslt-processor
 268                           " could not be found!"))
 269                  (setq jde-global-classpath classpath)))))))
 270
 271 (defun xslt-process-display-messages (messages msg-buffer out-buffer)
 272   (set-buffer msg-buffer)
 273   (insert messages)
 274   (let ((msg-window (get-buffer-window msg-buffer))
 275         (out-window (get-buffer-window out-buffer)))
 276     (if (not msg-window)
 277         (split-window out-window))
 278     (display-buffer msg-buffer)))
 279
 280 ;;;###autoload
 281 (if (fboundp 'add-minor-mode)
 282     (add-minor-mode 'xslt-process-mode
 283                     xslt-process-mode-line-string
 284                     xslt-process-mode-map
 285                     nil
 286                     'xslt-process-mode)
 287   (or (assoc 'xslt-process-mode minor-mode-alist)
 288       (setq minor-mode-alist
 289             (cons '(xslt-process-mode xslt-process-mode-line-string)
 290                   minor-mode-alist)))
 291
 292   (or (assoc 'xslt-process-mode minor-mode-map-alist)
 293       (setq minor-mode-map-alist
 294             (cons (cons 'xslt-process-mode xslt-process-mode-map)
 295                   minor-mode-map-alist))))
 296
 297 (provide 'xslt-process)