;;; aon.el --- utilities for implementing Project Aon errata ;; Copyright (C) 2003, 2004, 2005 Thomas Wolmer & Project Aon ;; Author: Thomas Wolmer ;; Created: 17 Aug 2003 ;; Version: 0.12 ;; Keywords: aon ;;; Commentary: ;; This code provides support for implementing errata in the XML files ;; Project Aon uses as "single sources" for the books it publishes. For ;; more information on Project Aon, see http://www.projectaon.org/. ;;; Change Log: ;; 2003-08-17: 0.01: First nicely formatted version. ;; 2003-08-24: 0.02: Fixed bugs in aon-find-errata-entry and aon-fix-markup, ;; implemented aon-errata-jump and support functions. ;; 2003-08-31: 0.03: Added default section id and title, and modified ;; aon-get-sect-id and aon-get-sect-title, so that errata ;; in the blurb gets listed correctly. Fixed some major ;; problems in aon-errata-replace-all. ;; 2003-09-07: 0.04: Improved usability: aon-errata-replace[-all] presents ;; better prompt and a default text, and checks for "same" ;; and null replacements. aon-errata-add also checks null ;; input. All four user functions take an optional comment. ;; 2003-09-14: 0.05: Now saves all input to the interactive functions to avoid ;; losing them if the user changes the selection/point while ;; answering the interactive questions. Fixed bug in ;; aon-errata-add which asked you for a comment twice. ;; Extended aon-fix-markup. ;; 2003-10-12: 0.06: XEmacs does not put mouse-selected region in kill ring by ;; default and does not have match-string-no-properties. ;; Oops. Now things work in XEmacs, but regressions tests ;; with GNU Emacs should probably be done too. ;; 2003-10-31: 0.07: Used defconst to define some of the constants. ;; 2003-11-12: 0.08: Flesh out the aon-nonindexed-sects definition ;; 2004-05-09: 0.09: Fixed too greedy anchor tag regexp in aon-fix-markup & ;; added more 04wotw sections to aon-nonindexed-sects ;; 2005-02-05: 0.10: Added a function for inserting large illustrations ;; 2005-05-06: 0.11: Added a function for inserting inline illustrations ;; 2005-05-23: 0.12: Fixed bug in aon-re-get-errata-entry-id. ;; A slight limitation: We can only handle one illustrator at a time. (defvar aon-illustrator-name "Paul Bonner" "*") (defvar aon-large-illustration-width "386" "*") ;;; Code: (defconst aon-nonindexed-sects (list ;; kai disciplines "camflage" "hunting" "sixthsns" "tracking" "healing" "wepnskll" "wepnskll" "mndblst" "anmlknsp" "mindomtr" ;; magnakai disciplines "wpnmstry" "anmlctrl" "curing" "invsblty" "hntmstry" "pthmnshp" "psisurge" "psiscrn" "nexus" "dvnation" "lcbonus" ;; magnakai improved disciplines "primate" "tutelary" "prncpln" "mentora" "scion" "archmstr" ;; grandmaster disciplines "mksumary" "wpnmstry" "anmlmstr" "deliver" "assimila" "hntmstry" "pthmnshp" "kaisurge" "kaiscrn" "nexus" "gnosis" "magi" "alchemy" ;; grandmaster improved disciplines "guardian" "sunkght" ;; gs lesser magicks "lessmcks" "sorcery" "enchant" "elementl" "alchemy" "prophecy" "psycmncy" "evcation" "staff" ;; gs higher magicks "highmcks" "thamtrgy" "telergy" "physirgy" "theurgy" "visionry" "necrmncy" ;; general "toc" "credits" "howcarry" "howmuch" "howuse" "evasion" "smevazn" "errintro" "errerr" "primill" "secill") "These sections are ignored for errata entries; the enclosing section is used instead (unless it is also 'nonindexed').") (defconst aon-default-sect-id "title" "The default section to assign an erratum to if none is found.") (defconst aon-default-sect-title "Title Page" "The title of the 'default section' (see `aon-default-sect-id').") ;; Commonly used search regexps (defconst aon-re-errerr-sect "" "Regexp used to locate the start of the errata entry list.") (defconst aon-re-get-sect-id "" "Regexp used to find the id of asection.") (defconst aon-re-get-errata-entry-id "

()" "Regexp used to find the id of an errata list entry.") (defconst aon-re-get-title "\\(.+?\\)" "Regexp used to find the title of a section.") ;; The errata item texts (as templates to be fed to 'format') ;; These are only (hardcoded) reader-visible texts inserted by this hack! ;; TODO: rename these variabled. defconst? (setq replaceditemtext " Replaced %s with %s%s.") (setq addeditemtext " Added %s%s.") (setq deleteditemtext " Deleted %s%s.") (setq replacedallitemtext (concat " Replaced all occurrences of %s" " with %s%s.")) ;; TODO: an optional second argument should be where the search starts, ;; instead of at the beginning of the file (defun aon-get-sect-pos (sect) "Returns the start position of the named section. Useful for comparing the order of sections." (save-excursion (goto-char (point-min)) (re-search-forward (format "" sect) nil t) (match-beginning 0))) ;; TODO: rewrite this property fetching stuff, it is way too inefficient (defun aon-get-sect-property (regexp) "Returns a property, as selected by regexp, of the current indexed section." (save-excursion ;; if we're in an ignored section, go to its beginning and repeat search (if (member (aon-get-unchecked-sect-id) aon-nonindexed-sects) (progn (search-backward "(" id) (save-excursion (search-forward "")) t) (search-forward "

") ; place position last in entry (match-beginning 0))))) (defun aon-create-errata-entry () "Creates an errata entry for the current section. Returns the errata item insertion point in the new entry." (interactive) ;; for testing only (setq newerrataentry (format "

(%s)

\n" (aon-get-sect-id) (aon-get-sect-title))) (save-excursion (aon-goto-new-errata-list-entry-pos (point)) (insert newerrataentry) (search-backward "

") (indent-according-to-mode) (point))) ; goto insertion point and make it be returned ;; This function is HORRIBLY slow due to the calls to aon-get-sect-pos (defun aon-goto-new-errata-list-entry-pos (sectpos) "Places the point at the position where a new errata entry shall be created." (re-search-forward aon-re-errerr-sect) (search-forward "") (setq endoferrata (save-excursion (if (search-forward "") (point) (error "Could not find the end of the errata list!")))) (while (let ((id (save-excursion (if (re-search-forward aon-re-get-errata-entry-id endoferrata t) ;;(match-string-no-properties 1) ; Boohoo XEmacs (match-string 1) "footnotz" ; hack warning! to avoid getting too far )))) (unless (setq thissectpos (aon-get-sect-pos id)) (error "Section %s has an errata entry but does not exist!" id)) (< thissectpos sectpos)) (forward-line 1))) ;; TODO: Figure out some way not to create an errata entry before we know that ;; it will work OK. As it is now, an empty errata entry may be left behind ;; if an error occurs. But maybe that's not a problem?? (defun aon-insert-errata-entry (errataentry id) "Adds an errata item to the current indexed section's errata entry. An errata entry is created if it does not exist." (save-excursion (goto-char (or (aon-find-errata-entry) ; if it is not found... (aon-create-errata-entry))) ; ...create the entry (insert (aon-format-errata-item id errataentry)))) (defun aon-format-errata-item (id errataentry) "" (format "%s" id errataentry id)) (defun aon-format-erratum (id newtext) "" (format "%s" id newtext id)) (defun aon-format-erratum-empty (id) "" (format "" id)) (defun aon-errata-replace (beg end newtext oldtext &optional comment) "Replaces the current region and records the replacement." (interactive ;; save all positions and string as the user may change the selection! (let* ((xbeg (region-beginning)) (xend (region-end)) ;;(xoldtext (car kill-ring-yank-pointer)) ; Boohoo Xemacs (xoldtext (buffer-substring-no-properties xbeg xend)) (xnewtext (read-string (format "Replace '%s' with: " xoldtext) xoldtext)) (cmnt (read-string "Additional comment (optional): "))) (list xbeg xend xnewtext xoldtext cmnt))) (cond ((string= newtext "") (error "No replacement! To delete text, use 'aon-errata-delete'.")) ((string= newtext oldtext) (error "The replacement is the same as the original!"))) (let* ((id (aon-get-new-errata-id "RE")) (errataentry (format replaceditemtext (aon-fix-markup oldtext) (aon-fix-markup newtext) comment))) (kill-region beg end) (insert (aon-format-erratum id newtext)) (aon-insert-errata-entry errataentry id))) (defun aon-errata-delete (beg end oldtext &optional comment) "Deletes the current region and records the deletion." (interactive ;; save all positions and string as the user may change the selection! (let* ((xbeg (region-beginning)) (xend (region-end)) ;;(xoldtext (car kill-ring-yank-pointer)) ; Boohoo Xemacs (xoldtext (buffer-substring-no-properties xbeg xend)) (cmnt (read-string "Additional comment (optional): "))) (list xbeg xend xoldtext cmnt))) (let* ((id (aon-get-new-errata-id "DE")) (errataentry (format deleteditemtext (aon-fix-markup oldtext) comment))) (kill-region beg end) (insert (aon-format-erratum-empty id)) (aon-insert-errata-entry errataentry id))) (defun aon-errata-add (pos newtext &optional comment) "Adds text in the current position and records the addition." (interactive (let ((xpos (point)) (string (read-string "Insert text: ")) (cmnt (read-string "Additional comment (optional): "))) (list xpos string cmnt))) (if (string= newtext "") (error "No text to add!")) (let* ((id (aon-get-new-errata-id "AD")) (errataentry (format addeditemtext (aon-fix-markup newtext) comment))) (insert (aon-format-erratum id newtext)) (aon-insert-errata-entry errataentry id))) (defun aon-errata-replace-all (beg end newtext oldtext &optional comment) "Replaces all occurrences of the current region and records the replacements. Stretches all over one indexed section, so it might affect text before the selected region as well! It is NOT very intelligent about abstaining from replacing text in markup that should not be touch, so don't even think about replacing, say, 'class'." (interactive ;; save all positions and string as the user may change the selection! (let* ((xbeg (region-beginning)) (xend (region-end)) ;;(xoldtext (car kill-ring-yank-pointer)) ; Boohoo Xemacs (xoldtext (buffer-substring-no-properties xbeg xend)) (xnewtext (read-string (format "Replace all occurrences of '%s' with: " xoldtext) xoldtext)) (cmnt (read-string "Additional comment (optional): "))) (list xbeg xend xnewtext xoldtext cmnt))) (if (string= newtext oldtext) (error "The replacement text is the same as the original!")) (let* ((id (aon-get-new-errata-id "RA")) (errataentry (format replacedallitemtext (aon-fix-markup oldtext) (aon-fix-markup newtext) comment)) (saved-case-fold-search case-fold-search)) (save-excursion (aon-goto-sect-start) (forward-line 1) ; workaround to avoid matching this section start (setq sectend (aon-get-sect-end)) (setq case-fold-search nil) ; No case folded false matches thank you (while (re-search-forward (format "[^\"]\\\(%s\\\)[^\"]" oldtext) sectend t) (replace-match (aon-format-erratum id newtext) t t nil 1)) (setq case-fold-search saved-case-fold-search)) ; Reset case folding (aon-insert-errata-entry errataentry id))) ;; SLOW!!! And doesn't need to be recursive. Rewrite. (defun aon-goto-sect-start () "Places the point at the start of the current indexed section." (interactive) ; for test purposes (if (member (aon-get-unchecked-sect-id) aon-nonindexed-sects) (progn (search-backward "")))) (if (< nextclosesect nextopensect) nextclosesect ; return the end of this section (save-excursion (goto-char nextopensect) ; place inside nested section (goto-char (aon-get-sect-end)) ; goto end of that section (aon-get-sect-end))))) ; continue search for this section's end (defun aon-get-new-errata-id (type) "Returns a new unique errata item id." (let ((id (format "ERRTAG-%s-%s" type (point)))) (save-excursion (while (search-forward (format "%s-" id) nil t) (setq id (format "%s1" id)))) ; append '1' and try again id)) (defun aon-fix-markup (string) "Converts some markup in text from section to fit in an errata item." ;; Quotes - assume it is single quotes, double must be handled manually (while (string-match "" string) (setq string (replace-match "&lsquot;" nil nil string))) (while (string-match "" string) (setq string (replace-match "&rsquot;" nil nil string))) ;; TODO: Except for tags that shall become entities, maybe the rest can be ;; handled by a general transformation? ;; Link texts (while (string-match "" string) (setq string (replace-match "" nil nil string))) (while (string-match "" string) (setq string (replace-match "" nil nil string))) ;; idrefs and similar ;; TODO: a complete idref does not need to be replaced! (while (string-match "<\\(a .*?\\)>" string) (setq string (replace-match (format "" (match-string 1 string)) nil nil string))) (while (string-match "" string) (setq string (replace-match "" nil nil string))) string) ;; (defun aon-refix-markup (string) ;; "Converts some 'fixed' markup in an errata item text to fit in a section. ;; To be used when an erratum is undone and the replaced or deleted text from ;; an errata item shall be re-inserted in the section." ;; (while (or (string-match "&lsquot;" string) ;; (string-match "&ldquot;" string)) ;; (setq string (replace-match "" nil nil string))) ;; (while (or (string-match "&rsquot;" string) ;; (string-match "&rdquot;" string)) ;; (setq string (replace-match "" nil nil string))) ;; string) (defun aon-locate-errata-item-start () "Return the starting position of the errata block the point is in. Currently, the point may not be within a comment start or end tag. Returns an error message if the point is not within an errata tag or if the errata structure is corrupt." (save-excursion (let ((prevcommentend (save-excursion (search-backward "-->" nil t))) (prevcommentstart (save-excursion (search-backward "" nil t)))) (unless (and prevcommentstart nextcommentend) (error "Point is not within an errata item!")) (goto-char prevcommentstart) (cond ;; if we are at the start of an opening tag, it is OK ((looking-at "") (point)) ;; if we are at the start of a content-free tag, we must check that ;; we were not outside that tag when we started. ((looking-at "") (if (> prevcommentend prevcommentstart) (error "Point is not within an errata item!") (point))) ;; if we are at the start of a closing tag, we must check that we were ;; not outside that tag when we started, and then find the opening tag ((looking-at "") (if (> prevcommentend prevcommentstart) (error "Point is not within an errata item!") (search-backward (format "" (match-string 1))))) ;; if the comment was not an errata tag (t (error "Point is not within an errata item!")))))) (defun aon-errata-jump () "If the point is within tags, jump to the corresponding erratum/errata item. In the case of a \"replace all\" erratum, jumps to the first location." (interactive) (let ((pos (save-excursion (goto-char (aon-locate-errata-item-start)) ; inefficient! (cond ((looking-at "") (goto-char (point-min)) (re-search-forward (format "" (match-string 1))) (match-beginning 0)) ((looking-at "") (goto-char (point-min)) (search-forward (format "" (match-string 1))) (match-beginning 0)) (t (error "This code can not be reached!")))))) (if pos (goto-char pos) (error "This code can not be reached!")))) ; should have received error ;; TODO: Make the illustration functions add entries in the illustrations list (defun aon-illustration-large (number height caption) "Adds a large illustration at the insertion point. The illustrations list is not updated (TBD)." (interactive (let ((xnum (read-string "Illustration number: ")) (xheight (read-string "Pixel height: ")) (xcaption (read-string "Caption: "))) (list xnum xheight xcaption))) (let ((startpos (point)) (endpos (save-excursion (insert (format "\n \n %s\n %s\n \n \n \n " aon-illustrator-name caption number aon-large-illustration-width height number aon-large-illustration-width height)) (point)))) (aon-indent-block startpos endpos))) (defun aon-illustration-inline (filename height) "Adds an inline illustration at the insertion point. The illustrations list is not updated (TBD)." (interactive (let ((xfilename (read-string "File name: ")) (xheight (read-string "Pixel height: "))) (list xfilename xheight))) (let ((startpos (point)) (endpos (save-excursion (insert (format "\n\n%s\n\n\n" aon-illustrator-name filename aon-large-illustration-width height)) (point)))) (aon-indent-block startpos endpos))) (defun aon-indent-block (startpos endpos) "Indents the text between startpos and endpos. The positions need not be start or end of lines. Leaves point at end of block." (dotimes (i (count-lines startpos endpos)) (indent-according-to-mode) (forward-line 1))) (global-set-key "\C-cr" 'aon-errata-replace) (global-set-key "\C-cd" 'aon-errata-delete) (global-set-key "\C-ca" 'aon-errata-add) (global-set-key "\C-cR" 'aon-errata-replace-all) (global-set-key "\C-cj" 'aon-errata-jump) ;;(global-set-key "\C-cu" 'aon-errata-revert) (global-set-key "\C-cl" 'aon-illustration-large) (global-set-key "\C-ci" 'aon-illustration-inline) ;; Errata examples ;; ;; ;; Errata item ;; ;; RE - replace ;; DE - delete ;; AD - add ;; RA - replace all ;;; aon.el ends here