;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; NAME:
;;	utilities.el
;;
(defconst cjw-utilities-version "$Id: utilities.el,v 1.18 2002/03/20 16:15:35 cwynne Exp $")
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SYNOPSIS:
;;	(load "utilities" nil t)
;;
;; DESCRIPTION:
;;	 "utilities" contains the following miscellaneous functions from
;;	  Karl E. Vogel <vogelke@c-17igp.wpafb.af.mil>.
;;
;;	cd (dir)
;;	file-name-sans-extension ()
;;	insert-time ()
;;	local-indent-region ()
;;	local-unindent-region ()
;;	regular-format-paragraph ()
;;	regular-format-region ()
;;	this-line-to-top-of-screen (line)
;;
;;	 I have added a few things.	 There is code to perform random sig
;;	 file insertions. 
;;
;;		mail-mc-sign-send (arg)
;;		mail-mc-sign-send-and-exit (arg)
;;		mail-signature-dir			*VARIABLE
;;		mail-signature-regexp		*VARIABLE
;;		mail-signature-local		*VARIABLE
;;		mail-signature-begin		 VARIABLE
;;		mail-signature-end			 VARIABLE
;;
;;		mail-signature-separator ()
;;		mail-insert-signature (arg)
;;		cjw-sig-function ()
;;		cjw-sig-num-to-name ()
;;		mail-signature-choose-random ()
;;
;;	 This stuff handles mail composition headers in various ways.
;;
;;		this-mail-field (field)
;;		this-mail-to
;;		mail-from ()
;;		mail-gcc ()
;;		mail-x-spool ()
;;		mail-remove-fcc ()
;;		mail-remove-replyto ()
;;		mail-remove-bcc ()
;;		mail-remove-gcc ()
;;		cjw-fix-mail-headers()
;;
;;	 A little miscellany...
;;
;;		find-info-file (file)
;;
;;		kill-current-buffer ()
;;
;;		scroll-up-line ()
;;		scroll-down-line ()
;;		cjw-kill-buffer-and-frame ()
;;
;;		cjw-fix-sentence-spacing ()
;;		cjw-fix-semicolons ()
;;
;;	 And a bunch of stuff to let TeX-mode deal with postscript files
;;	 more easily.
;;
;;		tex-dvips-command			*VARIABLE
;;		tex-ps-print-command		*VARIABLE
;;		tex-alt-ps-print-command	*VARIABLE
;;		tex-ps-view-command			*VARIABLE
;;		tex-dvips ()
;;		tex-ps-print ()
;;		tex-view-ps ()
;;
;;		tex-clear-tex-shell ()
;;
;; AUTHOR:
;;		Signature functions by Colin J. Wynne <cwynne@mts.jhu.edu>.
;;		additional written or found by Karl E. Vogel
;;		<vogelke@c-17igp.wpafb.af.mil>.
;;
;;		13.12.94: find-info-file added; taken from Dorai Sitaram
;;		<dorai@ses.com> in group comp.emacs.
;;
;;		20.12.94: kill-current-buffer added; suggestion by Kai Grossjohann
;;		<grossjoh@linus.informatik.uni-dortmund.de> in group gnu.emacs.help.
;;
;;	17.10.97: TeX ps handling commands added
;;
;; BUGS:
;;	None noticed yet.

;;
;; Change directory.
;;

(defun cd (dir)
  "Make DIR become the current buffer's default directory."
  (interactive "DChange default directory: ")
  (setq dir (expand-file-name dir))
  (if (not (eq system-type 'vax-vms))
	  (setq dir (file-name-as-directory dir)))
  (if (not (file-directory-p dir))
	  (error "%s is not a directory" dir)
	(setq default-directory dir))
  (pwd))

;;
;; Strip an extension from a filename.	Added by Karl Vogel.
;;

(defun file-name-sans-extension (name)
  "Return FILENAME sans dot extension."
  (substring name 0
		 (if (eq system-type 'vax-vms)
		 (or (string-match ".c$" name)
			 (string-match ".h$" name)
			 (length name))
		   (or (string-match ".c$" name)
		   (string-match ".h$" name)
		   (length name)))))

;;
;; Insert the current time into the buffer.
;;

(defun insert-time ()
  (interactive)
  (insert-string (current-time-string)))

;;
;; Indent or unindent the current region by a tab space.
;;

(defun local-indent-region ()
  "Indents the current region by one tab space."
  (interactive)
  (shell-command-on-region (point) (mark) "sed -e 's/^/		   /'" t))

(defun local-unindent-region ()
  "Un-indents the current region by one tab space."
  (interactive)
  (shell-command-on-region (point) (mark) "sed -e 's/^		  //'" t))

;;
;; Reformat current region or paragraph.
;;

(defvar cjw-par-command "par 70rT4bgqR 'B=.?_A_a' 'Q=_s>|'")

(defun cjw-reformat-paragraph ()
  "Runs CJW-PAR-COMMAND on the current paragraph of text."
  (interactive)
  (save-excursion
		(mark-paragraph)
		(shell-command-on-region (point) (mark) cjw-par-command t)))

(defun cjw-reformat-region ()
  "Runs CJW-PAR-COMMAND on the current region of text."
  (interactive)
  (shell-command-on-region (point) (mark) cjw-par-command t))

(defun cjw-reformat-region-or-paragraph (arg)
  "Reformat the current region using the par command.  If invoked with
a prefix argument, reformat the current paragraph instead."
  (interactive "P")
  (if arg (cjw-reformat-paragraph) (cjw-reformat-region)))

(defun cjw-html-reformat-next-par nil
  "Go to the next paragraph, starting with <p> and ending with
a blank line, and reformat it with par.	 Tabify the result."
  (interactive)
  (let (p)
	(search-forward "<p>")
	(beginning-of-line)
	(forward-line 1)
	(setq p (point))
	(re-search-forward "^[	]*$")
	(shell-command-on-region p (point) cjw-par-command t)
	(tabify p (point))
  )
)

(defun cjw-html-reformat-all-par nil nil
  (interactive)
  (save-excursion
	(while (cjw-html-reformat-next-par))
  )
)

;;
;; Put the current line at the top of the screen.  Usually mapped to
;; Control-L.
;;

(defun this-line-to-top-of-screen (&optional line)
  "Reposition line point is on to the top of the screen.  With ARG,
put point on line ARG.	Negative counts from the bottom."
  (interactive "P")
  (recenter
   (if line
	   (prefix-numeric-value line)
	 0)))


;;
;; Handles signature insertions.

(defvar mail-signature-dir "~/mail/.sigs/"
  "*Name of directory from which to extract random signature files.")
(defvar mail-signature-regexp nil
  "*Regexp to match names of sig files in MAIL-SIGNATURE-DIR.")
(defvar mail-signature-local "~/.sig.uka"
  "*Pathname of local signature file to be used when mail-choose-signature
is called with an optional prefix argument.")

(defvar mail-signature-begin nil
  "Beginning of last signature insertion.  Set by MAIL-INSERT-SIGNATURE.")
(defvar mail-signature-end	 nil
  "End of last signature insertion.	 Set by MAIL-INSERT-SIGNATURE.")

(defun mail-signature-separator nil
  "	 This function is called by MAIL-INSERT-SIGNATURE.	It returns
a string used to separate the message body from the signature."
  (interactive)
  (concat "\n\n--\n")
)

(defun mail-insert-signature (arg)
  "	 Attach a random signature matching MAIL-SIGNATURE-REGEXP
from MAIL-SIGNATURE-DIR.  An optional prefix argument will remove
the randomness---the argument number will generate a specific
signature name to be used.	If that file does not exist, then
MAIL-SIGNATURE-LOCAL will be attached instead.
  Successive calls will first remove the existing signature,
thus allowing one to change a selected signature."
  (interactive "P")
  (if (eq last-command 'mail-insert-signature)
	  (save-excursion
	(delete-region mail-signature-begin mail-signature-end)))
  (let (this-sig)
	(save-excursion
	  (goto-char (point-max))
	  (skip-chars-backward " \t\n")
	  (end-of-line)
	  (delete-region (point) (point-max))
	  (setq mail-signature-begin (point))
	  (insert (mail-signature-separator))
;	  (if arg
;		  (setq this-sig mail-signature-local)
;		(setq this-sig (mail-signature-choose-random)))
;	  (insert-file-contents (expand-file-name this-sig))
	  (setq this-sig (cjw-sig-function arg))
	  (setq mail-signature-end (point-max)))
   )
)

(defun cjw-sig-function (arg)
  "Put together a signature with a random quote using
MAIL-SIGNATURE-CHOOSE-RANDOM. If an argument is passed from 
MAIL-SIGNATURE-FUNCTION, use it to construct a specific signature 
name instead.  Use MAIL-SIGNATURE-LOCAL as a fallback."
  (let (sig-start
		sig-name
		this-sig
		sig-end)
	(setq sig-start (concat mail-signature-dir "sig.start"))
	(if arg
		(progn
		  (setq sig-name (cjw-sig-num-to-name (prefix-numeric-value arg)))
		  (setq this-sig (concat mail-signature-dir sig-name)))
	  (setq this-sig  (mail-signature-choose-random)))
	(setq sig-end	(concat mail-signature-dir "sig.end"))
	(if (file-exists-p (expand-file-name this-sig))
		(progn
		  (insert-file-contents (expand-file-name sig-start))
		  (goto-char (point-max))
		  (insert-file-contents (expand-file-name this-sig))
		  (goto-char (point-max))
		  (insert-file-contents (expand-file-name sig-end)))
	  (insert-file-contents (expand-file-name mail-signature-local)))
	))

(defun cjw-sig-num-to-name (num)
  "Convert a passed NUM argument to the name of a signature file
to be located in MAIL-SIGNATURE-DIR."
  (let (sig-name)
	(if (< num 10)
		(setq sig-name (concat "00" (number-to-string num)))
	  (if (< num 100)
		  (setq sig-name (concat "0" (number-to-string num)))
		(setq sig-name (number-to-string num))))
  (setq sig-name (concat "tag." sig-name))
  (message sig-name)
  sig-name))


(defun mail-signature-choose-random ()
  "Insert a random file from MAIL-SIGNATURE-DIR."
	(let (sig-list
	  sig-count
	  sig-num
	  next-sig)
	  (setq sig-list
	  (delete "." (delete ".."
		 (directory-files (expand-file-name mail-signature-dir)
					 nil mail-signature-regexp t))))
	  (setq sig-count (length sig-list))
	  (setq sig-num (random sig-count))
	  (setq next-sig (nth sig-num sig-list))
	  (message next-sig)
	  (setq next-sig (concat mail-signature-dir next-sig))
	  next-sig))

(defun this-mail-field (field) 
  "Return the To: field of a message being composed."
  (save-excursion
	(let (
	  (beg				nil)
	  (end				nil)
	  (to-names			nil)
	  (case-fold-search	  t))
	  (goto-char (point-min))
	(re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
	(setq end (match-beginning 0))
	(goto-char (point-min))
	(if (re-search-forward (concat "^" (regexp-quote field) ": ") end t)
	(progn
	  (setq beg (match-end 0))
	  (re-search-forward "^[^ \t]" nil 'move)
		  (beginning-of-line)
		  (skip-chars-backward "\n")
	  (setq to-names (buffer-substring beg (point)))
	  (setq to-names (replace-in-string to-names "\n[ \t]*" ""))
	  to-names
	  )
	  ""))
   )
)

(defun this-mail-to () 
  (interactive)
  (this-mail-field "To"))
	  
(defun mail-from ()
  "Move point to end of From-field."
  (interactive)
  (expand-abbrev)
  (mail-position-on-field "From"))

(defun mail-gcc ()
  "Move point to end of Gcc-field."
  (interactive)
  (expand-abbrev)
  (mail-position-on-field "Gcc"))

(defun mail-x-spool ()
  "Move point to end of X-Spool-field."
  (interactive)
  (expand-abbrev)
  (mail-position-on-field "X-Spool"))

(defun mail-remove-fcc ()
  "Deletes the first occurrence of an `FCC:' line."
  (interactive)
  (save-excursion
	(mail-fcc)
	(beginning-of-line)
	(delete-region (point) (progn (forward-line 1) (point)))
;	 (goto-char (point-min))
;	 (if (search-forward-regexp "^FCC: " nil t)
;	(progn
;	  (goto-char (match-beginning 0))
;	  (delete-region (point) (progn (forward-line 1) (point)))))
	))

(defun mail-remove-replyto ()
  "Deletes the first occurrence of a `Reply-To:' line."
  (interactive)
  (save-excursion
	(mail-replyto)
	(beginning-of-line)
	(delete-region (point) (progn (forward-line 1) (point)))
	(goto-char (point-min))
	))

(defun mail-remove-bcc ()
  "Deletes the first occurrence of an `Bcc:' line."
  (interactive)
  (save-excursion
	(mail-bcc)
	(beginning-of-line)
	(delete-region (point) (progn (forward-line 1) (point)))
	))

(defun mail-remove-gcc ()
  "Deletes the first occurrence of an `Gcc:' line."
  (interactive)
  (save-excursion
	(mail-gcc)
	(beginning-of-line)
	(delete-region (point) (progn (forward-line 1) (point)))
	))

(defvar cjw-mail-header-program "mailhead")

(defun cjw-fix-mail-headers ()
  "To be used in a mail edit buffer.  It sends the entire buffer to
an external program, defined by CJW-MAIL-HEADER-PROGRAM,
for header munging.  The program should return the fixed mail
message on STDOUT."
  (interactive)
  (save-excursion
	(shell-command-on-region (point-min) (point-max) cjw-mail-header-program t)
	))

(defun find-info-file (file)
  (interactive "fFind info file: ")
  (let ((buf (find-file-noselect file)))
	(switch-to-buffer buf)
	(require 'info)
	(condition-case ignore-error
	(Info-goto-node
	 (concat "("
		 (if (and (stringp file) (not (equal file "")))
			 file "dir")
		 ")top"))
	  (error
	   (Info-goto-node
	(concat "(" file ")*"))))
	(kill-buffer buf)
	(switch-to-buffer "*info*")))

(defun kill-current-buffer ()
  (save-buffer)
  (kill-buffer (current-buffer)))

(defun scroll-up-line (&optional arg)
  (interactive)
  (scroll-up (or arg 1)))
(defun scroll-down-line (&optional arg)
  (interactive)
  (scroll-down (or arg 1)))

(defun cjw-kill-buffer-and-frame ()
  "Kill the current buffer and, if successful, delete the current 
frame."
  (interactive)
  (and (kill-buffer nil) (delete-frame nil)))

(defun cjw-fix-sentence-spacing ()
  "Make sure there are exactly two spaces after sentences."
  (interactive)
  (save-excursion
	(replace-regexp "\\([.?!:]\\) +\\([A-Z]\\)" "\\1  \\2")))

(defun cjw-fix-semicolons ()
  "Turn mistyped semicolons into the apostrophes they were meant to be."
  (interactive)
  (save-excursion
	(replace-regexp "\\([a-zA-Z]\\);\\([a-zA-Z]\\)" "\\1'\\2")))

(defvar tex-dvips-command	 nil
  "*Command used by \\[tex-dvips] to produce a postscript
version of the .dvi file.  If this string contains an asterisk (*), it will
be replaced by the .dvi filename; if not, the name of the file, preceded by 
blank, will be added to this string.")

(defvar tex-ps-print-command	 nil)
(defvar tex-alt-ps-print-command nil)

(defvar tex-ps-view-command nil
  "*Command used by \\[tex-view-ps] to display a postscript 
version of the .dvi file.  If this string contains an asterisk (*), it will
be replaced by the .dvi filename; if not, the name of the file, preceded by 
blank, will be added to this string.")


(defun tex-dvips nil
  "Produce a postscript version of the last `.dvi' file made
by running TeX under Emacs.	 This means, made using \\[tex-region], 
\\[tex-buffer] or \\[tex-file].	 The variable `tex-dvips-command'
specifies the shell command to produce the postcript."
  (interactive)
  (let ((tex-dvi-print-command tex-dvips-command))
	(tex-print)))

(defun tex-ps-print (&optional alt)
  "Print the .ps file made by \\[tex-dvips].  Runs the shell 
command defined by tex-ps-print-command.  If prefix argument 
is provided, use the alternative command, tex-alt-ps-print-command."
  (interactive "P")
  (let ((print-file-name-ps (tex-append tex-print-file ".ps"))
		test-name)
	(if (and (not (equal (current-buffer) tex-last-buffer-texed))
			 (buffer-file-name)
			 ;; Check that this buffer's printed file is up to date.
			 (file-newer-than-file-p
			  (setq test-name (tex-append (buffer-file-name) ".ps"))
			  (buffer-file-name)))
		(setq print-file-name-ps test-name))
	(if (not (file-exists-p print-file-name-ps))
		(error "No appropriate `.ps' file could be found")
	  (tex-send-command
		(if alt tex-alt-ps-print-command tex-ps-print-command)
		print-file-name-ps t))))

(defun tex-view-ps ()
  "Preview a postscript version of the last `.dvi' file made
by running TeX under Emacs.	 This means, made using \\[tex-region], 
\\[tex-buffer] or \\[tex-file].	 The variable `tex-ps-view-command'
specifies the shell command for preview."
  (interactive)
  (let ((tex-ps-print-command tex-ps-view-command))
	(tex-ps-print)))

(defun tex-clear-tex-shell () 
  "Clear all but the last line of the TeX-shell buffer."
  (interactive)
  (let (end)
	(save-excursion
	  (set-buffer "*tex-shell*")
	  (goto-char (point-max))
	  (comint-send-input)
	  (sleep-for 0.2)
	  (goto-char (point-max))
	  (beginning-of-line)
	  (setq end (point))
	  (beginning-of-buffer)
	  (delete-region (point) end))
	))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; EOF
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;