From: Thomas Wolmer Date: Wed, 25 May 2005 21:29:52 +0000 (+0000) Subject: First checked in version X-Git-Tag: 20121028~167 X-Git-Url: http://git.projectaon.org/?p=project-aon.git;a=commitdiff_plain;h=8021bf7610ebce0b8034c8e83620d430bca70558 First checked in version git-svn-id: https://projectaon.org/data/trunk@66 f6f3e2d7-ff33-0410-aaf5-b4bee2cdac11 --- diff --git a/scripts/aon.el b/scripts/aon.el new file mode 100755 index 0000000..b099dd9 --- /dev/null +++ b/scripts/aon.el @@ -0,0 +1,498 @@ +;;; 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 \ No newline at end of file