(in-package "CL-USER")

;; $Id: //info.ravenbrook.com/project/mps/tool/xml-import/mminfo-transforms.lisp#2 $

;; Transformations for documents extracted from the xml dump of mminfo.  
;; Nick Levine 2001-10-05

;; STATUS: this file started as transformations for mail documents
;; only. I continued to modify it as I worked my way down the list of
;; document types in mminfo. I did some regression tests, but did not
;; recreate every document every time I changed anything.  It is
;; therefore possible that some of the early types might need a little
;; hand-holding to continue running; this is not an issue at present
;; as running the code below has been envisaged as a one-off
;; operation. Note also that some of the changes have, as a price for
;; greatly simplifying and shortening the code, resulted in minor
;; changes to the formatting (e.g. changes to vertical whitespace) of
;; documents already submitted to Perforce; I have chose to leave
;; these well alone.


;; Before working on this file:
;; (compile-file (current-pathname "parse-xml") :load t) 

;; parse mminfo file: split off constituent documents, find best names
;; for them; apply transformations, write back as individual
;; documents. We know that the xml is not well-formed, so we do apply
;; a parse written specially to handle this rubbish.

;; form can be absent, or a string to filter by, or a hash-table to
;; read instead of the file.
(defun walk-xml (file function &optional form retain)
  (with-open-file (istream file)
    (if (hash-table-p form)
        (maphash (lambda (ignore documents)
                   (declare (ignore ignore))
                   (dolist (document documents)
                     (let ((pname (find-simple-subtag document 'form)))
                       (funcall function istream
                                (make-tag (tag-name document)
                                          (tag-attributes document)
                                          (sort-subtags (loop for subtag in (tag-contents document)
                                                              when (member (tag-name subtag) retain)
                                                              collect subtag)
                                                        pname))))))
                 form)
      (progn
        (dotimes (i 2) (read-line istream))          ; strip first 2 lines 
        (loop (when (eq (skip-to-start istream :eof-error nil) :eof)
                (return))
              (let ((tag (read-quasi-tag istream form retain)))
                (funcall function istream tag)))))))

(defun find-simple-subtag (tag name)
  (when-let (subtag (find name (tag-contents tag) :key 'tag-name))
    (car (tag-contents subtag))))

(defun split-xml-to-text (file form retain text-function filename-function)
  (walk-xml file
            (lambda (istream tag)
              (declare (ignore istream))
              (when tag
                (multiple-value-bind (text destination attachments)
                    (funcall text-function tag)
                  (let ((where (format nil "~a~a"
                                       (pathname-location file)
                                       destination)))
                    (ensure-directories-exist where)
                    (let ((ofile (format nil "~a~a" 
                                         where
                                         (funcall filename-function destination))))
                      (with-open-file (ostream ofile
                                               :direction :output
                                               :external-format '(:latin-1 :eol-style :lf)
                                               :if-exists :supersede)
                        (write-string text ostream))
                      (when attachments
                        (format t "~&~a~&" destination)
                        (dolist (attachment attachments) (format t "~&   ~a" (car attachment)))))))))
            form
            retain))


;; we start by wanting to know what is in the file, but it's far too
;; large to inspect visually.

(defparameter *always-empty*
  '($Orig                  
    $Fonts                 
    Docuid                 
    Updatelog              
    $Links                 
    Sendertag              
    $Keepprivate           
    Securemail             
    Inheritedfromdomain    
    Mailsavedform          
    Createdby_1            
    Createdtime_1          
    Goals                  
    Responsibilities       
    $Signature             
    $Verref                
    $Header                
    $Ref                   
    Orgconfidential        
    Broadcast              
    Bookfreetime           
    Fromcategories)
  "Experimentation has shown that the values against these tags in mminfo2.xml are always empty")

;; The form tag defines the overall shape for this document. Experimentally, we believe it.
(defun tree-xml-document (file)
  (let ((table (make-hash-table :test 'equal)))
    (walk-xml file
              (lambda (istream tag)
                (declare (ignore istream))
                (let* ((names nil)
                       (form (car (tag-contents (find 'form (tag-contents tag) :key 'tag-name))))
                       (form-table (or (gethash form table)
                                       (setf (gethash form table)
                                             (make-hash-table :test 'equal)))))
                  (dolist (subtag (tag-contents tag))
                    (let ((name (tag-name subtag)))
                      (unless (member name *always-empty*)
                        (push name names))))
                  (incf (gethash (sort names 'string<) form-table 0)))))
    table))

;; It's really worth calling this on each value in the table returned by tree-xml-document
(defun display-table (table)
  (let ((names (let ((temp-tab (make-hash-table))
                     (names nil))
                 (maphash (lambda (k v) (dolist (kk k) (incf (gethash kk temp-tab 0) v))) table)
                 (maphash (lambda (k v) (push (list k v) names)) temp-tab)
                 (mapcar 'car (sort names '> :key 'cadr))))
        (name-lists nil))
    (maphash (lambda (k v) (declare (ignore v))(push k name-lists)) table)
    (let ((max (reduce 'max  names :key (lambda (x) (length (symbol-name x))))))
      (dolist (name names)
        (format t "~&~a~vt" name (+ max 4))
        (dolist (name-list name-lists)
          (format t (if (member name name-list) "*" " ")))))))

;;;;;;;;;;;;;;;;;;;;;;

;; 2001-10-04 - read-quasi-tag. I asked Xanalys:
;;
;;   Now, I could throw away my xml parser and - on the assumption that
;;   all your xml contains is <item> tags inside <document> tags - build
;;   something simpler.
;;   Can you tell me whether this assumption is correct? 
;;
;; and fwiw they said "yes".

(defun read-quasi-tag (istream form retain)
  (read-line-matching istream "<document>")
  (let ((return-nil nil)
        (subtags nil)
        (close-doc "</document>"))
    (loop (multiple-value-bind (line match position)
              (read-line-matching istream close-doc "<item name=")
            (when (eq match close-doc)
              (return))
            (let ((tag-name (intern (nstring-upcase (read-from-string line t nil :start position))))
                  (lines nil))
              (loop (let ((line (read-line istream)))
                      (when (string= line "</item>")
                        (return))
                      (push line lines)))
              (when (and form
                         (eq tag-name 'form)
                         (string/= form (car lines)))
                (setf return-nil t))
              (unless (or return-nil
                          (and retain
                               (not (member tag-name retain))))
                (push (make-tag tag-name
                                nil 
                                (join-lines (nreverse lines)))
                      subtags)))))
    (unless return-nil
      (make-tag 'document 
                nil
                (if retain
                    (sort-subtags subtags form)
                  (nreverse subtags))))))

(defun sort-subtags (subtags pname)
  ;; this would be gross on a larger system but is ok for this one
  (sort subtags '< :key (lambda (subtag) (get (tag-name subtag) (intern (string-upcase pname))))))

(defun join-lines (lines)
  `(,(if (< (length lines) 50)                     ;; ??????? wild guess, but it gave me a factor of 10 speedup and is now fast enough
         (reduce (lambda (s1 s2) (concatenate 'string s1  #(#\Newline) s2))
                 lines)
       (let ((string (make-array (+ (reduce '+ lines :key 'length) (length lines))
                                 :element-type 'base-char :fill-pointer 0)))
         (with-output-to-string (str string)
           (dolist (line lines)
             (write-string line str)
             (terpri str)))
         string))))                                

(defun read-line-matching (istream &rest matches)
  (let ((line (read-line istream)))
    (dolist (match matches)
      (let ((match-length (length match)))
        (when (and (>= (length line) match-length)
                   (string= line match :end1 match-length))
          (return-from read-line-matching 
            (values line match match-length)))))
    (if (cdr matches)
        (xml-parse-error istream "Expected one of ~s~{, ~s~}; got ~s." (car matches) (cdr matches) line)
      (xml-parse-error istream "Expected ~s; got ~s." (car matches) line))))


(defparameter page-width 72)          
(defparameter *spaces* (make-string page-width :initial-element #\Space))

(defun centre (text)
  (let* ((text (string-trim #(#\Space) text))
         (length (length text))
         (where (position #\Newline text)))
    (cond ((null text) (terpri))
          ((zerop length))
          (where (centre (subseq text 0 where))
                 (centre (subseq text (1+ where))))
          ((> length page-width) (let* ((break-near (floor page-width 2))
                                        (where (or (position #\Space text :start break-near)
                                                   (position #\Space text :end break-near :from-end t)
                                                   (warn "~s unsuitable for centre." text))))
                                     (if where
                                         (progn
                                           (centre (subseq text 0 where))
                                           (centre (subseq text (1+ where))))
                                       (write-string text))))
          (t (write-string *spaces* nil :end (floor (- page-width length) 2))
             (write-string text)
             (terpri)))))

(defun minor (label text)
  (when (plusp (length text))
    (format t "~@[~a: ~]~a~%" label text)))

(defun major (label text)
  (when (plusp (length text))
    (format t "~%~@[~a:~2%~]~a~2%" label text)))

(defun centres (&rest texts)
  (dolist (text texts)
    (centre text)))

(defun minors (&rest data)
  (write-against-labels data 'minor))

(defun majors (&rest data)
  (write-against-labels data 'major))

(defun write-against-labels (data function)
  (when (loop for text in (cdr data) by 'cddr thereis (plusp (length text)))
    (terpri)
    (loop for (label text) on data by 'cddr
          do (funcall function label text))))

(defun attach (attachments)
  (when attachments
    (major (if (cdr attachments) "ATTACHMENTS" "ATTACHMENT")
           (format nil "~{   ~s~%~}" (mapcar 'car attachments)))))

(defun extract-date (creationtime)
  ;;  <creationtime>11/08/95 11:12:31</creationtime>
  (let* ((day-end (position #\/ creationtime))
         (month-end (position #\/ creationtime :start (1+ day-end)))
         (year-end (position #\Space creationtime :start (1+ month-end)))
         (raw-year (parse-integer creationtime :start (1+ month-end) :end year-end))
         (year (cond ((< 1000 raw-year) raw-year)
                     ((<= 50 raw-year 99) (+ raw-year 1900))
                     ((<= 00 raw-year 10) (+ raw-year 2000))
                     (t (error "Bad year ~d." raw-year)))))
    (values
     (format nil "~a-~a-~a"
             year 
             (subseq creationtime (1+ day-end) month-end)
             (subseq creationtime 0 day-end))
     (1+ year-end))))

;; def-simple-tag

(defun mark-tag-order (form list)
  (let ((pname (intern (string-upcase form))))
    (loop for name in list as position from 0 do
          (setf (get name pname) position)))
  list)

(defmacro binding-subtags ((&rest names) contents &body body)
  (if names
      (let ((name (car names))
            (contents-var (gensym "CONTENTS-VAR-"))
            (next-var (gensym "NEXT-VAR-")))
        `(let* ((,contents-var ,contents)
                (,next-var (car ,contents-var))
                ,name)
           (when (and ,next-var
                      (eq (tag-name ,next-var) ',name))
             (setf ,name (car (tag-contents ,next-var)))
             (pop ,contents-var))
           (binding-subtags ,(cdr names) ,contents-var ,@body)))
    `(progn ,@body)))

(defmacro def-simple-tag (form arglist &body body-and-filename-function)
  (let ((fun-name (intern (string-upcase (format nil "~a-from-xml" form))))
        (filename-function (or (cadr body-and-filename-function)
                               (constantly "index.txt")))
        (body (car body-and-filename-function)))
    `(progn
       (mark-tag-order ',form ',arglist)
       (defun ,fun-name (file &optional tree)
         (split-xml-to-text file 
                            (if (hash-table-p tree)
                                (gethash ',form tree)
                              ',form)
                            ',arglist
                            (lambda (document)
                              (binding-subtags ,arglist (tag-contents document)
                                ,body))
                            ,filename-function)))))

(defmacro def-very-simple-tag (form &rest minors)
  `(def-simple-tag ,form (title tag status type createdby creationtime 
                                ,@(loop for var in (cdr minors) by 'cddr collect var)
                                text $file)
    (let ((attachments (when $file
                         ;; we know there was at least one attachment, but not that there was only one.
                         (mapcar 'tag-contents (member '$file (tag-contents document) :key 'tag-name)))))
      (values 
       (with-output-to-string (*standard-output*)
         (centres (string-upcase title)
                  tag
                  (format nil "~a ~a" status type)
                  (format nil "~a ~a" 
                          createdby
                          (extract-date creationtime)))
         (minors ,@minors)
         (majors nil text)
         (attach attachments))
       (format nil "~a/" (substitute #\/ #\. tag))
       attachments))))

;;; Mail

;; When we get here we have the following tags to contend with:

;; $FILE         	(maybe multiple) attachments (to 42 messages)
;; HEADER        	almost always present (missing in ~400)
;; MAILCC        	always
;; MAILDATE      	always. the only field with time zones
;; MAILFROM      	always.
;; MAILSUBJECT   	should use this rather than title if present
;; MAILTO        	always.
;; MESSAGE_ID    	missing in so many (~50%) that not worth using
;; TAG           	always. add to header X-MMInfo-Tag: ...
;; TEXT          	absent once - leave blank
;; TITLE         	if no mailsubject (happens once). always present!

;; We get them in the following order:
;; 
;; tag header maildate mailfrom mailto mailcc mailsubject title message_id text $file 
;;
;; Some may be absent and $file may be there more than once (if at all)

;;  <tag>mail.agesen.1999-03-25.04-12</tag>
;;  <tag>mail.alexp.1996-06-05.11-51.1</tag>
;; mail/2001/10/04/17-44-00/
;; parse form the end! some persons have a dot in their names!


(def-simple-tag "mail" (tag header maildate mailfrom mailto mailcc mailsubject title message_id text $file)
  (let ((destination (let* ((last-dot (position #\. tag :from-end t))
                            (tag (if (> (- (length tag) last-dot) 3)
                                     tag
                                   (subseq tag 0 last-dot)))
                            (end-date (position #\. tag :from-end t))
                            (start-date (1+ (position #\. tag :end (1- end-date) :from-end t))))
                       (format nil "mail/~a/~a/"
                               (nsubstitute #\/ #\- (subseq tag start-date end-date))
                               (subseq tag (1+ end-date)))))
        (header (format nil "X-MMInfo-Tag: ~a~%~a"
                        tag
                        (or header 
                            (format nil "Date: ~a~%From: ~a~%To: ~a~%CC: ~a~%Subject: ~a~%~@[Message-ID: ~a~%~]"
                                    maildate mailfrom mailto mailcc (or mailsubject title) message_id))))) 
    (values (format nil "~a~2%~a" header text)
            destination
            (when $file
              ;; we know there was at least one attachment, but not that there was only one.
              (mapcar 'tag-contents (member '$file (tag-contents document) :key 'tag-name)))))
  (filename-destinations))

(defun filename-destinations ()
  (let ((destinations (make-hash-table :test 'equal)))
    (lambda (destination)
      (format nil "~d.txt"
              (incf (gethash destination destinations -1))))))


(def-simple-tag "doc" (tag title status type createdby creationtime text $file)
  (let ((attachments (when $file
                       ;; we know there was at least one attachment, but not that there was only one.
                       (mapcar 'tag-contents (member '$file (tag-contents document) :key 'tag-name)))))
    (values
     (with-output-to-string (*standard-output*)
       (centres (string-upcase title)
                tag
                (format nil "~a ~a" status type)
                (format nil "~a ~a" 
                       createdby
                       (extract-date creationtime)))
       (majors nil text)
       (attach attachments))
     (format nil "doc/~a/" (substitute #\/ #\. tag))
     attachments)))

(def-simple-tag bib 
    (tag title status createdby creationtime 
         authors publisher publicationdate identification url 
         abstract reviews $file)
  (let ((attachments (when $file
                       ;; we know there was at least one attachment, but not that there was only one.
                       (mapcar 'tag-contents (member '$file (tag-contents document) :key 'tag-name)))))
    (values 
     (with-output-to-string (*standard-output*)
       (centres (string-upcase title)
                authors
                (format nil "~@[~a, ~]~a" 
                        (when (plusp (length publisher)) publisher)
                        publicationdate)
                identification
                url
                ()
                tag
                status
                (format nil "~a ~a" 
                        createdby
                        (extract-date creationtime)))
       (majors "ABSTRACT" abstract
               "REVIEWS" reviews)
       (attach attachments))
     (format nil "bib/~a/" (substitute #\/ #\. tag))
     attachments)))

(def-simple-tag symbol (tag title status type createdby creationtime text internalnotes) 
  (values 
   (with-output-to-string (*standard-output*)
     (centres (string-upcase title)
              tag
              (format nil "~a ~a" status type)
              (format nil "~a ~a" 
                      createdby
                      (extract-date creationtime)))
     (majors nil text)
     (minors "INTERNAL NOTES" internalnotes))
   (format nil "~a/" (substitute #\/ #\. tag))))

(def-simple-tag issue (tag title status stage issuetype createdby creationtime
                           urgencyedit importanceedit occurances 
                           discoverer discoverytime discoveryprocess
                           location description rootcause suggestions processsuggestions
                           resolver resolutiontime resolutionprocess resolution
                           text)
  (values 
   (with-output-to-string (*standard-output*)
     (centres (string-upcase title)
              tag
              (format nil "~@[~a ~]~@[~a ~]~@[~a ~]" status stage issuetype)
              (format nil "~a ~a" 
                      createdby
                      (extract-date creationtime)))
     (minors "Urgency" urgencyedit
             "Importance" importanceedit
             "Occurances" occurances
             "Discoverer" discoverer
             "Discovery date" discoverytime
             "Discovery process" discoveryprocess
             "Locaction" location)
     (majors "DESCRIPTION" description
             "ROOT CAUSE" rootcause
             "SUGGESTIONS" suggestions
             "PROCESS SUGGESTIONS" processsuggestions)
     (minors "Resolver" resolver
             "Date resolved" resolutiontime
             "Resolution process" resolutionprocess
             "Resolution" resolution
             "Internal notes" text))
   (format nil "~a/" (substitute #\/ #\. tag))))

(def-simple-tag review (tag title status type creationtime createdby  
                            rules checklists source author leader editor scribe candidatestatus approved  
                            entry entrymanpower entrynotes  
                            checkers rate length actualcheckingtime issues  
                            kickoffstart kickoffend kickofflength kickoffnotes  
                            loggingstart loggingend logginglength loggingrate  
                            nmajor nminor numberofissues majordefectsremaining  
                            brainstormstart brainstormend brainstormlength brainstorm  
                            editmanpower editnotes  
                            exit exitmanpower exitnotes  
                            manpowerused manpowersaved
                            text)
  (values
   (with-output-to-string (*standard-output*)
     (centres (string-upcase title)
              tag
              (format nil "~a ~a" status type)
              (format nil "~a ~a" 
                      createdby
                      (extract-date creationtime)))
     (minors "Rules" rules
             "Checklists" checklists
             "Source" source
             "Candidate status" candidatestatus)
     (minors "Author" author
             "Leader" leader
             "Editor" editor
             "Scribe" scribe
             "Approved" approved)
     (minors "Entry" entry
             "Entry manpower" entrymanpower)
     (majors "Entry notes" entrynotes)
     (minors "Loggingstart" loggingstart
             "Loggingend" loggingend
             "Logginglength" logginglength
             "Loggingrate" loggingrate)
     (minors "Checkers" checkers
             "Rate" rate
             "Length" length
             "Actual checking time" actualcheckingtime)
     (minors "Kickoff start" kickoffstart
             "Kickoff end" kickoffend
             "Kickoff length" kickofflength)
     (minors "Kickoff notes" kickoffnotes)
     (majors "ISSUES" issues)    
     (minors "Brainstorm start" brainstormstart
             "Brainstorm end" brainstormend
             "Brainstorm length" brainstormlength)
     (majors "BRAINSTORM" brainstorm)
     (minors "Number of major issues" nmajor
             "Number of minor issues" nminor
             "Number of issues" numberofissues
             "Major defects remaining" majordefectsremaining)
     (minors "Edit manpower" editmanpower)
     (majors "Edit notes" editnotes)
     (minors "Exit" exit
             "Exit manpower" exitmanpower)
     (majors "Exit notes" exitnotes)
     (minors "Manpowerused" manpowerused
             "Manpowersaved" manpowersaved)
     (majors () text))
   (format nil "~a/" (substitute #\/ #\. tag))))

(def-simple-tag obj (title tag status stage type createdby creationtime responsible due products sources procedures report text $file)
  (let ((attachments (when $file
                       ;; we know there was at least one attachment, but not that there was only one.
                       (mapcar 'tag-contents (member '$file (tag-contents document) :key 'tag-name)))))
    (values 
     (with-output-to-string (*standard-output*)
       (centres (string-upcase title)
                tag
                (format nil "~@[~a ~]~@[~a ~]~@[~a ~]" status stage type)
                (format nil "~a ~a" 
                        createdby
                        (extract-date creationtime)))
       (minors "Responsible" responsible
               "Due" due
               "Products" products
               "Sources" sources
               "Procedures" procedures)
       (majors () text
               "REPORT" report)
       (attach attachments))
     (format nil "~a/" (substitute #\/ #\. tag))
     attachments)))

(def-simple-tag design (title tag status type createdby creationtime 
                              introduction overview requirements architecture analysis ideas implementation testing text $file)
  (let ((attachments (when $file
                       ;; we know there was at least one attachment, but not that there was only one.
                       (mapcar 'tag-contents (member '$file (tag-contents document) :key 'tag-name)))))
    (values
     (with-output-to-string (*standard-output*)
       (centres (string-upcase title)
                tag
                (format nil "~a ~a" status type)
                (format nil "~a ~a" 
                        createdby
                        (extract-date creationtime)))
       (majors "INTRODUCTION" introduction
               "OVERVIEW" overview
               "REQUIREMENTS" requirements
               "ARCHITECTURE" architecture
               "ANALYSIS" analysis
               "IDEAS" ideas
               "IMPLEMENTATION" implementation
               "TESTING" testing
               "TEXT" text)
       (attach attachments))
     (format nil "~a/" (substitute #\/ #\. tag))
     attachments)))

(def-very-simple-tag proc)

(def-simple-tag type (title tag status type createdby creationtime rules tagging purpose tagtemplate procedures content)
  (values 
   (with-output-to-string (*standard-output*)
     (centres (string-upcase title)
              tag
              (format nil "~a ~a" status type)
              (format nil "~a ~a" 
                      createdby
                      (extract-date creationtime)))
     (minors "Rules" rules)
     (minors "Tag template" tagtemplate)
     (majors "Tagging" tagging
             "Purpose" purpose
             "Content" content
             "Procedures" procedures))
   (format nil "~a/" (substitute #\/ #\. tag))))

(def-simple-tag infosys\\role (title tag status type createdby creationtime person description duties)
  (values 
   (with-output-to-string (*standard-output*)
     (centres (string-upcase title)
              tag
              (format nil "~a ~a" status type)
              (format nil "~a ~a" 
                      createdby
                      (extract-date creationtime)))
     (majors "Person " person 
             "Description" description
             "Duties))" duties))
   (format nil "~a/" (substitute #\/ #\. tag))))

(def-very-simple-tag person)

(def-very-simple-tag InfoSys\\Checklist 
                     "Scope" scope
                     "Summary" summary)

(def-very-simple-tag platform
                     "Pre-processor symbol" ppsymbol)

(def-very-simple-tag rule
                     "Scope" scope)

;; MainTopic are copies of mail message already in .../mail/...
;; The proof is that you can run this one and diff the files
(def-simple-tag maintopic ($additionalheaders datecomposed body)
  ;; "10/02/98 11:27:18"
  (let ((creationtime (if (plusp (length datecomposed))
                          datecomposed
                        (progn (cerror "Prompt for datestring."
                                       "~s has empty 'datecomposed' tag." document)
                          (env:prompt-for-string "Give new datestring in format shown."
                                                 :default "01/01/70 00:00:00")))))
    (multiple-value-bind (date time-pos)
      (extract-date creationtime)
      (let* ((time (nsubstitute #\- #\: 
                                (subseq creationtime time-pos 
                                        (position #\: creationtime :from-end t))))
             (faked-tag (format nil "~a.~a" date time))
             (destination (format nil "maintopic/~a/~a/" (substitute #\/ #\- date) time))
             (header (format nil "X-MMInfo-Tag: ~a~%X-MMInfo-Tag-Faked: Yes~%~a"
                             faked-tag $additionalheaders)))
        (values (format nil "~a~2%~a" header body)
                destination))))
  (filename-destinations))

(def-very-simple-tag builder
                     "Pre-processor symbol" ppsymbol)

(def-very-simple-tag os
                     "Pre-processor symbol" ppsymbol)

(def-very-simple-tag urgency 
                     "Adjective" adjective)

(def-very-simple-tag importance
                     "Adjective" adjective)

(def-very-simple-tag arch
                     "Pre-processor symbol" ppsymbol
                     "Align mod" alignmod
                     "Address width" addrwidth)

(def-very-simple-tag stage)

(def-very-simple-tag document)