;; Variables.
;; Emacs-Time-stamp: "2010-02-05 18:30:33"
(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"
(number-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-number (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-number 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)
(save-match-data ;; 2009.07.22
(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))))
;; (lb-gender-search)
(defun lb-gender-search nil
""
;;
(let (_rc _pt0 _pt1)
(save-excursion
(save-match-data
(while (and (not _rc)
(sfr "\\$+" nil t)
(setq _pt0 (match-beginning 0)))
(when (and (looking-at "[a-z]+\\$+")
(setq _rc (concat
(buffer-substring-no-properties _pt0 (point))
(match-string-no-properties 0)))
(setq _pt1 (point)))
;;
;; Stuff after the $WORD$
(goto-char (match-end 0))
(if (looking-at "[a-z]+[=+]")
(setq _rc (concat _rc (match-string-no-properties 0))))
;;
;; Stuff before the $WORD$
(goto-char _pt0)
(and (looking-at-backward-become-forward "[=+][a-z]+")
(setq _rc (concat (match-string-no-properties 0) _rc)))
(setq _pt (point))))))
;;
(if _rc (goto-char _pt))
_rc))
;; (lb-gender-newstring (lb-gender-search))
(defun lb-gender-newstring (arg1str)
""
;;
(let (_prefix _suffix
(_re-middle (concat "[$]+" "\\([^$]+\\)" "[$]+"))
_rc)
(save-match-data
(if (not (string-match _re-middle arg1str))
(error "%s: %s" "Not found" _re-middle)
(setq _rc (match-string-no-properties 1 arg1str))
(setq _prefix (substring arg1str 0 (match-beginning 0)))
(setq _suffix (substring arg1str (match-end 0))))
;;
(if (and (string-match "=" _prefix)
(string-match "=" _suffix)) (error "%s: %s" "err" "err"))
;;
(when (not (string= "" _prefix))
(if (string-match "^=" _prefix)
(setq _rc (substring _prefix 1))
(if (string-match "^[+]" _prefix)
(setq _rc (concat (substring _prefix 1)
;; Maybe make "root" lowercase.
(downcase _rc)))
(error "%s: %s" "err" "err"))))
;;
(when (not (string= "" _suffix))
(if (string-match "=$" _suffix)
(setq _rc
(substring _suffix 0 (1- (length _suffix))))
(if (string-match "[+]$" _suffix)
(setq _rc
(concat _rc (substring _suffix 0 (1- (length _suffix)))))
(error "%s: %s" "err" "err"))))
)
_rc))
;; (lb-gender-changer)
(defun lb-gender-changer ()
""
;;
(let (_str _pt
_rc)
(save-match-data
(save-excursion
(goto-char (point-min))
(while (setq _str (lb-gender-search))
(delete-region (setq _pt (point)) (+ _pt (length _str)))
(insert (lb-gender-newstring _str)))))
_rc))
(provide 'lb-model)
;;;
;