;;;
;;; See: http://www.lafn.org/~cymbala/bin/lia_qual.html
;;;
;;; Emacs-Time-stamp: "2004-03-01 21:16:38 cymbala"
;;; Emacs-File-stamp: "/floppy/Lia/lia_qual.el"
;;;
;;; Names of functions begin "rjc-" if only used by me; begin "my-" if
;;; function might be useful to others.
(defun rjc-find-file-in-volume (args)
"Open HTM file described by anchor containing point in a volume##.htm"
;;
(interactive "P")
(let (
(my-upload-sh "~/www.marxists.org/archive/lenin/works/upload.sh")
(my-pathfile-root "~/www.marxists.org/archive/lenin/works/")
(my-list nil)
(my-regexp nil)
(my-pathfile nil)
(my-bound-lo nil)
(my-bound-hi nil)
)
(save-excursion
(save-restriction
(setq my-list (split-string (buffer-file-name) "/"))
(setq my-regexp "^volume[0-9][0-9]\.htm$")
(if (not
(string-match my-regexp
(nth (- (length my-list) 1) my-list)))
(message (concat
"Error: buffer-file-name does not match " my-regexp))
(setq my-bound-lo (search-backward-regexp "<[aA]"))
(search-forward-regexp
"[hH][rR][eE][fF]=\"\.\./\\([^\"]+\\)\"")
(setq my-pathfile (match-string-no-properties 1))
(setq my-bound-hi (search-forward-regexp "</[aA]"))
;; Set register x (a.k.a. 120) to name= value if it exists.
(if (search-backward-regexp
"[nN][aA][mM][eE]=\"\\([^\"]+\\)\""
my-bound-lo t)
(set-register 120 (match-string-no-properties 1)))
;; Queue for upload.
(find-file my-upload-sh)
(beginning-of-buffer)
;; (search-forward "x=\"$x ") (beginning-of-line)
(newline) (forward-char -1)
(insert (concat "x=\"$x " my-pathfile "\""))
(bury-buffer)
;; Edit file.
(if (= 1 (count-windows)) (split-window-vertically))
(find-file-other-window
(concat my-pathfile-root my-pathfile)))))))
(defun rjc-itemize-add-row (args)
"Add new row and add 1 to last number: '00#.00#.00#[^.]'"
;;
;; Example:
;; 01.001.0000-New Economic Developments in Peasant Life <--given
;; 01.001.0001- <--row added
;;
(interactive "P") (beginning-of-line)
; Build new row data.
(setq a "")
(if (looking-at "[0-9]") nil (error "Missing row ID."))
(while (looking-at "[0-9]")
(search-forward-regexp "\\([0-9]+\\)\\(\\.?\\)" nil t)
(setq z (buffer-substring (match-beginning 1) (match-end 1)))
(setq a (concat (if (> (length a) 0)
(concat a ".")
a)
(format (concat
"%0" (int-to-string (length z)) "d")
;
; Add 1 to last portion ONLY.
(+ (if (equal "." (match-string-no-properties 2))
0 1)
(string-to-int z))))))
;
; Add separator.
(setq a (concat a (buffer-substring (match-end 0) (+ 1 (match-end 0)))))
;
; Add new row.
(end-of-line)
(open-line 1)
(next-line 1)
(insert a)
(recenter))
(defun rjc-itemize-increment-row (args)
"Add 1 to last number (numeric prefix argument modifies n rows):
'00#.00#.00#[^.]'"
;;
;; Example:
;; 01.001.0000- <--given
;; 01.001.0001- <--results
;;
(interactive "P")
;; (save-excursion
(save-restriction
(let ((my-spam nil)
(my-n))
(setq my-n (if (numberp args) args 1))
(while (> my-n 0)
(setq my-n (- my-n 1))
(beginning-of-line)
; Build new row data.
(setq a "")
(while (looking-at "[0-9]")
(search-forward-regexp "\\([0-9]+\\)\\(\\.?\\)" nil t))
(setq my-spam (buffer-substring (match-beginning 1) (match-end 1)))
(delete-region (match-beginning 1) (match-end 1))
(insert (format (concat
"%0" (int-to-string (length my-spam)) "d")
(+ (string-to-int my-spam) 1)))
(next-line 1)
(recenter)))))
;;; Sat Oct 5 11:37:42 PDT 2002
(defun rjc-itemize-insert-next-document (args)
""
(interactive "p")
(let (
(my-bar nil)
(my-point nil)
(my-string nil)
(my-vol nil)
(my-text nil))
(beginning-of-line)
(if (looking-at (concat
"\\(0[0-9][0-9]\\)"
"\.\\([0-9][0-9][0-9]\\)"
"\.\\([0-9][0-9][0-9][0-9]\\) "))
(progn
(setq my-vol (match-string-no-properties 1))
(setq my-text (match-string-no-properties 2))
(setq my-string (concat
my-vol "."
(format "%03d" (+ 1 (string-to-number my-text))) "."
"000"))
(setq my-point (point))
(search-backward-regexp "\\(#\-\-+\\)")
(setq my-bar (match-string-no-properties 0))
(goto-char my-point) (end-of-line)
(newline) (insert (concat my-string "0 " my-bar))
(newline) (insert (concat my-string "0 () "))
(newline) (insert (concat my-string "0: (+ 0 ) "))
(rjc-itemize-add-row nil)
(backward-delete-char 1) (insert " ")
(search-backward "()") (search-forward " ")))))
(defun rjc-footnote-increment (args)
"Add n to footnote number"
;;
;; Example:
;; ...<a href="#3n" name="3.">[3]</a> :in body.
;; ...<a href="#3." name="3n">[3]</a> :in footnotes.
;;
(interactive "P")
;; (save-excursion
(save-restriction
(let ((my-spam nil)
)
(setq my-n (if (numberp args) args 1))
(while (> my-n 0)
(setq my-n (- my-n 1))
(setq my-point-before (point))
; Begin.
(search-backward-regexp "<a[\n\\s ]+href=\"#" nil nil)
;
(search-forward-regexp "[0-9]+" my-point-before nil)
(setq my-beginning-href (match-beginning 0))
(setq my-s-before (match-string-no-properties 0))
(search-forward-regexp "[n.]\"[\n\\s ]+name=\"" my-point-before nil)
(if (not (looking-at my-s-before))
(error (concat "Value of name= is not: " my-s-before))
nil)
(search-forward-regexp "[0-9]+" my-point-before nil)
(setq my-beginning-name (match-beginning 0))
(search-forward-regexp "[n.]\">\\[" my-point-before nil)
(if (not (looking-at my-s-before))
(error (concat "Value of footnote number is not: " my-s-before))
nil)
(search-forward-regexp "[0-9]+" my-point-before nil)
(setq my-beginning-number (match-beginning 0))
(setq my-n-before (string-to-int my-s-before))
;
(goto-char my-beginning-number)
(delete-char (length my-s-before))
(insert (int-to-string (+ rjc-footnote-increment-n my-n-before)))
(goto-char my-beginning-name)
(delete-char (length my-s-before))
(insert (int-to-string (+ rjc-footnote-increment-n my-n-before)))
(goto-char my-beginning-href)
(delete-char (length my-s-before))
(insert (int-to-string (+ rjc-footnote-increment-n my-n-before)))
(goto-char my-point-before)
; Move right if previous number was "9"s.
(if (string-match "^9+$" my-s-before)
(forward-char 3)
nil)
(recenter)))))
(defvar rjc-footnote-increment-n 18 "Amount to increase footnote")
;;; This one comes from a keyboard macro.
;;; 1. C-x ( to begin define macro
;;; 2. C-x ) to end define macro
;;; 3. M-x name-last-kbd-macro
;;; 4. M-x insert-kbd-macro
;;;
;;; Mon Mar 1 11:45:26 PST 2004
(defun my-check-hyperlink (href basehref type clobber)
""
;; (my-check-hyperlink "1906-aug-29"
"~/www.marxists.org/archive/lenin/works/cw" "name")
(interactive "*")
(if (equal "href" type)
(setq href (concat basehref "/" href))
(if (equal "name" type)
(progn
;; Change "-" to "/", and add "../" to beginning and ".htm" to end.
(setq href (concat "../" href ".htm"))
(setq my-string nil)
(loop for i in (substitute 47 45 (string-to-sequence href 'list))
do (setq my-string (concat my-string (char-to-string i))))
(setq href (concat basehref "/" my-string)))
(error (concat "Unknown argument: " type))))
(when (and (not (string-match "cw/volume[0-4][0-9][.]htm" href))
(not (string-match "cw/../../index.htm" href)))
;; Does directory exist? Error if it doesn't exist.
(if (not (file-directory-p (file-name-directory href)))
(error (concat "Directory does not exist: " (file-name-directory href))))
(unless clobber (if (file-exists-p href)
(error (concat "File already exists: " href)))) href))
;;; Sun Sep 15 23:01:07 PDT 2002
(defun my-check-hyperlink-collisions (clobber)
"Abort if an HREF value in buffer collides with an existing file"
;; Return base HREF.
(interactive "*")
(let ((my-href nil)
(my-href-list ())
(my-directory nil)
(my-point-min -1)
(my-base-href nil)
(my-base-href-default "~/www.marxists.org/archive/lenin/works/cw")
;;
;; Above default will work on server or on local hard drive if
;; _ON SERVER_ ~/www.marxists.org is a symlink to
;; /www/public_html !
;; Where did ~/www.marxists.org come from?
;; _ON LOCAL HARD DRIVE_,
;; ``cd ; wget --no-parent --recursive http://www.marxists.org/...''
;; puts everything under ~/www.marxists.org !
;; This rsync syntax uses directory hierarchy created by wget:
;; ``rsync ... ''
)
(defun my-href-list-handler (my-href-candidate)
"Add string to list otherwise abort if it already exists"
(if (member
my-href-candidate my-href-list)
(error "%s %s"
"Duplicate HREF in buffer:" my-href-candidate)
(message (concat "Adding " my-href-candidate "..."))
(setq my-href-list
(append (list my-href-candidate) my-href-list))))
(save-excursion
(save-restriction
;; Set base directory.
(goto-char (point-min))
(if (not
(file-directory-p
(if (search-forward-regexp "<[bB][aA][sS][eE]" nil t)
(if (search-forward-regexp
"[ \t\n]+[hH][rR][eE][fF]=\"\\([^\"]+\\)\"")
(setq my-base-href (match-string-no-properties 1)))
(setq my-base-href my-base-href-default))))
(error (concat "Not a directory: " my-base-href " !")))
;; Ex.: <base href="~/www.marxists.org/archive/lenin/works/cw">
;; ...and remove trailing slashes...
(while (string-equal
"/" (substring my-base-href (- (length my-base-href) 1)))
(setq my-base-href
(substring my-base-href 0 (- (length my-base-href) 1))))
(message "%s %s" "Setting base directory..." my-base-href)
;; TO-DO: check for conflicting name= and href= values.
;; To skip HREF= in <base> do _NOT_ do (beginning-of-buffer)!
(search-forward-regexp "<[Bb][Oo][Dd][Yy]")
(setq my-point-min (point))
(setq my-href-list ())
(while (search-forward-regexp
(concat
"\\([hH][rR][eE][fF]\\)=\""
"\\([^\"]+\\)" "\"") nil t)
(my-href-list-handler
(my-check-hyperlink (match-string-no-properties 2) my-base-href
(match-string-no-properties 1)
clobber)))
(setq my-href-list ())
(while (search-forward-regexp
(concat
"\\([nN][aA][mM][eE]\\)=\""
"\\([^\"]+\\)" "\"") nil t)
(my-href-list-handler
(my-check-hyperlink (match-string-no-properties 2) my-base-href
(match-string-no-properties 1)
clobber)))
(message "%s" "No collisions.")))
my-base-href))
;;;
;