;;
;; Emacs-Time-stamp: "2010-04-24 23:58:01"
(setq file-stamp "Emacs-File-stamp: \"/home/ysverdlov/leninist.biz/lb-misc.el\"")
;;
;; simple.el ::
(defun backward-kill-word (arg)
"Kill characters backward until encountering the beginning of a word.
With argument, do this that many times."
(interactive "p")
(let (_del-ampersand _rc)
;;
(sex
(_-move-backward-whitespace)
(if (looking-back-at "&[^ \t\n\r]+;")
(setq _del-ampersand t)))
(kill-word (- arg))
(if (and _del-ampersand
(looking-back-at "&[#]?"))
(kill-region (point) (progn (forward-char
(- (match-beginning 0) (match-end 0)))
(point))))
_rc))
;;
;; simple.el ::
(defun kill-word (arg)
"Kill characters forward until encountering the end of a word.
With argument, do this that many times."
(interactive "p")
(let (_del-semicolon _rc)
;;
(sex
(_-move-forward-whitespace)
(if (looking-at "&[^ \t\n\r]+;")
(setq _del-semicolon t)))
(kill-region (point) (progn (forward-word arg) (point)))
(if (and _del-semicolon
(looking-at ";"))
(kill-region (point) (progn (forward-char 1) (point))))
_rc))
;;
(when nil
(loop for i in kill-ring
do
(insert i "\n\n* * *\n\n")) (setq kill-ring nil))
;; (lb-db-zerobyte-p "~/leninist.biz/en/1978/SR354/.index")
(defun lb-db-zerobyte-p (arg1pf)
""
;;
(let (_rc)
(if (= 0 (nth 7 (file-attributes arg1pf)))
(setq _rc t))
_rc))
;; Used by hooks:
(defun lb-bfn-to-url (arg1bfn)
""
;; (lb-bfn-to-url (buffer-file-name)) => "http://leninist.biz/lb.el"
(let (x)
(save-match-data
(and (string-match abbreviated-home-dir (setq x (buffer-file-name)))
(string-match "^~" (setq x (replace-match "~/" t t x)))
(replace-match "http:/" t t x)))))
;; Used by hooks:
(defun lb-date-verbal nil
"Now"
;; (lb-date-verbal) => "2005 May 31"
(with-temp-buffer
;; (shell-command "822-date" t)
(insert (format-time-string "%Y %B %d"))
(buffer-substring-no-properties (point-min) (point-max))))
(defun lb-date-YYYY.MM.DD nil
"Now"
;; (lb-date-verbal) => "2005 May 31"
(with-temp-buffer
;; (shell-command "822-date" t)
(insert (format-time-string "%Y.%m.%d"))
(buffer-substring-no-properties (point-min) (point-max))))
;; (lb-date-YYYY.MM.DD-add-a-day "20090531")
;; (lb-date-YYYY.MM.DD-add-a-day "20091231") _> "20100101"
(defun lb-date-YYYY.MM.DD-add-a-day (arg1YYYYMMDD)
""
;;
(let ((_rc arg1YYYYMMDD))
;; 2009.06.01
(cond
((string-match "0131$" _rc)
(setq _rc (replace-match "0200" nil nil _rc)))
((string-match "0229$" _rc)
(setq _rc (replace-match "0300" nil nil _rc)))
((string-match "0331$" _rc)
(setq _rc (replace-match "0400" nil nil _rc)))
((string-match "0430$" _rc)
(setq _rc (replace-match "0500" nil nil _rc)))
((string-match "0531$" _rc)
(setq _rc (replace-match "0600" nil nil _rc)))
((string-match "0630$" _rc)
(setq _rc (replace-match "0700" nil nil _rc)))
((string-match "0731$" _rc)
(setq _rc (replace-match "0800" nil nil _rc)))
((string-match "0831$" _rc)
(setq _rc (replace-match "0900" nil nil _rc)))
((string-match "0930$" _rc)
(setq _rc (replace-match "1000" nil nil _rc)))
((string-match "1031$" _rc)
(setq _rc (replace-match "1100" nil nil _rc)))
((string-match "1130$" _rc)
(setq _rc (replace-match "1200" nil nil _rc)))
((string-match "1231$" _rc)
(setq _rc (replace-match "0100" nil nil _rc))
;;
(progn
(string-match "\\([0-9][0-9][0-9]\\)....$" _rc)
(setq _rc (replace-match
(format "%03d"
(1+ (string-to-number
(match-string-no-properties 1 _rc))))
nil nil _rc 1)))))
(setq _rc (number-to-string (1+ (string-to-number _rc))))
_rc))
;;
(defun lb-time-stamp-format nil
""
(let ((lb-bfn (buffer-file-name)))
(if (string-match lb-domain lb-bfn)
(set (make-local-variable 'time-stamp-format)
"%:y-%02m-%02d %02H:%02M:%02S"))))
(defun lb-test-prefixarg-prefix-arg (&optional arg)
"If interactive is *p, argument will *always* be a number (1 w/o prefix arg).
If interactive is *P, argument will be nil if no prefix argument used"
(interactive "*P")
;;(interactive "*P") ; nothing: nil; C-u: (4); C-u 3: 3;
;;(interactive "*p") ; nothing: 1; C-u: 4; C-u 3: 3;
(message "%s" (prin1-to-string arg)))
;; (lb-shell-find "en/1972/H306" "pdf")
(defun lb-shell-find (arg1subpath &optional arg2ext)
"Find text, say .tx, files using shell-command in folder
retrieved by lb-ht-get-copy-directories with argument ARG1.
Optional ARG2 changes filename extension and skips the fancy function"
;;
(let (lb-pf lb-list
_rc)
(if arg2ext
(setq lb-pf (concat lb-home arg1subpath))
(setq arg2ext lb-ext-tx)
;;
(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))))
;; ALTERNATIVE:
(when t
(with-temp-buffer
(shell-command
(concat "find " lb-pf " -follow -type f -name '[0-9][0-9][0-9]."
arg2ext "'") t)
(shell-command
(concat "find " lb-pf " -follow -type f -name '[0-9][0-9][0-9][0-9]."
arg2ext "'") t)
;; 2009.04.04
;; find: .....en/1972/H306/.#index.html: No such file or directory
(goto-char (point-min))
(flush-lines "^find: ")
(sort-lines nil (point-min) (point-max))
(setq _rc (_-something-to-list))))
;; ALTERNATIVE:
(when nil
(setq lb-pf (concat lb-home arg1subpath "/" lb-file-tx))
(setq _rc (list lb-pf)))
_rc))
;; (lb-delete-files "~/leninist.biz/en/1989/HCM243/" "HTML document text")
(defun lb-delete-files (arg1path arg2file-filetype)
""
;;
(let (lb-filelist
lb-filetype
_rc)
(save-match-data
(loop for file in (directory-files arg1path t)
do
(if
(and
;; OPTIONAL:
(not (string-match "[.]jp[e]?g$" file))
;; MANDATORY:
(string= arg2file-filetype (_-filetype file)))
(setq lb-filelist (append
lb-filelist (list file)))))
(loop for file in lb-filelist
do
(delete-file file)))
_rc))
;;
(defun tab-renumber-col- (&optional arg1col)
"
Start with point on last line with correct number"
;;
;; hrefs 16 4-I . z
;; hrefs 17 4-1 . z
;; hrefs 17 4-2 . z
;; hrefs 18 4-3 . z
(interactive)
;; fix!
;; Leave trailing hypen alone if "[introduction.]" in description.
;; fix! Re-use code that checks for .ABC at end of filename.
(let (_re-col _n
_line _col
_pt-dash-tab
_trailing-pounds
_flag-roman-numerals-after-trailing-dash
_col-roman-numerals-after-trailing-dash
(_cnt-roman-numerals-after-trailing-dash -1)
_rc)
(save-excursion
;; 2010.02.07
(gpm)
(if (sfr "[#][0-9]" nil t)
(error "%s: %s" "Put # signs *AFTER* number" (_-current-line)))
;; 2007.03.28
(goto-char (point-min))
(tx-move-forward-past-pound-comment-lines)
(beginning-of-line)
(if (not arg1col)
(setq arg1col (string-to-number (read-input "Col? "))))
(setq _re-col "^[^\t]+")
(loop for i from (1+ (- arg1col (1- arg1col))) to arg1col
do
(setq _re-col (concat _re-col
"\t" "\\([^\t]*\\)")))
(beginning-of-line)
(while
(and
(search-forward-regexp _re-col nil t)
(setq _msnp1 (match-string-no-properties 1))
;; Ignore "#" at end of string in target column.
(save-match-data
(setq _trailing-pounds
(if (string-match
;; 2006.12.04 - Keep letter-for-sorting.
;; "[#]+$"
"[a-z]?[#]+$"
_msnp1)
(match-string-no-properties 0 _msnp1) ""))
t)
(progn
(replace-match
(concat
(format "%02d"
(setq _n
(+
(if (string= "" _trailing-pounds)
1 0)
(if (not _n)
(setq _n
(1- (string-to-number _msnp1))
)
_n)
)))
_trailing-pounds)
t t nil 1)
t)
) ;; and
;; fix!
;; "ABC-" has to be done manually; after that,
;; skip if only one instance; it means "introduction":
;;; hrefs 40 CAK- . z
;;; hrefs 41 CAK-I . z
;; fix!
;; Does not detect change of root name when two blocks are
;; next to one another; e.g., below no "QIRH-I"
;;; hrefs 18 EF- . [ON THE ``ECONOMIC FACTOR'' ...
;;; hrefs 18 EF- . [ON THE ``ECONOMIC FACTOR'' ...
;;; hrefs 19 QIRH- . ON THE QUESTION OF THE INDIVIDUAL'S ...
;;; hrefs 19 QIRH- . ON THE QUESTION OF THE INDIVIDUAL'S ...
(if ;; Try to append Roman numerals after a trailing dash.
(or
;; 2006.10.04 - Allow "ABC-" to mean introduction.
(string-match "[[]introduction[.]?[]]" (setq _line (_-current-line)))
(string-match "INTRODUCTION$" (setq _line (_-current-line)))
(not
(string-match "[a-z0-9A-Z][-][\t]" _line)
))
;; RESET.
(progn
(setq _col-roman-numerals-after-trailing-dash
(setq _flag-roman-numerals-after-trailing-dash nil))
(setq _cnt-roman-numerals-after-trailing-dash -1))
;; Where was that?
(setq _pt-dash-tab (+
(save-excursion
(beginning-of-line) (point))
(match-end 0)))
;; Was question asked for this group before?
(if
(not
_flag-roman-numerals-after-trailing-dash)
(while
(not
(setq
_flag-roman-numerals-after-trailing-dash
;; fix! change this to the read that just needs 'y' w/o ENTER.
(read-input
(concat
(substring _line 0 (match-end 0))
"ROMAN NUMERALS? "
))))))
;; Count tabs to left.
(if (and
(setq _col
(1-
(length
(split-string
(substring _line 0 (match-end 0)) "[\t]"
;; 2009.05.31 - omit-nulls in split-string !!
t))))
_col-roman-numerals-after-trailing-dash
(/= _col
_col-roman-numerals-after-trailing-dash))
(error "%s: %s" "oh" "no")
(setq _col-roman-numerals-after-trailing-dash _col))
;; Add Roman numeral.
(when (string-match "[^nN]*[yY]"
_flag-roman-numerals-after-trailing-dash)
(setq _cnt-roman-numerals-after-trailing-dash
(1+ _cnt-roman-numerals-after-trailing-dash))
(goto-char (1- _pt-dash-tab))
(insert
(nth _cnt-roman-numerals-after-trailing-dash
lb-list-roman-numerals)))
) ;; if has dash-tab
) ;; while
) ;; save-excursion
(occur (concat "[.]"
;; 2010.02.09
;; "..."
"[^0-9][^0-9][^0-9]"
"[\t]"))
;; 2010.01.27
(save-excursion
(goto-char (point-min))
(sfs lb-str-emacs-file-stamp)
(sfr lb-re-path-year+book nil nil)
(set-register ?i (concat
(match-string-no-properties 2)
"/" (match-string-no-properties 3)))
;; 2010.03.05
(ffow (concat lb-home
;; 2010.04.11
;; lb-lang
(lb-get-lang-from-path (bfn))
;;
"/" lb-f-last-numbered-page))
(message "%s: %s"
(concat
"Now, edit ../../" lb-f-last-numbered-page " with ?i (C-x r i i) = ")
(get-register ?i)))
_rc))
;;
(defun lb-wdiff (arg1pfnew arg2action)
"ARG1 is disk-file in the process of creation.
If nil, defaults to lbg-wdiff-pf.
ARG2 is 'beg' (before disk-write) or 'end' (after disk-write)"
;;
(let (_list _pf
(_ext ".wdiffin")
_rc)
(if arg1pfnew
(setq lbg-wdiff-pf arg1pfnew)
(setq arg1pfnew lbg-wdiff-pf))
(setq _pf (concat arg1pfnew _ext))
(cond
((string= "beg" arg2action)
(if (file-exists-p _pf)
(delete-file _pf))
(if (file-exists-p arg1pfnew)
(copy-file arg1pfnew _pf)))
((string= "end" arg2action)
(if (not (file-exists-p _pf))
(setq _list (list "a" "b" "c"))
;;
(with-temp-buffer
;; wdiff ignores changes to whitespace.
(shell-command (concat "wdiff " _pf " " arg1pfnew) t)
(goto-char (point-min))
(while (search-forward-string "[-" nil t)
(setq _list (append _list (list (_-current-line))))
(if (not (search-forward-string "-]" nil t))
(error "%s: %s" "Did not find '-]' ...maybe file has '[-'?"
(_-buffer-substring-from-))))
(goto-char (point-min))
(while (search-forward-string "{+" nil t)
(setq _list (append _list (list (_-current-line))))
(search-forward-string "+}"))
))
;;
;; Check.
(if (not _list) (error "%s: %s"
"Got wdiff? Why no differences, not even time-stamps?"
_pf))
;;
(if (or (> (length _list)
;; 1
2 ;; 2010.02.13 - Would file-stamp also be different?
)
(or (not (string-match "Emacs-Time-stamp:" (car _list)))
(not (string-match "Emacs-File-stamp:" (nth 1 _list)))))
(lb-lftp-dosomething-file arg1pfnew))
;;
(if (file-exists-p _pf) (delete-file _pf)))
;; ---------------------------------
(t
(error "%s: %s" "Programming" "error")))
_rc))
;; (setq lb-index-htm "~/leninist.biz/en/./1973/PHP462/index.html")
;; (lb-make-href-relative-by-stripping-home lb-index-htm)
(defun lb-make-href-relative-by-stripping-home (arg1pf)
""
;;
(let (
(_rc arg1pf))
(save-match-data
;; Removes any embedded "/./"
(setq _rc (expand-file-name _rc))
;;
(if (string-match
(concat "^" (expand-file-name lb-home))
_rc)
(setq _rc (substring _rc (match-end 0)))
(error "%s: %s" lb-home _rc)))
_rc))
;; (ffow "~/.emacs")
(defun ffow (arg1pf)
""
;;
(let ( _rc)
(delete-other-windows)
(split-window)
(find-file-other-window arg1pf)
(setq _rc (current-buffer))
_rc))
(provide 'lb-misc)
;;;
;