;; Leninist.Biz! ;; Emacs-Time-stamp: "2007-11-23 17:16:43" (setq file-stamp "Emacs-File-stamp: \"/home/ysverdlov/leninist.biz/lb-edits.el\"") (defvar lb-ext-edits-push "push" "") ;; Helpers for manual editing. (progn (global-set-key "\C-c\C-k" 'lb-edits-push-paragraph) ;; See: lb-tmm.el !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ;; (local-set-key [f5] '_-para-delete) (local-set-key [C-f11] 'lb-edits-pop-file) (global-set-key [f2 ?h] '(lambda nil "" (interactive) (lb-something-to-html))) (global-set-key [f2 ?r] '(lambda nil "" (interactive) (lb-tx-make-or-refresh-indextx))) (global-set-key [f2 ?u] '(lambda nil "" (interactive) (_-tex2unibyte t))) ) ;; (defun tx-editing-delete-hooks-early-on (&optional arg1) "" ;; (interactive) ;; fix! ;; If ARG1 is non-nil, just return list of hooks for tx-check-buffer! ;; If ARG1 is nil, delete hooks. ;; That way list of functions can be shared. (delete-hook 'local-write-file-hooks 'lb-tx-chk-^^) (delete-hook 'local-write-file-hooks 'lb-tx-check-buffer4-singularities) (delete-hook 'local-write-file-hooks 'lb-tx-check-buffer4-trailing-dash) (delete-hook 'local-write-file-hooks 'lb-tx-check-buffer4-para-break-before-last-line) ;; 2007.08.22 (delete-hook 'local-write-file-hooks 'lb-tx-check-page-numbers-editing) ) ;; (defun tx-editing-rename-image (&optional arg1) "Use this function after typing father ... BEFORE: AFTER: " ;; (interactive) (let (_re _fn-new _fn-old _dir-old _dir-new _rc) (save-match-data (save-excursion (progn (setq _dir-old (file-name-directory (bfn))) (if (not (looking-at (setq _re "[.]jpg\" alt="))) (error "%s: %s" "For now, expecting point at" _re)) (search-forward-string "jpg") (search-backward-regexp (concat "src=/"\\(" "[0-9]+" "[-]" ".*" "\\)" )) (setq _fn-new (match-string-no-properties 1)) (search-forward-regexp (concat "alt=\"" "\\(" "[^\"]+" "\\)" "\"")) (setq _fn-old (match-string-no-properties 1)) ;; Remove trailing slash. 1 of 2. (setq _dir-new (substring _dir-old 0 (1- (length _dir-old)))) ;; Maybe move image up one bdirectory level. (when (string-match lb-re-path-year+book-instance _dir-new) (setq _dir-new (file-name-directory _dir-new)) ;; Remove trailing slash. 1 of 2. (setq _dir-new (substring _dir-new 0 (1- (length _dir-new))))) ) (rename-file (concat _dir-old "" _fn-old) (concat _dir-new "/" _fn-new)) (recenter) ))_rc)) ;; (local-set-key "\C-y" 'tx-editing-yank) ;; (local-set-key "\C-y" 'yank) ;; (local-set-key [Ctrl-y] 'tx-editing-yank) (defun tx-editing-yank (&optional arg) "Runs traditional yank, then runs a hook to automate certain editing functions. With prefix argument, does everything except traditional yank" ;; from simple.el (interactive "*P") (let (_pt-save-excursion _rc) (save-match-data (if (or (not arg) (and arg (/= 4 (car arg)))) (yank arg)) ;; If looking at a paragraph that begins with a naked "*". (save-excursion (if (or (not arg) (and arg (/= 4 (car arg)))) (exchange-point-and-mark)) (if (tx-editing-insert-_-_-_) (setq _pt-save-excursion (point)))) (if _pt-save-excursion (goto-char _pt-save-excursion)) ) _rc)) ;; (local-set-key [f2 d] 'tx-editing-del-para) (defun tx-editing-del-para () "Delete this paragraph, or the one after this blank line" (interactive) (let (_wdn _rc) (save-match-data (if (_-blank-line-p) (_-move-forward-whitespace)) (delete-region (car (setq _wdn (_-where-double-newlines))) (cdr _wdn)) ) _rc)) (defun tx-editing-common-prep nil "" ;; (let (_rc) (save-match-data ;; 2006.12.28 ;; Default _-where-page-numbers seems to be "bottom". ;; After header inserted with "top" value, this should be run. ;; Running it here to change value early-on. (_-find-file-hooks-__-globals) ;; fix! When page number inserted, search for next pageno and if ;; the same, delete it. ;; (when (_-blank-line-p) (tx-editing-compress-here-multiple-newlines)) ;; fix! Looking up to find
to delete, skipover __PRINTERS_P_999_COMMENT__ ;; Cursor Ctrl-LEFT to close P tag. (when (looking-at "p>[ ]*\r\n") (goto-char (match-end 0)) (_-move-forward-whitespace) (when (looking-at "__PRINTERS_P_") (goto-char (cdr (_-where-double-newlines))) (_-move-forward-whitespace))) ;; 2007.01.12 - move from blank line under page number to page number. (when (and (_-blank-line-p) (save-excursion (forward-line -1) (string-match lb-re-bracketed-integer-anchored (_-current-line)))) (forward-line -1)) ;; May have just finished typing page number. (if (save-excursion (beginning-of-line) (looking-at lb-re-bracketed-integer)) (beginning-of-line)) ;; Probably in blank line above first page number. ;; Probably going to do tx-editing-insert-page-break-mid-paragraph next. (progn (_-move-forward-whitespace t) (if (not (_-blank-line-p)) (goto-char (car (_-where-double-newlines))))) ) _rc)) ;; (local-set-key [f2 f6] 'tx-editing-del-recto-pageno) (defun tx-editing-del-recto-pageno (&optional arg1) "Place cursor on or before paragraph with verso page number and try to delete next three (3) paragraphs (two running headers and recto page number) up to and including last paragraph with recto page number. With prefix argument, does not check 3rd paragraph for valid page number" (interactive "p") (let (lb-para lb-pageno-verso lb-pageno-verso-end lb-pageno-recto lb-pageno-recto-expected lb-pageno-recto-end _rc) (save-match-data (save-excursion (tx-editing-common-prep) ;; Expecting point on line with page number. (when (and (string-match lb-re-bracketed-integer-anchored (setq lb-para (car (_-para t t)))) (setq lb-pageno-verso (match-string-no-properties 1 lb-para)) (setq lb-pageno-recto-expected (int-to-string (1+ (string-to-int lb-pageno-verso)))) (setq lb-pageno-verso-end (save-excursion (goto-char (cdr (_-where-double-newlines))) (point))) ) (loop for i from 1 to 3 do (progn (goto-char (cdr (_-where-double-newlines))) (_-move-forward-whitespace)) (if (or ;; 3rd paragraph has a real page number. (and (string-match lb-re-bracketed-integer-anchored (setq lb-para (car (_-para t t)))) (setq lb-pageno-recto (match-string-no-properties 1 lb-para))) ;; Fake it. (and (= 3 i) ;; fix! ;; Display current paragraph and prompt for delete. (and arg1 (= 4 arg1)) )) (setq lb-pageno-recto-end (save-excursion (goto-char (cdr (_-where-double-newlines))) (point))) ) ) ;; loop )) ;; fix! ;; With prefix argument, assume a page number after next 2 paragraphs. (when (and lb-pageno-verso-end lb-pageno-recto-end) (goto-char lb-pageno-verso-end) (delete-region lb-pageno-verso-end lb-pageno-recto-end) (setq _rc t) (recenter)) ;; fix! ;; if "" ends previous paragraph, ;; if "" starts next paragraph,
;; ask whether to delete the pair.
)
_rc))
;;
(defun tx-editing-insert-footnote-marker (&optional arg1)
"With point at '*' or in '***' or after '*' this
changes asterik(s) to a footnote marker (and maybe
changes '*' to an integer)"
;;
(interactive "p")
(let (_pt _str
_page-beg _footnotes-beg _re
_rc)
;; fix! must start with "*" "**"... change to "1" "2"...
;; based on __FOOTNOTE_MARKER_STYLE__
(save-match-data
(save-excursion
;; REPOSITION.
;; * - only works with asterik!
(while (looking-at-backward-become-forward "[*]+[ ]*"))
;; REPOSITION.
;;
(when (looking-at-backward-become-forward "[0-9]*")
(forward-char 1))
;; *
(when (and (not _rc)
(looking-at "[*]+")
(progn
(replace-match (concat "^^" (match-string-no-properties 0)
"^^"))
t)
(setq _rc t))
(sbs "^^")
(sbs "^^")
;; Spaces before "*"
(while (looking-at-backward-become-forward " +")
(replace-match "~")
(backward-char 1))
;; fix? Could be a global hook always done at beginning of [f2 f2]
(if (looking-at-backward-become-forward "[>).,?]\\("\\)")
(replace-match "''" t t nil 1))
(if (looking-at-backward-become-forward "\\("\\)[>).,?]")
(replace-match "''" t t nil 1))
(sfs "^^")
;; Maybe change asteriks to integer.
(and
(string-match "0-9" _-footnote-marker-style)
(progn
(setq _page-beg (lb-tx-page-point "page-beg"))
(setq _footnotes-beg (lb-tx-page-point "footnotes-beg"))
(setq _re (concat "\\^\\^\\(" _-footnote-marker-style
"\\)\\^\\^"))
(setq _pt (point)))
;; fix! if footnote numbers continuous, search past
;; top of current page for previous footnote number in body.
(cond
((sbr _re
(if (and _footnotes-beg
(> (point) _footnotes-beg))
_footnotes-beg
_page-beg)
t)
(setq _str (match-string-no-properties 1)))
;;
((and (boundp '_-footnote-marker-sequence)
(string= "continuous"
_-footnote-marker-sequence))
(goto-char _page-beg)
(sbr _re)
(setq _str (match-string-no-properties 1)))
;;
(t (setq _str "0")))
;;
(goto-char _pt)
(and (looking-at "[*]+")
(replace-match (int-to-string (1+ (string-to-int
_str))))))
(sfs "^^"))
;;
(when (and (not _rc)
(_-sgml-markup-p)
(string= "SUP" (_-sgml-what-element)))
(sfs ">")
(when (and (looking-at "[0-9]+")
(looking-at-backward-become-forward ""))
(setq _rc t)
(replace-match "^^")
(sfr "[0-9]+")
;;
(if (looking-at "")
(replace-match "^^")
(if (looking-at
(concat "\\(" _-whitespace-wM "+" "\\)"
""))
(replace-match (concat "^^" (match-string-no-properties 1)))
(error "%s: %s" "Tried to replace "
(_-buffer-substring-from-))))))
))
_rc))
;;
(defun tx-editing-insert-endnote-marker (arg1)
"Add 1 to previous existing endnote marker and insert here"
;;
(interactive "p")
(let (re-^^marker^^
re-4-string-match
n-previous n-current
_rc)
(save-match-data
(progn
(_-move-forward-whitespace)
;; point before " "
(if (looking-at " "))
;; point after "p" in " "
(if (looking-at ">") (forward-char 1))
(_-move-forward-whitespace))
(save-excursion
(if (not (search-backward-regexp
(setq re-^^marker^^ "\\^\\^\\([0-9]+[a-c]?\\)\\^\\^")
nil t))
(error "%s: %s" "Looking backward" re-^^marker^^))
(setq n-previous (match-string-no-properties 1))
(if (string-match "[a-z]" n-previous)
(error "%s: %s" "What to do with alpha in marker" n-previous))
n-previous)
(if (not (string-match
(setq re-4-string-match (concat " "
_-whitespace-noM"*"
"[~]?"
_-whitespace-noM"*"
))
(_-buffer-substring -10)))
(error "%s: %s" "Expecting before point" re-4-string-match))
(insert "^^"
(setq n-current
(int-to-string (1+ (string-to-int n-previous))))
"^^" " ")
(set-mark (point))
(forward-paragraph)
(recenter)
(message (setq _rc n-current))
)_rc))
;; (local-set-key [f2 f2] 'tx-editing-contextual-insert-)
(defun tx-editing-contextual-insert- nil
"Attempt to do something based upon context"
;;
(interactive)
(let (_which-worked
(noerr t)
_rc)
(save-match-data
;; (save-excursion
;; Let's get general! So, change this function to just _-contextual?
(or
(tx-editing-contextual-insert-__printers)
;; 2007.10.30
(lb-abbyycln-join-a-hyphen-control-M)
(tx-editing-contextual-insert-smart-quote)
;; fix! if in B or EM tag, insert class="sic"
(tx-editing-contextual-insert-blockquote)
(tx-editing-insert-footnote-cont noerr)
(tx-editing-contextual-insert-class-sic)
(if (tx-editing-insert-footnote-marker)
(setq _which-worked "tx-editing-insert-footnote-marker"))
;; (_-describe-function)
(find-function-at-point)
(tx-editing-del-recto-pageno)
;; LAST:
;; (tx-editing-change-p-to-alpha_lvl)
)
)
(if _which-worked
(message "%s" _which-worked))
_rc))
;;
(defun tx-editing-insert-footnote-cont (&optional arg1noerr)
""
;;
(interactive)
(let (_pg
(_cfs case-fold-search)
(_re-paz (concat _-whitespace-noM "*"
"\\( \\)"
_-whitespace-noM "*"
"[a-z]" ;; cfs
))
_rc)
(save-excursion
(save-match-data
;; Just deleted
" "\n\n")) (search-forward-string "
") (goto-char (cdr (_-where-double-newlines))) (insert "\n\n" "" "\n\n") (backward-paragraph)) _rc)) ;;; MOVED FROM: ~/www.marxists.org/archive/lenin/howto/lia.el (defun tx-editing-contextual-insert-__printers nil "For PRINTERS_999_NOTE." ;; (interactive) (let (lb-data _rc) (save-match-data (save-excursion ;; fix! ask whether to delete above, like inserting _-_-_ does. ;; fix? This should be in standard function for all tx-editing-insert-* (progn (if (not (looking-at "[ \t\r]*[\n][ \t]*[\n]")) (_-move-forward-whitespace t)) (if (_-blank-line-p) (_-move-forward-whitespace)) (goto-char (car (_-where-double-newlines)))) (cond ((looking-at (concat "" _-whitespace-noM "*" "\\(" "" "\\)?" "\\(" "[0-9]+[*]" "\\|" "[0-9]+" ;; 2007.11.23 - en/0000/MPIP223/20051103/199.tx "[.]?" "[-]+[0-9][0-9]+[*]?" "\\)" "\\(" "" "\\)?" "\\(
" _-whitespace-noM "*\\)?" _-whitespace-noM "*" "
" "[ \t\r]*" "\n" "[ \t\r]*" "\n")) (setq lb-data (concat (match-string-no-properties 1) (match-string-no-properties 2) (match-string-no-properties 3))) (_-para-delete) (insert (setq _rc (concat "__PRINTERS_P_" (lb-tx-what-page) "_COMMENT__\n" lb-data "\n\n")))) ;; This matches *both* !!! ;;;; 31---826 ;;
((or (string-match (concat "^[0-9]+[-][-][-][0-9][0-9]+" _-whitespace-wM "*" "$") (car (_-para))) (string-match (concat "^[0-9]+[*]+" _-whitespace-wM "*" "$") (car (_-para))) ) (insert (setq _rc (concat "__PRINTERS_P_" (lb-tx-what-page) "_COMMENT__\n")))) (t (if t t ;; changed to -contextual- (error "%s: %s" "Not matched" (car (_-para))))) ))) ;; Move to blank line under inserted text. (if _rc (while (not (_-blank-line-p)) (forward-line 1))) _rc)) ;;; MOVED FROM: ~/www.marxists.org/archive/lenin/howto/lia.el ;; (local-set-key [f2 f2] 'tx-editing-insert-__progress_comment__) (defun tx-editing-insert-__progress_comment__ (arg1) "For NOTES. Place cursor before or after '' in '
p. 999
'" (interactive "p") (let (lb-n lb-pt0 lb-flag-edit lb-rc) (save-excursion (save-match-data ;; Point after "p":(if (looking-at ">") (forward-char 1)) ;; This will move point to left of "p. 999" if point ;; on blank line under "
". (looking-at-backward-become-forward (concat "p." "[ ]+" "[0-9]+[ ]*" "[ \t\r]*" "\n")) ;; Move over open or close P tag(s). (if (looking-at (concat _-whitespace-wM "*" "\\(\\)?" _-whitespace-wM "*" "")) (goto-char (match-end 0))) ;; (_-move-forward-whitespace) ;; (when (looking-at (concat "\\(p[.][ ]+[0-9]+\\)" "\\(
\\)" )) (setq lb-pt0 (point)) (replace-match (concat "\n\n" "__PROGRESS_COMMENT__" "\n" (match-string-no-properties 1) "\n\n" (match-string-no-properties 2))) (goto-char lb-pt0) (_-move-backward-whitespace) (if (looking-at-backward-become-forward (concat "" _-whitespace-wM "*" "")) (replace-match "")) (search-forward "
") ;; Signaling: (error "Lisp nesting exceeds max-lisp-eval-depth") ;; (lb-save-buffer-control-M) ;; Move to "\n\n=\n\n" (setq lb-flag-edit (point))) ;; What does this do? (when (looking-at (concat _-whitespace-wM "*" "=" "[ \t]*" "[\n]" "[ \t]*" "[\n]" "" _-whitespace-wM "*" "[~]?" "^^" "\\([0-9]+\\)" "^^" "[ \t]*")) (replace-match (concat "\n\n" (match-string-no-properties 1) "\n\n" "
" "\n"))
(setq lb-flag-edit (point)))
))
(when lb-flag-edit
(goto-char lb-flag-edit)
(recenter))
lb-rc))
;;; -------------------------------------------------------
;; (tx-editing-while-interline-CR-insert-br)
(defun tx-editing-while-interline-CR-insert-br nil
"From beginning of paragraph, search for carriage returns
and insert BR tag up to, not including, last carriage return"
;;
(interactive)
(let (_pt
_rc)
(_-goto-beginning-of-paragraph t)
;; Skip first one.
(while (and
;; If there is just one CR:
(< (point) (setq _pt (cdr (_-where-double-newlines nil t))))
(sfr (concat "[\r][-]?[0-9]*" _-whitespace-noM "+") _pt t))
(if (not (looking-at "
")))
;;
(_-goto-beginning-of-paragraph)
_rc))
;;
(defun tx-editing-change-p-to-caption (&optional arg1)
""
;;
(interactive "p")
(let (_rc)
;;
(tx-editing-change-p-to- "__CAPTION__")
;; Time to move on.
(tx-editing-forward-paragraph)
_rc))
;;
(defun tx-editing-change-alpha-to-h9 (&optional arg1)
"
This undoes p-to-alpha
"
;;
(interactive "p")
(let (_ms0 _ms1 _ms2
_rc)
(_-goto-beginning-of-paragraph)
(when (looking-at lb-re-__-lvl)
(setq _ms0 (match-string-no-properties 0))
(setq _ms1 (match-string-no-properties 1))
(setq _ms2 (match-string-no-properties 2))
(replace-match (concat "
\\)")))) (error "%s: %s" "Not looking-at" _re) (replace-match arg1markup-beg t t)) ;; If no whitespace in new markup, delete whitespace after it. (if (and ;; fix? - was getting: __CAPTION__Word word word nil (and (not (string-match _-whitespace-wM arg1markup-beg)) (not (string-match lb-re-__-lvl-root arg1markup-beg))) (looking-at _-whitespaces-noM)) (replace-match "")) ;; fix? maybe put ;; _-compress-multiple-markup into t2h-fill-paragraph-control-M (tx-editing-while-interline-CR-insert-br) (_-compress-multiple-markup) (t2h-fill-paragraph-control-M) ;; Move to beginning to prepare for any further changes. (goto-char (car (_-where-double-newlines)))) ;; (message "%s" (concat "Page " (lb-tx-what-page))) _rc)) ;;; ------------------------------------------------------- ;; (defun tx-editing-insert-blockquote (&optional arg1) " C-u prefix argument removes
andbefore and after inserted blockquote" ;; (interactive "p") ;; fix! 2007.06.15 - Prefix arg (C-u) to delete "
" above ;;and ". (let (_pt _mark _cons _rc) (save-match-data (if (not mark-active) (error "%s: %s" "Must set mark" "open tag will insert at mark")) (when (and (= (point) (mark)) (string-match "^[yY]$" (read-input (concat "Blockquote this paragraph " "(next if point on blank line)? ") "Y" nil nil nil))) (if (_-blank-line-p) (_-move-forward-whitespace)) (set-mark (car (setq _cons (_-where-double-newlines)))) (goto-char (cdr _cons))) (if (= (point) (mark)) (error "%s: %s" "Point and mark are the same" (int-to-string (point)))) (if (< (point) (mark)) ;; (error "%s: %s" "Out of order" "mark must be above point")) (exchange-point-and-mark)) (insert "\n\n" "" "\n\n") (exchange-point-and-mark) (insert "\n\n" "" below
" "\n\n") (exchange-point-and-mark) ;; In case we want to killand yank it further down. ;; 2007.06.15 - changed mind. ;; (search-backward-string "") (when (and arg1 (= 4 arg1)) (progn (sbs "
") (_-move-backward-whitespace t) (if (looking-at-backward-become-forward "") (replace-match ""))) (progn (sfs "") (_-move-forward-whitespace t) (if (looking-at "
")
(replace-match ""))))
(_-compress-multiple-newlines))
_rc))
(defun tx-editing-compress-here-multiple-newlines nil
"
Moves point to a blank line if point at end or beginning of non-blank line"
;;
(interactive)
(let ((_pt-beg (point))
_rc)
;; fix!
;; Stick this in tx-editing-common-prep?
(if (looking-at "[ \t]*[\r]") (goto-char (match-end 0)))
;; Move up to blank line?
(if (and
(= (point) (save-excursion (beginning-of-line) (point)))
(not (_-blank-line-p))
(save-excursion (forward-line -1)
(_-blank-line-p)))
(forward-line -1))
;; Move down to blank line?
(if (and
(looking-at (concat "[ \t\r]*[\n]"))
(not (_-blank-line-p))
(save-excursion (forward-line 1)
(_-blank-line-p)))
(forward-line 1))
(while (_-blank-line-p)
(if (and (progn (end-of-line) t)
(looking-at (concat "[\n]" _-whitespace-noM "*" "[\n]")))
(replace-match "\n"))
(if (save-excursion (= 0 (forward-line -1)))
(forward-line -1)))
(if (/= (point) _pt-beg) (forward-line 1))
_rc))
;; (tx-editing-move-word-start-across-page-break-omg-hyphen)
(defun tx-editing-move-word-start-across-page-break-omg-hyphen nil
"Point should be at beginning of line of first line of page.
f2 f7 runs the command tx-editing-insert-page-break-mid-paragraph"
;;
(interactive)
(let (_str _pt-beg
_rc)
(save-excursion
(save-match-data
;; NOTE: Previous movement was to search-forward for page# and
;; maybe skip over __NOTE__ ... "
;;
(interactive "p")
;; fix! After inserting page number, if page above has footnote,
;; display end of body text in message area. 2007.06.15
;; fix! 2007.11.07 - ignore __RUNNING_HEADER__ when joining pg-break word.
;;
;; 129
;;
;; __RUNNING_HEADER__
;; N. I. NAUMOV
;;
(let (_pt
_rc)
;; fix! does NOT delete
... pair can be deleted. ;; fix? ;; Function (lb-tx-what-page) works when page numbers at top of page. ;; What about at bottom of page? ;; page number (save-excursion (insert "\n\n" (int-to-string (1+ (string-to-int ;; 2006.10.03 ;; Just use first page number up. ;; Page numbers down may be unedited !!! ;; (lb-tx-what-page) (save-excursion ;; 2007.04.04 (if (search-backward-regexp lb-re-bracketed-para-integer nil t) (match-string-no-properties 1) (if (search-backward-regexp lb-re-bracketed-para-integer-top-of-file nil t) (match-string-no-properties 1) ;; First page number at bottom! (int-to-string (1- (* 100 (string-to-int (substring (file-name-sans-directory (bfn)) 0 1))))) )))))) "\n\n")) ;; Point above new page number. ;;
(tx-sbr-not-whitespace t) ;; fix! 2007.11.14 - make this movement into a function. ;; Skip back over ... 1 of 2. (while (or (string-match "^]*[>]\\)")) (replace-match (concat "") t t nil 1)) ;; fix! use tx-editing-compress-here-multiple-newlines instead. (cmn) ;; 2006.12.28 (tx-editing-move-word-start-across-page-break-omg-hyphen) (recenter) _rc)) ;; fix!!! Does _-move-backward-whitespace treat -9 in ^M-9 as whitespace?!?!? ;; fix!!! Does _-move-backward-whitespace treat -9 in ^M-9 as whitespace?!?!? ;; fix!!! Does _-move-backward-whitespace treat -9 in ^M-9 as whitespace?!?!? ;; fix!!! Does _-move-backward-whitespace treat -9 in ^M-9 as whitespace?!?!? ;; fix!!! Does _-move-backward-whitespace treat -9 in ^M-9 as whitespace?!?!? ;; fix!!! Does _-move-backward-whitespace treat -9 in ^M-9 as whitespace?!?!? ;; fix!!! Does _-move-backward-whitespace treat -9 in ^M-9 as whitespace?!?!? ;; fix!!! Does _-move-backward-whitespace treat -9 in ^M-9 as whitespace?!?!? ;; fix!!! Does _-move-backward-whitespace treat -9 in ^M-9 as whitespace?!?!? ;; fix!!! Does _-move-backward-whitespace treat -9 in ^M-9 as whitespace?!?!? ;; fix!!! Does _-move-backward-whitespace treat -9 in ^M-9 as whitespace?!?!? (defun tx-sbr-not-whitespace (&optional arg1) "sbr=search-backward-regexp If ARG1 is non-nil, treats carriage returns as white space. Treats '-9' after carriage return as part of whitespace." (let ( _rc) ;; This could be the "9" in "^M-9" ;; 1 of 2. (search-backward-regexp (concat "[^ \t\n" (if arg1 "\r") "]")) (if arg1 (when (or (save-excursion (forward-char -2) ;; ^M-9 (looking-at "[\r][-][0-9]")) (save-excursion (forward-char -3) ;; ^M-10 (looking-at "[\r][-][0-9][0-9]"))) (search-backward-regexp "[\r]") ;; ;; 2 of 2. (search-backward-regexp (concat "[^ \t\n" (if arg1 "\r") " ]")))) _rc)) (defun tx-editing-insert-tx-header (arg1) "" ;; (interactive "p") (_-dfun-hook "tx-editing-insert-tx-header") (let (lb-str lb-pf-000 lb-pf-099 lb-pf-used lb-str-header lb-pfo lb-read _rc) (if (looking-at (concat _-whitespaces-wM "")) (replace-match "")) (if (looking-at (concat _-whitespaces-wM "
")) (replace-match "")) (progn (setq lb-pf0 (bfn)) (setq lb-pf-099 (concat (file-name-directory lb-pf0) "099." lb-ext-tx)) (setq lb-pf-000 (concat lb-home (lb-get-lang-from-path lb-pf0) "/000.t")) (setq lb-str-header (with-temp-buffer (_-ifcl (if (and (file-exists-p lb-pf-099) (not (string= lb-pf0 lb-pf-099))) (setq lb-pf-used lb-pf-099) (setq lb-pf-used lb-pf-000))) (goto-char (point-min)) (search-forward-regexp (concat _-whitespaces-wM "[[]BEGIN[]]" _-whitespaces-wM)) (buffer-substring-no-properties (point-min) (if (string= lb-pf-used lb-pf-000) (match-end 0) (match-beginning 0)))))) (goto-char (point-min)) (with-temp-buffer (insert lb-str-header) ;; on-the-fly (goto-char (point-min)) (search-forward-string "__WHERE_PAGE_NUMBERS__") (when (string= lb-pf-used lb-pf-000) (while (not (string-match "^[bBtT]" (setq lb-read (read-input (concat "Where page numbers? " "[tT]op? [bB]ottom? ")))))) (_-move-forward-whitespace) (kill-line) (if (string-match "^[tT]" lb-read) (insert "top") (insert "bottom"))) ;; Maybe remove page number "[1]". (when (search-backward-regexp (concat "\n" "\\(" "[[][01][]]\n\n" "\\)") nil t) (replace-match "\n" t t nil 1)) ;; (goto-char (point-min)) (search-forward-string "__OCR__") (setq lb-str (concat "ABBYY 6 Professional (" ;; fix? modification date of .ht file? (lb-date-YYYY.MM.DD) ")")) (_-move-forward-whitespace) (kill-line) ;; 2007.08.23 (if t (setq lb-read "y") (while (not (string-match "^[yYnN]" (setq lb-read (read-input (concat "OCR [yYnN] ? " lb-str " "))))))) (if (not (string-match "^[y]" lb-read)) (error "%s: %s" "Error brought to you by" _-defun) (insert lb-str)) ;; DONE. (setq lb-str-header (buffer-string))) ;; (if (or (string= lb-home (setq lb-str (substring (abbreviate-file-name (bfn)) 0 (length lb-home)))) (string= lb-home-dat lb-str)) (if lb-str-header (insert lb-str-header "\n\n") (_-ifcl (concat lb-home lb-lang "/000.t"))) (error "%s: %s" "hay" "now")) (_-find-file-hooks-__-globals) (tx-editing-delete-hooks-early-on) (while (not (string-match "[oO][kK]" (read-input (concat "Please check MARKER_STYLEs !!! [ok]" " "))))) _rc)) (defun tx-editing-insert-_-_-_ (&optional arg1 arg2save) " Returns t if footnote bar _-_-_ was inserted. Leaves point before footnote bar. Optional ARG2, if non-nil, will save buffer and maybe run hooks" (interactive "p") (let (_pt _pt-inserted-_-_-_ _flag _str _rc) (save-match-data (save-excursion ;; 2007.10.15 ;; WAS IN: defun tx-editing-yank ;;; (when (and (looking-at (concat _-whitespace-wM "*" "" ;;; _-whitespace-wM "*" ;;; "[~]?")) ;;; (goto-char (match-end 0))) ;;; (when ;;; (or ;;; (looking-at (concat "\\(\\^\\)*" ;;; "[*]" ;;; "\\(\\^\\)*" ;;; " ")) ;;; (looking-at (concat "\\^\\^" ;;; "[0-9]+" ;;; "\\^\\^" ;;; " "))) ;; fix! ;; move this to lb-defvar.el (setq lb-re-temp-footnote-to-first-marker (concat _-whitespace-wM "*" "
]*>" _-whitespace-wM "*" "[~]?" "\\(" "\\^\\^[0-9]+\\^\\^" "\\|[*]+" "\\|\\^\\^[*]+\\^\\^" "\\)")) (progn ;; fix? - this seems GP (general purpose); move to separate defun? (if (not (save-excursion (search-forward-regexp _-^whitespace-wM nil t))) (_-move-backward-whitespace)) ;; 2007.07.31 (lb-tx-move-away-from-page-number-paragraph) ;; fix? - this seems GP (general purpose); move to separate defun? (if (looking-at "[ \t]*[\r]") (goto-char (match-end 0)))) (when (and (or tx ;; This called as a hook from backward-kill-word-sgml-my ! (string-match "[.]tx$" (bfn))) ;; No "_-_-_" yet. (not (lb-tx-page-point "footnotes-beg")) ;; Start with point above first footnote. (looking-at (concat lb-re-temp-footnote-to-first-marker)) ;; Do not add footnotes beyond NOTES. (save-excursion (setq _flag nil) (while (and (not _flag) (search-backward-string "__ALPHA_LVL1__" nil t)) (setq _str (_-compress-delete-whitespaces (_-sgml-del-markup (lb-db-__-del-__ (car (_-para)) t)) t)) (if (or (string= "NOTES" _str) (string= "NOTAS" _str)) (setq _flag _str))) (not _flag))) ;; Insert. (progn (_-move-backward-whitespace) (save-excursion (insert "\n\n" lb-str-footnote-_-_-_ "\n\n")) (setq arg2 t) (_-move-forward-whitespace) (setq _pt-inserted-_-_-_ (point)) (setq _rc t)) (when ;; Delete previous
? (and nil ;; 2007.02.08 - this slows things down too much. (progn (tx-sbr-not-whitespace t) (looking-at ">")) (progn (search-backward "<") (not (looking-at "")))) ;; (when (string-match "^[yY]" (read-input (concat "... " (buffer-substring-no-properties (save-excursion (goto-char (- _pt-inserted-_-_-_ 20)) (search-backward-regexp "[ \t\n]") (1+ (point))) _pt-inserted-_-_-_) " <<<===DELETE======>>> ? ") (list "n") nil)) (search-forward-regexp "<[^>]+[>]") (replace-match ""))) (progn (goto-char _pt-inserted-_-_-_) (lb-ht-insert-^^-around-footnotes-asteriks) (cmn)) ;; Run hook that checks for balanced footnote markers: (if arg2save (save-buffer)) ) )) _rc)) ;; (lb-edits-pf-push) (defun lb-edits-pf-push nil "Return current buffer-file-name with \".\" lb-ext-edits-push" ;; (let ((lb-bfn (buffer-file-name)) (lb-rc (concat (buffer-file-name) "." lb-ext-edits-push))) (if (string-match "push$" lb-bfn) (error "%s: %s" "Function should not work with extension" lb-ext-edits-push)) ;; fix? ;; error if file exists? lb-rc)) (defun lb-edits-push-paragraph (&optional args) "Delete and append current paragraph (or next, if point inbetween two paragraphs) to file FILE.push. Like kill-paragraph, but will kill from beginning of paragraph if point in middle of paragraph. Also, paragraphs separated by blank lines: see _-para See also C-c C-k" ;; (interactive "p") (let (lb-buffer (lb-pf-push (lb-edits-pf-push)) lb-rc) ;; fix? ;; Add to kill ring? ;; Must kill push buffer before deleting paragraph! (progn ;; Kill buffer with push if necessary. (if (setq lb-buffer (find-buffer-visiting lb-pf-push)) (kill-buffer lb-buffer)) ;; fix? ;; make function? ;; or? ;; just unconditionally use? (_-move-forward-whitespace t) (progn ;; If point is at end of a paragraph, move to next paragraph. (progn ;; By default, _-para includes trailing whitespace. (if (looking-at "[ \t\m]$") (goto-char (match-end 0))) (if (= (point) (cdr (cdr (_-para)))) (forward-char 1))) ;; While point is in blank line, move it forward. (while (_-blank-line-p) (end-of-line) (forward-char 1))) (setq lb-rc (_-para-delete))) (with-temp-buffer (if (file-exists-p lb-pf-push) (insert-file-contents-literally lb-pf-push)) (goto-char (point-max)) (insert "\n\n" lb-rc "\n\n") (_-compress-multiple-newlines) (write-region (point-min) (point-max) lb-pf-push)) ;; While point is in blank line, move it forward. (while (_-blank-line-p) (end-of-line) (forward-char 1)) (recenter) lb-rc)) (defun lb-edits-pop-file (args) "If file returned by [lb-edits-pf-push] exists, insert it literally, surrounded by blank lines, and delete it" ;; (interactive "p") (let (lb-rc (lb-pf-push (lb-edits-pf-push))) (when (file-exists-p lb-pf-push) (insert "\n\n") (insert-file-contents-literally lb-pf-push) (insert "\n\n") (basic-save-buffer-1) (delete-file lb-pf-push)) lb-rc)) ;; ;; (defun ht-editing-insert-link-in-link-htmm nil "ADD NEW RECORD to Links.htmm" ;; (interactive) (let ( lb-rc) (save-excursion (while (search-backward-string (concat "<""li>") nil t) (if (not (string-match (concat "^ <""li> ") (_-current-line))) (error "%s: %s" "Misaligned" (_-current-line)))) (setq _d (lb-date-YYYY.MM.DD)) (setq _t (read-input "TITLE: ")) (setq _h (read-input "http HREF: ")) (setq _w (read-input "When? ")) ;; WHEN (setq _c (read-input "Where? ")) ;; CITY (setq _s0 (concat " <""li> " _t)) (setq _s (concat _s0 "\n" "