cgit.sxemacs.org Git - packages/blob - xemacs-packages/xslide/xslide.el

   1 ;;;; xslide.el --- XSL Integrated Development Environment
   2 ;; $Id: xslide.el,v 1.11 2003/07/18 23:27:13 tonygraham Exp $
   3
   4 ;; Copyright (C) 1998, 1999, 2000, 2001, 2003 Tony Graham
   5
   6 ;; Author: Tony Graham <tkg@menteith.com>
   7 ;; Contributors: Simon Brooke, Girard Milmeister, Norman Walsh,
   8 ;;               Moritz Maass, Lassi Tuura, Simon Wright, KURODA Akira,
   9 ;;               Ville Skyttä, Glen Peterson
  10 ;; Created: 21 August 1998
  11 ;; Version: $Revision: 1.11 $
  12 ;; Keywords: languages, xsl, xml
  13
  14 ;;; This file is not part of GNU Emacs.
  15
  16 ;; This program is free software; you can redistribute it and/or
  17 ;; modify it under the terms of the GNU General Public License
  18 ;; as published by the Free Software Foundation; either version 2
  19 ;; of the License, or (at your option) any later version.
  20 ;;
  21 ;; This program is distributed in the hope that it will be useful,
  22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 ;; GNU General Public License for more details.
  25 ;;
  26 ;; You should have received a copy of the GNU General Public License
  27 ;; along with this program; if not, write to the Free Software
  28 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  29
  30 \f
  31 ;;;; Commentary:
  32
  33 ;; Functions for editing XSL stylesheets
  34
  35 ;; Requires xslide-font.el, xslide-data.el, xslide-abbrev.el, xslide-process.el
  36 ;; Requires 'etags for `find-tag-default'
  37 ;; Requires 'reporter for `xsl-submit-bug-report'
  38 ;; Requires 'imenu for "Goto" menu
  39 ;;
  40 ;; Send bugs to xslide-bug@menteith.com
  41 ;; Use `xsl-submit-bug-report' for bug reports
  42 \f
  43 ;;;; Code:
  44 (provide 'xslide)
  45
  46 (require 'cl)
  47 (require 'compile)
  48 (require 'font-lock)
  49 ;; XEmacs users don't always have imenu.el installed, so use
  50 ;; condition-case to cope if xslide causes an error by requiring imenu.
  51 (eval-and-compile
  52   (condition-case nil
  53         (require 'imenu)
  54     (error nil)))
  55 ;; Need etags for `find-tag-default'
  56 (require 'etags)
  57
  58 (require 'xslide-data "xslide-data")
  59 (require 'xslide-abbrev "xslide-abbrev")
  60 (require 'xslide-font "xslide-font")
  61 (require 'xslide-process "xslide-process")
  62
  63 ;; Work out if using XEmacs or Emacs
  64 ;; Inspired by 'vm'
  65 (defconst xsl-xemacs-p nil)
  66 (defconst xsl-fsfemacs-p nil)
  67 (defun xsl-xemacs-p () xsl-xemacs-p)
  68 (defun xsl-fsfemacs-p () xsl-fsfemacs-p)
  69 (defun xsl-note-emacs-version ()
  70   (setq xsl-xemacs-p (string-match "XEmacs" emacs-version)
  71         xsl-fsfemacs-p (not xsl-xemacs-p)))
  72 (xsl-note-emacs-version)
  73
  74 ;; Define core `xsl' group.
  75 (defgroup xsl nil
  76   "Major mode for editing XSL."
  77   :prefix "xsl-"
  78   :group 'languages)
  79
  80 (defgroup xsl-faces nil
  81   "Font faces used in XSL mode."
  82   :group 'xsl
  83   :group 'faces)
  84
  85 (defgroup xsl-process nil
  86   "Running XSL processors from XSL mode."
  87   :group 'xsl)
  88
  89 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  90 ;; Version information
  91
  92 (defconst xslide-version "0.2.2"
  93   "Version number of xslide XSL mode.")
  94
  95 (defun xslide-version ()
  96   "Return the value of the variable `xslide-version'."
  97   xslide-version)
  98
  99 (defconst xslide-maintainer-address "xslide-bug@menteith.com")
 100
 101 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 102 ;; Variables
 103
 104 (defvar xsl-indent-tabs-mode nil
 105   "*Initial value of `indent-tabs-mode' on entering `xsl-mode'.")
 106
 107 (defvar xsl-default-filespec "*.xsl"
 108   "*Initial prompt value for `xsl-etags''s FILESPEC argument.")
 109
 110 (defvar xsl-filespec-history (list xsl-default-filespec)
 111   "Minibuffer history list for `xsl-etags' and `xsl-grep''s FILESPEC argument.")
 112
 113 (defvar xsl-grep-pattern-history nil
 114   "Minibuffer history list for `xsl-grep''s PATTERN argument.")
 115
 116 (defvar xsl-grep-case-sensitive-flag nil
 117   "*Non-nil disables case insensitive searches by `xsl-grep'.")
 118
 119 (defvar xsl-comment-start "<!--"
 120   "*Comment start character sequence.")
 121
 122 (defvar xsl-comment-end "-->"
 123   "*Comment end character sequence.")
 124
 125 (defvar xsl-comment-max-column 70
 126   "*Maximum column number for text in a comment.")
 127
 128 (defcustom xsl-initial-stylesheet-file (locate-library "xslide-initial.xsl" t)
 129   "*File containing initial stylesheet inserted into empty XSL buffers."
 130   :type '(choice (file :must-match t) (const :tag "No initial stylesheet" nil))
 131   :group 'xsl)
 132
 133 (defcustom xsl-initial-stylesheet-initial-point 0
 134   "*Initial position of point in initial stylesheet."
 135   :type '(integer)
 136   :group 'xsl)
 137
 138 (defcustom xsl-initial-fo-file (locate-library "xslide-initial.fo" t)
 139   "*File containing initial FO stylesheet inserted into empty XSL buffers."
 140   :type '(choice (file :must-match t) (const :tag "No initial FO file" nil))
 141   :group 'xsl)
 142
 143 (defcustom xsl-initial-fo-initial-point 0
 144   "*Initial position of point in initial FO stylesheet."
 145   :type '(integer)
 146   :group 'xsl)
 147
 148 (defcustom xsl-indent-attributes nil
 149   "*Whether to indent attributes on lines following an open tag.
 150 If non-nil, attributes will be aligned with the space after the
 151 element name, otherwise by two spaces."
 152   :type '(choice (const :tag "Yes" t) (const :tag "No" nil))
 153   :group 'xsl)
 154
 155 (defcustom xsl-element-indent-step 2
 156   "*Amount by which to indent success levels of nested elements."
 157   :type '(integer)
 158   :group 'xsl)
 159
 160 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 161 ;; functions
 162
 163 (defun xsl-read-from-minibuffer (prompt default history)
 164   "Read from minibuffer with default and command history."
 165 (let ((value nil))
 166   (if (string-equal
 167        ""
 168        (setq value
 169              (read-from-minibuffer (if default
 170                                        (format
 171                                         "%s(default `%s') "
 172                                         prompt default)
 173                                      (format "%s" prompt))
 174                                    nil nil nil
 175                                    history)))
 176              default
 177              value)))
 178
 179 ;; XSLIDE house style puts all comments starting on a favourite column
 180 (defun xsl-comment (comment)
 181   "Insert COMMENT starting at the usual column.
 182
 183 With a prefix argument, e.g. \\[universal-argument] \\[xsl-comment], insert separator comment
 184 lines above and below COMMENT in the manner of `xsl-big-comment'."
 185   (interactive "sComment: ")
 186   (insert "\n")
 187   (backward-char)
 188   (xsl-electric-tab)
 189   (let ((fill-column (1- xsl-comment-max-column))
 190         (fill-prefix (make-string (1+ (length xsl-comment-start)) ?\ ))
 191 ;;      (comment-start xsl-init-comment-fill-prefix)
 192         (saved-auto-fill-function auto-fill-function))
 193     (auto-fill-mode 1)
 194     (insert xsl-comment-start)
 195     (insert " ")
 196     (indent-to (length fill-prefix))
 197     (fill-region (point) (save-excursion
 198                            (insert comment)
 199                            (point))
 200                  nil
 201                  1
 202                  1)
 203     ;; The fill does the right thing, but it always ends with
 204     ;; an extra newline, so delete the newline.
 205     (delete-backward-char 1)
 206     (if (not saved-auto-fill-function)
 207         (auto-fill-mode 0))
 208     (insert " ")
 209     (insert xsl-comment-end)
 210     (insert "\n")
 211     (if font-lock-mode
 212         (save-excursion
 213           (font-lock-fontify-keywords-region
 214            (xsl-font-lock-region-point-min)
 215            (xsl-font-lock-region-point-max))))))
 216
 217 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 218 ;; Mode map stuff
 219
 220 (defvar xsl-mode-map nil
 221   "Keymap for XSL mode.")
 222
 223 (if xsl-mode-map
 224     ()
 225   (setq xsl-mode-map (make-sparse-keymap))
 226   (define-key xsl-mode-map [tab]          'xsl-electric-tab)
 227 ;;  (define-key xsl-mode-map "\M-\t"      'xsl-complete)
 228   (define-key xsl-mode-map [(meta tab)]   'xsl-complete)
 229 ;;  (define-key xsl-mode-map "\""         'xsl-electric-quote)
 230 ;;  (define-key xsl-mode-map "'"          'xsl-electric-apos)
 231   (define-key xsl-mode-map "/"            'xsl-electric-slash)
 232   (define-key xsl-mode-map "<"            'xsl-electric-less-than)
 233   (define-key xsl-mode-map ">"            'xsl-electric-greater-than)
 234 ;;  (define-key xsl-mode-map "["          'xsl-electric-lsqb)
 235 ;;  (define-key xsl-mode-map "("          'xsl-electric-lpar)
 236 ;;  (define-key xsl-mode-map "{"          'xsl-electric-lcub)
 237   (define-key xsl-mode-map [(control c) (control c)]
 238                                           'xsl-comment)
 239   (define-key xsl-mode-map [(control c) (control p)]
 240                                           'xsl-process)
 241   (define-key xsl-mode-map [(control o)]
 242                                           'xsl-open-line)
 243   (define-key xsl-mode-map "\C-c<"        'xsl-insert-tag)
 244   (define-key xsl-mode-map "\C-c\C-t"     'xsl-if-to-choose)
 245 ;;  (define-key xsl-mode-map [(control m)]        'xsl-electric-return)
 246 ;;  (define-key xsl-mode-map \10          'xsl-electric-return)
 247   (define-key xsl-mode-map "\177"         'backward-delete-char-untabify)
 248 ;;  (define-key xsl-mode-map "\M-\C-e" 'xsl-next-rule)
 249 ;;  (define-key xsl-mode-map "\M-\C-a" 'xsl-previous-rule)
 250 ;;  (define-key xsl-mode-map "\M-\C-h" 'mark-xsl-rule)
 251 )
 252
 253 (defun xsl-if-to-choose ()
 254   "Converts <xsl:if> to <xsl:choose>.  Works on a single 'ifs' or on a region.
 255 So:
 256
 257 <xsl:if test=\"isFive = 5\"><p>It's five!</p></xsl:if>
 258
 259 Becomes:
 260 <xsl:choose>
 261    <xsl:when test=\"isFive = 5\"><p>It's five!</p></xsl:when>
 262    <xsl:otherwise></xsl:otherwise>
 263 </xsl:choose>
 264
 265 If you put your cursor inside the open-tag of the if, it will work on that tag
 266 only.  If you highlight a region, it will convert every 'if' whose start tag is
 267 within that region.  It is very easy to convert consecutive 'if's to a single
 268 choose by deleting the appropriate lines after executing this command.
 269
 270 Bound to C-c C-t by default."
 271   (interactive)
 272   (let
 273     (
 274       (single-if (not (mark)))
 275       (the-start (point))
 276       (the-end (if (mark) (mark) (point)))
 277     )
 278     (if (and (not (null (mark)))
 279              (< (mark) (point)))
 280       (progn
 281         (exchange-point-and-mark)
 282         (setq the-start (point))
 283         (setq the-end (mark))
 284       )
 285     )
 286     (save-excursion
 287       (if single-if
 288         (progn
 289           (search-backward "<" nil t)
 290 ;          (message "xsl-if-to-choose: single if mode")
 291           (xsl-convert-if-to-choose-slave)
 292         )
 293         (save-excursion
 294 ;          (message
 295 ;            (concat "xsl-if-to-choose: Region mode: "
 296 ;                    (int-to-string the-start)
 297 ;                    " "
 298 ;                    (int-to-string the-end)
 299 ;            )
 300 ;          )
 301           (goto-char the-end)
 302           (if (save-excursion (search-backward "<xsl:if" the-start t))
 303             (while (search-backward "<xsl:if" the-start t)
 304               (xsl-convert-if-to-choose-slave)
 305             )
 306             (message "xsl-if-to-choose error: There's no <xsl:if> within the selected region.")
 307           )
 308         )
 309       )
 310     )
 311   )
 312 )
 313
 314 (defun xsl-convert-if-to-choose-slave ()
 315   (if (looking-at "<xsl:if")
 316     (let
 317       ( (start (save-excursion (beginning-of-line) (point))) )
 318       (delete-char 7)
 319       (insert "<xsl:choose>\n<xsl:when")
 320       (search-forward "</xsl:if>" nil t)
 321       (backward-delete-char 9)
 322       (insert "</xsl:when>\n<xsl:otherwise></xsl:otherwise>\n</xsl:choose>")
 323       (indent-region start (point) nil)
 324     )
 325       (message "xsl-if-to-choose error: point is not within the start tag of an <xsl:if>.")
 326   )
 327 )
 328
 329 (defun xsl-electric-greater-than (arg)
 330   "Insert a \">\" and, optionally, insert a matching end-tag.
 331
 332 If the \">\" closes a start-tag and the start-tag is the last thing on
 333 the line, `xsl-electric-greater-than' inserts the matching end-tag.
 334 Providing a prefix argument, e.g., \\[universal-argument] \\[xsl-electric-greater-than], stops the inserting of the
 335 matching end-tag.
 336
 337 If the element being terminated is listed as a block element in
 338 `xsl-all-elements-alist', then point is left on the next line at the
 339 correct indent and the end-tag is inserted on the following line at
 340 the correct indent.
 341
 342 `xsl-electric-greater-than' also fontifies the region around the
 343 current line."
 344   (interactive "P")
 345   (insert ">")
 346   (if (and
 347        (not arg)
 348        (looking-at "$")
 349        (save-excursion
 350          (let ((limit (point)))
 351            (backward-char)
 352            (search-backward "<")
 353 ;;         (message "%s:%s" (point) limit)
 354            (and
 355             (looking-at "<\\(\\(\\sw\\|\\s_\\)+\\)\\(\\s-+\\(\\sw\\|\\s_\\)+[   ]*=[    ]*\\('[^']*'\\|\"[^\"]*\"\\)\\)*\\s-*\\(/?\\)>")
 356 ;;          (message "%s:%s" limit (match-end 0))
 357             (= (match-end 0) limit)
 358 ;;          (message ":%s:" (match-string 6))
 359             (not (string-equal (match-string 6) "/"))
 360             (not (save-match-data
 361                    (string-match "^/" (match-string 1))))))))
 362       (if (string-equal (nth 1 (assoc (match-string 1) xsl-all-elements-alist)) "block")
 363           (progn
 364             (xsl-electric-return)
 365             (save-excursion
 366               (insert "\n<")
 367               (xsl-electric-slash)))
 368         (save-excursion
 369           (insert (format "</%s>" (match-string 1))))))
 370   (if font-lock-mode
 371       (save-excursion
 372         (font-lock-fontify-region
 373          (xsl-font-lock-region-point-min)
 374          (xsl-font-lock-region-point-max)))))
 375
 376 (defun xsl-electric-apos ()
 377   "Function called when \"'\" is pressed in XSL mode."
 378   (interactive)
 379   (insert "'")
 380   (if (looking-at "\\([\"/})]\\|$\\)")
 381       (save-excursion
 382         (insert "'"))))
 383
 384 (defun xsl-electric-quote ()
 385   "Function called when '\"' is pressed in XSL mode."
 386   (interactive)
 387   (insert "\"")
 388   (if (looking-at "\\(['/})]\\|$\\)")
 389       (save-excursion
 390         (insert "\""))))
 391
 392 (defun xsl-electric-lsqb ()
 393   "Function called when \"[\" is pressed in XSL mode."
 394   (interactive)
 395   (insert "[")
 396   (if (looking-at "\\([\"'/})]\\|$\\)")
 397       (save-excursion
 398         (insert "]"))))
 399
 400 (defun xsl-electric-lpar ()
 401   "Function called when \"(\" is pressed in XSL mode."
 402   (interactive)
 403   (insert "(")
 404   (if (looking-at "\\([\]\"'/}]\\|$\\)")
 405       (save-excursion
 406         (insert ")"))))
 407
 408 (defun xsl-electric-lcub ()
 409   "Function called when \"{\" is pressed in XSL mode."
 410   (interactive)
 411   (insert "{")
 412   (if (looking-at "\\([\])\"'/}]\\|$\\)")
 413       (save-excursion
 414         (insert "}"))))
 415
 416 (defun xsl-electric-less-than ()
 417   "Function called when \"<\" is pressed in XSL mode."
 418   (interactive)
 419   (insert "<")
 420   (xsl-electric-tab))
 421
 422 (defun xsl-match-opening-tag (a)
 423   "Function called to match the next opening tag to a closing tag."
 424   (if (looking-at "</")
 425       (catch 'start-tag
 426         (while (re-search-backward
 427                 (concat "\\(<\\|</\\)" a "[ \t\n\r>]") nil t)
 428           (cond
 429            ((looking-at (concat "</" a))
 430             (xsl-match-opening-tag a))
 431            ((looking-at (concat "<" a))
 432             (throw 'start-tag a))
 433            )))
 434     nil)
 435 )
 436 (defun xsl-electric-slash ()
 437   "Function called when \"/\" is pressed in XSL mode."
 438   (interactive)
 439   (insert "/")
 440   (xsl-electric-tab)
 441   (if (looking-at "$")
 442       (let ((element-name
 443              (save-excursion
 444                (backward-char 2)
 445                (if (looking-at "</")
 446                    (catch 'start-tag
 447                      (while (re-search-backward "<" nil t)
 448                        (cond
 449                         ((looking-at "</\\([^/> \t]+\\)>")
 450 ;;                       (message "End tag: %s" (match-string 1))
 451 ; find matching tag:
 452                          (xsl-match-opening-tag (match-string 1)))
 453 ;;original
 454 ;;                       (re-search-backward
 455 ;;                        (concat "<" (match-string 1) "[ \t\n\r>]") nil t))
 456                         ((looking-at "<\\(\\([^/>]\\|/[^>]\\)+\\)/>"))
 457 ;;                       (message "Empty tag: %s" (match-string 1)))
 458                         ((looking-at "<!--[^-]*\\(-[^-]+\\)*-->"))
 459                         ;; skip CDATA sections
 460                         ((looking-at "<!\\[CDATA\\["))
 461                         ;; XEmacs Change: and the XMLdecl, DOCTYPE and ENTITYs
 462                         ((looking-at
 463                           "<\\(\\?xml\\|!\\(DOCTYPE\\|ENTITY\\)\\)[ \t\n\r]"))
 464                         ((looking-at "<\\([^/> \n\t]+\\)")
 465 ;;                       (message "Start tag: %s" (match-string 1))
 466                          (throw 'start-tag (match-string 1)))
 467                         ((bobp)
 468                          (throw 'start-tag nil)))))
 469                  nil))))
 470         (if element-name
 471             (progn
 472               (insert element-name)
 473               (insert ">")
 474               (if font-lock-mode
 475                   (save-excursion
 476                     (font-lock-fontify-region
 477                      (xsl-font-lock-region-point-min)
 478                      (xsl-font-lock-region-point-max)))))))))
 479
 480 (defun xsl-electric-return ()
 481   "Function called when RET is pressed in XSL mode."
 482   (interactive)
 483   (insert "\n")
 484   (xsl-electric-tab))
 485
 486 (defun xsl-open-line (arg)
 487   (interactive "p")
 488   (if (not arg)
 489       (setq arg 1))
 490   (save-excursion
 491     (while (> arg 0)
 492       (setq arg (1- arg))
 493       (insert "\n"))
 494     (if (looking-at "<")
 495         (xsl-electric-tab))))
 496
 497 (defun xsl-electric-tab ()
 498   "Function called when TAB is pressed in XSL mode."
 499   (interactive)
 500   (save-excursion
 501     (beginning-of-line)
 502     (delete-horizontal-space)
 503     (if (looking-at "</")
 504         (indent-to (max 0 (- (xsl-calculate-indent) xsl-element-indent-step)))
 505       (indent-to (xsl-calculate-indent))))
 506   (if (and
 507        (bolp)
 508        (looking-at "[ \t]+"))
 509       (goto-char (match-end 0)))
 510   (if font-lock-mode
 511       (save-excursion
 512         (font-lock-fontify-keywords-region
 513          (xsl-font-lock-region-point-min)
 514          (xsl-font-lock-region-point-max)))))
 515
 516
 517 (defun xsl-close-open-tab-p nil
 518   "Return t if the current line contains more right than left angle-brackets."
 519   (save-excursion
 520     (beginning-of-line)
 521     (let ((open 0))
 522       (while (not (eolp))
 523         (let ((here (char-after (point))))
 524           (cond
 525            ((eq here '?\>) (setq open (1- open)))
 526            ((eq here '?\<) (setq open (1+ open)))
 527            )
 528           )
 529         (forward-char)
 530         )
 531       (< open 0)                        ; true if we've counted more
 532                                         ; closes than opens
 533       )
 534     )
 535   )
 536
 537 (defun xsl-calculate-indent ()
 538   "Calculate what the indent should be for the current line."
 539   (let* ((limit   (point))
 540          (name    "[^<>=\"' \t\n]+")
 541          (string  "\\(\"[^<>\"]*\"\\|'[^<>']*'\\)")
 542          (ostring "\\(\"[^<>\"]*\\|'[^<>']*\\)")
 543          (attval  (concat name "=" string))
 544          (oattval (concat name "=" ostring))
 545          (element (concat "<\\(" name "\\)"
 546                           "\\([ \t\n]+" attval "\\)*[ \t\n]*"))
 547          (meta    (concat "<!\\(DOCTYPE\\|ENTITY\\)"
 548                           "\\([ \t\n]+\\(" name "\\|" string "\\)\\)*")))
 549     (save-excursion
 550       (if (re-search-backward "^\\([ \t]*\\)<" nil t)
 551           (goto-char (match-end 1))
 552         (beginning-of-line))
 553       (cond
 554        ;; closed comment => stay put
 555        ((save-excursion
 556           (re-search-forward "<!--[^-]*\\(-[^-]+\\)*-->" limit t))
 557         (current-column))
 558        ;; open comment => indent by five
 559        ((looking-at "<!--")
 560         (+ (current-column) 5))
 561        ;; end tag, closed empty tag, open tag immediately followed by
 562        ;; other tags/char data or a complete meta tag => stay put
 563        ((save-excursion
 564           (or (looking-at (concat "</" name ">"))
 565               ;; XEmacs change: grok whitespace before />.
 566               (re-search-forward (concat element "[ \t\n]*/>") limit t)
 567               (re-search-forward (concat element ">[ \t]*[^\n]") limit t)
 568               (re-search-forward (concat meta ">[ \t]*\n") limit t)))
 569         (current-column))
 570        ;; closed open tag followed by new line, or an opening meta tag
 571        ;; => indent by xsl-element-indent-step
 572        ((save-excursion
 573           (or (re-search-forward (concat element ">[ \t]*\n") limit t)
 574               (re-search-forward (concat meta "\\[[ \t]*\n") limit t)))
 575         (+ (current-column) xsl-element-indent-step))
 576        ;; incomplete open tag or open meta => indent after tag name
 577        ((save-excursion
 578           (and (or (re-search-forward (concat element "[ \t\n]*") limit t)
 579                    (re-search-forward (concat meta "[ \t\n]*") limit t))
 580                (= (point) limit)))
 581         (if xsl-indent-attributes
 582             (progn (goto-char (match-end 1))
 583                    (+ (current-column) 1))
 584           (+ (current-column) xsl-element-indent-step)))
 585        ;; incomplete attribute value => indent to string start
 586        ((save-excursion
 587           (and (or (re-search-forward (concat element "[ \t\n]+" oattval)
 588                                       limit t))
 589                (= (point) limit)))
 590         (goto-char (match-beginning 4))
 591         (+ (current-column) 1))
 592        ;; beginning of buffer => stay put (beginning of line)
 593        ((bobp)
 594         (current-column))
 595        ;; otherwise => indent by xsl-element-indent-step
 596        (t
 597         (+ (current-column) xsl-element-indent-step))))))
 598
 599 (defun xsl-complete ()
 600   "Complete the tag or attribute before point.
 601 If it is a tag (starts with < or </) complete with allowed tags,
 602 otherwise complete with allowed attributes."
 603   (interactive "*")
 604   (let ((tab                            ; The completion table
 605          nil)
 606         (pattern nil)
 607         (c nil)
 608         (here (point)))
 609     (skip-chars-backward "^ \n\t</!&%")
 610     (setq pattern (buffer-substring (point) here))
 611     (setq c (char-after (1- (point))))
 612 ;;    (message "%s" c)
 613     (cond
 614      ;; entitiy
 615 ;;     ((eq c ?&)
 616 ;;      (sgml-need-dtd)
 617 ;;      (setq tab
 618 ;;          (sgml-entity-completion-table
 619 ;;           (sgml-dtd-entities (sgml-pstate-dtd sgml-buffer-parse-state)))))
 620      ;; start-tag
 621      ((eq c ?<)
 622 ;;      (save-excursion
 623 ;;      (backward-char 1)
 624 ;;      (sgml-parse-to-here)
 625         (setq tab xsl-all-elements-alist))
 626      ;; end-tag
 627 ;;     ((eq c ?/)
 628 ;;      (save-excursion
 629 ;;      (backward-char 2)
 630 ;;      (sgml-parse-to-here)
 631 ;;      (setq tab (sgml-eltype-completion-table
 632 ;;                 (sgml-current-list-of-endable-eltypes)))))
 633      ;; markup declaration
 634 ;;     ((eq c ?!)
 635 ;;      (setq tab sgml-markup-declaration-table))
 636      ((eq c ? )
 637 ;;      (save-excursion
 638 ;;      (backward-char 1)
 639 ;;      (sgml-parse-to-here)
 640         (setq tab xsl-all-attribute-alist))
 641      (t
 642       (goto-char here)
 643       (ispell-complete-word)))
 644     (when tab
 645       (let ((completion (try-completion pattern tab)))
 646         (cond ((null completion)
 647                (goto-char here)
 648                (message "Can't find completion for \"%s\"" pattern)
 649                (ding))
 650               ((eq completion t)
 651                (goto-char here)
 652                (message "[Complete]"))
 653               ((not (string= pattern completion))
 654                (delete-char (length pattern))
 655                (insert completion))
 656               (t
 657                (goto-char here)
 658                (message "Making completion list...")
 659                (let ((list (all-completions pattern tab)))
 660                  (with-output-to-temp-buffer " *Completions*"
 661                    (display-completion-list list)))
 662                (message "Making completion list...%s" "done")))))))
 663
 664 (defun xsl-insert-tag (tag)
 665   "Insert a tag, reading tag name in minibuffer with completion."
 666   (interactive
 667    (list
 668     (completing-read "Tag: " xsl-all-elements-alist)))
 669   ;;  (xsl-find-context-of (point))
 670   ;;  (assert (null xsl-markup-type))
 671   ;; Fix white-space before tag
 672   ;;  (unless (xsl-element-data-p (xsl-parse-to-here))
 673   (skip-chars-backward " \t")
 674   (cond
 675    ((looking-at "^\\s-*$")
 676     (xsl-electric-tab))
 677    ((looking-at "^\\s-*</")
 678     (save-excursion
 679       (insert "\n"))
 680     (xsl-electric-tab))
 681    ((looking-at "$")
 682     (insert "\n")
 683     (xsl-electric-tab)))
 684   (let ((tag-type (nth 1 (assoc tag xsl-all-elements-alist))))
 685     (cond
 686      ((or
 687        (equal tag-type "block")
 688        (equal tag-type nil))
 689       (insert "<")
 690       (insert tag)
 691       (insert ">")
 692       (save-excursion
 693         (insert "\n")
 694         (xsl-electric-tab)
 695         (insert "<")
 696         (if (looking-at "<")
 697             (progn
 698               (insert "\n")
 699               (backward-char)))
 700         (xsl-electric-slash)))
 701      ((equal tag-type "inline")
 702       (insert "<")
 703       (insert tag)
 704       (insert ">")
 705       (save-excursion
 706         (insert "</")
 707         (insert tag)
 708         (insert ">")))
 709      (t
 710       (insert "<")
 711       (insert tag)
 712       (save-excursion
 713         (insert "/>"))))))
 714
 715 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 716
 717 (defun xsl-insert-template (match)
 718   "Insert a template."
 719   (interactive "smatch=")
 720   (xsl-electric-tab)
 721   (insert (format "<xsl:template match=\"%s\">\n" match))
 722   (xsl-electric-tab)
 723   (save-excursion
 724     (insert "\n<")
 725     (xsl-electric-slash)
 726     (insert "\n")))
 727
 728 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 729 ;; Syntax table stuff
 730
 731 (defvar xsl-mode-syntax-table nil
 732   "Syntax table used while in XSL mode.")
 733
 734 (if xsl-mode-syntax-table
 735     ()
 736   (setq xsl-mode-syntax-table (make-syntax-table))
 737   ;; set the non-alphanumeric characters in XML names to
 738   ;; 'symbol constituent' class
 739   (modify-syntax-entry ?: "_" xsl-mode-syntax-table)
 740   (modify-syntax-entry ?_ "_" xsl-mode-syntax-table)
 741   (modify-syntax-entry ?- "_ 1234" xsl-mode-syntax-table)
 742   (modify-syntax-entry ?. "_" xsl-mode-syntax-table)
 743   ;; "-" is a special case because it is the first and second characters
 744   ;; of the start- and end-comment sequences.
 745   (modify-syntax-entry ?- "_ 1234" xsl-mode-syntax-table)
 746   ;; "%" does double duty in parameter entity declarations and references.
 747   ;; Not necessary to make "%" and ";" act like parentheses since the
 748   ;; font lock highlighting tells you when you've put the ";" on the
 749   ;; end of a parameter entity reference.
 750   (modify-syntax-entry ?% "_" xsl-mode-syntax-table)
 751   (modify-syntax-entry ?\; "_" xsl-mode-syntax-table)
 752   ;; "/" is just punctuation in XSLs, and really only has a role in
 753   ;; Formal Public Identifiers
 754   (modify-syntax-entry ?/ "." xsl-mode-syntax-table)
 755   ;; Sometimes a string is more than just a string, Dr Freud.
 756   ;; Unfortunately, the syntax stuff isn't fussy about matching
 757   ;; on paired delimiters, and will happily match a single quote
 758   ;; with a double quote, and vice versa.  At least the font
 759   ;; lock stuff is more fussy and won't change colour if the
 760   ;; delimiters aren't paired.
 761   (modify-syntax-entry ?\" "$" xsl-mode-syntax-table)
 762   (modify-syntax-entry ?\' "$" xsl-mode-syntax-table)
 763   ;; The occurrence indicators and connectors are punctuation to us.
 764   (modify-syntax-entry ?| "." xsl-mode-syntax-table)
 765   (modify-syntax-entry ?, "." xsl-mode-syntax-table)
 766   (modify-syntax-entry ?& "." xsl-mode-syntax-table)
 767   (modify-syntax-entry ?? "." xsl-mode-syntax-table)
 768   (modify-syntax-entry ?+ "." xsl-mode-syntax-table)
 769   (modify-syntax-entry ?* "." xsl-mode-syntax-table)
 770   ;; `<' and `>' are also punctuation
 771   (modify-syntax-entry ?< "." xsl-mode-syntax-table)
 772   (modify-syntax-entry ?> "." xsl-mode-syntax-table)
 773   ;; "#" is syntax too
 774   (modify-syntax-entry ?# "_" xsl-mode-syntax-table))
 775
 776 \f
 777 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 778 ;; imenu stuff
 779
 780 (defun xsl-sort-alist (alist)
 781   "Sort an alist."
 782   (sort
 783    alist
 784    (lambda (a b) (string< (car a) (car b)))))
 785
 786 (defun xsl-imenu-create-index-function ()
 787   "Create an alist of elements, etc. suitable for use with `imenu'."
 788   (interactive)
 789   (let ((template-alist '())
 790         (mode-alist '())
 791         (key-alist '())
 792         (attribute-set-alist '())
 793         (name-alist '()))
 794     (goto-char (point-min))
 795     (while
 796         (re-search-forward
 797          "^\\s-*<xsl:template\\(\\s-+\\)" nil t)
 798       ;; Go to the beginning of the whitespace after the element name
 799       (goto-char (match-beginning 1))
 800       ;; Match on either single-quoted or double-quoted attribute value.
 801       ;; The expression that doesn't match will have return nil for
 802       ;; `match-beginning' and `match-end'.
 803       ;; Don't move point because the 'mode' attribute may be before
 804       ;; the 'match' attribute.
 805       (if (save-excursion
 806             (re-search-forward
 807              "match\\s-*=\\s-*\\(\"\\([^\"]*\\)\"\\|'\\([^']*\\)'\\)"
 808              (save-excursion
 809                (save-match-data
 810                  (re-search-forward "<\\|>" nil t)))
 811              t))
 812           (let* ((pattern (buffer-substring-no-properties
 813                            ;; Rely on the pattern that didn't match
 814                            ;; returning nil and on `or' evaluating the
 815                            ;; second form when the first returns nil.
 816                            (or
 817                             (match-beginning 2)
 818                             (match-beginning 3))
 819                            (or
 820                             (match-end 2)
 821                             (match-end 3))))
 822                  (pattern-position (or
 823                                     (match-beginning 2)
 824                                     (match-beginning 3))))
 825             ;; Test to see if there is a 'mode' attribute.
 826             ;; Match on either single-quoted or double-quoted attribute value.
 827             ;; The expression that doesn't match will have return nil for
 828             ;; `match-beginning' and `match-end'.
 829             (if (save-excursion
 830                   (re-search-forward
 831                    "mode\\s-*=\\s-*\\(\"\\([^\"]*\\)\"\\|'\\([^']*\\)'\\)"
 832                    (save-excursion
 833                      (save-match-data
 834                        (re-search-forward "<\\|>" nil t)))
 835                    t))
 836                 (let* ((mode-name (buffer-substring-no-properties
 837                                    ;; Rely on the pattern that didn't match
 838                                    ;; returning nil and on `or' evaluating the
 839                                    ;; second form when the first returns nil.
 840                                    (or
 841                                     (match-beginning 2)
 842                                     (match-beginning 3))
 843                                    (or
 844                                     (match-end 2)
 845                                     (match-end 3))))
 846                        (mode-name-alist (assoc mode-name mode-alist)))
 847                   (if mode-name-alist
 848                       (setcdr mode-name-alist
 849                               (list (car (cdr mode-name-alist))
 850                                     (cons pattern pattern-position)))
 851                     (setq mode-alist
 852                           (cons
 853                            (list mode-name (cons pattern pattern-position))
 854                            mode-alist))))
 855               (setq template-alist
 856                     (cons (cons pattern pattern-position)
 857                           template-alist)))))
 858       ;; When there's no "match" attribute, can still have "name"
 859       ;; attribute
 860       (if (save-excursion
 861             (re-search-forward
 862              "\\s-+name\\s-*=\\s-*\\(\"\\([^\"]*\\)\"\\|'\\([^']*\\)'\\)"
 863              (save-excursion
 864                (save-match-data
 865                  (re-search-forward "<\\|>" nil t)))
 866              t))
 867           (setq name-alist
 868                 (cons
 869                  (cons (buffer-substring-no-properties
 870                         ;; Rely on the pattern that didn't match
 871                         ;; returning nil and on `or' evaluating the
 872                         ;; second form when the first returns nil.
 873                         (or
 874                          (match-beginning 2)
 875                          (match-beginning 3))
 876                         (or
 877                          (match-end 2)
 878                          (match-end 3)))
 879                        (or
 880                         (match-beginning 2)
 881                         (match-beginning 3)))
 882                  name-alist))))
 883     (goto-char (point-min))
 884     (while
 885         (re-search-forward
 886          "^\\s-*<xsl:attribute-set\\(\\s-+\\)" nil t)
 887       ;; Go to the beginning of the whitespace after the element name
 888       (goto-char (match-beginning 1))
 889       ;; Match on either single-quoted or double-quoted attribute value.
 890       ;; The expression that doesn't match will have return nil for
 891       ;; `match-beginning' and `match-end'.
 892       (if (save-excursion
 893             (re-search-forward
 894              "name\\s-*=\\s-*\\(\"\\([^\"]*\\)\"\\|'\\([^']*\\)'\\)"
 895              (save-excursion
 896                (save-match-data
 897                  (re-search-forward "<\\|>$" nil t)))
 898              t))
 899           (setq attribute-set-alist
 900                 (cons
 901                  (cons (buffer-substring-no-properties
 902                         ;; Rely on the pattern that didn't match
 903                         ;; returning nil and on `or' evaluating the
 904                         ;; second form when the first returns nil.
 905                         (or
 906                          (match-beginning 2)
 907                          (match-beginning 3))
 908                         (or
 909                          (match-end 2)
 910                          (match-end 3)))
 911                        (or
 912                         (match-beginning 2)
 913                         (match-beginning 3)))
 914                  attribute-set-alist))))
 915     (goto-char (point-min))
 916     (while
 917         (re-search-forward
 918          "^\\s-*<xsl:key\\(\\s-+\\)" nil t)
 919       ;; Go to the beginning of the whitespace after the element name
 920       (goto-char (match-beginning 1))
 921       ;; Match on either single-quoted or double-quoted attribute value.
 922       ;; The expression that doesn't match will have return nil for
 923       ;; `match-beginning' and `match-end'.
 924       (if (save-excursion
 925             (re-search-forward
 926              "name\\s-*=\\s-*\\(\"\\([^\"]*\\)\"\\|'\\([^']*\\)'\\)"
 927              (save-excursion
 928                (save-match-data
 929                  (re-search-forward "<\\|>$" nil t)))
 930              t))
 931           (setq key-alist
 932                 (cons
 933                  (cons (buffer-substring-no-properties
 934                         ;; Rely on the pattern that didn't match
 935                         ;; returning nil and on `or' evaluating the
 936                         ;; second form when the first returns nil.
 937                         (or
 938                          (match-beginning 2)
 939                          (match-beginning 3))
 940                         (or
 941                          (match-end 2)
 942                          (match-end 3)))
 943                        (or
 944                         (match-beginning 2)
 945                         (match-beginning 3)))
 946                  key-alist))))
 947     (append
 948      (if key-alist
 949          (list (cons "xsl:key" (xsl-sort-alist key-alist))))
 950      (if attribute-set-alist
 951          (list (cons "xsl:attribute-set"
 952                      (xsl-sort-alist attribute-set-alist))))
 953      (if name-alist
 954          (list (cons "name=" (xsl-sort-alist name-alist))))
 955      (if mode-alist
 956          ;; Sort the mode-alist members, format the mode names nicely,
 957          ;; and sort the templates within each mode.
 958          (append
 959           (mapcar (lambda (x)
 960                     (cons (format "mode=\"%s\"" (car x))
 961                           (xsl-sort-alist (cdr x))))
 962                   (xsl-sort-alist mode-alist))))
 963      (xsl-sort-alist template-alist))))
 964
 965 \f
 966 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 967 ;; grep stuff
 968
 969 ;;;###autoload
 970 (defun xsl-grep (pattern filespec)
 971   "Grep for PATTERN in files matching FILESPEC.
 972
 973 Runs `grep' with PATTERN and FILESPEC as arguments.
 974
 975 PATTERN is the pattern on which `grep' is to match.  PATTERN is quoted
 976 with single quotes in the `grep' command arguments to avoid
 977 interpretation of characters in PATTERN.  `xsl-grep' maintains a
 978 history of PATTERNs so you can easily re-use a previous value.
 979
 980 FILESPEC is the names or regular expression for the files to be
 981 scanned by grep.  Since `xsl-grep' uses `grep', regular expressions
 982 and multiple filenames are supported, and \"*.xsl\" and \"*.XSL
 983 *.ent\" are both valid FILESPEC values.
 984
 985 When called interactively, the initial FILESPEC is taken from
 986 xsl-default-filespec, but `xsl-grep' also maintains a history of
 987 FILESPEC arguments so you can easily re-use a previous value.  The
 988 history is shared with `xsl-etags' so you can re-use the same FILESPEC
 989 with both functions."
 990   (interactive
 991    (list
 992     (xsl-read-from-minibuffer "Pattern: "
 993                               (find-tag-default)
 994                               'xsl-grep-pattern-history)
 995     (xsl-read-from-minibuffer "Files: "
 996                               (car xsl-filespec-history)
 997                               'xsl-filespec-history)))
 998   ;; Include "--" in the command in case the pattern starts with "-"
 999   (grep (format "grep -n %s -- '%s' %s"
1000                 (if (not xsl-grep-case-sensitive-flag)
1001                     "-i")
1002                 pattern
1003                 filespec)))
1004
1005 \f
1006 ;;;###autoload
1007 (defun xsl-mode ()
1008   "Major mode for editing XSL stylesheets.
1009
1010 Special commands:
1011 \\{xsl-mode-map}
1012 Turning on XSL mode calls the value of the variable `xsl-mode-hook',
1013 if that value is non-nil.
1014
1015 Abbreviations:
1016
1017 XSL mode includes a comprehensive set of XSL-specific abbreviations
1018 preloaded into the abbreviations table.
1019
1020 Font lock mode:
1021
1022 Turning on font lock mode causes various XSL syntactic structures to be
1023 highlighted. To turn this on whenever you visit an XSL file, add
1024 the following to your .emacs file:
1025   \(add-hook 'xsl-mode-hook 'turn-on-font-lock\)
1026
1027 Processing stylesheets:
1028
1029 \\[xsl-process] runs a shell command, in a separate process
1030 asynchronously with output going to the buffer *XSL process*.  You can
1031 then use the command \\[next-error] to find the next error message and
1032 move to the line in the XSL document that caused it.
1033
1034 The first time that the program is run and whenever you provide a
1035 prefix argument, e.g. \\[universal-argument] \\[xsl-process], prompts
1036 for input filename, stylesheet file, and output filename.  Those
1037 values are used with the templates in `xsl-process-command' to
1038 populate this command's command history with the command lines to run
1039 several XSLT processors using those values.  Use M-p and M-n to step
1040 through the predefined commands, edit a command if necessary, or enter
1041 a new command line.  The next time that this command is run, the
1042 previously executed command is used as the default.
1043
1044 Searching multiple files:
1045
1046 To search multiple files, use \"\\[execute-extended-command] xsl-grep\" and supply the pattern to
1047 search for and the specification of files to search in response to
1048 the prompts.
1049 "
1050   (interactive)
1051   (kill-all-local-variables)
1052   (use-local-map xsl-mode-map)
1053   (setq mode-name "XSL")
1054   (setq major-mode 'xsl-mode)
1055   (setq local-abbrev-table xsl-mode-abbrev-table)
1056   ;; XEmacs users don't all have imenu
1057   (if (featurep 'imenu)
1058       (progn
1059         ;; If you don't have imenu, you'll get a "free variable"
1060         ;; warning for imenu-create-index-function when you
1061         ;; byte-compile, but not having imenu won't cause problems
1062         ;; when you use xslide
1063         (setq imenu-create-index-function 'xsl-imenu-create-index-function)
1064         (setq imenu-extract-index-name-function 'xsl-imenu-create-index-function)
1065         (imenu-add-to-menubar "Templates")))
1066   ;; comment stuff
1067 ;;  (make-local-variable 'comment-column)
1068 ;;  (setq comment-column 32)
1069   ;; XEmacs change: make `comment-region' work.
1070   (make-local-variable 'comment-start)
1071   (setq comment-start "<!-- ")
1072   (make-local-variable 'comment-end)
1073   (setq comment-end " -->")
1074   (make-local-variable 'comment-indent-function)
1075   (setq comment-indent-function 'xsl-electric-tab)
1076   (make-local-variable 'comment-start-skip)
1077   ;; This will allow existing comments within declarations to be
1078   ;; recognized.  [Does not work well with auto-fill, Lst/940205]
1079   ;;(setq comment-start-skip "--[ \t]*")
1080   (setq comment-start-skip "<!--[ \t]*")
1081   ;;
1082   ;; later we should move this into the xsl-mode-hook in
1083   ;; our local .emacs file
1084   ;; (abbrev-mode t)
1085   ;;
1086   ;; XSL font-lock highlighting setup
1087 ;;  (xsl-font-make-faces)
1088   (make-local-variable 'font-lock-defaults)
1089   (setq font-lock-defaults '(xsl-font-lock-keywords t))
1090   (if (xsl-fsfemacs-p)
1091       (progn
1092         (make-local-variable 'font-lock-mark-block-function)
1093         (setq font-lock-mark-block-function
1094               'xsl-font-lock-mark-block-function)))
1095   (make-local-variable 'indent-line-function)
1096   (setq indent-line-function 'xsl-electric-tab)
1097 ;;  (make-local-variable 'font-lock-defaults)
1098 ;;  (setq font-lock-defaults
1099 ;;      '(xsl-font-lock-keywords nil t ((?- . "w")
1100 ;;                                      (?_ . "w")
1101 ;;                                      (?. . "w"))))
1102   ;; add an entry to compilation-error-regexp-alist for XSL
1103   ;; compiler errors
1104 ;;  (setq compilation-error-regexp-alist
1105 ;;      (cons '("file:/c:/projects/xslide/test.xsl:29:
1106 ;;XSL Error on line \\([0-9]*\\) in file \\(.*\\):$" 2 1)
1107 ;;            compilation-error-regexp-alist))
1108
1109   (set-syntax-table xsl-mode-syntax-table)
1110   ;; Maybe insert space characters when user hits "Tab" key
1111   (setq indent-tabs-mode xsl-indent-tabs-mode)
1112   (if (and
1113        xsl-initial-stylesheet-file
1114        (eq (point-min) (point-max)))
1115       (progn
1116         (insert-file-contents xsl-initial-stylesheet-file)
1117         (goto-char xsl-initial-stylesheet-initial-point)))
1118   (run-hooks 'xsl-mode-hook))
1119
1120 \f
1121 ;;;; Bug reporting
1122
1123 (defun xsl-submit-bug-report ()
1124   "Submit via mail a bug report on 'xslide'."
1125   (interactive)
1126   (require 'reporter)
1127   (and (y-or-n-p "Do you really want to submit a report on XSL mode? ")
1128        (reporter-submit-bug-report
1129         xslide-maintainer-address
1130         (concat "xslide.el " xslide-version)
1131         (list
1132          )
1133         nil
1134         nil
1135      "Please change the Subject header to a concise bug description.\nRemember to cover the basics, that is, what you expected to\nhappen and what in fact did happen.  Please remove these\ninstructions from your message.")
1136     (save-excursion
1137       (goto-char (point-min))
1138       (mail-position-on-field "Subject")
1139       (beginning-of-line)
1140       (delete-region (point) (progn (forward-line) (point)))
1141       (insert
1142        "Subject: xslide " xslide-version " is wonderful but...\n"))))
1143
1144 \f
1145 (autoload 'reporter-submit-bug-report "reporter")
1146
1147 ;;;; Last provisions
1148 ;;;(provide 'xslide)
1149
1150 ;; XEmacs change
1151 ;;;###autoload(add-to-list 'auto-mode-alist '("\\.\\(?:xsl\\|fo\\)$" . xsl-mode))
1152
1153 ;;; xslide.el ends here