;;; Emacs-Time-stamp: "2006-12-15 23:06:51"
;;; Emacs-File-stamp: "/home/ysverdlov/leninist.biz/abbyycln.el"

;; TO-DO:   History </em>for

;; TO-DO:   were  distributed   as   a

;; TO-DO:   Do not ^^1^^ ones like km<sup>2</sup>  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<p>[ ]*\n"
		  "\\(<b>\\)?"
		  "\\([0-9]+\\)"
		  " 
 "
		  "\\(<b>\\)?"
		  "TO "
		  "\\([- A-Z]+\\)"
		  "\\(</b>\\)?"
		  "</p> 
[ ]*\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 'my-tag-word-em
   [?< ?e ?m ?> C-right ?< ?/ ?e ?m ?>])

(defun my-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 "<em>")
	(goto-char t2h-point)

	(progn (while (and (search-backward-regexp "[a-zA-Z]") 
		    (_-sgml-markup-p)))
	       (forward-char 1))

	(insert "</em>") (search-forward "<em>"))))

;;;
;;; for an understanding with Ger- =
;;;
;;; 
 many?&quot;^^2^^ Shortly after
;;;

(defun abbyycln-maybe-interactions (arg1p)
  ""
  ;;
  (interactive "p")
  (let (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 "SUP" "sup")
				    (cons "SUB" "sub")
				    ))
		_rc)
    
    (progn ;; Change tags.
      (loop for my-cons in my-tag-table
	    do
	    (goto-char (point-min))
	    (setq my-tag (car my-cons))
	    (while (search-forward-regexp (concat "\\(</?\\)"
						  my-tag ">") nil t)
	      (replace-match (concat (match-string-no-properties 1)
				     (cdr my-cons) ">")))))

    (progn ;; ^M inside span markup.

      ;; fix!  Move this to "Swaps and substitutions".
      (goto-char (point-min))
      (while (search-forward-regexp (_-ws " 
 \\(</em>\\)") nil t)
	(replace-match (concat
			(match-string-no-properties 1) " 
 "))))

    (progn ;; Page numbers: just integer inside P tag. Need ^M (just above).
      (goto-char (point-min))
      (while (search-forward-regexp
	      (concat "\n\n" "<p>[ \t\n]*"
		      "\\(<b>\\|<em>\\)?" "\\([0-9]+\\)" "\\(</b>\\|</em>\\)?"
		      "</p>"
		      "[ \t]*
[ \t]*" "\n\n") nil t)
	(setq my-pt-beg (match-beginning 0))
	(replace-match (concat "\n\n"
			       (match-string-no-properties 2) "\n\n"))
	(progn (goto-char my-pt-beg)
	       (search-forward-regexp "[0-9]"))))

    (progn ;; Quotes (abbycln.el|html2tx.el)
      (goto-char (point-min))
      (while (search-forward-regexp (concat
				     "\\(&quot;\\|\"\\)"
				     "\\([-a-zA-Z]+\\)"
				     "\\(&quot;\\|\"\\)") nil t)
	(if (and (not (_-sgml-markup-p))
		 (not (string-match "^[-]+$"
				    (match-string-no-properties 2))))
	    (replace-match (concat "``" (match-string-no-properties 2)
				   "''")))))

    (progn ;; After deleting some tags: 1st of 2 page numbers
      (goto-char (point-min))
      (while (search-forward "<!-- vol= pg= " nil t)
	(when (search-forward "<" nil t)
	  (goto-char (setq pt-beg (match-beginning 0)))
	  (when (looking-at (concat "<SPAN class=font" "[0-9]+" ">"
				    "\\(<B>\\)?"
				    "\\([0-9]+\\)"
				    "\\(</B>\\)?"
				    "</SPAN><BR>"))
	    (setq pg (match-string-no-properties 2))
	    (replace-match "")
	    (search-backward "pg=")
	    (goto-char (match-end 0))
	    (insert (format "%03d" (string-to-int pg)))))))

    (progn ;; Shift whitespace before close tag.
      (setq taglist '("em" "b"))
      (while (and taglist
		  (and (setq tag (car taglist))
		       (or (setq taglist (cdr taglist)) t))
		  (goto-char (point-max)))
	(while (> (point) (point-min))
	  (goto-char (point-min))
	  (while (search-forward-regexp (concat
					 "\\([ \t\n]+\\)"
					 "\\(</" tag ">\\)"
					 ) nil t)
	    (replace-match (concat (match-string-no-properties 2)
				   (match-string-no-properties 1)))))))

    (progn ;; Swaps and substitutions (after tag renames).

      (setq my-list
	    (list
	     (cons "\\(aaa\\)\\(bbb\\)\\(ccc\\)"
		   (list (list 1 2 3)))
	     ;; Endnotes:
	     (cons "\\(</p><p>[ \t\n]*\\)\\(Letter No[.][ ~][0-9]+\\)\\(</p>\\)"
		   (list (list "</p><p>\n\n"
			       2 " __PROGRESS_COMMENT__\n\n</p>")))
	     (cons "\\(<p class=\"quote\">\\)\\([ \t\n]*\\)\\(&quot;\\|\"\\)"
		   (list (list 1 2 "``")))
	     ;; ,"B
	     (cons (concat "\\([.,]\\)" "\\(" "&quot;\\|\"\\)" "\\([ ]\\)")
		   (list (list 1 "''" 3)))
	     ;; ",B
	     (cons "\\(&quot;\\|\"\\)\\([.,]\\)\\([ \n]\\)"
		   (list (list "''" 2 3)))
	     (cons "\\([0-9][0-9]+\\)\\([-]\\)\\([0-9][0-9]+\\)"
		   (list (list 1 "--" 3)))
	     (cons "\\([\(]\\)\\(&quot;\\)"
		   (list (list "``" 1)))
	     (cons "\\(&quot;\\)\\([;,\)]\\)"
		   (list (list "''" 2))) ;; WAS: (list 2 "''")
	     (cons "\\(&quot;\\)\\(</em>\\)"
		   (list (list 2 1)))
	     (cons "\\([*]+\\)\\(</em>\\)"
		   (list (list 2 1)))
	     (cons "\\([ \t\n]*
[ \t\n]*\\)\\(</em>\\)"
		   (list (list 2 " 
 ")))
	     (cons "\\([,:]\\)\\([ ]*\\)\\(</em>\\)"
		   (list (list 3 1 2)))
	     (cons "\\(<em>\\)\\(&quot;\\)"
		   (list (list 2 1)))
	     (cons "\\( \\)\\(<em>\\)\\([\(]\\)"
		   (list (list 1 3 2)))
	     (cons "\\([\)]\\)\\(.?\\)\\(</em>\\)"
		   (list (list 3 1 2)))

	     ;; NO. "~" means data were checked by eye.
;;	     (cons "\\(No.\\)\\([ \t\n]+\\)\\([0-9]+\\)"
;;		   (list (list 1 "~" 3)))

	     "zzzzzz"))

      (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")))
		(replace-match (concat
				my-msnp1 my-msnp2 my-msnp3 my-msnp4)))))))

    (progn ;; Hyphenation (do near end).

      (when nil
	;; OLD METHOD. Negative number indicates how many characters
	;; came from line below.
	(goto-char (point-max))
	(while (search-backward-regexp (concat "[ \t\n]" "\\([^ \t\n]+\\)"
					       "[-]" "[ \t\n]+
[ \t\n]+"
					       "\\([a-z]\\)") nil t)
	  (progn (setq my-msnp1 (match-string-no-properties 1))
		 (setq my-msnp2 (match-string-no-properties 2))
		 (setq my-pt-beg (match-beginning 0))
		 (setq my-pt-end (match-end 0)))
	  (when (string-match "[a-zA-Z]+$" my-msnp1)
	    (setq my-n (length (match-string-no-properties 0 my-msnp1)))
	    (delete-region (goto-char my-pt-beg) my-pt-end)
	    (insert " " "
-" (int-to-string my-n)
		    " " my-msnp1 my-msnp2))))

      (when nil
	(abbyycln-hyphens-control-M))

      )

    ;; 2006.09.07
    (progn
      (goto-char (point-min))
      (while (search-forward-regexp " [\r] </p> [\r]" nil t)
	(replace-match "</p> 
")))

    _rc))

(defun abbyycln-hyphens-control-M 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)

    (goto-char (point-max))
    (while (and (search-backward-regexp
		 (concat "\\([^a-zA-Zóéíáñú]\\)"
			 "\\([a-zA-Zóéíáñú]+\\)"
			 "[-][ \t]+[\r]"

			 ;; -----------------------------
			 ;; DO NOT put "[-][0-9]" here!
			 ;; -----------------------------
			 ;; law-gov- ^M
			 ;;  ->
			 ;; law- ^M-3
			 ;; -----------------------------
			 ;; KEEP "law-" LIKE THAT.
			 ;; -----------------------------

			 ;; "[ \t]*" "[\n]"
			 "\\(" "[ \t\n]+" "\\)"

			 ) nil t)
		(setq _pt (match-end 0)))
      (if
	  (save-match-data
	    (setq _rc
		  (string-match "[ \t]*[a-zA-Z]"
				(setq _str
				      (buffer-substring _pt
							(min (+ 20 _pt)
							     (point-max)))))))
	  (if (and (not (null _rc)) (= 0 _rc))
	      (replace-match
	       (concat

		(match-string-no-properties 1)

		" 
-"

		(int-to-string (length (match-string-no-properties 2)))

		(match-string-no-properties 3)

		(match-string-no-properties 2)))

	   t t)))

    ;; Compress spaces to left of carriage return.
    (goto-char (point-min))
    (while (search-forward-regexp "[ \t][ \t]+[\r]" nil t)
      (replace-match " 
"))

    _rc))

(defun abbyycln-justonce (arg1p)
  ""
  ;;
  (interactive "p")
  (let (my-cons my-tag my-cons my-cnt my-pt-beg my-pt-end my-properties
		my-msnp1 my-n
		my-counter
		)

    (progn ;; Change certain <SPAN ...  to <p>.
      (goto-char (point-min))
      (while (search-forward "<SPAN class=font" nil t)
	(goto-char (match-beginning 0))
	(delete-region (point) (search-forward ">"))
	(insert "<p> \n"))
      (goto-char (point-min))
      ;; fix?  Change them all?
      (while (search-forward "</SPAN>" nil t)
	(replace-match "</p>" t t)))

    (progn ;; Delete empty tags.
      (setq my-cnt 1)
      (while (and (> my-cnt 0)
		  (goto-char (point-min)))
	(setq my-cnt 0)
	(while (search-forward-regexp "<\\([A-Z]+\\)[^A-Z]" nil t)
	  (setq my-tag (match-string-no-properties 1))
	  (goto-char (setq my-pt-beg (match-beginning 0)))
	  (search-forward ">")
	  (when (looking-at (concat "[ \t\n]*</" (downcase my-tag) ">"))
	    (setq my-cnt (1+ my-cnt))
	    (delete-region my-pt-beg (match-end 0))))))

    (progn ;; Dashes
      (goto-char (point-min))
      (while (search-forward-regexp (concat
				     "—"
				     ) nil t)
	(replace-match "---")))

    (progn ;; 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))))))

    (progn ;; Page numbers
      (goto-char (point-min))
      (while (search-forward "<HR>" nil t)
	(replace-match "\n\n<!-- vol= pg= src= type= -->\n\n" t t)))

    (progn ;; Superscript numbers
      (goto-char (point-min))
      (while (search-forward-regexp (concat "\\([ \t\n]*\\)" ;; added this later.
					    "<SUP>"
					    "\\(<BR>\\)?"
					    "\\([0-9]+\\)"
					    "\\(<BR>\\)?"
					    "</SUP>") nil t)
	(setq my-msnp1 (match-string-no-properties 1))
	(replace-match
	 (concat (if (< 0 (length my-msnp1)) "~" "")
		 (match-string-no-properties 2)
		 "^^" (match-string-no-properties 3) "^^"
		 (match-string-no-properties 4)))
	(progn (search-backward-regexp "[ \t\n]")
	       (replace-match (concat (match-string-no-properties 0)
				      "=\n\n")))
	))

    (progn ;; Line-breaks and integer-only page numbers.
      (goto-char (point-min))
      (while (search-forward "<BR>" nil t)
	(replace-match " 
 ")))

    (progn ;; Endnotes.
      (while (search-forward-regexp (concat "<p>~^^"
					    "\\([0-9]+\\)" "^^ ") nil t)
	(replace-match
	 (concat "\n\n"
		 (match-string-no-properties 1)
		 "\n\n" "<p>\n") t t nil 0)))

    (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 "</" my-tag ">"))
	    (if (assoc "del.chardata" my-properties)
		(delete-region my-pt-beg (point))
	      (replace-match ""))))))

    ;; 2006.11.05
    (while
	(search-forward-regexp (concat "\n\n<p>\n\\(<em></em>\\)[*]") nil t)
      (replace-match "" t t nil 1))

    ;; 2006.11.05
    ;; Delete solo carriage returns.
    (progn (setq my-counter 1)
	   (while (> my-counter 0)
	     (setq my-counter 0)
	     (goto-char (point-min))
	     (while (search-forward-regexp 
		     (concat
		      "[\n]"
		      "[ \t]*[\n]"
		      "[ \t]*[\r]"
		      "[ \t]*[\n]"
		      "[ \t]*[\n]"
		      )
		     nil t)
	       (setq my-counter (1+ my-counter))
	       (replace-match "\n\n"))))

    ;; 2006.11.11
    (while (search-forward-regexp
	    (concat
	     "[\r][\n][\n]"
	     "\\(<p>\\)[\n]"
	     "[0-9]+[*]" "\\(</p> [\r]\\)"
	     "[\n][\n]"
	     "\\([0-9]+\\)" ;; page #
	     "[\n][\n]<p>[\n]"
	     "[^\n]+</p> [\r][\n][\n]<p>[\n]"
	     "[^\n]+</p> [\r][\n][\n]"
	     "[0-9]+" ;; page #
	     "[\n][\n]"
	     ) nil t)
      (setq my-n (match-string-no-properties 3))
      (replace-match "" t t nil 2)
      (replace-match (concat
		      "__PRINTERS_P_" 
		      (int-to-string
		       (1-
			(string-to-int
			 my-n)))
		      "_COMMENT__")
		     t t nil 1))

    ))

(defun abbyycln- (&optional arg1p)
  ""
  ;;

  ;; 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]+

  (interactive "p")
  (let (my-re my-bfn-original my-bfn-rename my-pf-tx my
	      _rc)

    (progn ;; No-nos.
      (goto-char (point-min))
      (setq my-re " &quot; ")
      ;;(if (search-forward-regexp my-re  nil t)
      ;;(error "%s: %s" "Found" (concat "->" my-re "<-")))
      )

    (progn ;; Preliminaries.
      ;; (save-some-buffers)
      (setq my-bfn-original (buffer-file-name))
      (when nil
	(if (not (string-match (concat
				"v37pp77"
				;; "v34pp74"
				"[^.]*[.]htm") (setq my-pf-tx (buffer-file-name))))
	    (error "%s: %s" "a" "b")))

      (setq my-pf-tx (progn (setq my-pf-tx (buffer-file-name))
		      (if (string-match "[.]html?$" my-pf-tx)
			  (setq my-pf-tx
				(replace-match

				 (concat ".tx"

					 ;; 2006.11.05
					 "q"

					 )

				 t t my-pf-tx)))))
      (if (file-exists-p my-pf-tx)
	  (find-file my-pf-tx)

	(setq my-bfn-rename my-bfn-original)

	;; fix?
	;; Why [^mM] ?

	(if (not (string-match "\\([mM]\\)[^mM]*$" my-bfn-rename))
	    (error "%s: %s" "y" "z")
	  (setq my-bfn-rename (replace-match "" nil nil my-bfn-rename 1)))
	(if (file-exists-p my-bfn-rename)
	    (error "%s: %s" "Cannot rename: file already exists:" my-bfn-rename)

	  (rename-file my-bfn-original my-bfn-rename)
	  (find-file my-pf-tx)
	  (insert-file-contents-literally my-bfn-rename)
	  (if (setq my (get-file-buffer my-bfn-original))
	      (kill-buffer my)))

	(goto-char (point-min))
	(setq my "<META NAME=\"GENERATOR\" CONTENT=\"ABBYY FineReader 6.0\">")
	(if (not (search-forward my))
	    (error "%s: %s" "Did not find" my)
	  (delete-region (point-min) (point)))

	(goto-char (point-min))
	;; Later all <BR> will be changed to ^M.
	(while (search-forward "
" nil t) (replace-match ""))

	;; Do not (save-buffer 0) to prevent running hook lb-tx-check-^^ .
	(progn (write-region (point-min) (point-max) my-pf-tx)
	       (not-modified)
	       (kill-buffer (current-buffer)))
	))

    (progn (find-file my-pf-tx)

	   (font-lock-mode) ;; turn off mode.

	   (abbyycln-justonce nil)
	   (abbyycln-maybe-interactions nil)
	   (abbyycln-maybe-interactions nil)
	   (abbyycln-maybe-interactions nil)
	   (abbyycln-maybe-interactions nil)
	   (abbyycln-maybe-interactions nil)
	   ;; Enough?
	   (abbyycln-maybe-interactions nil))

    ;; Trailing whitespace.
    (progn
      (goto-char (point-min))
      (while (search-forward-regexp "[ \t]$" nil t) (replace-match "")))

    (progn ;; Fini.
      (goto-char (point-min))
      (if (looking-at (concat (_-ws " </HEAD> ")
			      (_-ws " <BODY> "))) (replace-match "\n"))
      )

    ;; 2006.08.21
    ;; Was doing manually:
    (progn (goto-char (point-min)) (abbyycln-hyphens-control-M))

    ;; 2006.08.21
    ;; Was doing manually:
    (progn (goto-char (point-min)) 
	   (while (search-forward-regexp "  +" nil t)
	     (replace-match " ")))

    ;; 2006.08.21
    ;; Was doing manually:
    (progn (goto-char (point-min))
	   (while (search-forward-regexp "[ \t]+$" nil t)
	     (replace-match "")))

    ;; 2006.08.21
    ;; Was doing manually:
    (progn (goto-char (point-min))
	   (while (search-forward-regexp "[ ]*&#8212;[ ]*" nil t)
	     (replace-match "---"))
	   (goto-char (point-min))
	   (while (search-forward-regexp "[-][-][-][\r]" nil t)
	     (replace-match "--- 
"))
	   )

    ;; 2006.08.21
    ;; Was doing manually:
    (progn (goto-char (point-min))
	   (while (search-forward-regexp "<p>[ \t\n\r]\\(&quot;\\)" nil t)
	     (replace-match "``" t t nil 1))
	   )

    ;; 2006.08.21
    ;; Was doing manually:
    (progn (goto-char (point-min))
	   (while (search-forward-regexp

		   (concat
		    "<em>[^ \t\n\r]+\\("

		    ;; fuck! he said, 2006.09.21
		    ;; Most of GPSPW[12345]PP is affected.
		    ;;
		    ;; BEFORE: "." AFTER:
		    "[.]"

		    "</em>\\)" 
		    )

		   nil t)
	     (replace-match "</em>." t t nil 1))
	   )

    ;; 2006.09.27 - missing paragraph break inbetween footnotes.
    (progn (goto-char (point-min))
	   (while (search-forward-regexp

		   (concat " 
 " "\\([*]\\)" 
			   "[*]+" ;; fix? include ")" after "*"?
			   " ") nil t)
	     (replace-match
	      (concat
	       "</p>\n\n<p>\n"
	       (match-string-no-properties 1))
	      t t nil 1)
	     ))

    _rc))

(defun abbyycln-at-point-__title__-letter (arg1p)
  "Execute this function with point to left of:

<p>
189 
 TO <b>HIS SISTER ANNA</b></p> 
"
  ;;
  (interactive "p")
  (let (my my-cons my-msnp1 my-msnp2)
    (if (looking-at "[ \t\n
]") (goto-char (match-end 0)))
    (goto-char (car (setq my-cons (_-where-double-newlines))))
    ;;
    ;; # and TITLE in same paragraph.
    (when
	(looking-at (concat (_-ws "<p> \\(<B>\\)?\\([0-9]+\\)")
			    (_-ws "\\(</p>\\)? ")
			    (concat "\\(" (_-ws "
 ")
				    "\\|" (_-ws "
 ")
				    "[\n][ \t]*[\n][ \t]*"
				    "<p>[ \t\n]+"
				    "\\)")
			    "\\(<B>\\)?"
			    "TO[ \t]+"
			    "\\([^
]+\\)"
			    (_-ws " 
") "[ \t]*[\n][ \t]*[\n]"))
      (setq my-msnp1 (match-string-no-properties 2))
      (setq my-msnp2 (match-string-no-properties 6))
      ;; Chop trailing tags.
      (save-match-data
	(if (string-match (_-ws " </p> $") my-msnp2)
	    (setq my-msnp2 (replace-match "" nil nil my-msnp2 0)))
	(if (string-match (_-ws " </b> $") my-msnp2)
	    (setq my-msnp2 (replace-match "" nil nil my-msnp2 0))))
      (replace-match (concat "__SUPRATITLE__\n" my-msnp1 "\n\n"
			     "__TITLE__\nTO "
			     my-msnp2 "\n\n")))))

(provide 'abbyycln)