(provide 'functions)

(defun kill-region-safe (beg end)
  (interactive "*r")
  (if (< 7000 (- end beg))
      (do-auto-save))
  (copy-region-as-kill beg end)
  (delete-region beg end))

(defun remove-marks-in-buffer ()
  (interactive)
  (while mark-ring
    (set-marker (Pop mark-ring) nil)))

;(defun find-file (filename)
;  "Edit file FILENAME.
;Switch to a buffer visiting file FILENAME,
;creating one if none already exists. If file
;is a symbolic link, asks to edit the file using
;the target pathname instead of the symlink
;pathname."
;  (interactive "FFind file: ")
;  (let ((linked-to (follow-symlink filename)))
;    (and linked-to
;         (y-or-n-p (format "File %s is a symlink to %s. Use real pathname? "
;                           (unexpand-file-name filename)
;                           (unexpand-file-name linked-to)))
;         (setq filename linked-to))
;    (and (string-match "\\`/mit/\\([^/]+\\)/" filename)
;         (not (file-exists-p (concat "/mit/" (match-string filename 1))))
;         (attach (match-string filename 1)))
;    (switch-to-buffer (find-file-noselect filename))))

(defun follow-symlink (file)
  (let ((directory (file-name-directory file))
	link)
    (When (file-symlink-p file)
      (while (setq link (file-symlink-p file))
	(setq file link))
      (expand-file-name file directory))))

(defun edit-definition (arg)
  (interactive "P")
  (let* ((tags-file-name "/tmp/TAGS")
	 (curr-fun (function-called-at-point))
	 (function (completing-read (if curr-fun 
					(format "Edit definition (%s): "
						curr-fun)
					"Edit definition: ")
				    obarray)))
    (When (string-equal function "")
      (setq function (format "%s" curr-fun)))
    (if (and (fboundp (string-to-symbol function))
	     (subrp (symbol-function (string-to-symbol function))))
	(progn 
	  (beep)
	  (message "Sorry! \"%s\" is a built-in function." function))
	(progn
	  (if arg 
	      (find-tag-other-window (format " %s " function))
	      (find-tag (format " %s " function)))
	  (recenter-in-window)))))

(defun edit-command-definition (arg keys)
  (interactive "P\nkEdit definition for command on keys: ")
  (let ((function (key-binding keys))
	(tags-file-name "/tmp/TAGS"))
    (cond ((eq function 'keyboard-quit)
	   (keyboard-quit))
	  ((and (fboundp function)
		(subrp (symbol-function function)))
	   (beep)
	   (message "Sorry! \"%s\" is a built-in function." function))
	  (t (message "Looking for definition of \"%s\"..." function)
	     (if arg 
		 (find-tag-other-window (format " %s " function))
		 (find-tag (format " %s " function)))
	     (recenter-in-window)))))

(defun edit-next-definition ()
  (interactive)
  (find-tag nil t))

(defun goto-mark ()
  (interactive)
  (set-mark-command t))

(defun select-other-window ()
  (interactive)
  (other-window 1)
  (delete-other-windows)
  (recenter-in-window))

(defun bury-select-other-window ()
  (interactive)
  (bury-buffer)
  (other-window 1)
  (delete-other-windows)
  (recenter-in-window))

(defun kill-other-windows ()
  (interactive)
  (delete-other-windows)
  (recenter-in-window))

(defun magic-zap ()
  (interactive)
  (save-buffer)
  (sit-for 0)
  (cond ((eq major-mode 'emacs-lisp-mode)
	 (save-and-compile))
	((eq major-mode 'texinfo-mode)
	 (texinfo-format-buffer))
	((memq major-mode '(plain-TeX-mode LaTeX-mode))
	 (make-local-variable 'compile-command)
	 (compile (setq compile-command
			(concat (if (eq major-mode 'plain-TeX-mode)
				    "tex " "latex ")
				(file-name-nondirectory buffer-file-name)))))
	((memq major-mode '(c-mode c++-mode))
	 (call-interactively 'compile))))

(defun save-and-compile ()
  (interactive)
  (save-buffer)
  (byte-compile-file (buffer-file-name))
  (and tags-file-name
       (visit-tags-table tags-file-name)))

(defun switch-to-existing-buffer (buffer-name)
  (interactive (list (read-buffer "Switch to buffer: "
				  (other-buffer 1)
				  'existing)))
  (switch-to-buffer buffer-name))

(defun scroll-up-same-line ()
  (interactive)
  (scroll-up 1))

(defun scroll-down-same-line ()
  (interactive)
  (scroll-down 1))

(defun select-previous-window ()
  (interactive)
  (other-window -1))

(defun is-latex-mode ()
  (memq major-mode '(TeX-mode LaTeX-mode)))

(defun is-text-mode ()
  (memq major-mode '(text-mode fundamental-mode)))

(defun word-count ()
  (interactive)
  (insert "Word count:")
  (call-process-region "/usr/ucb/wc" "-w"))

(defun delete-to-start-of-line ()
  (interactive)
  (cond ((bobp)
	 (error "Beginning of buffer"))
	((bolp)
	 (backward-delete-char 1 t))
	(t (delete-region 
	    (point)
	    (progn (re-search-backward "^" (point-min))
		   (point))))))

(defun insert-cshell-line ()
  (interactive)
  (cond ((is-text-mode)
	 (insert "#!/bin/csh -f\n"))
	(t (message "Buffer not in text mode.")
	   (beep))))

(defun insert-tex-bullet ()
  (interactive)
  (cond ((is-latex-mode)
	 (setq standard-output (current-buffer))
	 (princ "$\\bullet$ "))
	(t (message "Buffer not in TeX or LaTeX mode.")
	   (beep))))

(defun insert-name ()
  (interactive)
  (cond ((is-latex-mode)
	 (setq standard-output (current-buffer))
	 (princ "Ra\\'{u}l J. Acevedo"))
	(t (message "Buffer not in TeX or LaTeX mode.")
	   (beep))))

(defun raise-buffer ()
  (interactive)
  (let ((buffer-list (nreverse (buffer-list)))
	buffer)
    (while (string-match "\\` " 
			 (buffer-name
			  (prog1 (setq buffer (car buffer-list))
			    (setq buffer-list (cdr buffer-list))))))
    (switch-to-buffer buffer)))

(defun compile-defun ()
  (interactive)
  (require 'byte-compile "bytecomp")
  (let* (macrop
	 (function 
	  (save-excursion
	    (beginning-of-defun)
	    (setq macrop (looking-at "(defmacro "))
	    (if (looking-at "(def\\(un\\|macro\\) ")
		(string-to-symbol 
		 (buffer-substring (progn (forward-word 1)
					  (forward-char 1)
					  (point))
				   (progn (forward-char 1)
					  (search-forward "(")
					  (1- (point)))))
		(error "Not a function or macro definition!")))))
    (message "Compiling %s..." function)
    (eval-defun nil)
    (if macrop
	(eval (byte-compile-file-form 
	       (append (list 'defmacro function)
		       (cdr (cdr (symbol-function function))))))
	(byte-compile function))
    (message "%s %s compiled." 
	     (if macrop "Macro" "Function")
	     function)))

(defun my-eval-buffer ()
  (interactive)
  (message "Evaluating buffer...")
  (eval-current-buffer)
  (message "Evaluating buffer...done."))

(defun my-eval-region ()
  (interactive)
  (message "Evaluating region...")
  (eval-region (mark) (point) t)
  (message "Evaluating region...done."))

(defun restore-help-window ()
  (interactive)
  (let ((curr-window (selected-window)))
    (call-interactively 'switch-to-buffer-other-window)
    (select-window curr-window)))

;(defun save-window-configuration ()
;  (interactive)
;  (setq window-configuration 
;	(current-window-configuration))
;  (message "Window configuration set."))

;(defun restore-window-configuration ()
;  (interactive)
;  (if window-configuration
;      (set-window-configuration window-configuration)
;      (error "Window configuration not set.")))

(defun my-indent-region ()
  (interactive)
  (message "Indenting region...")
  (call-interactively 'indent-region)
  (message "Indenting region...done."))

(defun redisplay ()
  (interactive)
  (let ((wstart (window-start)))
    (recenter)
    (set-window-start (selected-window) wstart)))

(defun move-line-to-top ()
  (interactive)
  (recenter 1))

(defun recenter-defun ()
  (interactive)
  (forward-line 1)
  (let (start end fname)
    (save-excursion 
      (if (eq major-mode 'clu-mode)
	  (and (re-search-backward 
		"^\\( \\|\t\\)*[a-za-z0-9_]+ += +\\(proc\\|iter\\|cluster\\)"
		(point-min))
	       (setq fname
		     (regexp-quote
		      (buffer-substring (progn (forward-word 1)
					       (backward-word 1)
					       (point))
					(progn (forward-word 1)
					       (point))))))
	  (beginning-of-defun))
      (setq start (current-line))
      (if (eq major-mode 'clu-mode)
	  (re-search-forward 
	   (concat "^\\( \\|\t\\)*end +" fname "\\( \\|\t\\|\n\\)")
	   (point-max))
	  (end-of-defun))
      (setq end (current-line)))
    (goto-line (/ (+ start end) 2))
    (recenter-in-window)))

(defun move-line-to-bottom ()
  (interactive)
  (recenter -2))

(defun toggle-truncate ()
  (interactive)
  (setq truncate-lines (not truncate-lines))
  (shrink-window 1)
  (enlarge-window 1))

(defun my-scroll-left (n)
  (interactive "p")
  (scroll-left n))

(defun my-scroll-right (n)
  (interactive "p")
  (scroll-right n))

(defun join-next-line ()
  (interactive)
  (delete-region
   (point)
   (progn (re-search-forward "[^^\t \n]" (point-max) t)
	  (1- (point))))
  (backward-char 1))

(defun move-to-last-line ()
  (interactive)
  (move-to-window-line -2)
  (recenter '(1)))

(defun move-to-first-line ()
  (interactive)
  (move-to-window-line 1)
  (recenter '(1)))

(defun split-horizontally-two-buffers ()
  (interactive)
  (split-window-horizontally)
  (other-window 1)
  (bury-buffer)
  (other-window -1))

(defun split-vertically-two-buffers (arg)
  (interactive "P")
  (split-window-vertically)
  (Unless arg (other-window 1))
  (bury-buffer)
  (other-window -1))

(defun insert-x-cut-buffer ()
  (interactive)
  (insert (x-get-cut-buffer)))

(defun save-into-x-cut-buffer (begin end)
  (interactive "r")
  (x-store-cut-buffer (buffer-substring begin end)))

(defun insert-command-name (keys)
  (interactive "kInsert name of command on keys: ")
  (let ((command (key-binding keys)))
    (if (eq command 'keyboard-quit)
	(beep)
	(insert (format "%s" (key-binding keys))))))

(defun toggle-debug-on-error ()
  (interactive)
  (setq debug-on-error (not debug-on-error))
  (if debug-on-error
      (message "Debugger enabled.")
      (message "Debugger disabled.")))

(defun my-Info-goto-top-node ()
  (interactive)
  (Info-goto-node "Top"))

(defun rmail-first-message ()
  (interactive)
  (rmail-maybe-set-message-counters)
  (rmail-show-message 1))

(defun rmail-jump-to-message (arg)
  (interactive "P")
  (let ((n (if arg
	       (format "%d" arg)
	       (read-from-minibuffer 
		(format "Go to message number: (%s max) "
			rmail-total-messages)))))
    (When (and (not (string-equal "" n))
	       (numberp (setq n (car (read-from-string n)))))
      (rmail-show-message n))))

(defun rmail-end-of-message ()
  (interactive)
  (rmail-show-message rmail-current-message)
  (goto-char (point-max)))

(defun my-list-buffers (arg)
  (interactive "P")
  (list-buffers arg)
  (Unless (eq (current-buffer) (get-buffer "*Buffer List*"))
    (other-window 1))
  (goto-line 3)
  (run-hooks 'Buffer-menu-mode-hook))

(defun zwrite-consult (arg)
  (interactive "P")
  (if arg
      (zwrite-instance "sipb")
      (zwrite-instance "consult")))

(defun zwrite-help (arg)
  (interactive "P")
  (if arg
      (call-interactively 'zwrite-instance)
      (zwrite-instance "help")))

(defun show-matching-paren ()
  (interactive)
  (blink-matching-open))

(defun byte-force-recompile-directory (directory &optional arg)
  "Recompile every .el file in DIRECTORY.
If the .elc file does not exist, offer to compile the .el file
only if a prefix argument has been specified." 
  (interactive "DByte recompile whole directory: \nP")
  (save-some-buffers)
  (setq directory (expand-file-name directory))
  (let ((files (directory-files directory nil "\\.el\\'"))
	(count 0)
	source dest)
    (while files
      (if (and (not (auto-save-file-name-p (car files)))
	       (setq source (expand-file-name (car files) directory))
	       (setq dest (concat (file-name-sans-versions source) "c"))
	       (if (file-exists-p dest)
		   t ; (file-newer-than-file-p source dest)
		   (and arg (y-or-n-p (concat "Compile " source "? ")))))
	  (progn (byte-compile-file source)
		 (setq count (1+ count))))
      (setq files (cdr files)))
    (message "Done (Total of %d file%s compiled)"
	     count (if (= count 1) "" "s"))))

(defun where-is-library (file arg)
  "Find where the Emacs Lisp library FILE is in the current
`load-path'.  By default, appends \".el\" to the filename given,
unless FILE already ends in \".el\" or \".elc\". If a prefix argument
is given, then no \".el\" prefix is given."
  (interactive "sWhere is library: \nP")
  (let ((path load-path)
	(file (if (or arg (string-match ".elc?\\'" file))
		  file
		  (concat file ".el"))))
    (while (and path (not (file-exists-p (concat (car path) "/" file))))
      (setq path (cdr path)))
    (if path
	(message "File %s is in %s." file (car path))
	(message "File %s not found." file))))

(defun my-shell-filter (process string)
  (let* ((buffer (process-buffer process))
	 (marker (process-mark process))
	 (window (get-buffer-window buffer))
	 (current-window (selected-window)))
    (save-excursion
      (set-buffer buffer)
      (goto-char marker)
      (insert string)
      (set-marker marker (point)))
    (if window
	(unwind-protect
	    (progn
	      (select-window window)
	      (goto-char marker)
	      (recenter (- (window-height) 2))
	      (end-of-line))
	  (select-window current-window)))))

(defun my-shell ()
  (interactive)
  (shell)
  (set-process-filter (get-process "shell") 'my-shell-filter))

(defun lpq (arg)
  (interactive "P")
  (let ((printer (if arg
		     (read-from-minibuffer "Printer: ")
		     (getenv "PRINTER"))))
    (save-window-excursion
      (pop-to-buffer "*lpq*")
      (erase-buffer)
      (call-process "/usr/ucb/lpq" nil t nil
		    (concat "-P" printer))
      (goto-char (point-min))
      (momentary-string-display "" (point)))))

(defun is-rcs-file-locked (file)
  (save-excursion
    (set-buffer (get-buffer-create " *temp rcs buf*"))
    (erase-buffer)
    (call-process "rlog" nil t nil "-h" (expand-file-name file))
    (re-search-backward (format "^locks:.*\\<%s\\>:[ \t]*"
				(user-login-name))
			(point-min) t)))

(defun is-file-under-rcs (file)
  (file-exists-p
   (expand-file-name
    (concat (file-name-directory file) 
	    "RCS/"
	    (file-name-nondirectory file)
	    ",v"))))

(defun get-process-environment ()
  (let (result)
    (save-excursion
      (set-buffer (get-buffer-create " *get process environment*"))
      (erase-buffer)
      (call-process "/usr/athena/lib/gnuemacs/etc/env" nil t nil)
      (goto-char (point-min))
      (while (looking-at "^[^=]+=.*$")
	(Push (buffer-match-string 0) result)
	(forward-line 1))
      (kill-buffer (current-buffer)))
    (nreverse result)))

(defun rename-file-and-buffer (buffer newfile)
  (interactive "bRename file on buffer: \nFNew file name: ")
  (rename-file (buffer-file-name (get-buffer buffer)) (expand-file-name newfile))
  (save-excursion
    (set-buffer buffer)
    (rename-buffer (file-name-nondirectory newfile))
    (set-visited-file-name newfile)))

(defun hide-region (begin end)
  (interactive "r")
  (let ((buffer-read-only nil))
    (subst-char-in-region begin end ?\n ?\r))
  (setq selective-display t
	selective-display-ellipses t))

(defun unhide-region (begin end)
  (interactive "r")
  (let ((buffer-read-only nil))
    (subst-char-in-region begin end ?\r ?\n)))

(defun check-mail ()
  (interactive)
  (message "Checking mail...")
  (if (save-excursion
	(set-buffer (get-buffer-create " *check-mail*"))
	(erase-buffer)
	(call-process "from" nil t nil "-v")
	(goto-char (point-min))
	(looking-at "^You don't have any mail waiting\\."))
      (message "No new mail.")
      (progn
	(switch-to-buffer " *check-mail*")
	(sit-for 0)
	(rmail))))

(defun nuke-date-and-time ()
  (interactive)
  (make-local-variable 'global-mode-string)
  (setq global-mode-string nil))

(defun goto-cmd ()
  (interactive)
  (let ((cwd default-directory)
	(win (get-buffer-window "*cmd*")))
    (if (get-buffer-window "*cmd*")
	(select-window win)
	(switch-to-buffer "*cmd*"))
    (if (not (string-equal cwd default-directory))
	(progn
	  (insert "cd " cwd)
	  (cmd-execute)))))

(defun my-cmd-exit ()
  (interactive)
  (let ((wconfig cmd-wconfig))
    (bury-buffer)
    (set-window-configuration wconfig)))

(defun my-cmd-delete-line ()
  (interactive)
  (cmd-beginning-of-line 1)
  (kill-line 1))

(defun nuke-buffer-and-window ()
  (interactive)
  (kill-buffer (current-buffer))
  (if (not (one-window-p t))
      (remove-window)))

(defun build ()
  (interactive)
  (let ((default-directory "/home/acapulco/colorfast/prerel/os/build/"))
    (compile "buildos")))

(defun edit (file)
  (interactive "sEdit ColorFast file: ")
  (let ((count 0)
	(projdir (getenv "PROJECTDIR"))
	(buf (get-buffer-create "*find*")))
    (message "Looking for %s in %s..." file projdir)
    (pop-to-buffer buf)
    (let ((default-directory (concat projdir "/")))
      (setq buffer-read-only nil)
      (erase-buffer)
      (insert "cd " default-directory "\n")
      (insert "find . -name " file " -print\n")
      (sit-for 0)
      (call-process "find" nil t t "." "-name" file "-print")
      (goto-line 3)
      (while (looking-at "^\\./")
	(setq count (1+ count))
	(insert (format "%d)  " count))
	(forward-line 1))
      (goto-char (point-min)))
    (cond ((= count 0)
	   (error "File not found!"))
	  ((= count 1)
	   (goto-line 3)
	   (find-file (concat projdir
			      (buffer-substring (+ 5 (point))
						(progn (end-of-line)
						       (point)))))
	   (kill-buffer buf)
	   (message "Found in %s." (substring default-directory 0 -1)))
	  (t
	   (message "Enter number of file to edit, anything else to cancel.")
	   (let ((n (- (read-char) 48)))
	     (if (and (> n 0)
		      (<= n count))
		 (progn
		   (goto-line (+ 2 n))
		   (find-file (concat projdir
				      (buffer-substring (+ 5 (point))
							(progn (end-of-line)
							       (point)))))
		   (kill-buffer buf))))))))

(defun ximake ()
  (interactive)
  (shell-command "ximake"))

(defun dired-Up-directory ()
  (interactive)
  (let ((buf (current-buffer)))
    (dired-up-directory)
    (kill-buffer buf)))

(defun dired-File-directory ()
  (interactive)
  (let ((buf (current-buffer)))
    (dired-file-directory buffer-file-name)
    (kill-buffer buf)))

(defun complete-env-var ()
  (interactive)
  (let* (start
	 (var (save-excursion
	       (skip-chars-backward "$A-Z")
	       (and (looking-at "\\$\\([A-Z_]+\\)")
		    (setq start (point))
		    (buffer-match-string 1)))))
    (if var
	(let* ((end (point))
	       (vars (mapcar '(lambda (x)
				(string-match "\\`\\([A-Z_]+\\)=" x)
				(cons (substring x 0 (match-end 1)) nil))
			     process-environment))
	       (result (try-completion var vars)))
	  (cond ((eq result t)
		 (beep t))
		((equal var result)
		 (save-window-excursion
		   (with-output-to-temp-buffer " *Completions*"
		     (display-completion-list (all-completions var vars)))
		   (momentary-string-display "" (point) 32 "Hit SPC to remove window.")))
		(t (delete-region (1+ start) end)
		   (insert result))))
	(complete-file-name))))

(defun follow-file-links ()
  (interactive)
  (dired-follow-symlinks buffer-file-name))

(defun shell-command-cd (dir)
  (interactive "DDirectory: ")
  (let ((default-directory (expand-file-name dir)))
    (call-interactively 'shell-command)))

(defun compile-maybe-cd (arg)
  (interactive "P")
  (call-interactively (if arg 'compile-cd 'compile)))

(defun compile-cd (dir)
  (interactive "DDirectory: ")
  (setq dir (expand-file-name dir))
  (let ((default-directory dir))
    (call-interactively 'compile))
  (save-excursion
    (set-buffer (get-buffer-create "*compilation*"))
    (setq default-directory dir)))

(defun browse-and-bury ()
  (interactive)
  (browse-mode -1)
  (bury-buffer nil))

(defun macxp ()
  (and (getenv "DISPLAY")
       (getenv "MACDISPLAY")
       (equal (getenv "DISPLAY")
	      (getenv "MACDISPLAY"))))

(defun set-tab-width (arg)
  (interactive "NTab width: ")
  (setq tab-width (prefix-numeric-value arg))
  (set-window-start (selected-window) (window-start)))

(defun egrep (command)
  (interactive "sRun egrep (with args): ")
  (compile (concat "egrep -n " command " /dev/null")))

(defun Telnet (host)
  (interactive "sTelnet to host: ")
  (let ((cmd-shell-name "telnet")
	(cmd-shell-args (list host)))
    (cmd 10)
    (rename-buffer (format "*%s*" host))
    (setq mode-line-buffer-identification
	  (list host ": " (list 25 "" 'cmd-working-directory))
	  mode-line-modified "-----")
    (make-local-variable 'cmd-specials)
    (setq cmd-specials '(("man" . cmd-man)
			 ("vi" . cmd-no-go)
			 ("su" . cmd-su)
			 ("kinit" . (lambda (arg) (cmd-su arg "kinit")))
			 ("more" . cmd-more)
			 ("cd" . cmd-cd)
			 ("pushd" . (lambda (arg) (cmd-dir-changing-command "pushd" arg)))
			 ("popd" . (lambda (arg) (cmd-dir-changing-command "popd" arg)))
			 ("edit" . (lambda (arg)
				     (cmd-send-shell newline)
				     (edit (substring arg 0 -1))
				     nil))
			 ("cwd" . cmd-set-cwd)))))

(defun stop-compilation ()
  (interactive)
  (interrupt-process "compilation"))

(defun emacs-v18-p ()
  (string-match "^18" emacs-version))

(defun emacs-v19-p ()
  (string-match "^19" emacs-version))