path: root/Build/source/utils/xindy/src/markup.lsp

;; line 1154 "markup.nw"
;; $Id: markup.nw,v 1.24 1997/03/26 16:18:58 kehr Exp $

(lisp:defpackage "MARKUP")
(lisp:in-package "MARKUP")
(lisp:provide "markup")
#+CLISP (lisp:require "base")
#+CLISP (lisp:require "locref")
#+CLISP (lisp:require "idxstyle")
#+CLISP (lisp:require "index")

(eval-when (compile load eval)
  (lisp:use-package "CLOS")
  #+(and :XP CLISP) (lisp:use-package "XP")
  #+CLISP (setq custom:*suppress-check-redefinition* t)
  #-CLISP (lisp:require "base")
  #-CLISP (lisp:require "locref")
  #-CLISP (lisp:require "idxstyle")
  #-CLISP (lisp:require "index")
  (lisp:require "version")
  (lisp:use-package "BASE")
  (lisp:use-package "LOCREF")
  (lisp:use-package "IDXSTYLE")
  (lisp:use-package "INDEX"))

;; line 1222 "markup.nw"
;; $Id: markup.nw,v 1.24 1997/03/26 16:18:58 kehr Exp $

;; line 71 "markup.nw"
(defparameter *markup-output-stream* *standard-output*)
(defparameter *markup-verbose-mode*  nil)
(defparameter *markup-verbose-open*  "<")
(defparameter *markup-verbose-close* ">")
(defparameter *markup-indentation*   2)
(defparameter *markup-indent-level*  0)
(defparameter *empty-markup* "")

(defvar *markup-percentage-list*)
(defvar *current-number*)

(defun do-markup-indent ()
  (incf *markup-indent-level* *markup-indentation*))
(defun do-markup-outdent ()
  (decf *markup-indent-level* *markup-indentation*))
;; line 102 "markup.nw"
(defun do-markup-string (str)
  (declare (inline))
  (write-string str *markup-output-stream*))
;; line 111 "markup.nw"
(defun do-markup-default (str &optional arg1 arg2 arg3)
  (when *markup-verbose-mode*
    (loop for x from 1 to *markup-indent-level*
          do (write-string " " *markup-output-stream*))
    (do-markup-string *markup-verbose-open*)
    (do-markup-string str)
    (when arg1
      (format *markup-output-stream* " [~S]" arg1)
      (when arg2
        (format *markup-output-stream* " [~S]" arg2)
        (when arg3
          (format *markup-output-stream* " [~S]" arg3)
          )))
    (do-markup-string *markup-verbose-close*)
    (terpri *markup-output-stream*)
    ))
;; line 138 "markup.nw"
(defmacro do-markup-list (some-list
                          &key
                          identifier counter
                          elt-body   sep-body
                          open-body  close-body)
  `(PROGN
    ,(when open-body `,open-body)
    (LET ,(if counter
              `((LIST-END (CAR (LAST ,some-list)))
                (COUNTER ,counter))
              `((LIST-END (CAR (LAST ,some-list)))))
      (DO ((SLIST ,some-list (CDR SLIST)))
          ((ENDP SLIST))
        (LET ((,identifier (CAR SLIST)))
          ,elt-body
          ,(if sep-body
               `(UNLESS (EQL ,identifier LIST-END)
                 ,sep-body)))))
    ,(when close-body close-body)))
;; line 162 "markup.nw"
#|
(macroexpand '(markup-list '(1 2 3) :identifier FOO
               :open-body  (print "open")
               :close-body (print "close")
               :elt-body   (print FOO)
               :sep-body   (print ",")))

expands to

(PROGN (PRINT "open")
  (LET ((LIST-END (CAR (LAST '(1 2 3)))))
    (DO ((SLIST '(1 2 3) (CDR SLIST))) ((ENDP SLIST))
      (LET ((FOO (CAR SLIST))) (PRINT FOO)
        (UNLESS (EQL FOO LIST-END) (PRINT ","))
  ) ) )
  (PRINT "close")
) ;
T
|#
;; line 193 "markup.nw"
(defmacro define-list-environment-methods (name
                                           signature
                                           &key open close sep declare body)
  (let ((name (stringify name)))
    `(EVAL-WHEN (COMPILE LOAD EVAL)
      (HANDLER-BIND ((WARNING #'MUFFLE-WARNING))
       (CL:DEFMETHOD
           ,(intern (string-upcase (concatenate 'string name "-open"))
                    'markup)
           ,signature ,@declare ,@open ,@body)
       (CL:DEFMETHOD
           ,(intern (string-upcase (concatenate 'string name "-close"))
                    'markup)
           ,signature ,@declare ,@close ,@body)
       (CL:DEFMETHOD
           ,(intern (string-upcase (concatenate 'string name "-sep"))
                    'markup)
           ,signature ,@declare ,@sep ,@body)))))
;; line 214 "markup.nw"
(defmacro define-environment-methods (name
                                      signature
                                      &key open close declare body)
  (let ((name (stringify name)))
    `(EVAL-WHEN (COMPILE LOAD EVAL)
      (HANDLER-BIND ((WARNING #'MUFFLE-WARNING))
       (CL:DEFMETHOD
           ,(intern (string-upcase (concatenate 'string name "-open"))
                    'markup)
           ,signature ,@declare ,@open ,@body)
       (CL:DEFMETHOD
           ,(intern (string-upcase (concatenate 'string name "-close"))
                    'markup)
           ,signature ,@declare ,@close ,@body)))))

(defmacro define-method (name
                         signature
                         &key declare body)
  (let ((name (stringify name)))
    `(EVAL-WHEN (COMPILE LOAD EVAL)
      (HANDLER-BIND ((WARNING #'MUFFLE-WARNING))
       (CL:DEFMETHOD
           ,(intern (string-upcase name) 'markup)
           ,signature ,@declare ,@body)))))
;; line 326 "markup.nw"
(defmethod do-markup-index ((idx base-index))
  (setq *current-number* 0)
  (setq *markup-percentage-list* index:*percentage-list*)
  (do-markup-index-open idx)
  (do-markup-list (get-entries idx)
    :identifier LETTER-GRP
    :open-body  (do-markup-letter-group-list-open)
    :elt-body   (do-markup-letter-group LETTER-GRP)
    :sep-body   (do-markup-letter-group-list-sep)
    :close-body (do-markup-letter-group-list-close))
  (index:print-rest-of-percentages *markup-percentage-list*)
  (do-markup-index-close idx))

(define-environment-methods do-markup-index ((idx base-index))
  :open  ((do-markup-default "INDEX:OPEN")
          (do-markup-indent))
  :close ((do-markup-outdent)
          (do-markup-default "INDEX:CLOSE")))
;; line 351 "markup.nw"
(defmacro markup-index (&whole whole &rest args)
  (destructuring-switch-bind (&key
                              open close hierdepth
                              &switch
                              tree flat)
      args
    (let (hierdepth-cmd)
      (when (or hierdepth tree flat)
        (cond
          ((and tree flat)
             (error "you can't specify :tree and :flat simultaneously in ~%~S~%"
                     whole))
          ((and hierdepth (or tree flat))
             (error "you can't specify :hierdepth with :tree or :flat simultaneously in ~%~S~%"
                     whole))
          (flat (setq hierdepth-cmd
                      `(SET-HIERDEPTH 0 *INDEX*)));; no tree-structure
          ;; MOST-POSITIVE-FIXNUM means make all trees
          (tree (setq hierdepth-cmd
                      `(SET-HIERDEPTH MOST-POSITIVE-FIXNUM *INDEX*)))
          (hierdepth
             (when (not (numberp hierdepth))
               (error "~S is not a number in ~S~%" whole))
             (setq hierdepth-cmd
                   `(SET-HIERDEPTH ,hierdepth *INDEX*))))
        `(LET ()
          (markup::define-environment-methods
              DO-MARKUP-INDEX ((idx index:base-index))
            :declare ((declare (ignore idx)))
            :open  ,(when open  `((do-markup-string ,open)))
            :close ,(when close `((do-markup-string ,close))))
          ,hierdepth-cmd)))))
;; line 390 "markup.nw"
(define-list-environment-methods do-markup-letter-group-list ()
  :open  ((do-markup-default "LETTER-GROUP-LIST:OPEN")
          (do-markup-indent))
  :close ((do-markup-outdent)
          (do-markup-default "LETTER-GROUP-LIST:CLOSE"))
  :sep   ((do-markup-default "LETTER-GROUP-LIST:SEP")))
;; line 409 "markup.nw"
(defmethod do-markup-letter-group ((letter-grp letter-group))
  (let ((group-definition (get-group-definition letter-grp)))
    (do-markup-letter-group-open       group-definition)
    (do-markup-letter-group-head-open  group-definition)
    (do-markup-letter-group-head       group-definition)
    (do-markup-letter-group-head-close group-definition)
    (do-markup-list (get-members letter-grp)
      :identifier IDXENT #| the identifier to use in the expansion |#
      :open-body  (do-markup-indexentry-list-open  0
                    #|initial depth:=0|#)
      :elt-body   (do-markup-indexentry IDXENT     0)
      :sep-body   (do-markup-indexentry-list-sep   0)
      :close-body (do-markup-indexentry-list-close 0))
    (do-markup-letter-group-close group-definition)))

(define-environment-methods do-markup-letter-group
    ((group letter-group-definition))
  :open  ((do-markup-default "LETTER-GROUP:OPEN"  (get-name group))
          (do-markup-indent))
  :close ((do-markup-outdent)
          (do-markup-default "LETTER-GROUP:CLOSE" (get-name group))))

(define-environment-methods do-markup-letter-group-head
    ((group letter-group-definition))
  :open  ((do-markup-default "LETTER-GROUP-HEAD:OPEN"  (get-name group))
          (do-markup-indent))
  :close ((do-markup-outdent)
          (do-markup-default "LETTER-GROUP-HEAD:CLOSE" (get-name group))))

(define-method do-markup-letter-group-head ((group letter-group-definition))
  :body ((do-markup-default "LETTER-GROUP-HEAD" (get-name group))))
;; line 503 "markup.nw"
(define-list-environment-methods do-markup-indexentry-list ((depth number))
  :open  ((do-markup-default "INDEXENTRY-LIST:OPEN"  depth)
          (do-markup-indent))
  :close ((do-markup-outdent)
          (do-markup-default "INDEXENTRY-LIST:CLOSE" depth))
  :sep   ((do-markup-default "INDEXENTRY-LIST:SEP"   depth)))
;; line 525 "markup.nw"
(defmethod do-markup-indexentry ((idxent index-entry)
                                 (depth number))
  (when (>= (incf *current-number*) (caar *markup-percentage-list*))
    (index:print-percent (pop *markup-percentage-list*)))

  (do-markup-indexentry-open depth)

  (let ((print-key (get-print-key idxent)))
    (do-markup-list (merge-print-and-main-key print-key (get-main-key idxent))
      :identifier KEYWORD
      :open-body  (do-markup-keyword-list-open  depth)
      :elt-body   (do-markup-keyword   KEYWORD  depth)
      :sep-body   (do-markup-keyword-list-sep   depth)
      :close-body (do-markup-keyword-list-close depth)))

  (let ((locrefs (get-locrefs idxent)))
    (unless (endp locrefs)
      (do-markup-list locrefs
        :identifier LOCCLS-GRP
        :open-body  (do-markup-locclass-list-open)
        :elt-body   (do-markup-locclass LOCCLS-GRP)
        :sep-body   (do-markup-locclass-list-sep)
        :close-body (do-markup-locclass-list-close))))

  (let ((subentries (get-subentries idxent)))
    (unless (endp subentries)
      (let ((new-depth (1+ depth)))
        (do-markup-list subentries
          :identifier IDXENT
          :open-body  (do-markup-indexentry-list-open  new-depth)
          :elt-body   (do-markup-indexentry IDXENT     new-depth)
          :sep-body   (do-markup-indexentry-list-sep   new-depth)
          :close-body (do-markup-indexentry-list-close new-depth)))))

  (do-markup-indexentry-close depth))

(defun merge-print-and-main-key (print-key main-key)
  ;;(info "~&(merge-print-and-main-key ~S ~S)" print-key main-key)
  (if print-key
      (mapcar #'(lambda (print main)
                  (or print main))
              print-key main-key)
      main-key))
;; line 571 "markup.nw"
(define-environment-methods do-markup-indexentry ((depth number))
  :open  ((do-markup-default "INDEXENTRY:OPEN"  depth)
          (do-markup-indent))
  :close ((do-markup-outdent)
          (do-markup-default "INDEXENTRY:CLOSE" depth)))
;; line 595 "markup.nw"
(define-list-environment-methods do-markup-keyword-list ((depth number))
  :open  ((do-markup-default "KEYWORD-LIST:OPEN"  depth)
          (do-markup-indent))
  :close ((do-markup-outdent)
          (do-markup-default "KEYWORD-LIST:CLOSE" depth))
  :sep   ((do-markup-default "KEYWORD-LIST:SEP"   depth)))
;; line 617 "markup.nw"
(defmethod do-markup-keyword (keyword (depth number))
  (do-markup-keyword-open depth)
  (do-markup-string keyword)
  (do-markup-keyword-close depth))
;; line 624 "markup.nw"
(define-environment-methods do-markup-keyword ((depth number))
  :open  ((do-markup-default "KEYWORD:OPEN"  depth)
          (do-markup-indent))
  :close ((do-markup-outdent)
          (do-markup-default "KEYWORD:CLOSE" depth)))
;; line 654 "markup.nw"
(define-list-environment-methods do-markup-locclass-list ()
  :open  ((do-markup-default "LOCCLASS-LIST:OPEN")
          (do-markup-indent))
  :close ((do-markup-outdent)
          (do-markup-default "LOCCLASS-LIST:CLOSE"))
  :sep   ((do-markup-default "LOCCLASS-LIST:SEP")))
;; line 677 "markup.nw"
(defmethod do-markup-locclass ((locref-cls-grp locref-class-group))
  (let ((locclass (get-locclass locref-cls-grp)))
    (do-markup-locref-class-open locclass)

    (do-markup-list (get-members locref-cls-grp)
      :identifier ATTRIBUTE-GRP
      :open-body  (do-markup-attribute-group-list-open)
      :elt-body   (do-markup-attribute-group ATTRIBUTE-GRP locclass)
      :sep-body   (do-markup-attribute-group-list-sep)
      :close-body (do-markup-attribute-group-list-close))

    (do-markup-locref-class-close locclass)))

(define-environment-methods do-markup-locref-class
    ((locrefcls layered-location-class))
  :open  ((do-markup-default "LOCREF-CLASS:OPEN"  (get-name locrefcls))
          (do-markup-indent))
  :close ((do-markup-outdent)
          (do-markup-default "LOCREF-CLASS:CLOSE" (get-name locrefcls))))
;; line 1044 "markup.nw"
(defmethod do-markup-locclass ((xref-cls-grp crossref-class-group))
  (let ((xrefclass (get-locclass xref-cls-grp)))

    (do-markup-list (get-members xref-cls-grp)
      :identifier XREF
      :open-body  (do-markup-crossref-list-open  xrefclass)
      :elt-body   (do-markup-crossref            XREF)
      :sep-body   (do-markup-crossref-list-sep   xrefclass)
      :close-body (do-markup-crossref-list-close xrefclass))))

(define-list-environment-methods do-markup-crossref-list
    ((xrefclass crossref-location-class))
  :open  ((do-markup-default "CROSSREF-LIST:OPEN"  (get-name xrefclass))
          (do-markup-indent))
  :close ((do-markup-outdent)
          (do-markup-default "CROSSREF-LIST:CLOSE" (get-name xrefclass)))
  :sep   ((do-markup-default "CROSSREF-LIST:SEP"   (get-name xrefclass))))
;; line 1080 "markup.nw"
(defmethod do-markup-crossref ((xref crossref-location-reference))
  (let ((xrefclass (get-locclass xref)))

    (do-markup-list (get-target xref)
      :identifier XREF-LAYER
      :open-body  (do-markup-crossref-layer-list-open  xrefclass)
      :elt-body   (do-markup-crossref-layer XREF-LAYER xrefclass)
      :sep-body   (do-markup-crossref-layer-list-sep   xrefclass)
      :close-body (do-markup-crossref-layer-list-close xrefclass))))

(define-list-environment-methods do-markup-crossref-layer-list
    ((xref-class crossref-location-class))
  :open  ((do-markup-default "CROSSREF-LAYER-LIST:OPEN"
            (get-name xref-class))
          (do-markup-indent))
  :close ((do-markup-outdent)
          (do-markup-default "CROSSREF-LAYER-LIST:CLOSE"
            (get-name xref-class)))
  :sep   ((do-markup-default "CROSSREF-LAYER-LIST:SEP"
            (get-name xref-class))))
;; line 1119 "markup.nw"
(defmethod do-markup-crossref-layer (xref-layer
                                     (xref-class crossref-location-class))
  (do-markup-crossref-layer-open  xref-class)
  (do-markup-string               xref-layer)
  (do-markup-crossref-layer-close xref-class))

(define-environment-methods do-markup-crossref-layer
    ((xref-class crossref-location-class))
  :open  ((do-markup-default "CROSSREF-LAYER:OPEN"  (get-name xref-class))
          (do-markup-indent))
  :close ((do-markup-outdent)
          (do-markup-default "CROSSREF-LAYER:CLOSE" (get-name xref-class))))
;; line 718 "markup.nw"
(define-list-environment-methods do-markup-attribute-group-list ()
  :open  ((do-markup-default "ATTRIBUTE-GROUP-LIST:OPEN")
          (do-markup-indent))
  :close ((do-markup-outdent)
          (do-markup-default "ATTRIBUTE-GROUP-LIST:CLOSE"))
  :sep   ((do-markup-default "ATTRIBUTE-GROUP-LIST:SEP")))
;; line 737 "markup.nw"
(defmethod do-markup-attribute-group ((attribute-group category-attribute-group)
                                      (loccls layered-location-class))
  (let ((ordnum (get-ordnum attribute-group)))
    (do-markup-attribute-group-open ordnum)

    (do-markup-list (get-members attribute-group)
      :identifier LOCREF
      :open-body  (do-markup-locref-list-open  loccls 0)
      :elt-body   (do-markup-locref     LOCREF loccls 0)
      :sep-body   (do-markup-locref-list-sep   loccls 0)
      :close-body (do-markup-locref-list-close loccls 0))

    (do-markup-attribute-group-close ordnum)))

(define-environment-methods do-markup-attribute-group ((ordnum number))
  :open  ((do-markup-default "ATTRIBUTE-GROUP:OPEN"  ordnum)
          (do-markup-indent))
  :close ((do-markup-outdent)
          (do-markup-default "ATTRIBUTE-GROUP:CLOSE" ordnum)))
;; line 776 "markup.nw"
(define-list-environment-methods do-markup-locref-list
    ((loccls layered-location-class) (depth number))
  :open  ((do-markup-default "LOCREF-LIST:OPEN"  (get-name loccls) depth)
          (do-markup-indent))
  :close ((do-markup-outdent)
          (do-markup-default "LOCREF-LIST:CLOSE" (get-name loccls) depth))
  :sep   ((do-markup-default "LOCREF-LIST:SEP"   (get-name loccls) depth)))
;; line 808 "markup.nw"
(defmethod do-markup-locref ((locref location-reference)
                             (loccls layered-location-class)
                             (depth  number))
  #+ASSERT! (assert! (and (typep locref 'layered-location-reference)
                          (typep depth 'number)))
  (let ((attr    (get-catattr  locref))
        (subrefs (get-subrefs  locref))
        (new-depth (1+ depth)))

    (do-markup-locref-open attr loccls depth)

    (cond
      (subrefs
         (let ((layer 0))
           (do-markup-list (get-layers locref)
             :identifier LOCREF-LAYER
             :open-body  (do-markup-locref-layer-list-open  loccls depth)
             :elt-body   (do-markup-locref-layer LOCREF-LAYER loccls depth
                                                 (prog1 layer
                                                   (incf layer)))
             :sep-body   (do-markup-locref-layer-list-sep   loccls depth)
             :close-body (do-markup-locref-layer-list-close loccls depth)))

         (do-markup-list subrefs
           :identifier LOCREF
           :open-body  (do-markup-locref-list-open  loccls new-depth)
           :elt-body   (do-markup-locref     LOCREF loccls new-depth)
           :sep-body   (do-markup-locref-list-sep   loccls new-depth)
           :close-body (do-markup-locref-list-close loccls new-depth)))

      ((= 0 depth)
         (do-markup-string (get-locref-string locref)))

      (t (let ((layer 0))
           (do-markup-list (get-layers locref)
             :identifier LOCREF-LAYER
             :open-body  (do-markup-locref-layer-list-open  loccls depth)
             :elt-body   (do-markup-locref-layer LOCREF-LAYER loccls depth
                                                 (prog1 layer
                                                   (incf layer)))
             :sep-body   (do-markup-locref-layer-list-sep   loccls depth)
             :close-body (do-markup-locref-layer-list-close loccls depth)))))

    (do-markup-locref-close attr loccls depth)))
;; line 855 "markup.nw"
(define-list-environment-methods do-markup-locref-layer-list
    ((loccls layered-location-class) (depth  number))
  :open  ((do-markup-default "LOCREF-LAYER-LIST:OPEN"  (get-name loccls) depth)
          (do-markup-indent))
  :sep   ((do-markup-default "LOCREF-LAYER-LIST:SEP"   (get-name loccls) depth))
  :close ((do-markup-outdent)
          (do-markup-default "LOCREF-LAYER-LIST:CLOSE" (get-name loccls) depth)))
;; line 883 "markup.nw"
(defun do-markup-locref-layer (locref-layer loccls depth layer)
  (do-markup-locref-layer-open loccls depth layer)
  (do-markup-string locref-layer)
  (do-markup-locref-layer-close loccls depth layer))

(define-environment-methods do-markup-locref-layer
    ((locref-class layered-location-class) (depth number) (layer number))
  :open  ((do-markup-default "LOCREF-LAYER:OPEN"
            (get-name locref-class) depth layer)
          (do-markup-indent))
  :close ((do-markup-outdent)
          (do-markup-default "LOCREF-LAYER:CLOSE"
            (get-name locref-class) depth layer)))
;; line 918 "markup.nw"
(define-environment-methods do-markup-locref ((attr   category-attribute)
                                              (loccls layered-location-class)
                                              (depth  number))
  :open  ((do-markup-default "LOCREF:OPEN"
            (get-name attr) (get-name loccls) depth)
          (do-markup-indent))
  :close ((do-markup-outdent)
          (do-markup-default "LOCREF:CLOSE"
            (get-name attr) (get-name loccls) depth)))
;; line 955 "markup.nw"
(defmethod do-markup-locref ((range location-range)
                             (loccls layered-location-class)
                             (depth number))
  (let ((length (get-length range)))
    (do-markup-range-open  loccls length)
    (do-markup-locref (get-first range) loccls depth)
    (do-markup-range-sep   loccls length)
    (when (markup-range-print-end-p loccls length)
      (do-markup-locref (get-last range)  loccls depth))
    (do-markup-range-close loccls length)))

(define-list-environment-methods do-markup-range
    ((loccls layered-location-class) (length number))
  :open  ((do-markup-default "RANGE:OPEN"  (get-name loccls) length)
          (do-markup-indent))
  :close ((do-markup-outdent)
          (do-markup-default "RANGE:CLOSE" (get-name loccls) length))
  :sep   ((do-markup-default "RANGE:SEP" (get-name loccls) length)))

(defmethod markup-range-print-end-p ((loccls layered-location-class)
                                     (length number))
  t)
;; line 304 "markup.nw"
(defmacro markup-trace (&rest args)
  (destructuring-switch-bind (&key
                              (open  *markup-verbose-open*)
                              (close *markup-verbose-close*)
                              &switch
                              on)
      args
    (cond
;; line 245 "markup.nw"
((and open (not (stringp open)))
 (nraw "parameter `~S' is not a string! (ignored)~%" open))
((and close (not (stringp close)))
 (nraw "parameter `~S' is not a string! (ignored)~%" close))
;; line 312 "markup.nw"
          (t `(LET ()
               (SETQ *markup-verbose-open*  ,open)
               (SETQ *markup-verbose-close* ,close)
               ,(when on `(SETQ *markup-verbose-mode* t)))))))
;; line 399 "markup.nw"
(defmacro markup-letter-group-list (&key open close sep)
  (cond
;; line 245 "markup.nw"
((and open (not (stringp open)))
 (nraw "parameter `~S' is not a string! (ignored)~%" open))
((and close (not (stringp close)))
 (nraw "parameter `~S' is not a string! (ignored)~%" close))
;; line 260 "markup.nw"
((and sep  (not (stringp sep)))
 (nraw "parameter `~S' is not a string! (ignored)~%" sep))
;; line 401 "markup.nw"
        (t `(markup::define-list-environment-methods
             DO-MARKUP-LETTER-GROUP-LIST ()
             :open  ,(when open  `((do-markup-string ,open)))
             :close ,(when close `((do-markup-string ,close)))
             :sep   ,(when sep   `((do-markup-string ,sep)))))))
;; line 443 "markup.nw"
(defmacro markup-letter-group (&whole whole &rest args)
  (destructuring-switch-bind (&key
                              open close group
                              open-head close-head
                              &switch
                              upcase downcase capitalize)
      args
    (cond
;; line 245 "markup.nw"
((and open (not (stringp open)))
 (nraw "parameter `~S' is not a string! (ignored)~%" open))
((and close (not (stringp close)))
 (nraw "parameter `~S' is not a string! (ignored)~%" close))
;; line 451 "markup.nw"

;; line 252 "markup.nw"
((and open-head (not (stringp open-head)))
 (nraw "parameter `~S' is not a string! (ignored)~%" open-head))
((and close-head (not (stringp close-head)))
 (nraw "parameter `~S' is not a string! (ignored)~%" close-head))
;; line 452 "markup.nw"

;; line 275 "markup.nw"
((and group (progn
              (setq group (stringify group))
              (not (lookup-letter-group-definition *indexstyle* group))))
 (nraw "parameter `~S' is not a valid letter-group! (ignored)~%" group))
;; line 453 "markup.nw"
          ((or (and upcase downcase)
               (and upcase capitalize)
               (and downcase capitalize))
             (error "more than one modifier in~%~S" whole))
          (t `(LET ()
               (markup::define-environment-methods
                   DO-MARKUP-LETTER-GROUP
                   (,(if group
                         `(lg-def (EQL ',(lookup-letter-group-definition
                                          *indexstyle* group)))
                         '(lg-def letter-group-definition)))
                 :declare ((declare (ignore lg-def)))
                 :open  ,(when open  `((do-markup-string ,open)))
                 :close ,(when close `((do-markup-string ,close))))
               (markup::define-environment-methods
                   DO-MARKUP-LETTER-GROUP-HEAD
                   (,(if group
                         `(lg-def (EQL ',(lookup-letter-group-definition
                                          *indexstyle* group)))
                         '(lg-def letter-group-definition)))
                 :declare ((declare (ignore lg-def)))
                 :open  ,(when open-head  `((do-markup-string ,open-head)))
                 :close ,(when close-head `((do-markup-string ,close-head))))
               ,(when (or open-head close-head)
                      `(markup::define-method
                        DO-MARKUP-LETTER-GROUP-HEAD
                        (,(if group
                              `(lg-def (EQL ',(lookup-letter-group-definition
                                               *indexstyle* group)))
                              '(lg-def letter-group-definition)))
                        :body ((do-markup-string
                                   ,(cond (upcase     `(string-upcase
                                                        (get-name lg-def)))
                                          (downcase   `(string-downcase
                                                        (get-name lg-def)))
                                          (capitalize `(string-capitalize
                                                        (get-name lg-def)))
                                          (t `(get-name lg-def))))))))))))
;; line 512 "markup.nw"
(defmacro markup-indexentry-list (&key open close sep depth)
  (cond
;; line 245 "markup.nw"
((and open (not (stringp open)))
 (nraw "parameter `~S' is not a string! (ignored)~%" open))
((and close (not (stringp close)))
 (nraw "parameter `~S' is not a string! (ignored)~%" close))
;; line 260 "markup.nw"
((and sep  (not (stringp sep)))
 (nraw "parameter `~S' is not a string! (ignored)~%" sep))
;; line 514 "markup.nw"

;; line 265 "markup.nw"
((and depth (not (integerp depth)))
 (nraw "parameter `~S' is not a number! (ignored)~%" depth))
;; line 515 "markup.nw"
        (t `(markup::define-list-environment-methods
             DO-MARKUP-INDEXENTRY-LIST
             (,(if depth `(depth (EQL ,depth)) '(depth number)))
             :declare ((declare (ignore depth)))
             :open  ,(when open  `((do-markup-string ,open)))
             :close ,(when close `((do-markup-string ,close)))
             :sep   ,(when sep   `((do-markup-string ,sep)))))))
;; line 579 "markup.nw"
(defmacro markup-indexentry (&key open close depth)
  (cond
;; line 245 "markup.nw"
((and open (not (stringp open)))
 (nraw "parameter `~S' is not a string! (ignored)~%" open))
((and close (not (stringp close)))
 (nraw "parameter `~S' is not a string! (ignored)~%" close))
;; line 581 "markup.nw"

;; line 265 "markup.nw"
((and depth (not (integerp depth)))
 (nraw "parameter `~S' is not a number! (ignored)~%" depth))
;; line 582 "markup.nw"
        (t `(markup::define-environment-methods
             DO-MARKUP-INDEXENTRY
             (,(if depth `(depth (EQL ,depth)) '(depth number)))
             :declare ((declare (ignore depth)))
             :open  ,(when open  `((do-markup-string ,open)))
             :close ,(when close `((do-markup-string ,close)))))))
;; line 604 "markup.nw"
(defmacro markup-keyword-list (&key open close sep depth)
  (cond
;; line 245 "markup.nw"
((and open (not (stringp open)))
 (nraw "parameter `~S' is not a string! (ignored)~%" open))
((and close (not (stringp close)))
 (nraw "parameter `~S' is not a string! (ignored)~%" close))
;; line 260 "markup.nw"
((and sep  (not (stringp sep)))
 (nraw "parameter `~S' is not a string! (ignored)~%" sep))
;; line 606 "markup.nw"

;; line 265 "markup.nw"
((and depth (not (integerp depth)))
 (nraw "parameter `~S' is not a number! (ignored)~%" depth))
;; line 607 "markup.nw"
        (t `(markup::define-list-environment-methods
             DO-MARKUP-KEYWORD-LIST
             (,(if depth `(depth (EQL ,depth)) '(depth number)))
             :declare ((declare (ignore depth)))
             :open  ,(when open  `((do-markup-string ,open)))
             :close ,(when close `((do-markup-string ,close)))
             :sep   ,(when sep   `((do-markup-string ,sep)))))))
;; line 632 "markup.nw"
(defmacro markup-keyword (&key open close depth)
  (cond
;; line 245 "markup.nw"
((and open (not (stringp open)))
 (nraw "parameter `~S' is not a string! (ignored)~%" open))
((and close (not (stringp close)))
 (nraw "parameter `~S' is not a string! (ignored)~%" close))
;; line 634 "markup.nw"

;; line 265 "markup.nw"
((and depth (not (integerp depth)))
 (nraw "parameter `~S' is not a number! (ignored)~%" depth))
;; line 635 "markup.nw"
        (t `(markup::define-environment-methods
             DO-MARKUP-KEYWORD
             (,(if depth `(depth (EQL ,depth)) '(depth number)))
             :declare ((declare (ignore depth)))
             :open  ,(when open  `((do-markup-string ,open)))
             :close ,(when close `((do-markup-string ,close)))))))
;; line 663 "markup.nw"
(defmacro markup-locclass-list (&key open close sep)
  (cond
;; line 245 "markup.nw"
((and open (not (stringp open)))
 (nraw "parameter `~S' is not a string! (ignored)~%" open))
((and close (not (stringp close)))
 (nraw "parameter `~S' is not a string! (ignored)~%" close))
;; line 260 "markup.nw"
((and sep  (not (stringp sep)))
 (nraw "parameter `~S' is not a string! (ignored)~%" sep))
;; line 665 "markup.nw"
        (t `(markup::define-list-environment-methods
             DO-MARKUP-LOCCLASS-LIST ()
             :open  ,(when open  `((do-markup-string ,open)))
             :close ,(when close `((do-markup-string ,close)))
             :sep   ,(when sep   `((do-markup-string ,sep)))))))
;; line 699 "markup.nw"
(defmacro markup-locref-class (&key open close class)
  (cond
;; line 245 "markup.nw"
((and open (not (stringp open)))
 (nraw "parameter `~S' is not a string! (ignored)~%" open))
((and close (not (stringp close)))
 (nraw "parameter `~S' is not a string! (ignored)~%" close))
;; line 701 "markup.nw"

;; line 282 "markup.nw"
((and class (progn (setq class (stringify class))
                   (not (lookup-locref-class *indexstyle* class))))
 (nraw "parameter `~S' is not a location-reference class! (ignored)~%" class))
;; line 702 "markup.nw"
        (t `(markup::define-list-environment-methods
             DO-MARKUP-LOCREF-CLASS
             (,(if class
                   `(locrefcls (EQL ',(cdr (lookup-locref-class
                                            *indexstyle* class))))
                   '(locrefcls layered-location-class)))
             :declare ((declare (ignore locrefcls)))
             :open  ,(when open  `((do-markup-string ,open)))
             :close ,(when close `((do-markup-string ,close)))))))
;; line 727 "markup.nw"
(defmacro markup-attribute-group-list (&key open close sep)
  (cond
;; line 245 "markup.nw"
((and open (not (stringp open)))
 (nraw "parameter `~S' is not a string! (ignored)~%" open))
((and close (not (stringp close)))
 (nraw "parameter `~S' is not a string! (ignored)~%" close))
;; line 260 "markup.nw"
((and sep  (not (stringp sep)))
 (nraw "parameter `~S' is not a string! (ignored)~%" sep))
;; line 729 "markup.nw"
        (t `(markup::define-list-environment-methods
             DO-MARKUP-ATTRIBUTE-GROUP-LIST ()
             :open  ,(when open  `((do-markup-string ,open)))
             :close ,(when close `((do-markup-string ,close)))
             :sep   ,(when sep   `((do-markup-string ,sep)))))))
;; line 759 "markup.nw"
(defmacro markup-attribute-group (&key open close group)
  (cond
;; line 245 "markup.nw"
((and open (not (stringp open)))
 (nraw "parameter `~S' is not a string! (ignored)~%" open))
((and close (not (stringp close)))
 (nraw "parameter `~S' is not a string! (ignored)~%" close))
;; line 761 "markup.nw"

;; line 275 "markup.nw"
((and group (progn
              (setq group (stringify group))
              (not (lookup-letter-group-definition *indexstyle* group))))
 (nraw "parameter `~S' is not a valid letter-group! (ignored)~%" group))
;; line 762 "markup.nw"
        (t `(markup::define-environment-methods
             DO-MARKUP-ATTRIBUTE-GROUP
             (,(if group
                   `(ordnum (EQL ,group))
                   '(ordnum number)))
             :declare ((declare (ignore ordnum)))
             :open  ,(when open  `((do-markup-string ,open)))
             :close ,(when close `((do-markup-string ,close)))))))
;; line 786 "markup.nw"
(defmacro markup-locref-list (&key open close sep class depth)
  (cond
;; line 245 "markup.nw"
((and open (not (stringp open)))
 (nraw "parameter `~S' is not a string! (ignored)~%" open))
((and close (not (stringp close)))
 (nraw "parameter `~S' is not a string! (ignored)~%" close))
;; line 260 "markup.nw"
((and sep  (not (stringp sep)))
 (nraw "parameter `~S' is not a string! (ignored)~%" sep))
;; line 788 "markup.nw"

;; line 265 "markup.nw"
((and depth (not (integerp depth)))
 (nraw "parameter `~S' is not a number! (ignored)~%" depth))
;; line 789 "markup.nw"

;; line 282 "markup.nw"
((and class (progn (setq class (stringify class))
                   (not (lookup-locref-class *indexstyle* class))))
 (nraw "parameter `~S' is not a location-reference class! (ignored)~%" class))
;; line 790 "markup.nw"
        (t `(markup::define-list-environment-methods
             DO-MARKUP-LOCREF-LIST
             (,(if class
                   `(locrefcls (EQL ',(cdr (lookup-locref-class
                                            *indexstyle* class))))
                   '(locrefcls layered-location-class))
              ,(if depth `(depth (EQL ,depth)) '(depth number)))
             :declare ((declare (ignore locrefcls depth)))
             :open  ,(when open  `((do-markup-string ,open)))
             :close ,(when close `((do-markup-string ,close)))
             :sep   ,(when sep   `((do-markup-string ,sep)))))))
;; line 865 "markup.nw"
(defmacro markup-locref-layer-list (&key open close sep class depth)
  (cond
;; line 245 "markup.nw"
((and open (not (stringp open)))
 (nraw "parameter `~S' is not a string! (ignored)~%" open))
((and close (not (stringp close)))
 (nraw "parameter `~S' is not a string! (ignored)~%" close))
;; line 260 "markup.nw"
((and sep  (not (stringp sep)))
 (nraw "parameter `~S' is not a string! (ignored)~%" sep))
;; line 867 "markup.nw"

;; line 265 "markup.nw"
((and depth (not (integerp depth)))
 (nraw "parameter `~S' is not a number! (ignored)~%" depth))
;; line 868 "markup.nw"

;; line 282 "markup.nw"
((and class (progn (setq class (stringify class))
                   (not (lookup-locref-class *indexstyle* class))))
 (nraw "parameter `~S' is not a location-reference class! (ignored)~%" class))
;; line 869 "markup.nw"
        (t `(markup::define-list-environment-methods
             DO-MARKUP-LOCREF-LAYER-LIST
             (,(if class
                   `(locrefcls (EQL ',(cdr (lookup-locref-class
                                            *indexstyle* class))))
                   '(locrefcls layered-location-class))
              ,(if depth `(depth (EQL ,depth)) '(depth number)))
             :declare ((declare (ignore locrefcls depth)))
             :open  ,(when open  `((do-markup-string ,open)))
             :close ,(when close `((do-markup-string ,close)))
             :sep   ,(when sep   `((do-markup-string ,sep)))))))
;; line 899 "markup.nw"
(defmacro markup-locref-layer (&key class open close depth layer)
  (cond
;; line 245 "markup.nw"
((and open (not (stringp open)))
 (nraw "parameter `~S' is not a string! (ignored)~%" open))
((and close (not (stringp close)))
 (nraw "parameter `~S' is not a string! (ignored)~%" close))
;; line 901 "markup.nw"

;; line 265 "markup.nw"
((and depth (not (integerp depth)))
 (nraw "parameter `~S' is not a number! (ignored)~%" depth))
;; line 902 "markup.nw"

;; line 270 "markup.nw"
((and layer (not (integerp layer)))
 (nraw "parameter `~S' is not a number! (ignored)~%" layer))
;; line 903 "markup.nw"

;; line 282 "markup.nw"
((and class (progn (setq class (stringify class))
                   (not (lookup-locref-class *indexstyle* class))))
 (nraw "parameter `~S' is not a location-reference class! (ignored)~%" class))
;; line 904 "markup.nw"
        (t `(markup::define-environment-methods
             DO-MARKUP-LOCREF-LAYER
             (,(if class
                   `(locrefcls (EQL ',(cdr (lookup-locref-class
                                            *indexstyle* class))))
                   '(locrefcls layered-location-class))
              ,(if depth `(depth (EQL ,depth)) '(depth number))
              ,(if layer `(layer (EQL ,layer)) '(layer number)))
             :declare ((declare (ignore depth layer)))
             :open  ,(when open  `((do-markup-string ,open)))
             :close ,(when close `((do-markup-string ,close)))))))
;; line 930 "markup.nw"
(defmacro markup-locref (&key open close class attr depth)
  (cond
;; line 245 "markup.nw"
((and open (not (stringp open)))
 (nraw "parameter `~S' is not a string! (ignored)~%" open))
((and close (not (stringp close)))
 (nraw "parameter `~S' is not a string! (ignored)~%" close))
;; line 932 "markup.nw"

;; line 294 "markup.nw"
((and attr (progn (setq attr (stringify attr))
                   (not (lookup-catattr *indexstyle* attr))))
 (nraw "parameter `~S' is not an attribute! (ignored)~%" attr))
;; line 933 "markup.nw"

;; line 265 "markup.nw"
((and depth (not (integerp depth)))
 (nraw "parameter `~S' is not a number! (ignored)~%" depth))
;; line 934 "markup.nw"

;; line 282 "markup.nw"
((and class (progn (setq class (stringify class))
                   (not (lookup-locref-class *indexstyle* class))))
 (nraw "parameter `~S' is not a location-reference class! (ignored)~%" class))
;; line 935 "markup.nw"
        (t `(markup::define-environment-methods
             DO-MARKUP-LOCREF
             (,(if attr
                   `(attr (EQL ',(lookup-catattr *indexstyle* attr)))
                   '(attr category-attribute))
              ,(if class
                   `(locrefcls (EQL ',(cdr (lookup-locref-class
                                            *indexstyle* class))))
                   '(locrefcls layered-location-class))
              ,(if depth `(depth (EQL ,depth)) '(depth number)))
             :declare ((declare (ignore attr locrefcls depth)))
             :open  ,(when open  `((do-markup-string ,open)))
             :close ,(when close `((do-markup-string ,close)))))))
;; line 1002 "markup.nw"
(defmacro markup-range (&whole whole &rest args)
  (destructuring-switch-bind (&key
                              open close sep class length
                              &switch ignore-end)
      args
    (cond
;; line 245 "markup.nw"
((and open (not (stringp open)))
 (nraw "parameter `~S' is not a string! (ignored)~%" open))
((and close (not (stringp close)))
 (nraw "parameter `~S' is not a string! (ignored)~%" close))
;; line 260 "markup.nw"
((and sep  (not (stringp sep)))
 (nraw "parameter `~S' is not a string! (ignored)~%" sep))
;; line 1008 "markup.nw"

;; line 282 "markup.nw"
((and class (progn (setq class (stringify class))
                   (not (lookup-locref-class *indexstyle* class))))
 (nraw "parameter `~S' is not a location-reference class! (ignored)~%" class))
;; line 1009 "markup.nw"
          ((and length (not (numberp length)))
             (nraw "parameter `~S' is not a number! (ignored)~%" length))
          (t `(let ()
               (markup::define-list-environment-methods
                   DO-MARKUP-RANGE
                   (,(if class
                         `(locrefcls (EQL ',(cdr (lookup-locref-class
                                                  *indexstyle* class))))
                         '(locrefcls layered-location-class))
                    ,(if length
                         `(length (EQL ,length))
                         '(length number)))
                 :open  ,(when open  `((do-markup-string ,open)))
                 :close ,(when close `((do-markup-string ,close)))
                 :sep   ,(when sep   `((do-markup-string ,sep))))
               (define-method markup::MARKUP-RANGE-PRINT-END-P
                   (,(if class
                         `(locrefcls (EQL ',(cdr (lookup-locref-class
                                                  *indexstyle* class))))
                         '(locrefcls layered-location-class))
                    ,(if length
                         `(length (EQL ,length))
                         '(length number)))
                 :declare ((declare (ignore locrefcls length)))
                 :body    (,(not ignore-end))))))))
;; line 1064 "markup.nw"
(defmacro markup-crossref-list (&key open sep close class)
  (cond
;; line 245 "markup.nw"
((and open (not (stringp open)))
 (nraw "parameter `~S' is not a string! (ignored)~%" open))
((and close (not (stringp close)))
 (nraw "parameter `~S' is not a string! (ignored)~%" close))
;; line 260 "markup.nw"
((and sep  (not (stringp sep)))
 (nraw "parameter `~S' is not a string! (ignored)~%" sep))
;; line 1066 "markup.nw"

;; line 288 "markup.nw"
((and class (progn (setq class (stringify class))
                   (not (lookup-crossref-class *indexstyle* class))))
 (nraw "parameter `~S' is not a cross-reference class! (ignored)~%" class))
;; line 1067 "markup.nw"
        (t `(markup::define-list-environment-methods
             DO-MARKUP-CROSSREF-LIST
             (,(if class
                   `(xrefcls (EQL ',(cdr (lookup-crossref-class *indexstyle*
                                                                class))))
                   '(xrefcls crossref-location-class)))
             :declare ((declare (ignore xrefcls)))
             :open  ,(when open  `((do-markup-string ,open)))
             :close ,(when close `((do-markup-string ,close)))
             :sep   ,(when sep   `((do-markup-string ,sep)))))))
;; line 1103 "markup.nw"
(defmacro markup-crossref-layer-list (&key open sep close class)
  (cond
;; line 245 "markup.nw"
((and open (not (stringp open)))
 (nraw "parameter `~S' is not a string! (ignored)~%" open))
((and close (not (stringp close)))
 (nraw "parameter `~S' is not a string! (ignored)~%" close))
;; line 260 "markup.nw"
((and sep  (not (stringp sep)))
 (nraw "parameter `~S' is not a string! (ignored)~%" sep))
;; line 1105 "markup.nw"

;; line 288 "markup.nw"
((and class (progn (setq class (stringify class))
                   (not (lookup-crossref-class *indexstyle* class))))
 (nraw "parameter `~S' is not a cross-reference class! (ignored)~%" class))
;; line 1106 "markup.nw"
        (t `(markup::define-list-environment-methods
             DO-MARKUP-CROSSREF-LAYER-LIST
             (,(if class
                   `(xrefcls (EQL ',(cdr (lookup-crossref-class *indexstyle*
                                                                class))))
                   '(xrefcls crossref-location-class)))
             :declare ((declare (ignore xrefcls)))
             :open  ,(when open  `((do-markup-string ,open)))
             :close ,(when close `((do-markup-string ,close)))
             :sep   ,(when sep   `((do-markup-string ,sep)))))))
;; line 1134 "markup.nw"
(defmacro markup-crossref-layer (&key open close class)
  (cond
;; line 245 "markup.nw"
((and open (not (stringp open)))
 (nraw "parameter `~S' is not a string! (ignored)~%" open))
((and close (not (stringp close)))
 (nraw "parameter `~S' is not a string! (ignored)~%" close))
;; line 1136 "markup.nw"

;; line 288 "markup.nw"
((and class (progn (setq class (stringify class))
                   (not (lookup-crossref-class *indexstyle* class))))
 (nraw "parameter `~S' is not a cross-reference class! (ignored)~%" class))
;; line 1137 "markup.nw"
        (t `(markup::define-list-environment-methods
             DO-MARKUP-CROSSREF-LAYER
             (,(if class
                   `(xrefcls (EQL ',(cdr (lookup-crossref-class *indexstyle*
                                                                class))))
                   '(xrefcls crossref-location-class)))
             :declare ((declare (ignore xrefcls)))
             :open  ,(when open  `((do-markup-string ,open)))
             :close ,(when close `((do-markup-string ,close)))))))
;; line 1188 "markup.nw"
(eval-when (compile load eval)
  (defparameter *markup-user-interface-definitions*
    '(*markup-verbose-mode*
      *markup-verbose-open*
      *markup-verbose-close*
      markup-crossref-layer
      markup-crossref-layer-list
      markup-crossref-list
      markup-index
      markup-letter-group
      markup-letter-group-list
      markup-indexentry
      markup-indexentry-list
      markup-keyword
      markup-keyword-list
      markup-locclass-list
      markup-locref-class
      markup-attribute-group-list
      markup-attribute-group
      markup-locref-list
      markup-locref
      markup-locref-layer-list
      markup-locref-layer
      markup-range
      markup-trace
      )))

;; line 1238 "markup.nw"
(eval-when (compile load eval)

;; line 89 "markup.nw"
(export '(*markup-output-stream*
          *markup-verbose-mode*
          *markup-verbose-open*
          *markup-verbose-close*
          *indexstyle-readtable*))
;; line 347 "markup.nw"
(export '(do-markup-index))
;; line 1217 "markup.nw"
(export '*markup-user-interface-definitions*)
(export *markup-user-interface-definitions*)
;; line 1240 "markup.nw"
  )

;; line 1178 "markup.nw"
(defvar *RCS-Identifier* '(
;; line 1244 "markup.nw"
("markup" . "$Id: markup.nw,v 1.24 1997/03/26 16:18:58 kehr Exp $")
;; line 236 "startup.nw"
("startup" . "$Id: startup.nw,v 1.17 1997/03/26 16:19:03 kehr Exp $")
;; line 1178 "markup.nw"
                                               ))

;; this should be the last of the module since it defines the
;; additional package `xindy'.
;; line 210 "startup.nw"
;; $Id: startup.nw,v 1.17 1997/03/26 16:19:03 kehr Exp $

(lisp:defpackage  "XINDY")
(lisp:in-package  "XINDY")

(eval-when (compile load eval)
  (lisp:use-package "BASE")
  (lisp:use-package :xindy-version)
  (lisp:use-package "MARKUP")
  (lisp:use-package "CLOS")
  (lisp:use-package "COMMON-LISP")
  #+CLISP (lisp:use-package "EXT")
  (lisp:import markup:*markup-user-interface-definitions*))

(eval-when (compile load eval)
  (pushnew :HANDLER      *features*))
;; FIXME: error messages about package locks
;(eval-when (compile load eval)
;  (pushnew :BREAK-DRIVER *features*))

;; line 44 "startup.nw"
(defun issue-startup-message ()
  (info "xindy kernel version: ~A~%" *xindy-kernel-version*)
  (info "xindy run time engine: ~A, version ~A~%"
	*xindy-platform* xindy::*xindy-rte-version*)
  (info "~A version ~A~%    architecture: ~A~%"
	(lisp-implementation-type) (lisp-implementation-version)
	(machine-version))
  )

(defun startup (&key idxstyle rawindex output logfile
                     show-version markup-trace (trace-level 0))
  (when show-version
    (issue-startup-message)
    (exit-normally))
  (when markup-trace (setq *markup-verbose-mode* t))
  #+:HANDLER
  (handler-case
      (do-startup idxstyle rawindex output logfile trace-level)
    (error
        (condition)
      (oops* (simple-condition-format-string    condition)
             (simple-condition-format-arguments condition))
      (error-exit)))
  #-:HANDLER
  (do-startup idxstyle rawindex output logfile trace-level))
;; line 70 "startup.nw"
(defun do-startup (idxstyle raw-index output logfile trace-level)
  (set-searchpath-by-environment)
  (setq custom:*default-file-encoding* charset:iso-8859-1
	custom:*foreign-encoding* charset:iso-8859-1)
  (when logfile
    (info "~&Opening logfile ~S " logfile)
    (handler-case
        (setq *logging-stream* (open logfile
                                     :direction :output
                                     :if-does-not-exist :create
                                     :if-exists :supersede))
      (error ()
             (oops "Opening logfile ~S failed!" logfile)
             (error-exit)))
    (info "(done)~%")
    ;; Set necessary flags...
    (setq *logging-on* t)
    (case trace-level
      (0)
      (1 (setq *mappings-trace* t))
      (2 (setq *mappings-trace* t) (setq *locref-trace* t))
      (3 (setq *mappings-trace* t) (setq *locref-trace* t))
      (t (error "Invalid :trace-level ~S !" trace-level)))
    #+:ORDRULES (when *mappings-trace*
                  (setq ordrules::*message-logging* 1))

    (multiple-value-bind (sec min hour day mon year)
        (get-decoded-time)
      (gol t ";; This logfile was generated automatically by `xindy'~%")
      (gol t ";; at ~2,'0D.~2,'0D.~4,'0D  ~2,'0D:~2,'0D:~2,'0D~%"
           day mon year hour min sec))
    (gol t ";; Indexstyle: ~S, Rawindex: ~S, Output: ~S~%~%"
         idxstyle raw-index output)
    )

  (info "~&Reading indexstyle...~%")
  (let ((*readtable* idxstyle:*indexstyle-readtable*))
    (idxstyle:do-require idxstyle))
  (info "~&Finished reading indexstyle.")
  (info "~&Finalizing indexstyle... ")
  (idxstyle:make-ready idxstyle:*indexstyle*)
  (info "(done)~%~%")

  (info "~&Reading raw-index ~S..." raw-index)
  (load raw-index :verbose nil)
  (info "~&Finished reading raw-index.~%~%")

  (handler-case
      (setq *markup-output-stream*
            (open output
                  :direction :output
                  :if-does-not-exist :create
                  :if-exists :supersede))
    (error ()
           (oops "Opening file ~S failed!" output)
           (error-exit)))

  (info "~&Processing index...")
  (index:process-index index:*index*)
  (info "~&Finished processing index.~%~%")

  (info "~&Writing markup...")
  (markup:do-markup-index index:*index*)
  (info "~%Markup written into file ~S.~%" output))
;; line 139 "startup.nw"
(defun set-searchpath-by-environment ()
  (let ((sp (#+CLISP
             system::getenv
             #+ALLEGRO
             sys:getenv
             "XINDY_SEARCHPATH")))
    (when sp (idxstyle:set-searchpath-by-string sp))))
;; line 170 "startup.nw"
#+:BREAK-DRIVER
(fmakunbound '*break-driver*)

#+:BREAK-DRIVER
(defun *break-driver* (continuable
                       &optional (condition nil) (print-it nil)
                       &aux (may-continue
                             (or continuable
                                 (and condition
                                      (find-restart 'continue condition))
                                 ) )
                       (interactive-p (interactive-stream-p *debug-io*))
                       (commandsr '())
                       )
  (declare (ignore may-continue interactive-p commandsr))
  ;; This when-clause is from Bruno Haible.
  (when (and condition print-it)
    (terpri *error-output*)
    (write-string "*** - " *error-output*)
    #+CLISP (system::print-condition condition *error-output*)
    #-CLISP (print condition *error-output*)
    )
  (format *ERROR-OUTPUT* "~&Bye.")
  (error-exit))

#+:BREAK-DRIVER-OLD
(defun *break-driver* (continuable &rest rest)
  (declare (ignore continuable rest))
  (format *ERROR-OUTPUT* "~&Bye.")
  (error-exit))

#+:BREAK-DRIVER
(eval-when (compile load eval)
  (export '*break-driver*))

;; line 230 "startup.nw"
(eval-when (compile load eval)

;; line 135 "startup.nw"
(export '(startup *xindy-core-version* *xindy-platform*))
;; line 232 "startup.nw"
  )