;; Poor Man's Markup. ;; Emacs-Time-stamp: "2008-08-17 07:57:14" (setq file-stamp "Emacs-File-stamp: \"/home/ysverdlov/leninist.biz/lb-tx.el\"") ;; (tx-page-number-p) (defun tx-page-number-p nil "Is this paragraph a page number?" (let (_str _rc) (if (and (not (_-blank-line-p)) (string-match lb-re-bracketed-integer-anchored (setq _str (_-normalize-whitespace (car (_-para t t)))))) (setq _rc (match-string-no-properties 0 _str))) _rc)) ;; (defun lb-tx-globals () "2007.06.25" ;; (let (_assoc _rc) (setq _assoc (_-find-file-hooks-__-globals)) ;; (if (setq lb-str (cdr (assoc "__WHERE_PAGE_NUMBERS__" _assoc))) (setq _-where-page-numbers-global lb-str) (makunbound '_-where-page-numbers-global)) ;; (if (setq lb-str (cdr (assoc "__FOOTNOTE_MARKER_STYLE__" _assoc))) ;; (setq lb-re-^^marker^^ (setq _-re-footnote-marker-global (concat "\\^\\^\\(" lb-str "\\)\\^\\^")) (makunbound '_-re-footnote-marker-global)) _rc)) ;; (defun lb-tx-delete-indexes () "" ;; (let ( _rc) (if (file-exists-p lbg-text-indextx) (delete-file lbg-text-indextx)) (if (file-exists-p lbg-text-indextxlog) (delete-file lbg-text-indextxlog)) (if (file-exists-p lbg-text-indextxt) (delete-file lbg-text-indextxt)) _rc)) ;; (lb-tx-make-or-refresh-indextx) ;; dired: M-x lb-tx-make-or-refresh-indextx (defun lb-tx-make-or-refresh-indextx () "If time-stamps or missing files dictate, do this: ... /1981/PCM336$ rm index.txt index.tx.log ... /1981/PCM336$ cat 20*/*.tx > index.tx ... $ [Emacs: create index.tx.log] NOTE: Uses regexps from lb-defvar instead of '*'. If called interactively in dired-mode, uses path from _-dired-get-fullpath, otherwise uses path from lbg-text-indextx" (_-dfun-hook "lb-tx-make-or-refresh-indextx") ;; (interactive) ;; Useful from dired. (let (lb-command lb-pf lb-where-page-numbers lb-path lb-rc) ;; fix! ;; How to automate ``mrm *.html'' via lftp? ;; 2006.11.17 - Decided to drop ".html" extension. ;; How to synch remote website with local drive? ;; --------------------------------- ;; howto fix! ;; Get a directory listing, exclude ".jpg", then run ;; "file" command, deleting ones that are: ;; login@debian:~/leninist.biz/en/1989/HCM243$ file china.html ;; china.html: HTML document text ;; --------------------------------- ;; SEE: (lb-delete-files ...) ;; --------------------------------- ;; nofix! ;; Create set of ".tx.log" files to go along w/ ".tx" files. ;; If ".tx" changes, update ".tx.log". ;; NO! Webpages created from index.tx, so .log for that ONLY! ;; For use with function key from within dired: (if (not (eq 'dired-mode major-mode)) (setq lb-path (file-name-directory lbg-text-indextx)) ;; (setq lb-path (_-dired-get-fullpath)) ;; ;; CASE 1: /home/login/leninist.biz/en/1981/1HU376/20051214: ;; CASE 2: /home/login/leninist.biz/en/1981/1HU376: (if (not (string-match lb-re-path-year+book lb-path)) (setq lb-path nil) ;; Chop-off book-instance? (when (string-match lb-re-path-year+book-instance lb-path) (string-match (concat ;; fix? Chop-off trailing slash? No. Neither method above does. "/?" lb-re-YYYYMMDD "/?$") lb-path) (setq lb-path (replace-match "/" t t lb-path))))) ;; ------------------------------------------------------- ;; ------------------------------------------------------- (when lb-path ;;;(message "%s" (concat "xxx lb-path " lb-path));2007.07.18-ugh-how.did.this.fix.it? ;; ------------------------------------------------------- (when ;; .tx (or (not (file-exists-p ;; fix! why one relative and other absolute? ;; lbg-text-indextx => ;; "~/leninist.biz/en/0000/EROS999/index.tx" ;; lbg-text-indextxt ;; "/home/ysverdlov/leninist.biz/en/0000/EROS999/index.txt" ;; 2007.08.19 - allow more stuff in txt, less in tx__>webpages. ;; lbg-text-indextx lbg-text-indextxt )) (and ;; Got little .tx files? (setq lbg-str-little-tx-files (with-temp-buffer (shell-command (setq lb-command (concat "cd " lb-path " ; " "find " lb-re-YYYYMMDD " -follow" " -mindepth 1 -maxdepth 1 " " -name '" lb-re-tx-100pages "' " " | sort" )) t) (goto-char (point-min)) (while (search-forward-regexp "\n" nil t) (replace-match " ")) (if (string= "" (buffer-string)) nil (buffer-string)))) ;; Was a little .tx changed more recently than big .tx ? (setq lbg-str-little-tx-files-changed (with-temp-buffer (shell-command (setq lb-command (concat "cd " lb-path " ; " "find " lb-re-YYYYMMDD " -follow" " -mindepth 1 -maxdepth 1 " " -name '" lb-re-tx-100pages "' " " -cnewer " ;; 2007.08.19 - allow more stuff in txt, ... ;; lbg-text-indextx lbg-text-indextxt )) t) (if (string= "" (buffer-string)) nil (buffer-string)))) ) ;; and ) ;; or ;; Delete files independently of cat-ing *.tx into index.tx. (with-temp-buffer ;;;(message "%s" (concat "xxx rm files"));2007.07.18-ugh-how.did.this.fix.it? (shell-command (setq lb-command (concat "cd " lb-path " ; " ;; fix? use lbg-text-indextxt ? "rm -f" " " lb-file-txt " " lb-file-tx " " lb-file-tx ".log ; " )) nil (current-buffer)) (setq lb-rc (concat lb-rc (buffer-string)))) ;; Create file. (with-temp-buffer ;;;(message "%s" (concat "xxx create file"));2007.07.18-ugh-how.did.this.fix.it? (shell-command (setq lb-command (concat "cd " lb-path " ; " "awk -f " lb-home ;; "cat " ;; 2007.08.19 "9tx2txt.awk " ;; lb-re-YYYYMMDD "/" lb-re-tx-100pages ;; 2007.08.19 (concat " | awk -f " lb-home "crstrip.awk ") " > " ;; 2007.08.19 - allow more stuff in txt, ... ;; lb-file-tx lb-file-txt ;; 2007.08.19 (progn (lb-lftp-dosomething-file lbg-text-indextxt) nil) ;; " 2>/dev/null" " ; " ;;; fix! ;;; fix! man bash / "Pathname Expansion" ;;; fix! ;;; AWK complains if it cannot find 9999.tx files. ;;; (Shell command failed with no output) ;;; (Shell command succeeded with no output) ;;; "[2][0][0-9][0-9][0-9][0-9][0-9][0-9]/[0-9][0-9][0-9][0-9].tx " )) ;; Use current-buffer as ERROR-BUFFER; will be used for rc. nil (current-buffer)) (setq lb-rc (concat lb-rc (buffer-string)))) ;; ------------------------------------------------------- ;; Checks, with write-file. (with-temp-buffer ;;;(message "%s" (concat "xxx checks"));2007.07.18-ugh-how.did.this.fix.it? (insert-file-contents-literally ;; 2007.08.19 - allow more stuff in txt, less in tx__>webpages. ;; lbg-text-indextx lbg-text-indextxt ) ;; --------------------------------- ;; CHECKS ;; 2007.01.25 ;; Sets lbg-str-time-stamps . (tx-check-buffer lbg-text-indextxt) ;; --------------------------------- ;; ON-THE-FLY: lb-tx-make-or-refresh-indextx ;; Changes acceptable in both index.txt and index.tx ;; Remove all but latest Emacs-Time-stamp . (when (and lbg-str-time-stamps (> (length lbg-str-time-stamps) 1)) ;;;(message "%s" (concat "xxx ON-THE-FLY"));2007.07.18-ugh-how.did.this.fix.it? (goto-char (point-max)) (while (search-backward-string lb-str-emacs-time-stamp nil t) (_-para-delete)) ;; (insert "\n\n" (with-temp-buffer (loop for i in lbg-str-time-stamps do (insert i "\n")) (sort-lines t (point-min) (point-max)) (goto-char (point-min)) (_-current-line)) "\n\n") (message "%s: %s" _defun "Emacs-time-stamps replaced with latest.")) ;; 2007.02.25 - 1st line indentation: join 1st and 2nd if 1st = "

" (goto-char (point-max)) (while (search-backward-regexp (concat "^

" "\\([\n]\\)" _-^whitespace-noM) nil t) (replace-match (concat " " " " " " " " " ") t t nil 1)) ;; fix! likewise for "

" ... make all right-aligned to fixed col. ;; 2006.08.22 ;; __ALPHA_LVL0__ should be last, with 1,2,3 in body (not 0,1,2). (goto-char (point-max)) (search-backward-regexp "_LVL[0-9]__") (if (search-backward "_LVL0_" nil t) (error "%s: %s" "Use 1,2,3 in body" (concat "_LVL0 not at end" "\n" (_-buffer-substring-from-)))) (message "%s: %s" _defun "LVL0 checked.") ;; 2007.04.05 ;; Delete character used to force newline in .tx file before ;; next ^M. (goto-char (point-max)) (while (sbs ;; fix! ;; "_" or "=" to insert newline in middle of line? ;; What about " = \n" or " = \r\n" ? tx-str-fill-paragraph-midline nil t) (replace-match "")) ;; 2007.10.01 (lb-gender-changer) ;; 2007.12.17 - was in tx-check-buffer (lb-pmm-transform-shadow-copies) ;; --------------------------------- ;; WRITE. ;; Write back to disk due to time-stamp. (_-compress-multiple-newlines) (write-region (point-min) (point-max) ;; 2007.08.19 - allow more stuff in txt, ... ;; lbg-text-indextx lbg-text-indextxt ) ) ;; with-temp-buffer ) ;; WAS: .tx NOW: .txt ;; ------------------------------------------------------- (when ;; .txt (or (not (file-exists-p ;; 2007.08.19 - allow more stuff in txt, less in tx__>webpages. ;; lbg-text-indextxt lbg-text-indextx )) (string< (_-timestamp ;; lbg-text-indextxt lbg-text-indextx ) (_-timestamp ;; lbg-text-indextx lbg-text-indextxt ))) ;;;(message "%s" (concat "xxx .txt"));2007.07.18-ugh-how.did.this.fix.it? ;; ------------------------------------------------------- ;; Create file. (with-temp-buffer ;;;(message "%s" (concat "xxx awk"));2007.07.18-ugh-how.did.this.fix.it? (shell-command (setq lb-command (concat "cd " lb-path " ; " "awk -f " lb-home ;; 2007.08.19 ;; "tx2txt.awk " "" "txt2tx.awk " ;; "crstrip.awk " ;; lb-file-tx lb-file-txt " > " ;; lb-file-txt lb-file-tx ;; 2007.08.19 ;; (progn (lb-lftp-dosomething-file lbg-text-indextxt) nil) " ; " )) ;; Use current-buffer as ERROR-BUFFER; will be used for rc. nil (current-buffer)) (setq lb-rc (concat lb-rc (buffer-string)))) ) ;; .txt ;; ------------------------------------------------------- (when ;; .tx.log ;;;(message "%s" (concat "xxx tx.log"));2007.07.18-ugh-how.did.this.fix.it? ;; Function creates it if it does not exist. ;; Function deletes then creates it if timestamp is stale. t ;; ------------------------------------------------------- ;; Create file. (lb-tx-parse-tx-make-log) ) ;; .tx.log ) (if (string= "" lb-rc) (setq lb-rc nil)) lb-rc)) ;; (setq arg1pf "~/leninist.biz/en/1976/HA243/20060412/099odd.tx") ;; (setq arg1pf "~/www.marxists.org/archive/lenin/works/cw/v36pp71/099even.tx") ;; (lb-tx-parse-tx-make-log arg1pf) ;; ;; lb-tx-make-or-refresh-indextx: (lb-tx-parse-tx-make-log) (defun lb-tx-parse-tx-make-log (&optional arg1pf arg2type) "Create a .log from ARG1 unless time-stamp of former is newer. Loop forward searching for non-whitespace; move to end of paragraph; pass paragraph to lb-ht-para-type to determine type. Optional ARG1 is input file, defaults to lbg-text-indextx. Optional ARG2 is type of object (e.g., PG#) to limit log file" (_-dfun-hook "lb-tx-parse-tx-make-log") ;; (let (lb-pf lb-cons-wdn lb-para lb-cons lb-re lb-str lb-pg lb-int lb-roman-page-cnt lb-pt-beg lb-pt-end lb-type lb-log lb-buffer-log lb-buffer-temp (lb-current-buffer (current-buffer)) lb-globals _rc) (if (not arg1pf) (setq arg1pf lbg-text-indextx )) ;; fix! ;; Check page numbers first! Crashed on roman numerals NOT page #s. ;; --------------------------------- ;; fix! ;; If input file is a 100-page text chunk (see lb-tx-merge-odd-even), ;; check for unreasonable page numbers, for example, page numbers from ;; Table of Contents that are not joined with heading. ;; let ;; n-expect-page-first n-expect-page-last ;; (progn (setq n-expect-page-last (string-to-int arg1endpage)) ;; (setq n-expect-page-first (- n-expect-page-last 99))) (progn ;; Maybe delete stale log file. (if (file-exists-p (setq lb-log (concat arg1pf "." lb-ext-txlog))) (if (string-lessp (_-timestamp lb-log) ;"2005-07-20T13:23:18-0700" (_-timestamp arg1pf)) ;"2005-07-20T18:45:46-0700" (delete-file lb-log)))) (when ;; If logfile does not exist or was deleted. (not (file-exists-p lb-log)) (progn ;; Create temp buffer and read input data from disk. (set-buffer (setq lb-buffer-temp (get-buffer-create (make-temp-name "")))) (_-ifcl arg1pf) (setq lb-globals (_-find-file-hooks-__-globals nil t)) ;; 2007.08.01 (lb-tx-check-page-numbers arg1pf) lb-buffer-temp) (progn ;; Start log file. (when (setq lb-buffer-log (find-buffer-visiting lb-log)) (kill-buffer lb-buffer-log)) ;; (setq lb-buffer-log (find-file lb-log)) (setq _-where-page-numbers ;; fix? This should be done in lb-tx-globals only! (setq _-where-page-numbers-global (cdr (assoc "__WHERE_PAGE_NUMBERS__" lb-globals)))) ;; fixed! No need to insert two newlines beforehand, just one. (insert "\n" _defun "\n\n") lb-log) ;; BEGIN. Temp buffer has copy of index.tx (set-buffer lb-buffer-temp) ;; Converting roman page numbers to negative PG numbers. No page "0". (progn (goto-char (point-min)) (setq lb-roman-page-cnt 0) ;; fix! check sequence ... i ... ii ... iii ... or check it in .log! (while (and (sfr lb-re-bracketed-para-integer nil t) (not (string-match "[0-9]" (match-string-no-properties 0))) (setq lb-roman-page-cnt (1- lb-roman-page-cnt)))) (if (= 0 lb-roman-page-cnt) (setq lb-roman-page-cnt nil)) lb-roman-page-cnt) ;; MAIN. Keep searching for non-whitespace character. (goto-char (point-min)) (while (and (search-forward-regexp "[^ \t\n\r]" nil t) (progn (forward-char -1) (goto-char (setq lb-pt-beg (car (setq lb-cons-wdn (_-where-double-newlines))))) (setq lb-para (buffer-substring-no-properties lb-pt-beg (setq lb-pt-end (cdr lb-cons-wdn)))) (setq lb-type (lb-ht-para-type lb-para lb-type)) t)) ;; fix! Toss this check into step that creates index.tx !! ;; LVL's must have data. (if (and (not (string-match "[ \t\n]" lb-para)) (string-match "__[A-Z]+_LVL[0-9]__" lb-para)) (error "%s: %s" "Missing data" lb-para)) ;; MAIN. (when (or (not arg2type) (string= lb-type arg2type)) ;; fix? One with-temp-buffer per paragraph seems like a lot. (with-temp-buffer (insert ;; First (and maybe only) word of first line: "\n\n" lb-type "" (cond ((or (string= "__WHERE_PAGE_NUMBERS__" lb-type) (string-match (concat "^" lb-re-__-lvl4chunking "$") lb-type) (string-match (concat "^" lb-re-__-titles "$") lb-type)) ;; Retain beg. pt. of __WHERE_PAGE_NUMBERS__ in log file. ;; Retain beg. pt. of lb-re-__-lvl4chunking in log file. ;; Retain beg. pt. of lb-re-__-titles in log file. ;; INSERT: (concat " " ;; Begin point (where-page-numbers). ;; Begin point (chapters/NUMERICs and sections/ALPHAs). ;; Begin point (title and subtitles). (int-to-string lb-pt-beg) ;; Paragraph. "\n" lb-para)) ((string= "PG#" lb-type) ;; Retain beg. pt. of page number. ;; Retain value of page number. ;; INSERT: end point (page numbers). (concat " " (int-to-string (if (string= "top" _-where-page-numbers) lb-pt-beg lb-pt-end)) ;; 2006.11.23 - Add true page number after start point. ;; 2007.03.02 - True PG# for last Roman numeral page is "-1". (concat " " ;; (_-string-to-int "1") ;; (_-string-to-int "[2]") ;; (_-string-to-int "-3-") ;; (_-string-to-int "-3") ;; 2007.02.27 - en/1976/NSO261/ ;; [i] ;; NOTE: Not able to just keep it at level of a string! ;; NOTE: Want PG#s in .log to be independent of top/bottom. ;; Non-Roman numbered pages: (if (setq lb-int (_-string-to-int lb-para)) ;; Will remove brackets: (if (string= "top" _-where-page-numbers) (int-to-string lb-int) ;; If page numbers at bottom, assume they are at top! (int-to-string (1+ lb-int))) ;; 2007.02.27 - Roman numbered page. ;; 2007.03.02 - Already added 1 if PG#'s at bottom (Cabove)! ;; In log file, all PG#'s assumed at *TOP* of page! ;; If i thru xxii and PG#'s at bottom, PG# i is... -21. ;; If i thru xxii and PG#'s at bottom, PG# ii is... -20. ;; If i thru xxii and PG#'s at bottom, PG# xxi is... -1 . ;; If i thru xxii and PG#'s at bottom, PG# xxii is... 1 . ;; --- ;; In log file, all PG#'s assumed at *TOP* of page! ;; If i thru xxii and PG#'s at top, PG# i is... -22. ;; If i thru xxii and PG#'s at top, PG# ii is... -21. ;; If i thru xxii and PG#'s at top, PG# xxi is... -2 . ;; If i thru xxii and PG#'s at top, PG# xxii is... -1 . (progn (setq lb-str lb-roman-page-cnt) (if (string= "bottom" _-where-page-numbers) (if (= -1 lb-roman-page-cnt) (setq lb-str 1) (setq lb-str (1+ lb-str)))) (setq lb-str (int-to-string lb-str)) (setq lb-roman-page-cnt (1+ lb-roman-page-cnt)) lb-str))) ;; Paragraph. "\n" lb-para)) ;; Retain first word of a BIG paragraph. ((string-match (concat "\\([^" (setq lb-re " \t\n\r") "]+\\)[" lb-re ;; SEE 2 lines up. "]") lb-para) ;; INSERT: (concat "\n" (match-string 1 lb-para))) ;; OTHERWISE. One-word paragraph that isn't special. (t ;; INSERT: (concat "\n" lb-para))) ;; Blank line after this "record". "\n\n") (setq lb-str (buffer-string))) (set-buffer lb-buffer-log) (insert lb-str) (set-buffer lb-buffer-temp)) ;; when (goto-char lb-pt-end)) ;; while (kill-buffer lb-buffer-temp) (set-buffer lb-buffer-log) ;; fix? Should be able to control multiple blank lines. (_-compress-multiple-newlines) (basic-save-buffer-1) (kill-buffer (current-buffer)) (set-buffer lb-current-buffer)) (setq _rc lb-log) _rc)) ;; (lb-tx-merge-odd-even "~/leninist.biz/en/1976/HA243/20060412/099even.tx") ;; (lb-tx-merge-odd-even "~/leninist.biz/en/1976/HA243/20060412/199odd.tx") ;; (lb-tx-merge-odd-even "~/leninist.biz/en/1976/HA243/20060412/243odd.tx") ;; ;; (setq arg1pf "~/www.marxists.org/archive/lenin/works/cw/v36pp71/099even.tx") ;; (lb-tx-merge-odd-even arg1pf "PG#") (defun lb-tx-merge-odd-even (&optional arg1pf arg2type) "Combine (edited) 999even.tx and (edited) 999odd.tx into 999.tx. Point data is taken from temporary files created by lb-tx-parse-tx-make-log. ARG1 is path to either an odd or even .tx file. Optional ARG2 is passed to lb-tx-parse-tx-make-log. FIX: If page boundaries are VPST, put a dummy VPST at bottom of file, or fix lb-tx-parse-tx-make-log so it does not skip last page" (interactive) (let (arg1endpage arg1type lb-re arg1pfother arg1pfout arg1pflog arg1pfotherlog arg1pfpoints arg1pfotherpoints lb-cons0 lb-cons1 lb-cons lb-pf lb-pg (page-first "99999") (page-last "-99999") (page-first-default "99999") (page-last-default "-99999") lb-rc) ;; If no first argument, try using buffer-file-name. (if (not arg1pf) (setq arg1pf (bfn))) (if (not (string-match (setq lb-re (concat "/" lb-re-tx-odd-even "$")) arg1pf)) (error "%s: %s" arg1pf lb-re) ;; (setq arg1endpage (match-string-no-properties 1 arg1pf)) (setq arg1type (match-string-no-properties 2 arg1pf)) (if (not (file-exists-p arg1pf)) (error "%s: %s" "File not found" arg1pf)) (if (file-exists-p (setq arg1pfout (replace-match "" t t arg1pf 2))) (error "%s: %s" "File already exists" arg1pfout))) (if (not (file-exists-p (setq arg1pfother (replace-match (if (string= "odd" arg1type) "even" "odd") t t arg1pf 2)))) (error "%s: %s" "File not found" arg1pfother)) ;; fix! ;; Turn into function? ;; Throws an error instead of asking to save buffer. (if (find-buffer-visiting arg1pf) (if (buffer-modified-p (find-buffer-visiting arg1pf)) (error "%s: %s" "Save first" arg1pf) (kill-buffer (find-buffer-visiting arg1pf)))) (if (find-buffer-visiting arg1pfother) (if (buffer-modified-p (find-buffer-visiting arg1pfother)) (error "%s: %s" "Save first" arg1pfother) (kill-buffer (find-buffer-visiting arg1pfother)))) ;; (progn (setq arg1pflog (lb-tx-parse-tx-make-log arg1pf arg2type)) (setq arg1pfotherlog (lb-tx-parse-tx-make-log arg1pfother arg2type)) ;; (setq arg1pfpoints (lb-tx-parse-pg-points arg1pflog)) (setq arg1pfotherpoints (lb-tx-parse-pg-points arg1pfotherlog))) ;; Set bounds. (loop for i in (append arg1pfpoints arg1pfotherpoints) do (if (< (string-to-int (car i)) (string-to-int page-first)) (setq page-first (car i))) (if (> (string-to-int (car i)) (string-to-int page-last)) (setq page-last (car i)))) (if (or (string= page-last-default page-last) (string= page-first-default page-first)) (error "%s: %s" page-last-default page-first-default)) ;; Merge. (with-temp-buffer (loop for i from (string-to-int page-first) to (string-to-int page-last) do (setq lb-pg (int-to-string i)) (setq lb-cons0 (assoc lb-pg arg1pfpoints)) (setq lb-cons1 (assoc lb-pg arg1pfotherpoints)) (if (and lb-cons0 lb-cons1) (error "%s: %s" (concat "Page " lb-pg " found in both") (concat " + " arg1pf " + " arg1pfother))) (if (not (or lb-cons0 lb-cons1)) (error "%s: %s" "Missing page" lb-pg)) (setq lb-cons (if lb-cons0 lb-cons0 lb-cons1)) (setq lb-pf (if lb-cons0 arg1pf arg1pfother)) ;; (goto-char (point-max)) (insert "\n\n") ;; The two arguments START and END are character positions; ;; they can be in either order. ;; (buffer-substring-no-properties ;; (car (cdr lb-cons1)) (cdr (cdr lb-cons1))) ;; The optional third and fourth arguments BEG and END ;; specify what portion of the file to insert. ;; These arguments count bytes in the file, not characters in the buffer. (insert-file-contents-literally lb-pf nil (1- (car (cdr lb-cons))) (1- (cdr (cdr lb-cons)))) (insert "\n\n")) (_-compress-multiple-newlines) ;; fix! ;; Keep just one Emacs-Time-stamp: ... which one? ;; Check for duplicate __EMAIL__ etc. and (1) check for identity; (2) ;; delete 2nd copy. (progn ;; DO SIMULTANEOUSLY! (write-region (point-min) (point-max) arg1pfout) (progn ;; DO SIMULTANEOUSLY! (delete-file arg1pflog) (delete-file arg1pfotherlog) ;; Drop "x" from ".tx" (rename-file arg1pf (substring arg1pf 0 (1- (length arg1pf)))) (rename-file arg1pfother (substring arg1pfother 0 (1- (length arg1pfother)))))) ;; END TEMP BUFFER. ) (setq lb-rc arg1pfout))) ;; (setq lbg-text-indextxlog "~/leninist.biz/en/1973/WICIR313/index.txt.log") ;; (setq arg1pf lbg-text-indextxlog) ;; (setq lb-list (lb-tx-parse-pg-points arg1pf)) (defun lb-tx-parse-pg-points (arg1pf-log) "Return list of conses with page number and boundary points cons cell. Input comes from ARG1, a file created by lb-tx-parse-tx-make-log. If page numbers at top, car of cons cell is point to left of page number. If page numbers at bottom, cdr of cons cell is point to right of page number. - cons cell is the cdr of this return value - page number is the car of this return value" (_-dfun-hook "lb-tx-parse-pg-points") ;; (let (lb-pf lb-rc lb-lag lb-mstr1 lb-mstr2 (lb-re (concat "\n\nPG#" " " "\\([0-9]+\\)" ;; 2006.11.23 " " "\\([-]?[0-9]+\\)" ;; 2006.11.23 (when nil "\n" ;; Allow VPST for LIA, too. ;;"[[]?" "\\([0-9]+\\)" "[]]?" "\\([^\n]+\\)" ) ))) ;; PG# 1333 ;; [4] (with-temp-buffer (_-ifcl arg1pf-log) ;; fix? ;; How does this work? Will log file have globals? ;; For globals, should log file have whole paragraph, not just 1st token? (_-find-file-hooks-__-globals nil (if (not (string-match "[.]log$" arg1pf-log)) t)) (goto-char (setq lb-lag (if (string= "top" _-where-page-numbers) (point-max) (point-min)))) (if (string= "top" _-where-page-numbers) (while (search-backward-regexp lb-re nil t) (setq lb-mstr1 (match-string 1)) (setq lb-mstr2 (match-string 2)) ;; (_-app 'lb-rc (list (cons ;; Either page from pg= or whole string. (if (string-match ;; 2007.03.04 ;; "pg=0*\\([0-9]+\\)" "pg=0*\\([-]?[0-9]+\\)" lb-mstr2) (match-string 1 lb-mstr2) lb-mstr2) (cons (string-to-int lb-mstr1) lb-lag) ))) (setq lb-lag (string-to-int lb-mstr1))) ;; fix! ;; duplicate code! except for direction of search and order of points. (while (search-forward-regexp lb-re nil t) (setq lb-mstr1 (match-string 1)) (setq lb-mstr2 (match-string 2)) ;; (_-app 'lb-rc (list (cons ;; Either page from pg= or whole string. (if (string-match ;; 2007.03.04 ;; "pg=0*\\([0-9]+\\)" "pg=0*\\([-]?[0-9]+\\)" lb-mstr2) (match-string 1 lb-mstr2) lb-mstr2) ;; 2006.04.17: Fixed: Reversed cons cell. (cons lb-lag (string-to-int lb-mstr1)) ))) (setq lb-lag (string-to-int lb-mstr1))) )) lb-rc)) (defun lb-tx-contextual-auto-edit (&optional arg1) "... Use carefully, because user must know what to exepect for end results! To insert page number and remove pair of

[POINT]

, place point on blank line. To remove pair and delete blank lines (instead of insert page number), move point after ''" ;; (interactive "*") (let (lb-rc lb-flag lb-pg (lb-pt (point))) (save-match-data (save-excursion (if (_-trailing-whitespacep 100 t) (error "%s: %s" "+/- 100 characters from here" "trailing whitespace")) ;; PRIORITY: HIGH. ;; Toss "^^" around "*" in a footnote. (when (and (not lb-flag) (progn (if (looking-at "[\n]+[ \t\n\r]*") (goto-char (match-end 0))) t) (progn (goto-char (car (_-where-double-newlines))) t) (looking-at "

[ \t\n\r]*\\([*]+\\)[ \t\n\r]*")) (replace-match (concat "

~^^" (match-string-no-properties 1) "^^\n\n")) (setq lb-flag "ADD-^^-IN-FOOTNOTE")) ;; Point before (bottom-of-page) page number and empty VPST. (when (and (not lb-flag) ;; Skip back over whitespace(s) since expecting ;; two newlines before page number. (progn (_-move-backward-whitespace) t) (looking-at (concat lb-re-bracketed-para-integer "\\(" "" "\\)"))) (replace-match "" nil nil nil 2) (setq lb-flag "VPST")) ;; Add page number when point inbetween two pages and ;; in middle of sentence (thus, delete "

" "

" pair). (when (and (not lb-flag) (save-excursion (forward-word -2) (looking-at (concat "[-.a-zA-Z]+[ \t\n\r]*

[ \t\n\r]*[\r]" "[\n][ \t]*[\n][ \t]*" "

")))) (save-excursion (search-backward-regexp lb-re-bracketed-para-integer) (setq lb-pg (match-string-no-properties 1))) (insert "\n\n" (format "%d" (1+ (string-to-int lb-pg))) "\n\n") (progn (search-backward "

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

") (replace-match "")) (setq lb-flag "MIDSENTENCE-MIDPAGE")) ;; Join two paragraphs w/ point after " ^M ;; ;; OPTIONAL: 123 ;; ;;

;; learned (when (and (not lb-flag) (save-excursion (forward-char -2) (looking-at (concat "\\(

\\)[ \t]*[\r][\n]" ;(1) "[ \t]*[\n]" "\\([ \t]*" ;(2) (_-del-parens lb-re-bracketed-integer) "[ \t\n\r]*\\)?" "[ \t]*\\(

\\)")))) ;(3) (setq lb-flag (match-string-no-properties 2)) (replace-match "" nil nil nil 3) (replace-match "" nil nil nil 1) ;; Delete blank line(s) if no page number. (when (not lb-flag) (search-forward-regexp "\n\\([ \t\n\r]+\\)") (replace-match "\n")) (setq lb-flag "JOIN-PARAGRAPHS")) ;; END. ) ;; Outside of save-excursion (but not save-match-data). (when lb-flag (if (string= lb-flag "VPST") ;; Move point forward to prepare for deleting "

". (forward-word 2)) (when (string= lb-flag "JOIN-PARAGRAPHS") ;; Move point to first word after page number. (search-forward-regexp "[a-zA-Z]") (goto-char (match-beginning 0))) (when (string= lb-flag "ADD-^^-IN-FOOTNOTE" ) (search-forward "*") (search-forward-regexp "\n[ \t\n\r]*")) (recenter) )) lb-rc)) ;; (setq x (lb-tx-get-__ "\\(ALPHA\\|NUMERIC\\)_LVL[12]")) ;; (lb-tx-get-__ "ALPHA_LVL[12]") (defun lb-tx-get-__ (arg1__ &optional arg2deltag) "Search buffer for regexp ARG1 and return list with paragraphs. ARG1 is tag name with or w/o '__' quotes" (let ( lb-rc) (if (not (string-match "__" arg1__)) (setq arg1__ (concat "__" arg1__ "__"))) (save-excursion (goto-char (point-min)) (while ;; (search-forward-regexp arg1__ nil t) (lb-db-__-search- "forward" arg1__) (_-app 'lb-rc ;; 2006.12.28 ;;(buffer-substring-no-properties ;; (car (setq x (_-where-double-newlines))) ;; (cdr x)) (car (_-para nil nil arg2deltag))))) lb-rc)) (defun lb-tx-view-__ (arg1) "???" (interactive "p") (let (lb-rc lb-tagname (lb-scratch "~/*scratch*")) (setq lb-tagname (read-input "__ tag name: ")) (if (file-exists-p lb-scratch) (delete-file lb-scratch)) (setq lb-rc (lb-tx-get-__ lb-tagname)) (find-file lb-scratch) (loop for i in lb-rc do (insert "\n\n" i "\n\n")) (_-compress-multiple-newlines) (delete-other-windows) (goto-char (point-min)) (not-modified))) ;; (tx-check-buffer-LVLs) (defun tx-check-buffer-LVLs (&optional arg1) "" ;; (interactive "p") ;;; CHECK FOR THIS KIND OF ORDER: ;;; ;;; 19 lines matching "_lvl" in buffer 099.tx. ;;; 167:__NUMERIC_LVL1__ ;;; 170:__ALPHA_LVL1__ ;;; 174:__NUMERIC_LVL2__ ;;; 177:__ALPHA_LVL2__ ;;; 181:__ALPHA_LVL3__ ;;; 318:__ALPHA_LVL3__ ;;; 549:__ALPHA_LVL3__ ;;; 554:

;;; 688:

;;; 728:

;;; 902:

;;; 977:__NUMERIC_LVL2__ ;;; 980:__ALPHA_LVL2__ ;;; 984:__ALPHA_LVL3__ ;;; 989:

;;; 1201:

;;; 1253:

;;; 1357:

;;; 1451:__ALPHA_LVL3__ (let (_msnp _list _str _line1a _line1b _this-alpha-lvl _rc) (save-excursion (save-match-data (goto-char (point-min)) (while (and (sfr lb-re-__-lvl-root nil t) (setq _msnp (match-string-no-properties 1))) (setq _line1a (_-current-line)) (save-excursion (forward-line 1) (setq _line1b (_-current-line))) (if (not (looking-at "[0-9]")) (error "%s: %s" "" "") (setq _this-alpha-lvl (string-to-int (match-string-no-properties 0)))) (when (and (string= "ALPHA" _msnp) (_-lvl-markup-p) (save-excursion (setq _list nil) (while (and (< (length _list) 3) (sfr lb-re-__-lvl-root nil t) (setq _msnp (match-string-no-properties 1))) (when (and (string= "ALPHA" _msnp) (_-lvl-markup-p) ;; 2007.11.10 ;;; "/home/ysverdlov/leninist.biz/en/1980/HORL354/20070408/199.tx" ;;; "__ALPHA_LVL2__" "[introduction.]" ;;; "

Daniel the Exile..." (not (_-sgml-markup-p)) (looking-at "[0-9]") (setq _msnp (match-string-no-properties 0))) (setq _list (append _list (list (list (string-to-int _msnp) (_-current-line) (save-excursion (forward-line 1) (_-current-line)))))))) ;; _list)) ;; In this pair, second ALPHA_LVL is down one level: (when (= (1+ _this-alpha-lvl) (nth 0 (nth 0 _list))) ;; If "looking at" last two ALPHA_LVLs in buffer, ;; last must be equal-to or less-than (higher) next-to-last. (if (and (save-excursion (sfs "__ALPHA_LVL0__" nil t)) (= 1 (length _list))) (error "%s: %s" (concat "Last ALPHA_LVL is down one level" "\n from next-to-last") (prin1-to-string _list))) ;; In 2nd pair (with overlap between pairs), ALPHA_LVLs not =: (when (and (nth 1 _list) (> (nth 0 (nth 1 _list)) (nth 0 (nth 0 _list)))) ;; (when (and (nth 2 _list) (not (and (> (length _list) 2) (= (nth 0 (nth 2 _list)) (nth 0 (nth 1 _list)))))) (setq _str nil) (loop for i in _list do (setq _str (concat _str "\n" (prin1-to-string i)))) (error "%s: %s" "Bad LVL logic" (concat "\n" _str "\n\n"))))))) )) _rc)) ;; (defun tx-check-buffer-noninteractive () "" ;; (let ( _rc) (when (bfn) (_-compress-multiple-newlines) (bsb)) ;; (when (= (point) (point-max)) (tx-check-buffer) (message "%s" "Running tx-check-buffer-noninteractive ... done.") ) _rc)) ;; (defun tx-check-buffer (&optional arg1pf) "An interactive function that can be called from within a tx file and from lb-ht-tenderize-tx / lb-tx-make-or-refresh-indextx . Took off 'lb-' prefix since this is for interactive use Sets lbg-str-time-stamps" (interactive) (_-dfun-hook "tx-check-buffer") (let ( ;; SEE: _-find-file-hooks-__-globals ;; SEE: tx-find-file-hooks ;; ( _orig-case-fold-search ;; Automatically becomes buffer-local when set in any fashion. ;; case-fold-search) _rc) ;; 2007.08.07 (when (bfn) (delete-other-windows) ;; 2007.11.02 (bsb)) ;; 2007.10.31 (save-buffer)) (unless (featurep 'lb-batch) (save-some-buffers)) (save-match-data (save-excursion ;; 2007.06.25 (lb-tx-globals) (progn ;; Delete trailing spaces. (goto-char (point-min)) (while (sfr "[ \t]+$" nil t) (replace-match ""))) ;; Uh, what does this do, again? ;;; no! ;;; inserts: ;;; ;;; (lb-pmm-transform-shadow-copies) ;; Emacs-Time-stamp: (progn (setq lbg-str-time-stamps nil) (goto-char (point-max)) (while (search-backward-string lb-str-emacs-time-stamp nil t) (setq lbg-str-time-stamps (append lbg-str-time-stamps (list (car (_-para t t))))))) ;; Check page sequence. ;; DISABLED: 2007.08.22: (lb-tx-count-pages) ;; (message "%s: %s" _defun "Page sequence checked.") ;; ;; 2007.07.05 ;; fix? How is this different from lb-tx-count-pages ? (lb-tx-check-page-numbers arg1pf) ;; 2007.09.27 (lb-tx-check-buffer4-para-break-before-last-line) (lb-tx-check-buffer4-trailing-dash) ;; Trailing space or tab? (goto-char (point-min)) (if (search-forward-regexp "[ \t]$" nil t) (error "%s: %s" "Trailing space or tab" (concat (if (bfn) (bfn) lbg-text-indextx) "\n" (_-current-line)))) (message "%s: %s" _defun "Trailing whitespace checked.") ;; 2007.07.05 ;; fix! Since this is also done by write hook, ;; stick in wrapper function and just call wrapper ;; function in write hook... and here! ;; For example: check-footnotes would NOT be in wrapper function. (lb-tx-check-buffer4-singularities) (message "%s: %s" _defun "Singularities checked.") ;; 2007.04.03 (lb-tx-check-control-M-aka-CR-aka-carriage-return) (message "%s: %s" _defun "Carriage returns checked.") ;; 2007.09.05 (tx-check-buffer-LVLs) (message "%s: %s" _defun "LVLs checked.") ;; LONG: MORE TOWARDS THE END: ;; Foonotes ;; 2006.10.16 (tx-check-footnotes nil t) (message "%s: %s" _defun "Footnotes checked.") ;; fix! ;; Run functions turned off by tx-editing-delete-hooks-early-on! (message "%s: %s" _defun "DONE.") )) _rc)) (defun lb-tx-check-TEMPLATE nil "" ;; (let (lb-str rc) (save-match-data (save-excursion )) _rc)) (defun lb-tx-check-control-M-aka-CR-aka-carriage-return nil "" ;; (let (lb-str lb-pt lb-rc) (save-match-data (save-excursion (goto-char (point-min)) (while (sfr "[\r]" nil t) ;; 2007.09.27 (if (looking-at (concat "\\([-][0-9]+\\)?" ;; 2007.11.10 "[ \t\n]*" "[\r]")) (error "%s: %s" (concat "On page " (lb-tx-what-page) ", found two CR in a row") (concat "\n\n" (_-buffer-substring-from-)))) (if (not (string= " " (buffer-substring (1- (1- (setq lb-pt (point)))) (1- lb-pt)))) (error "%s: %s" (concat "On page " (lb-tx-what-page) " missing space before CR") (_-buffer-substring-from-)))) )) lb-rc)) ;; (lb-tx-page-point-away-from-page-number) (defun lb-tx-page-point-away-from-page-number nil "Return char away from page number if point on blank line next to page number or on line with page number. Return char to left of whitespaces if page numbers ... Otherwise return nil" ;; ;; OLD DOCUMENTATION: If point next to page number, move away (skip ;; forward over whitespace if numbers at top; skip backward over ;; whitespace if numbers at bottom). Point should be inbetween ;; white-space inbetween page number and contents, and contents. (let (lb-beg lb-end lb-col lb-re lb-para-before lb-para-after lb-rc) (save-match-data (save-excursion ;; fix! next two should be a single function that flips. ;; AMBIGUITY when looking for 'page-beg' and page numbers at ;; bottom: If nothing after point and page numbers at bottom, point ;; is in whitespace at bottom of current page (underneath page ;; number), *not* whitespace at top of next page. (when (not (save-excursion (search-forward-regexp _-^whitespace-noM nil t))) (if (and (_-move-forward-whitespace) (not (_-blank-line-p))) (error "%s: %s" "Expecting blank line at bottom of file" (_-buffer-substring-from-))) ;; (lb-tx-para-move-back-and-skipover-re- nil) (if (string-match lb-re-bracketed-integer-anchored (_-normalize-whitespace (car (_-para t t)))) ;; fix! what if it isn't "top" or "bottom"? fix everywhere! (if (string= "top" _-where-page-numbers) (error "%s: %s" "Nothing AFTER LAST page number" (_-buffer-substring-from-)) ;; Jump back over page number (which is last paragraph). (forward-line -1)) ;; (if (string= "bottom" _-where-page-numbers) (error "%s: %s" "Expecting" (concat lb-re-bracketed-integer-anchored (_-buffer-substring-from-)))))) ;; AMBIGUITY: Same thing, other direction. (when (not (save-excursion (search-backward-regexp _-^whitespace-noM nil t))) (if (and (_-move-backward-whitespace) (not (_-blank-line-p))) (error "%s: %s" "Expecting blank line at top of file" (_-buffer-substring-from-))) ;; (_-move-forward-whitespace t) (if (string-match lb-re-bracketed-integer-anchored (_-normalize-whitespace (car (_-para t t)))) ;; fix! what if it isn't "top" or "bottom"? fix everywhere! (if (string= "bottom" _-where-page-numbers) (error "%s: %s" "Nothing BEFORE FIRST page number" (_-buffer-substring-from-)) ;; Jump forward over page number (which is first paragraph). (forward-line 1)) ;; (if (string= "top" _-where-page-numbers) (error "%s: %s" "Expecting" (concat lb-re-bracketed-integer-anchored (_-buffer-substring-from-)))))) ;; If point was at top of file and first paragraph is a ;; page number, point to left of page number... still not ;; really inside first page. ;; ;; If point was at bottom of file and last paragraph is a ;; page number, point to left of page number... great! it is ;; really inside last page. ;; Blank line. If either one of the above happened, not on blank. (when (_-blank-line-p) (save-excursion (setq lb-para-before (if (search-backward-regexp _-^whitespace-noM nil t) (_-normalize-whitespace (car (_-para t t)))))) (save-excursion (setq lb-para-after (if (search-forward-regexp _-^whitespace-noM nil t) (_-normalize-whitespace (car (_-para t t)))))) ;; ;; This detects empty pages where "THIS PAGE LEFT ;; INTENTIONALLY BLANK" rule broken. (if (and lb-para-before lb-para-after (string-match lb-re-bracketed-integer-anchored lb-para-before) (string-match lb-re-bracketed-integer-anchored lb-para-after)) (error "%s: %s" "Maybe insert '~' for page's contents?" (concat lb-para-before " <-> " lb-para-after))) ;; (if (and (string= "bottom" _-where-page-numbers) (string-match lb-re-bracketed-integer-anchored lb-para-after)) (setq lb-rc (progn (_-move-backward-whitespace) (point)))) ;; (if (and (string= "top" _-where-page-numbers) (string-match lb-re-bracketed-integer-anchored lb-para-before)) (setq lb-rc (progn (_-move-forward-whitespace) (point))))) ;; END when on a blank line. ;; Page number paragraph. (when (and (not (_-blank-line-p)) (string-match lb-re-bracketed-integer-anchored (_-normalize-whitespace (car (_-para t t)))) (progn (setq lb-beg (match-beginning 1)) (setq lb-end (match-end 1)) (setq lb-col (current-column)) (if (and (> lb-col lb-beg) (< lb-col lb-end)) (error "%s: %s" "Point in middle of page number > 9" (_-buffer-substring-from-))) t)) ;; Which way to move? (if (<= lb-col lb-beg) (progn (beginning-of-line) (_-move-backward-whitespace) (setq lb-rc (point))) (progn (end-of-line) (_-move-forward-whitespace) (setq lb-rc (point))))) )) lb-rc)) ;; (goto-char (lb-tx-page-point "page-beg")) ;; (goto-char (lb-tx-page-point "page-end")) ;; (goto-char (lb-tx-page-point "page-end-without-number")) ;; (goto-char (lb-tx-page-point "page-end-without-number" "__PRINTERS_")) ;; (goto-char (lb-tx-page-point "body-beg")) ;; (goto-char (lb-tx-page-point "footnotes-beg")) ;; (goto-char (lb-tx-page-point "footnotes-beg" t)) ;; (goto-char (lb-tx-page-point "body-end")) ;; (goto-char (lb-tx-page-point "footnotes-end")) (defun lb-tx-page-point (arg1which &optional arg2re_or_flag arg1noerror) "NEW THINKING: -beg point always at beginning of paragraph at top of region of interest. NEW THINKING: -end point always at beginning of first paragraph *after* region of interest. EXCEPTION: page-beg and page-end to left or right of page number. ( 2006.09.05 ) Return point of ARG1, one of double-quoted: 99 point of first non-whitespace on page 99 page-beg page-end page-end-without-number OPTIONAL ARG2 regexp body-beg body-end footnotes-beg OPTIONAL ARG2 insert-flag footnotes-end When ARG1 is 'page-end-without-number' ARG2 may be a regexp for skipping backwards over paragraphs that start with ARG2. So, return end of footnotes (or end of body if no footnotes) using: \"page-end-without-number\" \"__PRINTERS_\" When ARG1 is 'footnotes-beg' and ARG2 is non-nil, insert footnotes bar. Point returned includes as much whitespace as possible. For example, when page numbers are at top of page, 'page-beg' will not return point to left of page number; will return point to left of whitespace to left of page number. Use page number '[0]' to insert stuff before first page if page numbers at bottom of page. Returns a character position. May return nil if ARG1 is 'footnotes-beg', ARG2 is nil and a footnotes region does not exist. 'page-beg' will move to left of whitespace to left of page number N at top of page, then, 'page-end' will simply move forward over whitespace at bottom of page N-1 because point will be at end of last paragraph on page N-1. 'footnotes-beg' is to left of whitespace to left of footnotes boundary line" ;; (let (lb-pt lb-pt0 lb-pt-beg-page lb-re lb-re1 lb-str lb-cnt lb-cons lb-flag lb-end-global-maximum lb-rc) (save-match-data ;; Check where page numbers. ;; fix! Make this a global hook run every time editing happens. (if (or (not (boundp '_-where-page-numbers)) (null _-where-page-numbers) (string= "" _-where-page-numbers)) (_-find-file-hooks-__-globals)) (when (and (boundp '_-where-page-numbers) (or (string= "bottom" _-where-page-numbers) (string= "top" _-where-page-numbers))) (save-excursion ;; 2006.09.04 ;; Treat beginning of notes as page ending. (save-excursion (when (and (string-match "[-]end" arg1which) ;; fix! ;; Make %%it%% a variable. (search-forward-string "%%div-class-notes-start%%" nil t)) (beginning-of-line) ;; (_-move-backward-whitespace) (setq lb-end-global-maximum (point)))) ;; where-page-numbers? (if (and (not (string= "top" _-where-page-numbers)) (not (string= "" _-where-page-numbers)) ;; old .tx for LIA (not (string= "bottom" _-where-page-numbers))) (error "%s: %s" "Expecting _-where-page-numbers" (concat "top -OR- bottom" "\n\n" (_-buffer-substring-from-)))) ;; ARG2. (if (and arg2re_or_flag (not (or (string= arg1which "page-end-without-number") (string= arg1which "footnotes-beg")))) (error "%s: %s" "Optional regexp ARG2 only allowed with" (concat "page-end-without-number" " | footnotes-beg" ))) ;; Maybe move away from page number b/c search for page number ;; includes blank lines before and after. (if (and (not (string= "" _-where-page-numbers)) (setq lb-pt (lb-tx-page-point-away-from-page-number))) (goto-char lb-pt)) (case ;; outer (if nil 0 (if (string= arg1which "page-beg") 1 (if (string= arg1which "page-end") 1 (if (string= arg1which "page-end-without-number") 2 (if (string= arg1which "body-beg") 3 (if (string= arg1which "footnotes-beg") 4 (if (string= arg1which "body-end") 5 (if (string= arg1which "footnotes-end") 6 (error "%s" arg1which))))))))) (1 ;;arg1which "page-beg" ;;arg1which "page-end" ;; LENIN INTERNET ARCHIVE .tx files ONLY. ;; May need to set _-where-page-numbers to nil, or unbind it. (when nil ;; bye David (Walters, not Moros). 2007.01.10. (string= "" _-where-page-numbers) (if (string= arg1which "page-beg") (if (not (search-backward-regexp t2h-regexp-vpst nil t)) (if (not (search-forward-regexp t2h-regexp-vpst)) (error "%s: %s" t2h-regexp-vpst (_-buffer-substring-from-))))) (beginning-of-line)) (case ;; inner ;; Cases: Must find current page number to locate point. (if (and (string= arg1which "page-beg") (string= _-where-page-numbers "top")) 1 (if (and (string= arg1which "page-end") (string= _-where-page-numbers "bottom")) 2 ;; Cases: May not find current page number to locate point. (if (and (string= arg1which "page-beg") (string= _-where-page-numbers "bottom")) 3 (if (and (string= arg1which "page-end") (string= _-where-page-numbers "top")) 4)))) ;; 1 & 2 basically the same; "forward" and "backward" flip-flopped. (1 (if (search-backward-regexp lb-re-bracketed-para-integer nil t) (setq lb-rc (progn (goto-char (match-beginning 1)) (beginning-of-line) (point))) ;; Integer paragraph may be at top of buffer. (if (setq lb-pt (save-excursion (goto-char (point-min)) (_-move-forward-whitespace) (if (string-match lb-re-bracketed-integer-anchored (car (_-para t t))) (point)))) (setq lb-rc (goto-char lb-pt)) (if (not arg1noerror) (error "%s: %s" "Missing page number (1.1)" (concat "\n\n" (_-buffer-substring-from-))) ) ))) (2 (if (search-forward-regexp lb-re-bracketed-para-integer nil t) (setq lb-rc (progn (goto-char (match-end 1)) (end-of-line) (point))) ;; Integer paragraph may be at bottom of buffer. (if (setq lb-pt (save-excursion (goto-char (point-max)) (_-move-backward-whitespace) (if (string-match lb-re-bracketed-integer-anchored (car (_-para t t))) (point)))) (setq lb-rc (goto-char lb-pt)) (if (not arg1noerror) (error "%s: %s" "Missing page number (1.2)" (concat "\n\n" (_-buffer-substring-from-))) ) ))) (3 (if (search-backward-regexp lb-re-bracketed-para-integer nil t) (setq lb-rc (progn (goto-char (match-end 1)) (end-of-line) (point))) (setq lb-rc (goto-char (point-min))))) (4 (if (search-forward-regexp lb-re-bracketed-para-integer nil t) (setq lb-rc (progn (goto-char (match-beginning 1)) (beginning-of-line) (point))) (setq lb-rc (goto-char (point-max))))) ) ;; case ) ;; case (2 ;;arg1which "page-end-without-number" (when (setq lb-rc (lb-tx-page-point "page-end" nil arg1noerror)) (goto-char lb-rc) (when (string= "bottom" _-where-page-numbers) ;; Point to right, no wait, left, of page number. (beginning-of-line) (setq lb-rc (point))) (if (and arg2re_or_flag (setq lb-pt (save-excursion (lb-tx-para-move-back-and-skipover-re- arg2re_or_flag)))) (setq lb-rc (goto-char lb-pt))))) ;; ################################# ;; ################################# ;; The rest do not have to check for nil lb-rc before goto-char! ;; ################################# ;; ################################# (3 ;;arg1which "body-beg" (goto-char (lb-tx-page-point "page-beg")) ;; Move after page number if at top. (if (string= "top" _-where-page-numbers) ;; Point to left of page number (end-of-line)) (setq lb-rc (_-move-forward-whitespace)) ;; Move after running header. (when (looking-at "__RUNNING") (goto-char (cdr (_-where-double-newlines))) (setq lb-rc (_-move-forward-whitespace)))) (4 ;;arg1which "footnotes-beg" (setq lb-pt-beg-page (lb-tx-page-point "page-beg")) (goto-char (lb-tx-page-point "page-end-without-number" ;; 2007.06.20 "__PRINTERS_" "__\\(PRINTERS\\|PPPARAGRAPH\\)_" )) ;; fix? ;; Why the need to add footnotes region to page that has none? ;; Footnote region exists? (if (not (save-excursion (setq lb-rc (search-backward-regexp lb-re-footnote-div lb-pt-beg-page t)))) ;; Maybe insert footnotes bar. (when arg2re_or_flag ;; After insert, point will be at end of inserted text. (setq lb-rc (point)) ;; fix! ;; insert _-_-_ or _=_=_ ? (insert ;; "\n\n" lb-str-footnote-_-_-_ "\n\n" ;; "~" "\n\n" )) ;; Check ARG. (if arg2re_or_flag (error "%s: %s" "No-can-do" "_-_-_ bar already exists.")) (when nil ;; Check start of pre-existing first footnote. (goto-char lb-rc) (end-of-line) (_-move-forward-whitespace) (if (and (not (looking-at lb-re-footnote-continued)) (not (looking-at (setq lb-re (concat lb-re-footnote-start _-re-footnote-marker-global)))) ;; Footnote area may be empty. (looking-at (setq lb-re1 "[ \t\n\r]*[^ \t\n\r]")) ) (error "%s: %s" (concat "On page " (lb-tx-what-page) ", not looking-at one of") (concat "\n" lb-re-footnote-continued "\n\nOR\n\n" lb-re "\n\nOR\n\n" lb-re1 "\n" (_-buffer-substring-from-) )))) )) (5 ;;arg1which "body-end" (setq lb-rc (goto-char (or (lb-tx-page-point "footnotes-beg") (lb-tx-page-point "page-end-without-number" ;; 2007.06.20 "__PRINTERS_" "__\\(PRINTERS\\|PPPARAGRAPH\\)_" ))))) (6 ;;arg1which "footnotes-end" (if (not (lb-tx-page-point "footnotes-beg" nil arg1noerror)) (error "%s: %s" "Not found on this page" (concat "footnotes-beg" "\n\n" (_-buffer-substring-from-) ))) (setq lb-rc (goto-char (lb-tx-page-point "page-end-without-number" ;; 2007.06.20 "__PRINTERS_" "__\\(PRINTERS\\|PPPARAGRAPH\\)_" arg1noerror))) ) (t (error "%s: %s" "Not matched by case statement" arg1which))) ;; 2006.09.04 (if (and lb-end-global-maximum (> lb-rc lb-end-global-maximum)) (goto-char (setq lb-rc lb-end-global-maximum))) (when nil ;; 2006.09.05 (when (or (string-match "[-]end" arg1which) (string-match "[-]beg" arg1which)) ;; Should fix a bug where "__NOTE__" got appended to ;; previous paragraph. (if (_-move-forward-whitespace) (setq lb-rc (point)))) ) )) ;; 2007.07.12 - if -end, skip __ALPHA_LVL0__ (see register ?}) (when (and (string-match "-end" arg1which) lb-rc) (save-excursion (setq lb-flag nil) (goto-char lb-rc) (while (and (_-move-backward-whitespace) (or (string= "[END]" (car (setq lb-cons (_-para)))) (string-match "__ALPHA_LVL0__" (car lb-cons)))) (goto-char (setq lb-flag (car (cdr lb-cons))))) (when lb-flag (_-move-forward-whitespace) (setq lb-rc (point))))) ) lb-rc)) ;; (lb-tx-check-buffer4-para-break-before-last-line) (defun lb-tx-check-buffer4-para-break-before-last-line nil "Check for paragraph break between last and next-to-last line" ;; (let (_para-prev msnp-0 msnp-1 msnp-2 _rc) (save-match-data (save-excursion (when (not (tx-first-draft-p)) (goto-char (point-min)) (while (and (search-forward-regexp "\\([a-zA-Z]\\)

[ \r]*\n\n

\n\\([a-zA-Z]\\)" nil t) (setq msnp-0 (match-string-no-properties 0)) (setq msnp-1 (match-string-no-properties 1)) (setq msnp-2 (match-string-no-properties 2))) (save-excursion (goto-char (match-beginning 0)) (setq _para-prev (car (_-para)))) (if (and ;; letter before

is lowercase. (not (string= msnp-1 (upcase msnp-1))) ;; letter after

is lowercase. (or (not (string= msnp-2 (upcase msnp-2))) ;; ... or uppercase. t) (not (string-match "class=\"legal_article\"" _para-prev)) ) (error "%s: %s" (concat "Page " (lb-tx-what-page) " has extra para break?") msnp-0)))))) _rc)) (defun lb-tx-check-buffer4-singularities nil "" ;; (let ( _rc) (save-match-data (save-excursion ;; 2007.04.13 (goto-char (point-min)) (when (sfr (concat "\\(" "•" "\\)") nil t) (error "%s: %s" "Numeric entity 8226" (_-buffer-substring-from-))) ;; 2007.04.06 ;; Uppercase superscripts? See lb-abbyycln. (when (not (tx-first-draft-p)) (goto-char (point-min)) (setq case-fold-search nil) (when (sfr "" nil t) (occur "") (error "%s: %s" "Uppercase superscript" (_-buffer-substring-from-))) (setq case-fold-search _orig-case-fold-search)) )) _rc)) (defun lb-tx-check-buffer4-trailing-dash nil "Check for single trailing dash before carriage return. No arguments" ;; (let (_buffer _re _rc) (save-excursion (save-match-data (when (and (if (not (boundp 'TRIGGER-lb-tx-check-buffer4-trailing-dash)) t (if (not (_-timestamp)) t (string< TRIGGER-lb-tx-check-buffer4-trailing-dash (_-timestamp)))) ;; fix? This is a global variable? tx) (if (setq _buffer (get-buffer "*Occur*")) (kill-buffer _buffer)) ;; fix documentation. How does this work? (goto-char (point-min)) (when (and (sfr (setq _re "[^-][-][ ]*[\r]") nil t) ;; 2007.10.08 (not (looking-at (concat "[-]0" _-whitespace-noM)))) ;; 2007.07.11 (occur _re) (error "%s: %s" "Before carriage return, found single hyphen" (_-buffer-substring-from-))) ) )) _rc)) ;; (defun lb-tx-move-away-from-page-number-paragraph nil "Moves point away from a paragraph that is a page number. Moves backwards or forwards over whitespace depending on value of _-where-page-numbers. Useful if page numbers at top of file and point is in paragraph with first page number" ;; (let ( _rc) (if (tx-page-number-p) (goto-char (sex (if (string= "top" _-where-page-numbers) (end-of-line) (if (string= "bottom" _-where-page-numbers) (beginning-of-line) (error "%s: %s" "Expecting _-where-page-numbers" "'bottom' or 'top'"))) (if (string= "top" _-where-page-numbers) (_-move-forward-whitespace t) (if (string= "bottom" _-where-page-numbers) (_-move-backward-whitespace t))) (point)))) _rc)) ;; (defun lb-tx-check-^^-get-list-and-check (arg1style) "Called once by lb-tx-check-^^. If both * and 0-9 footnotes co-exist, called twice" ;; (let (lb-list lb-half lb-str lb-n lb-n-other lb-beg lb-end lb-page-end lb-pg (lb-offset 0) (lb-pt (point)) _rc) (save-match-data (save-excursion ;; 2007.07.31 (lb-tx-move-away-from-page-number-paragraph) (lb-ht-insert-^^-around-footnotes-asteriks) (progn (setq lb-pg (lb-tx-what-page)) (setq lb-page-end (lb-tx-page-point "page-end")) (goto-char (lb-tx-page-point "page-beg"))) (while (and (search-forward-regexp (concat "\\^\\^" arg1style "\\^\\^") lb-page-end t) (or (setq lb-beg (match-beginning 0)) t) (setq lb-list (append lb-list (list (match-string-no-properties 0))))) ;; 2007.05.10 (if (string= "" (buffer-substring-no-properties (- lb-beg (length "")) lb-beg)) (error "%s: %s" (concat "Open emphasis before marker on page " (lb-tx-what-page)) (_-buffer-substring-from-))) ) ;; (when lb-list (if (oddp (length lb-list)) (error "%s: %s" (concat "Page " lb-pg "," " odd number of items" (prin1-to-string lb-list)) (_-buffer-substring-from-))) (setq lb-half (/ (length lb-list) 2)) ;; What this? (loop for i from 0 to (1- lb-half) do (if (not (string= (nth i lb-list) (nth (+ i lb-half) lb-list))) (error "%s: %s" (concat "Mismatch" (prin1-to-string lb-list)) (_-buffer-substring-from-))) ) ;; Check sequence. (loop for i from 0 to (1- (length lb-list)) do (setq lb-n (_-string-to-int (setq lb-str (nth i lb-list)))) ;; If "***" convert to 3. (if (not (integerp lb-n)) (if (not (string-match "^^^[*)]+^^$" lb-str)) (error "%s: %s" "Not ^^999^^ nor ^^***)^^" lb-str) ;; Changed mind! ;; Do *NOT* convert "***..." to integer. (when nil (setq lb-n (- (length lb-str) (if (string-match "[)]" lb-str) 5 4)))) ;; WHEN. )) (cond ((or (string= arg1style lb-re-footnote-marker-style-*) (string= arg1style lb-re-footnote-marker-style-*-paren)) ;; If past the half-way mark, these should be anchors ;; in footnotes area. (when (> lb-offset 0) (if (not (string= (nth (- i 0 ) lb-list) (nth (- i lb-offset) lb-list))) (error "%s: %s" (concat "Out of order" (prin1-to-string lb-list)) (_-buffer-substring-from-)))) ) ;; * ((string= arg1style lb-re-footnote-marker-style-9) ;; Set using (unless (and (boundp '_-footnote-marker-sequence) (string= "continuous" _-footnote-marker-sequence)) (if (/= (1+ (- i lb-offset)) lb-n) (error "%s: %s" (concat "Out of order" (prin1-to-string lb-list)) (_-buffer-substring-from-)))) ) ;; 0-9 ((string= arg1style lb-re-footnote-marker-style-both) (error "%s: %s" "How to check sequence?" arg1style)) ) ;; cond (if (= (1+ i) lb-half) (setq lb-offset lb-half)) ) ;; loop ;; Look for "_-_-_" (goto-char (lb-tx-page-point "page-beg")) (setq lb-beg (search-forward (nth (1- lb-half) lb-list))) (setq lb-end (search-forward (car lb-list))) (if (not (search-backward-regexp lb-re-footnote-div lb-beg t)) (error "%s: %s" (concat "Missing" lb-re-footnote-div) (_-buffer-substring-from-)))))) _rc)) (defun lb-tx-check-^^ (&optional arg1not-interactive arg2pg-para) "Check for matching footnote anchors on current page. ARG1, if non-nil, supresses tx-editing-insert-_-_-_ when this called from tx-check-footnotes when that called from lb-ht-refresh-indextx . ARG2 is an optional page-paragraph from search immediately before calling this function" ;; (let ( _rc) (save-match-data ;; Suppress action if editing 2-page .tx files for /lenin/. (when ;; fix! make _-footnote-marker-style buffer-local. How? ;; This sets _-footnote-marker-style (and (_-find-file-hooks-__-globals nil t) (boundp '_-footnote-marker-style)) ;; fix! ;; Separate function to check _-footnote-marker-style. ;; AND just accept all defvar's starting ``lb-re-footnote-marker-style-'' ;; If just above first footnote, try to insert divider. (if (not arg1not-interactive) (setq _rc (tx-editing-insert-_-_-_))) ;; SEE ALSO second "(cond" below for checking sequence. (cond ((or (string= _-footnote-marker-style lb-re-footnote-marker-style-*) (string= _-footnote-marker-style lb-re-footnote-marker-style-*-paren)) ;; (lb-tx-check-^^-get-list-and-check _-footnote-marker-style) ) ((string= _-footnote-marker-style lb-re-footnote-marker-style-9) (lb-tx-check-^^-get-list-and-check _-footnote-marker-style) ) ;; 2006.11.16 ((string= _-footnote-marker-style lb-re-footnote-marker-style-both) (lb-tx-check-^^-get-list-and-check ;; _-footnote-marker-style lb-re-footnote-marker-style-* ) (lb-tx-check-^^-get-list-and-check ;; _-footnote-marker-style lb-re-footnote-marker-style-9 )) ;; 2006.12.22 ((string= _-footnote-marker-style lb-re-footnote-marker-style-nil) nil) (t (error "%s: %s" "Invalid" "_-footnote-marker-style"))) ) ;; when (if _rc (recenter)) ) _rc)) (defun lb-tx-para-if-not-inside-move-forward-to-start nil "If point on blank line or to left of whitespace on first line, move to first non-whitespace character in paragraph" ;; (let (lb-rc) ;; If at end of last line of paragraph, stay put. (if (save-excursion (beginning-of-line) (looking-at "[ \t]*[\n]")) ;; If in blank line, move forward. (search-forward-regexp "[ \t\n\r]+")) (if (looking-at "[ \t]*[^ \t\n\r]") (goto-char (match-end 0))) lb-rc)) ;; (lb-tx-para-move-back-and-skipover-re- "__PRINTERS_") ;; (lb-tx-para-move-back-and-skipover-re- "__\\(PRINTERS\\|PPPARAGRAPH\\)_") (defun lb-tx-para-move-back-and-skipover-re- (&optional arg1re) "Search backward for first alpha; move to beginning of paragraph; repeat if looking at ARG1. Returns point of last skipped-over ARG1, otherwise returns nil" ;; (let (lb-rc) ;; (lb-tx-para-if-not-inside-move-forward-to-start) (_-move-backward-whitespace) (while (and (progn (search-backward-regexp "[^ \t\n\r]") t) (progn (goto-char (car (_-where-double-newlines))) t) ;; fix! ;; Allow a list of expressions; loop over inside an "or". (if (not arg1re) nil (looking-at arg1re)) ;; (setq lb-rc (point)))) lb-rc)) ;; (lb-tx-footnote-end) (defun lb-tx-footnote-end nil "Return end-point of footnote when point at beginning of footnote text. End of current footnote is either beginning of next footnote or end of page contents; if the later, may not be true end-of-footnote if it continues on next page. Returns a cons cell where car is endpoint and cdr is either nil or page number from __NOTE__ paragraph if footnote ends with a lb-re-footnote-continued of type 'continued on' or error if not of that type" ;; (let (lb-rc lb-pt lb-str) (save-match-data (save-excursion ;; fix? ;; Inspect here? ;; Simply do 'looking-at' from current point? ;; When would point have to move from non-first footnote to first? ;; Move past footnote marker of this footnote before searching ;; for marker of next footnote. ;; fix? ;; Assume not looking at whitespace? (_-move-forward-whitespace) ;; fix? ;; Test whether at beginning of footnote or a continuation? ;; Move into body of current footnote. ;; fix? error if not looking-at? (if (looking-at (concat lb-re-footnote-start _-re-footnote-marker-global)) (goto-char (match-end 0))) ;; 2006.09.04 (setq lb-pt-page-end (lb-tx-page-point "page-end")) (if (>= (point) lb-pt-page-end) ;; Could be at %%div-class-notes-start%% ! ;; 2008.04.26 - oh, really? ;; 2008.05.13 - yes, really. ;; ;; (error "%s: %s" "Wrong side of point" ;; (concat "\n" (_-buffer-substring-from-)))) (setq lb-rc (point)) (if (search-forward-regexp (concat lb-re-footnote-start _-re-footnote-marker-global) lb-pt-page-end t) ;; Easy case: there's another footnote on this page. (setq lb-rc (match-beginning 0)) ;; When no other footnote, return end of page contents. (setq lb-rc (lb-tx-page-point "page-end-without-number" ;; 2007.06.20 - "__PRINTERS_" "__\\(PRINTERS\\|PPPARAGRAPH\\)_" ) ))) ;; Does this footnote continue on next page? ;; __NOTE__ may be before a __PRINTERS_P_999_COMMENT__ ! (if (null lb-rc) (error "%s: %s" "lb-rc is null" (_-buffer-substring-from-))) (goto-char lb-rc) (lb-tx-para-move-back-and-skipover-re- nil) (setq lb-rc (cons lb-rc (if (looking-at lb-re-footnote-continued) (if (not (string= ;; "on" - 2008.04.26 "on" (setq lb-str (match-string-no-properties 2)))) (error "%s: %s" (concat "Got '" lb-str "'" " but expecting 'on' variation of" lb-re-footnote-continued) (_-buffer-substring-from-)) (match-string-no-properties 3))))))) lb-rc)) ;; (lb-tx-goto-page 12) (defun lb-tx-goto-page (arg1pg &optional arg2flag-insert) "Move to page ARG1 (string or integer) and return integer ARG1 if successful. Optional ARG2, if non-nil, inserts page ARG1 if highest existing page number is (1- ARG1). If not, an error occurs" ;; (let (lb-re lb-str lb-current-page lb-pt-moved lb-rc) (if (stringp arg1pg) (setq arg1pg (string-to-int arg1pg))) (save-match-data (goto-char (point-min)) (progn (string-match "[[]0[-]9[]][+]" lb-re-bracketed-para-integer) (setq lb-re (replace-match (int-to-string arg1pg) nil nil lb-re-bracketed-para-integer))) ;; Have page already? (if (search-forward-regexp lb-re nil t) (progn ;; Found a page number paragraph (not at top of buffer). (if (string= "bottom" _-where-page-numbers) (goto-char (match-beginning 0)) (goto-char (match-end 0))) ;;(goto-char (lb-tx-page-point "page-beg")) (setq lb-rc arg1pg)) ;; Not found, but could be at top of buffer. (_-move-forward-whitespace) (if (and (string-match lb-re-bracketed-integer-anchored (setq lb-str (car (_-para)))) (= arg1pg (string-to-int (match-string-no-properties 1 lb-str)))) (progn ;; Page number is at top of file. (end-of-line) (_-move-forward-whitespace) (setq lb-rc arg1pg)) ;; Did not find page ANYWHERE. (when arg2flag-insert ;;; ;; 2006.10.02 ;;; ;; Not returning nil if page not found. ;;; ;; Return nil if page not found! ;;; ;;; (error "%s: %s" "Did not find page" ;;; (concat lb-re ;;; "\n" (_-buffer-substring-from-))) ;; Add page. ;; If preceding page does not exist, ERROR. (if (not (lb-tx-goto-page (1- arg1pg))) (error "%s: %s" (concat "Trying to insert page " (int-to-string arg1pg)) (concat "did not find page " (int-to-string (1- arg1pg))))) ;; Move to end of preceding page. (goto-char (lb-tx-page-point "page-end")) (if (string= "bottom" _-where-page-numbers) ;; Insert page when page numbers at top. (insert "\n\n~\n\n" (int-to-string arg1pg) "\n\n") (if (string= "top" _-where-page-numbers) ;; Insert page when page numbers at bottom. (insert "\n\n" (int-to-string arg1pg) "\n\n~\n\n") (error "%s" "%s"))) ;; (search-backward "~") (setq lb-rc arg1pg) ) ;; Done adding page ) ) ;; 2006.10.02 ;; (setq lb-rc arg1pg) ) lb-rc)) ;; (lb-tx-check-page-numbers-editing) (defun lb-tx-check-page-numbers-editing nil " Check page numbers if point is at least 95% into buffer" ;; (if (> (* 100 (/ (+ 0.0 (point)) (point-max))) 94.999) (lb-tx-check-page-numbers))) ;; (lb-tx-check-page-numbers) (defun lb-tx-check-page-numbers (&optional arg1pf) "" ;; (interactive "p") (let (lb-n lb-re lb-n-lag lb-n-str lb-n-str-lag _while-loop-init-flag _while-loop-re lb-pt-while-search lb-pt-while-search-lag lb-rc) ;; fix! 2007.11.08 - a. look for "0" .. error. ;; fix! 2007.11.08 - b. look for "1" ;; fix! 2007.11.08 - c1. search backward for non-roman numeral pg#. ;; fix! 2007.11.08 - c2. search forward for roman numeral pg#. ;; fix! 2007.11.08 - d1. search backward and check roman numeral pg#. ;; fix! 2007.11.08 - d2. search forward and check non-roman numeral pg#. (save-match-data (save-excursion (_-compress-multiple-newlines) ;; Check page number at top or bottom. (cond ((string= "top" _-where-page-numbers) (goto-char (point-min)) (setq _while-loop-re lb-re-bracketed-para-integer-top-of-file)) ;; ((string= "bottom" _-where-page-numbers) (goto-char (point-max)) (_-move-backward-whitespace t) (goto-char (car (cdr (_-para)))) (_-move-backward-whitespace nil) (setq _while-loop-re lb-re-bracketed-para-integer))) ;; (if (not (looking-at _while-loop-re)) (error "%s: %s" (concat "Expected PG# at " _-where-page-numbers "-of-file") (_-buffer-substring-from-))) (goto-char (point-min)) (while (and ;; while ;; Tricky! Two page numbers adjacent to one another. (progn (_-move-backward-whitespace) t) ;;; "/home/ysverdlov/leninist.biz/en/1972/LBI363/20060307/299.tx" ;;;

~^^1^^ The Road to Communism, Moscow, 1961, pp. 501--02.

;;; ;;; 298 ;;; ;;; I ;;; ;;; same functions of deceiving men and keeping their minds ;; (sfr _while-loop-re nil t) ;; Lags. (progn ;; 2007.08.19 (setq lb-pt-while-search-lag lb-pt-while-search) (setq lb-pt-while-search (match-beginning 0)) (setq lb-n-str-lag lb-n-str) (setq lb-n-str (match-string 1)) (setq lb-n-lag lb-n) (setq lb-n (string-to-int lb-n-str)) ;; (string-to-int "I") _> 0 ;; (string-to-int "[I]") _> 0 t)) ;; Disallow page-number string "0". (if (string= "0" lb-n-str) (error "%s: %s" "Page number 0 not allowed" (_-buffer-substring-from-))) ;; ;; First iteration. (when (and (not _while-loop-init-flag) (setq _while-loop-init-flag t)) (setq _while-loop-re lb-re-bracketed-para-integer) ;; Top of 999.tx file? Top of index.tx file? ;; fix! if 999.tx file, first page must be one-greater-than ;; number 998.tx if there is a preceding tx file. (if (and ;; First page must end with "1" or "...01" if lb-n GT 0. (and (> lb-n 1) (not (string-match "^[1-9][0][1]$" lb-n-str))) ;; (when nil ;; 2007.07.10 - ... or be negative. ;; "en/2000/WIE126/20070501/099.tx" (>= lb-n 0)) ;; ;; 2007.07.16 (when nil ;; fix? when would previous .tx be a single-page file?!?!?! (not (file-exists-p (concat (file-name-directory (bfn)) (int-to-string (1- (string-to-int lb-n-str))) "." lb-ext-tx)))) ;; ;; 2007.08.01 - first PG# is not used in buffer's filename. (not (string-match (concat "/" (format "%03d" lb-n) "." lb-ext-tx "$") (bfn)))) ;; (error "%s: %s" "PG# must end with '0' or '1'" ;; lb-n-str (_-buffer-substring-from-)))) ;; Disallow Roman numeral pages after first non-Roman numeral page. ;; fix! 0 page already not allowed. (if (and lb-n-lag (= 0 lb-n) (not (= 0 lb-n-lag))) (error "%s: %s" "Found random Roman-numeral page number" (_-buffer-substring-from-))) ;; Skip check of Roman numeral page numbers that are integer 0. ;; fix! 0 page already not allowed. (when (and lb-n-lag ;; 2007.08.16 (not (= 0 lb-n)) (not (= 0 lb-n-lag)) ;; 2007.08.15 - NO ZERO: ...-3 -2 -1 1 2 3... (not (and (= 1 lb-n) (= -1 lb-n-lag)))) (if (and (not (= (1+ lb-n-lag) lb-n)) ;; 2007.08.19 - if "__CUT_" in index.tx* after previous PG#. (not (and (string-match "/index[.]tx" (if arg1pf arg1pf (bfn))) (sex (sbs "__CUT_" lb-pt-while-search-lag t))))) ;; 2008.05.13 - fix? if directory listing changed due to, ;; say, moving (or renaming) 299.tx when 199.tx has ;; __ALPHA_LVL0__ (for incremental processing), count that ;; move or rename as an edit and delete index.txt/.tx ? (error "%s: %s" (concat "Page " lb-n-str " not numbered continuously") (_-buffer-substring-from-)))) ) ;while )) lb-rc)) (defun lb-tx-zap-paragraphs (arg1re &optional arg2insert) "Delete paragraphs containing regexp ARG1" ;; (let (lb-cons-wdn lb-rc) (goto-char (point-min)) (while (search-forward-regexp arg1re nil t) (setq lb-cons-wdn (_-where-double-newlines)) (goto-char (car lb-cons-wdn)) (delete-region (car lb-cons-wdn) (cdr lb-cons-wdn)) ;; 2008.05.25 (when arg2insert (insert arg2insert))) lb-rc)) ;; (lb-tx-what-page) (defun lb-tx-what-page (&optional arg1noerror) " Optional ARG1, if non-nil, will suppress error if page boundary not found" ;; (let (lb-pt lb-rc) (save-match-data (save-excursion (setq lb-pt (if (string= "top" _-where-page-numbers) (lb-tx-page-point "page-beg" nil arg1noerror) (lb-tx-page-point "page-end-without-number" nil arg1noerror))) (if (not lb-pt) (if (not arg1noerror) (error "%s: %s" "Cannot move to point" "nil")) (goto-char lb-pt) (if (search-forward-regexp lb-re-bracketed-integer nil t) (setq lb-rc (match-string 1))))) )lb-rc)) ;; (lb-tx-count-pages) (defun lb-tx-count-pages (&optional arg1) "Count pages in current .tx buffer." ;; (interactive "p") ;; arg1 is 1 when: M-x lb-tx-count-pages ;; arg1 is nil when: (lb-tx-count-pages) (let (lb-page lb-para lb-page-lag lb-para-lag lb-pages lb-pt lb-bound) (save-excursion ;; Ignore pages not part of book, e.g., "REQUEST TO READERS". (progn (goto-char (point-max)) (setq lb-bound (if (search-backward "__ALPHA_LVL0__" nil t) (point) (point-max)))) (goto-char (point-min)) (while (search-forward-regexp lb-re-bracketed-para-integer lb-bound t) (setq lb-para (match-string-no-properties 0)) (setq lb-page (match-string-no-properties 1)) ;; Skip pages before 1. (when (> (string-to-int lb-page) 0) ;; fix! What if NUM changes? (setq lb-pages (append lb-pages (list lb-page))) (if lb-page-lag (if (/= (1- (_-string-to-int lb-page)) (_-string-to-int lb-page-lag)) (if t t ;; DISABLED - 2007.08.22 - see: lb-tx-check-page-numbers (error "%s: %s" "Break in page sequence" (concat lb-page-lag " ???? " lb-page "\n" (_-buffer-substring-from-) ))) )) (search-backward-regexp "[^ \t\n]") ;; CASE: [1]\n\n[2] (setq lb-para-lag lb-para) (setq lb-page-lag lb-page)))) (message (concat "Pages in buffer: " (int-to-string (length lb-pages)) " (" (car lb-pages) " to " (nth (1- (length lb-pages)) lb-pages) ")")) (cons (length lb-pages) lb-pages))) (defun lb-tx-shell-find (arg1subpath) "Find .tx files" ;; BEFORE ;; (lb-tx-shell-find "en/1984/AP470") => [sorted list of .tx files] ;; AFTER ;; (lb-tx-shell-find "en/1984/AP470") => ("~/leninist.biz/en/1984/AP470/text") (let (lb-pf lb-list _rc) (if (< 1 (length (setq lb-list (lb-ht-get-copy-directories arg1subpath)))) (error "%s: %s" "More than one copy" (prin1-to-string lb-list)) (setq lb-pf (car lb-list))) ;; BEFORE: (when nil (with-temp-buffer (shell-command (concat "find " lb-pf " -follow -type f -name '[0-9][0-9][0-9].tx'") t) (shell-command (concat "find " lb-pf " -follow -type f -name '[0-9][0-9][0-9][0-9].tx'") t) (sort-lines nil (point-min) (point-max)) (_-something-to-list))) ;; AFTER: (when t (setq lb-pf (concat lb-home arg1subpath "/" lb-file-tx)) (setq _rc (list lb-pf))) _rc)) (defun _-goto-beginning-of-paragraph (&optional arg1end-trim) " SEE: _-goto--of-paragraph - while on blank line, moves forward whitespace" (interactive) (_-goto--of-paragraph "b" arg1end-trim)) ;;; (defun _-goto-end-of-paragraph (&optional arg1end-trim arg2end-trim-confirm) " SEE: _-goto--of-paragraph - while on blank line, moves FORWARD whitespace" (interactive) (if (and (not arg1end-trim) ;; ARG1 not 't', which is very exceptional (not arg2end-trim-confirm) ;; if ARG1 is nil, this MUST be 't' ) (error "%s: %s" "ARG1 is nil" "ARG2 must be non-nil to confirm that an ending ^M is text")) (if (and arg1end-trim ;; ARG1 't', meaning ignore ^M at end. arg2end-trim-confirm ;; if ARG1 is t, this MUST NOT be 't' ) (error "%s: %s" "ARG1 is non-nil" "ARG2 should only be non-nil when ARG1 is non-nil")) (_-goto--of-paragraph "e" arg1end-trim)) ;;; (defun _-goto--of-paragraph (arg1where &optional arg2-b-or-e-trim) "ARG1 is 'b' for beg or 'e' for end." (let (_rc) (save-match-data ;; Assume forward editing. (while (_-blank-line-p) (_-move-forward-whitespace)) (goto-char (cond ((string= "b" arg1where) (car (_-where-double-newlines arg2-b-or-e-trim nil))) ((string= "e" arg1where) (cdr (_-where-double-newlines nil arg2-b-or-e-trim))) (t (error "%s" "%s")))) )_rc)) ;; (tx-move-forward-past-pound-comment-lines) (defun tx-move-forward-past-pound-comment-lines (&optional arg1) "" (let (_line _array _element _flag _rc) (while (and (and (setq _line (_-current-line)) (setq _array (split-string _line "[\t]"))) (or ;; fix! need a function to detect comment lines. ;; No tab. (string-match (concat "^" _-whitespace-noM "*" "#") _line) (progn (setq _flag nil) (loop for i from 0 to 1 do (setq _element (nth i _array)) (if (or (string-match (concat "^" _-whitespace-noM "*" "#") _element) (string-match (concat "#" _-whitespace-noM "*" "$") _element)) (setq _flag t))) _flag))) (forward-line 1)) _rc)) (defun tx-ls-lR-to-tabbed (arg1) "" ;; (interactive "p") (let ( _pt-beg ;;(_user "r c y m b a l a") (_user "r") _rc) (while (sfr "^[-]" nil t) ;; Use "-" as prefix for sorting. ;; (beginning-of-line) (setq _pt-beg (point)) (sfs (concat _user " ")) (sfs (concat _user " ")) (_-move-forward-whitespace) (if (not (looking-at "[0-9]")) (error "%s" "error") (delete-region _pt-beg (point))) (sfr "[0-9]+") ;; day (if (looking-at " +[^ ]+") (replace-match "")) ;; time (if (looking-at " +[^ ]+") (replace-match "")) ;; Two fields: OK if input is "ls -lR" from lftp. ;; Three fields: "ls -lR" on IBM 770e. (if (or (looking-at "\\( +[12][0-9][0-9][0-9]\\) ") (looking-at "\\( +[012][0-9][:][0-9][0-9]\\) ")) (replace-match "" nil nil nil 1)) (if (looking-at " +") (replace-match "_")) ) _rc)) (provide 'lb-tx) ;;; ;