;;;; psgml-info.el;;; Last edited: 2000-11-09 19:23:50 lenst;;; $Id$;; Copyright (C) 1994, 1995 Lennart Staflin;; Author: Lennart Staflin <lenst@lysator.liu.se>;; This program is free software; you can redistribute it and/or;; modify it under the terms of the GNU General Public License;; as published by the Free Software Foundation; either version 2;; of the License, or (at your option) any later version.;; ;; This program is distributed in the hope that it will be useful,;; but WITHOUT ANY WARRANTY; without even the implied warranty of;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the;; GNU General Public License for more details.;; ;; You should have received a copy of the GNU General Public License;; along with this program; if not, write to the Free Software;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.Nextpage...;;;; Commentary:;; This file is an addon to the PSGML package. ;; This file contains some commands to print out information about the;; current DTD.;; sgml-list-elements;; Will list all elements and the attributes declared for the element.;; sgml-list-attributes;; Will list all attributes declared and the elements that use them.;; sgml-list-terminals;; Will list all elements that can contain data.;; sgml-list-occur-in-elements;; Will list all element types and where it can occur.;; sgml-list-content-elements;; Will list all element types and the element types that can occur;; in its content.;;;; Code:(provide'psgml-info)(require'psgml)(require'psgml-parse)(defconstsgml-attr-col18);;;; Utility functions(defsubstsgml-add-to-table(row-indexelemtable)(let((p(assocrow-indextable)))(cond((nullp)(cons(listrow-indexelem)table))(t(nconcp(listelem))table))))(defsubstsgml-add-last-unique(xl)(unless(memqxl)(nconcl(listx))))(defunsgml-map-element-types(func)(sgml-need-dtd)(sgml-map-eltypesfunc(sgml-pstate-dtdsgml-buffer-parse-state)t))(defunsgml-eltype-refrenced-elements(eltype)"List of element types referenced in the model of ELTYPE.";; Now with cache. Uses appdata prop re-cache.(or(sgml-eltype-appdataeltype're-cache)(let*((res; result list (eltypes)nil)(states; list of states(list(sgml-eltype-modeleltype)))(agenda; point into statesstates))(cond((not(sgml-model-group-p(carstates)))nil)(t(whileagenda(cond((sgml-normal-state-p(caragenda))(loopformin(append(sgml-state-opts(caragenda))(sgml-state-reqs(caragenda)))do(pushnew(sgml-move-tokenm)res)(sgml-add-last-unique(sgml-move-destm)states)))(t; &-node(sgml-add-last-unique(sgml-and-node-next(caragenda))states)(loopfordfain(sgml-and-node-dfas(caragenda))do(sgml-add-last-uniquedfastates))))(setqagenda(cdragenda)))(setqres(sort(copy-seq(set-difference(unionres(sgml-eltype-includeseltype))(sgml-eltype-excludeseltype)))(functionstring-lessp)))(setf(sgml-eltype-appdataeltype're-cache)res)res)))));;;; List elements(defunsgml-list-elements()"List the elements and their attributes in the current DTD."(interactive)(message"Creating table...")(sgml-display-table(sgml-map-element-types(function(lambda(eltype)(cons(sgml-eltype-nameeltype)(mapcar(functionsgml-attdecl-name)(sgml-eltype-attlisteltype))))))"Elements""Element""Attribute"));;;; List attributes(defunsgml-list-attributes()"List the attributes and in which elements they occur."(interactive)(let((attributesnil))(message"Creating table...")(sgml-map-element-types(function(lambda(eltype)(loopforain(sgml-eltype-attlisteltype)do(setqattributes(sgml-add-to-table(sgml-attdecl-namea)(sgml-eltype-nameeltype)attributes))))))(sgml-display-tableattributes"Attributes""Attribute""Element")));;;; List terminals(defunsgml-list-terminals()"List the elements that can have data in their content."(interactive)(message"Creating table...")(let((data-models(listsgml-cdatasgml-rcdatasgml-any)))(sgml-display-table(delqnil(sgml-map-element-types(function(lambda(eltype)(if(or(sgml-eltype-mixedeltype)(memq(sgml-eltype-modeleltype)data-models))(list(sgml-eltype-nameeltype)(symbol-name(if(sgml-model-group-p(sgml-eltype-modeleltype))'mixed(sgml-eltype-modeleltype)))))))))"Terminals""Element""Content")));;;; Element cross reference list(defunsgml-list-content-elements()"List all element types and the element types that can occur in its content."(interactive)(message"Creating table...")(sgml-display-table(sgml-map-element-types(function(lambda(eltype)(cons(sgml-eltype-nameeltype)(mapcar(functionsgml-eltype-name)(sgml-eltype-refrenced-elementseltype))))))"Elements referenced by elements""Element""Content"))(defunsgml-list-occur-in-elements()"List all element types and where it can occur."(interactive)(message"Creating table...")(let((crossnil))(sgml-map-element-types(function(lambda(eltype)(loopforrefin(sgml-eltype-refrenced-elementseltype)do(setqcross(sgml-add-to-tableref(sgml-eltype-nameeltype)cross))))))(sgml-display-tablecross"Cross referenced element types""Element""Can occur in")));;;; Display table(defunsgml-display-table(tabletitlecol-title1col-title2&optionalwidthnosort)(orwidth(setqwidthsgml-attr-col))(let((buf(get-buffer-create(format"*%s*"title))))(message"Preparing display...")(set-bufferbuf)(erase-buffer)(insertcol-title1)(indent-towidth)(insertcol-title2"\n")(insert-char?=(lengthcol-title1))(indent-towidth)(insert-char?=(lengthcol-title2))(insert"\n")(unlessnosort(setqtable(sorttable(function(lambda(ab)(string<(cara)(carb)))))))(loopforeintabledo(insert(format"%s "(care)))(loopfornamein(ifnosort(cdre)(sort(cdre)(functionstring-lessp)))do(when(>(+(lengthname)(current-column))fill-column)(insert"\n"))(when(<(current-column)sgml-attr-col)(indent-towidth))(insertname" "))(insert"\n"))(goto-char(point-min))(display-bufferbuf)(messagenil)));;;; Describe entity(defunsgml-describe-entity(name)"Describe the properties of an entity as declared in the current DTD."(interactive(let(defaultinput)(sgml-need-dtd)(save-excursion(sgml-with-parser-syntax(unless(sgml-parse-delim"ERO")(skip-chars-backward"^&\"'= \t\n"))(setqdefault(or(sgml-parse-namet)""))))(setqinput(completing-read(format"Entity name (%s): "default)(sgml-entity-completion-table(sgml-dtd-entities(sgml-pstate-dtdsgml-buffer-parse-state)))))(list(if(equal""input)defaultinput))))(with-output-to-temp-buffer"*Help*"(let((entity(sgml-lookup-entityname(sgml-dtd-entities(sgml-pstate-dtdsgml-buffer-parse-state)))))(orentity(error"Undefined entity"))(princ(format"Entity %s is %s\n"name(cond((nullentity)"undefined")(t(format"a %s entity"(sgml-entity-typeentity))))))(whenentity(let((text(sgml-entity-textentity))(notation(sgml-entity-notationentity)))(cond((stringptext)(princ"Defined to be:\n")(princtext))(t(princ"With external identifier ")(princ(if(cartext)"PUBLIC""SYSTEM"))(when(cartext)(princ(format" '%s'"(cartext))))(when(cdrtext)(princ(format" '%s'"(cdrtext))))(whennotation(princ(format"\nand notation '%s'"notation))))))))));;;; Describe element type(defunsgml-princ-names(names&optionalfirstsep)(setqsep(orsep" "))(loopwithcol=0fornameinnamesforthis-sep=(iffirst(prog1first(setqfirstnil))sep)do(princthis-sep)(incfcol(lengththis-sep))(when(and(>col0)(>(+col(lengthname))fill-column))(princ"\n ")(setqcol1))(princname)(incfcol(lengthname))))(defunsgml-describe-element-type(et-name)"Describe the properties of an element type as declared in the current DTD."(interactive(let(defaultinput)(sgml-need-dtd)(save-excursion(sgml-with-parser-syntax(unless(sgml-parse-delim"STAGO")(skip-syntax-backward"w_"))(setqdefault(sgml-parse-name))(unless(anddefault(sgml-eltype-defined(sgml-lookup-eltypedefault)))(setqdefaultnil))))(setqinput(sgml-read-element-type(ifdefault(format"Element type (%s): "default)"Element type: ")sgml-dtd-infodefault))(list(sgml-eltype-nameinput))))(sgml-need-dtd)(let((et(sgml-lookup-eltypeet-name)))(with-output-to-temp-buffer"*Help*"(princ(format"ELEMENT: %s\n\n"(sgml-eltype-nameet)))(princ(format" Start-tag is %s.\n End-tag is %s.\n"(if(sgml-eltype-stag-optionalet)"optional""required")(if(sgml-eltype-etag-optionalet)"optional""required")))(princ"\nATTRIBUTES:\n")(loopforattdeclin(sgml-eltype-attlistet)do(let((name(sgml-attdecl-nameattdecl))(dval(sgml-attdecl-declared-valueattdecl))(defl(sgml-attdecl-default-valueattdecl)))(when(listpdval)(setqdval(concat(if(eq(firstdval)'NOTATION)"#NOTATION (""(")(mapconcat(functionidentity)(seconddval)"|")")")))(cond((sgml-default-value-type-p'FIXEDdefl)(setqdefl(format"#FIXED '%s'"(sgml-default-value-attvaldefl))))((symbolpdefl)(setqdefl(upcase(format"#%s"defl))))(t(setqdefl(format"'%s'"(sgml-default-value-attvaldefl)))))(princ(format" %-9s %-30s %s\n"namedvaldefl))));; ----(let((s(sgml-eltype-shortmapet)))(whens(princ(format"\nUSEMAP: %s\n"s))));; ----(princ"\nCONTENT: ")(cond((symbolp(sgml-eltype-modelet))(princ(sgml-eltype-modelet)))(t(princ(if(sgml-eltype-mixedet)"mixed\n\n""element\n\n"))(sgml-princ-names(mapcar#'symbol-name(sgml-eltype-refrenced-elementset)))))(let((incl(sgml-eltype-includeset))(excl(sgml-eltype-excludeset)))(when(orinclexcl)(princ"\n\nEXCEPTIONS:"))(whenincl(princ"\n + ")(sgml-princ-names(mapcar#'symbol-nameincl)))(whenexcl(princ"\n - ")(sgml-princ-names(mapcar#'symbol-nameexcl))));; ----(princ"\n\nOCCURS IN:\n\n")(let((occurs-in()))(sgml-map-eltypes(function(lambda(cand)(when(memqet(sgml-eltype-refrenced-elementscand))(pushcandoccurs-in))))(sgml-pstate-dtdsgml-buffer-parse-state))(sgml-princ-names(mapcar'sgml-eltype-name(sortoccurs-in(functionstring-lessp))))))));;;; Print general info about the DTD.(defunsgml-general-dtd-info()"Display information about the current DTD."(interactive)(sgml-need-dtd)(let((elements0)(entities0)(parameters0)(fmt"%20s %s\n")(hdr""))(sgml-map-eltypes(function(lambda(e)(incfelements)))sgml-dtd-info)(sgml-map-entities(function(lambda(e)(incfentities)))(sgml-dtd-entitiessgml-dtd-info))(sgml-map-entities(function(lambda(e)(incfparameters)))(sgml-dtd-parameterssgml-dtd-info))(with-output-to-temp-buffer"*Help*"(princ(formatfmt"Doctype:"(sgml-dtd-doctypesgml-dtd-info)))(when(sgml-dtd-mergedsgml-dtd-info)(princ(formatfmt"Compiled DTD:"(car(sgml-dtd-mergedsgml-dtd-info)))))(princ(formatfmt"Element types:"(format"%d"elements)))(princ(formatfmt"Entities:"(format"%d"entities)))(princ(formatfmt"Parameter entities:"(format"%d"parameters)))(setqhdr"Files used:")(loopforxin(sgml-dtd-dependenciessgml-dtd-info)if(stringpx)do(princ(formatfmthdrx))(setqhdr""))(setqhdr"Undef parameters:")(sgml-map-entities(function(lambda(entity)(when(sgml-entity-marked-undefined-pentity)(princ(formatfmthdr(sgml-entity-nameentity)))(setqhdr""))))(sgml-dtd-parameterssgml-dtd-info)))));;; psgml-info.el ends here