;; 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" )