#!/bin/sh if (cmp $1 $1 2>/dev/null); then if tail -1189 `dirname $0`/compile-jargon > tmp-jargon.el; then if emacs -batch -q -f batch-byte-compile tmp-jargon.el; then if emacs -batch -q -l tmp-jargon.elc $1 -f buffer-jargon-to-html; then rm tmp-jargon.el*; exit 1; fi; fi; fi; echo "** Error during compilation to HTML."; exit 0; else VERSION_NUMBER="V1.4beta"; VERSION_DATE="Mon Jun 24 14:01:27 2002" ; VERSION="$VERSION_NUMBER $VERSION_DATE"; echo "usage: compile-jargon JARGON-FILE"; echo ""; echo "Converts a jargon-style text file into HTML."; echo "It relies on the following conventions: " echo " * Regular entries are of form \"^:KEY:\""; echo " * Alphabetic Captions are listed as \"^= KEY =\""; echo " * Chapters are listed as \"^:KEY:\\\\n****\""; echo " * Sections are listed as \"^:KEY:\\\\n====\""; echo " * Sub-sections are listed as \"^:KEY:\\\\n----\""; echo " * Entries are referenced by \"{KEY}\""; echo ""; echo " [ Here, \"^\" is beginning of line, \"KEY\" is the keyword, \\\\n is line-break ]"; echo ""; echo "KEY may consist of several words, and {KEY} may contain line-breaks."; echo "For text that looks like an email address (e.g. ) or a"; echo "URL (http://something, ftp://somewhere), the conversion inserts"; echo "hyper-links, but might make occasional mistakes."; echo ""; echo "By default, the translation yields a framed version with javascript,"; echo "and writes files jargon.html, jargon-menu.html, jargon-text.html."; echo "By customization, you can construct a no-frame version instead,"; echo "suppress javascript, and change the layout (see below)."; echo ""; echo "If you have emacs 19.28 or higher, the input file may be compressed."; echo "Creates the files jargon.html, jargon-menu.html, jargon-text.html."; echo ""; echo "Customization:"; echo " You can modify the emacs lisp part of file"; echo " `dirname $0`/compile-jargon"; echo " If you change the number of lines, however, adjust line 3:"; cat `dirname $0`/compile-jargon | head -3 |tail -1; echo " The number after \"tail\" has to match the length of the emacs lisp part."; echo ""; echo "Relies on: emacs [version 19.28 or higher]"; echo ""; echo "Please change *maintainer-email* and *maintainer-name* to yours." echo ""; echo "compile-jargon $VERSION --- "; exit 0; fi;## ---------------------------------------------------------------------- ## -- maintainance of this file -------------------------------------------- ## ------------------------------------------------------------------------- ## ------------------------------------------------------------------------- ## -- emacs lisp part starts after this line ------------------------------- ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Script to translate cross-referenced text into .html files ;;; ------------------------------------------------------------- ;;; ;;; Usage: from a shell call ;;; ;;; $ emacs -batch -q -l my-jargon.el INPUT -f 'buffer-jargon-to-html ;;; ;;; Synopsis: ;;; Emacs Lisp Extenstions ;;; Jargon style text file -> HTML compiler scripts ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @TABLE OF CONTENTS: [TOCD: 14:32 25 Jul 2001] ;;; ;;; [1] Setups ;;; [1.1] Maintainer ;;; [1.2] General Layout ;;; [1.3] Style Setups ;;; [1.4] Javascript ;;; [1.5] Emacs Options ;;; [2] Language Extension ;;; [3] String Manipulation ;;; [3.1] HTML specific fixes ;;; [4] Compression (if *allow-compressed-inputs* it non-nil) ;;; [5] Main Function ;;; [6] Sub-Indices ;;; [7] Templates and Style Sheets ;;; ///////////////////////////////////////////////////////// ;;; @FILE: my-jargon.el ;;; @PLACE: Linux Homestation ;;; @FORMAT: emacs lisp ;;; @AUTHOR: M. Oliver M'o'ller ;;; @BEGUN: Sat Jul 14 23:46:00 2001 ;;; @VERSION: V1.4beta Mon Jun 24 14:01:27 2002 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ////////////////////////////////////////////////////////////////// ;;; [1] Setups ;;; ////////////////////////////////////////////////////////////////// ;;; ////////////////////////////////////////////// ;;; [1.1] Maintainer ;;; ////////////////////////////////////////////// (defconst *maintainer-name* "Oliver Möller" "*page maintainer") (defconst *maintainer-email* "omoeller@verify-it.de" "*email address") (defconst *relative-graph-path* "./../graph/" "*place where to find \"valid-html40.gif\"") ;;; ////////////////////////////////////////////// ;;; [1.2] General Layout ;;; ////////////////////////////////////////////// (defconst *document-name* "Jargon" "*Name of the document as to appear in the tag") (defconst *file-prefix* "jargon" "*Prefix of the contructed files; The main method will overwrite *file-prefix*.html *file-prefix*-menu.html *file-prefix*-text.html") (defconst *jargon-monolithic* nil "*For buffer-jargon-to-html. If non-nil, it constructs only *one* file instead of a framed version (3 files).") (defconst *jargon-use-script* t "*For buffer-jargon-to-html. If non-nil, uses javascript to construct HTML pages.") (defconst *jargon-menu-row-layout* nil "*If non-nil, or *jargon-monolitic* is t, use row-layout. The alternative is to have column layout, i.e., the menue above and in a row.") (defconst *jargon-alphachars-per-line* 7 "*Number of entries in alphabetical table row before linewrap.") ;; -- linewrapping --------------------------------------------------------- (defconst *jargon-force-linewrap* 80 "*If non-nil, denotes the maximal number of characters in a line. Surplus characters are wrapped (with *jargon-linewrap-spaces* spaces up front).") (defconst *jargon-linewrap-spaces* 3 "*Number of spaces after (forced) linewrap.") (defconst *linewrap-marker-char* 1 "*Character code for linewrap") ;; -- index table cells ---------------------------------------------------- (defconst *jargon-alphachars-cellspacing* "0" "*String to insert for alphabetic index table (small value == narrower).") (defconst *jargon-alphachars-cellpadding* "3" "*String to insert for alphabetic index table (small value == narrower).") ;;; ////////////////////////////////////////////// ;;; [1.3] Style Setups ;;; ////////////////////////////////////////////// (defconst *jargon-background-color* "#000000" "*Document Background Color") (defconst *jargon-text-color* "#dde044" "*Document Text Color") (defconst *jargon-plain-color* "#00eeee" "*Ordinary Link Color") (defconst *jargon-visited-color* "#33ff99" "*Color of visited links") (defconst *jargon-caption-color* "#f04040" "*Headline Color") (defconst *jargon-key-color* "#F04040" "*Internal Link Color") (defconst *jargon-hyperlink-color* "#9999ee" "*External Link/Mailto Color") ;;; ////////////////////////////////////////////// ;;; [1.4] Javascript ;;; ////////////////////////////////////////////// (defconst *findinpage-javascript-function* "\nvar numtimes = 0;\nvar n = 0;\n\nfunction findInPage(str) {\n\nif (str == \"\") return false;\n\nif (document.all) {\n\nvar txt = window.document.body.createTextRange();\nvar found = txt.findText(str);\n\nfor (var i = 0; i <= numtimes && found != false; i++) {\n txt.moveStart(\"character\", 1);\n txt.moveEnd(\"textedit\");\n}\n\n\nif (found) {\n txt.moveStart(\"character\", -1);\n txt.findText(str);\n txt.select();\n txt.scrollIntoView();\n numtimes++;\n}\n\nelse {\n if (numtimes > 0) {\n numtimes = 0;\n findInPage(str);\n }\n\nelse alert(\"The word \\\"\"+ str +\"\\\" was not found.\");\n}\nreturn false;\n} // end of document.all\nelse {\n window.focus();\nif (!window.find(str)) {\n while(window.find(str, false, true)) n++;\n }\nelse numtimes++;\n\nif (numtimes == 0) alert(\"The word \\\"\"+ str +\"\\\" was not found.\");\n}\n}" "Function to allow for searching strings in IE/Netscape") (defconst *findinpage-javascript-action* (if *jargon-monolithic* "javascript: findInPage(window.document.forms[0].elements[0].value);" "javascript: findInPage(parent.frames[0].document.forms[0].elements[0].value);parent.frames[0].document.forms[0].elements[0].focus();") "Script to find text in page") ;;; ////////////////////////////////////////////// ;;; [1.5] Emacs Options ;;; ////////////////////////////////////////////// (defconst *allow-compressed-inputs* t "*If set to t, assumes that package jka-compr can be found by emacs") ;;; ////////////////////////////////////////////////////////////////// ;;; [2] Language Extension ;;; ////////////////////////////////////////////////////////////////// (defmacro my-loop-for-i-from-to-do (start end &rest exec) (list 'let (list (list 'i start) (list 'ex 'nil)) (list 'while (list '<= 'i end) (list 'setq 'ex (list 'quote exec)) (list 'while (list 'not (list 'null 'ex)) (list 'eval (list 'car 'ex)) (list 'setq 'ex (list 'cdr 'ex))) (list 'setq 'i (list '+ 'i 1)) ))) (defmacro my-loop-for-i-from-downto-do (start end &rest exec) (list 'let (list (list 'i start) (list 'ex 'nil)) (list 'while (list '>= 'i end) (list 'setq 'ex (list 'quote exec)) (list 'while (list 'not (list 'null 'ex)) (list 'eval (list 'car 'ex)) (list 'setq 'ex (list 'cdr 'ex))) (list 'setq 'i (list '- 'i 1))))) (defmacro my-loop-for-e-in-do (list &rest exec) (list 'let (list (list 'e 'nil) (list 'l list) (list 'ex 'nil)) (list 'while (list 'not (list 'listp 'l)) (list 'setq 'l (list 'eval 'l))) (list 'while (list 'not (list 'null 'l)) (list 'setq 'e (list 'car 'l)) (list 'setq 'l (list 'cdr 'l)) (list 'setq 'ex (list 'quote exec)) (list 'while (list 'not (list 'null 'ex)) (list 'eval (list 'car 'ex)) (list 'setq 'ex (list 'cdr 'ex))) ))) (defun my-member (element list &rest cmp) (let ((comparison (if (null cmp) 'equal (car cmp)))) (if (null list) nil (if (funcall comparison (car list) element) t (my-member element (cdr list) comparison))))) (defmacro my-add-to-list (LIST-VAR ELEMENT) "mimics add-to-list: Add to the value of LIST-VAR the element ELEMENT if it isn't there yet. The test for presence of ELEMENT is done with `equal'. If ELEMENT is added, it is added at the beginning of the list." (list 'if (list 'my-member ELEMENT LIST-VAR) LIST-VAR (list 'setq LIST-VAR (list 'cons ELEMENT LIST-VAR)))) (defun my-string-to-charlist (s) (let ((res nil)) (my-loop-for-i-from-downto-do (- (length s) 1) 0 (setq res (cons (aref s i) res))) res)) (defun my-string-to-number (s &rest base) "Converts a string to a integer (or float, if a '.' occurs), relative to a given base (2-36). If no base is given, it is assumed to be to base 10. The digits greater than 9 are assumed to be a,b,c,...z (upper or lowercase). Returns nil if it fails." (let ((l (my-string-to-charlist s)) (base (if (null base) 10 (car base))) (res 0) (digit -1) (minus nil) (shifted nil) (fault nil)) (my-loop-for-e-in-do l (if shifted (setq shifted (/ shifted base))) (cond ((equal e (aref "." 0)) (setq res (* 1.0 res) shifted 1.0)) ((and (= 0 res) (equal e (aref "-" 0))) (setq minus t)) (t (cond ((and (<= 48 e) (<= e 57)) (setq digit (- e 48))) ((and (<= (aref "a" 0) e) (<= e (aref "z" 0))) (setq digit (+ 10 (- e (aref "a" 0))))) ((and (<= (aref "A" 0) e) (<= e (aref "Z" 0))) (setq digit (+ 10 (- e (aref "A" 0))))) (t (setq digit -1))) (if (or (< digit 0) (>= digit base)) (setq fault (if (integerp res) -1 -1.0)) (setq res (+ digit (* base res))))))) (if minus (setq res (- 0 res))) (if fault nil (if shifted (* shifted res) res)))) (defun kill-buffer-content () (interactive) (kill-region (point-min) (point-max))) (defun goto-next-whitespace () "Move point before the next whitespace or to the end of file." (interactive) (if (search-forward-regexp "\\( \\|\r\\|\n\\|\t\\|$\\)" (point-max) t) (backward-char 1) (goto-char (point-max)))) (defun mark-current-buffer () "Insert whole buffer in killring." (interactive) (let ((mark (point-marker))) (kill-ring-save (point-min) (point-max)) (goto-char mark) (message "<<Current Buffer was Marked>>"))) ;;; ////////////////////////////////////////////////////////////////// ;;; [3] String Manipulation ;;; ////////////////////////////////////////////////////////////////// (defmacro scon (&rest args) "Concatenate" (list 'let (list (list 's "") (list 'a (list 'quote args))) (list 'while (list 'not (list 'null 'a)) (list 'setq 's (list 'format "%s%s" 's (list 'eval (list 'car 'a)))) (list 'setq 'a (list 'cdr 'a))) 's)) (defun scon-list (args) "Catenate a list." (let ((res "")) (my-loop-for-e-in-do args (setq res (format "%s%s" res e))) res)) (defun my-substring (s from &rest to-rest) "Substring, starts counting at positions 0, optional argument to gives position before truncation, i.e. (my-substring \"abcd\" 1 3) -> \"bc\". (Java convention)." (let ((res nil) (to (if to-rest (min (- (car to-rest) 1) (- (length s) 1)) (- (length s) 1)))) (my-loop-for-i-from-downto-do to from (setq res (cons (aref s i) res))) (scon-list (mapcar 'my-c-to-string res)))) (defun my-c-to-string (s) (format "%c" s)) (defun my-capitalize-string (string) "Return a string with capitalized first letter." (let* ((clist (my-string-to-charlist string)) (first (car clist)) (rest (cdr clist)) (cassoc (list (cons (aref "a" 0) (aref "A" 0)) (cons (aref "b" 0) (aref "B" 0)) (cons (aref "c" 0) (aref "C" 0)) (cons (aref "d" 0) (aref "D" 0)) (cons (aref "e" 0) (aref "E" 0)) (cons (aref "f" 0) (aref "F" 0)) (cons (aref "g" 0) (aref "G" 0)) (cons (aref "h" 0) (aref "H" 0)) (cons (aref "i" 0) (aref "I" 0)) (cons (aref "j" 0) (aref "J" 0)) (cons (aref "k" 0) (aref "K" 0)) (cons (aref "l" 0) (aref "L" 0)) (cons (aref "m" 0) (aref "M" 0)) (cons (aref "n" 0) (aref "N" 0)) (cons (aref "o" 0) (aref "O" 0)) (cons (aref "p" 0) (aref "P" 0)) (cons (aref "q" 0) (aref "Q" 0)) (cons (aref "r" 0) (aref "R" 0)) (cons (aref "s" 0) (aref "S" 0)) (cons (aref "t" 0) (aref "T" 0)) (cons (aref "u" 0) (aref "U" 0)) (cons (aref "v" 0) (aref "V" 0)) (cons (aref "w" 0) (aref "W" 0)) (cons (aref "x" 0) (aref "X" 0)) (cons (aref "y" 0) (aref "Y" 0)) (cons (aref "z" 0) (aref "Z" 0)) (cons (aref "" 0) (aref "" 0)) (cons (aref "" 0) (aref "" 0)) (cons (aref "" 0) (aref "" 0)) (cons (aref "" 0) (aref "" 0)) (cons (aref "" 0) (aref "" 0)) (cons (aref "" 0) (aref "" 0)) (cons (aref "" 0) (aref "" 0)) (cons (aref "" 0) (aref "" 0))) )) (if (assoc first cassoc) (my-charlist-to-string (cons (cdr (assoc first cassoc)) rest)) string))) (defun my-charlist-to-string (l) (if (null l) "" (format "%c%s" (car l) (my-charlist-to-string (cdr l))))) (defun my-replace-char (orig new string) "Replace character by other character (i.e. ASCII number) or string." (interactive) (let ((charlist (my-string-to-charlist string)) (res nil) (new-list (cond ((stringp new) (list new)) ((integerp new) (list (format "%c" new))) (t "?")))) (while (not (null charlist)) (setq res (if (eq orig (car charlist)) (append new-list res) (cons (format "%c" (car charlist)) res))) (setq charlist (cdr charlist))) (scon-list (reverse res)))) (defun my-charp (char) "Test, whether it can be used as ASCII char" (integerp char)) (defun whitespacep (char) "Tests, whether a (ASCII) character is a whitespace" (and (my-charp char) (or (= (aref " " 0) char) (= (aref "\t" 0) char) (= (aref "\n" 0) char) (= (aref "\r" 0) char)))) (defun my-substring-upto-without-char (s c) "Returns a string until the first occurence of a char (exclusive)" (let ((res nil) (notdone t)) (my-loop-for-e-in-do (my-string-to-charlist s) (if notdone (if (equal c e) (setq notdone nil) (setq res (cons e res))))) (scon-list (mapcar 'my-c-to-string (reverse res))))) (defun point-end-of-this-line () "Returns position of the end of this line." (let ((tmp (point-marker)) (res nil)) (end-of-line) (setq res (point-marker)) (goto-char tmp) res)) ;;; ////////////////////////////////////////////// ;;; [3.1] HTML specific fixes ;;; ////////////////////////////////////////////// (defun compress-whitespaces (string) "Replace sequence of whitespaces in string by a single whitespace." (let ((res nil) (in-whitespaces nil)) (my-loop-for-e-in-do (my-string-to-charlist string) (if (whitespacep e) (if in-whitespaces nil (setq res (cons e res) in-whitespaces t)) (setq res (cons e res) in-whitespaces nil))) (my-charlist-to-string (reverse res)))) (defun fix-keyword (string) "Returns a HTML admissilbe version of some keyword string." (my-replace-char (aref ";" 0) "-" (my-replace-char (aref "&" 0) "-" (my-replace-char (aref "\"" 0) "-" (my-replace-char (aref "\n" 0) "" (my-replace-char *linewrap-marker-char* "" (my-replace-char (aref " " 0) "" string))))))) (defun remove-linewrap-marker (string) "Removes the linewrap-marker from string" (my-replace-char *linewrap-marker-char* "" string)) (defun adjust-linebreak () "Browse this line, and adjust linebreaks around { } (for these characters are removed). If there is some \"}\" before this position in the line, it will do nothing: the linebreaks have already been adjusted." (let ((orig-pos (point-marker)) (now nil) (beg nil) (count 0)) (beginning-of-line) (setq beg (point-marker)) (if (search-forward "<A CLASS=\"plain\"" (- orig-pos 1) t) (goto-char orig-pos) ;; do nothing ;; ----------------------------------------------------------------- (while (search-forward (format "%c" *linewrap-marker-char*) (point-end-of-this-line) t) (setq now (point-marker) count 0) (goto-char beg) (while (search-forward-regexp "[{}]" (+ now count) t) (setq count (+ 1 count))) (goto-char now) (setq beg (+ now 1)) (if (> count 0) (progn (backward-delete-char 1) ;; (message (format "Counter: %d" count)) (move-to-column (+ (current-column) count)) (insert (format "%c" *linewrap-marker-char*)) ))) (goto-char orig-pos)))) (defun shift-linebreaks-by (i) "Move all linebreaks in this line (if any) i positions to the right." (let ((orig-pos (point-marker))) (beginning-of-line) (while (search-forward (format "%c" *linewrap-marker-char*) (point-end-of-this-line) t) (backward-delete-char 1) (forward-char i) (insert (format "%c" *linewrap-marker-char*))) (goto-char orig-pos))) ;;; ////////////////////////////////////////////////////////////////// ;;; [4] Compression (if *allow-compressed-inputs* it non-nil) ;;; ////////////////////////////////////////////////////////////////// (let ((emacs-main-version (or (my-string-to-number (my-substring-upto-without-char emacs-version (aref "." 0))) -1)) (emacs-sub-version (or (my-string-to-number (my-substring emacs-version 3)) -1))) (message (format "Emacs: %d %d" emacs-main-version emacs-sub-version)) (if (and *allow-compressed-inputs* (or (> emacs-main-version 19) (and (= emacs-main-version 19) (>= emacs-sub-version 30)))) (progn (if (fboundp 'auto-compression-mode) ; Emacs 19.30+ (auto-compression-mode 0) (require 'jka-compr) ) ;; Now add bzip2 support and turn auto compression back on. (my-add-to-list jka-compr-compression-info-list ["\\.bz2\\(~\\|\\.~[0-9]+~\\)?\\'" "zipping" "bzip2" () "unzipping" "bzip2" ("-d") nil t]) ;; -- switch it on --------------------------------------------------- (auto-compression-mode) ))) ;;; ////////////////////////////////////////////////////////////////// ;;; [5] Main Function ;;; ////////////////////////////////////////////////////////////////// (defun buffer-jargon-to-html (&rest rest) "Reads a jargon style buffer and constructs either one monolithic file *file-prefix*.html or three new files: *file-prefix*.html *file-prefix*-menu.html *file-prefix*-text.html depending on *compute-jargon-to-html-monolithic*. The contents into linked HTML text; assumes that local names are given in ^:KEY WORD: and references to them are denoted {KEY WORD}, possibly with line break or similar in between. Uses cascading style-sheets. Does _not_ modify source buffer. " (interactive) (let* ((pos nil) (aux nil) (key "") (version-string "") (tmp nil) (menu-pos nil) (detail-pos nil) (contents-string (format "%s<TABLE BORDER=\"2\" SUMMARY=\"Content Table\"><TR><TD><B>Content</B></TD></TR><TR><TD>" (if (or *jargon-monolithic* *jargon-menu-row-layout*) "<TD VALIGN=\"LEFT\">" ""))) (findindex-string (format "%s<TABLE SUMMARY=\"Find-Form Table\" CELLSPACING=\"%s\" CELLPADDING=\"%s\"><TR><TD COLSPAN=\"%d\"><FORM name=search onSubmit=\"\" ACTION=\"%s\"><FONT SIZE=\"-1\" FACE=\"arial,helvetica,serif\" COLOR=\"#9900CC\">Find:<INPUT name=string type=text size=10 onChange=\"n = 0;\"></FONT></FORM></TD><TR VALIGN=\"RIGHT\">" (if (or *jargon-monolithic* *jargon-menu-row-layout*) "<TD VALIGN=\"RIGHT\">" "") *jargon-alphachars-cellspacing* *jargon-alphachars-cellpadding* *jargon-alphachars-per-line* *findinpage-javascript-action* )) (detail-string (format "%s<TABLE BORDER=\"2\" SUMMARY=\"Detail Table\"><TR><TD><I>* Sub-Contents *</I></TD></TR><TR><TD>" (if (or *jargon-monolithic* *jargon-menu-row-layout*) "<TD VALIGN=\"CENTER\">" ""))) (tail-string (format "</TD></TR></TABLE>%s" (if (or *jargon-monolithic* *jargon-menu-row-layout*) "</TD>" "<BR>"))) (detail-list nil) ;; list of [ strings + list of strings ] (sub-index-list nil) (sub-sub-index-list nil) (sub-index-name "") ;; -- Constant helpers --------------------- (main-index-regexp "^[ ]*:.*:[ \n]*\\*\\*") (sub-index-regexp "^[ ]*:.*:[ \n]\\(===\\|---\\)") (next-main nil) (sub-index-second nil) (main-index "") (source-buffer (current-buffer)) (buffer-jargon nil) (buffer-jargon-menu nil) (buffer-jargon-text nil) (count 0) (mi-count 1) (global-tail-string "") (save-case-fold-search case-fold-search) (frame-string (format "<FRAMESET %s>\n<!-- frameborder=\"0\" -->\n<FRAME SCROLLING=AUTO SRC=\"%s-menu.html\" NAME=\"Menu\">\n<FRAME SCROLLING=AUTO SRC=\"%s-text.html\" NAME=\"Main-Frame\">\n</FRAMESET>\n<noframes>\n<p>Your browser does not support frames. \nYou can go <a href=\"%s-text.html\">here</a> to view the text body\nwithout frames.</p>\n</noframes>\n\n</HTML>\n" (if *jargon-menu-row-layout* "ROWS=\"25%,75%\"" "COLS=\"20%,80%\"") *file-prefix* *file-prefix* *file-prefix*)) (frame-doctype "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Frameset//EN\">\n") (memo-newline "") (linewrap-string "\n") (global-replace '(lambda (x y) (goto-char pos)(replace-string x y))) (global-replace-regexp '(lambda (x y) (goto-char pos)(replace-regexp x y))) ) (setq case-fold-search t) ;;; allow to match uppercase (auto-fill-mode nil) ;; ----------------------------------------------------------------- (goto-char (point-min)) (if (search-forward-regexp "version [^,]*," (point-max) t) (progn (kill-ring-save (match-beginning 0) (- (match-end 0) 1)) (setq version-string (format " - %s" (car kill-ring))))) ;; -- creating the buffers ----------------------------------------- ;; -- jargon.html -------------------------------------------------- (find-file (scon *file-prefix* ".html")) (setq buffer-jargon (current-buffer)) (kill-buffer-content) (goto-char (point-min)) (insert "\n") (goto-char (point-min)) (insert-html-template (scon *document-name* version-string)) (if *jargon-monolithic* (progn (insert-style-sheet) (search-forward "</script>") (previous-line 2) (beginning-of-line) (setq aux (point-marker)) (setq buffer-jargon-text buffer-jargon) (setq buffer-jargon-menu buffer-jargon)) ;; -- else --------------------------------------- (goto-char (point-min)) (search-forward "<script") (next-line 2) (insert "var mi = 0;\n") ;; ---------------------------------------- (search-forward "<body") (backward-char 5) (insert frame-string) (delete-region (point-marker) (point-max)) (if (search-backward "<!doctype " (point-min) t) (progn (beginning-of-line) (kill-line)) (goto-char (point-min))) (insert frame-doctype) (goto-char (point-max))) (setq case-fold-search t) ;;; allow to match uppercase (basic-save-buffer) ;; -- jargon-menu.html ------------------------ (if *jargon-monolithic* null (find-file (scon *file-prefix* "-menu.html")) (kill-buffer-content) (goto-char (point-min)) (insert "\n") (goto-char (point-min)) (insert-html-template (scon *document-name* " Menu" version-string)) (insert-style-sheet)) (setq case-fold-search t) ;;; allow to match uppercase (setq buffer-jargon-menu (current-buffer)) (goto-char (point-min)) (goto-html-script) (insert (format *findinpage-javascript-function* )) (if *jargon-monolithic* (goto-char aux) ;; else (goto-char (point-min)) (search-forward "<title") (next-line 1)(beginning-of-line) (insert "<BASE TARGET=\"Main-Frame\">\n") (goto-char (point-min)) (search-forward "</script>") (previous-line 2) (beginning-of-line)) (setq aux (point-marker)) (search-forward "<body")(forward-line 1)(beginning-of-line) (setq tmp (point-marker)) (search-forward "</body>") (beginning-of-line) (delete-region tmp (point-marker)) ;; ----------------------------------------------------------------- (goto-html-body) (setq aux (point-marker)) (if (or *jargon-monolithic* (null *jargon-use-script*)) (insert "\n</BODY>\n</HTML>\n") ;; -- script and tail ------------------------------- (insert "\n<SCRIPT>\n") (insert "\ndraw_document();\n</SCRIPT>\n</BODY></HTML>") (delete-region (point-marker) (point-max))) (basic-save-buffer) ;; -- jargon-text.html ------------------------ (if *jargon-monolithic* null ;; -- non-monlithic -------------------------------------------- (find-file (scon *file-prefix* "-text.html")) (kill-buffer-content) (goto-char (point-min)) (insert "\n") (goto-char (point-min)) (insert-html-template (scon *document-name* " Text Body" version-string)) (insert-style-sheet) ;; -------------------------------------------- (goto-html-script) (insert (format *findinpage-javascript-function* )) ;; -- prepare to cutt off ------------------- (goto-html-body) (beginning-of-line) (setq aux (point-marker)) (search-forward "</body>") (beginning-of-line) (delete-region aux (point-marker)) (setq aux (point-marker)) (setq buffer-jargon-text (current-buffer))) (setq case-fold-search t) ;;; allow to match uppercase (basic-save-buffer) ;; -------------------------------------------- (set-buffer source-buffer) (mark-current-buffer) (set-buffer buffer-jargon-text) (goto-html-body) (insert (format "<I>Hyperlinked monolithic version constructed on %s</I><HR>\n<A NAME=\"TOP-MARK\"></A><TT>\n" (current-time-string))) (yank) ;; either in jargon.html or jargon-text.html (kill-region (point-marker) (point-max)) (setq global-tail-string (car kill-ring)) ;; -- (basic-save-buffer) (if *jargon-monolithic* (goto-char aux) (search-backward "<body")) (next-line 1)(beginning-of-line) (setq pos (point-marker)) (message "** header inserted.") ;; -- preprocess: remove double braces ----------------------------- (goto-html-jargon) (setq menu-pos (point-marker)) (setq pos (point-marker)) ;; -- common fixes ------------------------------------------ (funcall global-replace "{{" "{") (funcall global-replace "{{" "{") (funcall global-replace "}}" "}") (funcall global-replace "<<" "<") (funcall global-replace ">>" ">") ;; - fix a minor irregularity if present (funcall global-replace-regexp "^The Jargon Lexicon[ \n]*******" ":The Jargon Lexicon:\n*******") ;; ;; -- fix the new underline-style 4.2.2 (funcall global-replace ": -------" ": \n-------") (funcall global-replace ": =======" ": \n=======") (funcall global-replace ": *******" ": \n*******") (funcall global-replace "= =====\n" "=\n=====\n") (funcall global-replace " #=====================" "\n#=====================") ;; -- force linebreak --------------------------------------------------- (funcall global-replace "" "ö") ;; is a marker (goto-char pos) (previous-line 1) (if *jargon-force-linewrap* (progn (while (progn (forward-line 1) (end-of-line) (< (point-marker) (point-max))) (if (< *jargon-force-linewrap* (current-column)) (progn (beginning-of-line) (while (< (point-marker) (point-end-of-this-line)) (move-to-column (- (+ (current-column) *jargon-force-linewrap*) (if (< (current-column) *jargon-force-linewrap*) 0 -1))) (insert (format "%c" *linewrap-marker-char*)) (forward-char 0)) (backward-delete-char 1) ))))) (my-loop-for-i-from-to-do 1 *jargon-linewrap-spaces* (setq linewrap-string (scon linewrap-string " "))) ; (basic-save-buffer) ; (error "end") ;; ---------------------------------------------------------- (goto-char pos) (funcall global-replace "&" "&") ;; - fix < and > (funcall global-replace "<" "<") (funcall global-replace ">" ">") (funcall global-replace "" "×") (message "** done with preprocessing.") ;; ----------------------------------------------------------------- ;; -- insert EMAILs ------------------------------------------------ (goto-html-jargon) (setq menu-pos (point-marker)) (while (and (goto-char menu-pos) (search-forward-regexp "[ ;\"][^ &;\n@]*@[^ &;\n\\<&]*[ \\<\\>&\"\n,\\`\\']" (point-max) t)) (setq menu-pos (point-marker)) (search-backward-regexp "[^ ,&\n\\<\\>\\.\"\\`\\']");; emails don't end with . (forward-char 1) (setq aux (point-marker)) (insert "</A>") (backward-char 4) (search-backward-regexp "[ ,;\\>\"]") (forward-char 1) (kill-ring-save (point-marker) aux) (insert (format "<A CLASS=\"hyperlink\" HREF=\"MAILTO:%s\">" (remove-linewrap-marker (car kill-ring))))) (message "** emails inserted.") ;; ----------------------------------------------------------------- ;; -- insert URLs -------------------------------------------------- (goto-html-jargon) (setq menu-pos (point-marker)) (while (and (goto-char menu-pos) (search-forward-regexp "\\(http\\|ftp\\)://[^ \n,\"\\`\\']*[,\n \"\\`\\']" (point-max) t)) (setq menu-pos (point-marker)) (search-backward-regexp "[^ \\`\\',\\.\\)\n\"]") ;; urls don't end with . or ) (forward-char 1) (setq aux (point-marker)) (insert "</A>") (search-backward-regexp "\\(http\\|ftp\\)://") (kill-ring-save (point-marker) aux) (insert (format "<A CLASS=\"hyperlink\" TARGET=\"_new\" HREF=\"%s\">" (remove-linewrap-marker (car kill-ring))))) (message "** URLs inserted.") ;; ----------------------------------------------------------------- ;; -- compute an index --------------------------------------------- ;; ----------------------------------------------------------------- (goto-html-body) (while (search-forward-regexp main-index-regexp (point-max) t) (next-line 2) (setq aux (point-marker)) (previous-line 3) (beginning-of-line)(search-forward ":") (setq menu-pos (point-marker)) (search-forward ":")(backward-char 1) (kill-ring-save menu-pos (point-marker)) (setq main-index (car kill-ring)) ;; (end-of-line) (insert "</B></A>") (beginning-of-line) (insert (format "<A NAME=\"%s\"></A><A CLASS=\"key\" HREF=\"#TOP\" onMouseOver=\"window.status = '-> TOP of file'\"><B>" (fix-keyword main-index))) ;; ------------------------------------------ (setq contents-string (scon contents-string (format "* <FONT=\"-1\"><A CLASS=\"key\" %s HREF=\"%s#%s\">%s</A></FONT><BR>" (if (and *jargon-use-script* (null *jargon-monolithic*)) (format "onmouseover=\"parent.mi=%d; if((local_mi != parent.mi) && ( detail_array[parent.mi].length > 0 )){ window.location.reload() }\"" mi-count) "") (if *jargon-monolithic* "" (scon *file-prefix* "-text.html")) (fix-keyword main-index) main-index))) (setq mi-count (+ 1 mi-count)) ;; -- compute Array-Index ---------------------------------------- (setq aux (point-marker)) (if (search-forward-regexp main-index-regexp (point-max) t) (setq next-main (point-marker)) (setq next-main (point-max))) (goto-char aux) (previous-line 1) ;; -- second/third ------------------------------------ (setq sub-index-list nil) (setq sub-sub-index-list nil) (while (search-forward-regexp sub-index-regexp next-main t) (backward-delete-char 1 t) (insert (car kill-ring)) (cond ((string= "=" (car kill-ring)) (setq sub-index-second t)) (t (setq sub-index-second nil))) (next-line 2) (setq aux (point-marker)) (previous-line 3) (beginning-of-line)(search-forward ":") (setq menu-pos (point-marker)) (search-forward ":")(backward-char 1) (kill-ring-save menu-pos (point-marker)) (setq sub-index-name (car kill-ring)) ;; (end-of-line) (insert "</B></A>") (beginning-of-line) (insert (format "<A NAME=\"%s\"></A><A CLASS=\"key\" HREF=\"#%s\" onMouseOver=\"window.status = '-> HIGHER INDEX: %s'\"><B>" (fix-keyword sub-index-name) (fix-keyword main-index) main-index)) ;; ---------------------------------------- now insert: (if sub-index-second ;; -- higher index: clear old --------- (progn (if sub-sub-index-list (setq sub-index-list (append sub-index-list (list sub-sub-index-list)) sub-sub-index-list nil)) (setq sub-index-list (append sub-index-list (list sub-index-name)))) ;; -- lower index --------------------- (progn (setq sub-sub-index-list (append sub-sub-index-list (list sub-index-name)))))) ;; -- next main index entry -------------------------------------- (if sub-sub-index-list (setq sub-index-list (append sub-index-list (list sub-sub-index-list)))) (setq detail-list (append detail-list (list (cons main-index (list sub-index-list))))) ;; --------------------------------------------------------------- ) ;; -------------------------------------------- (setq contents-string (scon contents-string (format "</TD></TR></TABLE>%s" (if (or *jargon-monolithic* *jargon-menu-row-layout*) "</TD>" "<BR>")))) (message "** Index computed.") ;; ----------------------------------------------------------------- ;; -- compute alphabetic index ------------------------------------- ;; ----------------------------------------------------------------- (set-buffer buffer-jargon-text) (setq aux (point-min)) (while (progn (goto-char aux) (search-forward-regexp "^[ ]*= .* =" (point-max) t)) (backward-char 1) (setq menu-pos (point-marker)) (end-of-line) (insert "</B></A>") (beginning-of-line)(search-forward "=") (kill-ring-save menu-pos (point-marker)) (beginning-of-line) (setq key (car kill-ring)) (insert (format "<A NAME=\"%s\"></A><A CLASS=\"key\" HREF=\"#TOP\" onMouseOver=\"window.status = '-> TOP of File'\"><B>" (fix-keyword key))) (setq aux (point-marker)) ;; ------------------------------------------ (setq findindex-string (scon findindex-string (format "<TD WIDTH=\"8\"><FONT SIZE=\"-2\"><A CLASS=\"key\" HREF=\"%s#%s\">%s</A></FONT></TD>" (if *jargon-monolithic* "" (scon *file-prefix* "-text.html")) (fix-keyword key) key))) (setq count (mod (+ 1 count) *jargon-alphachars-per-line*)) (if (= 0 count) (setq findindex-string (scon findindex-string "</TR><TR VALIGN=\"RIGHT\">")))) ;; -------------------------------------------- (setq findindex-string (scon findindex-string (format "</TABLE>%s" (if (or *jargon-monolithic* *jargon-menu-row-layout*) "</TD>" "<BR>")))) (message "** alphabetic index computed.") ;; -- insert index tables ------------------------------------------ (set-buffer buffer-jargon-menu) (if (and *jargon-use-script* (null *jargon-monolithic*)) (progn (goto-html-script) (insert (format "doc_contents=\"%s\";\n\n" (my-replace-char (aref "\"" 0) "\\\"" contents-string))) (insert (format "doc_findindex=\"%s\";\n\n" (my-replace-char (aref "\"" 0) "\\\"" findindex-string))) (insert (format "doc_details=\"%s\";\n\n" (my-replace-char (aref "\"" 0) "\\\"" detail-string))) (insert (format "doc_tail=\"%s\";\n\n" (my-replace-char (aref "\"" 0) "\\\"" tail-string))) (insert (format "detail_array = new Array(\"\"\n %s\n);\n\n" (all-detailled-entries-as-array detail-list))) (insert "var local_mi = parent.mi;\n\n") (insert "function draw_document() {\n") (insert "document.clear;\n") (if (or *jargon-monolithic* *jargon-menu-row-layout*) (progn (insert "document.writeln(\"<TABLE WIDTH=\\\"100%\\\" SUMMARY=\\\"Menu\\\"><TR>\");\n") (insert "document.writeln(doc_contents);\n") (insert "document.writeln(doc_details);\n") (insert "document.writeln(detail_array[parent.mi]);\n") (insert "document.writeln(doc_tail);\n") (insert "document.writeln(doc_findindex);\n") (insert "document.writeln(\"</TR></TABLE>\");\n")) ;; -- column layout --------------------------- (insert "document.writeln(doc_findindex);\n") (insert "document.writeln(doc_contents);\n") (insert "document.writeln(doc_details);\n")) (insert "document.writeln(detail_array[parent.mi]);\n") (insert "document.writeln(doc_tail);\n") (insert "document.close;\n") (insert "}\n\n")) ;; -- no script ------------------------------------- (goto-html-body) (if (or *jargon-monolithic* *jargon-menu-row-layout*) (progn (insert "<TABLE WIDTH=\"100%\" SUMMARY=\"Menu\"><TR>\n") (insert contents-string)(insert "\n\n") (insert (format "\n\n%s%s%s\n\n" detail-string (all-detailled-entries-plain detail-list) tail-string)) (insert findindex-string)(insert "\n\n") (insert "</TR></TABLE>\n\n")) ;; -- column layout ----------------------------- (insert findindex-string)(insert "\n\n") (insert contents-string)(insert "\n\n") (insert (format "\n\n%s%s%s\n\n" detail-string (all-detailled-entries-plain detail-list) tail-string)))) (basic-save-buffer) ;; -- ordinary alphabetical entries -------------------------------- (set-buffer buffer-jargon-text) (goto-html-jargon) ;; -- link the entries -- (while (search-forward-regexp "^[ \t]*:.*:" (point-max) t) ;; -- adjust linebreaks (: get deleted) --------- (shift-linebreaks-by 2) ;; -- insert name links ------------------------- (beginning-of-line)(search-forward ":") (backward-delete-char 1) (setq aux (point-marker)) (search-forward ":") (backward-delete-char 1) (kill-ring-save aux (point-marker)) (setq key (car kill-ring)) (insert "</B></A>") (beginning-of-line) (insert (format "<A NAME=\"%s\"></A><A CLASS=\"key\" HREF=\"#%s\" onMouseOver=\"window.status = '-> Beginning of letter %s'\"><B>" (fix-keyword key) (my-substring (my-capitalize-string key) 0 1) (my-substring (my-capitalize-string key) 0 1)))) (message "** name links inserted.") ;; -- insert internal hyperrefs ------------------------------------ (goto-html-jargon) (while (search-forward-regexp (format "{\\(;\\|[-%c+/a-zA-Z0-9 &\r\t\n\\'\\.!\\`]\\)*}" *linewrap-marker-char*) (point-max) t) (adjust-linebreak) ; (basic-save-buffer) ; (error "DONE") (setq tmp (point-marker)) (search-backward "{") (delete-char 1) (setq aux (point-marker)) (search-forward "}") (backward-delete-char 1) (kill-ring-save aux (point-marker)) (insert "</A>") (goto-char aux) (insert (format "<A CLASS=\"plain\" HREF=\"#%s\">" (fix-keyword (compress-whitespaces (car kill-ring)))))) (message "** internal hyperlinks to names inserted.") ;; -- turn plain text to HTML style (goto-html-jargon) (setq pos (point-marker)) ;; -- fix linewrap -------------------------------- (funcall global-replace (format "%c" *linewrap-marker-char*) linewrap-string) ;; ------------------------------------------------ (funcall global-replace " " "  ") (funcall global-replace " " "  ") (funcall global-replace "\n" "<BR>\n") (funcall global-replace-regexp "^ " " ") ;; -- insert tail ------------------------------------------- (goto-char (point-max)) (insert "</TT>\n<A href=\"http://validator.w3.org/check/referer\">") (insert "<IMG border=\"0\" ALIGN=\"RIGHT\" ") (insert (format "SRC=\"%svalid-html40.gif\" " *relative-graph-path*)) (insert "ALT=\"Valid HTML 4.0!\" HEIGHT=\"23\" WIDTH=\"60\"></A>\n") (insert (format "<HR><ADDRESS>Page maintained, but not edited, by <A CLASS=\"hyperlink\" HREF=\"MAILTO:%s?subject=jargon\">%s</A></ADDRESS>" *maintainer-email* *maintainer-name*)) (setq tmp (point-marker)) (insert global-tail-string) (goto-char tmp) (if *jargon-monolithic* null (kill-line)) (basic-save-buffer) (setq case-fold-search save-case-fold-search) (set-buffer source-buffer) (message "*** Computing Jargon: Done."))) ;; --------------------------------------------------------------------- (defun query-approval-default-n (string) (let ((approval (read-input (scon string "[N/yes]? ")))) (or (equal approval "yes") (equal approval "YES")))) (defun goto-html-body () "Jump to body tag in HTML document" (goto-char (point-min)) (search-forward "<body") (search-forward ">") (forward-char 1)) (defun goto-html-jargon () "Jump to the part in the HTML document, where the jargon is" (goto-char (point-min)) (search-forward "<tt>") (forward-char 1)) (defun goto-html-script () "Jump inside script tag in HTML document" (goto-char (point-min)) (search-forward "</script>") (search-backward "<") (previous-line 2) (insert "\n\n\n") (previous-line 2)) ;;; ////////////////////////////////////////////////////////////////// ;;; [6] Sub-Indices ;;; ////////////////////////////////////////////////////////////////// ;(defun all-detailled-entries-plain (list &rest thelevel) ; (list-to-string list)) (defun all-detailled-entries-plain (list &rest thelevel) (let ((res "")) (my-loop-for-e-in-do list (setq res (format "%s%s" res (all-detailled-entries-plain-aux e)))) res)) (defun all-detailled-entries-plain-aux (list &rest thelevel) "Returns a string reflecing all the main- and subindices in list." (let ((res "") (sub nil) (level (if (null thelevel) 0 (car thelevel)))) (my-loop-for-e-in-do list (if (stringp e) (progn (setq res (format "%s%s<FONT SIZE=\"-%d\"><A CLASS=\"key\" HREF=\"%s#%s\">%s</A></FONT><BR>" res (indent-string-for-level level) level (if *jargon-monolithic* "" (scon *file-prefix* "-text.html")) (fix-keyword e) e))) (setq sub e) (setq res (scon res (all-detailled-entries-plain-aux sub (+ 1 level)))))) res)) (defun all-detailled-entries-as-array (list) "Lists as array entries, omitting the main index name." (let ((res "")) (my-loop-for-e-in-do list (setq res (format "%s ,\"%s\"\n" res (my-replace-char (aref "\"" 0) "\\\"" ;; (list-to-string (cadr e)))))) (all-detailled-entries-plain-aux e 0))))) res)) (defun list-to-string (list) (let ((res "")) (cond ((listp list) (my-loop-for-e-in-do list (setq res (scon res (list-to-string e)))) (setq res (scon "( " res " )"))) ((stringp list) (setq res (scon res list))) (t (error "dont know how to write arg"))) res)) (defun indent-string-for-level (l) "Returns a string to reflect the indentation per level" (let ((res "")) (my-loop-for-i-from-to-do 1 l (setq res (scon res "   "))) res)) ;;; ////////////////////////////////////////////////////////////////// ;;; [7] Templates and Style Sheets ;;; ////////////////////////////////////////////////////////////////// (defun insert-html-template (title) "Inserts Skeleton of a HTML file with given title." (insert "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n") (insert "<HTML>\n") (insert "<HEAD>\n") (insert "\n") (insert (format"<TITLE>%s\n" title)) (insert (format"\n")) (insert (format "\n\n" (current-time-string))) (insert "\n\n") (insert "\n") (insert "\n") (insert (format "\n" *jargon-text-color* *jargon-plain-color* *jargon-visited-color*)) (insert "\n") (insert "\n") (insert "\n")) (defun insert-style-sheet () (interactive) (goto-char (point-min)) (search-forward "") (next-line 1) (beginning-of-line) (if (search-forward "" (point-max) t) (previous-line 2) (progn (insert "\n") (previous-line 3))) (beginning-of-line) ;; -- background properties ---------------------------------------------- (insert (format "BODY { background: %s ;\n" *jargon-background-color*)) (insert (format " color: %s ; }\n" *jargon-text-color*)) ;; -- links classes ------------------------------------------------------ (insert (format "a.key {text-decoration:none; color: %s; }\n" *jargon-caption-color*)) (insert (format "a.plain {text-decoration:none; }\n" )) (insert (format "a.hyperlink {text-decoration:none; color: %s; }\n" *jargon-hyperlink-color*)) (insert (format "a.key { text-decoration:none; color: %s ; }\n" *jargon-key-color*))) ;; ------------------------------------------------------------------------- (provide 'my-jargon) ;;; Local Variables: *** ;;; mode: lisp *** ;;; eval: (defun update-global-date () (let ((pos (point-marker))) (goto-char (point-min)) (if (search-forward-regexp "^VERSION_DATE=" (point-max) t) (progn (kill-line) (insert (format "\"%s\" ;" (current-time-string))) (basic-save-buffer) (message "** Version Date Updated."))) (goto-char pos))) *** ;;; eval: (defun new-global-hh-insert-disclaimer () (interactive) (insert-disclaimer) (update-global-date) (ksh-mode)(font-lock-mode) (local-set-key [f4] #'new-global-hh-insert-disclaimer)) *** ;;; eval: (progn (ksh-mode)(font-lock-mode) (local-set-key [f4] #'new-global-hh-insert-disclaimer)) *** ;;; comment-column:0 *** ;;; comment-start: ";;; " *** ;;; comment-end:"***" *** ;;; End: ***