common/scripts/aon.el

   1 ;;; aon.el --- utilities for implementing Project Aon errata
   2
   3 ;; Copyright (C) 2003, 2004, 2005 Thomas Wolmer & Project Aon
   4
   5 ;; Author: Thomas Wolmer <thomas@powerpuff.org>
   6 ;; Created: 17 Aug 2003
   7 ;; Version: 0.13
   8 ;; Keywords: aon
   9
  10 ;;; Commentary:
  11
  12 ;; This code provides support for implementing errata in the XML files
  13 ;; Project Aon uses as "single sources" for the books it publishes. For
  14 ;; more information on Project Aon, see http://www.projectaon.org/.
  15
  16 ;;; Change Log:
  17
  18 ;; 2003-08-17: 0.01: First nicely formatted version.
  19 ;; 2003-08-24: 0.02: Fixed bugs in aon-find-errata-entry and aon-fix-markup,
  20 ;;                   implemented aon-errata-jump and support functions.
  21 ;; 2003-08-31: 0.03: Added default section id and title, and modified
  22 ;;                   aon-get-sect-id and aon-get-sect-title, so that errata
  23 ;;                   in the blurb gets listed correctly. Fixed some major
  24 ;;                   problems in aon-errata-replace-all.
  25 ;; 2003-09-07: 0.04: Improved usability: aon-errata-replace[-all] presents
  26 ;;                   better prompt and a default text, and checks for "same"
  27 ;;                   and null replacements. aon-errata-add also checks null
  28 ;;                   input. All four user functions take an optional comment.
  29 ;; 2003-09-14: 0.05: Now saves all input to the interactive functions to avoid
  30 ;;                   losing them if the user changes the selection/point while
  31 ;;                   answering the interactive questions. Fixed bug in
  32 ;;                   aon-errata-add which asked you for a comment twice.
  33 ;;                   Extended aon-fix-markup.
  34 ;; 2003-10-12: 0.06: XEmacs does not put mouse-selected region in kill ring by
  35 ;;                   default and does not have match-string-no-properties.
  36 ;;                   Oops. Now things work in XEmacs, but regressions tests
  37 ;;                   with GNU Emacs should probably be done too.
  38 ;; 2003-10-31: 0.07: Used defconst to define some of the constants.
  39 ;; 2003-11-12: 0.08: Flesh out the aon-nonindexed-sects definition
  40 ;; 2004-05-09: 0.09: Fixed too greedy anchor tag regexp in aon-fix-markup &
  41 ;;                   added more 04wotw sections to aon-nonindexed-sects
  42 ;; 2005-02-05: 0.10: Added a function for inserting large illustrations
  43 ;; 2005-05-06: 0.11: Added a function for inserting inline illustrations
  44 ;; 2005-05-23: 0.12: Fixed bug in aon-re-get-errata-entry-id.
  45 ;; 2005-05-29: 0.13: Introduced full footnote support.
  46
  47 ;; A slight limitation: We can only handle one illustrator at a time.
  48
  49 (defvar aon-illustrator-name "Paul Bonner"
  50   "*")
  51 (defvar aon-large-illustration-width "386"
  52   "*")
  53
  54
  55 ;;; Code:
  56
  57 (defconst aon-nonindexed-sects
  58   (list
  59    ;; kai disciplines
  60    "camflage" "hunting" "sixthsns" "tracking" "healing" "wepnskll" "wepnskll"
  61    "mndblst" "anmlknsp" "mindomtr"
  62    ;; magnakai disciplines
  63    "wpnmstry" "anmlctrl" "curing" "invsblty" "hntmstry" "pthmnshp" "psisurge"
  64    "psiscrn" "nexus" "dvnation" "lcbonus"
  65    ;; magnakai improved disciplines
  66    "primate" "tutelary" "prncpln" "mentora" "scion" "archmstr"
  67    ;; grandmaster disciplines
  68    "mksumary" "wpnmstry" "anmlmstr" "deliver" "assimila" "hntmstry" "pthmnshp"
  69    "kaisurge" "kaiscrn" "nexus" "gnosis" "magi" "alchemy"
  70    ;; grandmaster improved disciplines
  71    "guardian" "sunkght" "sunlord" "sunthane"
  72    ;; gs lesser magicks
  73    "lessmcks" "sorcery" "enchant" "elementl" "alchemy" "prophecy" "psycmncy"
  74    "evcation" "staff"
  75    ;; gs higher magicks
  76    "highmcks" "thamtrgy" "telergy" "physirgy" "theurgy" "visionry" "necrmncy"
  77    ;; general
  78    "toc" "credits" "howcarry" "howmuch" "howuse" "evasion" "smevazn" "errintro"
  79    "errerr" "primill" "secill")
  80   "These sections are ignored for errata entries; the enclosing section is
  81 used instead (unless it is also 'nonindexed').")
  82
  83 (defconst aon-default-sect-id "title"
  84   "The default section to assign an erratum to if none is found.")
  85 (defconst aon-default-sect-title "Title Page"
  86   "The title of the 'default section' (see `aon-default-sect-id').")
  87
  88 ;; Commonly used search regexps
  89 (defconst aon-re-errerr-sect "<section.*id=\"errerr\".*>"
  90   "Regexp used to locate the start of the errata entry list.")
  91 (defconst aon-re-get-sect-id "<section.*id=\"\\(.+?\\)\".*>"
  92   "Regexp used to find the id of asection.")
  93 (defconst aon-re-get-errata-entry-id "<p>(<a idref=\"\\(.+?\\)\".*>)"
  94   "Regexp used to find the id of an errata list entry.") ; and footnotes too!
  95 (defconst aon-re-get-title "<title>\\(.+?\\)</title>"
  96   "Regexp used to find the title of a section.")
  97 (defconst aon-re-get-footnote-num
  98   "<footnote id=\".+?\" idref=\".+?-\\([0-9]+\\)\">"
  99   "Regexp used to locate the sequence number of a footnote.")
 100
 101 ;; The errata item texts (as templates to be fed to 'format')
 102 ;; These are only (hardcoded) reader-visible texts inserted by this hack!
 103 ;; TODO: rename these variabled. defconst?
 104 (setq replaceditemtext " Replaced <quote>%s</quote> with <quote>%s</quote>%s.")
 105 (setq addeditemtext " Added <quote>%s</quote>%s.")
 106 (setq deleteditemtext " Deleted <quote>%s</quote>%s.")
 107 (setq replacedallitemtext (concat " Replaced all occurrences of <quote>%s"
 108                                   "</quote> with <quote>%s</quote>%s."))
 109
 110 ;; TODO: an optional second argument should be where the search starts,
 111 ;; instead of at the beginning of the file
 112 (defun aon-get-sect-pos (sect)
 113   "Returns the start position of the named section.
 114 Useful for comparing the order of sections."
 115   (save-excursion
 116     (goto-char (point-min))
 117     (re-search-forward (format "<section.*id=\"%s\".*>" sect) nil t)
 118     (match-beginning 0)))
 119
 120 ;; TODO: rewrite this property fetching stuff, it is way too inefficient
 121
 122 (defun aon-get-sect-property (regexp)
 123   "Returns a property, as selected by regexp, of the current indexed section."
 124   (save-excursion
 125     ;; if we're in an ignored section, go to its beginning and repeat search
 126     (if (member (aon-get-unchecked-sect-id) aon-nonindexed-sects)
 127         (progn
 128           (search-backward "<section" nil t)
 129           (aon-get-sect-property regexp))
 130       (aon-get-unchecked-sect-property regexp))))
 131
 132 (defun aon-get-unchecked-sect-property (regexp)
 133   "Returns a property, as selected by regexp, of the current section.
 134 Unlike aon-get-sect-property, it does not checked if it is indexed."
 135   (save-excursion
 136     (and (re-search-backward regexp nil t)
 137          ;;(match-string-no-properties 1)))) ; Doesn't work in XEmacs
 138          (match-string 1))))
 139
 140 (defun aon-get-unchecked-sect-id ()
 141   "Returns the id of the current section.
 142 Unlike aon-get-sect-id, it does not check if it is indexed."
 143   (or (aon-get-unchecked-sect-property aon-re-get-sect-id)
 144       aon-default-sect-id)) ; workaround for the blurb and such
 145
 146 (defun aon-get-sect-id ()
 147   "Returns the id of the current indexed section."
 148   (or (aon-get-sect-property aon-re-get-sect-id)
 149       aon-default-sect-id)) ; workaround for the blurb and such
 150
 151 (defun aon-get-sect-title ()
 152   "Returns the title of the current indexed section."
 153   (if (string= (aon-get-sect-id) "title")
 154       aon-default-sect-title ; workaround for the blurb and such
 155     (aon-get-sect-property aon-re-get-title)))
 156
 157 (defun aon-find-errata-entry ()
 158   "Finds the insertion position in the errata entry for the current section.
 159 If no errata entry exists, returns nil."
 160   (save-excursion
 161     (let ((id (aon-get-sect-id)))
 162       (re-search-forward aon-re-errerr-sect)
 163       ;; locate the end of the errata list so that we don't search too far and
 164       ;; start finding footnotes instead
 165       (when (search-forward (format "<p>(<a idref=\"%s\">" id)
 166                             (save-excursion (search-forward "</section>"))
 167                             t)
 168         (search-forward "</p>") ; place position last in entry
 169         (match-beginning 0)))))
 170
 171 (defun aon-create-errata-entry ()
 172   "Creates an errata entry for the current section.
 173 Returns the errata item insertion point in the new entry."
 174   (interactive) ;; for testing only
 175   (setq newerrataentry (format "<p>(<a idref=\"%s\">%s</a>)</p>\n"
 176                                (aon-get-sect-id) (aon-get-sect-title)))
 177   (save-excursion
 178     (aon-goto-new-errata-list-entry-pos (point))
 179     (insert newerrataentry)
 180     (search-backward "</p>")
 181     (indent-according-to-mode)
 182     (point))) ; goto insertion point and make it be returned
 183
 184 ;; This function is HORRIBLY slow due to the calls to aon-get-sect-pos
 185 (defun aon-goto-new-errata-list-entry-pos (sectpos)
 186   "Places the point at the position where a new errata entry shall be created."
 187   (re-search-forward aon-re-errerr-sect)
 188   (search-forward "<data>")
 189   (setq endoferrata (save-excursion
 190                       (if (search-forward "</data>")
 191                           (point)
 192                         (error "Could not find the end of the errata list!"))))
 193   (while (let ((id (save-excursion
 194                      (if (re-search-forward aon-re-get-errata-entry-id
 195                                             endoferrata
 196                                             t)
 197                          ;;(match-string-no-properties 1) ; Boohoo XEmacs
 198                          (match-string 1)
 199                        "footnotz" ; hack warning! to avoid getting too far
 200                        ))))
 201            (unless (setq thissectpos (aon-get-sect-pos id))
 202              (error "Section %s has an errata entry but does not exist!" id))
 203            (< thissectpos sectpos))
 204     (forward-line 1)))
 205
 206 ;; TODO: Figure out some way not to create an errata entry before we know that
 207 ;; it will work OK. As it is now, an empty errata entry may be left behind
 208 ;; if an error occurs. But maybe that's not a problem??
 209 (defun aon-insert-errata-entry (errataentry id)
 210   "Adds an errata item to the current indexed section's errata entry.
 211 An errata entry is created if it does not exist."
 212   (save-excursion
 213     (goto-char (or (aon-find-errata-entry) ; if it is not found...
 214                    (aon-create-errata-entry))) ; ...create the entry
 215     (insert (aon-format-errata-item id errataentry))))
 216
 217 (defun aon-format-errata-item (id errataentry)
 218   ""
 219   (format "<!--%s-ITEM-->%s<!--/%s-ITEM-->" id errataentry id))
 220
 221 (defun aon-format-erratum (id newtext)
 222   ""
 223   (format "<!--%s-->%s<!--/%s-->" id newtext id))
 224
 225 (defun aon-format-erratum-empty (id)
 226   ""
 227   (format "<!--%s/-->" id))
 228
 229 (defun aon-errata-replace (beg end newtext oldtext &optional comment)
 230   "Replaces the current region and records the replacement."
 231   (interactive
 232    ;; save all positions and string as the user may change the selection!
 233    (let* ((xbeg (region-beginning))
 234           (xend (region-end))
 235           ;;(xoldtext (car kill-ring-yank-pointer)) ; Boohoo Xemacs
 236           (xoldtext (buffer-substring-no-properties xbeg xend))
 237           (xnewtext (read-string (format "Replace '%s' with: " xoldtext)
 238                                  xoldtext))
 239           (cmnt (read-string "Additional comment (optional): ")))
 240      (list xbeg xend xnewtext xoldtext cmnt)))
 241   (cond ((string= newtext "")
 242          (error "No replacement! To delete text, use 'aon-errata-delete'."))
 243         ((string= newtext oldtext)
 244          (error "The replacement is the same as the original!")))
 245   (let* ((id (aon-get-new-errata-id "RE"))
 246          (errataentry (format replaceditemtext
 247                               (aon-fix-markup oldtext)
 248                               (aon-fix-markup newtext)
 249                               comment)))
 250     (kill-region beg end)
 251     (insert (aon-format-erratum id newtext))
 252     (aon-insert-errata-entry errataentry id)))
 253
 254 (defun aon-errata-delete (beg end oldtext &optional comment)
 255   "Deletes the current region and records the deletion."
 256   (interactive
 257    ;; save all positions and string as the user may change the selection!
 258    (let* ((xbeg (region-beginning))
 259           (xend (region-end))
 260           ;;(xoldtext (car kill-ring-yank-pointer)) ; Boohoo Xemacs
 261           (xoldtext (buffer-substring-no-properties xbeg xend))
 262           (cmnt (read-string "Additional comment (optional): ")))
 263      (list xbeg xend xoldtext cmnt)))
 264   (let* ((id (aon-get-new-errata-id "DE"))
 265          (errataentry (format deleteditemtext
 266                               (aon-fix-markup oldtext)
 267                               comment)))
 268     (kill-region beg end)
 269     (insert (aon-format-erratum-empty id))
 270     (aon-insert-errata-entry errataentry id)))
 271
 272 (defun aon-errata-add (pos newtext &optional comment)
 273   "Adds text in the current position and records the addition."
 274   (interactive
 275    (let ((xpos (point))
 276          (string (read-string "Insert text: "))
 277          (cmnt (read-string "Additional comment (optional): ")))
 278      (list xpos string cmnt)))
 279   (if (string= newtext "")
 280       (error "No text to add!"))
 281   (let* ((id (aon-get-new-errata-id "AD"))
 282          (errataentry (format addeditemtext
 283                               (aon-fix-markup newtext)
 284                               comment)))
 285     (insert (aon-format-erratum id newtext))
 286     (aon-insert-errata-entry errataentry id)))
 287
 288 (defun aon-errata-replace-all (beg end newtext oldtext &optional comment)
 289   "Replaces all occurrences of the current region and records the replacements.
 290 Stretches all over one indexed section, so it might affect text before the
 291 selected region as well! It is NOT very intelligent about abstaining from
 292 replacing text in markup that should not be touch, so don't even think about
 293 replacing, say, 'class'."
 294   (interactive
 295    ;; save all positions and string as the user may change the selection!
 296    (let* ((xbeg (region-beginning))
 297           (xend (region-end))
 298           ;;(xoldtext (car kill-ring-yank-pointer)) ; Boohoo Xemacs
 299           (xoldtext (buffer-substring-no-properties xbeg xend))
 300           (xnewtext (read-string (format
 301                                   "Replace all occurrences of '%s' with: "
 302                                   xoldtext)
 303                                  xoldtext))
 304           (cmnt (read-string "Additional comment (optional): ")))
 305      (list xbeg xend xnewtext xoldtext cmnt)))
 306   (if (string= newtext oldtext)
 307       (error "The replacement text is the same as the original!"))
 308   (let* ((id (aon-get-new-errata-id "RA"))
 309          (errataentry (format replacedallitemtext
 310                               (aon-fix-markup oldtext)
 311                               (aon-fix-markup newtext)
 312                               comment))
 313          (saved-case-fold-search case-fold-search))
 314     (save-excursion
 315       (aon-goto-sect-start)
 316       (forward-line 1) ; workaround to avoid matching this section start
 317       (setq sectend (aon-get-sect-end))
 318       (setq case-fold-search nil) ; No case folded false matches thank you
 319       (while (re-search-forward (format "[^\"]\\\(%s\\\)[^\"]" oldtext) sectend t)
 320         (replace-match (aon-format-erratum id newtext) t t nil 1))
 321       (setq case-fold-search saved-case-fold-search)) ; Reset case folding
 322     (aon-insert-errata-entry errataentry id)))
 323
 324 ;; SLOW!!! And doesn't need to be recursive. Rewrite.
 325 (defun aon-goto-sect-start ()
 326   "Places the point at the start of the current indexed section."
 327   (interactive) ; for test purposes
 328   (if (member (aon-get-unchecked-sect-id) aon-nonindexed-sects)
 329         (progn
 330           (search-backward "<section" nil t)
 331           (aon-goto-sect-start))
 332     (search-backward "<section" nil t)))
 333
 334 (defun aon-get-sect-end ()
 335   "Returns the end position of this section."
 336   (let ((nextopensect (save-excursion
 337                         (search-forward "<section")))
 338         (nextclosesect (save-excursion
 339                          (search-forward "</section>"))))
 340     (if (< nextclosesect nextopensect)
 341         nextclosesect ; return the end of this section
 342       (save-excursion
 343         (goto-char nextopensect) ; place inside nested section
 344         (goto-char (aon-get-sect-end)) ; goto end of that section
 345         (aon-get-sect-end))))) ; continue search for this section's end
 346
 347 (defun aon-get-new-errata-id (type)
 348   "Returns a new unique errata item id."
 349   (let ((id (format "ERRTAG-%s-%s" type (point))))
 350     (save-excursion
 351       (while (search-forward (format "%s-" id) nil t)
 352         (setq id (format "%s1" id)))) ; append '1' and try again
 353     id))
 354
 355 (defun aon-fix-markup (string)
 356   "Converts some markup in text from section to fit in an errata item."
 357   ;; Quotes - assume it is single quotes, double must be handled manually
 358   (while (string-match "<quote>" string)
 359     (setq string (replace-match "<ch.lsquot/>" nil nil string)))
 360   (while (string-match "</quote>" string)
 361     (setq string (replace-match "<ch.rsquot/>" nil nil string)))
 362   ;; TODO: Except for tags that shall become entities, maybe the rest can be
 363   ;; handled by a general transformation?
 364   ;; Link texts
 365   (while (string-match "<link-text>" string)
 366     (setq string (replace-match "<!--link-text-->" nil nil string)))
 367   (while (string-match "</link-text>" string)
 368     (setq string (replace-match "<!--/link-text-->" nil nil string)))
 369   ;; idrefs and similar
 370   ;; TODO: a complete idref does not need to be replaced!
 371   (while (string-match "<\\(a .*?\\)>" string)
 372     (setq string (replace-match (format "<!--%s-->" (match-string 1 string))
 373                                 nil nil string)))
 374   (while (string-match "</a>" string)
 375     (setq string (replace-match "<!--/a-->" nil nil string)))  string)
 376
 377 ;; (defun aon-refix-markup (string)
 378 ;;   "Converts some 'fixed' markup in an errata item text to fit in a section.
 379 ;; To be used when an erratum is undone and the replaced or deleted text from
 380 ;; an errata item shall be re-inserted in the section."
 381 ;;   (while (or (string-match "&lsquot;" string)
 382 ;;              (string-match "&ldquot;" string))
 383 ;;     (setq string (replace-match "<quote>" nil nil string)))
 384 ;;   (while (or (string-match "&rsquot;" string)
 385 ;;              (string-match "&rdquot;" string))
 386 ;;     (setq string (replace-match "</quote>" nil nil string)))
 387 ;;   string)
 388
 389 (defun aon-locate-errata-item-start ()
 390   "Return the starting position of the errata block the point is in.
 391 Currently, the point may not be within a comment start or end tag.
 392 Returns an error message if the point is not within an errata tag or if
 393 the errata structure is corrupt."
 394   (save-excursion
 395     (let ((prevcommentend (save-excursion (search-backward "-->" nil t)))
 396           (prevcommentstart (save-excursion (search-backward "<!--" nil t)))
 397           (nextcommentend (save-excursion (search-forward "-->" nil t))))
 398       (unless (and prevcommentstart nextcommentend)
 399         (error "Point is not within an errata item!"))
 400       (goto-char prevcommentstart)
 401       (cond
 402        ;; if we are at the start of an opening tag, it is OK
 403        ((looking-at "<!--ERRTAG-..-[0-9]+\\(-ITEM\\)?-->")
 404         (point))
 405        ;; if we are at the start of a content-free tag, we must check that
 406        ;; we were not outside that tag when we started.
 407        ((looking-at "<!--ERRTAG-..-[0-9]+/-->")
 408         (if (> prevcommentend prevcommentstart)
 409             (error "Point is not within an errata item!")
 410           (point)))
 411        ;; if we are at the start of a closing tag, we must check that we were
 412        ;; not outside that tag when we started, and then find the opening tag
 413        ((looking-at "<!--/\\(ERRTAG-..-[0-9]+\\(-ITEM\\)?\\)-->")
 414         (if (> prevcommentend prevcommentstart)
 415             (error "Point is not within an errata item!")
 416           (search-backward (format "<!--%s-->" (match-string 1)))))
 417        ;; if the comment was not an errata tag
 418        (t (error "Point is not within an errata item!"))))))
 419
 420 (defun aon-errata-jump ()
 421   "If the point is within tags, jump to the corresponding erratum/errata item.
 422 In the case of a \"replace all\" erratum, jumps to the first location."
 423   (interactive)
 424   (let ((pos
 425          (save-excursion
 426            (goto-char (aon-locate-errata-item-start)) ; inefficient!
 427            (cond ((looking-at "<!--\\(ERRTAG-..-[0-9]+\\)-ITEM-->")
 428                   (goto-char (point-min))
 429                   (re-search-forward (format "<!--%s/?-->" (match-string 1)))
 430                   (match-beginning 0))
 431                  ((looking-at "<!--\\(ERRTAG-..-[0-9]+\\)/?-->")
 432                   (goto-char (point-min))
 433                   (search-forward (format "<!--%s-ITEM-->" (match-string 1)))
 434                   (match-beginning 0))
 435                  (t (error "This code can not be reached!"))))))
 436     (if pos (goto-char pos)
 437       (error "This code can not be reached!")))) ; should have received error
 438
 439 ;; TODO: Make the illustration functions add entries in the illustrations list
 440
 441 (defun aon-illustration-large (number height caption)
 442   "Adds a large illustration at the insertion point.
 443 The illustrations list is not updated (TBD)."
 444   (interactive
 445    (let ((xnum (read-string "Illustration number: "))
 446          (xheight (read-string "Pixel height: "))
 447          (xcaption (read-string "Caption: ")))
 448      (list xnum xheight xcaption)))
 449   (let ((startpos (point))
 450         (endpos (save-excursion
 451                   (insert (format "<illustration class=\"float\">\n<meta>\n<creator>%s</creator>\n<description>%s</description>\n</meta>\n<instance class=\"html\" src=\"ill%s.gif\" width=\"%s\" height=\"%s\"/>\n<instance class=\"pdf\" src=\"ill%s.pdf\" width=\"%s\" height=\"%s\"/>\n</illustration>"
 452                                   aon-illustrator-name caption number
 453                                   aon-large-illustration-width height number
 454                                   aon-large-illustration-width height))
 455                   (point))))
 456     (aon-indent-block startpos endpos)))
 457
 458 (defun aon-illustration-inline (filename height)
 459   "Adds an inline illustration at the insertion point.
 460 The illustrations list is not updated (TBD)."
 461   (interactive
 462    (let ((xfilename (read-string "File name: "))
 463          (xheight (read-string "Pixel height: ")))
 464      (list xfilename xheight)))
 465   (let ((startpos (point))
 466         (endpos (save-excursion
 467                   (insert (format "<illustration class=\"inline\">\n<meta>\n<creator>%s</creator>\n</meta>\n<instance class=\"html\" src=\"%s.gif\" width=\"%s\" height=\"%s\" mime-type=\"image/gif\" />\n</illustration>"
 468                                   aon-illustrator-name filename
 469                                   aon-large-illustration-width height))
 470                   (point))))
 471     (aon-indent-block startpos endpos)))
 472
 473 ;; TODO: Create a method that takes a function which adds text, and then
 474 ;; indents the added text. Now each caller of this function must add some
 475 ;; codes to handle start and end positions.
 476
 477 (defun aon-indent-block (startpos endpos)
 478   "Indents the text between startpos and endpos.
 479 The positions need not be start or end of lines. Leaves point at end of block."
 480   (dotimes (i (count-lines startpos endpos))
 481     (indent-according-to-mode)
 482     (forward-line 1)))
 483
 484 ;; TODO: Clean up the whole footnote code, it is a mess.
 485
 486 (defun aon-footnote-add (pos text)
 487   "Adds a footnote at the current position.
 488 Note that the footnote text must contain all <p>aragraph tags, and that line
 489 breaks are not allowed."
 490   (interactive
 491    (let ((xpos (point))
 492          (xtext (read-string "Footnote text: ")))
 493      (list xpos xtext)))
 494   (if (string= text "")
 495       (error "No footnote text!"))
 496   (let ((tpos (string-match "<p>" text)))
 497     (unless (and tpos (= 0 tpos))
 498       (error "Footnotes must contain <p>aragraph start and end tags!")))
 499   (save-excursion
 500     (let*
 501         ((sectid (aon-get-sect-id))
 502          (fblockstart (aon-find-footnote-block sectid))
 503          (fnum (if fblockstart
 504                     (aon-get-next-footnote-num fblockstart)
 505                  1))
 506          (fid (format "%s-%s" sectid fnum))
 507          (fentry
 508           (format "\n<footnote id=\"%s-foot\" idref=\"%s\">%s</footnote>"
 509                   fid fid text))
 510          (fref
 511           (format "<a id=\"%s\" idref=\"%s-foot\" class=\"footnote\" />"
 512                   fid fid))
 513          (fnth (1+ (aon-count-previous-footnotes sectid)))
 514          (flistref
 515           (format "(<a idref=\"%s\">%s</a>)" sectid (aon-get-sect-title)))
 516          (flistinsertpos
 517           (aon-find-footnote-list-insert-pos sectid flistref fnth)))
 518       ;; First insert errata list entry
 519       (goto-char flistinsertpos)
 520       (let ((startpos (point))
 521             (endpos (save-excursion
 522                       (insert "\n" text)
 523                       (point))))
 524         (aon-indent-block startpos endpos))
 525       (goto-char flistinsertpos)
 526       (search-forward "<p>") ; no line-end-position in xemacs
 527       (insert flistref " ")
 528       ;; Then errata ref
 529       (goto-char pos)
 530       (insert fref)
 531       ;; And last errata entry in section errata block (which may be created)
 532       (if fblockstart
 533           (progn ; block exists, go to the right position in it
 534             (goto-char fblockstart)
 535             (dotimes (i (1- fnth))
 536               (search-forward "</footnote>"
 537                               (save-excursion
 538                                 (goto-char fblockstart)
 539                                 (search-forward "</footnotes>")))))
 540         (goto-char (aon-create-footnote-block sectid)))
 541       (let ((startpos (point))
 542             (endpos (save-excursion
 543                       (insert fentry)
 544                       (point))))
 545         (aon-indent-block startpos endpos)))))
 546
 547 (defun aon-create-footnote-block (sect)
 548   "Creates a footnote block and returns insertion point."
 549   (save-excursion
 550     (goto-char (aon-get-sect-pos sect))
 551     (search-forward "</meta>")
 552     (save-excursion
 553       (let ((spos (point))
 554             (endpos (save-excursion
 555                       (insert "\n\n<footnotes>\n</footnotes>")
 556                       (point))))
 557         (aon-indent-block spos endpos)))
 558     (search-forward "<footnotes>")))
 559
 560 (defun aon-find-footnote-block (sect)
 561   "Returns the start of the footnote block of the current section, or nil."
 562   (save-excursion
 563     (goto-char (aon-get-sect-pos sect))
 564     (search-forward "</meta>")
 565     (let*
 566         ((datastart (save-excursion
 567                       (search-forward "<data>")))
 568          (footstart (save-excursion
 569                       (search-forward "<footnotes>" datastart t))))
 570       footstart)))
 571
 572 (defun aon-get-footnote-num (pos)
 573   "Return the numerical sequence number of the footnote on the current line.
 574 If there are no more footnotes defined here, it returns nil."
 575   (interactive "p")
 576   (let ((fend (save-excursion
 577                 (search-forward "</footnotes>"))))
 578     (save-excursion
 579       (and
 580        (re-search-forward aon-re-get-footnote-num fend t)
 581        (string-to-number (match-string 1))))))
 582
 583 (defun aon-get-next-footnote-num (pos)
 584   "Returns the next footnote id number.
 585 This will always be the previously highest number plus one."
 586   (let ((seq '()))
 587     (save-excursion
 588       (goto-char pos)
 589       (while (setq x (aon-get-footnote-num (point)))
 590         (setq seq (cons x seq))
 591         (search-forward "</footnote>")
 592         (forward-line 1)))
 593     (if seq
 594         (1+ (car (sort seq '>))) ; prior highest + 1
 595       1))) ; the first
 596
 597 (defun aon-count-previous-footnotes (sect)
 598   "Based on the current position, counts the number of footnotes before..."
 599   (save-excursion
 600     (let ((sectstart (aon-get-sect-pos sect))
 601           (count 0))
 602       (while (re-search-backward
 603               "<a.+?idref=\".+?-foot\".+?class=\"footnote\".*?/>" sectstart t)
 604         (setq count (1+ count)))
 605       count)))
 606
 607 (defun aon-find-footnote-list-insert-pos (sect ref nth)
 608   ""
 609   (save-excursion
 610     (let ((flistsectpos (aon-get-sect-pos "footnotz")))
 611       (if (= nth 1)
 612           (aon-find-new-footnote-list-entry-pos (aon-get-sect-pos sect))
 613         (progn
 614           (goto-char flistsectpos)
 615           (dotimes (i (1- nth))
 616             (search-forward ref))
 617           (end-of-line)
 618           (point))))))
 619
 620 ;; TODO: This code is mostly copied from the errata code. Merge them?
 621
 622 (defun aon-find-new-footnote-list-entry-pos (sectpos)
 623   "Return the position where a new footnote list entry shall be created."
 624   (save-excursion
 625     (goto-char (aon-get-sect-pos "footnotz"))
 626     (search-forward "<data>")
 627     (forward-line 1) ; pos is now on the line of the first <p> (if it exists)
 628     (let ((endofflist
 629            (save-excursion
 630              (if (search-forward "</data>")
 631                  (point)
 632                (error "Could not find the end of the footnotes list!")))))
 633       (while (let ((id (save-excursion
 634                          (if (re-search-forward aon-re-get-errata-entry-id
 635                                                 endofflist
 636                                                 t)
 637                              (match-string 1)
 638                            "illstrat" ; hack warning! to avoid getting too far
 639                            ))))
 640                (unless (setq thissectpos (aon-get-sect-pos id))
 641                  (error
 642                   "Section %s has a footnote list entry, but does not exist!"
 643                   id))
 644                (< thissectpos sectpos))
 645         (forward-line 1)))
 646     (forward-line -1)
 647     (end-of-line)
 648     (point)))
 649
 650 (global-set-key "\C-cr" 'aon-errata-replace)
 651 (global-set-key "\C-cd" 'aon-errata-delete)
 652 (global-set-key "\C-ca" 'aon-errata-add)
 653 (global-set-key "\C-cR" 'aon-errata-replace-all)
 654 (global-set-key "\C-cj" 'aon-errata-jump)
 655 ;;(global-set-key "\C-cu" 'aon-errata-revert)
 656
 657 (global-set-key "\C-cl" 'aon-illustration-large)
 658 (global-set-key "\C-ci" 'aon-illustration-inline)
 659
 660 (global-set-key "\C-cf" 'aon-footnote-add)
 661
 662 ;; Errata examples
 663 ;; <!--ERRTAG-RE-123--> <!--/ERRTAG-RE-123-->
 664 ;; <!--ERRTAG-DE-456/-->
 665 ;; Errata item
 666 ;; <!--ERRTAG-RE-123-ITEM--> <!--/ERRTAG-RE-123-ITEM-->
 667 ;; RE - replace
 668 ;; DE - delete
 669 ;; AD - add
 670 ;; RA - replace all
 671
 672 ;;; aon.el ends here