__0100644000175100017510000001236510636323213011171 0ustar cymbalacymbala(sort-lines nil (point) (point-max)) 0__ 0__ GUIDE: 0__ GUIDE: Emacs-Time-stamp: "2007-06-20 15:13:31" 0__ GUIDE: (lb-mu-htmm-to-html "~/leninist.biz/en/faq.htmm") 0__ GUIDE: (lb-mu-spawn-titles-by-letter "a" t) 0__ GUIDE: (lb-mu-spawn-titles-by-letter lb-az t) 0__ GUIDE: Type 0__ GUIDE: Type everything; if names need to be separated, use <>. 0__ GUIDE: Use "." at end of fields. 0__ GUIDE: Use "=-=-=" to delete a field, e.g., /en/progmosc/1970/391lgt/. 0__ THANKS: Thanks to Jim Monty and InMagic file format (Phoenix Tech Ctr). 0___ 9 9 BIBLIO <> __WHO__ Not know for sure whether author(s) or editor(s). <> __AUTHOR__ <> __AUTHORS__ <> __AUTHORIZED_BY__ <> __WRITTEN_BY__ <> __CONTRIBS__ Contributors. <> __EDITOR__ <> __ED_CHIEF__ <> __EDITORS__ <> __ED_BOARD__ <> __ED_COMM__ <> __COMPILER__ <> __COMPILERS__ <> __INTRO_BY__ <> __SELECTED_BY__ <> __PREPED_BY__ <> __DESIGNER__ <> __DESIGNERS__ <> __PRODUCER__ <> __ILLUSTRATOR__ <> __TRANSL__ No translator: <<>>, e.g., en/1976/UFPAA244/. <> __PUBL__ Must have this before TITLE (see lb-db-__-from). <> __PUBL__ IP International Publishers <> __PUBL__ NPAPH Novosti Press Agency Publishing House <> __PUBL__ PROGMOSC Progress Publishers <> __PUBL__ SEE (lb-defvar.el) FOR REST. <> __REDACCION__ <> __REDACTORES__ <> __REDACTOR_JEFE__ _-_-_ Invisible line between body and footnote region. _=_=_ Visible line between body and footnote region. __*_*_*__ Three asterisks used as a pause between paragraphs. __*__ One asterisks used as a pause between paragraphs. __<*_*_*__ Left-aligned three asterisks (en/1976/HCFI758/). __AAAAAAAA__ __ABBREV__ UNAMBIG ("HNSU" =4): El en la. __ALPHA_LVL0__ Was _SECTION_LVL0_ to mark book end, before back matter. __ALPHA_LVL1__ Was __SECTION_LVL1__ __ALPHA_LVL2__ Was __SECTION_LVL2__ __ALPHA_LVL3__ Was __SECTION_LVL3__ __ALPHA_LVL4__ Was __SECTION_LVL4__ __APPEAR__ What it looks like (size, paper/hard, color). __BACK_MATTER__ __BACK_COVER__ __BINDTYPE__ Publication or binding type ("book") __BLEMISHES__ __CAPTION__ __CHECKS__ __CITY__ __COLUMN2__ __COPYRIGHT__ __COVER__ __ABORT__ tell Lisp script to abort/abend. __DATE__ __DEDICATION__ __DONE__ __DRAWING__ __DUST_NAME__ __DUST_JACKET__ __EDITION__ __EDITING_PAUSE__ too tired to finish bibliography or index. __EMAIL__ webmaster@leninist.biz __ENDNOTE_MARKER_STYLE__ __ERROR__ __FAKENAME__ __FEATURE__ __FIX__ __FIXED__ __FOOTNOTE_MARKER_SEQUENCE__ continuous __FOOTNOTE_MARKER_STYLE__ [*]+ __FOOTNOTE_MARKER_STYLE__ [*]+[)]? __FOOTNOTE_MARKER_STYLE__ [0-9]+ __FOOTNOTE_MARKER_STYLE__ nil __FORMULA_MISSING__ "/en/1990/MCS295/20060606/099.tx" __FRONT_MATTER__ __GOBLYGOOK_COMMENT__ __HARDTITLE__ Ambiguous title to abbreviate ("in" versus "In") __IMPORTANT__ __INSTITUTE__ __INSTITUTO__ __ISBN__ __LOGO__ __MANUAL_EDITS__ __MEANING__ __METHOD__ __MISSING__ __NEW_BOOKS__ __NOTES__ __NOTE__ (no pink index card.) __NOTE__ SOME KEYWORDS: __NOTE__ continued from page 99999. __NOTE__ footnote continued on page 99999. __NUMERIC_LVL1__ Was __CHAPTER_LVL1__ __NUMERIC_LVL2__ Was __CHAPTER_LVL2__ __NUMERIC_LVL3__ Was __CHAPTER_LVL3__ __NUMERIC_LVL4__ Was __CHAPTER_LVL4__ __OCR__ __ORDER__ On-line order. __ORG__ __OWNER__ Copy owner. __PAGES__ __PARAGRAPH_CONT__ "en/1971/SCSP287/20070518/199.tx" __PARAGRAPH_PAUSE__ "en/1975/PDC248/20070520/248.tx" __PRINTERS_P_999_COMMENT__ __PROCEEDINGS__ __PUBL_CITY__ __PUBL_NOTE__ __QUESTION__ __QUERY__ __REALNAME__ __REDDOT__ Red dot (ink), e.g., page 224 for copy in "/20050524/". __RUNNING_HEADER_LEFT__ __RUNNING_HEADER_RIGHT__ __RUNNING_HEADER__ Use when LEFT and RIGHT running headers same. __SCAN_TIFFS__ __SERIES__ __SOURCE__ __SPELL_CHECK__ __SUBTITLE2__ __SUBTITLEZ__ __SUBTITLE__ __TITLE__ __TO_DO__ __TYPE__ __UNIQID__ __VSPACE1__ Blank vertical space of height 1 line (see _b_b_b_). __WHERE_PAGE_NUMBERS__ __WHO_PG__ __YEAR__ __ZZZZZZZZ__ __b_b_b__ Three blanks (invisible), similar to __*_*_*__. dustjacket www.ABEBOOKS.com www.BIBLIO.com www.ICEHOUSEBOOKS.uk.com www.THEBOOKCELLAR.com _-defvar.el0100644000175100017510000000372410653162335012702 0ustar cymbalacymbala ;; Variables. ;; Emacs-Time-stamp: "2007-07-29 12:05:01" (setq file-stamp "Emacs-File-stamp: \"/home/ysverdlov/leninist.biz/_-defvar.el\"") (unless (featurep 'cl) (load "cl")) (unless (featurep 'cl-macs) (load "cl-macs")) ;; has "loop" (defalias 'cmn '_-compress-multiple-newlines) (defalias 'cms '_-compress-multiple-spaces) (defvar _-punct-from-keyboard ;; (_makunbound) (concat "[" "][}{><" ;; "]" must come first. "`~!@#$%^&*()_+=|" "\\" ":;\"',.?/" "]") "") (defvar _-whitespace-wM ;; (_makunbound) "[ \t\n\r]" "") (defvar _-whitespace-noM ;; (_makunbound) "[ \t\n]" "") (defvar _-^whitespace-wM ;; (_makunbound) "[^ \t\n\r]" "") (defvar _-^whitespace-noM ;; (_makunbound) "[^ \t\n]" "") (defvar _-whitespaces-wM ;; (_makunbound) (concat _-whitespace-wM "+") "") (defvar _-whitespaces-noM ;; (_makunbound) (concat _-whitespace-noM "+") "") (defvar _-^whitespaces-wM ;; (_makunbound) (concat _-^whitespace-wM "+") "") (defvar _-^whitespaces-noM ;; (_makunbound) (concat _-^whitespace-noM "+") "") (defvar _-usr_share_sgml_html_dtd_xml_1.0_*.ent ;; (_makunbound) (directory-files (if (file-exists-p "/usr/share/sgml/html/dtd/xml/1.0/") "/usr/share/sgml/html/dtd/xml/1.0/" ;; 2007.07.29 "/usr/share/xml/entities/xhtml/") t "^xhtml[-].*[.]ent") "") (defvar _-re-__ ;; (_makunbound) (concat "__" "\\([-*:A-Z_0-9]+\\)" "__") ;; ~/www.marxists.org/archive/lenin/howto/tx2html.el "*Regexp that matches __PLACE_HOLDER__") (defvar _-regexp-separator-para ;; (_makunbound) (concat "[\n]" "\\([ \t]*[\n]\\)+") "*Regexp that separates paragraphs (newline at beginning and end)") (defvar _-re-tab-use-_> "^[-_][>]$" "String used in index.tab files to mean use page number in next column") ;;; ------------------------------------------------------- (provide '_-defvar) ;;; ; _-sgml.el0100644000175100017510000005353710646226565012414 0ustar cymbalacymbala ;; Leninist.Biz! ;; Emacs-Time-stamp: "2007-07-14 13:09:25" (setq file-stamp "Emacs-File-stamp: \"/home/ysverdlov/leninist.biz/_-sgml.el\"") ;; ;; ;; ;; See also: "~/Lia/archive/lenin/howto/lia-sgml.el" ;; fix! ;; Need a function to convertion single-byte 8-bit ASCII to named entity. ;; (_-sgml-cdata-to-alphanumerics "Ab;cdé.") => "Abcde" ;; (_-sgml-cdata-to-alphanumerics ".internationalism—these") (defun _-sgml-cdata-to-alphanumerics (arg1str &optional arg2flag-punct) "Change cdata string ARG1 to simplest possible representation using 0-9, a-z, and A-Z to get something easy to type after '#' at end of URL. If optional ARG2 is non-nil, keep punctuation" (let (lb-str lb-assoc-value (lb-rc arg1str)) ;; Delete markup if necessary. (while (string-match "<[^>]+>" lb-rc) (setq lb-rc (replace-match "" nil nil lb-rc 0))) ;; 2006.12.07 ;; Delete ✏. (while (string-match "\\([&][#][0-9][0-9][0-9][0-9];\\)" lb-rc) (setq lb-rc (replace-match "" nil nil lb-rc 1))) ;; Change ϧ numeric entities to named entities. (setq lb-rc (_-sgml-entity-numeric-to-named lb-rc)) ;; Delete certain named entities. (while (string-match (concat "[&]\\(" ;; fix! ;; Set as variable. ;; Function to turn list into parens. "quot" "\\|" "l[sd]quo" "\\|" "r[sd]quo" "\\|" "ls?aquo" "\\|" "rs?aquo" "\\)[;]") lb-rc) (setq lb-rc (replace-match "" nil nil lb-rc 0))) ;; Change named entities to single alphas. (while (string-match "[&]\\([a-zA-Z]\\)[a-zA-Z]+[;]" lb-rc) (setq lb-rc (replace-match (match-string-no-properties 1 lb-rc) nil nil lb-rc 0))) (if (not arg2flag-punct) ;; Then, delete punctuation. (while (and (string-match _-punct-from-keyboard lb-rc) t) (setq lb-rc (replace-match "" nil nil lb-rc 0)))) ;; lb-rc)) ;; (_-sgml-entity-numeric-to-named) ;; (nth 1 (assoc "192" _-sgml-lat1)) => "Agrave" ;; (_-sgml-entity-numeric-to-named "Bürger!") (defun _-sgml-entity-numeric-to-named (&optional arg1str) "" (let (_-str _-assoc-value _-rc) (if (not (boundp '_-sgml-lat1)) ;; (makunbound '_-sgml-lat1) (with-temp-buffer (defvar _-sgml-lat1 nil "") (loop for file in _-usr_share_sgml_html_dtd_xml_1.0_*.ent do (_-ifcl file)) (goto-char (point-min)) (while (search-forward-regexp (concat "") nil t) (_-app '_-sgml-lat1 (list (list (match-string-no-properties 2) (match-string-no-properties 1))))))) (if (setq _-rc arg1str) (while (and (string-match "[&][#]\\([0-9][0-9][0-9]+\\);" _-rc) (setq _-str (match-string-no-properties 1 _-rc))) (if (setq _-assoc-value (assoc _-str _-sgml-lat1)) (setq _-rc (replace-match (concat "&" (nth 1 _-assoc-value) ";") nil nil _-rc 0)) (error "%s: %s" (concat _-str " not found") (prin1-to-string _-sgml-lat1))))) _-rc)) (_-sgml-entity-numeric-to-named) ;; Initialize _-sgml-lat1 ;; See: (apropos "_-sgml.*-p") (defun _-sgml-comment-p nil "Is point to right of '' ? SEE ALSO _-sgml-markup-p" ;; (let ( _-flag) (save-match-data ;; fix! ;; BY DEFINITION: ;; treat CDATA inside a SPAN with attribute "sic" as a comment! ;; ;; ''estimable'' (save-excursion ;; comment beginning. 2006.09.09. (if (looking-at "[!]?\\([-]+\\)[^>]") (goto-char (match-end 1))) ;; comment ending. 2006.09.09. (while (looking-at "[-]?[>]") (forward-char -1)) (when (search-backward-regexp "[-][-]" nil t) (forward-char -2) (if (and (looking-at "" nil t)) (setq _-flag t))))) _-flag)) (defun _-sgml-scrub nil "Scrub SGML (some <> markup in non-authorish fields (en/1969/LCIA337)" (save-match-data (let (_-rc) (save-excursion (goto-char (point-min)) (while (search-forward-regexp "<<" nil t) (replace-match "")) (goto-char (point-min)) (while (search-forward-regexp ">>" nil t) (replace-match "")))))) ;; See: (apropos "_-sgml.*-p") ;; (_-sgml-cdata-p) (defun _-sgml-cdata-p nil ">...(point)...< returns tagname. <...(point)...> returns nil" (let (_-left _-right _-tagname _-str _-rc) (save-match-data (setq _-left (save-excursion (search-backward-regexp "[><]") (setq _-str (match-string-no-properties 0)) (when (string= ">" _-str) (search-backward "<") (if (looking-at "<\\([a-zA-Z]+\\)") (setq _-tagname (match-string-no-properties 1)))) _-str)) (setq _-right (save-excursion (search-forward-regexp "[><]") (match-string-no-properties 0))) (if (and (not (_-sgml-comment-p)) (string= _-left _-right)) (error "%s: %s" "Expecting pair" (concat _-left " ... " _-right "\n" (_-buffer-substring-from-) ))) ) (setq _-rc (if (string= ">" _-left) _-tagname)) _-rc)) (defun _-sgml-del-markup (&optional arg1str) "Delete all SGML markup in buffer. If ARG1 is a string, return it after deleting all markup." ;; (let ( _rc) (save-match-data (save-excursion (defun foo nil "" (goto-char (point-max)) (while (search-backward-regexp ""))))) (if (not arg1str) (foo) (with-temp-buffer (insert arg1str) (foo) (setq _rc (buffer-string)))))) _rc)) ;; (_-sgml-str-del-tags "a b
c d
e f
" (list "bR")) (defun _-sgml-str-del-tags (arg1str arg2list) "Delete markup tags (open and close) in list ARG2 from string ARG1" ;; (let (_pt _list _tagname _tag _alternator _rc) (save-match-data (with-temp-buffer (setq _list arg2list) (insert arg1str) (while _list (setq _tagname (car _list)) (setq _list (cdr _list)) (setq _alternator (concat "\\(" (downcase _tagname) "\\|" (upcase _tagname) "\\|" _tagname "\\)")) (goto-char (point-max)) (while (search-backward-regexp (concat "<" _alternator) nil t) (setq _tag (buffer-substring-no-properties (point) (setq _pt (save-excursion (search-forward-string ">"))))) (delete-region (point) _pt) (when (not (string-match "/[ \t]*>" _tag)) (search-forward-regexp (concat ""))))) (setq _rc (buffer-string)))) _rc)) ;; (defun _-sgml-del-tag (&optional arg1both) "If inside SGML markup tag, delete it." ;; (let (_pt-beg _pt-end _rc) (when (_-sgml-markup-p) (save-match-data (save-excursion (if (not (search-backward-string "<" nil t)) (error "%s: %s" "buffer" (_-buffer-substring-from-))) (if (not (search-forward-regexp "[^>]+>" nil t)) (error "%s: %s" "buffer" (_-buffer-substring-from-))) (setq _pt-beg (match-beginning 0)) (setq _pt-end (match-end 0)) ;; 2007.07.14 ;; (replace-match "") (kill-region _pt-beg _pt-end) (setq _rc (- _pt-end _pt-beg))))) _rc)) ;;; 2006.09.22 MOVED FROM tx2html.el (end of each defun is marked): ;;; 2007.01.29 MOVED FROM lia-sgml.el (end of each defun is marked): ;;; ;;; 6 lines matching "defun" in buffer foo. ;;; 1:(defun _-sgml-where-open (&optional arg1flag) ;;; 77:(defun _-sgml-what-element nil ;;; 86:(defun _-sgml-move-to-start-tag nil ;;; 99:(defun _-sgml-attr-mod (arg1attr &optional arg2value) ;;; 113:(defun _-sgml-attr-grab (arg1attr &optional arg2<) ;;; 139:(defun _-sgml-condition (t2h-specs) (defun _-sgml-where-open (&optional arg1flag) ;; UTILITY "Where does current SGML element begin? . Optional ARG1, if non-nil, asks where element ends" ;; fix! ;; If "" missing, this function thinks "

" is end of "" !!! ;; ;; Try this with point in tag below: (goto-char (_-sgml-where-open t)) ;; Journal of the Royal Statistical Society,

;; ;; In general, return error when looking for close-tag of an inline ;; element and close-tag for block-level element is found first. (let (t2h-bound (t2h-n-open 1) (t2h-point-original (point)) flag t2h-point t2h-pointb t2h-tagname (_-sgml-where-open-counter 0) (t2h-what-we-got-log "~/t2h-what-we-got") (_-sgml-where-open-counter-max 160) ;; cw/volume08.htm ;; Why max. of 160? Since text files do not have ;; tags like "", the opening tag will never be ;; far away. ) (if (file-exists-p t2h-what-we-got-log) (delete-file t2h-what-we-got-log)) (save-excursion ;; If inside close tag, move to left of "<". ;; If inside open tag, move to right of ">". ;; fix? See if end tag has same tag name as start tag. ;; fix! If inside comment?? When would that happen ?!?!?! (save-excursion (setq t2h-point (point)) (when (not (search-backward-regexp "[><]" nil t)) (write-region (point-min) (point-max) t2h-what-we-got-log) (error "%s: %s" (number-to-string (point)) (t2h-what-we-got))) ;; If inside a tag that does not have close tag, use it. (if (looking-at (concat "<" t2h-regexp-sgml-tags-solo "[^a-z]")) (progn (setq t2h-n-open 0) (setq t2h-point (point))) ;; Skip over tags that do not have close tags. (while (and (looking-at ">") (string-match (concat "^" t2h-regexp-sgml-tags-solo "$") (save-excursion (search-backward-regexp "<\\([a-z]+\\)[^a-z]") (match-string 1)))) (search-backward "<") (search-backward-regexp "[><]" nil t)) (if (looking-at t2h-regexp-close-tag) ;; inside close tag. (setq t2h-point (point)) (if (looking-at t2h-regexp-open-tag) ;; inside open tag. (setq t2h-point (search-forward ">"))))) t2h-point) (goto-char t2h-point) (while (> t2h-n-open 0) (setq _-sgml-where-open-counter (1+ _-sgml-where-open-counter)) (if t2h-flag-loop-message (t2h-log "WHILE _-sgml-where-open" nil t)) ;; Move back to first "<" that does not start a comment, or ;; move forw to first ">" that does not end a comment. (_-sgml-search-bk<-fw>-nocomment arg1flag t) (save-excursion (if arg1flag (search-backward "<")) ;; Prevent call to error below: ;; Ignore
  • , e.g., volume 12, The Fifth Congress. ;; Ignore , e.g., volume 11, 1906/dissolut/index. (if (looking-at (concat "<[/]?" "\\(li\\|code\\)" "[ \t\n>]")) (setq _-sgml-where-open-counter (1- _-sgml-where-open-counter))) (if (looking-at t2h-regexp-close-tag) (setq t2h-n-open (if arg1flag (1- t2h-n-open) (1+ t2h-n-open))) ;; Tags like "
    " were skipped by above _-sgml-search (setq t2h-n-open (if arg1flag (1+ t2h-n-open) (1- t2h-n-open))))) (when (= _-sgml-where-open-counter-max _-sgml-where-open-counter) (error "%s" (t2h-log (concat "Unable to determine what element: " "_-sgml-where-open: " (t2h-what-we-got 0 100)) nil t2h-point-original)))) (point)) )) ;; 2006.09.22 MOVED (defun _-sgml-what-element nil ;; UTILITY "" (let (t2h-letx) (save-match-data (save-excursion (goto-char (_-sgml-where-open)) (search-forward-regexp "\\([a-zA-Z0-9]+\\)[^a-zA-Z0-9]") ;; Greedy. (match-string 1))) )) ;; 2006.09.22 MOVED (defun _-sgml-move-to-start-tag nil ;; UTILITY "Move to start of element, return position" ;; fix! should give same answer as _-sgml-where-open ! ;; (let ((t2h-element (_-sgml-what-element))) ;; If point in tagname, move past it. (if (looking-at "[a-zA-Z0-9]+") (search-forward-regexp "[a-zA-Z0-9]+.") ;; If looking at white space, move past first whitespace character. (if (looking-at "[> \t\n]") (forward-char 1))) (search-backward-regexp (concat "<" t2h-element "[> \t\n]")) t2h-element)) ;; 2006.09.22 MOVED (defun _-sgml-attr-mod (arg1attr &optional arg2value) "Modify or add an attribute in/to current SGML element. Optional ARG2 is new value of attribute (if nil, then delete attribute)" (let (t2h-letx) (save-excursion (if (and (and (search-backward "<") (search-forward-regexp "<[a-zA-Z]+")) (not (_-sgml-attr-grab arg1attr))) (insert (concat " " arg1attr "=\"" arg2value "\"")) (if (search-forward-regexp (concat "[ \t\n]+" arg1attr "=.\\([^\"]+\\).") nil t) (if arg2value (replace-match arg2value t t nil 1) (replace-match ""))))) )) ;; 2006.09.22 MOVED (defun _-sgml-attr-grab (arg1attr &optional arg2<) ;; UTILITY "Get SGML-TOC attribute's value for element at point. Optional ARG2 if non-nil will move forward-char 1 if looking-at \"<\". SEE ALSO: (sgml-element-attr-specification-list (sgml-find-attr-element))" (let (t2h-bound t2h-point t2h-rc) (save-match-data (save-excursion (if arg2< (if (looking-at "<") (forward-char 1))) (goto-char (setq t2h-point (_-sgml-where-open))) (setq t2h-bound (search-forward ">")) (goto-char t2h-point) (if (search-forward-regexp (concat arg1attr "=[\"]\\([^\"]+\\)[\"]") t2h-bound t) (setq t2h-rc (match-string-no-properties 1)) (if (search-forward-regexp (concat arg1attr "=[\']\\([^\']+\\)[\']") t2h-bound t) (setq t2h-rc (match-string-no-properties 1))))) ;; Remove suffix from name= value. ;; * 207. (if (not t2h-rc) nil (if (string= "name" arg1attr) (progn (string-match "[^.]+" t2h-rc) (setq t2h-rc (match-string-no-properties 0 t2h-rc)))))) t2h-rc)) ;; 2006.09.22 MOVED (defun _-sgml-condition (t2h-specs) ;; UTILITY "" (let ((t2h-return-value t)) (setq debug-on-error t) ;; (setq t2h-specs '(("parent" (("tagname" . "editor") ("attribute" ("role" . "Translated_by")))))) ;; ;; (setq type '("parent" (("tagname" . "editor") ("attribute" ("role" . "Translated_by"))))) ;; ;; (setq t2h-specs '(("tagname" . "editor") ("attribute" ("role" . "Translated_by")))) ;; (setq type '("tagname" . "editor")) ;; (setq type '("attribute" ("role" . "Translated_by"))) ;; (loop for type in t2h-specs do (when (equal "parent" (car type)) (save-excursion ;; This is a recursive function. (progn (_-sgml-move-to-start-tag) (_-sgml-move-to-start-tag)) (forward-word 1) (setq t2h-return-value (_-sgml-condition (nth 1 type))))) (when (equal "tagname" (car type)) (setq t2h-return-value (and t2h-return-value (equal (_-sgml-what-element) (cdr type))))) (when (equal "attribute" (car type)) (setq t2h-return-value (and t2h-return-value (equal (_-sgml-attr-grab (nth 0 (nth 1 type))) (cdr (nth 1 type))))))) t2h-return-value)) ;; 2006.09.22 MOVED (defun _-sgml-element-del (arg1 &optional arg2which arg3flag-del-not) "Delete the start/end tag, or the whole element, at point. If deleting just a tag, tag must be at point. If deleting an element (ARG2 is nil), Optional ARG2 will delete just 'start'/'beg' or 'end' tag. Optional ARG3, if non-nil, will return REGEXP without deleting" ;; (let (h2t-letx _-re _-sfr-re (_-str-end-beg "<[ \t\n]*/[ \t\n]*") (_-str-start-beg "<[ \t\n]*") (_-str-end-end "[ \t\n]*>") _rc) ;; 2006.09.11 ;; (save-excursion (setq _-sfr-re (case (if (null arg2which) 1 (if (or (string= "beg" arg2which) (string= "start" arg2which)) 2 (if (string= "end" arg2which) 3 ))) (1 ;; Point in start tag of element ARG1? (_-sgml-element-del arg1 "beg" t) (_-sgml-element-del arg1 "end" t) ) (2 (progn (setq _-re (concat _-str-start-beg arg1 _-str-end-end)) (save-excursion (if (not (looking-at "<")) (search-backward "<")) (if (not (looking-at _-re)) (error "%s: %s" "Not looking-at" _-re))) _-re)) (3 (progn (setq _-re (concat _-str-end-beg arg1 _-str-end-end)) ;; Not needed by case 1. (when (not arg3flag-del-not) (save-excursion (if (not (looking-at "<")) (search-backward "<")) (if (not (looking-at _-re)) (error "%s: %s" "Not looking-at" _-re))) ) _-re)) (t (error "%s: %s" "Invalid ARG" (prin1-to-string arg1))))) (when (not arg3flag-del-not) (if (not (looking-at "<")) (search-backward "<")) (delete-region (point) (search-forward-regexp _-sfr-re (cdr (_-where-double-newlines)) ;;nil ))) (setq _rc (if arg3flag-del-not _-sfr-re)) )) ;; See: (apropos "_-sgml.*-p") (defun _-sgml-markup-p nil "Is point to right of '<' and to left of '>' ? SEE ALSO _-sgml-comment-p" ;; (let (_-flag) (if (_-sgml-comment-p) (setq _-flag t) (save-excursion (save-match-data (if (search-backward-regexp "[><]" nil t) (if (string= "<" (match-string-no-properties 0)) (setq _-flag t)))))) _-flag)) (defun _-sgml-search-bk<-fw>-nocomment (&optional arg1flag arg2flag) ;; UTILITY "Search backward for first '<' that does NOT start a comment. . Optional ARG1, if non-nil, searches forward for first '>'. Optional ARG2, if non-nil, ignores tags in t2h-regexp-sgml-tags-solo" (let (t2h-point (flag t) (t2h-point-start (point))) (while flag (if t2h-flag-loop-message (t2h-log "WHILE _-sgml-search-bk<-fw>-nocomment" nil t)) (unless (if arg1flag (setq t2h-point (search-forward ">" nil t)) (setq t2h-point (search-backward "<" nil t))) (write-region (point-min) (point-max) "~/.error") (error "%s" (t2h-log (concat (if arg1flag "BOTTOM" "TOP") " OF FILE: _-sgml-search-bk<-fw>-nocomment from " (number-to-string t2h-point-start) ": " "\n" (t2h-what-we-got 0 100)) t t))) (if (not arg1flag) (unless (looking-at ">>")) (buffer-substring-no-properties arg1from lb-end))))) _rc)) ;; fix! this is pointless! words already joined! ;; (_-join-hyphenated-words) (defun _-join-hyphenated-words (&optional arg1) "Wait a second! Words already joined in source .tx file for spell-check reasons! Does while loop over whole buffer. This does what crstrip.awk used to do in lb-tx-make-or-refresh-indextx. Optional ARG1, if non-nil, does not move point to top of current buffer before joining. Before using this function, convert '--' to endash" (let (_-pt _-flag-pg-num-para _-flag-^M-dash-9 _-flag-^M-dash-sic _-str-looking-back _-flag-ws-^M-before _-flag-ws-^M-after _-flag-hyphen (_-n-looking-back 10) _-pt _-pt-beg _-pt-end _-rc) ;; fix! ;; How to delete whitespace if mdash is on SECOND line? ;; EXAMPLE: ;; ~/leninist.biz/en/1970/LGT391/20060322/391.tx ;; and steadily increase capital investments in agriculture, etc., ^M ;; ---all these steps are the visible and practical realisation of Lenin's ;; fix! ;; Must move footnotes out of way before joining words split by page ;; break. ;; fix? ;; # fix! Does not seem to work... viewing index.txt in Opera shows ;; # space at beginning of line (the space after "^M"). ;; fix! ;; How to join words split between pages? ;; fix! ;; Page number "8" is in middle of word: on the con8 trary, ;; ~/leninist.biz/en/0000/LTRSP88/20060216/088.tx ;; trary, at once begin to combat these instincts. ;; fix! ;; Change "--" to "-" for hyphenated words, like, "working-class"? (if (not arg1) (goto-char (point-min))) (while (and (search-forward-regexp "[\r]" nil t) (setq _-pt-end (match-end 0)) (setq _-pt-beg (match-beginning 0))) (when (and ;;; "~/leninist.biz/en/1984/AP470/20050704/399.tx" ;;; above fundamental theories both in the macro- ^M-0 ;;; and microworlds. Nonetheless, it is rather a ^M (not (looking-at "[-][0]")) ;;; ;;; headed by Joseph McCarthy was particularly zealous in this witch-- ^M ;;; ;;; __NOTE__ Footnote continued on page 184. ;;; ;;; __NOTE__ Footnote continued from page 183. ;;; ;;; hunt. The purge instituted by this commission is one of the most ^M (not (looking-at ;; fix! ;; Delete __NOTE__ first *and* allow blank line. ;; Next line cannot be blank. (concat "[ \t\r]*" "[\n]" "[ \t\r]*" "[\n]"))) ;; Move back over ^M. (goto-char _-pt-beg) ) ;; Move back over whitespace. (if (not (_-move-backward-whitespace t nil)) (error "%s: %s" "Expecting whitespaces" (_-buffer-substring-from- nil 200))) ;; Grab 10 characters. (setq _-str-looking-back (buffer-substring-no-properties (- (setq _-pt (point)) _-n-looking-back) _-pt)) ;; Look for hyphen-like thing. (if (not (setq _-flag-hyphen (cond ((string= "-=" (substring _-str-looking-back (- _-n-looking-back (length "-=")))) "-=") ;; Must come before "--". ((string= "---" (substring _-str-looking-back (- _-n-looking-back (length "---")))) "---") ((string= "--" (substring _-str-looking-back (- _-n-looking-back (length "--")))) "--") ((string= "–" (substring _-str-looking-back (- _-n-looking-back (length "–")))) "–") ;; Must come after "--", such as, last. ((string= "-" (substring _-str-looking-back (- _-n-looking-back (length "-")))) "-"))) ) ;; Did not find something to change: move past ^M for next iteration. (goto-char _-pt-end) ;; Invalid txup (markup) (2006.03.28). (if (and (string= _-flag-hyphen "-=") (string= "--=" (substring _-str-looking-back (- _-n-looking-back (length "--="))))) (error "%s: %s" "Cannot use equal-sign in --= ^M" (_-current-line))) ;; Change hyphen. (cond ((or (string= _-flag-hyphen "–") (string= _-flag-hyphen "---") (string= _-flag-hyphen "--")) ;; Do nothing, as permanent hyphen changed: "-- ^M" (to) "-= ^M". nil) ((or (string= _-flag-hyphen "-=") (string= _-flag-hyphen "-")) ;; Delete "=" to retain permanent hyphen. ;; Delete "-" to delete real hyphen. (delete-char -1)) ) ;; cond ;; Delete whitespaces in middle of word, including ^M. (if (not (looking-at _-whitespaces-wM)) (setq _-flag-ws-^M-before nil) (setq _-flag-ws-^M-before (match-string-no-properties 0)) (replace-match "")) ;; fix? ;; If this only joins hyphenated words, DO NOT delete -9 and -sic. ;; Store "-9" after "^M-9". (if (not (looking-at "[-][0-9]+")) (setq _-flag-^M-dash-9 nil) (setq _-flag-^M-dash-9 (match-string-no-properties 0)) (replace-match "")) ;; Store "-sic" after "^M-9-sic". (if (not (looking-at "[-]sic")) (setq _-flag-^M-dash-sic nil) (setq _-flag-^M-dash-sic (match-string-no-properties 0)) (replace-match "")) ;; Delete whitespaces after ^M-9-sic, and before "\n\n999\n\n". (if (not (looking-at "[ \t]+")) (setq _-flag-ws-^M-after nil) (setq _-flag-ws-^M-after (match-string-no-properties 0)) (replace-match "")) ;; Store page number (was word split between pages?). (if (not (looking-at lb-re-bracketed-para-integer)) (setq _-flag-pg-num-para nil) (setq _-flag-pg-num-para (match-string-no-properties 0)) (replace-match "")) ;; Skip over 2nd half of hyphenated word. (search-forward-regexp _-^whitespaces-noM) ;; Put ^M and newline back. ;; fix? Why put dash-9 integer back? ;; Results in triple space in output when: ;; (1.) hyphenation removed. ;; (2.) carriage return converted to single space. (insert (concat _-flag-ws-^M-before _-flag-^M-dash-9 _-flag-^M-dash-sic _-flag-ws-^M-after _-flag-pg-num-para)) ;; fix? ;; Why "toss out leading whitespace at beginning of line" ? (when nil ;; Toss out leading whitespace at beginning of line (if (looking-at "[ \t]+") (replace-match ""))) ))) _-rc)) ;; (boundp 'anythinggoes) ;; (_-just-say-nil 'anythinggoes) ;; (boundp 'anythinggoes) ;; anythinggoes ;; (makunbound 'anythinggoes) ;; (setq anythinggoes "foobarfb") ;; (_-just-say-nil 'anythinggoes) (defun _-just-say-nil (arg1symbol &optional arg2init) "If not bound, set symbol ARG1 to nil and return nil. Otherwise return its value. Useful when debugging a function and symbol ARG1 is set to nil by let. Most variables set to nil by let. Optional ARG2 is an initial value other than nil. Use this function if a variable is set by let to avoid 'void-variable' error while testing pieces inside let. Wrap first usage of variable with this function" (let ( _-rc) (setq _-rc (if (boundp arg1symbol) (eval arg1symbol) (set arg1symbol (if arg2init arg2init nil)))) _-rc)) ;; (_-blank-line-p nil) (defun _-blank-line-p (&optional arg1flag) " Optional ARG1, if non-nil, includes carriage returns as whitespace" ;; (let ( lb-rc) (save-match-data (save-excursion (if (not (string-match ;; 2007.07.17 ;; (concat "[^ \t" (if arg1flag "\r") "]") (if (not arg1flag) _-^whitespace-noM _-^whitespace-wM) (buffer-substring-no-properties (progn (beginning-of-line) (point)) (progn (end-of-line) (point))))) (setq lb-rc t)))) lb-rc)) ;; fix! ;; Make ARG1 a string so \r and/or ~ can be appended to regexp. (progn (defun _-move-forward-whitespace (&optional arg1flag-CR arg2jumpover) "Calls _-move--whitespace ARG1: include carriage returns as whitespace. ARG2: ignore adjacent non-whitespace" (interactive) (_-move--whitespace "f" arg1flag-CR arg2jumpover)) (defun _-move-backward-whitespace (&optional arg1flag-CR arg2jumpover) "Calls _-move--whitespace ARG1: include carriage returns as whitespace. ARG2: ignore adjacent non-whitespace" (interactive) (_-move--whitespace "b" arg1flag-CR arg2jumpover)) ;; fix! ;; Allow ARG1 to be a string so \r and/or ~ can be appended to regexp. ;; (_-move--whitespace "f" nil nil) ;; (_-move--whitespace "f" t nil) ;; (_-move--whitespace "b" nil nil) ;; (_-move--whitespace "b" t nil) (defun _-move--whitespace (&optional arg0dirn arg1flag-CR arg2flag) "Similar to skip-chars-forward. Returns point instead of number of characters skipped. Optional ARG1, if non-nil, will include carriage returns as whitespace. Optional ARG2, if non-nil, will skip over adjacent whitespace even if point is not currently adjacent to a whitespace" ;; (let (_-pt (_-pt-beg (point)) _re-ws _rc) ;; fix! skip-chars-backward is a built-in function. (save-match-data (setq _re-ws (if arg1flag-CR _-whitespaces-wM _-whitespaces-noM)) (cond ;; Point in middle of ^M-9 ??? ((string= "f" arg0dirn) ;; Move forward to end regardless of ARG1. (if (and t (or (and (looking-at "[-][0-9]+") (setq _pt (match-end 0)) (looking-at-backward-become-forward "[\r]")) (and (looking-at "[0-9]+") (setq _pt (match-end 0)) (looking-at-backward-become-forward "[\r][-]")))) (or (goto-char _pt) t ;; Do undo the looking-at-backward-become-forward!! ))) ((string= "b" arg0dirn) ;; Move backward to beginning if ARG1 is non-nil. ;; If ARG1 is nil, all of "^M-9" is treated as non-whitespace. (if (and arg1flag-CR (or (and (looking-at "[-][0-9]+") (setq _pt (match-end 0)) (looking-at-backward-become-forward "[\r]")) (and (looking-at "[0-9]+") (setq _pt (match-end 0)) (looking-at-backward-become-forward "[\r][-]")) (and t (setq _pt (point)) (looking-at-backward-become-forward "[\r][-][0-9]+")))) (or t ;; Do *NOT* undo the looking-at-backward-become-forward ! (goto-char _pt) ))) (t (error "%s: %s" "Not 'b' or 'f'" arg0dirn))) (cond ;; Use ARG2 to cheat? ((string= "f" arg0dirn) (when (and arg2flag (not (looking-at _re-ws))) (sfr _re-ws) ;; May need to skipover "-9" after "^M". (goto-char (match-beginning 0)))) ;; ((string= "b" arg0dirn) (when (and arg2flag (not (looking-at-backward-become-forward _re-ws))) (sbr _re-ws))) (t t)) (cond ;; MAIN. ((string= "f" arg0dirn) (while (looking-at _re-ws) (setq _rc (goto-char (match-end 0))) ;; If ARG1 is t, point may be inbetween "^M" and "-9". (if (and arg1flag-CR (looking-at-backward-become-forward "[\r]")) (if (looking-at "[\r][-][0-9]+") (setq _rc (goto-char (match-end 0))) (error "%s: %s" "Expecting -9" "after carriage-return"))))) ;; ((string= "b" arg0dirn) (while (looking-at-backward-become-forward _re-ws) (setq _rc (point)) (and arg1flag-CR (looking-at-backward-become-forward "[\r][-][0-9]+") ;; fix? Why cannot looking-at* return point instead of 't'? (setq _rc (point))))) (t t)) ) _rc)) );progn ;; (_-del-parens lb-re-bracketed-integer) => "[[]?[0-9]+[]]?" (defun _-del-parens (arg1str) "" (let ((_-rc arg1str)) (while (string-match "[\\][)(]" _-rc) (setq _-rc (replace-match "" nil nil _-rc))) _-rc)) (defun _-trailing-whitespacep (&optional arg1n2check arg2noninteractive) "Check buffer for trailing whitespace at end of lines. Does not check for trailing newline at end of lines (meaningless). ARG1 is number of characters to check surrounding point, maybe less if number of characters above/below point is less than half of ARG1. ARG2 is flag that should be non-nil when called non-interactively" ;; (interactive "p") ;; If no prefix argument, ARG1 will be 1. (let (_-rc _-pt-above _-pt-below (_-pt (point))) (if (or (not arg1n2check) (= 1 arg1n2check)) (setq arg1n2check 2000)) (save-match-data (save-excursion (forward-char (- 0 (min (/ arg1n2check 2) (- (point) (point-min))))) (setq _-pt-above (point)) (setq _-rc (if (search-forward-regexp "[ ]$" ;; space and tab, not newline. (setq _-pt-below (+ (point) (min arg1n2check (- (point-max) (point))))) t) t nil)))) (if arg2noninteractive _-rc (message "%s" (concat (if _-rc "YES" "NO") ": Trailing whitespace found?" " (checked " (int-to-string (- _-pt _-pt-above)) "/" (int-to-string (- _-pt-below _-pt)) " " "characters above/below)."))))) ;; (setq _rc "EDITIONS: en-2000 es-9999") ;; (setq _cons (cons 123 321)) ;; (_-app '_rc _cons) (defun _-app (arg1sym arg2item) "Append non-list ARG2 to symbol ARG1 where ARG1 is a list" ;; (let ( _-rc-_-app) (set arg1sym (append (symbol-value arg1sym) (setq _-rc-_-app (if (or (listp arg2item) (consp arg2item)) arg2item (list arg2item))))) _-rc-_-app)) (defun _-exchange-symbol-values (arg1sym arg2sym) "" ;; (progn (setq a "a") (setq b "b") (_-exchange-symbol-values 'a 'b)) (let (_-1 _-2) (setq _-1 (symbol-value arg1sym)) (setq _-2 (symbol-value arg2sym)) (set arg1sym _-2) (set arg2sym _-1) nil)) (defun _-force-new-file (arg1pf) "Find a file, deleting it beforehand if it exists" ;; (let (_buff _rc) ;; fix? use _-ifcl? (if (setq _buff (find-buffer-visiting arg1pf)) (kill-buffer _buff)) (if (file-exists-p arg1pf) (delete-file arg1pf)) (find-file-literally arg1pf) (set-buffer-modified-p t) _rc)) ;; fix! ;; Change to _-let-hook and use return value (same as arg) to set lb-dfun. ;; (_-dfun-hook "lb-mu-spawn-taz-") (defun _-dfun-hook (arg1 &optional arg2) "Sets _-defun to ARG1. Messages string ARG1 if lb-debug is true. Optional ARG2, if non-nil, writes contents of buffer to /tmp/.input-to--" ;; (let ( (_-rc arg1)) (save-excursion (save-match-data (setq _-defun arg1) (setq _defun arg1) ;; Switching from _-rc to _rc (etc.). (if lb-debug (message (concat "INVOKING: " arg1))) (if arg2 (write-region (point-min) (point-max) (concat (temp-directory) "/.input-to--" _defun))) )) _-rc)) (defun _-dfun-hook-set (arg1p) "Interactive function to ensure argument to _-dfun-hook is same as defun name" ;; (interactive "p") (let (_-str) (save-excursion (goto-char (point-min)) (while (search-forward-regexp "(_-dfun-hook \"\\([^\" \t\n]*\\)\")" nil t) (replace-match (save-excursion (save-match-data (search-backward-regexp "[(]defun \\([^ \t\n\r]+\\)") (match-string 1))) t t nil 1))))) (defun _-just-one-whitespace (&optional arg1flag) ;; UTILITY "Delete all spaces and tabs AND NEWLINES around point, leaving one space. Optional ARG1, if non-nil, includes carriage returns as whitespace" ;; (1.) Function "fixup-whitespace" does not treat NEWLINE as whitespace. ;; (2.) Just like function just-one-space, with "\n" inserted twice below: ;; ;; ~/www.marxists.org/archive/lenin/howto/tx2html.el (interactive "*") (skip-chars-backward (concat " \t\n" (if arg1flag "\r"))) (if (= (following-char) ? ) (forward-char 1) (insert ? )) (delete-region (point) (progn (skip-chars-forward (concat " \t\n" (if arg1flag "\r"))) (point)))) (defun _-normalize-whitespace (arg1str &optional arg1flag) "Normalize whitespace in string ARG1 Optional ARG1, if non-nil, includes carriage returns as whitespace" ;; ~/www.marxists.org/archive/lenin/howto/tx2html.el ;; (defun _-sgml-normalize-element ;; (let (_-str) (with-temp-buffer (progn (insert arg1str) (goto-char (point-min))) (while (< (point) (point-max)) (if (looking-at (if arg1flag _-whitespace-wM _-whitespace-noM)) (_-just-one-whitespace arg1flag) (forward-char 1))) (progn (goto-char (point-min)) (if (looking-at " ") (replace-match ""))) (progn (goto-char (point-max)) (if (< (skip-chars-backward " ") 0) (delete-region (point) (1+ (point))))) (setq _-str (buffer-string))) _-str)) ;; (_-para) -> (";; (_-para) " 7646 . 7658) ;; (_-para t nil) ... strip leading + trailing blanks. (defun _-para (&optional arg1trim arg2trim arg3trim__) "Return cons cell with text of current paragraph and a cons cell with point boundaries that may be used by _-para-delete Optional ARG1 and ARG2 are passed to _-where-double-newlines to ignore whitespace-ish characters at beginning of block. Optional ARG3, if non-nil, deletes ___" ;; (let (_-cons _-str _-rc) (save-match-data (save-excursion (goto-char (car (setq _-cons (_-where-double-newlines arg1trim arg2trim)))) (setq _-str (buffer-substring-no-properties (car _-cons) (cdr _-cons))) (setq _-rc (list (if (not arg3trim__) _-str (with-temp-buffer (insert _-str) (goto-char (point-min)) ;; Interaction between arg1 and arg3: (if (and arg3trim__ (looking-at (concat _-re-__ _-whitespaces-wM))) (replace-match "")) (while (search-forward-regexp _-re-__ nil t) (replace-match "")) ;; (buffer-string))))) (_-app '_-rc _-cons))) _-rc)) ;; fix! ;; rename using "pop" (defun _-para-delete (&optional arg1trim arg2trim) "Delete paragraph as surrounded by newlines and return deleted paragraph. Optional ARG1 and ARG2 are passed to _-where-double-newlines. SEE ALSO _-kill-paragraph in tx2html.el" ;; (interactive) (let (_-cons _-rc) (save-match-data (if (_-blank-line-p t) (_-move-forward-whitespace t)) (setq _-rc (car (setq _-cons (_-para arg1trim arg2trim)))) (delete-region (car (cdr _-cons)) (cdr (cdr _-cons))) ;; 2006.11.23 ;; Compress multiple newlines in this zone. (progn (_-move-backward-whitespace) (if (looking-at "[ \t]+") (goto-char (match-end 0))) ;; Should be at first of two ... or more ... newlines. (if (not (looking-at "[\n][ \t\r]*[\n]")) (error "%s: %s" "Expecting" "two newlines") (goto-char (match-end 0))) ;; Delete 3rd+ newlines. (while (looking-at "[ \t\r]*[\n]") (replace-match ""))) (recenter) )_-rc)) (defun _-ifcl (arg1FILENAME &optional arg2VISIT arg3BEG arg4END arg5REPLACE) "Calls save-some-buffers before insert-file-contents-literally. Runs _-find-file-hooks-__-globals Leave point at min" ;; (let (_-str _-buffer _rc) (if (and (setq _-buffer (find-buffer-visiting arg1FILENAME)) (buffer-modified-p _-buffer)) (save-some-buffers)) ;; 2006.08.22 (if (and (not (file-exists-p arg1FILENAME)) (string-match (concat "/" lb-file-db "$") arg1FILENAME)) (error "%s: %s" "File not found (run lb.sh?)" arg1FILENAME)) (insert-file-contents-literally arg1FILENAME arg2VISIT arg3BEG arg4END arg5REPLACE) ;; _-where-page-numbers (_-find-file-hooks-__-globals arg1FILENAME) (goto-char (point-min)) _rc)) ;; (defun _-delete-paragraph-from-file (arg1re arg2pf) "Edit file ARG2 in-place by removing paragraph with regexp ARG1" ;; (with-temp-buffer (_-ifcl arg2pf) (goto-char (point-min)) (_-flush-one-paragraph arg1re nil nil) (write-region (point-min) (point-max) arg2pf))) (defun _-flush-one-paragraph (arg1re &optional arg2trim arg3trim) "ARG1 is a regular expression; if found, delete paragraph. A paragraph is surrounded by blank lines. See below. Optional ARG2 and ARG3 are passed to _-where-double-newlines during deletion. Returns..." ;; (_-flush-one-paragraph "%%data%%") (let ( _-rc) (save-excursion (save-match-data (if (search-forward-regexp arg1re nil t) (delete-region (car (setq _-rc (_-where-double-newlines arg2trim arg3trim))) (cdr _-rc))))) _-rc)) (defun _-current-time nil "Uses lb-format-time-string" ;; (format-time-string lb-format-time-string (current-time))) (defun _-timestamp (&optional arg1pf) ;; UTIL "For path/file ARG1 return something like: 2005-01-10T14:18:08-0800 ARG1 defaults to buffer-file-name. SEE ALSO: _-current-time" ;; ~/www.marxists.org/archive/lenin/howto/tx2html.el ;; (_-timestamp t2h-pathfile) (if (not arg1pf) (setq arg1pf (buffer-file-name))) (if (file-exists-p arg1pf) (format-time-string lb-format-time-string (nth 5 (file-attributes (if (nth 0 (file-attributes arg1pf)) (nth 0 (file-attributes arg1pf)) arg1pf)))))) (defun _-current-line (&optional arg1trim-lead arg2trim-tail) "Return line in buffer with point. Optional ARG1, if non-nil, trims leading whitespace. Optional ARG1, if non-nil, trims trailing whitespace" ;; (let ( (_-rc (buffer-substring-no-properties (save-excursion (beginning-of-line) (point)) (save-excursion (end-of-line) (point))))) (if (and arg1trim-lead (string-match (concat "^" _-whitespaces-wM) _-rc)) (setq _-rc (replace-match "" nil nil _-rc 0))) (if (and arg2trim-tail (string-match (concat _-whitespaces-wM "$") _-rc)) (setq _-rc (replace-match "" nil nil _-rc 0))) _-rc)) (defun _-set-buffer-to-pf (arg1pf) "Save some buffers; find file literally; fundamental mode; read-only" (_-dfun-hook "_-set-buffer-to-pf") ;; (let (_-buffer) (if (and (setq _-buffer (find-buffer-visiting arg1pf)) (buffer-modified-p _-buffer)) (error "%s: %s" "Already visiting modified buffer" arg1pf)) ;;;(defun insert-file-contents-literally (filename &optional visit beg end replace) ;;; "Like `insert-file-contents', but only reads in the file literally. ;;;A buffer may be modified in several ways after reading into the buffer, ;;;to Emacs features such as format decoding, character code ;;;conversion, find-file-hooks, automatic uncompression, etc. ;;; ;;;This function ensures that none of these modifications will take place." ;;; (let ((format-alist nil) ;;; (after-insert-file-functions nil) ;;; (coding-system-for-read 'no-conversion) ;;; (coding-system-for-write 'no-conversion) ;;; (jka-compr-compression-info-list nil) ;;; (find-buffer-file-type-function ;;; (if (fboundp 'find-buffer-file-type) ;;; (symbol-function 'find-buffer-file-type) ;;; nil))) ;;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv ;;; 't' is rawfile ;;; (find-file-noselect filename nil t) ;;; (find-file-noselect-1 buf filename nowarn ;;; rawfile truename number) ;;; (if rawfile ;;; (condition-case () ;;; (insert-file-contents-literally filename t) ;;;This does code conversion according to the value of ;;;`coding-system-for-read' or `file-coding-system-alist', ;;;and sets the variable `last-coding-system-used' to the coding system ;;;actually used. ;;; ;;;(insert-file-contents FILENAME &optional VISIT BEG END REPLACE) ;;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ;; (find-file-literally arg1pf) ;; (find-file arg1pf) ;; (setq buffer-file-coding-system 'iso-latin-1-unix) ;;; This variable is never applied to a way of decoding ;;; a file while reading it. (fundamental-mode) (toggle-read-only t) (set-buffer (current-buffer)))) (defun _-something-to-list (&optional arg1-or-buf-pf-str arg2-is-pf) "Chop ARG1 (buffer) (or file) (or string) into pieces delimited by blank lines. ARG1 is optional (uses current buffer if nil). If no blank lines chop by newlines. Optional ARG2, if non-nil, says to treat ARG1 as a pathfile string." ;; (_-something-to-list "") (let (_-rc _-pf _-cons (_-buffer-was-current (current-buffer))) ;; (when (stringp arg1-or-buf-pf-str) (if (and arg2-is-pf (not (file-exists-p arg1-or-buf-pf-str))) (error "%s: %s" "File not found" arg1-or-buf-pf-str)) (setq _-pf (if (and (not (string= "" arg1-or-buf-pf-str)) ;; !!!!! (file-exists-p "") => t (file-exists-p arg1-or-buf-pf-str)) arg1-or-buf-pf-str (concat (temp-directory) "/" (make-temp-name "")))) (if (not (file-exists-p _-pf)) (with-temp-buffer (insert arg1-or-buf-pf-str) (write-region (point-min) (point-max) _-pf))) (set-buffer (_-set-buffer-to-pf _-pf))) ;; (goto-char (point-min)) ;; Buffer has a blank line: (if (and (save-excursion (search-forward-regexp "\n[ \t]*\n" nil t)) (if (not (string-match (concat ".tab") _-pf)) t (error "%s: %s" "Blank line in tab file" _-pf))) ;; (while (search-forward-regexp "[^ \t\n\r]" nil t) (setq _-rc (append _-rc (list (buffer-substring-no-properties (car (setq _-cons (_-where-double-newlines))) (cdr _-cons))))) (goto-char (cdr _-cons))) ;; No blank line: assume each line is a record. (while (< (point) (point-max)) (if (not (looking-at "^[ \t]*[#]")) (setq _-rc (append _-rc (list (_-current-line))))) (end-of-line) (forward-char 1))) ;; (when _-pf (if (not (file-exists-p arg1-or-buf-pf-str)) (delete-file _-pf)) (kill-buffer (current-buffer)) (set-buffer _-buffer-was-current)) _-rc)) (defun _-comma-ify-int (arg1int) "" ;; (_-comma-ify-int 1) ;; (_-comma-ify-int 12) ;; (_-comma-ify-int 123) ;; (_-comma-ify-int 1234) ;; (_-comma-ify-int 12345) ;; (_-comma-ify-int 123456) ;; (_-comma-ify-int 1234567) ;; (_-comma-ify-int 12345678) ;; (_-comma-ify-int 123456789) (let (my my-rc my-chunk) (if (not (integerp arg1int)) arg1int (setq my (int-to-string arg1int)) (while (< 3 (length my)) (setq my-chunk (substring my (- (length my) 3))) (setq my (substring my 0 (- (length my) 3))) (setq my-rc (concat (if (< 0 (length my)) "," "") my-chunk my-rc))) (if (< 0 (length my)) (concat my "" my-rc) my-rc)))) (defun _-re-del-emacs (arg1str) "Delete emacs-ish stuff from string" ;; (_-re-del-emacs "\\([12][0-9][0-9][0-9]\\|9990\\|9999\\)") (let (my) (while (string-match "[\\\\]\\([)|(]\\)" arg1str) (setq arg1str (replace-match (match-string-no-properties 1 arg1str) nil nil arg1str)))) arg1str) ;; fix! ;; Replace all " \t\n" in code with one of these variables. ;; fix! ;; By default, \r (^M) is part of whitespace. ;; Need one that excludes \r when dealing with .tx files. ;; fix? ;; What about "~"? ;;; TO lb-defvar.el : ;;; 1102:(defvar _-punct-from-keyboard ;; (_makunbound) ;;; 1110:(defvar _-whitespace-wM ;; (_makunbound) ;;; 1112:(defvar _-whitespace-noM ;; (_makunbound) ;;; 1115:(defvar _-^whitespace-wM ;; (_makunbound) ;;; 1117:(defvar _-^whitespace-noM ;; (_makunbound) ;;; 1120:(defvar _-whitespaces-wM ;; (_makunbound) ;;; 1122:(defvar _-whitespaces-noM ;; (_makunbound) ;;; 1125:(defvar _-^whitespaces-wM ;; (_makunbound) ;;; 1127:(defvar _-^whitespaces-noM ;; (_makunbound) ;;; 1130:(defvar _-usr_share_sgml_html_dtd_xml_1.0_*.ent ;; (_makunbound) ;;; 1135:(defvar _-re-__ ;; (_makunbound) (defun _-ws (arg1list) "Change whitespaces to whitespace REGEXPs" ;; (_-ws "
      ") ;; fix! Why the newline in: (_-ws "1") -> "[\n]?1" (let (t2h-char (t2h-return-value "[\n]?") (t2h-flag t)) (if (stringp arg1list) (setq arg1list (list arg1list))) (loop for elem in arg1list do (loop for i from 0 to (1- (length elem)) do (setq t2h-char (substring elem i (1+ i))) (if (not (string-match "[ \t\n\r]" t2h-char)) (progn (setq t2h-return-value (concat t2h-return-value t2h-char)) (setq t2h-flag t)) (if t2h-flag (setq t2h-return-value (concat t2h-return-value "[ \t\n\r]*"))) (setq t2h-flag nil) ))) t2h-return-value)) ;; (_-lowercase-before-optnumber-p "STR123iii") ;; (_-lowercase-before-optnumber-p "StR123iii") (defun _-lowercase-before-optnumber-p (arg1str) "Is there a lowercase letter before optional number in string ARG1" (let (rc (i 0) str) (while (< i (length arg1str)) (setq str (substring arg1str i (1+ i))) (when (string-match "[0-9]" str) (setq i (1+ (length arg1str)))) (when (member str (split-string lb-az "")) (setq rc t) (setq i (1+ (length arg1str)))) (setq i (1+ i))) rc)) (defun _-append-to-buffer (arg1buf arg2beg arg3str) "After inserting ARG3, do append-to-buffer where END = point + length ARG3, then delete ARG3" ;; (let (_-pf) (save-excursion (insert arg3str)) (append-to-buffer arg1buf arg2beg (+ (point) (length arg3str))) (delete-region (point) (+ (point) (length arg3str))))) (defun _-tex2unibyte (&optional arg1) "" ;; (with-temp-buffer (insert "\æ") (message (_-tex2unibyte))) ;; (with-temp-buffer (insert "\á\é\í\ó\ú") (message (_-tex2unibyte))) ;; (with-temp-buffer (insert "\à\è\ì\ò\ù") (message (_-tex2unibyte))) ;; (with-temp-buffer (insert "\\ä\\ë\\ï\\ö\\ü") (message (_-tex2unibyte))) (interactive "p") (if arg1 (standard-display-european t)) (let (_-pf _-msnp1 _-msnp2) (save-match-data (save-excursion (goto-char (point-min)) (while (search-forward-regexp (concat "[\\]\\([" "a'`~\"" ;; may change. "]\\)\\([" "AEIONUYaeiou" ;; may change. "]\\)") nil t) (setq _-msnp1 (match-string-no-properties 1)) (setq _-msnp2 (match-string-no-properties 2)) (if (string= "'" _-msnp1) (replace-match (char-to-string (cond ((string= "a" _-msnp2) 225) ((string= "e" _-msnp2) 233) ((string= "i" _-msnp2) 237) ((string= "o" _-msnp2) 243) ((string= "u" _-msnp2) 250) ((string= "y" _-msnp2) 253) ((string= "A" _-msnp2) 193) ((string= "E" _-msnp2) 201) ((string= "I" _-msnp2) 205) ((string= "O" _-msnp2) 211) ((string= "U" _-msnp2) 218) ((string= "Y" _-msnp2) 221)))) (if (string= "`" _-msnp1) ;; NOTE: no "ygrave" or "Ygrave" (replace-match (char-to-string (cond ((string= "a" _-msnp2) 224) ((string= "e" _-msnp2) 232) ((string= "i" _-msnp2) 236) ((string= "o" _-msnp2) 242) ((string= "u" _-msnp2) 249) ((string= "A" _-msnp2) 192) ((string= "E" _-msnp2) 200) ((string= "I" _-msnp2) 204) ((string= "O" _-msnp2) 210) ((string= "U" _-msnp2) 217)))) (if (string= "\"" _-msnp1) (replace-match (char-to-string (cond ((string= "a" _-msnp2) 228) ((string= "e" _-msnp2) 235) ((string= "i" _-msnp2) 239) ((string= "o" _-msnp2) 246) ((string= "u" _-msnp2) 252) ((string= "y" _-msnp2) 255) ((string= "A" _-msnp2) 196) ((string= "E" _-msnp2) 203) ((string= "I" _-msnp2) 207) ((string= "O" _-msnp2) 214) ((string= "U" _-msnp2) 220) ((string= "Y" _-msnp2) 376)))) ;; oddball (if (string= "~" _-msnp1) (replace-match (char-to-string (cond ((string= "A" _-msnp2) 195) ((string= "N" _-msnp2) 209) ((string= "O" _-msnp2) 213) ((string= "a" _-msnp2) 227) ((string= "n" _-msnp2) 241) ((string= "o" _-msnp2) 245)))) (if (string= "a" _-msnp1) (replace-match (char-to-string (cond ;; fix? ;; eth? ;; thorn? ((string= "e" _-msnp2) 230) ))))))))))) ;; be sure to return nil so can be used on write-file-hooks nil)) ;; (setq _-pf "~/leninist.biz/en/html/htmm/../../../en/../default.css") ;; (command-line-normalize-file-name-then-some _-pf) (defun command-line-normalize-file-name-then-some (file) "Collapse multiple slashes to one, to handle non-Emacs file names Also removes embeded '/./'." (let (_-end) (save-match-data ;; Use arg 1 so that we don't collapse // at the start of the file name. ;; That is significant on some systems. ;; However, /// at the beginning is supposed to mean just /, not //. (if (string-match "^///+" file) (setq file (replace-match "/" t t file))) (while (string-match "//+" file 1) (setq file (replace-match "/" t t file))) ;; June 2005. (while (string-match "/[.]/" file 1) (setq file (replace-match "/" t t file))) ;; July 2005: Change "/../en/../" to "/../" (setq _-end 1) (while (string-match "/[.][.]\\(/[^/]+\\)/[.][.]/" file _-end) (setq _-end (match-beginning 1)) (if (not (string= "/.." (match-string 1 file))) (setq file (replace-match "/../" t t file)))) ;; March 2006: Replace "/abc/../" with "/". ;; March 2006: Replace "/abc/.." at end of string with "/". (progn (while (string-match "/[^/]+/[.][.]/" file) (setq file (replace-match "/" t t file))) (while (string-match "/[^/]+/[.][.]$" file) (setq file (replace-match "/" t t file)))) ;; ) file)) (defun _-compress-delete-whitespaces (&optional arg1str arg2__flag) "Compress whitespaces and delete trail/ending whitespace(s). Optional ARG2, if non-nil, removes __TAG__ tags" ;; (_-compress-delete-whitespaces " \tABC \n \n XYZ \t") ;; (_-compress-delete-whitespaces " \tABC \n \n __FOO__ XYZ \t") ;; (_-compress-delete-whitespaces " \tABC \n \n __FOO__ XYZ \t" nil) ;; (_-compress-delete-whitespaces " \tABC \n \n __FOO__ XYZ \t" t) (save-match-data (let (REGEXP NEWTEXT _-pf (_-pairs (list (cons (if (and (boundp 'arg2__flag) (not (null arg2__flag))) _-re-__ " ") " ") (cons "\n" " ") (cons "\t" " ") (cons "\r" " ") (cons " [ ]+" " ") (cons "^[ ]+" "") (cons "[ ]+$" "")))) (if arg1str (with-temp-buffer (insert arg1str) ;; (_-replace-regexp _-pairs) ;; (buffer-string)) (while _-pairs (goto-char (point-min)) ;; (_-replace-regexp _-pairs) ;; (setq _-pairs (nthcdr 1 _-pairs))))))) (defun _-replace-regexp (arg1conslist &optional arg2dir arg3rebound) "" ;; (describe-function 'replace-regexp) ;; ... ;;This function is usually the wrong thing to use in a Lisp program. ;;What you probably want is a loop like this: ;; (while (re-search-forward REGEXP nil t) ;; (replace-match TO-STRING nil nil)) ;;which will run faster and will not set the mark or print anything. ;; (_-replace-regexp (list (cons " " " ")) t 240) ;; MEANS: search-backward from (point-max) changing tabs after 240 to spaces. (let (_-search-dir-regexp (_-pairs arg1conslist)) (save-excursion (save-match-data (defalias '_-search-dir-regexp (if arg2dir (symbol-function 'search-backward-regexp) (symbol-function 'search-forward-regexp))) (while _-pairs (goto-char (if arg2dir (point-max) (point-min))) ;; ;;(replace-regexp (car (car _-pairs)) (cdr (car _-pairs))) (setq NEWTEXT (cdr (car _-pairs))) (if (< 0 (length (setq REGEXP (car (car _-pairs))))) (while (_-search-dir-regexp REGEXP (if arg3rebound (if (integerp arg3rebound) arg3rebound (save-excursion (_-search-dir-regexp arg3rebound nil t))) nil) t) (replace-match NEWTEXT t t))) (setq _-pairs (nthcdr 1 _-pairs))))))) (defun _-cda (arg1str arg2sym) "cdr ... assoc ... ARG1 ARG2 where ARG1 is a string and ARG2 is a symbol" ;; (_-cda "en" lb-mu-template-authors) (cdr (assoc arg1str arg2sym))) (defun _makunbound nil "" (let ( (_re-defvar "defvar[ \t]+") (_eol (save-excursion (end-of-line) (point))) _rc) (save-excursion (save-match-data (beginning-of-line) (if (and (or (search-forward-regexp _re-defvar _eol t) (search-backward-regexp _re-defvar nil t)) (goto-char (match-end 0))) (if (and (search-forward-regexp "[^ \t\n]+") (setq _rc (match-string-no-properties 0))) (makunbound (intern _rc)))))) _rc)) (defun _-string-to-int (arg1 &optional arg2nth) ;; UTILITY "Extract number as integer from string with digits. . Optional ARG2 skips over first ARG2 integers embedded in ARG1" ;; (_-string-to-int "sss111alsfjd" ) => "111" ;; (_-string-to-int "sss111alsfjd" 0) => "111" ;; (_-string-to-int "sss111als99fjd" 1) => "99" (let ((t2h-foo arg1) (t2h-nth (if arg2nth arg2nth 0)) _rc) (save-match-data (if (null arg1) (setq _rc arg1) (if (not (string-match "[0-9]" arg1)) (setq _rc arg1) (loop for i from 1 to t2h-nth do (progn (string-match "\\([0-9]+\\)" t2h-foo) (setq t2h-foo (replace-match "" nil nil t2h-foo)))) (progn (string-match "\\([0-9]+\\)" t2h-foo) (setq _rc (string-to-number (match-string 1 t2h-foo))))))) _rc)) (defun _-file-bytes (arg1pf) "" (nth 7 (file-attributes arg1pf))) (defun _-file-seconds (arg1pf) "" ;; (format-time-string "%s" nil) => "1121313967" (if (file-exists-p arg1pf) (string-to-int (format-time-string "%s" (nth 5 (file-attributes arg1pf)))) (error "%s: %s" "File not found (lb.sh turned off in crontab?)" arg1pf))) (defun _-compress-multiple-spaces (&optional arg1beg arg2end) "" (let ( (arg2adjust 0) _rc) (save-excursion (save-match-data (goto-char (if arg1beg arg1beg (point-min))) (while (search-forward-regexp " +" (if arg2end (- arg2end arg2adjust)) t) (setq arg2adjust (+ arg2adjust -1 (length (match-string-no-properties 0)))) (replace-match " ")))) _rc)) (defun _-compress-multiple-newlines nil ;; UTILITY "Compress two or more blank lines into one blank line" (interactive "*") ;; fix! Delete all blank lines immediately after open P tag. (save-excursion ;; Handle two newlines at top of buffer specially: (progn (goto-char (point-min)) (while (looking-at "\n[ \t\r]*\n") (replace-match "\n" t t) (goto-char (point-min)))) (while (or (search-forward-regexp (concat "\n[ \t\r]*" _-regexp-separator-para) nil t) (search-backward-regexp (concat "\n[ \t\r]*" _-regexp-separator-para) nil t)) ;; (if t2h-flag-loop-message (t2h-log "WHILE _-compress-multiple-newlines")) (replace-match "\n\n" t t)))) (defun _-find-to-list (arg1cmd &optional arg2where) "" ;; (_-find-to-list " -name .index") => ("~/leninist.biz/stf/.index" ;; (_-find-to-list " -type d") => ("~/leninist.biz/" ;; (interactive "p") (let (_-pf (_-rc (list))) (with-temp-buffer (shell-command (concat "find " (if arg2where arg2where lb-home) arg1cmd) t) (goto-char (point-min)) (while (search-forward "\n" nil t) (save-excursion (forward-char -1) (setq _-pf (buffer-substring-no-properties (save-excursion (beginning-of-line) (point)) (point)))) (setq _-rc (append _-rc (list _-pf))))) _-rc)) (defun _-mail (arg1recip arg2subj arg3pf) "Send mail message" ;; (_-mail lb-mail-recipient file-stamp my-temp-name) (let (_-buffer) (with-temp-buffer (setq _-buffer (buffer-name)) (shell-command (concat "mail " "-s " arg2subj " " arg1recip " < " arg3pf) _-buffer nil)))) ;; (_-capitalize-cdata " id='ABCD' ") ;; (_-capitalize-cdata "id='ABCD' ") ;; (_-capitalize-cdata "ABCD") ;; (_-capitalize-cdata ""ABCD") ;; (_-capitalize-cdata "AB\\\"UCD") (defun _-capitalize-cdata (arg1str) "" (let (_-pt _-flag _-rc) (with-temp-buffer (insert arg1str) (goto-char (point-max)) (while (forward-word -1) (setq _-pt (point)) (setq _-flag t) ;; id="Abcde" (goto-char _-pt) (if (and (> (point) 1) (or (forward-char -1) t) (looking-at "[ \t\n\r][a-zA-Z]+[=][\"']")) (setq _-flag nil)) ;;     (goto-char _-pt) (if (and (> (point) 2) (or (forward-char -2) t) (looking-at "")) (setq _-flag nil)) ;; \"u (progn (goto-char _-pt) (if (and (> (point) 2) (or (forward-char -2) t) (looking-at "[\\][\"'`~^]")) ;; AB\"UCD (setq _-flag nil)) (goto-char _-pt) ;; If there is a letter to left of '\"u' then downcase this word. (if (and (> (point) 3) (or (forward-char -3) t) (looking-at "[a-zA-Z][\\][\"'`~^]") ;; AB\"UCD (or (goto-char _-pt) t)) (downcase-word 1))) ;; (goto-char _-pt) (if (and (> (point) 1) (or (forward-char -1) t) (looking-at "<[a-zA-Z]+[ \t\n\r>]")) (setq _-flag nil)) ;; " (goto-char _-pt) (if (and (> (point) 1) (or (forward-char -1) t) (looking-at "[&][a-zA-Z0-9]+;")) (setq _-flag nil)) (progn (goto-char _-pt) (if _-flag (capitalize-word 1)) (goto-char _-pt))) (setq _-rc (buffer-string))) _-rc)) (defun _-downcase-nonsignifs (arg1str &optional arg2list) "Change certain non-significant words to downcase. Optional ARG2 is a list of non-significant words to use. Use _-normalize-whitespace beforehand to remove whitespace from ends" ;; ;; (_-downcase-nonsignifs "Firstword Of Secondword Of Fini.") ;; (_-downcase-nonsignifs "The Firstword And Secondword \rOf Fini.") ;; (_-downcase-nonsignifs "Firstword And Secondword Of Fini." '("OF")) (let (i len (_-rc arg1str)) (loop for w in (if arg2list arg2list '("OF" "AND" "THE")) do (setq i (1- (setq len (length _-rc)))) (while (> i 0) ;; Do not change first word, was: (> i -1) (if (and ;; When doing substring, do not exceed length of _-rc. (<= (+ i (length w)) (length _-rc)) (string= (upcase w) (upcase (substring _-rc i (+ i (length w))))) ;; Start of string or character to left must not be alpha. ;; TeX is nice: right-most character is always alpha. ;; SGML named entities not-so-nice: right-most character is ';'. (if (= i 0) t (not (string-match "[a-zA-Z]" (substring _-rc (1- i) i)))) ;; End of string or character to right must not be alpha. (if (= (+ i (length w)) (length _-rc)) t ;; Include backslash and assume it's a TeX accented letter. (not (string-match "[a-zA-Z\\]" (substring _-rc (+ 0 (+ i (length w))) (+ 1 (+ i (length w)))))))) (setq _-rc (concat (substring _-rc 0 i) (downcase w) (substring _-rc (+ i (length w)))))) (setq i (1- i)))) _-rc)) (defun _-write-hooks-clear (arg1p) "" (interactive "p") ;; make-variable-buffer-local is an interactive built-in function. ;; Using `set' or `setq' to set the variable causes it to have a separate ;; value for the current buffer if it was previously using the default ;; value. (setq write-contents-hooks nil) (setq local-write-file-hooks nil) (setq write-file-hooks nil)) (defun _-describe-function nil "" (interactive) (let (_rc) (when (function-called-at-point) (setq _rc t) (setq _rc (describe-function (function-called-at-point)))) _rc)) ;; (defun __handler (arg1action arg2var &optional arg3str) "Manipulates array lb-ht-__. ARG1 is 'PUT' or 'GET' or 'DEL'. ARG2 is name of slot (a string). Optional ARG3 is string to store in named slot when ARG1 is 'PUT'" ;; (__handler "PUT" "FOO1" "xyyz") => "PUT" ;; (__handler "GET" "FOO1") => "xyyz" ;; (__handler "GET" "FOO1" t) => ("__FOO1__" . "xyyz") ;; (__handler "DEL" "FOO1") => "DEL" (let (lb-str lb-existing lb-rc) (if (not (string-match _-re-__ arg2var)) ;; Accept 'FOO' for ARG2. (setq arg2var (concat "__" arg2var "__"))) (if (string= "PUT" (upcase arg1action)) (and (or (setq lb-existing (__handler "GET" arg2var t)) t) (or (setq lb-ht-__ (delete lb-existing lb-ht-__)) t) (if (stringp arg3str) (and (setq lb-ht-__ (append (list (cons arg2var arg3str)) lb-ht-__)) arg1action))) (if (string= "GET" (upcase arg1action)) (and (or (setq lb-existing (assoc arg2var lb-ht-__)) t) (if arg3str lb-existing (cdr lb-existing))) (if (string= "DEL" (upcase arg1action)) (and (or (__handler "PUT" arg2var) t) arg1action) (error "%s: %s" "Invalid ARG1" arg1action)))) lb-rc)) (defun _makunbound nil "" (let (_-str (_-eol (save-excursion (end-of-line) (point)))) (save-excursion (beginning-of-line) (if (search-forward-regexp "defvar[ \t]+" _-eol t) (if (and (search-forward-regexp "[^ \t\n]+") (setq _-str (match-string-no-properties 0))) (makunbound (intern _-str))))))) (defun _-something-to-string (arg1 arg2) ;; UTILITY "" (if (stringp arg2) (setq arg2 (string-to-number arg2))) (format arg1 arg2)) (defun _-number-to-alphas (arg1) ;; UTILITY "(_-number-to-alphas 44) => \"ar\"" ;; (concat (if (> (/ (- arg1 1) 26) 0) (char-to-string (+ 96 (/ (- arg1 1) 26)))) (char-to-string (+ 96 (+ 1 (mod (- arg1 1) 26)))))) (defun _-string-to-int (arg1 &optional arg2nth) ;; UTILITY "Extract number as integer from string with digits. . Optional ARG2 skips over first ARG2 integers embedded in ARG1" ;; (_-string-to-int "sss111alsfjd" ) => 111 ;; (_-string-to-int "sss111alsfjd" 0) => 111 ;; (_-string-to-int "sss111als99fjd" 1) => 99 ;; (_-string-to-int "-3-" ) => 3 ;; (_-string-to-int "-3" ) => -3 (let ((t2h-arg1 arg1) (t2h-nth (if arg2nth arg2nth 0)) _rc) ;; fix? use (cond ? (if (null arg1) arg1 (if (not (string-match "[0-9]" arg1)) arg1 ;; Not null, and has an integer. ;; Maybe skip over ARG2 integers. (loop for i from 1 to t2h-nth do (progn (string-match "\\([0-9]+\\)" t2h-arg1) (setq t2h-arg1 (replace-match "" nil nil t2h-arg1)))) ;; MAIN: (progn (string-match ;; 2006.11.23 ;; "-1" = 1, however, page number in .tx file may be: -1- ;; "\\([0-9]+\\)" (concat "\\([-]\\)?" "\\([0-9]+\\)" "\\([-]\\)?" ) t2h-arg1) ;; 2006.11.23 ;; (string-to-number (match-string 1 t2h-arg1)) (setq _rc (string-to-number (match-string 2 t2h-arg1))) (if (and ;; "-" before integer. (match-string 1 t2h-arg1) ;; No "-" after integer. (not (match-string 3 t2h-arg1))) (setq _rc (- 0 _rc)))))) _rc)) (defun _-int-add-length (arg1symbol arg2str) "" ;; (_-int-add-length 't2h-close-beg t2h-string) (let (t2h-letx) (set arg1symbol (+ (symbol-value arg1symbol) (length arg2str))))) (defun _-ws (arg1list) "Change whitespaces to whitespace REGEXPs" ;; (_-ws "
      ") ;; fix! Why the newline in: (_-ws "1") -> "[\n]?1" (let (t2h-char (t2h-return-value "[\n]?") (t2h-flag t)) (if (stringp arg1list) (setq arg1list (list arg1list))) (loop for elem in arg1list do (loop for i from 0 to (1- (length elem)) do (setq t2h-char (substring elem i (1+ i))) (if (not (string-match "[ \t\n]" t2h-char)) (progn (setq t2h-return-value (concat t2h-return-value t2h-char)) (setq t2h-flag t)) (if t2h-flag (setq t2h-return-value (concat t2h-return-value "[ \t\n]*"))) (setq t2h-flag nil) ))) t2h-return-value)) ;; (_-string-trim " 1 a b 2 ") => "1 a b 2" ;; (_-string-trim " 1 a b 2 " " \t\n2") => "1 a b 2" (defun _-string-trim (arg1str &optional arg2re_chars) "Remove leading and trailing whitespace" (let ((t2h-return-value arg1str)) (if (not arg2re_chars) (setq arg2re_chars " \t\n\r")) ;; Delete leading whitespace. ;; Delete trailing whitespace. (if (string-match (concat "^[" arg2re_chars "]+\\([^" arg2re_chars "].*\\)") t2h-return-value) (setq t2h-return-value (match-string 1 t2h-return-value))) (if (string-match (concat "\\(.*[^" arg2re_chars "]\\)[" arg2re_chars "]+$") t2h-return-value) (setq t2h-return-value (match-string 1 t2h-return-value))) t2h-return-value)) (defun _-where-double-newlines (&optional arg1trim arg2trim) "Return point after preceeding NL-WS*-NL and point before next NL-WS*-NL. If point near top (only whitespace above) or bottom (only whitespace below) of buffer, point will be first non-whitespace from either end. Optional ARG1, if non-nil, ignores leading tabs, spaces, CRs at beginning of block Optional ARG2, if non-nil, ignores trailing tabs, spaces, CRs at end of block" ;; ~/www.marxists.org/archive/lenin/howto/tx2html.el (let (_-pt-upper _-pt-lower _-char _-pt (para-sep-regexp "\n[ \t\r]*\n") _-rc) (save-match-data ;; Abort if point is in blank line; let calling function deal with it. (if (and (string-match "^[ \t]*$" (_-current-line)) (not (= 1 (point)))) (error "%s: %s" "Does not work with point" (concat "on blank line" "\n" (_-buffer-substring-from-)) ) (save-excursion (setq _-pt-upper (if (search-backward-regexp para-sep-regexp nil t) (search-forward-regexp para-sep-regexp) ;; buffer may be empty: (goto-char (point-min)) (if (setq _-pt (search-forward-regexp ;; fix ?!?! Should below be "-noM"? ;; fix ?!?! Should below be "-noM"? _-^whitespace-wM nil t)) (1- _-pt)) )) (save-excursion (setq _-pt-lower (if (search-forward-regexp para-sep-regexp nil t) (progn (search-backward-regexp para-sep-regexp) ;; Do not want two ^M in a row. (if (looking-at "[\n][ \t]*[\r]") (error "%s: %s" "Two in a row, or nothing to left" (_-buffer-substring-from-) )) (point)) (goto-char (point-max)) ;; buffer may be empty: (if (setq _-pt (search-backward-regexp ;; fix ?!?! Should below be "-noM"? _-^whitespace-wM nil t)) (1+ _-pt)) )) (if arg1trim (save-excursion (goto-char _-pt-upper) ;; Added \n\r (2006.04.25) to fix bug when ;; in paragraph at top of file b/c just one ;; newline above. (if (looking-at "[ \t\n\r]+") (setq _-pt-upper (match-end 0))))) (if arg2trim (save-excursion (goto-char _-pt-lower) (if (_-move-backward-whitespace arg2trim) (setq _-pt-lower (point))))))))) (setq _-rc (if (and _-pt-upper (not _-pt-lower)) (error "%s: %s" "Got point upper" "but not point lower") (if (and (not _-pt-upper) _-pt-lower) (error "%s: %s" "Got point lower" "but not point upper") (cons _-pt-upper _-pt-lower)))) _-rc)) ;;; ;; (_C-u 4) ;; (_C-u 1) (defun _C-u (arg1) (if (and arg1 (integerp arg1) (= 4 arg1)) t)) ;; NOTE: (defun tx-editing-insert-page-break-mid-paragraph (&optional arg1) ;; NOTE: (defun tx-editing-insert-page-break-mid-paragraph (arg1) (defun _C-u-message (arg1) (interactive "p") (message "%s" (prin1-to-string arg1))) (provide '_) ;;; ; file-stamp.el0100644000175100017510000000606410540657407013264 0ustar cymbalacymbala ;; Time-stamp: "2006-12-15 18:50:47 cymbala" @lafn.org (setq file-stamp "Emacs-File-stamp: \"/home/ysverdlov/bin/file-stamp.el\"") (defvar file-stamp-line-limit 100 "See: ~/bin/file-stamp.el") (if (or (not (boundp 'time-stamp-line-limit)) (< time-stamp-line-limit file-stamp-line-limit)) (setq time-stamp-line-limit file-stamp-line-limit)) (add-hook 'write-file-hooks 'file-stamp) ;; (file-stamp-get-stamp) (defun file-stamp-get-stamp (&optional arg1str) "" (let (x y rc) ;; Easiest. (when (boundp 'file-stamp) (setq x file-stamp) (if (string-match (setq y ".*/home/") x) (setq x (replace-match "/home/" t t x)) (error "%s: %s" y x)) (if (or (string-match (setq y abbreviated-home-dir) x) (string-match (setq y "^/home/ysverdlov\\(/\\|$\\)") x) ) (setq x (replace-match "~/" t t x)) (error "%s: %s" y x)) (setq rc x)) rc)) (defun file-stamp (&optional arg1pf) "UPDATE THIS FILE STAMP TEMPLATE: File-stamp: [\"<]" ;; .emacs ;; (load-file "~/bin/file-stamp.el") (interactive "*") ;; added 2005.12.25 (let ((foo "bar") (BOUND nil) (end -1) (index nil) (file-name-short-at-regexp "/archive/lenin/") ;; This should be a list. (file-name-short-replacement "~/Lia/archive/lenin/") ;; This should be a list. (file-name-short-current nil) (file-stamp-end "\\\\?[\">]") ;; (file-stamp-start "File-stamp:[ \t]+\\\\?[\"<]+") ;; (file-stamp-start "File-stamp:[ \t]+\\\\?[\\]?[\"<]+") (file-stamp-start "File-stamp:[ \t]*\\\\?[\\]?[\"<]+") (loop-line-number 1) (start -1) (bar "foo")) (save-excursion (save-restriction (goto-char (point-min)) (while (<= loop-line-number file-stamp-line-limit) (save-excursion (setq BOUND (search-forward "\n" nil t))) ;; Fewer than 8 lines in file. (if (eq nil BOUND) (setq BOUND (point-max))) (if (search-forward-regexp file-stamp-start BOUND t) (progn (setq start (match-end 0)) (if (search-forward-regexp file-stamp-end BOUND t) (progn (setq end (match-beginning 0)) (setq file-name-short-current (if arg1pf arg1pf (buffer-file-name))) (if (setq index (string-match file-name-short-at-regexp file-name-short-current)) (setq file-name-short-current (concat file-name-short-replacement (substring file-name-short-current (match-end 0))))) (goto-char start) (delete-char (- end start)) ;; 2006.12.14 (if (string-match "/[a-z]?cymbala/" file-name-short-current) (setq file-name-short-current (replace-match "/ysverdlov/" t t file-name-short-current))) (insert file-name-short-current) ;; Break out of loop (like time-stamp). (setq loop-line-number (+ 1 file-stamp-line-limit)))))) (end-of-line) (if (not (= (point) (point-max))) (forward-char 1)) (setq loop-line-number (+ 1 loop-line-number))))) ;; 2006.12.14 - why not. (if (functionp 'cmn) (cmn)) ;; be sure to return nil so can be used on write-file-hooks nil)) (provide 'file-stamp) ;;; ; lb-abbyy.el0100644000175100017510000007110210653161512012707 0ustar cymbalacymbala ;;; Emacs-Time-stamp: "2007-07-29 11:58:18" ;;; Emacs-File-stamp: "/home/ysverdlov/leninist.biz/lb-abbyy.el" ;;; DEPENDENCIES: (setq load-path (append (list "~/leninist.biz/") load-path)) (when nil ;; 2007.07.29 - moved ../bin/file-stamp.el to ../leninist.biz ! (if t ;; 2007.02.12 - made symbolic link from ~/bin to ~/leninist.biz (unless (featurep 'file-stamp) (load "file-stamp")) (load-file "~/bin/file-stamp.el"))) (unless (featurep 'file-stamp) (load "file-stamp")) (unless (featurep '_) (load "_")) (unless (featurep '_-defvar) (load "_-defvar")) (unless (featurep '_-sgml) (load "_-sgml")) (unless (featurep 'lb-defun) (load "lb-defun")) (unless (featurep 'lb-defvar) (load "lb-defvar")) ;; TO-DO: History for ;; TO-DO: were distributed as a ;; TO-DO: Do not ^^1^^ ones like km2 es/1974/SR231/20060303/ ;; TO-DO: ;;; Settings: ;;; ;;; - solid line for page breaks. ;;; - ;;; (while (search-forward-regexp "[ \t]+$" nil t) (replace-match "")) ;; (unless (featurep 't2h) ;; (load-file (concat "~/"my-dns-mia"/archive/lenin/howto/tx2html.el"))) ;;(unless (featurep 'lia) ;; (error "%s: %s" "Load this file instead" ;; (concat "~/"my-dns-mia"/archive/lenin/howto/lia.el"))) (when nil (unless (featurep 'lia) (load-file "~/www.marxists.org/archive/lenin/howto/lia.el")) ) ;; SEE: f2 t runs the command t2h-insert-__title__ (when nil (while (search-forward-regexp (concat "\n

    [ ]*\n" "\\(\\)?" "\\([0-9]+\\)" " [\r] " "\\(\\)?" "TO " "\\([- A-Z]+\\)" "\\(\\)?" "

    [\r][ ]*\n\n") nil t) (replace-match (concat "\n\n__SUPRATITLE__ " (match-string 2) "\n\n" "__TITLE__\n" "TO " (match-string 4) "\n\n"))) ) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; This 1 used more frequently than others in template.htm that have same root. (fset 'sgml-tag-word-em [?< ?e ?m ?> C-right ?< ?/ ?e ?m ?>]) (defun sgml-tag-word-em-split nil "" (interactive "*") (let (t2h-side t2h-point) (when (and (looking-at "[a-zA-Z]") (save-excursion (forward-char -1) (not (looking-at "[a-zA-Z]"))) (setq t2h-dir "left")) (setq t2h-point (point)) (insert "") (goto-char t2h-point) (progn (while (and (search-backward-regexp "[a-zA-Z]") (_-sgml-markup-p))) (forward-char 1)) (insert "") (search-forward "")))) ;; (defun lb-abbyycln-quotes-to-smart nil "" ;; (interactive) (let (_msnp1 _msnp2 _msnp3 _msnp4 _rc) ;; fix! ;; This changes quotes if no whitespace inbetween. ;; When one whitespace inbetween, change " to `` by hand then ;; change " to '' with script. ;; 2007.04.11 (goto-char (point-min)) (while (sfr "\\("\\)[.?!]

    " nil t) (replace-match "''" t t nil 1)) ;; Quotes (abbyycln.el|html2tx.el) (goto-char (point-min)) (while (and (search-forward-regexp (concat ;; -1- ;; 2007.04.11 - OMG! ;; "\\(``\\|"\\|\"\\)" "\\([']+\\|"\\|\"\\)" ;; -2- (concat "\\([" "-" "a-zA-Z" ">     lb-str-espanol-accented-vowels lb-str-espanol-accented-consonants "]+\\)") ;; -3- ;; fix? 2007.07.05 ;; "'" replaced with "'": remove it here? ;; And also remove "[^s]" below at same time? "\\([']+\\|"\\|\"\\)" ;; -4- ;; 2007.07.05 - "possessive's duh" "\\([^s]\\)" ) nil t) (progn (setq _msnp1 (match-string-no-properties 1)) (setq _msnp2 (match-string-no-properties 2)) (setq _msnp3 (match-string-no-properties 3)) (setq _msnp4 (match-string-no-properties 4)) t)) (if (and (not (_-sgml-markup-p)) (not (string-match "^[-]+$" _msnp2))) (replace-match (concat (if (string= "'" _msnp1) "`" "``") _msnp2 ;; 2007.05.16 - ERROR: was "1" should have been "3"! ;; (if (string= "'" _msnp1) "'" "''") (if (string= "'" _msnp3) "'" "''") _msnp4 )))) (progn ;; Swaps and substitutions (moved here from lb-abbyycln). (setq my-list (list ;; TEMPLATE ;; IMPORTANT! - 2007.04.11 ;; Characters *NOT* enclosed by "()" will be DELETED !!! (cons "\\(aaa\\)\\(bbb\\)\\(ccc\\)" (list (list 1 2 3))) ;; ,"B (cons (concat "\\([.,]\\)" "\\("\\|\"\\)" ;; 2007.04.04 ;; "\\([ ]\\)" ;; "\\([ ]+\\)" ;; state
    ". . .has fully confirmed ;; ERROR ERROR ERROR ERROR: "[^.]" ;; ;; ERROR: Without parenthesis, that character was ;; being deleted! 2007.04.11 ;; 2007.04.11 "\\([ ]+" "[^.]" "\\)") (list (list 1 "''" 3))) ;; ",B (cons (concat "\\("\\|\"\\)" "\\([.,]\\)" "\\([ \n]\\)") (list (list "''" 2 3))) ;; (" (cons (concat "\\([\(]\\)" "\\("\\)") (list (list 1 "``"))) ;; WAS (list "``" 1) (cons (concat "\\("\\)" "\\([;,\)]\\)") (list (list "''" 2))) ;; WAS: (list 2 "''") "zzzzzz")) ;; (tx-editing-swaps-and-substitutions my-list)) _rc)) (defun lb-abbyycln-join-a-hyphen-control-M nil "x of 3: why 3 with HYPHEN in defun name? Previous action was to search backward for: - \r This function isolated from lb-abbyycln-call-join-a-hyphen-function for use within tx-editing-merge-closing-paragraphs" (let ( (_pt (point)) _rc) (save-match-data (save-excursion (when (and ;; Same regexp as used in lb-abbyycln-call-join-a-hyphen-function (looking-at "[-][ \t]+[\r]") ;; Was "-" changed to "--" by previous iteration? (not (looking-at-backward-become-forward "[-]")) (looking-at-backward-become-forward (concat ;; SINGLE NON-ALPHA CHARACTER: ;; --------------------------- ;; This could be a "-" as in "semi-" as in: semi-col- ^M onial "[^a-zA-Z" lb-str-espanol-accented-vowels lb-str-espanol-accented-consonants "]" ;; POTENTIAL MANY ALPHA CHARACTER(S): ;; ---------------------------------- ;; DO NOT put "[-][0-9]" here! ;; law-gov- ^M ;; -> ;; law- ^M-3 ;; KEEP "law-" LIKE THAT. ;; ----------------------------- "[a-zA-Z" lb-str-espanol-accented-vowels lb-str-espanol-accented-consonants "]+" )) (progn (setq _str (buffer-substring (1+ (point)) _pt)) t)) ;; 2007.01.19 - if char to left of chunk to move is '-'... (when (looking-at "[-]") (setq _pt (1+ _pt)) (replace-match "--")) (progn (delete-region (- ;; Start with end-point for deletion (to right of '-') (1+ _pt) ;; the hypen 1 ;; word chunk (length _str)) (1+ _pt)) (search-forward-regexp "[\r]") (insert "-" (int-to-string (length _str))) (_-move-forward-whitespace) ;; fix? test whether next line begins with something? ;; fix! oh yes! broken: was inserting fragment before PG#! (if (string-match lb-re-bracketed-integer-anchored (_-current-line)) (goto-char (save-excursion (forward-line 1) (_-move-forward-whitespace) (point)))) (insert _str))) )) _rc)) ;;; ;;; for an understanding with Ger- = ;;; ;;; ^M many?"^^2^^ Shortly after ;;; (defun lb-abbyycln-call-join-a-hyphen-function nil "Move word before '- ^M' to next line and change to ' ^M-9'" ;; NO METHOD. We want each line to match the original verbatim. ;; (2006.02.23) ;; NEW METHOD. Negative number indicates how many characters moved ;; from upper line to lower line. This prevents disappearance of ;; last "line" when last line has just the last part of the last word. ;; fix? ;; Compare this 2nd version with 1st version... on laptop? (interactive "*") (let (_pt _str _rc) (save-match-data (save-excursion ;; 1 of 2: Compress spaces to left of carriage return. (progn (goto-char (point-min)) (while (search-forward-regexp "[ \t][ \t]+[\r]" nil t) (replace-match " "))) (goto-char (point-max)) (while (and (search-backward-regexp "[-][ \t]+[\r]" nil t) t) (lb-abbyycln-join-a-hyphen-control-M)) ;; 1 of 2: Compress spaces to left of carriage return. (progn (goto-char (point-min)) (while (search-forward-regexp "[ \t][ \t]+[\r]" nil t) (replace-match " "))))) _rc)) (defun lb-abbyycln (&optional arg1p) "Rewritten January 2007" ;; (interactive "p") ;; fix! Is not changing superscript footnotes at end of line to ^^9^^. ;; fix? Look for " ^M[ ]*[^\na-zA-Z]" to find superfluous carriage returns? (let (my-bfn-original my-bfn-rename my-pf-tx my ;; lb-abbyycln-justonce my-cons my-tag my-cons my-cnt my-pt-beg my-pt-end my-properties my-msnp1 my-n my-counter ;; lb-abbyycln-maybe-interactions my-list my-cons my-re my-msnp1 my-msnp2 my-msnp3 my-msnp4 my-pt-beg my-pt-end my-n my-tag (my-tag-table (list (cons "I" "em") (cons "B" "b") (cons "U" "u") ;; 2007.04.06 ;; Leave uppercase. ;; May need to be ^^9^^-ized. ;; See tx-check-buffer. ;; (cons "SUP" "sup") (cons "SUB" "sub") )) _pt _re _rc) ;; TO-DO: When calculating ^M-n count '\"u' as one (1) character.* ;; TO-DO: ;; TO-DO: ;; * But, '\' will not be included in [a-zA-Z]+ ;; Open 999.htm (progn ;; Switch from .htm to .txsomething (setq my-pf-tx (progn (setq my-bfn-original (setq my-pf-tx (buffer-file-name))) (if (not (string-match "[.]htm$" my-pf-tx)) (error "%s: %s" "Expecting extension" "htm") (setq my-pf-tx (replace-match (concat ;; ".tx" ;; 2006.11.05 ;; ".txq" ;; 2007.03.23 (if (_C-u arg1p) ".tx" ".txq")) t t my-pf-tx))))) (if (file-exists-p my-pf-tx) (error "%s: %s" "File already exists" my-pf-tx)) (if (not (string-match "[hH][tT]\\([mM]\\)$" my-bfn-original)) (error "%s: %s" "Expecting extension" "htm") (setq my-bfn-rename (replace-match "" nil nil my-bfn-original 1)) (if (file-exists-p my-bfn-rename) (error "%s: %s" "Cannot rename: file already exists:" my-bfn-rename) ;; No-nos in .htm. (progn (goto-char (point-min)) (setq my-re " " ") (if (search-forward-regexp my-re nil t) (error "%s: %s" "Found" (concat "->" my-re "<-"))) ) ;;(find-file my-pf-tx) (with-temp-buffer (insert-file-contents-literally my-bfn-original) (goto-char (point-min)) (setq my "") (if (not (search-forward my)) (error "%s: %s" "Did not find" my) (delete-region (point-min) (point))) (goto-char (point-min)) ;; Later all
    will be changed to ^M. (while (search-forward-regexp "[\r]" nil t) (replace-match "")) (write-region (point-min) (point-max) my-pf-tx) (rename-file my-bfn-original my-bfn-rename)) (if (setq my (get-file-buffer my-bfn-original)) (kill-buffer my))))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Basic Edits. (with-temp-buffer (insert-file-contents-literally my-pf-tx) ;; (lb-abbyycln-justonce nil) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;
    . (goto-char (point-min)) (while (search-forward "")) (insert "

    \n") (search-forward "" nil nil) (replace-match "

    " t t)) (goto-char (point-min)) (if (search-forward "") (_-move-forward-whitespace) t)) (if (looking-at (concat "")) (delete-region my-pt-beg (match-end 0))))) (progn ;; Change tags, such as lower case to upper case. (loop for my-cons in my-tag-table do (goto-char (point-min)) (setq my-tag (car my-cons)) (while (search-forward-regexp (concat "\\(") nil t) (replace-match (concat (match-string-no-properties 1) (cdr my-cons) ">"))))) (progn ;; Change (delete) some tags to \n\n. (setq my-taglist (list "TD" "TR" "TABLE" "DIV" (cons "STYLE" (list (list "del.chardata"))))) (while (and my-taglist (and (setq my-tag (car my-taglist)) (or (setq my-taglist (cdr my-taglist)) t)) (goto-char (point-max))) (if (stringp my-tag) (setq my-properties nil) (setq my-properties (cdr my-tag)) (setq my-tag (car my-tag))) (while (> (point) (point-min)) (goto-char (point-min)) (while (search-forward-regexp (concat "<" my-tag "[^A-Z]") nil t) (goto-char (setq my-pt-beg (match-beginning 0))) (insert "\n\n") (delete-region (point) (search-forward ">")) (setq my-pt-beg (point)) (search-forward-regexp (concat "")) (if (assoc "del.chardata" my-properties) (delete-region my-pt-beg (point)) (replace-match "")))))) (progn ;; Page numbers (goto-char (point-max)) (while (search-backward "
    " nil t) (replace-match "\n\n\n\n" t t))) (progn ;; Page numbers: just integer inside P tag. Need ^M (just above). (goto-char (point-max)) (while (search-backward-regexp (concat "\n\n" "

    " _-whitespace-noM "*" "\\(\\|\\)?" "\\([0-9]+\\)" "\\(\\|\\)?" "

    " "[ \t]*" "\\([\r]\\|
    \\)" "[ \t]*" "\n\n") nil t) (replace-match (concat "\n\n" (match-string-no-properties 2) "\n\n")))) (progn ;; Change
    to carriage returns (^M). (goto-char (point-max)) ;; Much faster going backwards? (while (search-backward-regexp "[ \t]*
    [ \t]*" nil t) (replace-match " "))) (progn ;; Shift whitespace before close tag. (setq taglist '("em" "b")) (loop for tag in taglist do (goto-char (point-min)) (while (search-forward-regexp (concat "\\(" "[ \t\n\r]+" "\\)" "\\(\\)" ) nil t) (replace-match (concat (match-string-no-properties 2) (match-string-no-properties 1)))))) (cms) (cmn) (write-region (point-min) (point-max) my-pf-tx) ) ;; with-temp-buffer ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Should look like a .tx file now. (with-temp-buffer (insert-file-contents-literally my-pf-tx) ;; 2007.01.01 - delete 2nd page number when two in a row. ;; 2007.01.09 - NO! This can delete integers from tables! (when nil nil) (progn ;; Dashes (goto-char (point-min)) (while (search-forward-regexp (concat "—" ) nil t) (replace-match "---")) ;; More dashes. ;; \200 and \224 are "detected" by search. ;; Why is not \342 "detected" by search?!?!?!?!?!?!?!?!?! ;; \342 shows up as acirc: (buffer-substring (point) (1+ (point))) (goto-char (point-min)) (while ;; (search-forward "—" nil t) (search-forward "€”" nil t) (replace-match "---") (forward-char -4) (if (= 226 (string-to-char (buffer-substring-no-properties (point) (1+ (point))))) (delete-region (point) (1+ (point))))) ;; More dashes. (progn (goto-char (point-min)) (while (search-forward-regexp "[ ]*—[ ]*" nil t) (replace-match "---")) (goto-char (point-min))) ;; Lastly. Dashes. [ ] before \r and after '---' may have been deleted. (progn (goto-char (point-min)) (while (search-forward-regexp "[-][-][-][\r]" nil t) (replace-match "--- "))) ) (progn ;; Superscript numbers ;; 2007.01.19 - was adding '=\n\n' before marker, but that was overkill. (goto-char (point-min)) (while (search-forward-regexp (concat "\\([ \t\n]*\\)" ;; added this later. "" "\\([0-9]+\\)" "") nil t) (setq my-msnp1 (match-string-no-properties 1)) (setq my-msnp2 (match-string-no-properties 2)) (replace-match (concat (if (< 0 (length my-msnp1)) "~" "") "^^" my-msnp2 "^^")))) (when nil nil nil nil nil nil nil nil nil ;; fix! Do only after NOTES LVL marker! (progn ;; Endnotes in NOTES: Move superscript out of paragraph. (while (search-forward-regexp (concat "

    ~^^" "\\([0-9]+\\)" "^^ ") nil t) (replace-match (concat "\n\n" (match-string-no-properties 1) "\n\n" "

    \n") t t nil 0)))) ;; Delete empty emphasis. (while (search-forward-regexp (concat "") nil t) (replace-match "" t t nil 1)) (progn ;; Move period after closing /EM ;; fix! what about other punct? (goto-char (point-min)) (while (search-forward-regexp (concat "\\(" ;; Not ';' b/c of '"' "[.,]" "\\)" "") nil t) (replace-match (concat "" (match-string-no-properties 1)) t t nil nil))) ;; 2006.09.27 - missing paragraph break inbetween footnotes. (when nil (progn (goto-char (point-min)) (while (search-forward-regexp (concat " [\r] " "\\([*]\\)" "[*]+" ;; fix? include ")" after "*"? " ") nil t) (replace-match (concat "

    \n\n

    \n" (match-string-no-properties 1)) t t nil 1) ))) (progn ;; ^M inside span markup. (when nil ;; Causing two ^M in a row! nil nil nil nil nil nil nil ;; fix! Move this to "Swaps and substitutions". (goto-char (point-min)) (setq _re (_-ws " \\(\\)")) (while (search-forward-regexp _re nil t) (replace-match (concat (match-string-no-properties 1) " "))))) (when nil (progn ;; After deleting some tags: 1st of 2 page numbers (goto-char (point-min)) (while (search-forward " (if (and (setq lb-re (concat "")) ;; fix? ;; Will _-where-page-numbers apply to SGML files? ;; It does not matter: we assume SGML comments can only ;; have true page number always *ABOVE* markup. (if ;; 2006.11.23 - We assume the one above has true page #. ;; 2006.11.23 - _-where-page-numbers was unbound. ;; (string= "top" _-where-page-numbers) t (search-backward-regexp lb-re nil t) (search-forward-regexp lb-re nil t))) (progn (setq lb-str (match-string-no-properties 1)) (setq lb-pt (if ;; 2006.11.23 ;; (string= "top" _-where-page-numbers) t (match-beginning 0) (match-end 0)))) ;; Default: raw ASCII text file. ;; Do not end search with "nil t" (need to fail when default). (setq lb-re lb-re-bracketed-para-integer) (if (string= "top" _-where-page-numbers) (if (not (search-backward-regexp lb-re nil t)) (if (not (search-forward-regexp lb-re nil t)) (error "%s: %s" lb-re (_-buffer-substring-from-))))) (progn (setq lb-str (lb-tx-what-page)) (setq lb-pt (if (string= "top" _-where-page-numbers) (lb-tx-page-point "page-beg") (lb-tx-page-point "page-end")))))))) (if (and (numberp arg1) (= 1 arg1)) (message (concat "page " lb-str)) (if (null arg1) lb-str (cons lb-str lb-pt))) )) ;; (lb-checkup-and-mail-it nil) (defun lb-checkup-and-mail-it nil ; 2005.05.28 "DOCUMENTATION" (let (lb-rc (my-temp-name (concat (temp-directory) "/" (make-temp-name "my-temp-name")))) (with-temp-file my-temp-name ;; (if (setq lb-rc (lb-batch-files-exist nil)) (insert "lb-batch-files-exist\n" lb-rc "\n")) ;; ) (if (< 0 (_-file-bytes my-temp-name)) (_-mail lb-mail-recipient lb-filestamp my-temp-name)) (delete-file my-temp-name))) ;; (looking-at-backward "[ ]+") (defun looking-at-backward (arg1re) "NEW 2007.08.01" (let (pt0 _pt-beg _pt-end (pt-original (point)) (_looking-at-backward--backup-factor 1000) ;; 5000) _rc) ;; fix! greedy / greediness ... ;; fix! searching forward, [ ]+ will move point further than backward. ;; fixed? Only problem is how far back to start for BIG buffers. (save-restriction (save-excursion (if (> (- (point) 3) _looking-at-backward--backup-factor) (forward-char (- 0 _looking-at-backward--backup-factor)) (goto-char (point-min))) ;; (progn (setq _pt-end nil) (while (and (sfr arg1re pt-original t) (setq _pt-beg (match-beginning 0)) (setq _pt-end (match-end 0)) ;; (not (= pt-original _pt-end))) ;; If match found but not da bomb, be ;; conservative and re-do search one point past ;; beginning of this match-beginning. (goto-char _pt-beg) (forward-char 1))) ;; (if (and _pt-end ;; Found at least 1. (= _pt-end pt-original) ;; Last one is da bomb. t) (setq _rc _pt-beg)) )) _rc)) ;; (looking-at-backward-OBSOLETE "[ ]+") (defun looking-at-backward-OBSOLETE (arg1re) "" (let (pt0 (pt-original (point)) _rc) ;; fix! greedy / greediness ... ;; fix! searching forward, [ ]+ will move point further than backward. (save-restriction (save-excursion (when (and (search-backward-regexp arg1re nil t) (= pt-original (match-end 0)) (setq _rc (match-beginning 0))) ;; fix? ;; Somehow the only way to get this to be the opposite ;; of looking-at is to: ;; (1) goto point min ;; (2) while search forward regexp using (point) as lower bound. ;; VERY EXPENSIVE! (while (and (progn ;; 2007.07.31 - "Beginning of buffer" if point-min!!! (forward-char -1) t) (looking-at arg1re) (= pt-original (match-end 0))) (setq _rc (match-beginning 0)))))) _rc)) (defun looking-at-backward-become-forward (arg1re) "If stuff to LEFT of point matches regexp ARG1, move to 'match-beginning 0' and then do a looking-at using ARG1" (let ( _rc) (if (and (setq _rc (looking-at-backward arg1re)) (goto-char _rc)) (looking-at arg1re)))) ;; (string-match-substitute "AAAAAAAA" "BEG" "::AAAAAAAA -->") (defun string-match-substitute (arg1reold arg2strnew arg3str) "Modeled after substitute CL-NEW CL-OLD CL-SEQ but ARG1 is before string, ARG2 is after string and ARG3 is string" (let ( lb-rc) (save-match-data (string-match arg1reold arg3str) (setq lb-rc (replace-match arg2strnew t t arg3str))) lb-rc)) (defun lb-date nil "Now" ;; (lb-date) => "2005.05.22 19:57:48 -0700" (with-temp-buffer ;; (shell-command "822-date" t) (insert (format-time-string "%Y.%m.%d %T %z")) (buffer-substring-no-properties (point-min) (point-max)))) (defun lb-list-index-text (arg1path-begin-with-lang) "Indirect way of calling lb-list-files-of-type-" ;; (lb-list-index-text lb-lang) ;; (lb-list-index-text "es/1974") (let (lb-rc) (lb-list-files-of-type- lb-file-txt arg1path-begin-with-lang))) (defun lb-list-index-html (arg1lang &optional arg2yr) "" ;; (lb-list-index-html lb-lang) (let (x) (lb-list-files-of-type- (concat lb-file-indexhtml ;; 2006.11.17 (if (string= "index" lb-file-indexhtml) ".html") ) arg1lang))) ;; (lb-list-files-of-type- lb-file-txt "en/1976") ;; (lb-list-files-of-type- lb-file-txt "en/1976/GPSPW2PP") (defun lb-list-files-of-type- (arg0-name arg1path-begin-with-lang &optional ) " ARG1 is passed to '-name' in find command. ARG2 is path pre-pended with lb-home and passed to find command." ;; (let (lb-str lb-depth _rc) (when arg1path-begin-with-lang ;; Delete leading slash. (if (string-match "^/" arg1path-begin-with-lang) (setq arg1path-begin-with-lang (substring arg1path-begin-with-lang 1))) ;; Add trailing slash. (if (not (string-match "/$" arg1path-begin-with-lang)) (setq arg1path-begin-with-lang (concat arg1path-begin-with-lang "/"))) ) (with-temp-buffer (setq lb-depth (int-to-string (+ 1 (- 3 (length (split-string arg1path-begin-with-lang "/")))))) (shell-command (concat "find " lb-home "" arg1path-begin-with-lang " -follow" " -mindepth " lb-depth " -maxdepth " lb-depth " -name " arg0-name) t) ;; fix! ;; find: /home/cymbala/leninist.biz/en/.#HTML: No such file or directory ;; why? 2007.07.31 ;; happens while creating en/HTML ! ;; ;;; ;;; /home/cymbala/leninist.biz/en/1939/HCPSU364/index.html ;;; /home/cymbala/leninist.biz/en/1926/MD152/index.html ;;; find: /home/cymbala/leninist.biz/en/.#HTML: No such file or directory ;;; cymbala@debian:~$ ;;; cymbala@debian:~$ #find ~/leninist.biz/en/ -follow -mindepth 3 -maxdepth 3 -name index.html ;;; cymbala@debian:~$ ;;; ;; fixed with this? (progn (goto-char (point-min)) (flush-lines "^find: ")) (setq _rc (buffer-string))) _rc)) (defun lb-get-id-from-path (&optional arg1pf arg2flag-partial) "Return, for example, 'en/1984/AP470'" ;; ;; (lb-get-id-from-path "~/leninist.biz/en/1984/AP470/.db") ;; (lb-get-id-from-path "~/leninist.biz/en/1984/" ) ;; (lb-get-id-from-path "~/leninist.biz/en/1984/" t) ;; (lb-get-id-from-path "~/leninist.biz/en/1984" t) ;; (lb-get-id-from-path "~/leninist.biz/en/" t) ;; (lb-get-id-from-path "~/leninist.biz/en" t) ;; (lb-get-id-from-path "en/1973/WICIR317" t) ;; (lb-get-id-from-path "en/1973/WICIR317/" t) ;; (lb-get-id-from-path "~/leninist.biz/en/1981/1HU376/index.html") (let (lb-str lb-pf _rc) (setq lb-pf (if arg1pf arg1pf (buffer-file-name))) (if (string-match (concat lb-re-path-year+book) lb-pf) (setq _rc (match-string 0 lb-pf)) (if arg2flag-partial (if (string-match (concat lb-re-path-year) lb-pf) (setq _rc (match-string-no-properties 0 lb-pf)) (if (string-match (concat "/" lb-re-lang "/?$") (file-name-directory lb-pf)) (setq _rc (match-string-no-properties 1 lb-pf)))))) (if (and _rc (string-match "/$" _rc)) (setq _rc (replace-match "" t t _rc))) _rc)) ;; fix! use proper _rc for other "lb-get-*" functions. ;; fix! use proper _rc for other "lb-get-*" functions. ;; fix! use proper _rc for other "lb-get-*" functions. (defun lb-get-lang-from-path (&optional arg1pf) "" ;; (lb-get-lang-from-path "~/leninist.biz/en/titl.htmm") (let (my my-pf) (if (not (string-match (concat lb-domain "/" lb-re-lang "/") (setq my-pf (if arg1pf arg1pf (buffer-file-name))))) nil (match-string-no-properties 1 my-pf)))) (defun lb-get-year-from-path (&optional arg1pf) "" ;; (lb-get-year-from-path "~/leninist.biz/en/1984/AP470/.db") (let (lb-str) (nth 1 (split-string (setq lb-str (lb-get-id-from-path arg1pf)) "/")))) (defun lb-get-titlpgs-from-path (&optional arg1pf) "" ;; (lb-get-titlpgs-from-path "ist.biz/en/1976/UFPAA244/20050713/.pageobjs.tx") (let (my my-pf) (if (not (string-match (concat (if nil lb-domain "") "/" lb-re-path-year+book) (setq my-pf (if arg1pf arg1pf (buffer-file-name))))) nil (match-string-no-properties 3 my-pf)))) (defun lb-testing-error-foo (arg1) "" ;; (if (file-exists-p "~/foo") (delete-file "~/foo")) (with-temp-buffer (insert (if (stringp arg1) arg1 (prin1-to-string arg1))) (write-region (point-min) (point-max) "~/foo")) (error "%s" "~/foo")) ;; 2007.03.23 (defun el-demonstrate-interactive-p (arg1) "" (interactive "p") (message "%s" (prin1-to-string arg1))) (defun bug nil "" (error "%s: %s" "Bug-ging from here" (_-buffer-substring-from-))) (provide 'lb-defun) ;;; ; lb-defvar.el0100644000175100017510000010041510647265165013064 0ustar cymbalacymbala ;; Variables. ;; Emacs-Time-stamp: "2007-07-17 18:18:45" (setq file-stamp "Emacs-File-stamp: \"/home/ysverdlov/leninist.biz/lb-defvar.el\"") ;; last-coding-system-used (setq file-coding-system-alist (append (list (cons "\\.tx$" (cons 'iso-latin-1-unix 'iso-latin-1-unix))) file-coding-system-alist)) (defvar _orig-case-fold-search t "") ;; fix! sync with tablenames in .index files (defvar lb-db-tablenames (list "BOOK" ) "") ;; NOTE: See "lb.el" for (defvar lbg-lang-english ;; NOTE: See "lb.el" for (defvar lbg-lang-espanol ;; Uses "setq" (not "defvar"), so last one takes precedence. (unless (featurep 'lb-es) (load "lb-es")) ;; (setq lb-lang (unless (featurep 'lb-en) (load "lb-en")) ;; (setq lb-lang (setq load-path (append (list "~/bin/") load-path)) (setq load-path (append (list "~/leninist.biz/") load-path)) (setq load-path (append (list "~/leninist.biz/stf") load-path)) ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar tx-str-fill-paragraph-midline "" "") (defvar tx-re-fill-paragraph (concat "[ " tx-str-fill-paragraph-midline "]") "") (defvar lbg-max-levels-for-chunking "3" "") ;; 2007.02.17 (defvar lb-str-emacs-time-stamp "Emacs-Time-stamp:" "") (defvar t2h-regexp-src "v[0-9][0-9][a-z][a-z][0-9][0-9]h?[:]?[:]?x?t?p?9?7?" "*Regexp that matches a source's volume, publisher and year") (defvar t2h-regexp-vpst (concat "") "*Regexp that matches ") (if (not (boundp 'lb-home)) ;; (load "lb-defvar-home.el") (defvar lb-home ;; (_makunbound) (let (x y) (setq x (file-stamp-get-stamp)) ;; Assume project is stored in a subdirectory just under ~. (if (string-match (setq y "^[^/]*/[^/]+/\\(.*\\)") x) (setq x (replace-match "" t t x 1)) (error "%s: %s" y x)) x) "Includes trailing slash b/c this is a base directory")) (setq default-directory (expand-file-name lb-home)) (defvar lb-str-footnote-cont-from "__NOTE__ Footnote cont. from page 0." "") (defvar lb-str-footnote-cont-on "__NOTE__ Footnote cont. on page 0." "") (progn (defvar lb-assoc-espanol-accented-to-numeric-entities ;; (_makunbound) (list (list "á" "á") (list "é" "é") (list "í" "í") (list "ó" "ó") (list "ú" "ú") (list "Á" "Á") (list "É" "É") (list "Í" "Í") (list "Ó" "Ó") (list "Ú" "Ú") (list "ñ" "ñ") (list "Ñ" "Ñ"))) (defvar lb-assoc-espanol-accented-to-un ;; (_makunbound) (list (list "á" "a") (list "é" "e") (list "í" "i") (list "ó" "o") (list "ú" "u") (list "Á" "A") (list "É" "E") (list "Í" "I") (list "Ó" "O") (list "Ú" "U") (list "ñ" "n") (list "Ñ" "N"))) (defvar lb-str-espanol-accented-vowels ;; (_makunbound) (let (str) (loop for list in lb-assoc-espanol-accented-to-un do (if (string-match (upcase (nth 1 list)) "AEIOU") (setq str (concat str (nth 0 list))))) str) "") (defvar lb-str-espanol-accented-consonants ;; (_makunbound) (let (str) (loop for list in lb-assoc-espanol-accented-to-un do (if (not (string-match (upcase (nth 1 list)) "AEIOU")) (setq str (concat str (nth 0 list))))) str) "")) (progn (defvar lb-re-__-titles ;; (_makunbound) (concat "__" "\\(" "TITLE" "\\|" "SUBTITLE" "\\|" "SUBTITLE2" "\\)" "__") "") (defvar lb-re-__-lvl4chunking-skipover ;; (_makunbound) (concat "__" "\\(" "AUTHOR" "\\|" "AUTHORS" "\\)" "__") "Paragraphs to skipover") (defvar lb-re-__-lvl-root ;; (_makunbound) (concat "\\(" "NUMERIC" "\\|" "ALPHA" "\\)" "_LVL")) (defvar lb-re-__-lvl ;; (_makunbound) (concat "__" ;; fix! auto-generate from ~/leninist.biz/__ lb-re-__-lvl-root ;; "\\([0-5]\\)" 1 thru 3: en/1981/PCM336/ ;; "\\([0-5]\\)" 1 thru 2: en/1976/UFPAA244/ ;; 2006.11.23 - Need 3rd level in: en/1976/HCFI758/ ;; 2006.11.23 - WARNING: Profound changes can happen now! ;; "\\([0-2]\\)" "\\([0-9]\\)" "__") "") (defvar lb-re-__-lvl4chunking ;; (_makunbound) (if (string-match "[0-9][-]\\([0-9]\\)" lb-re-__-lvl) (replace-match lbg-max-levels-for-chunking t t lb-re-__-lvl 1) (error "%s: %s" "" "")) "Same as variable without '-real' only '0-' is '1-'") (defvar lb-re-__-lvl4chunking-real ;; (_makunbound) (if (string-match "\\(0\\)[-][0-9]" lb-re-__-lvl4chunking) (replace-match "1" t t lb-re-__-lvl4chunking 1) (error "%s: %s" "" "")) "Same as variable without '-real' only '0-' is '1-'") ) ;; fix? ;; How is .pageobjs.tx different from index.txt.log ? (defvar TRIGGER-lb-tx-check-buffer4-trailing-dash ;; (_makunbound) "2007-01-30T14:57:21-0800" "If non-nil, only do check after this _-timestamp") (if ;; not good idea - circumvents CSS. nil (defvar lbg-css-html-background-color (with-temp-buffer (insert-file-contents-literally (concat lb-home "default.css")) (search-forward-regexp "^[ \t]*html[^\n]*[{]") (search-forward-regexp "background-color:[ \t]*\\([a-zA-Z]+\\)") (match-string-no-properties 1)) "")) (defvar lbg-lftp-source nil "File to be sourced by lftp; buffer is live until killed by lb-ht") (defvar _-footnote-marker-style nil "SEE _-find-file-hooks-__-globals") (defvar _-where-page-numbers nil "SEE _-find-file-hooks-__-globals") (progn ;; (defvar lb-ext-html ".html" "") (defvar lb-ext-html "" "Was once: html ... no more") (defvar lb-ext-htmm "htmm" "") (defvar lb-ext-tab "tab" "") (defvar lb-ext-log "log" "") ;; fix? how about .txq files? (defvar lb-ext-tx "tx" "") (defvar lb-ext-txt "txt" "") (defvar lb-re-tx-odd-even (concat "\\([0-9][0-9][0-9]\\)" "\\(odd\\|even\\)" "[.]" lb-ext-tx) "") (defvar lb-ext-txlog "log" "") (defvar lb-file-page-objs ".pageobjs.tx" "") ;; fix! ;; Use .tx for internal text format. ;; Use .txt for whatever David Walters wants. (defvar lb-file-txt (concat "index" "." lb-ext-txt)) (defvar lb-file-tx (concat "index" "." lb-ext-tx)) (defvar lb-file-indextab (concat "index" "." lb-ext-tab)) (defvar lb-file-indexhtml (concat "index" ;; "" lb-ext-html ".html" lb-ext-html ) "")) ;; (lb-get-diskfilename ".index.list" "es" t) ;; (lb-get-diskfilename "taz" "en" ) ;; (lb-get-diskfilename "texto" "es" ) ;; (lb-get-diskfilename "autor" "es" ) ;; (lb-get-diskfilename "titulo" "es" ) ;; (lb-get-diskfilename ".index.list" "en" t) ;; (lb-get-diskfilename "title" "en" t) ;; (lb-get-diskfilename "titl" "en" t) ;; (lb-get-diskfilename "t" "en" t) ;; (lb-get-diskfilename "T" "en" t) (defun lb-get-diskfilename (arg1type &optional arg2lang arg3fl-domain arg4fl-fn) " If optional ARG2 is non-nil, use language ARG2 instead of lb-lang. If optional ARG3 is non-nil, prepend '~/DOMAIN/' to return value" ;; (let ( lb-rc) (if (not arg2lang) (setq arg2lang lb-lang)) ;; 2006.12.12 (setq arg1type (downcase arg1type)) (cond ((string= "T" (upcase arg1type)) (setq arg1type "titl")) ((string= "A" (upcase arg1type)) (setq arg1type "auth")) ((string= "Y" (upcase arg1type)) (setq arg1type "year")) ) (cond ((string= "txt" arg1type) (setq arg1type "text")) ) (cond ((string= "title" arg1type) (setq arg1type "titl")) ((string= "author" arg1type) (setq arg1type "auth")) ((string= "ascii" arg1type) (setq arg1type "text")) ) (cond ((string= "titulo" arg1type) (setq arg1type "titl")) ((string= "autor" arg1type) (setq arg1type "auth")) ((string= "ano" arg1type) (setq arg1type "year")) ((string= "correo" arg1type) (setq arg1type "mail")) ((string= "noticias" arg1type) (setq arg1type "news")) ((string= "texto" arg1type) (setq arg1type "text")) ((string= "finanzas" arg1type) (setq arg1type "ledger")) ((string= "porque" arg1type) (setq arg1type "why")) ) (save-match-data (setq lb-rc (if (not (setq lb-rc (cdr (assoc arg2lang (assoc arg1type lb-assoc-htmm))))) (error "%s: %s" "Not found" arg1type) lb-rc))) (if arg3fl-domain (setq lb-rc (concat "~/" lb-domain "/" lb-rc))) (when arg4fl-fn (setq lb-rc (setq lb-rc (file-name-sans-directory lb-rc))) (setq lb-rc (setq lb-rc (file-name-sans-extension lb-rc)))) lb-rc)) (defvar lb-re-roman-numerals-1-9 ;; (_makunbound) (concat "\\(" "I" "\\|" "II" "\\|" "III" "\\|" "IV" "\\|" "V" "\\|" "VI" "\\|" "VII" "\\|" "VIII" "\\|" "IX" "\\)" ) "") (defvar lb-re-roman-numerals ;; (_makunbound) (concat "\\(" lb-re-roman-numerals-1-9 "\\|" "\\(" "\\(" "X" "\\|XX" "\\|XXX" "\\|XL" "\\|L" "\\|LX" "\\|LXX" "\\|LXXX" "\\|XC" "\\)" "\\(" lb-re-roman-numerals-1-9 "\\)?" "\\)" "\\)" ) "") (defvar lb-list-roman-numerals ;; (_makunbound) (progn (setq x (list)) (loop for i in '("" "X" "XX" "XXX" "XL" "L" "LX" "LXX" "LXXX" "XC") do (loop for j in '("" "I" "II" "III" "IV" "V" "VI" "VII" "VIII" "IX") do (if (> (length (concat i j)) 0) (setq x (append x (list (concat i j))))))) x) "Roman numerals I through XCIX") (defvar lb-assoc-htmm ;; (_makunbound) (list ;; fix! ;; Link w/ filenames used in lb.sh. (list ".db.list" ;; (defvar lb-pf-en-dblist (concat lb-home "en/.db.list") ;; "Refreshed by lb.sh") (cons "en" (concat "en/.db.list")) (cons "es" (concat "es/.db.list")) (cons "xx" (concat "en/aaaaaaaa"))) (list ".index.list" ;; (defvar lb-pf-en-indexlist (concat lb-home "en/.index.list") ;; "Refreshed by lb.sh") (cons "en" (concat "en/.index.list")) (cons "es" (concat "es/.index.list")) (cons "xx" (concat "en/aaaaaaaa"))) (list ".index.html.list" ;; (defvar lb-pf-en-index_html_list (concat lb-home "en/.index.html.list") ;; "Refreshed by lb.sh") (cons "en" (concat "en/.index.html.list")) (cons "es" (concat "es/.index.html.list")) (cons "xx" (concat "en/aaaaaaaa"))) ;; ------------------------------------------------------------------ ;; See DEPENDENCIES in lb-mu-make-webpage. (list "multilingual-ledger" (cons "en" (concat "htm/_multilingual-ledger" "."lb-ext-htmm)) (cons "es" (concat "htm/_multilingual-ledger" "."lb-ext-htmm)) (cons "xx" (concat "en/aaaaaaaa" "."lb-ext-htmm))) ;; ------------------------------------------------------------------ (list "aaaaaaaa" (cons "en" (concat "en/aaaaaaaa" "."lb-ext-htmm)) (cons "es" (concat "es/aaaaaaaa" "."lb-ext-htmm)) (cons "xx" (concat "en/aaaaaaaa" "."lb-ext-htmm))) ;; 2006.11.17 - "a" to "A". (list "auth" (cons "en" (concat "en/A" "."lb-ext-htmm)) (cons "es" (concat "es/A" "."lb-ext-htmm)) (cons "xx" (concat "en/A" "."lb-ext-htmm))) (list "book" ;; lbg-bindtype (cons "en" (concat "en/html/htmm/book" "."lb-ext-htmm)) (cons "es" (concat "es/html/htmm/book" "."lb-ext-htmm)) (cons "xx" (concat "es/html/htmm/book" "."lb-ext-htmm))) (list "faq" (cons "en" (concat "en/FAQ" "."lb-ext-htmm)) (cons "es" (concat "es/FAQ" "."lb-ext-htmm)) (cons "xx" (concat "en/FAQ" "."lb-ext-htmm))) (list "html" (cons "en" (concat "en/HTML" "."lb-ext-htmm)) (cons "es" (concat "es/HTML" "."lb-ext-htmm)) (cons "xx" (concat "en/HTML" "."lb-ext-htmm))) ;; Handle manually. Just point it to a page with real content! ;; (list "index" ;; (cons "en" (concat "en/index" "."lb-ext-htmm)) ;; (cons "es" (concat "es/index" "."lb-ext-htmm)) ;; (cons "xx" (concat "en/index" "."lb-ext-htmm))) (list "ledger" (cons "en" (concat "en/Ledger" "."lb-ext-htmm)) (cons "es" (concat "es/Finanzas" "."lb-ext-htmm)) (cons "xx" (concat "en/Ledger" "."lb-ext-htmm))) (list "links" (cons "en" (concat "en/Links" "."lb-ext-htmm)) (cons "es" (concat "es/Links" "."lb-ext-htmm)) (cons "xx" (concat "en/Links" "."lb-ext-htmm))) (list "sitemap" (cons "en" (concat "en/sitemap" "."lb-ext-htmm)) (cons "es" (concat "es/sitemap" "."lb-ext-htmm)) (cons "xx" (concat "en/sitemap" "."lb-ext-htmm))) ;;; (list "mail" ;;; (cons "en" (concat "en/Mail" "."lb-ext-htmm)) ;;; (cons "es" (concat "es/Correo" "."lb-ext-htmm)) ;;; (cons "xx" (concat "en/Mail" "."lb-ext-htmm))) (list "news" (cons "en" (concat "en/News" "."lb-ext-htmm)) (cons "es" (concat "es/Noticias" "."lb-ext-htmm)) (cons "xx" (concat "en/News" "."lb-ext-htmm))) (list "pdf" (cons "en" (concat "en/PDF" "."lb-ext-htmm)) (cons "es" (concat "es/PDF" "."lb-ext-htmm)) (cons "xx" (concat "en/PDF" "."lb-ext-htmm))) (list "ps" (cons "en" (concat "en/PS" "."lb-ext-htmm)) (cons "es" (concat "es/PS" "."lb-ext-htmm)) (cons "xx" (concat "en/PS" "."lb-ext-htmm))) (list "text" (cons "en" (concat "en/Text" "."lb-ext-htmm)) (cons "es" (concat "es/Texto" "."lb-ext-htmm)) (cons "xx" (concat "en/Text" "."lb-ext-htmm))) ;; 2006.11.17 - "t" to "T". ;; 2006.11.17 - Switch over from "title" to "T" (list "titl" ;; fix! index.html is symbolic link to titles page. (cons "en" (concat "en/T" "."lb-ext-htmm)) (cons "es" (concat "es/T" "."lb-ext-htmm)) (cons "xx" (concat "en/T" "."lb-ext-htmm))) (list "T" (cons "en" (concat "en/T" "."lb-ext-htmm)) (cons "es" (concat "es/T" "."lb-ext-htmm)) (cons "xx" (concat "en/T" "."lb-ext-htmm))) (list "TAZ" (cons "en" (concat "en/TAZ" "."lb-ext-htmm)) (cons "es" (concat "es/TAZ" "."lb-ext-htmm)) (cons "xx" (concat "en/TAZ" "."lb-ext-htmm))) (list "taz" (cons "en" (concat "en/TAZ" "."lb-ext-htmm)) (cons "es" (concat "es/TAZ" "."lb-ext-htmm)) (cons "xx" (concat "en/TAZ" "."lb-ext-htmm))) ;; Switch over from "year" to "19". (list "year" (cons "en" (concat "en/19" "."lb-ext-htmm)) (cons "es" (concat "es/19" "."lb-ext-htmm)) (cons "xx" (concat "en/19" "."lb-ext-htmm))) (list "19" (cons "en" (concat "en/19" "."lb-ext-htmm)) (cons "es" (concat "es/19" "."lb-ext-htmm)) (cons "xx" (concat "en/19" "."lb-ext-htmm))) (list "why" (cons "en" (concat "en/Why" "."lb-ext-htmm)) (cons "es" (concat "es/Porque" "."lb-ext-htmm)) (cons "xx" (concat "en/Why" "."lb-ext-htmm))) ) "List of HTMM files, associated by type, by 2-letter language") (defvar lb-list-href-ok-not-file-exist ;; (_makunbound) (if nil (list "foobar.html") (list ;;; "ta.html" "tb.html" "tc.html" "td.html" "te.html" "tf.html" "tg.html" ;;; "th.html" "ti.html" "tj.html" "tk.html" ;;; "tl.html" "tm.html" "tn.html" "to.html" "tp.html" ;;; "tq.html" "tr.html" "ts.html" ;;; "tt.html" "tu.html" "tv.html" ;;; "tw.html" "tx.html" "ty.html" "tz.html" "TA" "TB" "TC" "TD" "TE" "TF" "TG" "TH" "TI" "TJ" "TK" "TL" "TM" "TN" "TO" "TP" "TQ" "TR" "TS" "TT" "TU" "TV" "TW" "TX" "TY" "TZ" ;;; "aa.html" "ab.html" "ac.html" "ad.html" "ae.html" "af.html" "ag.html" ;;; "ah.html" "ai.html" "aj.html" "ak.html" ;;; "al.html" "am.html" "an.html" "ao.html" "ap.html" ;;; "aq.html" "ar.html" "as.html" ;;; "at.html" "au.html" "av.html" ;;; "aw.html" "ax.html" "ay.html" "az.html" "AA" "AB" "AC" "AD" "AE" "AF" "AG" "AH" "AI" "AJ" "AK" "AL" "AM" "AN" "AO" "AP" "AQ" "AR" "AS" "AT" "AU" "AV" "AW" "AX" "AY" "AZ" ) ) "") (defvar lb-debug t "") (defvar lb-re-file-rawdata ;; (_makunbound) "[.]index$" "") (defvar lb-re-lb-mu-recursive-replace ;; (_makunbound) (concat "" ) "") (defvar lb-domain "leninist.biz" ;; fix! Link with /etc/domain* "DOCUMENTATION") (defvar lb-re-domain "[lL]eninist[.][bB]iz" "DOCUMENTATION") (defvar lb-re-flag-libr ;; (_makunbound) (concat "\\(" "ysverdlov libr" "\\|" lb-re-domain " libr" "\\|" "IBM T30" "\\)" "") "") ;; fix! ;; See if there's a footnote dependency with previous + excluded section. (defvar lbg-ht-update-section-numbers ;; (_makunbound) nil "If non-nil, update HTML for subset of sections") (defvar lb-re-footnote-start ;; (_makunbound) ;; Bug fixed! Was missing "~" as in:

    ~^^1^^ Ibid. (concat "<" "\\(p\\|p[ \t\n][^>]+\\)" ">" "[~ \t\n]*") "") (defvar lb-re-footnote-continued-from-page ;; (_makunbound) (concat "__NOTE__" "[ \t]+" "[Ff]ootnote cont\\(inued\\|[.]\\) " "\\(from\\) pa?ge?[.]? ") "Regexp used by lb-ht-footnote-pop-from-next-section") (defvar lb-re-footnote-continued ;; (_makunbound) (concat "__NOTE__" "[ \t]+" "[Ff]ootnote cont\\(inued\\|[.]\\) " "\\(on\\|from\\) pa?ge?[.]? \\([0-9]+\\)") "Tagged paragraph to explicitly mark footnote text that crosses pages. Usually a footnote is split in the middle of a sentence; if a footnote is split between pages INBETWEEN paragraphs, this tag is needed, so, use it no matter how a footnote is split across two (or more) pages") (defvar lb-list-files-with-id-poundsigns ;; (_makunbound) ;; 2006.11.17 ;; (list "year" "titl") (list "19" "T" "A") "Webpages with #ZZ999-1999 sub-URLs") (defvar lb-max-chars-who-fields-names ;; (_makunbound) (with-temp-buffer (shell-command (concat "cut -f2 " lb-home ;; 2006.11.17 ;; "en/? " ;; 2007.01.29 - see dependencies at top of lb-abbyy.el (if (not (boundp 'lb-lang)) "en" lb-lang) "/" "T?-authors.tab" "| sed 's/[A-Z_]/A/g' | sort | tail -1 " "| awk '{print length($0);}'") t) ;; (message (buffer-string)) (goto-char (point-min)) (if (search-forward-regexp "[0-9]+" nil t) (string-to-int (match-string-no-properties 0)))) "ILLUSTRATOR is longest who-field name") (defvar lb-format-time-string "%Y-%m-%dT%T%z" "For example, to produce full ISO 8601 format, use \"%Y-%m-%dT%T%z\"") (unless (fboundp 'temp-directory) (if (file-exists-p (setq x "/usr/share/emacs/site-lisp/gnuserv/gnuserv-compat.el")) (load-file x))) (defvar lb-page-objs nil ;; (_makunbound) "Array of page objects keyed by instance subpath and page") ;; If no "." in lb-file-* then assume ".html" will be added. ;; (defvar lb-file-indexcard "bibl" "") (defvar lb-file-indexcard "index.card" "") (defvar lb-file-book "book" "") (defvar lb-file-index "index" "") (defvar lb-file-db ".db" "") ;; marker bookmark ... perpetual updates. (defvar lb-list-title-nonsignif-first ;; (_makunbound) (list ;; fix! ;; Divide by language. ;; fix! ;; Delete /en/.TITLE and/or /es/.TITLE if this var changes. "The" "An" "A" "If" "V.I." "V.~I." "La" "Las" "El" "Los" "V." ;; 2007.02.19 - ~/leninist.biz/en/1977/SOE347 ) "") (defvar lb-pf-__ (concat lb-home "__") "") (defvar lb-str-div-class-notes ;; (_makunbound) "

    " ;;
    "") (defvar lb-str-footnote-_-_-_ ;; (_makunbound) "_-_-_" "") (defvar lb-str-_=_=_ ;; (_makunbound) "_=_=_" "") ;; fix? ;; Include trailing whitespace in regexp to prevent having to move over it? ;; Include before/after blank lines in regexp to only accept paragraph matches? (defvar lb-re-footnote-div ;; (_makunbound) (concat "\\(" lb-str-footnote-_-_-_ "\\|" lb-str-_=_=_ "\\)" ) "") ;; Needed to test value found in file. ;; NOT MEANT TO BE USED IN SEARCHING. ;; In .tx files, see __FOOTNOTE_MARKER_STYLE__ [*]+[)]? ;; In .tx files, see __FOOTNOTE_MARKER_STYLE__ [0-9]+ ;; NOTE: Although these are *-re-* they may be compared with (string= ! (defvar lb-str-^^ "^^" "") (defvar lb-re-footnote-marker-style-nil ;; (_makunbound) "nil" "") (defvar lb-re-footnote-marker-style-* ;; (_makunbound) "[*]+" "") (defvar lb-re-footnote-marker-style-*-paren ;; (_makunbound) "[*]+[)]?" "") (defvar lb-re-footnote-marker-style-9 ;; (_makunbound) "[0-9]+" "") (defvar lb-re-footnote-marker-style-nil ;; (_makunbound) "nil" "") ;; 2006.11.16 ;; "~/leninist.biz/en/1989/HCM243/20061115/199.tx" (defvar lb-re-footnote-marker-style-both ;; (_makunbound) "[*0-9]+" "") ;; 2007.06.25 ;; (defvar lb-re-^^marker^^ (defvar _-re-footnote-marker-global ;; (_makunbound) nil "See function lb-tx-globals") (defvar _-where-page-numbers-global ;; (_makunbound) nil "See function lb-tx-globals") (defun lb-assoc-__-PUBL nil "Load lb-assoc-__-PUBL with data from lb-pf-__" ;; (lb-assoc-__-PUBL) ;; (cdr (assoc "PROGMOSC" lb-assoc-__-PUBL)) (let (my my-pt) (with-temp-buffer (setq lb-assoc-__-PUBL nil) (_-ifcl lb-pf-__) (keep-lines "WHO[0-9][0-9][a-z][a-z].*__PUBL__") (goto-char (point-min)) (while (search-forward-regexp ".*__PUBL__[ \t]+" nil t) (replace-match "")) (goto-char (point-min)) (while (search-forward " " nil t) (setq my-pt (save-excursion (end-of-line) (point))) (setq lb-assoc-__-PUBL (append lb-assoc-__-PUBL (list (cons (buffer-substring-no-properties (point-min) (1- (point))) (buffer-substring-no-properties (point) my-pt))))) (delete-region (point-min) (1+ my-pt)))))) (defvar lb-int-db-book-hook-stub-length 2 "") ;; (_makunbound) (defvar lb-re-sgml-attr-class ;; (_makunbound) (concat "[^a-zA-Z0-9]" "[^>]*class=\"" "\\([^\"]+\\)" "\"[^>]*") ;; EXAMPLE: (concat "" "1st character after open-tag name; [^>]*; class=\"PARENTH\"; [^>]*") (defvar lb-re-sgml-include-chunk ;; (_makunbound) "##\\([^#]+\\)##" "") (defvar lb-mail-recipient "webmaster@leninist.biz" "DOCUMENTATION") (defvar lb-db-empty "\n0\n\n0" "An empty database") (progn (defvar lb-re-__ ;; (_makunbound) _-re-__ "*Regexp that matches __PLACE_HOLDER__") (defvar lb-re-__-comment ;; (_makunbound) (progn (string-match "__$" lb-re-__) (replace-match "_COMMENT__" t t lb-re-__)))) (defvar lb-re-year "[12][0-9][0-9][0-9]" "") (defvar lb-re-YYYYMMDD ;; (_makunbound) (concat lb-re-year "[0-1][0-9][0-3][0-9]") "") (defvar lb-re-date ;; (_makunbound) (concat lb-re-year "[.][012][0-9][.][0123][0-9] " "[012][0-9][:][012345][0-9][:][012345][0-9] " "[-][0-9][0-9][0-9][0-9]") "") (defvar lb-re-date-grouped ;; (_makunbound) (concat "\\([23][0-9][0-9][0-9]\\)[.]\\([012][0-9]\\)[.]\\([0123][0-9]\\) " "\\([012][0-9]\\)[:]\\([012345][0-9]\\)[:]\\([012345][0-9]\\) " "\\([-][0-9][0-9][0-9][0-9]\\)") "") (defvar lb-re-db-rec-header ;; (_makunbound) (concat lb-re-date "\t" "[0-9]+" "\t" "[A-Z]+[ ]*" "\t" "[a-z]+") "") (defvar lb-assoc-publ ;; (_makunbound) ;; SEE ALSO: WHO80a[a-z] in file __. (list (list "EC" "Editorial Cartago") ;; 2006.03.01 (list "ECP" "Ediciones de Cultura Popular, Impreso y hecho en M\'exico") (list "ECS" "Editorial de Ciencias Sociales, Ciudad de la Habana") (list "EP" "Editorial Progreso (Moscow)") ;; 2006.10.18 (list "FLPH-H" "Foreign Languages Publishing House, Hanoi") (list "FLPH-M" "Foreign Languages Publishing House, Moscow") (list "FLPH-P" "Foreign Languages Publishing House, Peking") (list "IP" "International Publishers") ;; "© Progress Publishers" (list "MISC" "MISCellaneous") (list "NAUKA" "Nauka Publishers") (list "NPAPH" "Novosti Press Agency Publishing House") (list "PROGMOSC" "Progress Publishers") (list "RAGUDA" "other Soviet imprints, most notably Raguda") ;; (R.Dumain) (list "SOFIA" "Publishing House of the Bulgarian Academy of Sciences") (list "USSRAS" "Academia de Ciencias de la URSS") ;; "and also stuff from the USSR Academy of Sciences" (R.Dumain) (list "dummy0" "dummy") (list "dummy1" "dummy") (list "dummy2" "dummy") (list "dummy3" "dummy") (list "dummy4" "dummy") (list "dummy5" "dummy") ) ;bookmark "") (defvar lb-list-publ ;; (_makunbound) (let (x) (loop for item in lb-assoc-publ do (setq x (append x (list (car item))))) x) "") (progn (defvar lb-assoc-lang ;; (_makunbound) (list (cons "en" "English") (cons "es" "Español")) "") (defvar lb-re-lang "\\(en\\|es\\)" "") ;; fix! how to ensure they synch? (defvar lb-list-lang (progn (setq x (list)) (loop for y in lb-assoc-lang do (_-app 'x (car y))) x)) ) ;; /home/wget/www.w3.org/TR/html4/HTMLlat1.ent ;; RANGE BEG: 192: latin capital letter A with grave. ;; RANGE END: 255: latin small letter y with diaeresis. (defvar lb-re-multilingual-a-z ;; (_makunbound) ;; "/usr/share/emacs/20.7/lisp/simple.el" ;; (insert-and-inherit (unibyte-char-to-multibyte 255)) ;; fix! ;; Need separate lower and uppercase ranges. (concat "a-zA-ZÀ-ÿ" ) "") (defvar lb-re-path-folder_year ;; (_makunbound) (concat "\\(" lb-re-year ;; "\\|9990" ;; No year to be found in item. "\\|0000" ;; No year to be found in item. "\\|9999" ;; Year unknown. "\\)" ;; END: year ) ) "") ;; fix? Why "titlpgs" and not something that suggest abbreviation? (defvar lb-re-path-book-titlpgs ;; (_makunbound) ;; "\\([A-Z]+[0-9]+[xvi]*\\)" ;; en/progmosc/1981/gorky336viii/ ;; "\\([1-9]?[A-Z]+[0-9]+\\)" ;; 2005.12.14: en/1981/1HU376/ ;; Not "[1-9]?[0-9]?" because 1st digit in two-digits may not be matched. ;; Not "[1-9]{0-2} because not supported by Emacs Lisp. ;; Switch to triple choice. 2006.03.01 (concat "\\(" "[A-Z]+[0-9]+" "\\|" ;; Plain book. "[0-9]+[A-Z]+[0-9]+" "\\|" ;; Multi-volume book. "[A-Z]+[0-9]+[A-Z]+" "" ;; Collected/Selected Works. "\\)");; 2006.03.01 "") (defvar lb-re-path-year ;; (_makunbound) (concat "" ;; no leading "/" lb-re-lang "/" ;; lang ;; 20050605 DEL: "\\(progmosc\\|npaph\\)/" ;; publisher lb-re-path-folder_year "" ) "") (defvar lb-re-path-year+book ;; (_makunbound) (concat "" ;; no leading "/" lb-re-path-year "/" ;; 20050606 DEL: "\\([0-9]+[a-z]+" ;; 20050606 DEL: "\\|[0-9]+[a-z]+[0-9]+" ;; en/progmosc/1981/426asss1/ ;; 20050606 DEL: "\\|[a-z]+[0-9]+" lb-re-path-book-titlpgs "/" ;; id ) "") (defvar lb-re-tx-100pages ;; (_makunbound) (concat "[0-9][0-9][0-9]" "[.]" lb-ext-tx) "") (defvar lb-re-path-year+book-instance ;; (_makunbound) (concat lb-re-path-year+book "\\(" lb-re-YYYYMMDD "\\)") "" ) (defvar lb-file-dot-index ".index" "") (defvar lb-re-file-book-index ;; (_makunbound) (concat lb-re-path-year+book lb-re-file-rawdata) "") ;; Or, simply document subdirectory contents in .index !!! (defvar lb-file-filelist ;; (_makunbound) "~/leninist.biz/index.filelist" "Site-wide list of files") (progn (defvar lb-re-bracketed-integer ;; (_makunbound) ;; "[-[{]?\\([0-9]+\\)[]}-]?" ;; "- 1 -" page numbers (es/1979/EDL178/) ;; -------------------------------------------- ;; fix! ;; was: lb-re-bracketed-integer "[-[{]?\\([-]?[0-9]+\\)[]}-]?" ;; AMBIGUITY: if number surrounded by "-9-" negative #'s not possible! ;; AMBIGUITY: "-" in "-9" will be sucked-up as a delimiter, not negative. ;; NOT A PROBLEM! Will always have "[]" delimiters: [-99]. ;; fix? must include spaces: "- -9 -" (page negative nine). ;; ;; WORKING as of August 2006: ;; (concat "[-[{]?" "\\([-]?[0-9]+\\)" "[]}-]?") ;; ;; WARNING: next one, if used, would change grouping. ;; (concat "\\(" "[[{]" "\\)?" "\\([-]?[0-9]+\\)" "[]}]?") ;; ;; NOTE: next one has "?" changed to "*" due to "- " and " -" in "- 99 -". ;; (concat "[[ {-]" "*" "\\([-]?[0-9]+\\)" "[] }-]" "*") ;; (concat "[-[{]?" "\\([-]?[0-9]+\\)" "[]}-]?") ;; "- 1 -" page numbers (es/1979/EDL178/) ... what about spaces? "?" "*"? ;; "[-1]" page numbers (es/1977/ERD148/) ;; NUTS! Have to change grouping (2006.08.23). ;; NUTS! This regexp used as base for several other regexps! ;; "[[ {-]*" will extract "99" from "[-99]" (but works with: "- 99 -"). ;; - -99 - ;; - 99 - ;; [99] ;; [-99] ;; {99} ;; 2007.02.25 (concat "[-[{]?" "\\([-]?[0-9]+" "\\|" ;; fix? "[ivxIVX][ivxIVX]?[ivxIVX]?[ivxIVX]?[ivxIVX]?[ivxIVX]?" "\\)" "[]}-]?") "") (defvar lb-re-bracketed-integer-anchored ;; (_makunbound) ;; Include whitespace in case of mixup about ARG1 and ARG2 of _-para. (concat "^[ \t]*" lb-re-bracketed-integer "[ \t" ;; 2007.06.13 "\r" "]*$") "")) (progn (defvar lb-re-bracketed-para-integer-top-of-file ;; (_makunbound) (concat "\n[ \t]*" ;;"\\([0-9]+\\)" lb-re-bracketed-integer "[ \t" ;; 2007.06.13 "\r" "]*\n[ \t]*\n") "A paragraph with an integer: 1 newline before, 2 newlines after. Used by lb-db to keep count of records in an .index file") (defvar lia-re-para-vpst ;; (_makunbound) (concat "\n[ \t]*\n[ \t]*" t2h-regexp-vpst "[ \t]*\n[ \t]*\n") "See lia-tx.el (symbolic link) for t2h-regexp-vpst") ;; ------------------------------------------------------- ;; SEE ALSO: t2h-regexp-number-as-paragraph ;;; "[ ;;; ]\\([ ]*[ ;;; ]\\)+\\([0-9]+\\)[ ;;; ]\\([ ]*[ ;;; ]\\)+" ;; fix! "-para" should go at end, for sorting purposes. (defvar lb-re-bracketed-para-integer ;; (_makunbound) (concat "\n[ \t]*" lb-re-bracketed-para-integer-top-of-file) ;; Modification for LB: add 2nd newline *BEFORE* integer! ;; One with just *ONE* newline before integer allows integer at top of file. "A paragraph with an integer: 2 newlines before, 2 newlines after") ;;; " ;;; [ ]* ;;; [ ]*[-[{]?\\([-]?[0-9]+\\)[]}-]?[ ]* ;;; [ ]* ;;; " ) ;; (defvar lb-re-sgml-comment-spdw ;; (_makunbound) (concat "") "") (defvar lb-AZ "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "") (defvar lb-az "abcdefghijklmnopqrstuvwxyz" "") (defvar lb-mu-template-paths ;; (_makunbound) (list (cons lbg-lang-english (concat lb-home lbg-lang-english "/template/template/template/")) (cons lbg-lang-zzzzzzz (concat lb-home lbg-lang-zzzzzzz "/template/template/template/"))) ;; EXAMPLE: (_-cda "en" lb-mu-template-paths) "") ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar lb-mu-template-titles ;; (_makunbound) (list (cons lbg-lang-english (concat lb-home lbg-lang-english "/T")) ;; WAS titl.html (cons lbg-lang-zzzzzzz (concat lb-home lbg-lang-zzzzzzz "/T"))) ;; EXAMPLE: (_-cda "en" lb-mu-template-titles) "") (defvar lb-mu-template-authors ;; (_makunbound) (list (cons lbg-lang-english (concat lb-home lbg-lang-english "/A")) (cons lbg-lang-zzzzzzz (concat lb-home lbg-lang-zzzzzzz "/A"))) ;; EXAMPLE: (_-cda "en" lb-mu-template-authors) "") (defvar lb-mu-template-years ;; (_makunbound) (list (cons lbg-lang-english (concat lb-home lbg-lang-english "/19")) (cons lbg-lang-zzzzzzz (concat lb-home lbg-lang-zzzzzzz "/19"))) ;; EXAMPLE: (_-cda "en" lb-mu-template-years) "") (defvar lb-mu-template-text ;; (_makunbound) (list (cons lbg-lang-english (concat lb-home lbg-lang-english "/Text")) (cons lbg-lang-zzzzzzz (concat lb-home lbg-lang-zzzzzzz "/Text"))) ;; EXAMPLE: (_-cda "en" lb-mu-template-text) "") (defvar lb-mu-template- ;; (_makunbound) (concat lb-home "") "") ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar lbg-ftp-save-source-p nil "Flag to force saving lftp source if saving not triggered by date") (defvar t2h-regexp-sgml-tags-solo "\\(br\\|img\\|hr\\|meta\|link\\)" "*Regexp that matches SGML tag names that do not have close tags") (defvar t2h-regexp-open-tag "<[ \t\n]*[a-zA-Z0-9]+[ \t\n>]" "*Regexp that matches an open tag") (defvar t2h-regexp-close-tag "<[ \t\n]*/[ \t\n]*[a-zA-Z0-9]+[ \t\n]*>" "*Regexp that matches a close tag") (defvar t2h-regexp-close-h9 nil "*Regexp that matches a specific close heading tag") (defvar t2h-flag-loop-message nil "Flag to turn on looping messages") (provide 'lb-defvar) ;;; ; lb-edits.el0100664000175100017510000016255610654127331012733 0ustar cymbalacymbala ;; Leninist.Biz! ;; Emacs-Time-stamp: "2007-08-01 09:03:37" (setq file-stamp "Emacs-File-stamp: \"/home/ysverdlov/leninist.biz/lb-edits.el\"") (defvar lb-ext-edits-push "push" "") ;; Helpers for manual editing. (progn (global-set-key "\C-c\C-k" 'lb-edits-push-paragraph) ;; See: lb-tmm.el !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ;; (local-set-key [f5] '_-para-delete) (local-set-key [C-f11] 'lb-edits-pop-file) (global-set-key [f2 ?h] '(lambda nil "" (interactive) (lb-something-to-html))) (global-set-key [f2 ?r] '(lambda nil "" (interactive) (lb-tx-make-or-refresh-indextx))) (global-set-key [f2 ?u] '(lambda nil "" (interactive) (_-tex2unibyte t))) ) ;; (defun tx-editing-turn-off-hooks-early-on (&optional arg1) "" ;; (interactive) ;; fix! ;; If ARG1 is non-nil, just return list of hooks for tx-check-buffer! ;; If ARG1 is nil, delete hooks. ;; That way list of functions can be shared. (delete-hook 'local-write-file-hooks 'lb-tx-chk-^^) (delete-hook 'local-write-file-hooks 'lb-tx-check-buffer4-singularities) (delete-hook 'local-write-file-hooks 'lb-tx-check-buffer4-trailing-dash) (delete-hook 'local-write-file-hooks 'lb-tx-check-buffer4-para-break-before-last-line) ) ;; (defun tx-editing-rename-image (&optional arg1) "Use this function after typing father ... BEFORE: \"199-1.jpg\" AFTER: \"199-1.jpg\" " ;; (interactive) (let (_re _fn-new _fn-old _dir-old _dir-new _rc) (save-match-data (save-excursion (progn (setq _dir-old (file-name-directory (bfn))) (if (not (looking-at (setq _re "[.]jpg\" alt="))) (error "%s: %s" "For now, expecting point at" _re)) (search-forward-string "jpg") (search-backward-regexp (concat "src=\"" "\\(" "[0-9]+" "[-]" ".*" "\\)" )) (setq _fn-new (match-string-no-properties 1)) (search-forward-regexp (concat "alt=\"" "\\(" "[^\"]+" "\\)" "\"")) (setq _fn-old (match-string-no-properties 1)) ;; Remove trailing slash. 1 of 2. (setq _dir-new (substring _dir-old 0 (1- (length _dir-old)))) ;; Maybe move image up one bdirectory level. (when (string-match lb-re-path-year+book-instance _dir-new) (setq _dir-new (file-name-directory _dir-new)) ;; Remove trailing slash. 1 of 2. (setq _dir-new (substring _dir-new 0 (1- (length _dir-new))))) ) (rename-file (concat _dir-old "" _fn-old) (concat _dir-new "/" _fn-new)) (recenter) ))_rc)) ;; (local-set-key "\C-y" 'tx-editing-yank) ;; (local-set-key "\C-y" 'yank) ;; (local-set-key [Ctrl-y] 'tx-editing-yank) (defun tx-editing-yank (&optional arg) "Runs traditional yank, then runs a hook to automate certain editing functions. With prefix argument, does everything except traditional yank" ;; from simple.el (interactive "*P") (let (_pt-save-excursion _pt-exchange _rc) (save-match-data (if (or (not arg) (and arg (/= 4 (car arg)))) (yank arg)) ;; If looking at a paragraph that begins with a naked "*". (save-excursion (if (or (not arg) (and arg (/= 4 (car arg)))) (exchange-point-and-mark)) (setq _pt-exchange (point)) (when (and (looking-at (concat _-whitespace-wM "*" "

    " _-whitespace-wM "*" "[~]?")) (goto-char (match-end 0))) (when (or (looking-at (concat "\\(\\^\\)*" "[*]" "\\(\\^\\)*" " ")) (looking-at (concat "\\^\\^" "[0-9]+" "\\^\\^" " "))) (goto-char _pt-exchange) (tx-editing-insert-_-_-_) (if (looking-at lb-str-footnote-_-_-_) (setq _pt-save-excursion (point)))))) (if _pt-save-excursion (goto-char _pt-save-excursion)) ) _rc)) ;; (local-set-key [f2 d] 'tx-editing-del-para) (defun tx-editing-del-para () "Delete this paragraph, or the one after this blank line" (interactive) (let (_wdn _rc) (save-match-data (if (_-blank-line-p) (_-move-forward-whitespace)) (delete-region (car (setq _wdn (_-where-double-newlines))) (cdr _wdn)) ) _rc)) (defun tx-editing-common-prep nil "" ;; (let (_rc) (save-match-data ;; 2006.12.28 ;; Default _-where-page-numbers seems to be "bottom". ;; After header inserted with "top" value, this should be run. ;; Running it here to change value early-on. (_-find-file-hooks-__-globals) ;; fix! When page number inserted, search for next pageno and if ;; the same, delete it. ;; (when (_-blank-line-p) (tx-editing-compress-here-multiple-newlines)) ;; fix! Looking up to find

    to delete, skipover __PRINTERS_P_999_COMMENT__ ;; Cursor Ctrl-LEFT to close P tag. (when (looking-at "p>[ ]*\r\n") (goto-char (match-end 0)) (_-move-forward-whitespace) (when (looking-at "__PRINTERS_P_") (goto-char (cdr (_-where-double-newlines))) (_-move-forward-whitespace))) ;; 2007.01.12 - move from blank line under page number to page number. (when (and (_-blank-line-p) (save-excursion (forward-line -1) (string-match lb-re-bracketed-integer-anchored (_-current-line)))) (forward-line -1)) ;; May have just finished typing page number. (if (save-excursion (beginning-of-line) (looking-at lb-re-bracketed-integer)) (beginning-of-line)) ;; Probably in blank line above first page number. ;; Probably going to do tx-editing-insert-page-break-mid-paragraph next. (progn (_-move-forward-whitespace t) (if (not (_-blank-line-p)) (goto-char (car (_-where-double-newlines))))) ) _rc)) ;; (local-set-key [f2 f6] 'tx-editing-del-recto-pageno) (defun tx-editing-del-recto-pageno (&optional arg1) "Place cursor on or before paragraph with verso page number and try to delete next three (3) paragraphs (two running headers and recto page number) up to and including last paragraph with recto page number. With prefix argument, does not check 3rd paragraph for valid page number" (interactive "p") (let (lb-para lb-pageno-verso lb-pageno-verso-end lb-pageno-recto lb-pageno-recto-expected lb-pageno-recto-end _rc) (save-match-data (save-excursion (tx-editing-common-prep) ;; Expecting point on line with page number. (when (and (string-match lb-re-bracketed-integer-anchored (setq lb-para (car (_-para t t)))) (setq lb-pageno-verso (match-string-no-properties 1 lb-para)) (setq lb-pageno-recto-expected (int-to-string (1+ (string-to-int lb-pageno-verso)))) (setq lb-pageno-verso-end (save-excursion (goto-char (cdr (_-where-double-newlines))) (point))) ) (loop for i from 1 to 3 do (progn (goto-char (cdr (_-where-double-newlines))) (_-move-forward-whitespace)) (if (or ;; 3rd paragraph has a real page number. (and (string-match lb-re-bracketed-integer-anchored (setq lb-para (car (_-para t t)))) (setq lb-pageno-recto (match-string-no-properties 1 lb-para))) ;; Fake it. (and (= 3 i) ;; fix! ;; Display current paragraph and prompt for delete. (and arg1 (= 4 arg1)) )) (setq lb-pageno-recto-end (save-excursion (goto-char (cdr (_-where-double-newlines))) (point))) ) ) ;; loop )) ;; fix! ;; With prefix argument, assume a page number after next 2 paragraphs. (when (and lb-pageno-verso-end lb-pageno-recto-end) (goto-char lb-pageno-verso-end) (delete-region lb-pageno-verso-end lb-pageno-recto-end) (setq _rc t) (recenter)) ;; fix! ;; if "

    " ends previous paragraph, ;; if "

    " starts next paragraph, ;; ask whether to delete the pair. ) _rc)) ;; (defun tx-editing-insert-footnote-marker (&optional arg1) "With point at '*' or in '***' or after '*' this changes asterik(s) to a footnote marker (and maybe changes '*' to an integer)" ;; (interactive "p") (let (_str-sbr _str-sfr _page-beg _footnotes-beg _re _rc) ;; fix! must start with "*" "**"... change to "1" "2"... ;; based on __FOOTNOTE_MARKER_STYLE__ (save-match-data (save-excursion ;; * (while (looking-at-backward-become-forward "[*]+")) ;; (when (looking-at-backward-become-forward "[0-9]*") (forward-char 1)) ;; * (when (looking-at "[*]+") (setq _rc t) (replace-match (concat "^^" (match-string-no-properties 0) "^^")) (sbs "^^") (sbs "^^") ;; Spaces before "*" (while (looking-at-backward-become-forward " ") (replace-match "~") (backward-char 1)) ;; fix? Could be a global hook always done at beginning of [f2 f2] (if (looking-at-backward-become-forward "[>).,?]\\("\\)") (replace-match "''" t t nil 1)) (if (looking-at-backward-become-forward "\\("\\)[>).,?]") (replace-match "''" t t nil t)) (sfs "^^") (sfs "^^")) ;; (when (and (_-sgml-markup-p) (string= "SUP" (_-sgml-what-element))) (sfs ">") (when (and (looking-at "[0-9]+") (looking-at-backward-become-forward "")) (setq _rc t) (replace-match "^^") (sfr "[0-9]+") ;; (if (looking-at "") (replace-match "^^") (if (looking-at (concat "\\(" _-whitespace-wM "+" "\\)" "")) (replace-match (concat "^^" (match-string-no-properties 1))) (error "%s: %s" "Tried to replace " (_-buffer-substring-from-)))))) (when _rc ;; 2007.05.31 - may want to change "*" to "1". (looking-at-backward-become-forward "\\^\\^") ;; 2007.06.14 (if (and ;; 1-of-3. (string-match "0-9" _-footnote-marker-style) ;; 2-of-3. (save-excursion (setq _page-beg (lb-tx-page-point "page-beg")) (setq _footnotes-beg (lb-tx-page-point "footnotes-beg")) (setq _re "\\^\\^\\([0-9]+\\)\\^\\^") ;; If in footnote area and no previous ;; footnote, use top-most footnote number ;; in body. ;; HMMMM... without _-_-_ it is NOT working... so, ;; Look for "

    \n" to left of '*' or '^^*^^' (if (or ;; Use either previous footnote in this page's ;; body, or last footnote in previous page ;; with footnotes (either in footnotes or in body). (not _footnotes-beg) ;; HAVE FOOTNOTES... ;; Point above footnotes separator bar. (< (point) _footnotes-beg) ;; Point below footnotes separator bar. (save-excursion (sbr _re _footnotes-beg t))) (if (sbr _re ;; 2007.07.06 ;; (lb-tx-page-point "page-beg") nil t) (setq _str-sbr (match-string-no-properties 1))) ;; No ^^999^^ above point in footnotes region, ;; so, must find one from top of page. (goto-char _page-beg) (if (sfr _re _footnotes-beg t) (setq _str-sfr (match-string-no-properties 1)) (error "%s: %s" "Did not find ^^999^^" "in body")))) ;; 3-of-3 (looking-at-backward-become-forward "[*]+")) (replace-match (int-to-string (if _str-sfr (string-to-int _str-sfr) (1+ (string-to-int _str-sbr))))))) )) _rc)) ;; (defun tx-editing-insert-endnote-marker (arg1) "Add 1 to previous existing endnote marker and insert here" ;; (interactive "p") (let (re-^^marker^^ re-4-string-match n-previous n-current _rc) (save-match-data (progn (_-move-forward-whitespace) ;; point before "

    " (if (looking-at "")) ;; point after "p" in "

    " (if (looking-at ">") (forward-char 1)) (_-move-forward-whitespace)) (save-excursion (if (not (search-backward-regexp (setq re-^^marker^^ "\\^\\^\\([0-9]+[a-c]?\\)\\^\\^") nil t)) (error "%s: %s" "Looking backward" re-^^marker^^)) (setq n-previous (match-string-no-properties 1)) (if (string-match "[a-z]" n-previous) (error "%s: %s" "What to do with alpha in marker" n-previous)) n-previous) (if (not (string-match (setq re-4-string-match (concat "

    " _-whitespace-noM"*" "[~]?" _-whitespace-noM"*" )) (_-buffer-substring -10))) (error "%s: %s" "Expecting before point" re-4-string-match)) (insert "^^" (setq n-current (int-to-string (1+ (string-to-int n-previous)))) "^^" " ") (set-mark (point)) (forward-paragraph) (recenter) (message (setq _rc n-current)) )_rc)) ;; (local-set-key [f2 f2] 'tx-editing-contextual-insert-) (defun tx-editing-contextual-insert- nil "Attempt to do something based upon context" ;; (interactive) (let (_which-worked (noerr t) _rc) (save-match-data ;; (save-excursion ;; Let's get general! So, change this function to just _-contextual? (or (tx-editing-contextual-insert-smart-quote) ;; fix! if in B or EM tag, insert class="sic" (tx-editing-contextual-insert-blockquote) (tx-editing-contextual-insert-__printers) (tx-editing-insert-footnote-cont noerr) (tx-editing-contextual-insert-class-sic) (if (tx-editing-insert-footnote-marker) (setq _which-worked "tx-editing-insert-footnote-marker")) ;; (_-describe-function) (find-function-at-point) (tx-editing-del-recto-pageno) ;; LAST: ;; (tx-editing-change-p-to-alpha_lvl) ) ) (if _which-worked (message "%s" _which-worked)) _rc)) ;; (defun tx-editing-insert-footnote-cont (&optional arg1noerr) "" ;; (interactive) (let (_pg (_cfs case-fold-search) (_re-paz (concat _-whitespace-noM "*" "\\(

    \\)" _-whitespace-noM "*" "[a-z]" ;; cfs )) _rc) (save-excursion (save-match-data ;; Just deleted

    ? (when (looking-at "[ \t]*[\r][\n]") (goto-char (match-end 0))) ;; 2007.03.27 - insert divider? (setq case-fold-search nil) (when (and (null (lb-tx-page-point "footnotes-beg")) (_-blank-line-p) (looking-at _re-paz)) (beginning-of-line) (insert "\n\n" lb-str-footnote-_-_-_ "\n\n")) (defun foo (arg1str arg2offset) (let (_rc) (tx-editing-compress-here-multiple-newlines) (setq _pg (lb-tx-what-page)) (insert "\n" (with-temp-buffer (insert arg1str) (search-backward-string " 0") (replace-match (concat " " (int-to-string (+ arg2offset (string-to-int _pg))))) (buffer-string)) "\n") (setq _rc t) _rc)) ;; MAIN (cond ;; Cont. on? ((and ;; In footnotes area? (lb-tx-page-point "footnotes-beg") ;; At end of page? (save-excursion (_-move-forward-whitespace) (= (point) (lb-tx-page-point "page-end-without-number" "__PRINTERS")))) ;; If both of the above are true, something has to give. (if (and ;; Manually remove "

    " from end of paragraph that continues ON. (save-excursion (and (search-backward-regexp _-^whitespace-wM) (if (not (string= ">" (match-string-no-properties 0))) t (search-backward-string "<") (not (looking-at ". (if (looking-at _re-paz) (replace-match "" t t nil 1)) (if (save-excursion (_-move-forward-whitespace) (looking-at "" "\n\n")) (search-forward-string "

    ") (goto-char (cdr (_-where-double-newlines))) (insert "\n\n" "" "\n\n") (backward-paragraph)) _rc)) ;;; MOVED FROM: ~/www.marxists.org/archive/lenin/howto/lia.el (defun tx-editing-contextual-insert-__printers nil "For PRINTERS_999_NOTE." ;; (interactive) (let (lb-data _rc) (save-match-data (save-excursion ;; fix! ask whether to delete

    above, like inserting _-_-_ does. ;; fix? This should be in standard function for all tx-editing-insert-* (progn (if (not (looking-at "[ \t\r]*[\n][ \t]*[\n]")) (_-move-forward-whitespace t)) (if (_-blank-line-p) (_-move-forward-whitespace)) (goto-char (car (_-where-double-newlines)))) (cond ((looking-at (concat "

    " _-whitespace-noM "*" "\\(" "" "\\)?" "\\(" "[0-9]+[*]" "\\|" "[0-9]+[-]+[0-9][0-9]+[*]?" "\\)" "\\(" "" "\\)?" "\\(

    " _-whitespace-noM "*\\)?" _-whitespace-noM "*" "

    " "[ \t\r]*" "\n" "[ \t\r]*" "\n")) (setq lb-data (concat (match-string-no-properties 1) (match-string-no-properties 2) (match-string-no-properties 3))) (_-para-delete) (insert (setq _rc (concat "__PRINTERS_P_" (lb-tx-what-page) "_COMMENT__\n" lb-data "\n\n")))) ;; This matches *both* !!! ;;

    ;; 31---826 ;;

    ((or (string-match (concat "^[0-9]+[-][-][-][0-9][0-9]+" _-whitespace-wM "*" "$") (car (_-para))) (string-match (concat "^[0-9]+[*]+" _-whitespace-wM "*" "$") (car (_-para))) ) (insert (setq _rc (concat "__PRINTERS_P_" (lb-tx-what-page) "_COMMENT__\n")))) (t (if t t ;; changed to -contextual- (error "%s: %s" "Not matched" (car (_-para))))) ))) ;; Move to blank line under inserted text. (if _rc (while (not (_-blank-line-p)) (forward-line 1))) _rc)) ;;; MOVED FROM: ~/www.marxists.org/archive/lenin/howto/lia.el ;; (local-set-key [f2 f2] 'tx-editing-insert-__progress_comment__) (defun tx-editing-insert-__progress_comment__ (arg1) "For NOTES. Place cursor before or after '

    ' in '

    p. 999

    '" (interactive "p") (let (lb-n lb-pt0 lb-flag-edit lb-rc) (save-excursion (save-match-data ;; Point after "p":

    (if (looking-at ">") (forward-char 1)) ;; This will move point to left of "p. 999" if point ;; on blank line under "

    ". (looking-at-backward-become-forward (concat "p." "[ ]+" "[0-9]+[ ]*

    " "[ \t\r]*" "\n")) ;; Move over open or close P tag(s). (if (looking-at (concat _-whitespace-wM "*" "\\(

    \\)?" _-whitespace-wM "*" "

    ")) (goto-char (match-end 0))) ;; (_-move-forward-whitespace) ;; (when (looking-at (concat "\\(p[.][ ]+[0-9]+\\)" "\\(

    \\)" )) (setq lb-pt0 (point)) (replace-match (concat "\n\n" "__PROGRESS_COMMENT__" "\n" (match-string-no-properties 1) "\n\n" (match-string-no-properties 2))) (goto-char lb-pt0) (_-move-backward-whitespace) (if (looking-at-backward-become-forward (concat "

    " _-whitespace-wM "*" "

    ")) (replace-match "")) (search-forward "

    ") ;; Signaling: (error "Lisp nesting exceeds max-lisp-eval-depth") ;; (lb-save-buffer-control-M) ;; Move to "\n\n=\n\n" (setq lb-flag-edit (point))) ;; What does this do? (when (looking-at (concat _-whitespace-wM "*" "=" "[ \t]*" "[\n]" "[ \t]*" "[\n]" "

    " _-whitespace-wM "*" "[~]?" "^^" "\\([0-9]+\\)" "^^" "[ \t]*")) (replace-match (concat "\n\n" (match-string-no-properties 1) "\n\n" "

    " "\n")) (setq lb-flag-edit (point))) )) (when lb-flag-edit (goto-char lb-flag-edit) (recenter)) lb-rc)) ;;; ------------------------------------------------------- ;; (tx-editing-while-interline-CR-insert-br) (defun tx-editing-while-interline-CR-insert-br nil "From beginning of paragraph, search for carriage returns and insert BR tag up to, not including, last carriage return" ;; (interactive) (let (_pt _rc) (_-goto-beginning-of-paragraph t) ;; Skip first one. (while (and ;; If there is just one CR: (< (point) (setq _pt (cdr (_-where-double-newlines nil t)))) (sfr (concat "[\r][-]?[0-9]*" _-whitespace-noM "+") _pt t)) (if (not (looking-at " "))) ;; (_-goto-beginning-of-paragraph) _rc)) ;; (defun tx-editing-change-p-to-caption (&optional arg1) "" ;; (interactive "p") (let (_rc) ;; (tx-editing-change-p-to- "__CAPTION__") ;; Time to move on. (tx-editing-forward-paragraph) _rc)) ;; (defun tx-editing-change-alpha-to-h9 (&optional arg1) " This undoes p-to-alpha " ;; (interactive "p") (let (_ms0 _ms1 _ms2 _rc) (_-goto-beginning-of-paragraph) (when (looking-at lb-re-__-lvl4chunking-real) (setq _ms0 (match-string-no-properties 0)) (setq _ms1 (match-string-no-properties 1)) (setq _ms2 (match-string-no-properties 2)) (replace-match (concat "") t) ;; (if (looking-at _-whitespaces-wM) (replace-match "")) (goto-char (cdr (_-where-double-newlines nil t))) (insert (concat "")) ;; 2007.06.28 ;; fix! share these two with tx-editing-change-p-to-alpha_lvl, etc. (t2h-fill-paragraph-control-M) (tx-editing-forward-paragraph) ) _rc)) ;; (defun tx-editing-change-p-to-h9 (&optional arg1) "" ;; (interactive "p") (let (_rc) (tx-editing-change-p-to- (progn (while (not (string-match "^[1-6]$" (setq _i (read-input "Type an integer after 'H'... change P tag to H" (save-excursion (save-match-data (if (sbr "<[hH]\\([0-9]\\)" nil t) (msn 1))))))))) (concat "")) (concat "")) ;; 2007.02.22 - Delete whitespace after H9 tag because ;; first word not bold if not on line with open H9. (if (not (looking-at (concat "\\(" _-whitespace-wM "*" "\\)"))) (error "%s: %s" "Expecting to be" "at beginning of blankblock.") (replace-match "" t t nil 1)) ;; 2007.04.08 (when arg1 (goto-char (car (_-where-double-newlines))) (if (not (looking-at "\\)?" ;; fix! use Roman numerals regexp. "\\(" "I+\\|IV\\|VI*\\|IX\\|X+I*\\|X+IV\\|XVI*\\|XIX" "\\)" "\\(\\)?" "

    " ;; end anchor ) (cdr (_-where-double-newlines)) t)) ;; (save-excursion (search-forward-regexp ;; fix: Below, do not use "Part" b/c in middle. ;;;__ALPHA_LVL3__ ;;;The Struggle for Democracy-an Integral Part ^M ;;;
    of the Struggle for Socialism     ^M (concat "\\(" "[cC]hapter" "\\|" "[sS]ection" "\\|" "[pP]art[^a-zA-Z]" "\\)" ) (cdr (_-where-double-newlines)) t)) ) (setq _lvl-type "__NUMERIC_LVL")) ) ;; (tx-editing-change-p-to- (progn (while (not (string-match "^[1-6]$" (setq _i (read-input "Change LVL to: " (save-excursion (setq _i-initial-input ;; Above paragraph is an ALPHA. (if (and _lvl-in-previous-paragraph-type (string= "ALPHA" _lvl-in-previous-paragraph-type)) (int-to-string (1+ (string-to-int _lvl-in-previous-paragraph-number))) ;; Other above paragraph has a LVL. (save-match-data (if (sbr "_LVL\\([0-9]\\)__" nil t) (if (not (_C-u arg1)) (msn 1) (int-to-string (1+ (string-to-int (msn 1))))))))) _i-initial-input) ))))) (concat _lvl-type "" _i "__"))) ;; 2006.12.15 - This "-change-p-to-" has this; others do not. (t2h-save-buffer-control-M) ;; Time to move on. (tx-editing-forward-paragraph)) ;; 2007.06.27 - insert carriage returns. ;; "/home/cymbala/leninist.biz/en/1972/MLOWA430/20070603/099.tx" (when (and (not _lvl-type) (string-match "__ALPHA_LVL" (buffer-substring (car (setq _cons (_-where-double-newlines))) (cdr _cons)))) (goto-char (car _cons)) (sfs "__") (sfs "__") (_-move-forward-whitespace nil) (while (not (_-blank-line-p)) (when (not (string-match "[\r]" (_-current-line))) (end-of-line) (insert " \r")) (end-of-line) (forward-char 1))) _rc)) ;; (defun tx-editing-change-p-to- (arg1markup-beg &optional arg2markup-end) "Called by: -p-to-h9 -p-to-alpha_lvl -p-to-caption Inserts BR tags at beginning of each line and fills paragraph" ;; (let (_re _rm _rc) ;; (save-excursion (save-match-data ;; Do this if calling function requires pre-processing. (_-goto-beginning-of-paragraph) (progn ;; Got P tag around everything? (_-goto-end-of-paragraph t) (goto-char (cdr (_-where-double-newlines nil t))) (forward-char -1) (if (not (looking-at (setq _re ">"))) (error "%s: %s" "Not looking-at" _re)) (sbs "<") (if (not (looking-at (setq _re "

    "))) (error "%s: %s" "Not looking-at" _re) ;; fix? use? (_-sgml-element-del _tagname "end") (replace-match (if arg2markup-end arg2markup-end ""))) (while (_-blank-line-p) (_-move-backward-whitespace))) ;; fix! return point and use inside "and". (_-goto-beginning-of-paragraph t) (if (not (looking-at (setq _re (concat "\\(

    \\)")))) (error "%s: %s" "Not looking-at" _re) (replace-match arg1markup-beg t t)) ;; If no whitespace in new markup, delete whitespace after it. (if (and ;; fix? - was getting: __CAPTION__Word word word nil (and (not (string-match _-whitespace-wM arg1markup-beg)) (not (string-match lb-re-__-lvl-root arg1markup-beg))) (looking-at _-whitespaces-noM)) (replace-match "")) (tx-editing-while-interline-CR-insert-br) (t2h-fill-paragraph-control-M) ;; Move to beginning to prepare for any further changes. (goto-char (car (_-where-double-newlines)))) ;; (message "%s" (concat "Page " (lb-tx-what-page))) _rc)) ;;; ------------------------------------------------------- ;; (defun tx-editing-insert-blockquote (&optional arg1) " C-u prefix argument removes

    and

    before and after inserted blockquote" ;; (interactive "p") ;; fix! 2007.06.15 - Prefix arg (C-u) to delete "

    " above ;;
    and "

    " below

    . (let (_pt _mark _cons _rc) (save-match-data (if (not mark-active) (error "%s: %s" "Must set mark" "open tag will insert at mark")) (when (and (= (point) (mark)) (string-match "^[yY]$" (read-input (concat "Blockquote this paragraph " "(next if point on blank line)? ") "Y" nil nil nil))) (if (_-blank-line-p) (_-move-forward-whitespace)) (set-mark (car (setq _cons (_-where-double-newlines)))) (goto-char (cdr _cons))) (if (= (point) (mark)) (error "%s: %s" "Point and mark are the same" (int-to-string (point)))) (if (< (point) (mark)) ;; (error "%s: %s" "Out of order" "mark must be above point")) (exchange-point-and-mark)) (insert "\n\n" "" "\n\n") (exchange-point-and-mark) (insert "\n\n" "
    " "\n\n") (exchange-point-and-mark) ;; In case we want to kill
    and yank it further down. ;; 2007.06.15 - changed mind. ;; (search-backward-string "") (when (and arg1 (= 4 arg1)) (progn (sbs "
    ") (_-move-backward-whitespace t) (if (looking-at-backward-become-forward "

    ") (replace-match ""))) (progn (sfs "
    ") (_-move-forward-whitespace t) (if (looking-at "

    ") (replace-match "")))) (_-compress-multiple-newlines)) _rc)) (defun tx-editing-compress-here-multiple-newlines nil " Moves point to a blank line if point at end or beginning of non-blank line" ;; (interactive) (let ((_pt-beg (point)) _rc) ;; fix! ;; Stick this in tx-editing-common-prep? (if (looking-at "[ \t]*[\r]") (goto-char (match-end 0))) ;; Move up to blank line? (if (and (= (point) (save-excursion (beginning-of-line) (point))) (not (_-blank-line-p)) (save-excursion (forward-line -1) (_-blank-line-p))) (forward-line -1)) ;; Move down to blank line? (if (and (looking-at (concat "[ \t\r]*[\n]")) (not (_-blank-line-p)) (save-excursion (forward-line 1) (_-blank-line-p))) (forward-line 1)) (while (_-blank-line-p) (if (and (progn (end-of-line) t) (looking-at (concat "[\n]" _-whitespace-noM "*" "[\n]"))) (replace-match "\n")) (if (save-excursion (= 0 (forward-line -1))) (forward-line -1))) (if (/= (point) _pt-beg) (forward-line 1)) _rc)) ;; (tx-editing-move-word-start-across-page-break) (defun tx-editing-move-word-start-across-page-break nil "Point should be at beginning of line of first line of page. f2 f7 runs the command tx-editing-insert-page-break-mid-paragraph" ;; (interactive) (let (_str _pt-beg _pt-img _rc) (save-excursion (save-match-data ;; NOTE: Previous movement was to search-forward for page#. (goto-char (car (_-where-double-newlines))) ;; 2007.02.22 (when (looking-at "<[iI][mM][gG]") (setq _pt-img (point)) (goto-char (cdr (_-where-double-newlines))) (_-move-forward-whitespace)) (when (and (= (point) (save-excursion (beginning-of-line) (point))) ;; Is first token on page an alpha? (and (looking-at (concat "[" "a-zA-Z" lb-str-espanol-accented-vowels lb-str-espanol-accented-consonants "]+")) ;; Point where insert may take place (gets incremented). (setq _pt-beg (match-beginning 0)))) ;; Move back over page number. (if _pt-img (goto-char _pt-img)) (while (and (_-move-backward-whitespace) (string-match lb-re-bracketed-integer-anchored (_-current-line))) (beginning-of-line)) ;; (progn (goto-char (lb-tx-page-point "body-end")) (_-move-backward-whitespace)) ;; Hyphen as last character of previous page. (when (and (looking-at-backward-become-forward (concat "[-]" ;; 2007.01.19 "[ ]+" "[\r]")) ;; Line should not end with "--": (not (looking-at-backward-become-forward "[-]"))) (while (looking-at-backward-become-forward (concat ;; fix! put this into a global lb-re- ! "[a-zA-Z" lb-str-espanol-accented-vowels lb-str-espanol-accented-consonants "]" ;; "+" )) (setq _str (concat (match-string-no-properties 0) _str))) ;; Got something? (when _str ;; fix! this also happens in lb-abbyycln-call-join-a-hyphen-function ! (save-excursion (when (looking-at-backward-become-forward "[-]") (setq _pt-beg (1+ _pt-beg)) (insert "-"))) ;; Delete string and hypen. (delete-region (point) (+ (point) (length _str) 1)) (search-forward-regexp "[\r]") (insert "-" (int-to-string (length _str))) (goto-char (+ _pt-beg (- 0 (length _str)) (length (int-to-string (length _str))))) (insert _str)))))) _rc)) (global-set-key [f2 f7] 'tx-editing-insert-page-break-mid-paragraph) (defun tx-editing-insert-page-break-mid-paragraph (&optional arg1) " Use C-u to prevent deleting

    " ;; (interactive "p") ;; fix! After inserting page number, if page above has footnote, ;; display end of body text in message area. 2007.06.15 (let (_pt (_img "") _rc) ;; fix? - This is f2 f7; try to run this one automatically? ;; f2 f6 runs the command tx-editing-del-recto-pageno ;; Just inserted "-" to get "non--" to prevent joining? (when (and (looking-at-backward "[-][-]") (looking-at (concat "

    " _-whitespace-wM "*" "\\(<\\)p>"))) (goto-char (match-beginning 1)) (forward-line -1) (if (not (_-blank-line-p)) (error "%s: %s" "Expecting blank line" (_-buffer-substring-from-)))) (when (not (_-blank-line-p)) (if (looking-at "... pair can be deleted. ;; Store ]+>") (setq _img (match-string-no-properties 0)) (replace-match "")) ;; Delete forward

    (_-move-forward-whitespace) (if (looking-at (concat ;; "[ \t\n\r]*" "\\(]*[>]\\)")) (replace-match (concat "") t t nil 1)) ;; fix? ;; Function (lb-tx-what-page) works when page numbers at top of page. ;; What about at bottom of page? ;; page number (save-excursion (insert "\n\n" (int-to-string (1+ (string-to-int ;; 2006.10.03 ;; Just use first page number up. ;; Page numbers down may be unedited !!! ;; (lb-tx-what-page) (save-excursion ;; 2007.04.04 (if (search-backward-regexp lb-re-bracketed-para-integer nil t) (match-string-no-properties 1) (if (search-backward-regexp lb-re-bracketed-para-integer-top-of-file nil t) (match-string-no-properties 1) ;; First page number at bottom! (int-to-string (1- (* 100 (string-to-int (substring (file-name-sans-directory (bfn)) 0 1))))) )))))) "\n\n" _img "\n\n" "\n\n")) ;; Point above new page number. ;;

    (tx-sbr-not-whitespace) ;; Skip back over ... (when (string-match "^__PRINTERS_P_" (car (_-para))) (goto-char (car (_-where-double-newlines))) (tx-sbr-not-whitespace)) (when (looking-at ">") (search-backward "<") (when (and (not (lb-tx-page-point "footnotes-beg")) ;; 2007.03.23 ;; Use C-u to prevent deleting

    from middle of ;; verso when point is at top of recto. (not (_C-u arg1)) (looking-at "

    ")) (replace-match ""))) (search-forward-regexp lb-re-bracketed-para-integer) ;; fix! use tx-editing-compress-here-multiple-newlines instead. (cmn) ;; 2006.12.28 (tx-editing-move-word-start-across-page-break) (recenter) _rc)) ;; fix!!! Does _-move-backward-whitespace treat -9 in ^M-9 as whitespace?!?!? ;; fix!!! Does _-move-backward-whitespace treat -9 in ^M-9 as whitespace?!?!? ;; fix!!! Does _-move-backward-whitespace treat -9 in ^M-9 as whitespace?!?!? ;; fix!!! Does _-move-backward-whitespace treat -9 in ^M-9 as whitespace?!?!? ;; fix!!! Does _-move-backward-whitespace treat -9 in ^M-9 as whitespace?!?!? ;; fix!!! Does _-move-backward-whitespace treat -9 in ^M-9 as whitespace?!?!? ;; fix!!! Does _-move-backward-whitespace treat -9 in ^M-9 as whitespace?!?!? ;; fix!!! Does _-move-backward-whitespace treat -9 in ^M-9 as whitespace?!?!? ;; fix!!! Does _-move-backward-whitespace treat -9 in ^M-9 as whitespace?!?!? ;; fix!!! Does _-move-backward-whitespace treat -9 in ^M-9 as whitespace?!?!? ;; fix!!! Does _-move-backward-whitespace treat -9 in ^M-9 as whitespace?!?!? (defun tx-sbr-not-whitespace (&optional arg1) "sbr=search-backward-regexp Treats '-9' after carriage return as part of whitespace." (let ( _rc) ;; This could be the "9" in "^M-9" ;; 1 of 2. (search-backward-regexp "[^ \t\n\r]") (when (or (save-excursion (forward-char -2) ;; ^M-9 (looking-at "[\r][-][0-9]")) (save-excursion (forward-char -3) ;; ^M-10 (looking-at "[\r][-][0-9][0-9]"))) (search-backward-regexp "[\r]") ;; 2 of 2. (search-backward-regexp "[^ \t\n\r]")) _rc)) (defun tx-editing-insert-tx-header (arg1) "" ;; (interactive "p") (_-dfun-hook "tx-editing-insert-tx-header") (let (lb-str lb-pf-000 lb-pf-099 lb-pf-used lb-str-header lb-pfo lb-read _rc) (if (looking-at (concat _-whitespaces-wM "")) (replace-match "")) (if (looking-at (concat _-whitespaces-wM "")) (replace-match "")) (progn (setq lb-pf0 (bfn)) (setq lb-pf-099 (concat (file-name-directory lb-pf0) "099." lb-ext-tx)) (setq lb-pf-000 (concat lb-home (lb-get-lang-from-path lb-pf0) "/000.t")) (setq lb-str-header (with-temp-buffer (_-ifcl (if (and (file-exists-p lb-pf-099) (not (string= lb-pf0 lb-pf-099))) (setq lb-pf-used lb-pf-099) (setq lb-pf-used lb-pf-000))) (goto-char (point-min)) (search-forward-regexp (concat _-whitespaces-wM "[[]BEGIN[]]" _-whitespaces-wM)) (buffer-substring-no-properties (point-min) (if (string= lb-pf-used lb-pf-000) (match-end 0) (match-beginning 0)))))) (goto-char (point-min)) (with-temp-buffer (insert lb-str-header) ;; on-the-fly (while (not (string-match "^[bBtT]" (setq lb-read (read-input (concat "Where page numbers? " "[tT]op? [bB]ottom? ")))))) (goto-char (point-min)) (search-forward-string "__WHERE_PAGE_NUMBERS__") (_-move-forward-whitespace) (kill-line) (if (string-match "^[tT]" lb-read) (insert "top") (insert "bottom") ;; Maybe remove page number "[1]". (when (search-backward-regexp (concat "\n" "\\(" "[[][01][]]\n\n" "\\)") nil t) (replace-match "\n" t t nil 1))) (goto-char (point-min)) (search-forward-string "__OCR__") (setq lb-str (concat "ABBYY 6 Professional (" ;; fix? modification date of .ht file? (lb-date-YYYY.MM.DD) ")")) (_-move-forward-whitespace) (kill-line) (while (not (string-match "^[yYnN]" (setq lb-read (read-input (concat "OCR [yYnN] ? " lb-str " ")))))) (if (not (string-match "^[y]" lb-read)) (error "%s: %s" "Error brought to you by" _-defun) (insert lb-str)) ;; DONE. (setq lb-str-header (buffer-string))) ;; (if (string= lb-home (substring (abbreviate-file-name (bfn)) 0 (length lb-home))) (if lb-str-header (insert lb-str-header "\n\n") (_-ifcl (concat lb-home lb-lang "/000.t"))) (error "%s: %s" "hay" "now")) (_-find-file-hooks-__-globals) (tx-editing-turn-off-hooks-early-on) (while (not (string-match "[oO][kK]" (read-input (concat "Please check MARKER_STYLEs !!! [ok]" " "))))) _rc)) (defun tx-editing-insert-_-_-_ (&optional arg1 arg2save) " Returns t if footnote bar _-_-_ was inserted. Leaves point before footnote bar. Optional ARG2, if non-nil, will save buffer and maybe run hooks" (interactive "p") (let (_pt _pt-inserted-_-_-_ _flag _str _rc) (save-match-data (save-excursion ;; fix! ;; move this to lb-defvar.el (setq lb-re-temp-footnote-to-first-marker (concat "[ \t\n\r]*" "]*" ">" "[ \t\n~]*" "\\(" "\\^\\^[0-9]+\\^\\^" "\\|[*]+" "\\|\\^\\^[*]+\\^\\^" "\\)")) (progn ;; fix? - this seems GP (general purpose); move to separate defun? (if (not (save-excursion (search-forward-regexp _-^whitespace-wM nil t))) (_-move-backward-whitespace)) ;; 2007.07.31 (lb-tx-move-away-from-page-number-paragraph) ;; fix? - this seems GP (general purpose); move to separate defun? (if (looking-at "[ \t]*[\r]") (goto-char (match-end 0)))) (when (and tx ;; This called as a hook from backward-kill-word-sgml-my ! ;; No "_-_-_" yet. (not (lb-tx-page-point "footnotes-beg")) ;; Start with point above first footnote. (looking-at (concat lb-re-temp-footnote-to-first-marker)) ;; Do not add footnotes beyond NOTES. (save-excursion (setq _flag nil) (while (and (not _flag) (search-backward-string "__ALPHA_LVL1__" nil t)) (setq _str (_-compress-delete-whitespaces (_-sgml-del-markup (lb-db-__-del-__ (car (_-para)) t)) t)) (if (or (string= "NOTES" _str) (string= "NOTAS" _str)) (setq _flag _str))) (not _flag))) ;; Insert. (progn (_-move-backward-whitespace) (save-excursion (insert "\n\n" lb-str-footnote-_-_-_ "\n\n")) (setq arg2 t) (_-move-forward-whitespace) (setq _pt-inserted-_-_-_ (point)) (setq _rc t)) (when ;; Delete previous

    ? (and nil ;; 2007.02.08 - this slows things down too much. (progn (tx-sbr-not-whitespace) (looking-at ">")) (progn (search-backward "<") (not (looking-at "    ")))) ;; (when (string-match "^[yY]" (read-input (concat "... " (buffer-substring-no-properties (save-excursion (goto-char (- _pt-inserted-_-_-_ 20)) (search-backward-regexp "[ \t\n]") (1+ (point))) _pt-inserted-_-_-_) " <<<===DELETE===

    ===>>> ? ") (list "n") nil)) (search-forward-regexp "<[^>]+[>]") (replace-match ""))) (progn (goto-char _pt-inserted-_-_-_) (lb-ht-insert-^^-around-footnotes-asteriks) (cmn)) ;; Run hook that checks for balanced footnote markers: (if arg2save (save-buffer)) ) ))_rc)) ;; (lb-edits-pf-push) (defun lb-edits-pf-push nil "Return current buffer-file-name with \".\" lb-ext-edits-push" ;; (let ((lb-bfn (buffer-file-name)) (lb-rc (concat (buffer-file-name) "." lb-ext-edits-push))) (if (string-match "push$" lb-bfn) (error "%s: %s" "Function should not work with extension" lb-ext-edits-push)) ;; fix? ;; error if file exists? lb-rc)) (defun lb-edits-push-paragraph (&optional args) "Delete and append current paragraph (or next, if point inbetween two paragraphs) to file FILE.push. Like kill-paragraph, but will kill from beginning of paragraph if point in middle of paragraph. Also, paragraphs separated by blank lines: see _-para See also C-c C-k" ;; (interactive "p") (let (lb-buffer (lb-pf-push (lb-edits-pf-push)) lb-rc) ;; fix? ;; Add to kill ring? ;; Must kill push buffer before deleting paragraph! (progn ;; Kill buffer with push if necessary. (if (setq lb-buffer (find-buffer-visiting lb-pf-push)) (kill-buffer lb-buffer)) ;; fix? ;; make function? ;; or? ;; just unconditionally use? (_-move-forward-whitespace t) (progn ;; If point is at end of a paragraph, move to next paragraph. (progn ;; By default, _-para includes trailing whitespace. (if (looking-at "[ \t\m]$") (goto-char (match-end 0))) (if (= (point) (cdr (cdr (_-para)))) (forward-char 1))) ;; While point is in blank line, move it forward. (while (_-blank-line-p) (end-of-line) (forward-char 1))) (setq lb-rc (_-para-delete))) (with-temp-buffer (if (file-exists-p lb-pf-push) (insert-file-contents-literally lb-pf-push)) (goto-char (point-max)) (insert "\n\n" lb-rc "\n\n") (_-compress-multiple-newlines) (write-region (point-min) (point-max) lb-pf-push)) ;; While point is in blank line, move it forward. (while (_-blank-line-p) (end-of-line) (forward-char 1)) (recenter) lb-rc)) (defun lb-edits-pop-file (args) "If file returned by [lb-edits-pf-push] exists, insert it literally, surrounded by blank lines, and delete it" ;; (interactive "p") (let (lb-rc (lb-pf-push (lb-edits-pf-push))) (when (file-exists-p lb-pf-push) (insert "\n\n") (insert-file-contents-literally lb-pf-push) (insert "\n\n") (basic-save-buffer-1) (delete-file lb-pf-push)) lb-rc)) ;; ;; (defun ht-editing-insert-link-in-link-htmm nil "ADD NEW RECORD to Links.htmm" ;; (interactive) (let ( lb-rc) (save-excursion (while (search-backward-string (concat "<""li>") nil t) (if (not (string-match (concat "^ <""li> ") (_-current-line))) (error "%s: %s" "Misaligned" (_-current-line)))) (setq _d (lb-date-YYYY.MM.DD)) (setq _t (read-input "TITLE: ")) (setq _h (read-input "http HREF: ")) (setq _w (read-input "When? ")) ;; WHEN (setq _c (read-input "Where? ")) ;; CITY (setq _s0 (concat " <""li> " _t)) (setq _s (concat _s0 "\n" "
    " (if (> (length _w) 0) (concat "\n\n " _w ":" "\n " "\n \n") "") (if (> (length _c) 0) (concat "\n " _c " ") "") "\n " "• " _d "" "\n     " "\n " "   " (progn (string-match "http://" _h) (replace-match "" t t _h)) "\n" " " ""))) (save-excursion (search-backward-string (concat "<""/ul>")) (while (and _s (search-backward-string (concat "<""li") nil t) (setq _l (_-current-line))) (message "_l %s\n_s %s\n" _l _s0) (when (string-lessp _l _s0) (message "_LLLLLL %s\n_SSSSSS %s\n" _l _s0) (search-forward-string (concat "<""/li>")) (insert "\n\n" _s) (setq _s nil)))) ;; (lb-mu-htmm-to-html) lb-rc)) ;; (tx-moving-page-beg) (defun tx-moving-page-beg () "" (interactive) (let ((_pt-beg (point)) _pt _pt-end _rc) (tx-moving-page- "beg") (setq _pt-end (point)) ;; (when (save-excursion (goto-char _pt-beg) (setq _pt (search-backward-regexp lb-re-__-lvl _pt-end t))) (goto-char _pt) ;; (while (save-excursion (_-move-backward-whitespace t) (_-goto-beginning-of-paragraph t) (if (looking-at lb-re-__-lvl) (setq _pt (point)))) (goto-char _pt))) ;; (tx-editing-recenter-maybe) _rc)) ;; (tx-moving-page-end) (defun tx-moving-page-end () "" (interactive) ;; fix? Stop at __*_*_*__ ? ;; fix? Stop at

    ? (let ((_pt-beg (point)) _pt _pt-end _pg-up _pg-here _pg-down _rc) (tx-moving-page- "end") (setq _pt-end (point)) ;; (when (save-excursion (goto-char _pt-beg) (setq _pt (search-forward-regexp lb-re-__-lvl _pt-end t))) (goto-char _pt) (_-goto-end-of-paragraph nil t) (while (looking-at (concat _-whitespace-wM "*" lb-re-__-lvl)) (goto-char (match-end 0)) (_-goto-end-of-paragraph nil t))) ;; 2007.03.25 - point to right of page number. (when (and (save-excursion (if (sbr lb-re-bracketed-para-integer nil t) (setq _pg-up (match-string-no-properties 1)))) ;; This PG# and one above are same. (string= _pg-up (_-current-line)) ;; This PG# and one down are off by one. (and (looking-at lb-re-bracketed-para-integer) (setq _pg-down (match-string-no-properties 1)) (= (string-to-int _pg-down) (1+ (string-to-int _pg-up))))) (_-delete-line) (tx-editing-compress-here-multiple-newlines) (_-move-forward-whitespace) (goto-char (cdr (_-where-double-newlines)))) ;; (tx-editing-recenter-maybe) _rc)) ;; (defun tx-moving-page- (arg1dirn &optional arg2page-check) "Move point to [top/bottom] of this page or, if at [top/bottom], to [top/bottom] of ARG1 page where ARG1 is 'beg' or 'end'" (let (_pt (_pt-start (point)) _rc) ;; fix! make -beg and -end stop at __COLUMN2__ (end of en/1983/LAB525/). ;; 2007.07.04 (if (and (= (point) (point-max)) (string= "beg" arg1dirn)) (_-move-backward-whitespace)) ;; 2007.07.04 (when (and (_-blank-line-p) (and (save-excursion (_-move-backward-whitespace) (tx-page-number-p)) (save-excursion (_-move-forward-whitespace) (tx-page-number-p)))) (goto-char (save-excursion (if (string= "beg" arg1dirn) (_-move-backward-whitespace) (if (string= "end" arg1dirn) (_-move-forward-whitespace))) (if (string= "beg" arg1dirn) (_-goto-beginning-of-paragraph) (if (string= "end" arg1dirn) (_-goto-end-of-paragraph))) (point)))) (save-match-data ;; Move away from page number. (when (and (not (_-blank-line-p)) (string-match (concat "^" lb-re-bracketed-integer ;; 2007.06.13 "[ \t\r]*" "$") (car (_-para)))) (cond ((string= "beg" arg1dirn) (beginning-of-line) (_-move-backward-whitespace)) ((string= "end" arg1dirn) (end-of-line) (_-move-forward-whitespace)))) (when ;; When page number *NOT* [first/last] thing in buffer. (or (if (string= "beg" arg1dirn) (save-excursion (search-backward-regexp _-^whitespace-wM nil t))) (if (string= "end" arg1dirn) (save-excursion (search-forward-regexp _-^whitespace-wM nil t)))) (setq _pt (goto-char (lb-tx-page-point (concat "page-" arg1dirn)))) ;; fix! returns nil if page number is roman! However, ;; could make checking break in page sequence more difficult. (setq _rc (_-string-to-int (_-current-line))) (if (not arg2page-check) (tx-moving-page-check arg1dirn))) ) _rc)) (defun tx-moving-page-check (arg1dirn) "" ;; (let (n0 n1 _rc) (save-excursion (save-match-data ;; 2007.07.31 (if (looking-at "__ALPHA_LVL0__") (goto-char (sex (goto-char (cdr (wdn nil t))) (_-move-forward-whitespace t) (point)))) (if (= 0 (setq n0 (_-string-to-int (_-current-line)))) (error "%s: %s" "Page number 0 not allowed (-1 OK)" (concat "\n\n" (_-buffer-substring-from-)))) (when (setq n1 (cond ;; fix? 2007.03.05 - this seems familiar. ((string= "beg" arg1dirn) (if (sbr lb-re-bracketed-para-integer nil t) (_-string-to-int (match-string-no-properties 1)) (save-excursion (goto-char (point-min)) (if (looking-at lb-re-bracketed-para-integer-top-of-file) (_-string-to-int (match-string-no-properties 1)))))) ((string= "end" arg1dirn) (if (sfr lb-re-bracketed-para-integer nil t) (_-string-to-int (match-string-no-properties 1)))) (t (error "%s: %s" "beg" "end")))) (if (and ;; 2007.03.25 (not (tx-first-draft-p)) ;; 2007.07.10 (not (and (= -1 n0) (= 1 n1))) (/= n0 (+ n1 (if (string= "beg" arg1dirn) 1 -1)))) (error "%s: %s" "Break in page numbering" (concat (int-to-string n0) "<_>" (int-to-string n1))))))) _rc)) ;; (tx-first-draft-p) (defun tx-first-draft-p nil "" (let ( _rc) (save-match-data (save-excursion (goto-char (point-max)) (_-move-backward-whitespace) (if (looking-at-backward "[\n]") (setq _rc t)))) _rc)) ;; (tx-editing-comment-img-style-w-h) (defun tx-editing-comment-img-style-w-h nil "" (interactive) (let (_rc) (save-excursion (goto-char (point-min)) (while (search-forward-string "") (insert "\n" "")))) _rc)) ;; fix! use it! just one instance of defun name! (defun tx-editing-dumb-to-smart-quotes-at-footnote nil "Searches for [punctuation]["][^^][0-9*][^^] and changes the " to ''" ;; (interactive) (let ( _rc) (save-excursion (goto-char (point-min)) (while (sfr (concat "[!?.]" "\\("\\)" "\\(~\\)?" "\\^\\^" "[0-9*]+" "\\^\\^") nil t) (replace-match "''" t t nil 1))) _rc)) ;; fix! use it! just one instance of defun name! (defun tx-editing-dumb-to-smart-quotes-with-carriage-return nil "Searches for a quoted single word with a carriage return also inside quotes and changes quotes to smart quotes" ;; (interactive) (let ( _rc) (save-excursion ;; 2006.12.28 ;; " ^M7 deproletarianisation" (goto-char (point-max)) (while (search-backward-regexp (concat "\\("\\|``\\)" " " "[\r]-[0-9][0-9]?" " " (concat "[-a-zA-Z" lb-str-espanol-accented-vowels lb-str-espanol-accented-consonants "]+") "\\("\\|''\\)" ) nil t) (replace-match "''" t t nil 2) (replace-match "``" t t nil 1)) ) _rc)) (defun tx-editing-forward-paragraph (&optional arg1p) "Go forward 1 or, if non-nil, ARG1 paragraphs. Includes tx-editing-recenter-maybe" ;; (interactive) (let (_loopn _rc) ;; (while (and (_-blank-line-p) (_-move-backward-whitespace))) (forward-paragraph arg1p) (when nil ;; 2007.03.06 (setq _loopn (if arg1p arg1p 1)) (loop for i from 1 to _loopn do (goto-char (cdr (_-where-double-newlines nil t))) (_-move-forward-whitespace t)) (_-goto-beginning-of-paragraph t)) (tx-editing-recenter-maybe) _rc)) (defun tx-editing-forward-word (arg1p) "Includes tx-editing-recenter-maybe" ;; (interactive "p") (let (_rc) (forward-word arg1p) (tx-editing-recenter-maybe) _rc)) (defun tx-editing-recenter-maybe nil "" ;; ;; Uses characters displayed in window... not lines! (if (> (- (point) (window-start)) ;chars from upper-left to point. (* (- (window-end) (window-start)) ;;0.5 ;;0.7 0.8)) (recenter))) (defun tx-editing-swaps-and-substitutions (my-list) " Function created from code that was in lb-abbyycln " (let ( _rc) (while my-list (setq my-cons (car my-list)) (setq my-list (cdr my-list)) (when (consp my-cons) (setq my-re (car my-cons)) (setq my-cons (nth 1 my-cons)) (goto-char (point-min)) (while (search-forward-regexp my-re nil t) (setq my-msnp1 (if (nth 0 my-cons) (if (stringp (nth 0 my-cons)) (nth 0 my-cons) (match-string-no-properties (nth 0 my-cons))) "")) (setq my-msnp2 (if (nth 1 my-cons) (if (stringp (nth 1 my-cons)) (nth 1 my-cons) (match-string-no-properties (nth 1 my-cons))) "")) (setq my-msnp3 (if (nth 2 my-cons) (if (stringp (nth 2 my-cons)) (nth 2 my-cons) (match-string-no-properties (nth 2 my-cons))) "")) (setq my-msnp4 (if (nth 3 my-cons) (if (stringp (nth 3 my-cons)) (nth 3 my-cons) (match-string-no-properties (nth 3 my-cons))) "")) (if (and (not (_-sgml-markup-p)) ;; Below, "TEXTFILE_BORN" lumped with "WRITTEN" ;; (could split tags into two groups: editable and not). (not ;; (__ "tag") (string-match "__" (car (_-para))) )) (replace-match (concat my-msnp1 my-msnp2 my-msnp3 my-msnp4)))))) _rc)) (provide 'lb-edits) ;;; ; lb-en.el0100644000175100017510000000041010557514347012210 0ustar cymbalacymbala ;; Leninist.Biz! ;; Emacs-Time-stamp: "2007-01-29 17:01:27" (setq file-stamp "Emacs-File-stamp: \"/home/ysverdlov/leninist.biz/lb-en.el\"") (unless (featurep 'lb-lang) (load "lb-lang")) ;; fix? hardcode? (setq lb-lang lbg-lang-english) (provide 'lb-en) ;;; ; lb-es.el0100644000175100017510000000071110557514343012215 0ustar cymbalacymbala ;; Leninist.Biz! ;; Emacs-Time-stamp: "2007-01-29 17:01:23" (setq file-stamp "Emacs-File-stamp: \"/home/ysverdlov/leninist.biz/lb-es.el\"") (unless (featurep 'lb-lang) (load "lb-lang")) ;; THIS IS HOW WE REFRESH THE SPANISH SECTION: ;; ;; First, change default language to "es" in lb.el (fix?) ;; $ cd ~/leninist.biz/ ;; $ bash lb.sh es 1 ;; $ emacs -batch -l lb-batch.el ;; $ ;; fix? hardcode? (setq lb-lang lbg-lang-espanol) (provide 'lb-es) ;;; ; lb-fix1st.el0100644000175100017510000003232310607224754013030 0ustar cymbalacymbala ;; Leninist.Biz! ;; Emacs-Time-stamp: "2007-04-11 11:33:16" (setq file-stamp "Emacs-File-stamp: \"/home/ysverdlov/leninist.biz/lb-fix1st.el\"") ;;;;; NOTE: A file hasn't been corrected if is has lots of typos ;;;;; where the first letter is missing and the typo is to the ;;;;; right of regexp "[.,]''[ ]+" !!!!! ;;;;; lb-abbyy.el: ;;;;; ;;;;; ;; ,"B ;;;;; (cons ;;;;; (concat "\\([.,]\\)" ;;;;; "\\("\\|\"\\)" ;;;;; ;;;;; ;; 2007.04.04 ;;;;; ;; "\\([ ]\\)" ;;;;; ;; "\\([ ]+\\)" ;;;;; ;; state
    ". . .has fully confirmed ;;;;; ;; ERROR ERROR ERROR ERROR: "[^.]" ;; ;;;;; ;;;;; ;; ERROR: Without parenthesis, that character was ;;;;; ;; being deleted! 2007.04.11 ;;;;; ;;;;; ;; 2007.04.11 ;;;;; "\\([ ]+" "[^.]" "\\)" ;;;;; ) ;;;;; (list (list 1 "''" 3))) ;;;;; ;;;;; Check and fix these files: ;;; ;;; ./en/1965/LFD232/20070221/232.tx ;;; ./en/1965/LFD232/20070221/099.tx ;;; ./en/1965/LFD232/20070221/199.tx ;;; ./en/0000/MPIP223/20051103/099.tx ;;; ./en/1967/LIOL318/20061230/099.tx ;;; ./en/1967/LIOL318/20061230/199.tx ;;; ./en/1967/LIOL318/20061230/299.tx ;;; ./en/1967/LIOL318/20061230/318.tx ;;; ./en/1967/SC342/20070223/342.tx ;;; ./en/1967/SC342/20070223/099.tx ;;; ./en/1967/SC342/20070223/199.tx ;;; ./en/1967/SC342/20070223/299.tx ;;; ./en/1970/LGT390/20060322/199.tx ;;; ./en/1970/LGT390/20060322/099.tx ;;; ./en/1970/LGT390/20060322/299.tx ;;; ./en/1970/LGT390/20060322/391.tx ;;; ./en/1970/LTRSP88/20060216/088.tx ;;; ./en/1970/PBR194/20061002/194.tx ;;; ./en/1970/PBR194/20061002/099.tx ;;; ./en/1970/SLPP274/20070403/099.tx ;;; ./en/1970/SLPP274/20070403/199.tx ;;; ./en/1970/SLPP274/20070403/274.tx ;;; ./en/1971/YCI237/20070208/099.tx ;;; ./en/1971/YCI237/20070208/199.tx ;;; ./en/1971/YCI237/20070208/237.tx ;;; ./en/1972/EGW188/20070101/099.tx ;;; ./en/1972/EGW188/20070101/188.tx ;;; ./en/1972/FLC499/20070219/099.tx ;;; ./en/1972/FLC499/20070219/199.tx ;;; ./en/1972/FLC499/20070219/299.tx ;;; ./en/1972/FLC499/20070219/399.tx ;;; ./en/1972/FLC499/20070219/499.tx ;;; ./en/1972/FLC499/20070219/500.tx ;;; ./en/1972/SSWW277/20051212/099.tx ;;; ./en/1972/SSWW277/20051212/199.tx ;;; ./en/1972/SSWW277/20051212/277.tx ;;; ./en/1972/LBI363/20060307/099.tx ;;; ./en/1972/LBI363/20060307/dust.tx ;;; ./en/1972/LBI363/20060307/299.tx ;;; ./en/1972/LBI363/20060307/199.tx ;;; ./en/1972/LBI363/20060307/364.tx ;;; ./en/1972/PSD310/20061226/099.tx ;;; ./en/1972/PSD310/20061226/199.tx ;;; ./en/1972/PSD310/20061226/299.tx ;;; ./en/1972/PSD310/20061226/310.tx ;;; ./en/1973/USBEP201/20070405/199.tx ;;; ./en/1973/USBEP201/20070405/099.tx ;;; ./en/1973/USBEP201/20070405/201.tx ;;; ./en/1973/WICIR317/20051014/313.tx ;;; ./en/1973/WICIR317/20051014/099.tx ;;; ./en/1973/WICIR317/20051014/199.tx ;;; ./en/1973/WICIR317/20051014/299.tx ;;; ./en/1973/HR380/20070401/099.tx ;;; ./en/1973/HR380/20070401/199.tx ;;; ./en/1973/HR380/20070401/299.tx ;;; ./en/1973/HR380/20070401/380.tx ;;; ./en/1974/OSA354/20070216/099.tx ;;; ./en/1974/OSA354/20070216/199.tx ;;; ./en/1974/OSA354/20070216/299.tx ;;; ./en/1974/OSA354/20070216/354.tx ;;; ./en/1974/LIMIR287/20070105/287.tx ;;; ./en/1974/LIMIR287/20070105/099.tx ;;; ./en/1974/LIMIR287/20070105/199.tx ;;; ./en/1974/2SHW519/20070218/099.tx ;;; ./en/1974/2SHW519/20070218/199.tx ;;; ./en/1974/2SHW519/20070218/299.tx ;;; ./en/1974/2SHW519/20070218/399.tx ;;; ./en/1974/2SHW519/20070218/490.tx ;;; ./en/1974/2SHW519/20070218/499.tx ;;; ./en/1974/2SHW519/20070218/519.tx ;;; ./en/1974/1SHW599/20070214/600.tx ;;; ./en/1974/1SHW599/20070214/199.tx ;;; ./en/1974/1SHW599/20070214/299.tx ;;; ./en/1974/1SHW599/20070214/587.tx ;;; ./en/1974/1SHW599/20070214/099.tx ;;; ./en/1974/1SHW599/20070214/399.tx ;;; ./en/1974/1SHW599/20070214/499.tx ;;; ./en/1974/1SHW599/20070214/599.tx ;;; ./en/1975/LTSR447/20051022/199.tx ;;; ./en/1975/LTSR447/20051022/099.tx ;;; ./en/1975/LTSR447/20051022/299.tx ;;; ./en/1975/LTSR447/20051022/399.tx ;;; ./en/1975/LTSR447/20051022/447.tx ;;; ./en/1975/ISSR389/20070215/099.tx ;;; ./en/1975/ISSR389/20070215/199.tx ;;; ./en/1975/ISSR389/20070215/299.tx ;;; ./en/1975/ISSR389/20070215/373.tx ;;; ./en/1975/ISSR389/20070215/389.tx ;;; ./en/1975/WT332/20070313/099.tx ;;; ./en/1975/WT332/20070313/199.tx ;;; ./en/1975/WT332/20070313/299.tx ;;; ./en/1975/WT332/20070313/332.tx ;;; ./en/1976/NSO261/20070225/261.tx ;;; ./en/1976/NSO261/20070225/199.tx ;;; ./en/1976/NSO261/20070225/099.tx ;;; ./en/1976/TPPI307/20060306/099.tx ;;; ./en/1976/TPPI307/20060306/199.tx ;;; ./en/1976/TPPI307/20060306/299.tx ;;; ./en/1976/TPPI307/20060306/307.tx ;;; ./en/1976/CAC343/20061227/343.tx ;;; ./en/1976/CAC343/20061227/099.tx ;;; ./en/1976/CAC343/20061227/199.tx ;;; ./en/1976/CAC343/20061227/299.tx ;;; ./en/1976/GPSPW2PP/20060821/099.tx ;;; ./en/1976/GPSPW2PP/20060821/199.tx ;;; ./en/1976/GPSPW2PP/20060821/499.tx ;;; ./en/1976/GPSPW2PP/20060821/599.tx ;;; ./en/1976/GPSPW2PP/20060821/299.tx ;;; ./en/1976/GPSPW2PP/20060821/399.tx ;;; ./en/1976/GPSPW2PP/20060821/736.tx ;;; ./en/1976/GPSPW2PP/20060821/699.tx ;;; ./en/1976/GPSPW3PP/20060825/199.tx ;;; ./en/1976/GPSPW3PP/20060825/099.tx ;;; ./en/1976/GPSPW3PP/20060825/696.tx ;;; ./en/1976/GPSPW3PP/20060825/599.tx ;;; ./en/1976/GPSPW3PP/20060825/499.tx ;;; ./en/1976/GPSPW3PP/20060825/299.tx ;;; ./en/1976/GPSPW3PP/20060825/399.tx ;;; ./en/1976/HCFI758/20061104/199.tx ;;; ./en/1976/HCFI758/20061104/299.tx ;;; ./en/1976/HCFI758/20061104/099.tx ;;; ./en/1976/HCFI758/20061104/399.tx ;;; ./en/1976/HCFI758/20061104/699.tx ;;; ./en/1976/HCFI758/20061104/499.tx ;;; ./en/1976/HCFI758/20061104/599.tx ;;; ./en/1976/HCFI758/20061104/758.tx ;;; ./en/1976/HA242/20060412/099.tx ;;; ./en/1976/HA242/20060412/199.tx ;;; ./en/1976/HA242/20060412/243.tx ;;; ./en/1976/UFPAA243/20050713/099.tx ;;; ./en/1976/UFPAA243/20050713/244.tx ;;; ./en/1976/UFPAA243/20050713/199.tx ;;; ./en/1977/RV318/20060111/099.tx ;;; ./en/1977/RV318/20060111/299.tx ;;; ./en/1977/RV318/20060111/318.tx ;;; ./en/1977/RV318/20060111/199.tx ;;; ./en/1977/NT228/20070206/099.tx ;;; ./en/1977/NT228/20070206/199.tx ;;; ./en/1977/NT228/20070206/223.tx ;;; ./en/1977/NT228/20070206/228.tx ;;; ./en/1977/GPSPW1PP/20060819/099.tx ;;; ./en/1977/GPSPW1PP/20060819/499.tx ;;; ./en/1977/GPSPW1PP/20060819/199.tx ;;; ./en/1977/GPSPW1PP/20060819/599.tx ;;; ./en/1977/GPSPW1PP/20060819/299.tx ;;; ./en/1977/GPSPW1PP/20060819/818.tx ;;; ./en/1977/GPSPW1PP/20060819/799.tx ;;; ./en/1977/GPSPW1PP/20060819/399.tx ;;; ./en/1977/GPSPW1PP/20060819/787.tx ;;; ./en/1977/GPSPW1PP/20060819/699.tx ;;; ./en/1977/SOE347/20070212/099.tx ;;; ./en/1977/SOE347/20070212/199.tx ;;; ./en/1977/SOE347/20070212/299.tx ;;; ./en/1977/SOE347/20070212/347.tx ;;; ./en/1977/MICU186/20070329/099.tx ;;; ./en/1977/MICU186/20070329/186.tx ;;; ./en/1979/KTR183/20070127/099.tx ;;; ./en/1979/KTR183/20070127/183.tx ;;; ./en/1979/SPA248/20070327/248.tx ;;; ./en/1979/SPA248/20070327/099.tx ;;; ./en/1979/SPA248/20070327/199.tx ;;; ./en/1980/DMVH335/20051227/099.tx ;;; ./en/1980/DMVH335/20051227/199.tx ;;; ./en/1980/DMVH335/20051227/299.tx ;;; ./en/1980/DMVH335/20051227/317.tx ;;; ./en/1980/DMVH335/20051227/335.tx ;;; ./en/1980/GPSPW4PP/20061010/099.tx ;;; ./en/1980/GPSPW4PP/20061010/299.tx ;;; ./en/1980/GPSPW4PP/20061010/199.tx ;;; ./en/1980/GPSPW4PP/20061010/whacky/099o.tx ;;; ./en/1980/GPSPW4PP/20061010/whacky/199o.tx ;;; ./en/1980/GPSPW4PP/20061010/whacky/299o.tx ;;; ./en/1980/GPSPW4PP/20061010/599.tx ;;; ./en/1980/GPSPW4PP/20061010/699.tx ;;; ./en/1980/GPSPW4PP/20061010/399.tx ;;; ./en/1980/GPSPW4PP/20061010/783.tx ;;; ./en/1980/GPSPW4PP/20061010/499.tx ;;; ./en/1980/KQA238/20070315/099.tx ;;; ./en/1980/KQA238/20070315/199.tx ;;; ./en/1980/KQA238/20070315/238.tx ;;; ./en/1980/OHV203/20070406/099.tx ;;; ./en/1980/OHV203/20070406/203.tx ;;; ./en/1980/OHV203/20070406/199.tx ;;; ./en/1980/CCCWP251/20051220/099.tx ;;; ./en/1980/CCCWP251/20051220/199.tx ;;; ./en/1980/CCCWP251/20051220/252.tx ;;; ./en/1980/FPE287/20070121/099.tx ;;; ./en/1980/FPE287/20070121/199.tx ;;; ./en/1980/FPE287/20070121/287.tx ;;; ./en/1980/AD158/20070304/099.tx ;;; ./en/1980/AD158/20070304/158.tx ;done;; ./en/1980/HORL354/20070408/099.tx ;done;; ./en/1980/HORL354/20070408/199.tx ;done;; ./en/1980/HORL354/20070408/299.tx ;done;; ./en/1980/HORL354/20070408/354.tx ;;; ./en/1980/WCA283/20070314/099.tx ;;; ./en/1980/WCA283/20070314/199.tx ;;; ./en/1980/WCA283/20070314/283.tx ;;; ./en/1981/GPSPW5PP/20060913/399.tx ;;; ./en/1981/GPSPW5PP/20060913/199.tx ;;; ./en/1981/GPSPW5PP/20060913/099.tx ;;; ./en/1981/GPSPW5PP/20060913/499.tx ;;; ./en/1981/GPSPW5PP/20060913/599.tx ;;; ./en/1981/GPSPW5PP/20060913/735.tx ;;; ./en/1981/GPSPW5PP/20060913/299.tx ;;; ./en/1981/GPSPW5PP/20060913/699.tx ;;; ./en/1981/GPSPW5PP/20060913/703.tx ;;; ./en/1981/1HU376/20051214/099.tx ;;; ./en/1981/1HU376/20051214/199.tx ;;; ./en/1981/1HU376/20051214/376.tx ;;; ./en/1981/1HU376/20051214/299.tx ;;; ./en/1981/2HU326/20051216/099.tx ;;; ./en/1981/2HU326/20051216/199.tx ;;; ./en/1981/2HU326/20051216/327.tx ;;; ./en/1981/2HU326/20051216/299.tx ;;; ./en/1981/PCM335/20051006/336.tx ;;; ./en/1981/PCM335/20051006/199.tx ;;; ./en/1981/PCM335/20051006/099.tx ;;; ./en/1981/PCM335/20051006/299.tx ;;; ./en/1982/ONBP322/20070217/099.tx ;;; ./en/1982/ONBP322/20070217/199.tx ;;; ./en/1982/ONBP322/20070217/299.tx ;;; ./en/1982/ONBP322/20070217/322.tx ;;; ./en/1982/SNU207/20070404/199.tx ;;; ./en/1982/SNU207/20070404/099.tx ;;; ./en/1982/SNU207/20070404/207.tx ;;; ./en/1982/3HU357/20051223/099.tx ;;; ./en/1982/3HU357/20051223/199.tx ;;; ./en/1982/3HU357/20051223/299.tx ;;; ./en/1982/3HU357/20051223/326.tx ;;; ./en/1982/3HU357/20051223/351.tx ;;; ./en/1982/3HU357/20051223/357.tx ;;; ./en/1982/DBBW313/20061102/299.tx ;;; ./en/1982/DBBW313/20061102/099.tx ;;; ./en/1982/DBBW313/20061102/314.tx ;;; ./en/1982/DBBW313/20061102/199.tx ;done;; ./en/1982/CIATU278/20070328/099.tx no errors in these 3. ;done;; ./en/1982/CIATU278/20070328/199.tx ;done;; ./en/1982/CIATU278/20070328/278.tx ;;; ./en/1983/FCU180/20070317/099.tx ;;; ./en/1983/FCU180/20070317/180.tx ;;; ./en/1983/LAB525/20070119/099.tx ;;; ./en/1983/LAB525/20070119/299.tx ;;; ./en/1983/LAB525/20070119/199.tx ;;; ./en/1983/LAB525/20070119/399.tx ;;; ./en/1983/LAB525/20070119/499.tx ;;; ./en/1983/LAB525/20070119/525.tx ;;; ./en/1983/HM493/20070323/399.tx ;;; ./en/1983/HM493/20070323/199.tx ;;; ./en/1983/HM493/20070323/299.tx ;;; ./en/1983/HM493/20070323/099.tx ;;; ./en/1983/HM493/20070323/493.tx ;;; ./en/1984/AP469/20050704/099.tx ;;; ./en/1984/AP469/20050704/199.tx ;;; ./en/1984/AP469/20050704/299.tx ;;; ./en/1984/AP469/20050704/470.tx ;;; ./en/1984/AP469/20050704/399.tx ;;; ./en/1984/TIL286/20070209/286.tx ;;; ./en/1984/TIL286/20070209/099.tx ;;; ./en/1984/TIL286/20070209/199.tx ;;; ./en/1984/BSTRD194/20061009/099.tx ;;; ./en/1984/BSTRD194/20061009/195.tx ;;; ./en/1985/WW288/20060329/099.tx ;;; ./en/1985/WW288/20060329/199.tx ;;; ./en/1985/WW288/20060329/290.tx ;;; ./en/1987/WDM326/20060909/099.tx ;;; ./en/1987/WDM326/20060909/326.tx ;;; ./en/1987/WDM326/20060909/299.tx ;;; ./en/1987/WDM326/20060909/199.tx ;;; ./en/1987/WHM294/20060912/099.tx ;;; ./en/1987/WHM294/20060912/294.tx ;;; ./en/1987/WHM294/20060912/199.tx ;;; ./en/1989/HCM242/20061115/243.tx ;;; ./en/1989/HCM242/20061115/099.tx ;;; ./en/1989/HCM242/20061115/199.tx ;;; ./en/1990/MCS295/20060606/099.tx ;;; ./en/1990/MCS295/20060606/199.tx ;;; ./en/1990/MCS295/20060606/295.tx ;;; ./en/1926/MD152/20070125/099.tx ;;; ./en/1926/MD152/20070125/152.tx ;;; ./es/1976/GROI236/20060203/099.tx ;;; ./es/1976/GROI236/20060203/199.tx ;;; ./es/1976/GROI236/20060203/238.tx ;;; ./es/1980/QEMD256/20060224/099.tx ;;; ./es/1980/QEMD256/20060224/256.tx ;;; ./es/1980/QEMD256/20060224/199.tx ;;; ./es/1974/SR230/20060303/099.tx ;;; ./es/1974/SR230/20060303/199.tx ;;; ./es/1974/SR230/20060303/231.tx ;;; ./es/1974/ATA469/20060131/099.tx ;;; ./es/1974/ATA469/20060131/199.tx ;;; ./es/1974/ATA469/20060131/470.tx ;;; ./es/1974/ATA469/20060131/299.tx ;;; ./es/1974/ATA469/20060131/399.tx ;;; ./es/1969/LOC01EC/20060301/199.tx ;;; ./es/1969/LOC01EC/20060301/099.tx ;;; ./es/1969/LOC01EC/20060301/399.tx ;;; ./es/1969/LOC01EC/20060301/299.tx ;;; ./es/1969/LOC01EC/20060301/544.tx ;;; ./es/1969/LOC01EC/20060301/499.tx ;;; ./es/1969/LOC02EC/20070111/099.tx ;;; ./es/1969/LOC02EC/20070111/199.tx ;;; ./es/1969/LOC02EC/20070111/299.tx ;;; ./es/1969/LOC02EC/20070111/499.tx ;;; ./es/1969/LOC02EC/20070111/572.tx ;;; ./es/1969/LOC02EC/20070111/399.tx ;;; ./es/1979/LOE3EP/20061021/299.tx ;;; ./es/1979/LOE3EP/20061021/499.tx ;;; ./es/1979/LOE3EP/20061021/199.tx ;;; ./es/1979/LOE3EP/20061021/399.tx ;;; ./es/1979/LOE3EP/20061021/099.tx ;;; ./es/1979/LOE3EP/20061021/599.tx ;;; ./es/1979/LOE3EP/20061021/699.tx ;;; ./es/1979/LOE3EP/20061021/888.tx ;;; ./es/1979/LOE3EP/20061021/799.tx ;;; ./es/1977/ERD148/20060221/099.tx ;;; ./es/1977/ERD148/20060221/148.tx ;;; ./es/1977/V343/20060310/099.tx ;;; ./es/1977/V343/20060310/199.tx ;;; ./es/1977/V343/20060310/299.tx ;;; ./es/1977/V343/20060310/343.tx ;;; ./es/1978/LOE2EP/20061018/499.tx ;;; ./es/1978/LOE2EP/20061018/299.tx ;;; ./es/1978/LOE2EP/20061018/399.tx ;;; ./es/1978/LOE2EP/20061018/599.tx ;;; ./es/1978/LOE2EP/20061018/699.tx ;;; ./es/1978/LOE2EP/20061018/799.tx ;;; ./es/1978/LOE2EP/20061018/843.tx ;;; ./es/1978/LOE2EP/20061018/099.tx ;;; ./es/1978/LOE2EP/20061018/199.tx ;;; ./es/0000/3PP258/20070224/099.tx ;;; ./es/0000/3PP258/20070224/199.tx ;;; ./es/0000/3PP258/20070224/258.tx ;;; (provide 'lb-edits) ;;; ; lb-footn.el0100644000175100017510000006232210654125717012742 0ustar cymbalacymbala ;; TOC = Table of Contents. ;; Emacs-Time-stamp: "2007-08-01 08:50:39" (setq file-stamp "Emacs-File-stamp: \"/home/ysverdlov/leninist.biz/lb-footn.el\"") ;; (defun tx-check-footnotes (&optional arg1fromhere arg1not-interactive) " ... ARG1 is a from-here point. Optional ARG2, if non-nil when called from tx-check-footnotes//lb-tx-make-or-refresh-indextx//lb-ht-tenderize-tx, will suppress attempts to insert _-_-_ while checking foonotes" ;; (interactive) (let (lb-pg lb-str-^^ lb-pt-page-end lb-cons-tx-footnote-end lb-pt-start lb-pt-stop-checking lb-pt-footnote-end _rc) (save-match-data (progn (write-region (point-min) (point-max) "~/foofootnotes") (message "%s" "Checking footnotes...")) (save-excursion (setq lb-pt-start (if arg1fromhere (point) (point-min))) (setq lb-pt-stop-checking (save-excursion (goto-char (point-min)) (if (search-forward-string "__ALPHA_LVL0__" nil t) (point) (point-max)))) ;; 2006.10.16 (goto-char lb-pt-start) (while (search-forward-regexp lb-re-bracketed-para-integer ;; Do not check past __ALPHA_LVL0__ ;; 2006.11.10 ;; nil lb-pt-stop-checking t) (lb-tx-check-^^ arg1not-interactive (match-string-no-properties 0)) ) ;; 2006.10.16 (goto-char lb-pt-start) (while (search-forward-string "__NOTE__ Footnote" nil t) (goto-char (cdr (_-where-double-newlines))) (_-move-forward-whitespace) (if (and (looking-at " to __PRINTERS_P_999_COMMENT__ ?" (_-buffer-substring-from-)))) ;; 2007.06.07 - getting "missing

    " deep into processing. (goto-char lb-pt-start) (while (search-forward-string lb-str-footnote-_-_-_ nil t) (setq lb-pt-page-end (lb-tx-page-point "page-end")) (setq lb-pg (lb-tx-what-page)) ;; (while (search-forward-regexp _-re-footnote-marker-global lb-pt-page-end t) (setq lb-str-^^ (match-string 1)) (progn (goto-char (car ;; cdr is page number if footnote continued on next page. (setq lb-cons-tx-footnote-end (lb-tx-footnote-end)))) (_-move-backward-whitespace t)) ;; (if (and (not (cdr lb-cons-tx-footnote-end)) (not (looking-at-backward "

    ")) ;; 2007.07.12 ) (error "%s: %s" (concat "Page " lb-pg "," " missing

    in " lb-str-^^) ;; (car (_-para)) (_-buffer-substring-from-) )))) ) )_rc)) ;; (defun lb-ht-footnote-pop-it nil "Pop, or delete and return, entire or remaining footnote text starting from current point. Jump to next page if lb-re-footnote-continued found at end of footnotes region. Assumes footnote is in raw .tx format. Does not fetch end of footnote from next section, but this function is called by function that handles such cases. Deletes _-_-_ if no alphas found between _-_-_ and end of footnotes region" ;; (let (lb-flag-break lb-str-pg-previous lb-cons-tx-footnote-end lb-pt lb-re lb-str lb-int lb-end lb-rc) ;; fix? ;; save-excursion? save-match-data? ;; where is point before first iteration? ;; lb-ht-footnote-pop-from-next-section: ;; ;; fix! ;; Check that point is in footnotes area: _-_-_ before "page-beg" or ;; point after "footnotes-beg". ;; where is point before first iteration? ;; lb-ht-footnotes-anchor-and-move: ;; (_-move-forward-whitespace) (while (and (setq lb-end (car (setq lb-cons-tx-footnote-end (lb-tx-footnote-end)))) ;; 2006.09.05 - May be at %%div-class-notes-start%% ! (not (= (point) lb-end)) (not (_-just-say-nil 'lb-flag-break))) ;; fix? ;; insert real page number if part of footnote text from other page? ;; Pop text. (setq lb-rc (concat (_-just-say-nil 'lb-rc) ;; ASSUMPTION: If not empty, lb-rc ends w/ blank line. ;; "\n\n" (progn (setq lb-str (buffer-substring-no-properties (setq lb-beg (point)) lb-end)) (delete-region lb-beg lb-end) ;; Point might be to left of page number ;; for this page if numbers at bottom. ;; ;; (save-excursion (insert "\n\n\n")) lb-str) ;; "\n\n" )) ;; If all footnote text is deleted from a page, delete _-_-_ divider. (when (not (string-match "[a-zA-Z]" (buffer-substring (lb-tx-page-point "footnotes-beg") (lb-tx-page-point "footnotes-end")))) (goto-char (lb-tx-page-point "footnotes-beg")) (if (looking-at lb-re-footnote-div) (replace-match "") (error "%s: %s" "Expecting" lb-re-footnote-div))) ;; Reached true/real end of footnote text? (if (not (cdr lb-cons-tx-footnote-end)) ;; It does not end with lb-re-footnote-continued, break out. (setq lb-flag-break t) ;; Otherwise, footnote text continues on next page. ;; Check where it says to look for continuation. (if (/= ;; Page number (string) where continuation is expected. (string-to-int (setq lb-str (cdr lb-cons-tx-footnote-end))) ;; Add 1 to current page (before goto next page). (1+ (setq lb-int (string-to-int (setq lb-str-pg-previous (lb-tx-what-page)))))) (error "%s: %s" (concat "Expecting __NOTE__ to say contined on page " (int-to-string (1+ lb-int)) ", not") lb-str) ;; (lb-tx-goto-page (1+ (string-to-int lb-str-pg-previous)))) ;; fix? ;; Insert actual page number of next page? ;; Or pretend continuation of footnote is on same page as its start? ;; Chance that footnote continues in next section already ;; accounted for by lb-ht-footnote-pop-from-next-section. ;; Jump to footnote area. (goto-char (lb-tx-page-point "footnotes-beg")) ;; Move past footnotes bar. (goto-char (cdr (_-where-double-newlines))) (_-move-forward-whitespace) ;; Check continuation note to see if it mentions correct page number. (if (not (looking-at (setq lb-re lb-re-footnote-continued))) (error "%s: %s" (concat "On page " (lb-tx-what-page) " regexp not found") (concat lb-re "\n" (_-buffer-substring-from-))) (if (not (string= "from" (match-string-no-properties 2))) (error "%s: %s" "Expecting 'from' variation of" (concat lb-re "\n" (_-buffer-substring-from-))) (if (not (string= lb-str-pg-previous (match-string-no-properties 3))) (error "%s: %s" (concat "Expecting cont. on page " lb-str-pg-previous) (concat "\n" (_-buffer-substring-from-))))))) ) ;; while lb-rc)) ;; (defun lb-ht-footnote-pop-from-next-section (arg1str-or-re) ;)(06 b ;)(08 b "This called by two functions: lb-ht-footnotes-balancer-anchor-mismatch lb-ht-footnotes-balancer-next-page-next-section This pops first footnote from section (1+ ARG2) where footnote must begin with regexp ARG1. Due to lb-ht-toc-get-section, either re-uses pre-existing lbg-next-section or creates a new one using next section from index.txt. Sets lbg-next-section to remainder of buffer after footnote popped." ;; (_-dfun-hook "lb-ht-footnote-pop-from-next-section") ;; (let (lb-bound lb-rc) (with-temp-buffer (setq _-where-page-numbers _-where-page-numbers-global) ;; If lbg-next-section set, lb-ht-toc-get-section will return it *and* ;; set to nil. ;; Use non-nil optional 2nd arg to suppress recursion. (insert (lb-ht-toc-get-section (1+ lbg-i-from1) t)) ;)(07 a. 2 ;; (progn (goto-char (point-min)) (if (not (search-forward-regexp lb-re-footnote-div nil t)) (error "%s: %s" "Not found" (concat lb-re-footnote-div "\n" (_-buffer-substring-from-)))) (setq lb-bound (lb-tx-page-point "page-end"))) ;; Always look for specific footnote. (or (and (string-match "^\\([*]+\\|[0-9]+\\)$" arg1str-or-re) (search-forward-string (setq arg1str-or-re (concat "^^" arg1str-or-re "^^")) lb-bound t)) (and (string-match "ootnote cont" arg1str-or-re) (search-forward-regexp arg1str-or-re lb-bound t)) (error "%s: %s" (concat "Did not find footnote " arg1str-or-re " on page " (lb-tx-what-page)) (concat "\n" (_-buffer-substring-from-)))) (goto-char (car (_-where-double-newlines))) ;; Get footnote, including __NOTE__. (setq lb-rc (lb-ht-footnote-pop-it)) ;; Pass along whatever is leftover of next section after removing ;; footnote. REMEMBER use of non-nil ARG2 in lb-ht-toc-get-section (above). (setq lbg-next-section (buffer-string))) lb-rc)) ;; (lb-ht-footnotes-anchor-and-move) (defun lb-ht-footnotes-anchor-and-move nil ;)(03 f. "Anchor footnotes after inserting .tx into HTML" (_-dfun-hook "lb-ht-footnotes-anchor-and-move" t) ;; (let (lb-str-marker lb-str-visible-in-body lb-str-visible-in-note lb-str-href-in-body lb-str-href-in-note lb-pt-body-^^ lb-footnote lb-pg lb-str lb-str-^^ lb-str-n lb-str-page lb-pt-notes-bound lb-n-note lb-str-2b-inserted lb-rc) (goto-char (point-min)) ;; Insert set of anchors. (while (and ;; Very long AND! (progn ;; Reset. ;; Reset when debugging: (makunbound 'lb-n-note) (when (null (_-just-say-nil 'lb-n-note)) (goto-char (point-min)) (setq lb-n-note 0) (save-excursion ;; Bound for while loop. (if (not (search-forward-string (setq lb-str ;; fix? use other %% ? ;; "%%notes%%" "%%div-class-notes-start%%" ) nil t)) (error "%s: %s" "search-forward-string" lb-str)) (setq lb-pt-notes-bound (point)))) t) (if ;; Search for next footnote. (not (search-forward-regexp _-re-footnote-marker-global nil ;; This has to change every time! ;; lb-pt-notes-bound t)) ;; If not found do cleanup. (progn (_-compress-multiple-newlines) nil) ;; Found. ;; Set strings for... (setq lb-str-^^ (match-string 1)) (setq lb-pt-body-^^ (match-beginning 0)) (setq lb-n-note (1+ lb-n-note)) ;; Set strings for visible and href. (setq lb-str-visible-in-note (setq lb-str-n (int-to-string lb-n-note))) (setq lb-str-visible-in-body (concat (setq lb-str-page (lb-tx-what-page)) lb-ht-footnote-page-and-marker-separator lb-str-^^)) (setq lb-str-href-in-body (setq lb-str-href-in-note (concat lb-str-n "page" lb-str-page))) (setq lb-str-href-in-note (concat lb-ht-footnote-href-prefix-fw lb-str-href-in-note)) (setq lb-str-href-in-body (concat lb-ht-footnote-href-prefix-bk lb-str-href-in-body)) ;; BODY forw anchor. ;; BODY back anchor. ;; Insert anchor to get to note and get back to body from note. (replace-match (concat ;; 2006.12.14 - using word-spacing 3px in #main ! ;; "    " "  " ;; "[" lb-str-visible-in-body ;; "]" " " ;; This causes leading spaces at beginning ;; of line when footnote anchor is at end ;; of previous line: ;; "    " ;; Do *not* append newline; can cause ^M ;; to be at beginning of line. ;; "\n" )) t) ;; Very long AND! ) (if ;; Pop footnote. (not (search-forward-string (setq lb-str-marker (concat "^^" lb-str-^^ "^^")) ;; If last footnote on last page, this will be end of HTML! (lb-tx-page-point "page-end") t)) (error "%s: %s" (concat "On page " (lb-tx-what-page) " did not find foonote") (concat lb-str-^^ "\n" (_-buffer-substring-from-))) (progn ;; Prepare for footnote pop. (search-backward "       " "[" "" ;; lb-str-visible-in-note lb-str-visible-in-body "]" ;; How to separate number from start of P? ;;" " ;; "
    " "\n" "   " ;; 2006.11.05 ;; "•   " "\n" )) ;; Insert anchor and link back to body. (goto-char (point-max)) (if (not (search-backward "

    " nil t)) (error "%s: %s" (concat "Page " lb-pg "," " missing

    in " lb-str-^^) lb-footnote)) (replace-match (concat (when nil (concat "\n" ;; ;; "-> main text" link on separate line. ;; 2006.01.19 "
    " ;; "   " ;;"[" "—>" "" ;;"main text" ;; "BACK" "body text" "" ;;"]" " ")) ;; Just keep the

    !!! (match-string 0))) ) (buffer-string)) ;; "\n\n" )) ;; xxxx debug (when nil (if (string-match "recalled that during the war" lb-footnote) (error "%s" lb-str-2b-inserted))) (insert lb-str-2b-inserted)) ;; Reposition before next loop iteration. (progn (goto-char lb-pt-body-^^) (search-forward-string "")) ) ;; (while ;; (if (= 9 lbg-i-from1) (error "%s" (_-buffer-substring-from-))) (progn ;; All footnotes are inside "

    ". Add P attributes. ;; Modify '

    ' in footnotes. ;; fix? ;; Use variable to search for start of notes? (goto-char (point-min)) (search-forward-string "%%div-class-notes-start%%" nil nil) (while (search-forward-string "

    " nil t) ;; fix! ;; Use CSS (replace-match (concat "

    ")))) ;; Check for leftover .tx parts. (progn (goto-char (point-min)) (if (search-forward-regexp lb-re-footnote-div nil t) ;; __-_-_-__ is OK. (if (not (looking-at "[-]__")) (error "%s: %s" (concat "On page " (lb-tx-what-page) " found leftover " lb-re-footnote-div) (_-buffer-substring-from- nil 200))) )) ;; lb-rc)) ;;; ;)( (defun lb-ht-footnotes-balancer-anchor-mismatch nil ;)(05 c "Does last page have a footnote anchor in body but footnote text is absent due to start of new section inbetween those two things? This may call lb-ht-footnote-pop-from-next-section which would set lbg-next-section. ABCDE" ;; Are there footnote markers in body near end of this section but ;; footnote text marker missing? Maybe, if (beginning of) footnote text ;; appears *after* beginning of *next* section. ;; Does not alter anything when pair of markers is present but end of ;; footnote text is in next section. (_-dfun-hook "lb-ht-footnotes-balancer-anchor-mismatch") ;; (let (lb-pt lb-pt-while-backward-pt lb-pt-while-backward-bound lb-msnp1 lb-bound lb-flag lb-rc) ;; Move to end of body of last page (raw section w/o inserts). (progn (lb-tx-goto-page lbg-original-page-last) (goto-char (setq lb-pt-while-backward-pt (lb-tx-page-point "body-end"))) (setq lb-pt-while-backward-bound (lb-tx-page-point "page-beg"))) ;; Just check last page b/c next-to-last page always has matching "*". (while (and (goto-char lb-pt-while-backward-pt) (setq lb-pt-while-backward-pt (search-backward-regexp _-re-footnote-marker-global lb-pt-while-backward-bound t)) (setq lb-msnp1 (match-string-no-properties 1))) ;; After finding anchor in body, check for footnote. ;; Does _-_-_ exist below? If not, insert it. (if (not (setq lb-pt (lb-tx-page-point "footnotes-beg"))) (goto-char (lb-tx-page-point "footnotes-beg" t)) (goto-char lb-pt)) ;; Move past _-_-_ (progn (goto-char (cdr (_-where-double-newlines))) (_-move-forward-whitespace)) ;; Point is now after footnote divider. ;; Got footnote text? (progn (when (not (save-excursion (setq lb-bound (lb-tx-page-point "page-end")) (setq lb-flag nil) (while (search-forward-regexp _-re-footnote-marker-global lb-bound t) (if (string= lb-msnp1 (match-string-no-properties 1)) (setq lb-flag t))) lb-flag)) ;; Anchor in body but missing footnote. ;; This will create and/or modify lbg-next-section. (insert ;; "\n\n" (lb-ht-footnote-pop-from-next-section lb-msnp1) ;)(08 b 2 ;; "\n\n" )))) lb-rc)) ;; (lb-ht-footnotes-cont-checker) (defun lb-ht-footnotes-cont-checker nil ;)(05 a. "Finds all lb-re-footnote-continued starting from end of buffer. Returns list of lists with lb-re-footnote-continued pairs found in .tx file. Each pair is a list of six: 0/3 string `__NOTE__ Footnote cont. on/from page 999` 1/4 string page (from above) `999` 2/5 actual page number 998 Example of return code when count = 1 and CONTINUED FROM not found: `__NOTE__ Footnote cont. on page 9` `9` 8 nil nil nil Example of return code when count = 1 and CONTINUED FROM found: `__NOTE__ Footnote cont. on page 9` `9` 8 `__NOTE__ Footnote cont. from page 8` `8` 9" ;; ;; fix! do this in tx-check-buffer! 2007.05.10. (let ((lb-pt-search-bound (point-max)) (lb-cnt 0) lb-pt-resume-loop lb-str-on lb-str-from lb-beg lb-end lb-page-on lb-page-from lb-is-above-para-cont-on ;; Next two are integers: lb-page-on-actual (lb-page-from-actual "-1") lb-rc) (save-excursion (goto-char (point-max)) ;; __NOTE__ Footnote cont. on pg 2 (while (search-backward-regexp lb-re-footnote-continued nil t) (when (string= "on" (match-string-no-properties 2)) (setq lb-cnt (1+ lb-cnt)) (setq lb-pt-resume-loop (point)) (goto-char (match-end 0)) ;; If these stay nil, return code will be non-nil. (progn (setq lb-str-on (match-string-no-properties 0)) (setq lb-str-from nil) ;; (setq lb-page-on (match-string-no-properties 3)) (setq lb-page-on-actual nil) ;; (setq lb-page-from nil) (setq lb-page-from-actual (lb-tx-what-page))) ;; __NOTE__ Footnote cont. from pg 1 (if (not (search-forward-regexp lb-re-footnote-continued lb-pt-search-bound t)) (if (> lb-cnt 1) (error "%s: %s" "Expecting a 'from' search-forward-regexp" (concat lb-re-footnote-continued (_-buffer-substring-from-))) ;; BREAK. ;; Last footnote may continue on 1st page of next section. (goto-char (point-min))) ;;------------------------------------------------------- (progn (setq lb-str-from (match-string-no-properties 0)) (setq lb-page-from (match-string-no-properties 3)) (setq lb-page-on-actual (lb-tx-what-page)) (setq lb-beg (match-beginning 0)) ;; Returns 't' if above paragraph is "cont. on" paragraph. (setq lb-is-above-para-cont-on ;; 2006.11.29 - why this case on page 573--574? ;; ;; ~/leninist.biz/en/1976/GPSPW2PP/20060821/599.tx ;;;Grosse in ein andere Grosse, sondern Uebergang vom Qualitativen in das ;;; ;;;__NOTE__ Footnote cont. on page 574. ;;; ;;;__NOTE__ Footnote cont. from page 573<<<----- point here; ... ----->>>. ;;; ;;;__NOTE__ Missing two lines here: ;;;Quantitative und umgekehrt sind: ;;; ------------------------------------------------------- (save-excursion (save-match-data (goto-char lb-beg) (_-move-backward-whitespace) (goto-char (car (_-where-double-newlines))) (if (looking-at lb-re-footnote-continued) (match-string-no-properties 2)))))) ;; ------------------------------------------------------- (if (and (not (= (string-to-int lb-page-on) (string-to-int lb-page-on-actual))) ;; Above paragraph is "cont. on" NOTE? (not (string= "on" lb-is-above-para-cont-on))) (error "%s: %s" "Exp/Act ON values do not match" (concat lb-page-on " /= " lb-page-on-actual "\n" (_-buffer-substring-from-) ))) (if (not (= (string-to-int lb-page-from) (string-to-int lb-page-from-actual))) (error "%s: %s" "Exp/Act FROM values do not match" (concat lb-page-from " /= " lb-page-from-actual "\n" (_-buffer-substring-from-) ))) (if (and (not (= (1- (string-to-int lb-page-on-actual)) (string-to-int lb-page-from-actual))) ;; Above paragraph is "cont. on" NOTE? (not (string= "on" lb-is-above-para-cont-on))) (error "%s: %s" "Footnote should continue on next page" (concat lb-page-from " <-> " lb-page-on "\n" (_-buffer-substring-from-) )))) (_-app 'lb-rc (list (list lb-str-on lb-page-on lb-page-from-actual lb-str-from lb-page-from lb-page-on-actual))) ;; NEXT ITERATION (setq lb-pt-search-bound (goto-char lb-pt-resume-loop))))) lb-rc)) ;;; ;)( (defun lb-ht-footnotes-balancer-next-page-next-section nil ;)(05 b "SPECIAL CASE: Last footnote marker and beginning of footnote text are on page N-1. Section ends on page N *AND* footnote text continues on page N underneath beginning of next section. This function will grab/insert last portion of text of last footnote" (_-dfun-hook "lb-ht-footnotes-balancer-next-page-next-section") ;; (let (lb-list lb-list-footnotes-cont ;; Not used here: ;; lb-str-from lb-page-from lb-page-on-actual ;; lb-str-on lb-page-on lb-page-from-actual lb-rc) ;; If 4th element of last pair is nil, assume footnote continues ;; on next page where next section ALSO BEGINS. (when (and (> (length (setq lb-list-footnotes-cont (lb-ht-footnotes-cont-checker))) ;)(06 a. 0) (null (nth 3 (setq lb-list (nth 0 lb-list-footnotes-cont))))) ;; fix! ? ! ? (if nil (error "%s: %s" "THIS IS SO RARE" ;; Pages 117-118: ;; ~/leninist.biz/en/1976/GPSPW3PP/20060825/199.tx (concat (progn (delete-file "~/foo") (write-region (point-min) (point-max) "~/foo") nil) "had better insert a sticky into book and test NOW." "\n\n" (buffer-substring (max (- (point) 100) (point-min)) (min (+ 100 (point)) (point-max))) ))) (progn (setq lb-str-on (nth 0 lb-list)) (setq lb-page-on (nth 1 lb-list)) (setq lb-page-from-actual (nth 2 lb-list))) ;; Maybe insert page. (if (not (lb-tx-goto-page lb-page-on)) (lb-tx-goto-page lb-page-on t)) ;; Does _-_-_ exist below? If not, insert it. (if (not (setq lb-pt (lb-tx-page-point "footnotes-beg"))) ;; fix! ;; fix here and elsewhere! ;; This goto-char should be enough. (goto-char (lb-tx-page-point "footnotes-beg" t)) (goto-char lb-pt)) ;; Insert footnote. Point is to left of whitespace to left of bar. (progn (goto-char (cdr (_-where-double-newlines))) (_-move-forward-whitespace) (if (looking-at "~") (replace-match ""))) (insert (lb-ht-footnote-pop-from-next-section ;)(06 b 1 (concat lb-re-footnote-continued-from-page lb-page-from-actual))) ;; fix! ;; footnote may continue a 2nd time. ) lb-rc)) (defun lb-ht-insert-^^-around-footnotes-asteriks nil "" ;; (interactive) (let (_pt _rc) (save-match-data (save-excursion (when (setq _pt (lb-tx-page-point "footnotes-beg")) ;; Toss "^^" around "*" at beginning of paragraphs. (save-excursion (goto-char _pt) (while (search-forward-regexp (concat ;; "[ \t\n\r]*" "]*[>]" "[ \t\n" "~" "]*" ;; The other case, numeric markers, was already ^^9^^ ! "\\([*)]+\\)" ) (lb-tx-page-point "page-end") t) (replace-match (concat "^^" (match-string-no-properties 1) "^^") t t nil 1)))))) _rc)) (provide 'lb-footn) ;;; ; lb-ftp.el0100600000175100017510000001634410653647001012373 0ustar cymbalacymbala ;; Emacs-Time-stamp: "2007-07-31 07:58:09" (setq file-stamp "Emacs-File-stamp: \"/home/ysverdlov/leninist.biz/lb-ftp.el\"") ;;; 2006.11.18 - check *.el for "bsb". ;;; 2006.11.18 - check *.el for "write-" as in "-file" and "-region" ;;; DONE. 2006.11.18 - check *.el for "append-to" as in "-to-file" or "-buffer" ;;; DONE. 2006.11.18 - check *.el for "save-buffer". ;;; login@debian:~/leninist.biz$ egrep -Hi 'save-buffer' *.el ;;; DONE. ;;; login@debian:~/leninist.biz$ egrep -Hi 'save-buffer' *.el ;;; login@debian:~/leninist.biz$ egrep -Hi 'append-to' *.el ;;; DONE. ;;; login@debian:~/leninist.biz$ egrep -Hi 'append-to' *.el ;;; login@debian:~/leninist.biz$ egrep -Hi 'write-f' *.el ;;; DONE. ;;; login@debian:~/leninist.biz$ ;;; login@debian:~/leninist.biz$ egrep -Hi 'write-r' *.el ;;; DONE. ;;; login@debian:~/leninist.biz$ ;; (lb-lftp-dosomething-file "~/leninist.biz/en/1989/HCM243/Revolution") ;; (lb-lftp-dosomething-file "~/leninist.biz/en/1989/HCM243/Revolution.tx2") ;; (lb-lftp-dosomething-file "~/leninist.biz/en/TAZ") (defun lb-lftp-dosomething-file (arg1pf &optional arg2action) "" ;; ;; SEE ALSO: ;; 12 lines matching "lftp" in buffer lia-sgml.el. (let (lb-re lb-str lb-path-cd lb-path-lcd lb-path-testit lb-buffer (_s " ") lb-post-domain-assumed-exist-on-server lb-post-domain-assumed-exist-on-server-NOT lb-command lb-date (lb-pre-buffer (current-buffer)) _rc) (save-match-data (save-excursion (progn (if (not arg2action) (setq arg2action "put")) ;; Add trailing space. (if (not (string-match " $" arg2action)) (setq arg2action (concat arg2action " "))) ;; (setq lb-path-lcd (file-name-directory arg1pf)) (if (or (not lb-path-lcd) (string= "./" lb-path-lcd)) (setq lb-path-lcd (concat lb-home lbg-path-from-lang "/"))) (if (and (not (string-match lb-home lb-path-lcd)) (not (string-match "^/home/" lb-path-lcd))) (error "%s: %s" "Expecting lb-home or ^/home in" lb-path-lcd)) (setq lb-lftp-source "lftp.source") (setq lbg-lftp-source (concat lb-path-lcd lb-lftp-source)) (if (file-exists-p (setq lb-pidfile (concat lb-lftp-source ".pid"))) (error "%s: %s" "lftp running?" lb-pidfile)) ;; no newline! (setq lb-command (concat arg2action (file-name-sans-directory arg1pf) ""))) ;; fix? Maybe already fixed in lb-ht ? ;; Kill this buffer at end of processing; not killed here. (cond ;; (1.) Add line to existing buffer. ((setq lb-buffer (find-buffer-visiting lbg-lftp-source)) (set-buffer lb-buffer) (when (not (_-string-exist-end-of-line-p lb-command)) (progn ;;1of2 ;; Put all "rm"s on top of all "put"s! (goto-char (car (_-where-double-newlines))) (if (string-match "rm " lb-command) (insert "" lb-command "\n") (goto-char (cdr (_-where-double-newlines))) (insert "\n" lb-command ""))) (basic-save-buffer-1))) ;; (2.) Add line to existing file. ((file-exists-p lbg-lftp-source) ;; fix! Check paths! ;; Due to LOC, might rename folder after this file started. ;;;6 lines matching "231" in buffer lftp.source. ;;; 2:lcd /home/login/leninist.biz/es/1974/SR231/ ;;; 3:cd /leninist.biz/data/es/1974/SR231/ ;;; 5:!touch /home/login/leninist.biz/es/1974/SR231/lftp.source.pid ;;; 83:!rm -f /home/login/leninist.biz/es/1974/SR231/lftp.source.pid ;;; 85:!cat /home/login/leninist.biz/es/1974/SR231/lftp.source >>/home/login/leninist.biz/es/1974/SR231/.lftp.source.oldcat ;;; 87:!rm -f /home/login/leninist.biz/es/1974/SR231/lftp.source (set-buffer (find-file-literally lbg-lftp-source)) (setq backup-inhibited t) ;; fix? do this for existing buffer too? ;; Did path change due to LOC last-page-numbered? (goto-char (point-min)) (while (search-forward-string "cd " nil t) (if (and (looking-at "[^ \t\n]+") (setq lb-path-testit (match-string-no-properties 0)) (setq lb-path-testit (lb-get-id-from-path lb-path-testit)) (= 3 (length (split-string lb-path-testit "/")))) (if (not (string= (setq lb-str (lb-get-id-from-path lb-path-lcd)) lb-path-testit)) (error "%s: %s" lb-str (_-current-line))))) (goto-char (point-max)) (search-backward-regexp "^\\(m?rm\\|m?put\\) ") ;;1of2 (when (not (_-string-exist-end-of-line-p lb-command)) (progn ;;2of2 ;; Put all "rm"s on top of all "put"s! (goto-char (car (_-where-double-newlines))) (if (string-match "rm " lb-command) (insert "" lb-command "\n") (goto-char (cdr (_-where-double-newlines))) (insert "\n" lb-command ""))) (basic-save-buffer-1))) ;; (3.) Create a fresh file and add to it. (t (set-buffer (find-file-literally lbg-lftp-source)) ;; BEGIN. (insert "\n") (insert _s"lcd " lb-path-lcd "\n") (insert _s"!touch " lb-pidfile "\n") (insert _s"!cp -f "lb-lftp-source" "lb-lftp-source".lag\n") (insert _s"cd " (setq lb-path-cd (concat "/" lb-domain "/data/" (progn (string-match (concat ".*" lb-domain "/" lb-re-lang "/" "\\(" ".*" "\\)") lb-path-lcd) (setq lb-post-domain-assumed-exist-on-server-NOT (match-string 2 lb-path-lcd)) (setq lb-post-domain-assumed-exist-on-server (match-string 1 lb-path-lcd))))) "\n") (loop for folder in (split-string lb-post-domain-assumed-exist-on-server-NOT "/") do (insert _s"mkdir " folder "\n") (setq lb-path-cd (concat lb-path-cd "/" folder)) (insert _s" cd " folder "\n")) ;; Add trailing slash. (setq lb-path-cd (concat lb-path-cd "/" "")) (insert "\n") ;; MIDDLE. (insert lb-command "\n") ;; END. (insert "\n") ;; (lb-get-id-from-path "~/leninist.biz/en/1989/HCM243/") ;; (lb-get-id-from-path "~/leninist.biz/en/1989/" nil) ;; (lb-get-id-from-path "~/leninist.biz/en/1989/" t) ;; (lb-get-id-from-path "~/leninist.biz/en/" t) (insert _s"cd .; lcd .; ls > .lftp.ls\n") ;; Walk up the branch. (loop for i from 1 to (length (split-string (lb-get-id-from-path lb-path-lcd t) "/")) do (insert _s"cd ..; lcd ..; ls > .lftp.ls\n")) (insert _s"lcd " lb-path-lcd "\n") (insert _s"cd " lb-path-cd "\n") (insert _s"" ;; 2007.01.01 - keep copies 2 months from now. (if (or (string< "2007-03-01T15:05:36-0800" (_-current-time)) lbg-ftp-save-source-p) "#" "") "!" "cat " lb-lftp-source " >>" ;; Hide it with leading ".". "." lb-lftp-source ".oldcat" "\n") (insert _s"!" "rm -f " lb-lftp-source " " lb-pidfile "\n") (insert _s"echo " (setq lb-date (lb-date)) "; echo ""\n") (insert _s"!find " lb-home " -follow -name " lb-lftp-source "\n") (insert "# " " -------------------------------------END------------------" "\n") (insert "\n") (search-backward-regexp "^\\(m?rm\\|m?put\\) ") ;;2of2 (basic-save-buffer-1)) ) ;; cond ;; No matter how it got here, bury it. (bury-buffer))) ;; Recursion. Almost. ;; (setq arg1pf "~/leninist.biz/en/sitemap") (when (string-match (concat lb-re-lang "/sitemap$") arg1pf) (lb-lftp-dosomething-file ;; fix! make sure zz/index.html is a symbolic link to sitemap. (concat (file-name-directory arg1pf) lb-file-indexhtml))) _rc)) (provide 'lb-ftp) ;;; ; lb-go-speed-racer.el0100644000175100017510000002354310654122476014413 0ustar cymbalacymbala ;; go-speed-racer = what the mechanic called me one morning in downtown 81. ;; Emacs-Time-stamp: "2007-08-01 08:22:38" (setq file-stamp "Emacs-File-stamp: \"/home/ysverdlov/leninist.biz/lb-go-speed-racer.el\"") ;; 2007.02.07 - WHERE IS en/1984/BSTRD195/ IN THIS LIST ?!?!?! ;; (lb-db-go-speed-racer-inventory) ;;; (RE)DONE January 25, 2006 ;;; ;;; Y Update index.txt? ;;; Y Del. and upload html? ;;; #10: (progn (lb-tx-make-or-refresh-indextx "en/1982/3HU357/") (lb-ht "1982")) ;;; #9: (progn (lb-tx-make-or-refresh-indextx "en/1980/CCCWP252/") (lb-ht "1980")) ;;; YY #4: (progn (lb-tx-make-or-refresh-indextx "en/1973/WICIR313/") (lb-ht "1973")) ;;; YY #7: (progn (lb-tx-make-or-refresh-indextx "en/1981/1HU376/") (lb-ht "1981")) ;;; YY #8: (progn (lb-tx-make-or-refresh-indextx "en/1981/2HU327/") (lb-ht "1981")) ;;; YY #6: (progn (lb-tx-make-or-refresh-indextx "en/1972/SSWW277/") (lb-ht "1972")) ;;; YY #5: (progn (lb-tx-make-or-refresh-indextx "en/1975/LTSR447/") (lb-ht "1975")) ;;; YY #3: (progn (lb-tx-make-or-refresh-indextx "en/1981/PCM336/") (lb-ht "1981")) ;;; YY #2: (progn (lb-tx-make-or-refresh-indextx "en/1976/UFPAA244/") (lb-ht "1976")) ;;; YY #1: (progn (lb-tx-make-or-refresh-indextx "en/1984/AP470/") (lb-ht "1984")) ;;; ======================================================= ;;; moved here from lb-ht.el due to defun lb-mu-most-recently-modified-inputs... ;; ----------------------------------------------------------------------------- ;; ----------------------------------------------------------------------------- ;; MAIN: ;;--LoC- Last-numbered page used for subdirectory name. ;;--L0C- "LOC" changed to "L0C" when all webpages start with a number. ;; Use M-x sort-columns to order (a.) by date, (b.) by number, (c.) by path. ;; `00-00 #38: (lb-ht "es/1939/LL336" ) ;; no 1939 folder! ;; `06/03 #33: (lb-ht "en/0000/MPIP223" ) ;;--L0C-- `07/03 #01 : (lb-ht "en/1984/AP469" nil) ;;--L0C-- `07/03 #02 : (lb-ht "en/1976/UFPAA243" nil) ;;--L0C-- `07/03 #03 : (lb-ht "en/1981/PCM335" nil) ;;--L0C-- `07/03 #04 : (lb-ht "en/1973/WICIR317" nil) ;;--L0C-- `07/03 #05 : (lb-ht "en/1975/LTSR447" nil) ;;--L0C-- `07/03 #06 : (lb-ht "en/1972/SSWW277" nil) ;;--L0C-- `07/03 #07 : (lb-ht "en/1981/1HU376" nil) ;;--L0C-- `07/03 #08 : (lb-ht "en/1981/2HU326" nil) ;;--L0C-- `07/03 #09 : (lb-ht "en/1980/CCCWP251" nil) ;;--L0C-- `07/03 #10 : (lb-ht "en/1982/3HU357" nil) ;;--L0C-- `07/03 #11 : (lb-ht "es/1974/ATA469" nil) ;;--L0C-- `07/03 #12 : (lb-ht "en/1970/LTRSP88" nil) ...on loan...to Ricardo? ;;--L0C-- `07/03 #13 : (lb-ht "es/1976/GROI236" nil) ;;--L0C-- `07/03 #16 : (lb-ht "es/1974/SR230" nil) ;;--L0C-- `07/03 #18 : (lb-ht "en/1972/LBI363" nil) ;;--L0C-- `07/07 #19 : (lb-ht "en/1976/TAPPI307" nil) ;;Refreshed July 31, 2007 ;;--L0C-- `07/03 #20 : (lb-ht "es/1977/V343" nil) ;;--L0C-- `07/03 #21 : (lb-ht "en/1972/PSD310" nil) ;;--L0C-- `07/03 #22 : (lb-ht "en/1970/LGT390" nil) ;;;numeric prefixes? ;;--L0C-- `07/03 #23 : (lb-ht "en/1985/WW288" nil) ;;--L0C-- `07/03 #24 : (lb-ht "en/1976/HA242" nil) ;;--L C- `06/12 #25 : (lb-ht "en/1977/GPSPW1PP" nil) ;;--L C- `06/12 #26 : (lb-ht "en/1976/GPSPW2PP" nil) ;;--L C- `06/12 #27 : (lb-ht "en/1976/GPSPW3PP" nil) ;;--L C- `06/12 #28 : (lb-ht "en/1980/GPSPW4PP" nil) ;;--L C- `06/12 #29 : (lb-ht "en/1981/GPSPW5PP" nil) ;;--L0C-- `07/03 #30 : (lb-ht "en/1987/WDM326" nil) ;;--L0C-- `07/03 #31 : (lb-ht "en/1987/WHM294" nil) ;;--L0C-- `07/03 #32 : (lb-ht "en/1989/HCM242" nil) ;;--L0C-- `07/03 #34 : (lb-ht "en/1970/PBR194" nil) ;;--L0C-- `07/03 #35 : (lb-ht "en/1990/MCS295" nil) ;;--L0C-- `07/03 #36 : (lb-ht "en/1976/CAC343" nil) ;;--L0C-- `07/03 #37 : (lb-ht "en/1982/DBBW313" nil) ;;--L0C-- `07/03 #39 : (lb-ht "en/1967/LIOL318" nil) ;;--L C- `06/12 #40 : (lb-ht "es/1978/LOE2EP" nil) ;;--L C- `06/12 #41 : (lb-ht "es/1979/LOE3EP" nil) ;;--L C- `07/01 #17 : (lb-ht "es/1969/LOC01EC" nil) ;;--L C- `07/01 #44 : (lb-ht "es/1969/LOC02EC" nil) ;;--L0C-- `07/03 #42 : (lb-ht "en/1972/EGW188" nil) ;;--L0C-- `07/03 #43 : (lb-ht "en/1974/LIMIR287" nil) ;;--L0C-- `07/03 #45 : (lb-ht "en/1983/LAB525" nil) ;;--L0C-- `07/03 #47 : (lb-ht "en/1926/MD152" nil) ;;--L0C-- `07/03 #46 : (lb-ht "en/1980/FPE287" nil) ;;--L0C-- `07/03 #48 : (lb-ht "en/1979/KTR183" nil) ;;--L0C-- `07/03 #49 : (lb-ht "en/1977/RV318" nil) ;;--L0C-- `07/03 #50 : (lb-ht "en/1977/NT228" nil) ;;--L0C-- `07/03 #58 : (lb-ht "en/1971/YCI237" nil) ;;--L0C-- `07/03 #59 : (lb-ht "en/1984/TIL286" nil) ;;--L0C-- `07/03 #54 : (lb-ht "en/1975/ISSR389" nil) ;;--L0C-- `07/03 #53 : (lb-ht "en/1977/SOE347" nil) ;;--L0C-- `07/03 #55 : (lb-ht "en/1984/TIL286" nil) ;;--L0C-- `07/03 #52 : (lb-ht "en/1974/OSA354" nil) ;;--L0C-- `07/03 #51 : (lb-ht "en/1982/ONBP322" nil) ;;--L0C-- `07/03 #56 : (lb-ht "en/1974/2SHW519" nil) ;;--L0C-- `07/03 #57 : (lb-ht "en/1974/1SHW599" nil) ;;--L0C-- `07/03 #63 : (lb-ht "en/1972/FLC499" nil) non-LAPL ;;--L0C-- `07/03 #65 : (lb-ht "es/0000/3PP258" nil) non-LAPL ;;--L0C-- `07/03 #66 : (lb-ht "en/1980/AD158" nil) non-LAPL ;;--L0C-- `07/03 #67 : (lb-ht "en/1976/NSO261" nil) non-LAPL ;;hrefs 98 ABCDEFG-XCVII . z ;;hrefs 99 ABCDEFG-XCVIII . z ;;hrefs 100 __ALPHA_LVL0__ . . ;; WAS.MISSING.2007.02.07 ;;--LoC- `07/02 #60 : (lb-ht "en/1976/HCFI758" nil) ;; WAS.MISSING.2007.02.07 ;;--L0C-- `07/03 #61 : (lb-ht "en/1984/BSTRD194" nil) ;;--L0C-- `07/03 #62 : (lb-ht "en/1965/LFD232" nil) non-LAPL ;;--L0C-- `07/03 #64 : (lb-ht "en/1980/WCA283" nil) non-LAPL ;;--L0C-- `07/03 #70 : (lb-ht "en/1983/FCU180" nil) non-LAPL ;;--L0C-- `07/03 #68 : (lb-ht "en/1975/WT332" nil) non-LAPL ;;--L0C-- `07/03 #71 : (lb-ht "en/1967/SC342" nil) non-LAPL ;;--L0C-- `07/03 #69 : (lb-ht "en/1980/KQA238" nil) 1:LAPL:done:`` kimberly ;;--L0C-- `07/03 #72 : (lb-ht "en/1983/HM493" nil) 1:LAPL:done:`` kimberly ;;--L0C-- `07/03 #73 : (lb-ht "en/1979/SPA248" nil) 1:LAPL:done:`` kimberly ;;--L0C-- `07/04 #74 : (lb-ht "en/1982/CIATU278" nil) 1:LAPL:done:`` kimberly ;;--L0C-- `07/04 #75 : (lb-ht "en/1977/MICU186" nil) 1:LAPL:done:`` kimberly ;;--L0C-- `07/04 #76 : (lb-ht "en/1973/HR380" nil) 1:LAPL:done:`` kimberly ;;--L0C-- `07/04 #77 : (lb-ht "en/1970/SLPP274" nil) 1:LAPL:done:`` kimberly ;;--L0C-- `07/04 #78 : (lb-ht "en/1982/SNU207" nil) 1:LAPL:done:`` kimberly ;;--L0C-- `07/04 #79 : (lb-ht "en/1973/USBEP201" nil) 1:LAPL:done:`` kimberly ;;--L0C-- `07/04 #80 : (lb-ht "en/1980/OHV203" nil) 1:LAPL:done:`` kimberly ;;--L0C-- `07/00 #81 : (lb-ht "en/1980/HORL354" nil) 1:LAPL:done:`` kimberly ;;--L0C-- `07/04 #82 : (lb-ht "en/1973/SCA370" nil) 1:LAPL:done:`` kimberly ;;--L0C-- `07/00 #83 : (lb-ht "en/1969/SPTM191" nil) 1:LAPL:done:`` kimberly ;;--L0C-- `07/04 #84 : (lb-ht "en/1980/WHRR176" nil) ;; `06/09 #15: (lb-ht "es/1977/ERD148" ) ;; 2007.02.25 - OLD - from Sept. ;; `06/09 #14: (lb-ht "es/1980/QEMD256" ) ;; 2007.02.25 - OLD - from Sept. ;;--L0C-- `07/04 #85 : (lb-ht "en/1973/ABH264" nil) 2:LAPL:done:`` ;;--L0C-- `07/05 #86 : (lb-ht "en/1966/1PRU463" nil) 2:LAPL:done:`` ;;--L0C-- `07/05 #87 : (lb-ht "en/1975/CMEAT178" nil) 2:LAPL:done:`` ;;--L0C-- `07/05 #88 : (lb-ht "en/1975/PMSU147" nil) 2:LAPL:done:`` ;;--L0C-- `07/05 #89 : (lb-ht "en/1977/USITP299" nil) 2:LAPL:done:`` ;;--L0C-- `07/05 #90 : (lb-ht "en/1980/MP399" nil) 2:LAPL:done:`` ;;--L0C-- `07/05 #91 : (lb-ht "en/1971/FCU179" nil) 2:LAPL:done:`` ;;--L0C-- `07/07 #92 : (lb-ht "en/1972/CMTTC290" nil) ;;--L0C-- `07/05 #93 : (lb-ht "en/1979/2RHLM616" nil) ;;--L0C-- `07/05 #94 : (lb-ht "en/1985/BUSH268" nil) ;;--L0C-- `07/05 #95 : (lb-ht "en/1975/CRCU244" nil) ;;--L0C-- `07/05 #96 : (lb-ht "en/1980/PROCE270" nil) ;;--L0C-- `07/05 #97 : (lb-ht "en/1982/SLCR191" nil) ;;--L0C-- `07/05 #98 : (lb-ht "en/1971/SCSP287" nil) ;;--L0C-- `07/05 #99 : (lb-ht "en/1939/HCPSU364" nil) ;;--L0C-- `07/05 #100: (lb-ht "en/1975/PDC248" nil) ;;--L0C-- `07/05 #101: (lb-ht "en/1981/WISPE319" nil) ;;--L0C-- `07/05 #102: (lb-ht "en/1975/PS429" nil) ;;--L0C-- `07/06 #103: (lb-ht "en/1971/DRTC378" nil) ;;--L0C-- `07/06 #104: (lb-ht "en/1971/SSSPD271" nil) ;;--L0C-- `07/06 #105: (lb-ht "en/1985/ISOP276" nil) ;;--L0C-- `07/06 #106: (lb-ht "en/1982/RADU283" nil) ;;--L0C-- `07/06 #107: (lb-ht "en/1976/MLAL268" nil) ;;--L0C-- `07/06 #108: (lb-ht "en/1982/SI507" nil) ;;--L0C-- `07/06 #109: (lb-ht "en/1978/TOLI198" nil) ;;--L0C-- `07/06 #110: RERUN lb-ht.el - - - ;; 2007.06.20 - that was dumb - ... ;;--L0C-- `07/06 #110: (lb-ht "en/1982/WCE326" nil) ;;--L0C-- `07/06 #111: (lb-ht "en/1973/FOS375" nil) ;;--L0C-- `07/07 #112: (lb-ht "en/1972/MLOWA430" nil) ;;--L0C-- `07/07 #113: (lb-ht "en/1979/UIAI351" nil) ;;--L0C-- `07/07 #114: (lb-ht "en/1975/MAW306" nil) ;;--L0C-- `07/07 #115: (lb-ht "en/1972/SATR278" nil) ;;--L0C-- `07/07 #116: (lb-ht "es/1980/EUYAL357" nil) ;;--L0C-- `07/07 #117: (lb-ht "en/2000/WIE126" nil) ;;--L0C-- `07/07 #118: (lb-ht "en/1978/MLP519" nil) ;;--L0C-- `07/07 #119: (lb-ht "en/1973/SC181" nil) ;;--L0C-- `07/07 #120: (lb-ht "en/1978/TP408" nil) ;;--L0C-- `07/07 #121: (lb-ht "en/1972/LCPT354" nil) ;;--L0C-- `07/07 #122: (lb-ht "en/1968/SSD255" nil) ;;--L0C-- `07/07 #123: (lb-ht "en/1988/FDAB259" nil) ;; `07/00 #124: (lb-ht "en/" nil) ;; `07/00 #125: (lb-ht "en/" nil) ;; `07/00 #126: (lb-ht "en/" nil) ;; `07/00 #127: (lb-ht "en/" nil) ;; `07/00 #128: (lb-ht "en/" nil) ;; `07/00 #129: (lb-ht "en/" nil) ;; `07/00 #190: (lb-ht "en/" nil) ;; `07/00 #191: (lb-ht "en/" nil) ;; `07/00 #192: (lb-ht "en/" nil) ;; `07/00 #193: (lb-ht "en/" nil) ;; `07/00 #194: (lb-ht "en/" nil) ;; `07/00 #195: (lb-ht "en/" nil) ;; `07/00 #196: (lb-ht "en/" nil) ;; `07/00 #197: (lb-ht "en/" nil) ;; `07/00 #198: (lb-ht "en/" nil) ;; `07/00 #199: (lb-ht "en/" nil) ;; wish-list: ;; Ralph Dumain: MEANING AND CONCEPTUAL SYSTEMS (2006.02.23) ;; ----------------------------------------------------------------------------- ;;; do not provide. ; lb-hooks.el0100644000175100017510000002443710653657055012751 0ustar cymbalacymbala ;; Hooks. ;; Emacs-Time-stamp: "2007-07-31 09:07:09" (setq file-stamp "Emacs-File-stamp: \"/home/ysverdlov/leninist.biz/lb-hooks.el\"") ;;; files.el ;;;(defun basic-save-buffer () ;;;(or (run-hook-with-args-until-success 'write-contents-hooks) ;;; (run-hook-with-args-until-success 'local-write-file-hooks) ;;; (run-hook-with-args-until-success 'write-file-hooks) ;;; ;; If a hook returned t, file is already "written". ;;; ;; Otherwise, write it the usual way now. ;;; (setq setmodes (basic-save-buffer-1))) ;; Used by hooks: (defun lb-date-verbal nil "Now" ;; (lb-date-verbal) => "2005 May 31" (with-temp-buffer ;; (shell-command "822-date" t) (insert (format-time-string "%Y %B %d")) (buffer-substring-no-properties (point-min) (point-max)))) (defun lb-date-YYYY.MM.DD nil "Now" ;; (lb-date-verbal) => "2005 May 31" (with-temp-buffer ;; (shell-command "822-date" t) (insert (format-time-string "%Y.%m.%d")) (buffer-substring-no-properties (point-min) (point-max)))) ;; Used by hooks: (defun lb-bfn-to-url (arg1bfn) "" ;; (lb-bfn-to-url (buffer-file-name)) => "http://leninist.biz/lb.el" (let (x) (save-match-data (and (string-match abbreviated-home-dir (setq x (buffer-file-name))) (string-match "^~" (setq x (replace-match "~/" t t x))) (replace-match "http:/" t t x))))) ;; ;; "dired-after-readin-hook" comes after "dired-mode-hook" in dired.el. ;; SEE dired-internal-noselect. ;; - hook dired-mode-hook run at end of (dired-mode. ;; - hook dired-after-readin-hook run after that. ;; (setq dired-mode-hook nil) ;; (add-hook 'dired-mode-hook 'lb-dired-hook-insert-dot-index) ;; (setq dired-after-readin-hook nil) ;; (defun lb-dired-hook-insert-dot-index (&optional arg1) "" (interactive "p") (let (lb-path lb-files lb-rc) (when (string-match (concat lb-re-path-year+book "$") (dired-current-directory)) (setq lb-path (match-string-no-properties 0 (dired-current-directory))) (if (and (and (not (string-match "^AF1H4YV" (system-name))) ) (null (directory-files (dired-current-directory) t ;; fix? ;; should use regexp. (concat "^" lb-file-dot-index "$") ))) (lb-db-insert-dot-index-book lb-path))) ;; .index does not appear in dired window until... ;; (revert-buffer) ;;; Signaling: (error "Variable binding depth exceeds max-specpdl-size") ;;; file-name-non-special(expand-file-name "ls" "/:/bin") ;;; call-process("ls" nil t nil "-al" "--" "/home/login/leninist.biz/.") ;;; apply(call-process "ls" nil t nil ("-al" "--" "/home/login/leninist.biz/.")) ;;; insert-directory("/home/login/leninist.biz/" "-al" nil t) ;;; dired-insert-directory("~/leninist.biz/" "-al" nil t) ;;; dired-readin-insert("~/leninist.biz/") ;;; dired-readin("~/leninist.biz/" #) ;;; dired-revert(nil nil) ;;; revert-buffer() lb-rc)) (add-hook 'dired-after-readin-hook 'lb-dired-hook-insert-dot-index) (defun lb-do-auto-fill () "" (let (lb-pf lb-line) (setq lb-line (buffer-substring-no-properties (save-excursion (beginning-of-line) (point)) (save-excursion (end-of-line) (point)))) (do-auto-fill) ;; ;; Why is [SPACE][BACKSPACE] necessary? ;; Why not just [SPACE]? (if (string-match "^__TITLE__[^\n]+: $" lb-line) (insert "\n__SUBTITLE__ ") (if (string-match "^__SUBTITLE__[^\n]+: $" lb-line) (insert "\n__SUBTITLE2__ "))) )) ;; This takes too long every time an .index is opened. ;; Only really needed when adding a new book; SEE: lb-db-insert-dot-index-type ;; ;; But, without it, empty template is *NOT* added to new .index! (add-hook 'find-file-hooks 'lb-db-find-file-hook) (defun lb-db-find-file-hook nil "" (let ((lb-bfn (buffer-file-name))) (when (or (string-match (concat "/" lb-re-file-rawdata) lb-bfn) nil) (local-set-key "\M-q" 'lb-db-fill-paragraph) (local-set-key "\M-a" 'lb-db-fill-paragraph) (setq auto-fill-function 'lb-do-auto-fill) ;; If empty, add first record. (when (string= "" (buffer-string)) (progn (insert "\n0\n\n0") (save-buffer 0)) (progn (lb-db-insert-rec nil) (save-buffer 0)) (lb-db-insert-dot-index-type)) ;; (lb-db-check-dot-index lb-bfn) ;; SEE: lb-db-insert-dot-index-book ;; (lb-db-shell-grep-titl2 lb-bfn) ))) (defun lb-time-stamp-format nil "" (let ((lb-bfn (buffer-file-name))) (if (string-match lb-domain lb-bfn) (set (make-local-variable 'time-stamp-format) "%:y-%02m-%02d %02H:%02M:%02S")))) ; (add-hook 'find-file-hooks 'lb-time-stamp-format) (defun lb-write-file-hooks-text-mode-formatting nil "" (let (lb-rc) (when (or (eq 'text-mode major-mode) (eq 'text-mode major-mode)) (add-hook 'local-write-file-hooks '_-compress-multiple-newlines t) (add-hook 'local-write-file-hooks 'lb-db-fill-paragraph-non-interactive t)) (when (or (string-match "[.]txq?$" (bfn)) ) (add-hook 'local-write-file-hooks 'lb-tx-check-^^ t) (add-hook 'local-write-file-hooks 'lb-tx-check-buffer4-singularities t) (add-hook 'local-write-file-hooks 'lb-tx-check-buffer4-trailing-dash t) (add-hook 'local-write-file-hooks 'lb-tx-check-buffer4-para-break-before-last-line t) ) ;; be sure to return nil so can be used on write-file-hooks nil)) (add-hook 'find-file-hooks 'lb-write-file-hooks-text-mode-formatting) ;; (lb-write-file-hook-sgml-stamps-visible) (add-hook 'local-write-file-hooks 'lb-write-file-hook-sgml-stamps-visible) (defun lb-write-file-hook-sgml-stamps-visible (&optional arg1force) " Optional ARG1, if non-nil, will force this function to do its thing; otherwise change depends upon major-mode" ;; (let (lb-pf nil_rc) (goto-char (point-max)) (while (and (or arg1force (eq 'html-mode major-mode) (eq 'sgml-mode major-mode) (eq 'text-mode major-mode) ;; Raw markup (lb-mu.el). (eq 'xml-mode major-mode)) (search-backward-regexp "class=\"\\(modified\\|self-url\\)\"" nil t)) ;; (save-excursion (when (and (string= "span" (_-sgml-what-element)) (search-forward-string ">")) ;; 2006 Feb 3 (if (sfr (concat ;; 2007.07.31 - stopped working when ;; changed from: ;; 2006 Feb 3 ;; to: ;; Created= 2006 Feb 3 ;; -------------------- ;; _-whitespace-noM "*" ;; "\\([^0-9]*\\)" ;; "\\(.*\\)" "\\(2[0-9][0-9][0-9] [A-Z][a-z]+ [0-9]+\\)") (sex (sfr "\\(\\| (setq lb-pt (point-max)) (goto-char (point-min)) (when (search-forward-regexp "<\\([A-Ba-b]+\\)" nil t) (setq lb-str (match-string 1)) (save-excursion (goto-char lb-pt) (setq lb-pt (search-backward (concat ""))))) (goto-char lb-pt) (insert "") ;; (goto-char (point-min)) (search-forward-regexp "[0-9][.]\\([ \t\n\r]+\\)") (replace-match "\n
    " t t nil 1))) (buffer-string)) t t nil nil)) ;; end while. (setq lb-list-arg1 (cdr lb-list-arg1))) ;; while control. end while. lb-rc)) (defun lb-ht-comment-page-numbers (arg1pf) ;)(03 h. "" (_-dfun-hook "lb-ht-comment-page-numbers") ;; (let (lb-pf lb-src lb-str lb-pt-bound lb-rc) (save-match-data (save-excursion (progn (string-match (expand-file-name lb-home) arg1pf) (setq lb-src (replace-match "" nil nil arg1pf))) (progn (goto-char (point-min)) (setq lb-pt-bound (search-forward-string " "))) (goto-char (point-max)) (while (search-backward-regexp lb-re-bracketed-para-integer lb-pt-bound t) (setq lb-str (match-string 1)) (replace-match (lb-ht-src_pg_dte_www lb-src lb-str _-where-page-numbers))) )) lb-rc)) ;; (lb-ht-get-copy-directories "en/1926/MD152") (defun lb-ht-get-copy-directories (arg1subpath) "" (_-dfun-hook "lb-ht-get-copy-directories") ;; (let (lb-pf) (setq lb-pf (concat lb-home arg1subpath)) (with-temp-buffer (shell-command (concat "find " lb-pf " -follow -type d -name '" lb-re-YYYYMMDD"'") t) (buffer-string) (_-something-to-list)))) (defun lb-ht-src_pg_dte_www (arg1s arg2p arg3where) "Return source (ARG1), page (ARG2), and where-page-numbers (ARG3) combined with current date as an SGML comment" ;; (let (lb-pf lb-item lb-www lb-rc) (if (integerp arg2p) (setq arg2p (int-to-string arg2p))) (save-match-data ;; Assumption: Website URL is in local path: "~/leninist.biz/" (loop for lb-item in (reverse (split-string lb-home "/")) do (if (and (not lb-www) (string-match "[a-z0-9]" lb-item)) (setq lb-www lb-item))) ;; OLD: (setq lb-rc (concat "\n\n\n\n")) (setq lb-rc (concat ;; 2006.03.24 "\n\n\n\n"))) lb-rc)) ;; (defun lb-ht-harvest-levels nil " Function 'lb-ht-toc-parse-a-__heading__-para' moves point forward. Function 'lb-ht-toc-parse-a-__heading__-para' will skip over paragraphs not matched by 'lb-re-__-lvl4chunking-real' and return nil instead of a level list" (_-dfun-hook "lb-ht-harvest-levels") ;; (let ( lb-rc) (while (or (looking-at lb-re-__-lvl4chunking) ;; fix? ;; Maybe include quotations at beginning of chapter that ;; fall inbetween LVL1 and LVL2 in original? (looking-at lb-re-__-lvl4chunking-skipover) ) (if (looking-at lb-re-__-lvl4chunking) (setq lb-rc (append lb-rc (list (lb-ht-toc-parse-a-__heading__-para)))) ;; xxxtender 7 ;; Otherwise, (progn (goto-char (cdr (_-where-double-newlines))) (_-move-forward-whitespace)) ;; Position for next one. nil)) lb-rc)) ;; (defun lb-ht-para-type (arg1str &optional arg2prevrc) "Return type of object judging from string ARG1. Optional ARG2 is value returned by previous call to this function" ;; (let (lb-pf lb-rc) (save-match-data (if (and (not lb-rc) (string-match "^\\(Emacs-\\)?Time-stamp:" arg1str)) (setq lb-rc "TIME-STAMP")) ;; __NUMERIC_LVL1__ and __ALPHA_LVL1__. (if (and (not lb-rc) (string-match (concat "^" lb-re-__) arg1str)) (setq lb-rc (match-string 0 arg1str))) (if (and (not lb-rc) (string-match "^ (point) (point-min)) (or (forward-char -1) t)) (if (looking-at "[ \t\n\r][=][ \t]*[\n]") t))))) (setq lb-rc "CONTINUED-=")) ;; TEMPLATES. (if (and (not lb-rc) (string-match "^abcdefg" arg1str)) (setq lb-rc "")) (if (and (not lb-rc) (string-match "^abcdefg" arg1str)) (setq lb-rc "")) (if (and (not lb-rc) (string-match "^abcdefg" arg1str)) (setq lb-rc "")) (if (and (not lb-rc) (string-match "^abcdefg" arg1str)) (setq lb-rc "")) ;; DEFAULT (if (null lb-rc) (setq lb-rc "OTHER"))) lb-rc)) ;; (defun lb-ht-get-minors (arg1chaptitle) "ARG1 is an nth-1 from list returned by lb-ht-toc-get-headings" ;; (lb-ht-get-minors (nth 1 (lb-ht-toc-get-headings 12))) ;; (lb-ht-get-minors nil) ;; => ((8 . "1. OVERCOMING HEGEL") ...) (_-dfun-hook "lb-ht-get-minors") ;; (let ( lb-rc) (loop for i from 1 to (1- (length lbg-sections)) do (setq lb-headings-there (lb-ht-toc-get-headings i t)) (if (string= arg1chaptitle (nth 1 lb-headings-there)) (_-app 'lb-rc (list (cons (nth 3 lb-headings-there) i))))) lb-rc)) ;; (lb-ht-gen-insert-img-close-slash) (defun lb-ht-gen-insert-img-close-slash nil "ABBYY uses so insert slash before '>'" (_-dfun-hook "lb-ht-gen-insert-img-close-slash") (let (_rc) (goto-char (point-min)) (while (search-forward-regexp "<[iI][mM][gG]" nil t) (replace-match (downcase (match-string-no-properties 0)) t t) (search-forward-string ">") (when (not (looking-at-backward-become-forward "/[ \t\n]*>")) (forward-char -1) (insert " /"))) _rc)) (defun lb-ht-gen-add-span-pageno-subroutine (arg1where-lag) (setq _pg (match-string-no-properties 1)) (setq _where (match-string-no-properties 2)) (let (_visible _visible-on-the-fly) (if (setq _visible (if (string= "top" _where) _pg (if arg1where-lag arg1where-lag))) (save-excursion (if (string= "bottom" _where) (end-of-line) (beginning-of-line)) (insert (concat "\n\n" "" ;; ON-THE-FLY (progn (setq _visible-on-the-fly _visible) ;; Remove leading "0"s. (if (string-match "^0+" _visible-on-the-fly) (setq _visible-on-the-fly (replace-match "" t t _visible-on-the-fly))) _visible-on-the-fly) "" "\n\n"))))) _pg) ;; (lb-ht-gen-add-span-pageno) (defun lb-ht-gen-add-span-pageno nil "Show page numbers in webpage" (_-dfun-hook "lb-ht-gen-add-span-pageno") (let (_pt _pt-data-begin _pg _pg-lag _where _where-lag _lag _re-pg-where _rc) ;; Where page numbers? (goto-char (point-min)) (while (search-forward-string "where=" nil t) (when (_-sgml-comment-p) (setq _where (progn (looking-at "[^ ]+") (match-string-no-properties 0))) (if (and _where-lag (not (string= _where _where-lag))) (error "%s: %s" _where-lag _where)) (setq _where-lag _where))) ;; fix? uncomment? ;; (setq _pt-data-begin (search-forward-string "%%data%%" nil nil)) (progn (setq _re-pg-where (concat "pg=\\([^ ]+\\)" "[^\n]+" "where=\\([^ ]+\\)")) (if (string= "bottom" _where) (goto-char (point-max)) (if (string= "top" _where) (goto-char (point-min)) (error "%s: %s" "Not top or bottom" _where)))) (if (string= "top" _where) ;; MAIN. (while (sfr _re-pg-where nil t) (when (_-sgml-comment-p) (setq _pg-lag (lb-ht-gen-add-span-pageno-subroutine _pg-lag)))) (while (sbr _re-pg-where nil t) (when (_-sgml-comment-p) (setq _pg-lag (lb-ht-gen-add-span-pageno-subroutine _pg-lag)))) ;; Flush lagged value. (search-backward "%%data%%") (end-of-line) (lb-ht-gen-add-span-pageno-subroutine _pg-lag)) _rc)) (defun lb-ht-OLD-2007.03.04-gen-add-span-pageno nil "Show page numbers in webpage" (_-dfun-hook "lb-ht-gen-add-span-pageno") (let (_pg _where _lag _pt _pt-data-begin _rc) ;; (foo "1" "top") ;; (foo "1" "bottom") (defun foo (_pg _where) (concat "\n\n" "" (if (string= "bottom" _where) (int-to-string (1+ (string-to-int _pg))) _pg) "" "\n\n")) (goto-char (point-min)) (setq _pt-data-begin (search-forward-string "%%data%%" nil nil)) (goto-char (point-max)) (while (and (setq _pt (search-backward-regexp (concat " (if (or (search-backward-string "%%notes%%" nil t) (search-forward-string "%%notes%%" nil t)) (if (not (_-sgml-comment-p)) (tx-editing-del-para))) _rc)) ;; (lb-ht-gen-wrap-arrows-without-href-with-span) (defun lb-ht-gen-wrap-arrows-without-href-with-span nil "Delete arrow if no HREF" (_-dfun-hook "lb-ht-gen-wrap-arrows-without-href-with-span") ;; (let (_pt _rc) (goto-char (point-min)) (while (and (search-forward-regexp ""))) t)) (_-sgml-markup-p)) (goto-char _pt) (if (looking-at "\\(&[lg]t;\\)+<") (replace-match (concat "" (match-string 0) "/span><" ""))))) _rc)) ;; (defun lb-ht-gen-del-leading-href-poundsign nil ;)(03c "Remove '#' from beginning of HREF for final version (not templates)" (_-dfun-hook "lb-ht-gen-del-leading-href-poundsign") ;; (let ( lb-rc) ;; fix! ;; do not hardcode here. (loop for lb-item in '(".index" ;; 2006.11.17 ;;"index" "index.html" ;; 2006.12.04 ;; "bibl" "index.card" "index.txt" "index.ps" "index.pdf") do (if (not (string-match "[.]" lb-item)) (setq lb-item (concat lb-item "" lb-ext-html))) (goto-char (point-min)) (while (search-forward-regexp (concat "href=\"" "\\(" "#" "\\)" lb-item "\"") nil t) (replace-match "" nil nil nil 1))))) ;; (lb-ht-generate-index-card) (defun lb-ht-generate-index-card nil " NOTE: .db are updated from .index with ~/leninist.biz$ bash lb.sh en 1" (_-dfun-hook "lb-ht-generate-index-card") ;; (let (lb-str lb-tags-in-db lb-tags-in-tmplt lb-pf-db lb-publ-translations (lb-rc lbg-card-index)) ;; fix! Fields like TITLE might be different between .tx and .index !!! (progn ;; (progn (lb-ht-common-__ "lb-ht-generate-index-card") lb-ht-__) (setq lb-tags-in-db (lb-db-get-__-tags (setq lb-pf-db (concat (file-name-directory lbg-html-index) lb-file-db)))) (setq lb-tags-in-tmplt (with-temp-buffer (_-ifcl lbg-pf-template) (normal-mode) (goto-char (point-min)) ;; Isolate table with __TAGS__. (delete-region (point) (search-forward-regexp "") (delete-region (point) (point-max)) (lb-db-get-__-tags nil))) ;; Ensure all __TAGs__ in .db are also in book.htmm. (loop for tag in lb-tags-in-db do (if (and ;; "Private" variables, visible with a click on ".index" (not (member tag (list "__NOTE__" "__NOTES__" "__NOTES__" "__NOTES__" "__NOTES__" "__NOTES__" "__NOTES__" "__NOTES__" "__NOTES__" "__NOTES__" "__NOTES__" "__NOTES__" "__NOTES__" ;; fix! Mark "private" variables in __ "__SCAN_TIFFS__" "__BACK_MATTER__" "__ABBREV__" "__UNIQID__" "__BLEMISHES__" "__APPEAR__" "__REDDOT__" "__OWNER__" "__TO_DO__" "__SOURCE__"))) (not (member tag lb-tags-in-tmplt)) ) (error "%s: %s" (concat "Look in table-index-card.e* for" tag " from " lb-pf-db) lbg-pf-template)) (__handler "PUT" tag (cond ((string= "__PUBL__" tag) (if (not (setq lb-str (assoc (lb-db-__-get- tag lb-pf-db t) lb-assoc-publ))) (error "%s: %s" tab "lb-assoc-publ") (nth 1 lb-str))) (t ;; fix? - already have a function that deletes <<...>> ? (with-temp-buffer (insert (lb-db-__-get- tag lb-pf-db t)) (while (or (search-forward-regexp "\\(<<\\|>>\\)" nil t) (search-backward-regexp "\\(<<\\|>>\\)" nil t)) (replace-match "")) (buffer-string)) )))) lb-ht-__) ;; MAIN: (progn (_-force-new-file lbg-card-index) (_-ifcl lbg-pf-template) ;; Substitutions and deletions. ;; fix? - move to lb-mu-spawn-finale? ;; YES. 2006.12.12 ;; (lb-ht-subs-and-dels-__) ) (progn (goto-char (point-min)) ;; Needed just once. (while (_-flush-one-paragraph "__PREV_")) (while (_-flush-one-paragraph "__NEXT_"))) (progn (goto-char (point-min)) (search-forward-string "%%data%") (_-para-delete)) ;; Delete navigation table. (progn (goto-char (point-max)) (search-backward "
    ") (delete-region (point) (search-forward-string "
    "))) ;; Delete notes region. (progn (goto-char (point-max)) (search-backward-string lb-str-div-class-notes) (delete-region (point) (search-forward-string "

    "))) ;; (lb-mu-spawn-finale nil nil (list 'lb-ht-gen-del-leading-href-poundsign ;; index-card 'lb-ht-gen-add-poundsign-with-id ;; index-card 'lb-ht-gen-del-%%notes%% ;; index-card ;; fix! stick ones like this in a list to share with generate-book! ;; 'lb-ht-gen-wrap-arrows-without-href-with-span ;; index-card ) ) (lb-lftp-dosomething-file lbg-card-index) (lb-lftp-dosomething-file (concat (file-name-directory lbg-card-index) lb-file-dot-index)) lb-rc)) ;; (defun lb-ht-subs-and-dels-__ (&optional arg1__assoc) "" ;; (let ( _rc) (if (not arg1__assoc) (setq arg1__assoc lb-ht-__)) ;; __ substitutions. (lb-ht-sub-__ arg1__assoc) ;)(03 d. ;; Delete __TAGS__. (lb-tx-zap-paragraphs lb-re-__) ;)(03 e. _rc)) ;; (lb-ht-common-__) (defun lb-ht-common-__ (&optional arg1) "Set some variables using __handler. Optional ARG1 may be: - called from lb-ht-generate-book ARG1 is the name of that function - called from lb-ht-generate-toc ARG1 is not used " (_-dfun-hook "lb-ht-common-__") ;; (let (lb-title lb-headings lb-lvl-max lb-numeric lb-alpha lb-str lb-cdata lb-tdata lb-href lb-rc) (setq lb-ht-__ nil) (__handler "PUT" "*" (concat " " "
    " " * " "
    \n\n")) (__handler "PUT" "*_*_*" (concat " " ;; WARNING - 2006.12.08 - Keep this "" ;; 2006.12.08 ;; "  
    \n" ;;"  
    \n\n" " * * * " ;;"  \n\n" "
    \n\n")) (__handler "PUT" "TITLE_ELEMENT_TITLE" nil) (__handler "PUT" "TITLE_ELEMENT_SORT_BY_PATH" lbg-path-from-lang) (if (not __TITLE__) (error "%s: %s" "Missing" "__TITLE__") (setq lb-title (_-capitalize-cdata __TITLE__))) (__handler "PUT" "DIV_HEADER_TITLE" ;; 2007.07.02 (_-strip-br--M-9--^^-anchors (_-downcase-nonsignifs lb-title)) ) (__handler "PUT" "DIV_HEADER_SUBTITLE" (_-strip-br--M-9--^^-anchors __SUBTITLE__) ) (__handler "PUT" "DIV_HEADER_SUBTITLE2" (_-strip-br--M-9--^^-anchors __SUBTITLE2__) ) ;; ------------------------------------------------------- ;; When called from: lb-ht-generate-index-card (when (and (stringp arg1) (string= "lb-ht-generate-index-card" arg1)) ;; 140k: /home/login/leninist.biz/en/1970/LTRSP88/index.txt (with-temp-buffer (insert-file-contents-literally lbg-text-indextx nil 0 25000) (goto-char (point-min)) (if (search-forward-string "__COPYRIGHT__" nil t) (__handler "PUT" "COPYRIGHT" (car (lb-tx-get-__ "COPYRIGHT" t))))) ;; fix! EN vs. ES. (__handler "PUT" "TITLE_ELEMENT_TITLE" "Card") ;; 2006.12.05 - Superfluous. ;; (__handler "PUT" "DIV_HEADER_TITLE" "Card Catalog") ;; ) ;; ------------------------------------------------------- ;; When called from: lb-ht-generate-book (when (and (stringp arg1) (string= "lb-ht-generate-book" arg1)) ;; (__handler "PUT" "TITLE_ELEMENT_TITLE" lbg-html-href) ;; (__handler "PUT" "LOGO_ONMOUSEOVER" (concat " •" "section=" (int-to-string lbg-i-from1) ;; " •" )) (progn ;; Data for headings substitution. ;; These appear at top of webpage. (setq lb-headings (lb-ht-toc-get-headings lbg-i-from1 t)) ;; fix! BR tags not disappearing from navigation footer. (if (setq lb-str (nth 0 lb-headings)) (__handler "PUT" "NUMERIC_LVL1_CDATA" (_-sgml-str-del-tags (_-strip-br--M-9--^^-anchors lb-str) (list "br")))) (if (setq lb-str (nth 1 lb-headings)) (__handler "PUT" "ALPHA_LVL1_CDATA" (_-sgml-str-del-tags (_-strip-br--M-9--^^-anchors lb-str) (list "br")))) (if (setq lb-str (nth 2 lb-headings)) (__handler "PUT" "NUMERIC_LVL2_CDATA" (_-sgml-str-del-tags (_-strip-br--M-9--^^-anchors lb-str) (list "br")))) ;; Added NUMERIC_LVL2_CDATA on 2006.03.09 (if (setq lb-str (nth 3 lb-headings)) (__handler "PUT" "ALPHA_LVL2_CDATA" (_-sgml-str-del-tags (_-strip-br--M-9--^^-anchors lb-str) (list "br")))) ;; 2006.11.23 - Added ..._LVL3_... (if (setq lb-str (nth 4 lb-headings)) (__handler "PUT" "NUMERIC_LVL3_CDATA" (_-sgml-str-del-tags (_-strip-br--M-9--^^-anchors lb-str) (list "br")))) (if (setq lb-str (nth 5 lb-headings)) (__handler "PUT" "ALPHA_LVL3_CDATA" (_-sgml-str-del-tags (_-strip-br--M-9--^^-anchors lb-str) (list "br")))) ;; fix? what is this? do _-strip-br--M-9--^^-anchors on it? ;; TOC_A_ELEMENT looks messy. (when nil (setq lb-str (concat "" "CONTENTS")) (__handler "PUT" "TOC_A_ELEMENT" lb-str)) ) (progn ;; Data for navigation. ;; (setq lb-ht-__ nil) (loop for i-lvl from (setq lb-lvl-max (string-to-int ;; Highest LVL in this section. (nth 1 (assoc lbg-i-from1 lbg-sections-max-levels-list)))) downto 1 do ;;; TEMPLATE2SCRIPT: ;;; 12 lines matching "_lvl" in buffer book.htmm. ;;; 91: \n\n")) ;; Insert section. ;; Inserted data is bounded by: ;; ABOVE: src= comment for first page of section. ;; BELOW: src= comment for page AFTER last page of section. (insert (lb-ht-generate-wholesome-text arg1testing)) ;)(04 a (insert (concat "\n\n \n\n")) (insert (concat "\n\n \n\n")) (setq _-where-page-numbers _-where-page-numbers-global)) (when (string= "2006.09.04 moved from masa" "2006.09.04 moved from masa") ;; ;; Anchor and move footnotes. ;; Already deleted __CHILD_CITATION_* (lb-ht-toc-get-section). ;;xxxxxxxxxxxxxx ;; (if (= 30 lbg-i-from1) (error "%s" (_-buffer-substring-from-))) (lb-ht-footnotes-anchor-and-move) ;)(03 f. (when nil (if (= 11 lbg-i-from1) (error "%s" (concat "a" (_-buffer-substring-from-))))) ) ;; Comment time-stamps before inserting into template. ;; fix? ;; Return oldest and newest time-stamps ? (progn (goto-char (point-min)) (while (search-forward-string "Emacs-Time-stamp:" nil t) (beginning-of-line) (if (looking-at "[^\n]*"))) ;; Delete " =\n\n" before A anchor. (progn (goto-char (point-min)) (while (search-forward-regexp (concat "[ \t\n]\\(=\\)[ \t]*" "\n[ \t]*\n") nil t) (replace-match "" nil nil nil 1))) ;; OTHER? (progn ) ;; (setq lb-rc (buffer-substring-no-properties (point-min) (point-max)))) lb-rc)) ;; (lb-ht-insert-tx-into-html-masa-preparada) (defun lb-ht-insert-tx-into-html-masa-preparada (&optional arg1testing) ;)( "Generates text that gets inserted into HTML template. Gets text using lb-ht-tx-transform-target-html. ... lb-ht-footnotes-anchor-and-move _-join-hyphenated-words ... Returns list with two buffer substrings: %%data%% and %%notes%%" ;; (_-dfun-hook "lb-ht-insert-tx-into-html-masa-preparada") ;; (let ( lb-rc) (with-temp-buffer ;; (setq _-where-page-numbers _-where-page-numbers-global) (insert ;; (concat "\n\n \n\n") ;; Insert raw text after some minor transformations. (lb-ht-tx-transform-target-html arg1testing) ;)(03 a ;; (concat "\n\n \n\n") ) (when nil (if (= 11 lbg-i-from1) (error "%s" (concat "a" (_-buffer-substring-from-))))) ;; fix? put _-join-hyphenated-words into ...transform-target-html ? ;; fix! this is pointless! words already joined! ;; After moving footnotes, join word fragments by deleting hyphens. ;; fix? 2007.04.10 - when would they not be joined? (_-join-hyphenated-words) ;)(0 ;; ;; Return list with two buffer substrings: %%data%% and %%notes%%. (progn (goto-char (point-min)) (search-forward-string "%%div-class-notes-start%%") (beginning-of-line) (setq lb-rc (list (buffer-substring-no-properties (point-min) (point)) (buffer-substring-no-properties (point) (point-max)))) )) lb-rc)) ;; (lb-ht-insert-tx-into-html) ;; (lb-ht-insert-tx-into-html t) (defun lb-ht-insert-tx-into-html (&optional arg1testing) ;)( "Open index.html, delete %%data%% and insert .tx data transformed for HTML target. Anchor and move footnotes. Write buffer to HTML chunk" (_-dfun-hook "lb-ht-insert-tx-into-html") ;; (let (lb-data-and-notes lb-rc) ;; (setq lb-data-and-notes (lb-ht-insert-tx-into-html-masa-preparada arg1testing)) ;; TESTING: (when arg1testing (lb-testing-error-foo lb-data-and-notes)) ;; (with-temp-buffer ;; Insert template. ;; index.html is template until it is changed to Contents. (_-ifcl lbg-html-index) (goto-char (point-min)) (search-forward-string "%%data%%") (_-para-delete) (insert (car lb-data-and-notes)) (search-forward-string "%%notes%%") (_-para-delete) (insert (nth 1 lb-data-and-notes)) ;; Leave %%div-class-notes-start%% alone. ;; (_-compress-multiple-newlines) (write-region (point-min) (point-max) (setq lb-rc lbg-pf-output-html))) lb-rc)) ;; (defun lb-ht-generate-webpage nil "" ;; (let ( _rc) ;; Check for __ALPHA_LVL0__ entry in index.tab: (lb-ht-common-__ "lb-ht-generate-book") ;; 2006.12.11 ;; Every disk write: (a.) copy pre-existing to .wdiffin . ;; Every disk write: (b.) re-create file. ;; Every disk write: (c.) upload if two are different. (lb-wdiff lbg-pf-output-html "beg") (lb-ht-insert-tx-into-html) ;; -------------------------------------------- ;; Open actual file (not temp-buffer as above). ;; This allows (bfn) to work. (save-excursion ;; 2007.07.07 - cannot get _-highascii2html_entities working. (_-set-buffer-to-pf lbg-pf-output-html) (toggle-read-only nil) ;; - THIS FIXED: ;; (find-file lbg-pf-output-html) ;; - SO: changed "find-file-literally" to "find-file" in ;; _-set-buffer-to-pf ;; ;; Old code showing use of FONT tag to shrink cdata. ;; "" ;; ... (progn ;; Substitutions and deletions. ;; fix? - move to lb-mu-spawn-finale? ;; YES. 2006.12.12 ;; (lb-ht-subs-and-dels-__) ;; Change TX ... now? not later? ;; fix! ;; _-tx2something in lia-tx.el changes ^M (_-tx2something) ;)(0 ) (progn ;; fix? ;; Page sequence starts from 0 sometimes. ;; Change page numbers into SGML comments (spdw). (lb-ht-comment-page-numbers lbg-pf-output-html)) ;)(03 h. (progn ;; Stamps. (set-buffer-modified-p t) (time-stamp) (lb-write-file-hook-sgml-stamps-visible t)) ;)(03 x. (progn ;; (_-compress-multiple-newlines) ;; Debugging. (write-region (point-min) (point-max) "~/foo") ;; (lb-mu-spawn-finale nil nil (list 'lb-mu-insert-pound-anchors-at-beg-of-blocks 'lb-mu-insert-pound-anchors-scroll2next ;;; xxx 'lb-mu-insert-pound-anchors-move-them-above-p 'lb-ht-gen-del-leading-href-poundsign ;)(03 c. ;; 'lb-ht-gen-wrap-arrows-without-href-with-span 'lb-ht-gen-add-poundsign-with-id 'lb-ht-gen-add-poundsign-with-id-to-index ;)(. 'lb-ht-gen-add-span-pageno 'lb-ht-gen-del-%%notes%% 'lb-ht-gen-insert-img-close-slash ;; 2007.07.06 '_-highascii2html_entities )))) ;; ;; Do not upload if only thing that changed is time-stamp. (lb-wdiff nil "end") _rc)) ;; (setq lbg-html-index "~/leninist.biz/en/1984/AP470/index.html") ;; (setq lbg-html-index "~/leninist.biz/en/1976/UFPAA244/index.html") ;;; ;)( (defun lb-ht-generate-book nil ;)(02 b "" (_-dfun-hook "lb-ht-generate-book") ;; (let (lb-pf lb-href lb-str lb-str-tmplt lb-cons lb-item lb-__s lb-pg lb-webpage lb-rc) ;; (when nil ;; FOR LARGE BOOKS, when done incrementally, towards the END. ;; It's too dangerous to leave this set! (setq lbg-ht-update-section-numbers 60) (setq lbg-ht-update-section-numbers '(60 61 62)) (setq lbg-ht-update-section-numbers '(60 . 62)) (setq lbg-ht-update-section-numbers -60) (setq lbg-ht-update-section-numbers nil)) ;; ------------------------------------------------------- ;; Each one of these is an HTML chunk. ;; (setq i (setq lbg-i-from1 1)) ;; (setq i (setq lbg-i-from1 2)) ;; (setq i (setq lbg-i-from1 3)) (loop for i ;; from lb-loop-i-beg to lb-loop-i-end in (if (not lbg-ht-update-section-numbers) (_-something-to-list-of-integers 1 ;; 0=index nil "lb-ht-generate-book") (_-something-to-list-of-integers lbg-ht-update-section-numbers nil "lb-ht-generate-book")) do ;; (if (null (setq lb-href (cdr (assoc i lbg-html-hrefs)))) (error "%s: %s" (concat "?Missing __ALPHA_LVL0__ as " "lbg-i-from1=" (int-to-string lbg-i-from1) " lbg-html-hrefs ?") lbg-text-indextab)) (when (and ;; refresh HTML? ;; fix? are these two the same? (not (string= "__ALPHA_LVL0__" lb-href)) (< lbg-i-from1 (length lbg-sections))) (setq lb-webpage (concat (file-name-directory lbg-html-index) lb-href "" lb-ext-html)) (cond ((or ;; If HTML does not exist. (not (_-timestamp lb-webpage)) ;; If HTML is more recent than all inputs, do not bother! (string< (_-timestamp lb-webpage) ;; NOTE: Changing an .el file will cause refreshing! ;; Most recently modified input (conservative): (lb-mu-most-recently-modified-inputs))) (setq lbg-i-from1 i) (setq lbg-html-href lb-href) (setq lbg-pf-output-html lb-webpage) ;; 2007.01.03 (lb-ht-generate-webpage)) (t ;; Pretend webpage was modified. ;; Prevent file from being removed by lftp-source. (shell-command (concat "touch " lb-webpage)))))) ;; loop lb-rc)) ;; (lb-ht-generate-indexhtml-as-template) (defun lb-ht-generate-indexhtml-as-template nil ;)(02 a. "Do a 'find-file' on first version of index.html" (_-dfun-hook "lb-ht-generate-indexhtml-as-template") ;; (let ( lb-rc) (progn ;; Clear lb-ht-__ (lb-ht-common-__) ;; Create template. ;; (setq lbg-pf-template "~/leninist.biz/en/html/htmm/book") (setq lbg-pf-template (lb-mu-make-webpage lbg-bindtype))) (progn ;; Clear lb-ht-__ (lb-ht-common-__) ;; Find-file. (_-force-new-file (setq lb-rc lbg-html-index)) ;; Insert input into empty buffer. (_-ifcl lbg-pf-template) ;; Delete library card. (progn (goto-char (point-max)) (search-backward "") (delete-region (point) (search-forward-string "
    "))) ;; (lb-ht-gen-add-poundsign-with-id) ;; (if (string-match (concat "/book[.]" lb-ext-htmm "$") arg1pf) (lb-mu-gen-link-AZ-19 lbg-html-index) ;; Write and kill. ;; NO! Deletes __TAGs__ ! (lb-mu-spawn-finale nil nil nil) (bsb) (kill-buffer (current-buffer))) (progn ;; *AFTER* "index.html" is on disk (otherwise #index.html in ;; index.card is linked to /index.html ! ;; Create bibliography beginning with template. (lb-ht-generate-index-card)) lb-rc)) (defun lb-ht-print-and-bind nil ;)(01 b "Create or update 'index.html' and rest of book" (_-dfun-hook "lb-ht-print-and-bind") ;; (let ( lb-rc) ;; First version of index.html. (lb-ht-generate-indexhtml-as-template) ;)(02 a. ;; ;; Create book as HTML beginning with template. (lb-ht-generate-book) ;)(02 b ;; ;; Last version of index.html. (lb-ht-generate-toc) ;)(02 c ;; (lb-ht-del-old-html) ;; lb-rc)) ;; (lb-ht-del-old-html) (defun lb-ht-del-old-html nil "Delete HTML older than index.tab" ;; (let (lb-command lb-path lb-pf lb-list _rc) ;; When all HTML was updated, delete old stuff. ;; Not handled here: a list from 1 to max (equivalent to nil). (when (or (not lbg-ht-update-section-numbers) (and (integerp lbg-ht-update-section-numbers) (= 1 lbg-ht-update-section-numbers))) ;; Get list of old HTML. (with-temp-buffer (shell-command (setq lb-command (concat "cd " (setq lb-path (file-name-directory lbg-text-indextab)) "; " "find " " -follow" " -maxdepth 1" " -type f" " -not -newer " lbg-text-indextab)) t) (goto-char (point-max)) (while (search-backward-regexp "^[^\n]" nil t) (beginning-of-line) (save-excursion (setq lb-pf (_-current-line)) (kill-line) (shell-command (concat "cd " lb-path "; file " lb-pf) t))) (goto-char (point-min)) (while (search-forward-regexp (concat ": " "HTML document text$") nil t) (replace-match "") (beginning-of-line) (if (looking-at "^[.]/") (replace-match "")) (setq lb-list (append lb-list (list (_-current-line)))))) (loop for file in lb-list do ;; LOCAL. "//" is OK. (delete-file (concat lb-path file)) ;; REMOTE. (lb-lftp-dosomething-file file "rm "))) _rc)) ;; (lb-ht-tenderize-tx) (defun lb-ht-tenderize-tx () ;)(01 a. "Maybe create .tx file, check it, and set a few things" (_-dfun-hook "lb-ht-tenderize-tx") ;; (let (lb-str lb-n0 nb-n1 lb-buffer lb-assoc lb-rc) (save-excursion ;; Set global variables. ;; (setq lb-__s (lb-db-get-__-tags lbg-text-indextx)) ;; (progn ;; ... set previously .... (setq lbg-text-indextx ;; Error right away if lftp is running (check for "PID" file). (lb-lftp-dosomething-file (setq lbg-html-index (concat (file-name-sans-extension lbg-text-indextx) ;; 2006.11.17 ;; Just about ONLY use of ".html" so that when ;; a browser is pointed at a book's folder ;; it will find "index.html". "" lb-ext-html ".html"))) ;; (setq lbg-card-index (concat (file-name-directory lbg-text-indextx) lb-file-indexcard "" lb-ext-html)) ;; (setq lbg-text-indextab (concat (file-name-sans-extension lbg-text-indextx) "." lb-ext-tab)) ;; Touched index.tab used in -newer by lb-ht-del-old-html. (when (not lbg-ht-update-section-numbers) (if (setq lb-buffer (find-buffer-visiting lbg-text-indextab)) (kill-buffer lb-buffer)) (shell-command (concat "touch " lbg-text-indextab))) ;; (setq lbg-text-indextxt (concat (file-name-sans-extension lbg-text-indextx) "." lb-ext-txt)) (setq lbg-path-from-lang (lb-get-id-from-path lbg-html-index)) ;; Check for errors in HREFs before checking text files. (setq lbg-html-hrefs (lb-toc-get-html-hrefs lbg-path-from-lang)) (setq lbg-text-indextxlog (concat lbg-text-indextx "." lb-ext-log)) ;; (setq lbg-text-dot-db (concat (file-name-directory lbg-text-indextx) "" lb-file-db)) ;; (setq lbg-bindtype (lb-db-__-get- "BINDTYPE" lbg-text-dot-db t)) ) ;; ------------------------------------------------------- ;; 2006.10.16 (if (setq lb-str (lb-tx-make-or-refresh-indextx)) ;;xxxtender 0 zzz (error "%s: %s" "Got stderr?" lb-str)) (cond ((string= "book" lbg-bindtype) nil) (t (error "%s: %s" "No BINDTYPE" lbg-bindtype))) ;; fix? use _-find-file-hooks-__-globals instead? ;; Set "global" variables. (with-temp-buffer (shell-command (concat ;; 2007.06.25 ;; "egrep -B 3 -A 3 '__WHERE_P' " "head -1000 " lbg-text-indextx) t) (lb-tx-globals)) ;; fix? will this work if page numbers not at bottom of page? ;; Does not matter: ;; If page numbers at top, value of point is to left of page number. ;; If page numbers at bot, value of point is to right of page number. ;; ASSUMPTION: Page number is first or last object on page. ;; ASSUMPTION: For rectos where page number at top, page number ;; comes before running header (even though running header is ;; before page number in original). ;; fix! ;; The cdr should be a cons with upper and lower point boundaries! (setq lbg-pages (lb-tx-parse-pg-points lbg-text-indextxlog)) ;;xxxtender 4 ;; ~/leninist.biz/en/html.hrefs ;; 17 items, first is contents, last is last section (one-based). ;; (setq lbg-sections (lb-ht-toc-parse-tx-sections lbg-text-indextxlog)) ;;xxxtender 5 (if (<= (setq lb-n0 (length lbg-html-hrefs)) (setq lb-n1 (length lbg-sections))) (error "%s: %s" (concat "n=" (int-to-string lb-n0) "= lbg-html-hrefs") (concat "n=" (int-to-string lb-n1) "= lbg-sections"))) ;; (length lbg-sections) => 17 ;; 17 items, first is first section, last is dummy endpoint (zero-based). ;; ;; Do NOT include last section, a dummy section w/ "REQUEST TO READERS". (setq lbg-next-section nil) ) lb-rc)) ;; (defun lb-ht-random-checks (arg1skip) " If ARG1 is non-nil, skip." (_-dfun-hook "lb-ht-random-checks") ;; (let (_list _rc) ;; fix! add! ;; find ~/leninist.biz -follow -type f | xargs -i egrep -Hi 'cymb' '{}' > rpt (if arg1skip (setq _rc (message "%s: %s" _-defun "SKIPPED by non-nil ARG1")) ;; (_-current-time) => "2006-12-06T15:50:33-0800" (when (string-match "[:][135][13579][-]" (_-current-time)) ;; index.tab (loop for pf in (_-something-to-list (lb-list-files-of-type- "index.tab" lb-lang)) do (setq _list (lb-toc-get-html-hrefs (lb-get-id-from-path pf))) ) ;; )) ;; _rc)) ;; (defun lb-ht (arg1path-begin-with-lang &optional arg2-section-numbers0 arg2-section-numbers1) ;)(00. "Conditionally create HTML by checking time-stamp of index.tx or delete index.html for one or more books. Optional ARG1 will check all books for year ARG1. Optional ARG1yr/ARG1abbrev will check for text ARG1abbrev for year ARG1yr. Component HTML files (etc html) may have changed since HTML last created. If those components change, time-stamps of index.txt files must be updated. " ;; ;; $ awk -f ~/leninist.biz/crstrip.awk *.tx > ../index.txt ;; ;; Something to look at in the beginning: (_-dfun-hook "lb-ht") (let (lb-arg1-path lb-str lb-str1 lb-flag lb-list lb-dirs lb-parts lb-pf-tab lb-buffer lb-list-last-numbered-pages lb-rc) ;; (progn (setq lb-ht-__ nil) (setq lbg-i-from1 0) (save-some-buffers)) ;; Why do this? (lb-mu-htmm-to-html (concat "~/" lb-domain "/index.htmm")) (lb-ht-random-checks (or ;; Deadline `06DEC15: ;; MADE MORE STRICT: lb-toc-get-html-hrefs (string< (_-current-time) "2007-01-10T15:05:36-0800") )) ;; (1) nil (2) list (3) start-number. ;; This way, ARG2 to _-something-to-list is always nil. (setq lbg-ht-update-section-numbers (if (not arg2-section-numbers0) nil (if arg2-section-numbers1 (list arg2-section-numbers0 arg2-section-numbers1) arg2-section-numbers0))) ;; _-buffer-substring-from- (if (file-exists-p "~/foo") (delete-file "~/foo")) (progn (setq lb-arg1-path (setq lbg-path-from-lang arg1path-begin-with-lang)) ;; Prepend absolute path? (if (string-match (concat "^" lb-re-lang "/") lb-arg1-path) (setq lb-arg1-path (concat lb-home lb-arg1-path))) ;; ;; lb-something-to-html may supply argument with trailing "/..". (setq lb-arg1-path (command-line-normalize-file-name-then-some lb-arg1-path)) ;; Remove trailing slash. (if (string-match "/$" lb-arg1-path) (setq lb-arg1-path (substring lb-arg1-path 0 (1- (length lb-arg1-path))))) ;; Path must exist. (if (not (file-exists-p lb-arg1-path)) (error "%s: %s" "Path not found" lb-arg1-path)) ;; fix? ;; hardcode here? (setq lb-lang (lb-get-lang-from-path lb-arg1-path)) lb-arg1-path) ;; ------------------------------------------------------- ;; fix! make this a function. ;; 2006.11.29 ;; Fix page numbers in eBook subdirectory names. See top of ".tab"! (progn (setq lb-list-last-numbered-pages (lb-db-load-tabbish (setq lb-pf-tab (concat lb-home lb-lang "/last-numbered-page.tab")) ;; "AFTER" field is #4. 4)) ;; 2007.01.25 - only check stuff if it has a copy directory before 2007. (when (or t ;; 2007.06.20 - that was dumb - copy dir is made after scanning! (progn (setq lb-flag nil) (if (setq lb-dirs (lb-ht-get-copy-directories arg1path-begin-with-lang)) (loop for path in lb-dirs do (setq lb-parts (split-string path "/")) (if (string< (nth (1- (length lb-parts)) lb-parts) "20070101") (setq lb-flag t)))) lb-flag)) (if ;; Is it in tab file? (not (setq lb-list (nth 1 (assoc (setq lb-str ;; => "./1989/HCM243" (progn (string-match lb-re-lang (setq lb-str1 arg1path-begin-with-lang)) (replace-match "." t t lb-str1))) lb-list-last-numbered-pages)))) (error "%s: %s" ;; fix! Jump to tab-file for editing. (concat "Could not assoc key " lb-str " " lb-pf-tab) (prin1-to-string lb-list-last-numbered-pages)) ;; Field 4 may be a copy of field 3, but should be updated value. (if (and (string= (nth 2 lb-list) (setq lb-str (nth 3 lb-list))) (not (string-match "^N/[AC]" (nth 4 lb-list)))) (error "%s: %s" "Same data in fields 3 and 4" (concat lb-str " >-< " lb-pf-tab))) (if (or (string= "" (nth 3 lb-list)) ;; Corrected name. (not (string= "local:Y" (nth 0 lb-list))) (not (string= "srvr:Y" (nth 1 lb-list)))) (error "%s: %s" (concat lb-pf-tab " not right") (prin1-to-string lb-list)))))) (message "%s" (concat arg1path-begin-with-lang " (lb-debug: " (prin1-to-string lb-debug) ").")) ;; Set global variable. (setq lbg-text-indextx (concat lb-arg1-path "/" lb-file-index "." lb-ext-tx)) ;; Tenderize. (lb-ht-tenderize-tx) ;)(01 a. ;; MAIN: (lb-ht-print-and-bind) ;)(01 b ;; Delete index.tx, leave index.txt for uploading. (shell-command (setq lb-command (concat "cd " (file-name-directory lbg-text-indextx) " ; " ;; 2006.11.30 - Only delete after it is X months old. ;; "rm -f " lbg-text-indextx " true " " ; " ))) (setq lb-rc (message "%s: %s" "Done processing (lang/year)" (concat "(" arg1path-begin-with-lang ")"))) ;; fix! (progn (makunbound '_-where-page-numbers) (makunbound '_-footnote-marker-style)) ;; 2006.11.22 (when (setq lb-buffer (find-buffer-visiting lbg-lftp-source)) ;; 2006.12.22 ;; (kill-buffer lb-buffer) (switch-to-buffer lb-buffer) (occur "^[a-z]") (kill-buffer lb-buffer) (switch-to-buffer (get-buffer "*Occur*")) (delete-other-windows) ) lb-rc)) (when nil (while (search-backward-string (concat ";)""(") nil t) (while (< (current-column) 66) (insert " "))) t) ;;; MAIN: SEE: lb-go-speed-racer.el (provide 'lb-ht) ;;; Local Variables: *** ;;; eval:(font-lock-fontify-buffer) *** ;;; End: *** lb-lang.el0100644000175100017510000000051310557513320012521 0ustar cymbalacymbala ;; Leninist.Biz! ;; Emacs-Time-stamp: "2007-01-29 16:52:32" (setq file-stamp "Emacs-File-stamp: \"/home/ysverdlov/leninist.biz/lb-lang.el\"") (defvar lb-lang nil "Current language") (defvar lbg-lang-english "en" "ISO code") (defvar lbg-lang-espanol "es" "ISO code") (defvar lbg-lang-zzzzzzz "zz" "ISO code") (provide 'lb-lang) lb-markup-checker.el0100644000175100017510000000074310540450640014503 0ustar cymbalacymbala ;;; Emacs-Time-stamp: "2006-12-14 23:41:20" (setq el-pf "Emacs-File-stamp: \"/home/ysverdlov/leninist.biz/lb-markup-checker.el\"") ;; fix! ;; No such file: (load-file "~/bin/vm/html-markup-checker.el") (setq ext-html "html") (setq max-owies-per-view 100) (setq homeserver "~/leninist.biz/") (setq homereport "~/leninist.biz/var/rpt/") (setq folder-pruner nil) (setq folder-grafter nil) (setq re-pf-badchars "[ ]") (main "./") lb-misc.el0100644000175100017510000001417710606057034012546 0ustar cymbalacymbala ;; Emacs-Time-stamp: "2007-04-07 20:14:36" (setq file-stamp "Emacs-File-stamp: \"/home/ysverdlov/leninist.biz/lb-misc.el\"") ;; (lb-delete-files "~/leninist.biz/en/1989/HCM243/" "HTML document text") (defun lb-delete-files (arg1path arg2file-filetype) "" ;; (let (lb-filelist lb-filetype _rc) (save-match-data (loop for file in (directory-files arg1path t) do (if (and ;; OPTIONAL: (not (string-match "[.]jp[e]?g$" file)) ;; MANDATORY: (string= arg2file-filetype (_-filetype file))) (setq lb-filelist (append lb-filelist (list file))))) (loop for file in lb-filelist do (delete-file file))) _rc)) (defun tab-renumber-col- (&optional arg1col) " Start with point on last line with correct number" ;; ;; hrefs 16 4-I . z ;; hrefs 17 4-1 . z ;; hrefs 17 4-2 . z ;; hrefs 18 4-3 . z (interactive) ;; fix! ;; Leave trailing hypen alone if "[introduction.]" in description. ;; fix! Re-use code that checks for .ABC at end of filename. (let (_re-col _n _line _col _pt-dash-tab _trailing-pounds _flag-roman-numerals-after-trailing-dash _col-roman-numerals-after-trailing-dash (_cnt-roman-numerals-after-trailing-dash -1) _rc) (save-excursion ;; 2007.03.28 (goto-char (point-min)) (tx-move-forward-past-pound-comment-lines) (beginning-of-line) (if (not arg1col) (setq arg1col (string-to-int (read-input "Col? ")))) (setq _re-col "^[^\t]+") (loop for i from (1+ (- arg1col (1- arg1col))) to arg1col do (setq _re-col (concat _re-col "\t" "\\([^\t]*\\)"))) (beginning-of-line) (while (and (search-forward-regexp _re-col nil t) (setq _msnp1 (match-string-no-properties 1)) ;; Ignore "#" at end of string in target column. (save-match-data (setq _trailing-pounds (if (string-match ;; 2006.12.04 - Keep letter-for-sorting. ;; "[#]+$" "[a-z]?[#]+$" _msnp1) (match-string-no-properties 0 _msnp1) "")) t) (progn (replace-match (concat (format "%02d" (setq _n (+ (if (string= "" _trailing-pounds) 1 0) (if (not _n) (setq _n (1- (string-to-int _msnp1)) ) _n) ))) _trailing-pounds) t t nil 1) t) ) ;; and ;; fix! ;; "ABC-" has to be done manually; after that, ;; skip if only one instance; it means "introduction": ;;; hrefs 40 CAK- . z ;;; hrefs 41 CAK-I . z ;; fix! ;; Does not detect change of root name when two blocks are ;; next to one another; e.g., below no "QIRH-I" ;;; hrefs 18 EF- . [ON THE ``ECONOMIC FACTOR'' ... ;;; hrefs 18 EF- . [ON THE ``ECONOMIC FACTOR'' ... ;;; hrefs 19 QIRH- . ON THE QUESTION OF THE INDIVIDUAL'S ... ;;; hrefs 19 QIRH- . ON THE QUESTION OF THE INDIVIDUAL'S ... (if ;; Try to append Roman numerals after a trailing dash. (or ;; 2006.10.04 - Allow "ABC-" to mean introduction. (string-match "[[]introduction[.]?[]]" (setq _line (_-current-line))) (string-match "INTRODUCTION$" (setq _line (_-current-line))) (not (string-match "[a-z0-9A-Z][-][\t]" _line) )) ;; RESET. (progn (setq _col-roman-numerals-after-trailing-dash (setq _flag-roman-numerals-after-trailing-dash nil)) (setq _cnt-roman-numerals-after-trailing-dash -1)) ;; Where was that? (setq _pt-dash-tab (+ (save-excursion (beginning-of-line) (point)) (match-end 0))) ;; Was question asked for this group before? (if (not _flag-roman-numerals-after-trailing-dash) (while (not (setq _flag-roman-numerals-after-trailing-dash (read-input (concat (substring _line 0 (match-end 0)) "ROMAN NUMERALS? " )))))) ;; Count tabs to left. (if (and (setq _col (1- (length (split-string (substring _line 0 (match-end 0)) "[\t]")))) _col-roman-numerals-after-trailing-dash (/= _col _col-roman-numerals-after-trailing-dash)) (error "%s: %s" "oh" "no") (setq _col-roman-numerals-after-trailing-dash _col)) ;; Add Roman numeral. (when (string-match "[^nN]*[yY]" _flag-roman-numerals-after-trailing-dash) (setq _cnt-roman-numerals-after-trailing-dash (1+ _cnt-roman-numerals-after-trailing-dash)) (goto-char (1- _pt-dash-tab)) (insert (nth _cnt-roman-numerals-after-trailing-dash lb-list-roman-numerals))) ) ;; if has dash-tab ) ;; while ) ;; save-excursion (occur "[.]...[\t]") _rc)) ;; (defun lb-wdiff (arg1pfnew arg2action) "ARG1 is disk-file in the process of creation. If nil, defaults to lbg-wdiff-pf. ARG2 is 'beg' (before disk-write) or 'end' (after disk-write)" ;; (let (_list _pf (_ext ".wdiffin") _rc) (if arg1pfnew (setq lbg-wdiff-pf arg1pfnew) (setq arg1pfnew lbg-wdiff-pf)) (setq _pf (concat arg1pfnew _ext)) (cond ((string= "beg" arg2action) (if (file-exists-p _pf) (delete-file _pf)) (if (file-exists-p arg1pfnew) (copy-file arg1pfnew _pf))) ((string= "end" arg2action) (if (not (file-exists-p _pf)) (setq _list (list "a" "b" "c")) ;; (with-temp-buffer ;; wdiff ignores changes to whitespace. (shell-command (concat "wdiff " _pf " " arg1pfnew) t) (goto-char (point-min)) (while (search-forward-string "[-" nil t) (setq _list (append _list (list (_-current-line)))) (search-forward-string "-]")) (goto-char (point-min)) (while (search-forward-string "{+" nil t) (setq _list (append _list (list (_-current-line)))) (search-forward-string "+}")) )) ;; ;; Check. (if (not _list) (error "%s: %s" "Why no differences, not even time-stamps?" _pf)) ;; (if (or (> (length _list) 1) (not (string-match "Emacs-Time-stamp:" (car _list)))) (lb-lftp-dosomething-file arg1pfnew)) ;; (if (file-exists-p _pf) (delete-file _pf))) ;; --------------------------------- (t (error "%s: %s" "Programming" "error"))) _rc)) (provide 'lb-misc) ;;; ; lb-model.el0100644000175100017510000001510710544045755012715 0ustar cymbalacymbala ;; Variables. ;; Emacs-Time-stamp: "2006-12-25 14:08:45" (setq file-stamp "Emacs-File-stamp: \"/home/ysverdlov/leninist.biz/lb-model.el\"") (defun lb-make-page-objs (arg1pf) "" ;; (lb-make-page-objs "~/leninist.biz/en/1976/UFPAA244/20050713/.pageobjs.tx") (let (lb-rc lb-rc-append lb-pt lb-page lb-list-pages lb-list-while lb-car lb-str lb-pt-beg lb-pt-end) (setq lb-rc (list (cons "stamp" (_-timestamp arg1pf)))) (with-temp-buffer ;; BOOK (progn (_-ifcl arg1pf) (goto-char (point-min)) ;; fix! move this check into separate function. (if (search-forward-regexp "[ \t]$" nil t) (error "%s: %s" "Whitespace at end of line" (int-to-string (point)))) (setq lb-list-pages (lb-tx-count-pages))) ;; fix! (when t ;; Check number of pages if not in "suspense". (goto-char (point-min)) (save-excursion (setq lb-pt (search-forward-regexp "\n\n[[]?1[]]?\n\n"))) (when (not (search-forward "|SUSPENSE|" lb-pt t)) (if (not (= (car lb-list-pages) (_-string-to-int (lb-get-titlpgs-from-path arg1pf)))) (error "%s: %s" "Missing pages" arg1pf)))) (progn ;; Set return code. (setq lb-list-while (cdr lb-list-pages)) ;; 1st element is page count. (goto-char (point-min)) ;; fix! Assumes page numbers at bottom of page. (while lb-list-while (setq lb-page (car lb-list-while)) (setq lb-pt-beg (point)) (progn (search-forward (concat "\n\n" lb-page "\n\n") nil t) (goto-char (match-beginning 0)) (setq lb-pt-end (search-forward-regexp "\n+"))) (setq lb-str (buffer-substring-no-properties lb-pt-beg lb-pt-end)) ;; Parse objects for this page. (with-temp-buffer ;; PAGE (insert lb-str) (setq lb-rc-append (list (cons (_-string-to-int lb-page) ;; fix? ;; works? ^J removed from end of ;; items, 2005.07.19 (_-something-to-list)))) (if (not (string-match "[\|]" (nth 1 (car lb-rc-append)))) (error "%s: %s" "Missing '|'" lb-page)) (setq lb-rc (append lb-rc lb-rc-append))) ;; END while (progn (goto-char lb-pt-end) ;; Before two newlines before page number. ;; Just after page number. (search-forward-regexp "[0-9][^\n]*")) (setq lb-list-while (cdr lb-list-while)))) lb-rc))) (defun lb-get-page-objs-OTHER-WHATTHE (&optional arg1) "" ;; (interactive "p") (let ( lb-instance lb-pf lb-rc (lb-bfn (bfn)) ) (when (string-match lb-re-path-year+book-instance lb-bfn) (setq lb-instance (match-string-no-properties 0 lb-bfn)) (setq lb-pf (concat lb-home lb-instance "/" lb-file-page-objs)) (if (not (file-exists-p lb-pf)) (error "%s: %s" "File not found" lb-pf) (if (not (setq lb-rc (assoc lb-instance lb-page-objs))) (setq lb-page-objs (append lb-page-objs (lb-make-page-objs lb-pf))))) (if lb-rc lb-rc (assoc lb-instance lb-page-objs))))) (defun lb-get-page-objs (&optional arg1p) "" ;; (assoc "stamp" (assoc "en/1976/UFPAA244/20050713" lb-page-objs)) ;; (assoc 5 (assoc "en/1976/UFPAA244/20050713" lb-page-objs)) ;; From a buffer visiting a file: ;; (assoc 35 (lb-get-page-objs)) ;; (cdr (assoc 35 (lb-get-page-objs))) => ("|FULL|" "p P P P _-_-_ F F F") (interactive "p") (let ((lb-bfn (bfn)) lb-instance lb-pf lb-rc lb-stamp) (when (string-match lb-re-path-year+book-instance lb-bfn) (setq lb-instance (match-string-no-properties 0 lb-bfn)) (setq lb-pf (concat lb-home lb-instance "/" lb-file-page-objs)) (if (not (file-exists-p lb-pf)) (error "%s: %s" "File not found" lb-pf)) ;; File on disk is newer. (if (and (setq lb-stamp (assoc "stamp" (assoc lb-instance lb-page-objs))) (string-lessp (setq lb-stamp (cdr lb-stamp)) (_-timestamp lb-pf))) (setq lb-page-objs (delete (assoc lb-instance lb-page-objs) lb-page-objs))) ;; Does not exist in array. (if (not (setq lb-rc (assoc lb-instance lb-page-objs))) (setq lb-page-objs (append lb-page-objs (list (cons lb-instance ;; (list (lb-make-page-objs lb-pf)))))) (assoc lb-instance lb-page-objs)))) (defun lb-get-lang-from-path (&optional arg1pf) "" ;; (lb-get-lang-from-path "~/leninist.biz/en/titl.htmm") ;; (lb-get-lang-from-path "es/1974/ATA470/") (let (my) (if (not arg1pf) (setq arg1pf (buffer-file-name))) (if (not (or (string-match (concat lb-domain "/" lb-re-lang "/") arg1pf) (string-match (concat lb-re-lang "/") arg1pf) )) nil (match-string-no-properties 1 arg1pf)))) ;; (lb-get-pgs-from-titlpgs) (defun lb-get-pgs-from-titlpgs (&optional arg1titlpgs) "Number of pages in book's content (not physical pages)" ;; (let ( lb-rc) (if (null arg1titlpgs) (if (not (setq arg1titlpgs (lb-get-titlpgs-from-path))) (error "%s: %s" "No arg1titlpgs" "lb-get-titlpgs-from-path"))) (string-match "[A-Z]\\([0-9]+\\)" arg1titlpgs) (setq lb-rc (match-string-no-properties 1 arg1titlpgs)) lb-rc)) ;; (lb-get-titlpgs-from-path "ist.biz/en/1976/UFPAA244/20050713/.pageobjs.tx") ;; USE lb-text-index: (with-temp-buffer (lb-get-titlpgs-from-path)) (defun lb-get-titlpgs-from-path (&optional arg1pf) "Return subdirectory name containing title abbreviation and total pages" (let (my-pf (lb-re (concat (if nil lb-domain "") "/" lb-re-path-year+book)) lb-rc) (if (or (if arg1pf (string-match lb-re (setq my-pf arg1pf))) (if (bfn) (string-match lb-re (setq my-pf (bfn)))) (string-match lb-re (setq my-pf lbg-text-indextx))) (setq lb-rc (match-string-no-properties 3 my-pf))) lb-rc)) ;; (lb-count- "titles" "es") ;; (lb-count- "ebooks" "es") ;; (lb-count- "ebooks" "en") (defun lb-count- (arg1type &optional arg2lang) "" (_-dfun-hook "lb-count-") ;; TO-DO: default is count of titles; add count of ASCII sources (s.b. = others). (let (my (my-n 0)) (if (not arg2lang) (setq arg2lang lb-lang)) (save-match-data (with-temp-buffer (_-ifcl (if (string= "titles" arg1type) (lb-get-diskfilename ".index.list" arg2lang t) (if (string= "ebooks" arg1type) (lb-get-diskfilename ".index.html.list" arg2lang t) (error "%s: %s" "Not a choice" arg1type)))) (goto-char (point-min)) (save-excursion (while (search-forward-regexp "^[.]/" nil t) (replace-match (concat arg2lang "/")))) (save-excursion (while (search-forward-regexp (concat lb-re-path-year+book (cond ((string= "titles" arg1type) lb-file-dot-index) ((string= "ebooks" arg1type) (concat "index" ;; 2006.11.24 "" lb-ext-html ".html" )) ) "$") nil t) (setq my-n (1+ my-n)))) my-n)))) (provide 'lb-model) ;;; ; lb-mu.el0100644000175100017510000021053410653653265012241 0ustar cymbalacymbala ;; Markup. ;; Emacs-Time-stamp: "2007-07-31 08:35:17" (setq file-stamp "Emacs-File-stamp: \"/home/ysverdlov/leninist.biz/lb-mu.el\"") ;; (defun lb-mu-while-insert-tabindex nil "" ;; (let (lb-flag lb-pt-resume lb-cnt-scroll2next lb-cnt-next-arrow lb-cnt-prev-arrow (lb-tabindex 0) _rc) ;; 1. visit webpage; 2. press [TAB]; 3. press [ENTER] to start scrolling. (goto-char (point-min)) (if (search-forward-string "tabindex=" nil t) (error "%s: %s" "Not expecting" (match-string-no-properties 0))) ;; (setq lb-cnt-scroll2next (setq lb-cnt-next-arrow (setq lb-cnt-prev-arrow 0))) (while (or (and (= 0 lb-cnt-next-arrow) (search-forward-regexp "class=.\\(scroll2next\\)." nil t)) ;; Keep going. ;; fix! - could break if name in CSS changed. ;; fix! - assuming all scroll2next's are *ABOVE* navigation table. (and (= 0 lb-cnt-prev-arrow) (search-forward-regexp "class=.\\(next-arrow\\)." nil t)) ;; Now look back. (search-backward-regexp "class=.\\(prev-arrow\\)." nil t) ) (progn (if (string= "a" (_-sgml-what-element)) (setq lb-flag (match-beginning 0))) (setq lb-type (match-string-no-properties 1)) (setq lb-pt-resume (cond ((string= "scroll2next" lb-type) (setq lb-cnt-scroll2next (1+ lb-cnt-scroll2next)) ;; FORWARD. (match-end 0)) ((string= "next-arrow" lb-type) (setq lb-cnt-next-arrow (1+ lb-cnt-next-arrow)) ;; FORWARD. (match-end 0)) ((string= "prev-arrow" lb-type) (setq lb-cnt-prev-arrow (1+ lb-cnt-prev-arrow)) ;; BACKWARD. (match-beginning 0))))) ;; next- and prev-arrow are in TD in same TR as A. (when (or (string= "next-arrow" lb-type) (string= "prev-arrow" lb-type)) (setq lb-flag nil) (save-excursion ;; (when (string= "next-arrow" lb-type) ;; Go back two TDs. (search-backward-string "")) t) (if (search-forward-regexp "href=\"[^\"]+\"" (save-excursion (search-forward-string ">")) t) (setq lb-flag (match-beginning 0)))))) ;; (when lb-flag (goto-char lb-flag) (insert "" "tabindex=\"" (int-to-string (setq lb-tabindex (1+ lb-tabindex))) "\" ")) (goto-char lb-pt-resume)) ;; Everything else. (setq lb-tabindex 0) (goto-char (point-min)) (while (search-forward-regexp " at end of page but not end of paragraph. SEE ALSO: lb-mu-insert-pound-anchors-at-beg-of-blocks SEE ALSO: Function without trailing '-'" ;; (let (lb-str-href lb-pt lb-re-a-class-id lb-str-a-scroll2next _bound _while-bound _cdata-bound _rc) (setq lb-str-a-scroll2next "     found, skip to

    if next open tag? (goto-char (point-max)) (while (and (sbr (concat "<" arg1tag "[^a-z]") nil t) (progn (goto-char (setq _while-bound (match-beginning 0))) (sfs ">") (setq lb-str-href nil) t)) ;; Move to beginning of CDATA. (while (or (_-move-forward-whitespace) (and (looking-at "")) (and (looking-at "")) (and (looking-at "__") (goto-char (cdr (_-where-double-newlines)))))) ;; Try to insert anchor pointing to beginning of next block. (setq _cdata-bound (point)) ;;If

    before

    , may find

    before

    !!!!! (if (sfr (concat "<" arg1tag "[^a-z]") (setq _bound (save-excursion (sfs (concat "") nil t) (match-end 0))) t) (goto-char (match-beginning 0)) (goto-char _bound) (_-move-forward-whitespace)) ;; Maybe looking at

    before

    due to blockquote inside P. ;; Maybe after

    and whitespace. ;; Ignore close tags (blockquotes), comments and stuff like PG#'s. (while (or (_-move-forward-whitespace) (and (looking-at "")) (and (looking-at "")) (and (looking-at "")) (and (looking-at " ;; (if lb-significant-words (insert "\n\n" lb-significant-words " \n\n"))) ;; (goto-char lb-bound-upper)) ;; Process bread crumbs left behind from above. ;; Each block has one LARGE bread crumb. (goto-char (point-min)) (setq lb-pt-%%data%% (search-forward-string "%%data%%")) ;; (while (search-forward-string "" nil t) (replace-match "") (progn (setq lb-significant-words (_-current-line t t)) (delete-region (save-excursion (beginning-of-line) (point)) (save-excursion (end-of-line) (point))) (setq lb-significant-words (split-string lb-significant-words "[.]")) (setq lb-candidate nil) (setq lb-inserted-flag nil) (setq lb-list-dupes-curr-block nil)) ;; (loop for i from 1 to (length lb-significant-words) do (setq lb-candidate (concat lb-candidate (setq lb-word (nth (1- i) lb-significant-words)) ".")) ;; (when (and (>= i lb-min-number-of-significant-words) ;; 2006.12.07 (not (member lb-word lb-list-skip-candidate-words)) (if (not (member lb-candidate lb-global-list-dupes)) t (setq lb-list-dupes-curr-block (append lb-list-dupes-curr-block (list lb-candidate))) nil)) (insert (progn (setq lb-inserted-flag t) "") ;; 2007.04.11 ;; "    " "\">" "\n"))) ;; loop ;; (if (not lb-inserted-flag) (insert ;; 2007.04.11 ;; "" "\n"))) lb-rc)) ;; fix! ;; Must use "." in place of 8-bit ASCII character in regexp! ;; (lb-mu-get-element ">T.tulosTítulosTitlesTítulosTitles") (point)))) lb-rc)) ;; (lb-mu-template-get- "html") => "~/leninist.biz/en/HTML" ;; (lb-mu-template-get- "t") => "~/leninist.biz/en/T" ;; (lb-mu-template-get- "text") => "~/leninist.biz/es/texto" ;; (lb-mu-template-get- "text" "en") => "~/leninist.biz/en/text" (defun lb-mu-template-get- (arg1type &optional arg2lang) " Optional ARG2 is language" (let ( lb-rc) (if (not arg2lang) (setq arg2lang lb-lang)) (string-match-substitute "[.]htmm$" ;; 2006.11.17 ;; ".html" "" (lb-get-diskfilename arg1type arg2lang t)))) (defun lb-sgml-scrub-local-variables nil "" (_-dfun-hook "lb-sgml-scrub-local-variables") ;; (let (my) (save-excursion (goto-char (point-min)) (while (search-forward (concat "\n" "\n" "\n") nil t) (replace-match ""))))) (defun lb-sgml-scrub (&optional arg1letter arg2lang) "Scrub SGML ()" (_-dfun-hook "lb-sgml-scrub") ;; (if (not arg2lang) (setq arg2lang lb-lang)) (save-match-data (let (_-pf lb-str lb-pt lb-msnp1 lb-msnp2) ;; fix? context? (save-excursion (goto-char (point-min)) (while (search-forward-regexp "Transl:[ \t]*Translated" nil t) (replace-match "
    Translated"))) (save-excursion (goto-char (point-min)) (if (member arg1letter (split-string lb-az "")) (when (search-forward-regexp (concat "" (upcase arg1letter) "") nil t) (replace-match (concat (match-string 1) "-backcolor") t t nil 1) (search-backward "<") (search-forward-regexp (concat ">\\(" (upcase arg1letter) "\\)")) (replace-match (concat " " (match-string 1) " ") t t nil 1)))) ;; How many books online? 8734 is infinity. (save-excursion (goto-char (point-min)) (when (search-forward-regexp "∞" nil t) (replace-match (_-comma-ify-int (lb-count- "titles" arg2lang))) (if (search-forward-regexp "∞" nil t) (replace-match (_-comma-ify-int (lb-count- "ebooks" arg2lang))) (error "%s: %s" "Expecting two" "∞")))) (lb-sgml-scrub-local-variables) (_-compress-multiple-newlines)))) (defun lb-sgml-change-youarehere (arg1re arg2type &optional arg3lang) "Delete element with ARG1 and replace with one from ARG2's template" (_-dfun-hook "lb-sgml-change-youarehere") ;; fix! Should be able to auto-detect arg2type somehow. ;; (let ( lb-rc) (if (not arg3lang) (setq arg3lang lb-lang)) (goto-char (car (setq lb-cons (lb-mu-get-element-bounds arg1re)))) (delete-region (car lb-cons) (cdr lb-cons)) (insert (lb-mu-get-element arg1re (lb-mu-template-get- arg2type arg3lang))) lb-rc)) ;; (lb-mu-set-n-return-buffer-x arg1type i) ;; (lb-mu-set-n-return-buffer-x "t" "a" "en") ;; (set-buffer (lb-mu-set-n-return-buffer-x arg1type i)) (defun lb-mu-set-n-return-buffer-x (arg1type &optional arg2i arg3lang) "Return a buffer with beginning of web page. For titles, authors and years, ARG1 is 'T', 'A' and '19'. For titles, authors and years, ARG2 is 'A' or 'B' or 'C' ... or 'z' [YEARS?!?!?!]. Optional ARG3 is language. ;; fix! For 'text' & 'html' & 'ps' & 'pdf' edits .html created from .htmm because ARG2 is nil" (_-dfun-hook "lb-mu-set-n-return-buffer-x") ;; (let (lb-pf lb-rc) (if (not arg3lang) (setq arg3lang lb-lang)) ;; fix! ;; use lb-home instead of (concat "~/" lb-domain) ALL OVER .elS! (setq lb-pf (if (member (upcase arg1type) (split-string "TAY" "")) ;; If arg1type is 't': ".../ta.html through tz.html (concat lb-home arg3lang "/" arg1type arg2i "" lb-ext-html) ;; When arg1type is "titl", "auth", ... use canonical filename. (string-match-substitute ;; 2006.11.17 ;; "m$" ".htmm$" ;; ;; "l" (if arg2i arg2i "") (lb-get-diskfilename arg1type nil t)))) (progn (if ;; delete file? (or (member arg1type (split-string "TAY" "")) (assoc arg1type lb-assoc-htmm)) (if (file-exists-p lb-pf) (delete-file lb-pf))) (find-file-literally lb-pf) (if ;; insert template? (or (member arg1type (split-string "TAY" "")) (assoc arg1type lb-assoc-htmm)) (_-ifcl (lb-mu-template-get- arg1type)))) (xml-mode) ;; Delete href= that points to this file. (goto-char (point-min)) (if (search-forward-regexp (concat "[ \t\n]+href=\"" arg1type arg2i "" lb-ext-html "\"") nil t) (replace-match "")) ;; why? ;; Change "YOU ARE HERE" (cond ((string= arg1type "t") (lb-sgml-change-youarehere ;; fix? do not hardcode. (if (string= "en" arg3lang) ">TitlesT.tulosAuthorsAutorsYearsA.os (4226 . "~/leninist.biz/en/./1974/ETM165/.db") ;; (lb-search-sgml-comment t) => (3862 . "~/leninist.biz/en/./1966/ES187/.db") (save-match-data (let (lb-pf lb-pt lb-rc (lb-re-start (concat "") (setq lb-pt (point))) (cons lb-pt lb-pf)))))) (defun lb-mu-table-by-i-wrap-w-li (arg1i arg2table) "Return subset from table ARG2 if row starts with ARG1. ARG2 is something like ~/leninist.biz/en/.TITLE . Wrap results with LI tags. Preceed each observation with SGML comment containing source information NOTE: Does not include subtitle(s)...
  • Yellow Devil:, The
    • " ;; (lb-mu-table-by-i-wrap-w-li "b" (buffer-string)) (let (lb-pf lb-msnp0 lb-1st-char lb-rc) (save-match-data (with-temp-buffer (if (file-exists-p arg2table) (_-ifcl arg2table) (insert arg2table)) (goto-char (point-min)) ;; Delete titles that do not start with arg1i. (while (< (point) (point-max)) (if (and (not (string= (downcase arg1i) (downcase ;; In "es" titulo may start with ¿ ¿ (if (string= "?" (setq lb-1st-char (buffer-substring-no-properties (point) (1+ (point))))) (buffer-substring-no-properties (1+ (point)) (+ (point) 2)) lb-1st-char)))) ) (delete-region (point) (save-excursion (end-of-line) (1+ (point)))) (end-of-line) (forward-char 1))) ;; Wrap remaining titles, if any (starting with arg1i) with LI tag. (when (> (point-max) 1) (goto-char (point-min)) (while (< (point) (point-max)) (insert "\n") (save-excursion (insert "
  • ") (search-forward-regexp "[\t]\\([^\t\n]+\\)$") (setq lb-msnp0 (match-string-no-properties 0)) (replace-match "
    • ")) (insert "\n\n") (end-of-line) (forward-char 1))) (insert "\n\n") (setq lb-rc (buffer-string)))))) ;; (defun lb-mu-href-delete-pound-dead-ends nil "" ;; (let (_pound-list _id-list _name-list _keep-list _str _re _rc) (goto-char (point-min)) (while (search-forward-regexp "href=\"#\\([^\"]+\\)\"" nil t) (if (not (_-sgml-comment-p)) (setq _pound-list (append _pound-list (list (match-string-no-properties 1)))))) ;; fix! isn't there a function that gets these? (goto-char (point-min)) (while (search-forward-regexp (concat "\\(name\\|id\\)" "=\"\\([^\"]+\\)\"") nil t) (setq _str (match-string-no-properties 1)) (if (not (_-sgml-comment-p)) (cond ((string= "name" _str) (setq _name-list (append _name-list (list (match-string-no-properties 2))))) ((string= "id" _str) (setq _id-list (append _id-list (list (match-string-no-properties 2)))))))) ;; Checks (loop for i in _id-list do (if (member i _name-list) (error "%s: %s" "In both lists" i))) (loop for i in _name-list do (if (member i _id-list) (error "%s: %s" "In both lists" i))) (loop for i in _pound-list do (if (or (member i _name-list) (member i _id-list)) (setq _keep-list (append _keep-list (list i))))) (loop for i in _pound-list do (if (not (member i _keep-list)) (while (or (search-backward-string (setq _re (concat "href=\"#" i "\"")) nil t) (search-forward-string _re nil t)) ;; Not removing whitespace to left! ;; (replace-match "") ;; Remove whole paragraph, to get "title=" too. (_-para-delete)))) _rc)) ;; (lb-mu-href-replace-uptree) (defun lb-mu-href-replace-uptree nil "If HREF= points to non-existing file, try to find one higher up in the tree. For example, when /en/html/htmm/book.htmm is converted to .html must change titl.html to ../../titl.html ! No BASE element support (uses buffer-file-name for base)" (_-dfun-hook "lb-mu-href-replace-uptree") ;; (let (lb-pf lb-rc lb-str lb-str0 lb-str1 lb-list-midlings lb-href lb-mbeg lb-mend lb-test-link lb-missing-link lb-classvalue (lb-basedir (file-name-directory (bfn)))) (loop for i in '(".." "../.." "../../..") do (loop for j in (list "/" ;; Not logical: ;; (concat "/" lb-lang "/") ) do (setq lb-list-midlings (append lb-list-midlings (list (concat i j)))))) ;; Removed "edinplace-" (edit-in-place) from function names. ;; (unless (featurep 'lb-batch) (save-some-buffers)) (goto-char (point-min)) (while (and (search-forward-regexp (concat "href=\"" "\\([^#\"]+\\)") nil t) (progn (setq lb-mbeg (match-beginning 1)) (setq lb-mend (match-end 1)) (setq lb-href (match-string 1)) (setq lb-classvalue (_-sgml-attr-grab "class")) t)) (when (and (not (file-exists-p (concat lb-basedir lb-href))) (not (string-match "^\\(mailto\\|http\\):" lb-href)) ;; 2007.07.31 (not (_-sgml-comment-p)) ;; 2006.12.13 - htm/suggestion-box.en (not (looking-at "\"mailto")) ;; 2006.12.15 - ">" and ">>" and ">>>" files yet 2be created. (not (and lb-classvalue (or (string= "toc_page_number" lb-classvalue) (string= "sidebar-nav-arrow" lb-classvalue) (string= "footbar-nav-alpha" lb-classvalue)))) ) ;; Not found, and not a special case, so, keep going. (progn (setq lb-rc nil) (loop for lb-test-link in lb-list-midlings do (if (file-exists-p (setq lb-pf (concat lb-basedir lb-test-link lb-href))) (if (not (member lb-pf lb-rc)) (setq lb-rc (append lb-rc (list ;; MUST MAINTAIN SAME LENGTH (no collapse "..") ;; (command-line-normalize-file-name-then-some lb-pf))))))) (if (not lb-rc) (if (and (not (member lb-href lb-list-href-ok-not-file-exist)) (not (string-match "^__" lb-href))) (error "%s: %s" "Unable to resolve HREF (maybe touch it?)" (concat lb-href "\n" (_-buffer-substring-from-)) )) ;; Now lb-rc is a list, with one or more pathfiles... ;; ("~/leninist.biz/en/html/htmm/../../index.html" ;; "~/leninist.biz/en/html/htmm/../../../index.html") (if (and (> (length lb-rc) 1) (or ;; RETURN TRUE (error) if more than 2 in list. (not (= 2 (length lb-rc))) ;; If two items in list, maybe return one. ;; Get two items from list into variables. (and (setq lb-str0 (nth 0 lb-rc)) (setq lb-str (nth 1 lb-rc)) nil) ;; Swap if lb-str0 is not longer. (and (> (length lb-str) (length lb-str0)) (_-exchange-symbol-values 'lb-str 'lb-str0) nil) ;; RETURN NIL: ;; fix? (when nil ;; lb-str0 is longer. ;; If it has "/en/" will replacing that with "/" cause ;; both string to be equal? ;; If not, DONE (return TRUE). (or (not (string-match (concat "/" lb-lang "/") lb-str0)) (not (string= lb-str (replace-match "/" nil nil lb-str0)))) nil) )) (error "%s: %s" "More than one HREF found" (prin1-to-string lb-rc)) (goto-char lb-mbeg) (delete-region lb-mbeg lb-mend) (insert (substring (car lb-rc) (length lb-basedir))))))) )) ;; (defun lb-naletov-gen-html-includes (arg1pf) "" ;; (let (lb-str lb-pf) (goto-char (point-min)) (while (search-forward-regexp (concat "##" "\\([^ \t\n]+\\)" "##") nil t) (setq lb-pf (concat (file-name-directory arg1pf) (match-string 1))) (replace-match (with-temp-buffer (_-ifcl lb-pf) (lb-naletov-gen-html-includes lb-pf) ;; RECURSIVE. (buffer-string)))))) ;; (defun lb-mu-recursive-replace (arg1in &optional arg2implied-dot) " If ARG2 is non-nil, only process placeholders of type '##foo##' where 'foo' does not start with '.'" ;; (let ( lb-beg0 lb-beg01 lb-beg1 lb-end0 lb-end1 lb-fly-beg lb-fly-end lb-msnp1 lb-pf lb-pf-chunk lb-pf-chunk-dir lb-pf-chunk-dotdot lb-str _rc) ;; 2006.12.28 - lb-mu-recursive-replace _> lb-mu-recursive-replace-inplace ;; 2006.12.28 - guts moved here. (goto-char (point-max)) (while (and (search-backward-regexp lb-re-sgml-include-chunk nil t) (setq lb-beg0 (match-beginning 0)) (setq lb-end0 (match-end 0)) (setq lb-msnp1 (match-string-no-properties 1))) (when (not (_-sgml-comment-p)) ;; fixed! ;; In en/html/htmm/book.htmm changed: ;; ##../../../htm/ ;; to: ;; ##../htm/ ;; and this stopped working... SHOULD prepend "../" in effort to find it. ;; (setq arg1in "~/leninist.biz/en/html/htmm/book.htmm") ;; (setq lb-msnp1 "../htm/sidebar-ALL.en") (setq lb-pf-chunk-dotdot "") (while (and (not (file-exists-p (setq lb-pf-chunk (concat (unless (or (string= "/" (substring lb-msnp1 0 1)) (string= "~" (substring lb-msnp1 0 1))) (file-name-directory arg1in)) lb-pf-chunk-dotdot lb-msnp1)))) ;; Too many ../ will cause first member to be "..". (not (string= ".." (nth 0 (split-string (expand-file-name lb-pf-chunk) "/"))))) (setq lb-pf-chunk-dotdot (concat "../" lb-pf-chunk-dotdot))) ;; Cannot find it. (if (not (file-exists-p lb-pf-chunk)) (error "%s: %s" "File not found" lb-pf-chunk)) (setq lb-str (with-temp-buffer (_-ifcl lb-pf-chunk) ;; ON-THE-FLY. ;; Recursion inside of temporary buffer containing chunk. (while (lb-mu-recursive-replace lb-pf-chunk)) ;; Delete certain chunks. ;; E.g., htm/_multilingual-ledger.htmm ;; ;;2 lines matching "lb-mu" in buffer _multilingual-ledger.htmm. ;; 58: ;; 121: (progn (goto-char (point-max)) (when (search-backward-regexp (string-match-substitute "AAAAAAAA" "END" lb-re-lb-mu-recursive-replace) nil t) (setq lb-fly-end (match-beginning 0)) (if (not (search-backward-regexp (string-match-substitute "AAAAAAAA" "BEG" lb-re-lb-mu-recursive-replace) nil t)) (error "%s: %s" "ERROR" lb-re-lb-mu-recursive-replace) (setq lb-fly-beg (match-end 0)) (delete-region lb-fly-end (point-max)) (delete-region (point-min) lb-fly-beg)))) ;; Done with on-the-fly. (buffer-string))) ;; Substitution. (goto-char lb-beg0) (delete-region lb-beg0 lb-end0) (insert lb-str))) ;; Recurse? (goto-char (point-max)) (if (and (search-backward-regexp lb-re-sgml-include-chunk nil t) (not (_-sgml-comment-p))) ;; Recurse! (setq _rc t) ;; Delete "mode:fundamental" (otherwise some hooks may not work). (lb-sgml-scrub-local-variables)) _rc)) (defun lb-mu-recursive-replace-inplace (arg1in arg2out) "Inserts file ARG1 into temporary buffer. Substitutes strings matching lb-re-sgml-include-chunk in markup with contents of file named inbetween '##FILE##'. FYI: lb-re-sgml-include-chunk => ##\\([^#]+\\)## Writes buffer out to ARG2" ;; (_-dfun-hook "lb-mu-recursive-replace-inplace") (let ( _rc) (with-temp-buffer (_-ifcl arg1in) (lb-mu-recursive-replace arg1in) (write-region (point-min) (point-max) arg2out)) _rc)) (defun lb-mu-htmm-to-html-random (arg1pf) "" (_-dfun-hook "lb-mu-htmm-to-html-random") ;; ;; fix? ;; Just refresh if more than 24 hours old? (let (lb-pf) (if (string-match (substring (int-to-string (random)) 1 2) "13579") ;; "159" is 3 times out of 10. (lb-mu-make-webpage arg1pf)))) (defun lb-mu-spawn-finale (&optional arg1letter arg2lang arg3list-funcs arg4nosub) "Final SGML/HTML editing with (save-buffer/kill-buffer). Optional ARG1 is a letter to turn pink. Optional ARG2 is a language such as 'es', 'en'. Optional ARG3 is a list of functions to call: - lb-ht-gen-del-self-href - " (_-dfun-hook "lb-mu-spawn-finale") ;; (lb-mu-spawn-finale i) ;; (lb-mu-spawn-finale) (let (lb-pf _rc) (if (not arg2lang) (setq arg2lang lb-lang)) (setq lb-pf (bfn)) ;; fix? ;; Do this each time? (_-sgml-scrub) ;; fix? ;; Do this each time? (lb-sgml-scrub arg1letter arg2lang) (loop for item in arg3list-funcs do (eval (list item))) (progn (lb-time-stamp-format) ;; Suppress username from time-stamp. (run-hooks 'local-write-file-hooks)) ;; Always update time-stamp at top of file. ;; Always update file-stamp at bot of file. (progn (set-buffer-modified-p t) (lb-write-file-hook-sgml-stamps-visible t) (time-stamp)) ;; 2006.11.27 - Makes sense to call tex2html from here, but, can it wait? (_-tex2html) ;; (when (or ;; 2006.12.14 - when would (bfn) be nil? ;; (not lb-pf) ;; fix! what other templates go here? (not (string-match "/book" lb-pf)) ;; a template! ) (if (not arg4nosub) (lb-ht-subs-and-dels-__)) ;; (lb-ht-gen-del-self-href) ;; AFTER subs-and-dels ! (lb-ht-gen-wrap-arrows-without-href-with-span) ;; Modify non-existing HREFs. (lb-mu-href-replace-uptree) ;; ;; Delete non-existing "#foo" HREFs. (lb-mu-href-delete-pound-dead-ends)) ;; (lb-mu-symbolic-link-alternator) ;; 2007.01.01 (lb-mu-error-if-string-found) ;; 2007.04.11 (goto-char (point-min)) (while (sfr "\\^\\^[0-9]+\\^\\^" nil t) (replace-match (concat "" (match-string-no-properties 0) ""))) (lb-mu-hey-rocky) ;; (cmn) (save-buffer 0) (kill-buffer nil) _rc)) ;; (lb-mu-error-if-string-found) (defun lb-mu-error-if-string-found nil "" (_-dfun-hook "lb-mu-error-if-string-found") (let ( _rc) (loop for pair in (list (cons "tttttttttext/javascript" "SEE http://www.ietf.org/rfc/rfc4329.txt") ;; ) do (goto-char (point-min)) (if (search-forward-string (car pair) nil t) (error "%s: %s" (car pair) (cdr pair)))) _rc)) ;; (lb-mu-symbolic-link-alternator) (defun lb-mu-symbolic-link-alternator nil "Handle optional strings in symbolic linked files. Delete paragraphs where 'FN' in ->->FN->->text->-> does not match beginning of filename. If matched, delete everything surrounding text" ;; (let (_cnt (_fn (file-name-sans-directory (bfn))) _fn-starter _rc) (goto-char (point-min)) (while (search-forward-regexp (concat "\n" _-whitespace-wM "*" "\n" _-whitespace-wM "*" "->->") nil t) (when (= 2 (save-excursion (setq _cnt 0) (while (search-forward-string "->->" (cdr (_-where-double-newlines)) t) (setq _cnt (1+ _cnt))) _cnt)) (setq _fn-starter (buffer-substring-no-properties (point) (- (search-forward-string "->->") 4))) (if (or (> (length _fn-starter) (length _fn)) (not (string= _fn-starter (substring _fn 0 (length _fn-starter))))) (_-para-delete) ;; (delete-region (car (_-where-double-newlines t)) (point)) (search-forward-string "->->") (replace-match ""))) ;; May be two consecutive. (_-move-backward-whitespace)) _rc)) ;; (defun lb-mu-hey-rocky nil "" ;; (let (_rc) ;; 2006.12.06 (progn (goto-char (point-max)) (when (search-backward-regexp (concat "class=.self-url.>http://\\(leninist.biz\\)/") nil t) (replace-match (concat "" (match-string-no-properties 1) "") t t nil 1))) _rc)) (defun lb-mu-gen-del-all-but-first-letter nil "NOT IN USE. BAD IDEA. Shorten some links to first letter if before
    " ;; (let (lb-rc) ;; ;; '("MAIL" "FAQ" "NEWS" "HOME") (loop for lb-item in '("Titles" "Authors" "Years" "ASCII" "HTML" "PS" "PDF") do (goto-char (point-max)) (search-backward-regexp "
    ") (when (search-backward (concat ">" lb-item "<") nil t) (replace-match (concat ">" (substring lb-item 0 1) "<")) (search-backward-regexp (concat "")) (replace-match (concat "sidebar-1-letter") t t nil 1))))) ;; (lb-mu-htmm-to-html (concat "~/" lb-domain "/index.htmm")) ;; (lb-mu-htmm-to-html (concat "~/" lb-domain "/en/HTML.htmm")) ;; (lb-mu-htmm-to-html (concat "~/" lb-domain "/es/T.htmm") t) (defun lb-mu-htmm-to-html (&optional arg1pf arg2nosub) "Create X from X.htmm by inserting data that is subject to change. DO NOT USE THIS FUNCTION! ... use lb-mu-make-webpage instead" (_-dfun-hook "lb-mu-htmm-to-html") ;; (interactive) (let (lb-pf-out lb-msnp0 lb-msnp1 (lb-current-buffer (current-buffer)) lb-rc) (save-excursion (save-match-data ;; fix? when? [f2 f9] ? if so, revert buffer! (when (not arg1pf) ;; Interactive; (bsb) (setq lb-ht-__ nil) (setq arg1pf (bfn))) (save-some-buffers) (if (string-match (concat "[.]" lb-ext-htmm "$") (setq lb-pf-out arg1pf)) (setq lb-pf-out (concat (file-name-sans-extension lb-pf-out) "" lb-ext-html)) (error "%s: %s" "File must end with 'htmm'" lb-pf-out)) ;; 2006.11.17 (if (string-match "index$" lb-pf-out) (setq lb-pf-out (concat lb-pf-out ".html"))) ;; wdiff then delete. (progn ;; Prepare for wdiff. (if (lb-get-id-from-path lb-pf-out t) (lb-wdiff lb-pf-out "beg")) ;; Delete. (if (not (file-exists-p arg1pf)) (error "%s: %s" "File not found" arg1pf) (if (file-exists-p lb-pf-out) (delete-file lb-pf-out)))) ;; Create file and insert chunks recursively. (lb-mu-recursive-replace-inplace arg1pf lb-pf-out) ; RECURSION. ;; (find-file lb-pf-out) ;; -literally ;; Change href="#index.txt" to href="Text" (when (string-match (concat lb-re-lang "/[^/]+$") lb-pf-out) (goto-char (point-min)) (while (search-forward-regexp (concat "href=\"\\(#" lb-file-txt "\\)\"") nil t) (if (not (_-sgml-comment-p)) (replace-match ;; fix! cannot remember how to program this: (lb-get-diskfilename "Text" nil nil t) t t nil 1)))) ;; 2006.12.20 - we have general functions for this. (when nil ;; 2006.12.14 - delete 'href="../index.html"' (when (string-match (concat lb-domain "/index.html") lb-pf-out) (goto-char (point-min)) (while (search-forward-regexp "href=\"[^\"]*index.html\"" nil t) (_-para-delete)))) ;; fix? ;; BAD IDEA. ;; What is in ~/leninist.biz/htm/*.en should be it. (when nil (if (string-match (concat "/book[.]" lb-ext-htmm "$") arg1pf) (lb-mu-gen-del-all-but-first-letter)) ) (lb-mu-spawn-finale nil nil nil arg2nosub) ;; Wdiff. (if (lb-get-id-from-path lb-pf-out t) (lb-wdiff nil "end")) (setq lb-rc lb-pf-out))) (if arg1pf (set-buffer lb-current-buffer)) lb-rc)) (defun lb-mu-gen-link-AZ-19 (arg1pf) "" ;; (let (lb-year lb-title-abbrev _rc) (save-excursion (when (and (string-match lb-re-path-year+book arg1pf) (setq lb-year (match-string-no-properties 2 arg1pf)) (setq lb-title-abbrev (match-string-no-properties 3 arg1pf))) (goto-char (point-min)) ;; Titles (while (search-forward-string (concat "/" "T" ;; "t" "" lb-ext-html) nil t) (when (and (_-sgml-markup-p) (string= "a" (_-sgml-what-element))) (replace-match (concat "/T" ;; "/t" (downcase (substring lb-title-abbrev 0 1)) "" lb-ext-html "#" lb-title-abbrev "." lb-year)))) ) ) _rc)) (defun lb-sgml-insert-hyperlink-next-letter (arg1i) "Maybe insert hyperlink for next letter" ;; (let (lb-pf lb-re lb-cons lb-str) (when (< (string-to-char arg1i) 90) ;; z=122 ;; Z=90 ;; Grab paragraph for next letter from div id="header". (save-excursion (search-backward-regexp (setq lb-re (concat ">\\(" (upcase (char-to-string ;; Next letter: (1+ (string-to-char arg1i)))) "\\)<"))) (setq lb-str (buffer-substring-no-properties (car (setq lb-cons (_-where-double-newlines))) (cdr lb-cons)))) ;; Add space around letter (progn (string-match lb-re lb-str) (setq lb-str (replace-match (concat " " (match-string-no-properties 1 lb-str) " ") t t lb-str 1))) (insert "Next: " (if (string-match (concat "") lb-str) (setq lb-str (replace-match (concat (match-string 1 lb-str) "-backcolor") t t lb-str 1)) lb-str) "\n\n")))) ;; (lb-mu-insert-ascii) (defun lb-mu-insert-ascii nil "Insert human-readable table in place of %%data%%" ;; (lb-mu-spawn-formats "text") (let (lb-rc) (lb-mu-insert-human-readable-table "ascii" "TEXT"))) ;; (lb-mu-insert-html) (defun lb-mu-insert-html nil "foo" ;; (lb-mu-spawn-formats "html") (let (lb-rc) (lb-mu-insert-human-readable-table "html" "HTML"))) (defun lb-mu-insert-human-readable-table (arg1type arg2visible-type) "Insert
    foo" ;; (let ;; all these from: lb-mu-insert-titles-by-letter (lb-pf lb-re lb-cons lb-str lb-path lb-author lb-msnp0 lb-dir0 lb-dir1 lb-dir2 lb-lb-id lb-.index lb-href) (setq arg1type (upcase arg1type)) ;; ;; Position for insertion. (goto-char (point-min)) (if (not (setq lb-cons (_-flush-one-paragraph "%%data%%" t nil))) (error "%s: %s" "Not found" "%%data%%") (goto-char (car lb-cons))) ;; (insert "\n\n\n\n") (insert (with-temp-buffer (insert (cond ((string= "ASCII" arg1type) (lb-list-index-text lb-lang)) ((string= "HTML" arg1type) (lb-list-index-html lb-lang)) ((string= "PS" arg1type) (lb-list-index-ps lb-lang)) ((string= "PDF" arg1type) (lb-list-index-pdf lb-lang)) (t (error "%s: %s" "Unknown type" arg1type)))) ;;;/home/login/leninist.biz/en/1987/WHM294/index.html ;;;/home/login/leninist.biz/en/1989/HCM242/index.html ;;;/home/login/leninist.biz/en/1990/MCS295/index.html ;;; 2007.07.31 - weird error: ;;; lb-pf _> "find: /home/cymbala/leninist.biz/en/.#HTML: No such file or directory" (goto-char (point-min)) (while (< (point) (point-max)) (setq lb-pf (_-current-line)) (delete-region (point) (search-forward (concat "/"lb-lang"/"))) (setq lb-href (_-current-line)) (insert "\n\n\n" ;; "" "\n" ) (insert "\n") (insert "\n") (insert "\n\n") (end-of-line) (forward-char 1)) ;; END while. (buffer-string))) (insert "\n\n
    " (lb-get-year-from-path lb-pf) "" "" arg2visible-type "" "" ;; 2006.12.20 (with-temp-buffer (insert (lb-db-__-title-normalize (lb-db-__-get- "TITLE" (concat (file-name-directory lb-pf) lb-file-db) nil (list "<<")))) ;; Change <> to link to HTML. (when (string= "ASCII" arg1type) (goto-char (point-min)) (while (search-forward-string "<<" nil t) (replace-match (concat "")) (search-backward-regexp "[.][a-zA-Z]+") ;; Assuming it is "index.txt". (replace-match (concat "." lb-ext-html "html")) (search-forward-string ">>") (replace-match ""))) (buffer-string))) (if (setq lb-str (lb-db-__-get- "SUBTITLE" (concat (file-name-directory lb-pf) lb-file-db))) (insert " " (lb-db-__-title-normalize lb-str))) ;; 2006.12.05 (if (setq lb-str (lb-db-__-get- "SUBTITLE2" (concat (file-name-directory lb-pf) lb-file-db))) (insert " " (lb-db-__-title-normalize lb-str))) (insert "
    \n\n"))) ;; (lb-mu-insert-titles-by-letter "A" t) (defun lb-mu-insert-titles-by-letter (arg1i &optional arg1authors) "ARG1 is a letter, 'A' through 'Z'. This inserts TITLES and PERSON data into [AT]A through [AT]Z by finding '%%data%%' and replacing it with the data. Do titles first because authors can be ambiguous. ARG1 is passed to lb-mu-table-by-i-wrap-w-li. Optional ARG2 is a flag: lb-mu-spawn-authdata-by-letter ARG1" ;; (let (lb-pf lb-re lb-type lb-cons lb-str lb-path lb-author lb-msnp0 lb-dir0 lb-dir1 lb-dir2 lb-lb-id lb-.index lb-str-index-html lb-href lb-pt lb-rc) (setq lb-type "t") ;; Position for insertion. (goto-char (point-min)) (if (not (setq lb-pt (car (_-flush-one-paragraph (setq lb-str "%%data%%") t nil)))) (error "%s: %s" "Did not find" lb-str) (goto-char lb-pt) (insert "\n\n
      \n\n")) ;; Which HTML books exist? (setq lb-str-index-html (lb-list-index-html lb-lang)) ;; Insert titles, wrapped by LI element, that start with letter i. (insert ;; wrapper insert table. (with-temp-buffer (insert (lb-mu-table-by-i-wrap-w-li arg1i (lb-db-__-table "TITLE" (lb-get-diskfilename ".db.list" nil t) nil) ;; => ~/leninist.biz/en/.TITLE ;;; About Lenin: ~/leninist.biz/en/./1980/AL9/.db ;;; Across the Soviet Union: ~/leninist.biz/en/./1979/ASU9/.db ;;; Actors Without Makeup ~/leninist.biz/en/./1977/AWM9/.db ) ) (goto-char (point-min)) ;;; ;;; ;;;
    • Badges and Trophies in Soviet Sports
      • ;;; ;;; ;;; ;;;
    • Basic Economic Law of Modern Capitalism, The
      • (while (and (setq lb-cons (lb-search-sgml-comment)) (goto-char (car lb-cons)) (progn (setq lb-pf (cdr lb-cons)) (setq lb-dir0 (nth 0 (lb-db-__-get- "YEAR" lb-pf))) (setq lb-dir1 (nth 1 (lb-db-__-get- "YEAR" lb-pf))) (setq lb-dir2 (nth 2 (lb-db-__-get- "YEAR" lb-pf))) (setq lb-lb-id (concat ;; lb-dir0 "." (REDUNDANT.) ;; lb-dir1 "." lb-dir2 ;;; nsgmls:ta.html:183:8:E: value of attribute "id" invalid: "1" cannot start a name lb-dir2 "." lb-dir1 )) t)) (search-forward "
    • ") (replace-match (concat "
    • ")) (insert "") ;; Hyperlink title. ;; (setq lb-dir2 "AP470") ;; (setq lb-dir1 "1984") (if (string-match (concat "/" lb-lang "/" "\\(" ;; fix? ;; where is lb-file-indexhtml coming from? lb-dir1 "/" lb-dir2 "/" lb-file-indexhtml "\\)") lb-str-index-html) (insert "") (setq lb-href nil)) ;; ;; Discard
      • since subtitle(s) need to be added. (progn (search-forward "") (replace-match "\n") (if lb-href (save-excursion (search-backward "<") (insert "")))) (insert ;; wrapper0. (concat ;; wrapper1. ;; (if (setq lb-str (lb-db-__-get- "SUBTITLE" lb-pf)) (concat "\n
      " lb-str)) (if (setq lb-str (lb-db-__-get- "SUBTITLE2" lb-pf)) (concat "\n
      " lb-str)) ;; (concat "\n
      " ;; Align right. "" ;; Publisher. "" "
    " ;; ;; CHUNK - part a of B. (when nil ;; When book not online. "     " "" ;; "" (setq lb-path (concat "" "" ;; lb-dir0 " / " (REDUNDANT.) lb-dir1 " / " lb-dir2)) " /" "") ;; CHUNK - part b of B. (when nil ;; Link space after last "/" to .index " " ;; " ") "\n" (when t (concat "" "donated:")) " •" "   " ;; Current donation level (when t (concat "" " $0 " "")) "
    \n\n") ;; Name data, such as "Who" and "Transl". (progn (setq lb-cons (lb-db-__-get- "NAMEDATA" lb-pf)) ;; NO (when nil (setq lb-cons (cons (car lb-cons) (lb-db-__-namedatum-normalize (cdr lb-cons))))) (if (not (equal '("AUTHOR") (car lb-cons))) " " " ")) ;; ? (with-temp-buffer (insert (_-compress-delete-whitespaces (cdr lb-cons) nil)) (goto-char (point-max)) (insert "\n\n") (while (search-backward-regexp lb-re-__ nil t) (insert "\n\n")) (buffer-string)) "\n\n
     
    " "\n\n\n"))) (buffer-string))) ;; (insert "\n\n\n\n") (lb-sgml-insert-hyperlink-next-letter arg1i) ;; (if arg1authors (lb-mu-spawn-authdata-by-letter arg1i)) lb-rc)) (defun lb-mu-insert-authors-by-letter (arg1i) "This creates AA through AZ from files TA-authors.tab through TZ-authors.tab" (let ( lb-type lb-lag-person lb-list lb-str) (setq lb-type "a") ;; Position for insertion. (goto-char (point-min)) (goto-char (car (_-flush-one-paragraph "%%data%%" t nil))) (insert "\n\n\n\n") (insert (with-temp-buffer (_-ifcl (lb-db-__-table "PEOPLE" (lb-get-diskfilename ".db.list" nil t) nil)) (goto-char (point-min)) ;; fix! ;; What if first letter is accented in Spanish? (flush-lines (concat "^" "[" "^" (upcase arg1i) "]")) ;; Brezhnev (L.I.) WHO ~/leninist.biz/en/./1975/FLC9/.db ;; Brezhnev (L.~I.) WHO ~/leninist.biz/en/./1973/YR319/.db ;; Brezhnev, L. I. WHO ~/leninist.biz/en/./1975/CSU9/.db (while (< (point) (point-max)) (setq lb-list (split-string (_-current-line) "\t")) (delete-region (point) (search-forward "\n")) (insert "\n\n\n" ;; Width of 1st column determined by class= (default.css). ;; Width of 2nd column is padded with "~". ;; NOTE: AJ is a bit off. ;; Person. "" (if (and lb-lag-person (string= (nth 0 lb-list) lb-lag-person)) "  ”" ;; ditto (same author as above). (nth 0 lb-list)) "\n" ;; Type of person. "\n" ;; Title. "\n" "\n\n" ) (setq lb-lag-person (nth 0 lb-list))) (buffer-string))) (insert "\n\n
    " (progn (setq lb-str (nth 1 lb-list)) ;; Pad shorter strings with "~" ("~" changes to " "). (while (< (length lb-str) lb-max-chars-who-fields-names) (setq lb-str (if (oddp (length lb-str)) (concat "~" lb-str) (concat lb-str "~")))) lb-str) "" ;; fix? Will long titles wrap alot in 3rd column? (lb-db-__-title-normalize (lb-db-__-get- "TITLE" (expand-file-name (nth 2 lb-list))))) ;; ;; Could be nil, therefore, this cannot be inside (insert (if (setq lb-str (lb-db-__-get- "SUBTITLE" (expand-file-name (nth 2 lb-list)))) (insert " " (lb-db-__-title-normalize lb-str))) ;; 2006.12.05 (if (setq lb-str (lb-db-__-get- "SUBTITLE2" (expand-file-name (nth 2 lb-list)))) (insert " " (lb-db-__-title-normalize lb-str))) (insert "
    \n\n") ;; (insert "\n\n
     \n\n") ;; Matches one just before table. (lb-sgml-insert-hyperlink-next-letter arg1i))) ;; (lb-mu-make-webpage "book") ;; (lb-mu-make-webpage "volume") (defun lb-mu-make-webpage (arg1type &optional arg2lang arg3nosub) "Use .htmm of type ARG1 for language (lb-lang) to create a webpage --- with no .html extension. Returns return value from lb-mu-htmm-to-html" (let ( lb-rc) (if (not arg2lang) (setq arg2lang lb-lang)) ;; OLD METHOD: (when nil ;; 2006.11.17 - index.html is a symbolic link to (xxTAZxx) sitemap. (when nil (lb-mu-htmm-to-html (concat "~/" lb-domain "/index.htmm"))) ;; (lb-mu-make-webpage "aaaaaaaa" "es") (lb-mu-make-webpage "taz" "es") (lb-mu-make-webpage "index" "es") ;; (lb-mu-make-webpage "texto" "es") (lb-mu-make-webpage "html" "es") (lb-mu-make-webpage "pdf" "es") (lb-mu-make-webpage "ps" "es") ;; ;; ... ;; ... ;; ... ) ;; All .htmm should exist. (loop for cons in lb-assoc-htmm do (if (not (file-exists-p (setq lb-rc (concat "~/" lb-domain "/" (cdr (assoc arg2lang (cdr cons))))))) (error "%s: %s" "File not found" lb-rc))) ;; DEPENDENCIES. (if (string= "ledger" arg1type) (lb-mu-make-webpage "multilingual-ledger")) (setq lb-rc (lb-mu-htmm-to-html (lb-get-diskfilename arg1type arg2lang t) arg3nosub)) ;; fix! ;; These must be populated. ;; (lb-mu-spawn-formats "html") ;; (lb-mu-spawn-formats "text") lb-rc)) ;; (lb-mu-spawn-formats "html") ;; (lb-mu-spawn-formats "text") (defun lb-mu-spawn-formats (arg1type) "This creates HTML, Text, etc." (_-dfun-hook "lb-mu-spawn-formats") ;; ;; (lb-mu-spawn-formats "text") ;; (lb-mu-spawn-formats "html") (let (lb-pf _rc) (setq arg1type (upcase arg1type)) (lb-mu-make-webpage arg1type) (progn ;; Create new file and update stamps. (set-buffer (lb-mu-set-n-return-buffer-x arg1type)) ;; ;; HERE in lb-mu-spawn-x-by-letter: "Change TITLE element" ;; NOTHING TO CHANGE. No sub-files. ) ;; (cond ((string= "TEXT" arg1type) (lb-mu-insert-ascii)) ((string= "HTML" arg1type) (lb-mu-insert-html)) ((string= "PS" arg1type) (lb-mu-insert-ps)) ((string= "PDF" arg1type) (lb-mu-insert-pdf)) ((string= "AAAAAAAA" arg1type) (lb-mu-insert-x)) (t (error "%s: %s" "Invalid choice" arg1type))) ;; ;; (lb-mu-spawn-finale nil nil (list 'lb-ht-gen-del-%%notes%% )) _rc)) (defun lb-mu-spawn-x-by-letter-online-up-top (&optional arg1) "Arrange list of ebooks so ones with hyperlinks to HTML are on top" ;; (let (lb-pt-beg lb-pt-end lb-str-li-online _rc) ;; Harvest "records" with index.html . (goto-char (point-max)) (search-backward "" nil t) (progn (beginning-of-line) (point))))) (when (save-excursion (search-forward (concat "/" lb-file-index "" lb-ext-html) lb-pt-end t)) (setq lb-str-li-online (concat (buffer-substring-no-properties lb-pt-beg lb-pt-end) lb-str-li-online)) (delete-region lb-pt-beg lb-pt-end))) (progn (search-backward "\n" "\n" lb-str-li-online "\n" " \n" "\n"))) ;; ... (defun lb-mu-spawn-x-by-letter ;; ... ... (set-buffer (lb-mu-set-n-return-buffer-x arg1type i)) (lb-mu-recursive-replace (bfn))) _rc)) ;;; SEE SEE lb-batch.el: (lb-mu-spawn-x-by-letter "titl" lb-AZ) ;;; OR, just one letter: (lb-mu-spawn-x-by-letter "titl" "C") ;;; OR, just one letter: (lb-mu-spawn-x-by-letter "auth" "A") (defun lb-mu-spawn-x-by-letter (arg1type arg2az) "This creates XA (was xa.html) through XZ where 'X' is 'T' for titles, 'A' for authors, '19' for years, etc. ARG1 is type ('T' or 't' or 'titl' for titles, etc.) ARG2 is string of letters to process (see lb-az) Optional ARG3, if t, will execute lb-mu-spawn-authdata-by-letter also" (_-dfun-hook "lb-mu-spawn-x-by-letter") ;; (let (lb-x lb-pf lb-rc) (lb-assoc-__-PUBL) ;; fix? ;; What other dependent files should be emptied/erased? (lb-mu-make-webpage "TAZ") ;; Muy importante. ;; (lb-mu-htmm-to-html "~/leninist.biz/en/taz.htmm") ;SEE lb-mu-spawn-taz- (cond ;; Make template "T" before creating "TA" thru "TZ". ((string= "T" (upcase (substring arg1type 0 1))) (lb-mu-make-webpage "titl")) ((string= "A" (upcase (substring arg1type 0 1))) (lb-mu-make-webpage "auth")) ((or (string= "Y" (upcase (substring arg1type 0 1))) (string= "19" arg1type)) (lb-mu-make-webpage "year")) (t (error "%s: %s" "Invalid choice" arg1type))) (when (string= arg2az lb-AZ) ;; 2007.01.02 (setq lb-ht-__ nil) ;; TO-DO: (_-delete-paragraph-from-file "%%data%%" ;; (lb-mu-template-get- "y") (lb-mu-make-webpage "year") ) ;; fix! ;; Forgot to add "why". ;; So, loop over lb-assoc-htmm and run lb-mu-make-webpage on each one! ;; So, or, loop over list of *.htmm from disk. (lb-mu-make-webpage "a" nil t) (lb-mu-make-webpage "t" nil t) ;; fix! why "year" above? (lb-mu-make-webpage "19" nil t) (lb-mu-make-webpage "faq") (lb-mu-make-webpage "text") (lb-mu-make-webpage "html") (lb-mu-make-webpage "ps") (lb-mu-make-webpage "pdf") ;; (lb-mu-make-webpage "mail") (lb-mu-make-webpage "ledger") (lb-mu-make-webpage "links") (lb-mu-make-webpage "news") (lb-mu-make-webpage "why") (lb-mu-make-webpage "sitemap")) ;; (loop for i in (split-string arg2az "") ;; arg2az can be lb-AZ or lb-az. do ;; Create new file and update stamps. Insert data. (progn ;; Set buffer to, e.g., "TA" when 1starg="titl" and 2ndarg="A". (set-buffer (lb-mu-set-n-return-buffer-x arg1type i)) (setq lbg-path-from-lang (progn (setq lb-pf (bfn)) (string-match (concat ".*/" lb-lang "/") lb-pf) (setq _str (replace-match (concat lb-lang "/") t t lb-pf)))) (setq __TITLE__ "") (setq __SUBTITLE__ "") (setq __SUBTITLE2__ "") (lb-ht-common-__) (__handler "PUT" "TITLE_ELEMENT_SORT_BY_PATH" lbg-path-from-lang) (lb-wdiff (bfn) "beg") (when nil ;; fix! ;; Currently only handles English. ;; Change TITLE element. (progn (goto-char (point-min)) (search-forward-regexp (concat "\\(Titles\\|Authors\\)" "\\( \\)" ;; change this space. "(English)")) (replace-match (concat " ( " (upcase i) " ) ") t t nil 2)) ) (cond ((string= "titl" arg1type) (lb-mu-insert-titles-by-letter i t)) ((string= "auth" arg1type) (lb-mu-insert-authors-by-letter i)) (t (error "%s: %s" "Invalid" arg1type)))) ;; (when (string= "titl" arg1type) ;; 2006.12.28 (goto-char (point-min)) (while (search-forward-regexp (concat "href=\"[AT]" i "\"") nil t) (search-backward-string "")) (insert "•")) (goto-char (point-max)) (if (search-backward "")) (setq lb-pf (cdr (lb-search-sgml-comment t)))) (when (or (string= "author" lb-msnp1) (string= "namedata" lb-msnp1)) (while (and (goto-char (cdr (_-where-double-newlines))) (search-forward-regexp "[^ \t\n]") (or (forward-char -1) t) (looking-at (concat lb-re-__ "[ \t\n]+")) (setq lb-tag (match-string-no-properties 1)) ;; Delete __TAG__. (or (replace-match "") t)) (setq lb-cols23 (concat "\t" lb-tag "\t" lb-pf "\n")) (setq lb-pt nil) (goto-char (cdr (_-where-double-newlines))) (while (search-backward ">>" (car (_-where-double-newlines)) t) (replace-match "") (setq lb-pt (- (point) 2)) (search-backward "<<") (replace-match "") (setq lb-str (buffer-substring-no-properties (point) lb-pt)) (delete-region (point) lb-pt) (setq lb-pt (point)) (insert (lb-db-__-namedatum-normalize lb-str)) (_-append-to-buffer lb-buf lb-pt lb-cols23)) ;; This __FIELD__ does not have <<>> around name(s). (unless lb-pt (progn (goto-char (car (setq lb-cons (_-where-double-newlines)))) (setq lb-str (buffer-substring-no-properties (car lb-cons) (cdr lb-cons)))) ;; 1of2 (delete-region (car lb-cons) (cdr lb-cons)) (setq lb-pt (point)) (insert (lb-db-__-namedatum-normalize lb-str)) (_-append-to-buffer lb-buf lb-pt lb-cols23)) ;; Insert "Tag:" (unless (string= "AUTHOR" lb-tag) (goto-char (car (_-where-double-newlines))) (insert "" (upcase-initials (downcase lb-tag)) ": "))))) (save-excursion (setq lb-pf (current-buffer)) (set-buffer lb-buf) (save-buffer 0) ;; T[A-Z]-authors.tab (kill-buffer nil) (switch-to-buffer lb-pf)))) ;; (lb-mu-spawn-taz-) (defun lb-mu-spawn-taz- (&optional arg1lang) "Create taz.html" (_-dfun-hook "lb-mu-spawn-taz-") (let (my-href my-msnp-tz my-msnp1 lb-cons my-id lb-str lb-re lb-rc) (if (not arg1lang) (setq arg1lang lb-lang)) ;; fix! ;; Mimic