;;;* Last edited: Feb 12 15:21 1999 (sw)
;;; Figure out the site:

(setq load-path (append 
		 (list (concat (getenv "HOME") 
			       "/lib/emacs-19/vm-6.05"))
		 load-path))


;;; Configure Gnus
(setq gnus-nntp-server "entertainment-tonight.ai.mit.edu")
;; (setq gnus-nntp-server "news.mit.edu")
(setq gnus-interactive-catchup nil)
(setq gnus-interactive-exit nil)

(setq site (getenv "SITE"))

;;; Impede mail reading in an emacs
(defun no-mail-fn ()
  (interactive)
  (beep)
  (message "Don't do mail in this emacs..."))

(defun no-mail ()
  (interactive)  
  (message "OK, no mail in this emacs...")
  (global-set-key "\eR" 'no-mail-fn))

;;; Bindings

(global-set-key "\eC" 'compile)
(global-set-key "\eV" 'vm)

;;; (global-set-key "\eR" 'rmail)
(global-set-key "\eS" 'to-shell)
;;; (global-set-key "\eS" 'to-shell)
(global-set-key "\eF" 'visit-file-dot-points-to)
(global-set-key "\eB" 'visit-buffer-dot-points-to)
(global-set-key "\eN" 'dialup-mouse-function)
(global-set-key "\eQ" 'flatten-paragraph)

(global-set-key "\e:"  'commentify-region-lisp)
(global-set-key "\C-h" 'backward-delete-char-untabify)
(global-set-key "\C-z" 'scroll-up-cmd)
(global-set-key "\ez" 'scroll-down-cmd)
(global-set-key "\ek" 'copy-line-as-kill)
(global-set-key "\eT" 'insert-date)
(global-set-key "\eu" 'upcase-previous-word)
(global-set-key "\ec" 'capitalize-previous-word)
(global-set-key "\el" 'downcase-previous-word)
(global-set-key "\eK" 'kill-sentence)
(global-set-key "\C-x\C-f" 'find-file-other-window)
(global-set-key "\C-xd" 'delete-window)
(global-set-key "\C-x\C-m" 'buffer-menu)

(global-set-key "\C-z" 'scroll-up-cmd)
(global-set-key "\ez" 'scroll-down-cmd)
(global-set-key "\ek" 'copy-line-as-kill)
(global-set-key "\eT" 'insert-date)
(global-set-key "\eu" 'upcase-previous-word)
(global-set-key "\ec" 'capitalize-previous-word)
(global-set-key "\el" 'downcase-previous-word)
(global-set-key "\eK" 'kill-sentence)
;(global-set-key "\eQ" 'query-replace)
(global-set-key "\C-x\C-f" 'find-file-other-window)
(global-set-key "\C-xd" 'delete-window)
(global-set-key "\C-x\C-m" 'buffer-menu)

;(global-set-key "\eL" 'to-ilisp)

(global-set-key "\eE" 'line-to-shell)

(defun to-akcl ()
  (interactive)
  (call-interactively 'akcl)
  (goto-char (point-max)))


(global-set-key "\eZ" 'to-scheme)

(setq completion-ignored-extensions
      (cons ".sbin" completion-ignored-extensions))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Autoloads...


(if lucid
    (autoload 'c++-mode "c++-mode" "Use c++ mode" t))


(autoload 'shell "shell" "Run an inferior shell process." t)
(autoload 'cmulisp "cmulisp" "Run an inferior lisp process." t)

(autoload 'dialup-mouse-function "dialup-mouse")

(autoload 'akcl       "ilisp" "Inferior Austin Kyoto Common LISP." t) 
(autoload 'akcl-clx       "ilisp" 
	  "Inferior Austin Kyoto Common LISP with CLX." t) 

(setq ilisp-load-hook 
      '(lambda () 
	 (load "ilisp-hacks")
	 (setq ilisp-prefix "\C-c")
	 (setq lucid-program "/usr/local/bin/lucid")
	 (defdialect lucid-clx "Lucid with CLX." lucid
	   (setq ilisp-program "/usr/local/lucid/lisp-4-1-0-clos-clx"))))



(defun to-ilisp ()
  (interactive)
  (if (and (boundp 'ilisp-buffer)
	   ilisp-buffer
	   (get-buffer-process ilisp-buffer))
      (progn (lisp-pop-to-buffer ilisp-buffer)
	     (goto-char (point-max)))
      (run-ilisp)))




      
(setq lisp-no-popper t
      comint-always-scroll t)

(setq lisp-no-popper nil
      comint-always-scroll t)

;;; flush annoying pop ups from ilisp...
(setq popper-pop-buffers nil)



(autoload 'rmail "rmail-patches")
;;; (autoload 'to-shell "shell")		
(autoload 'visit-file-dot-points-to "dot-visit")
(autoload 'visit-buffer-dot-points-to "dot-visit")
(autoload 'commentify-region-lisp "comment-stuff" 
	  "comment out a region of lisp code" t)
(autoload 'zippy-comment-header "comment-stuff" 
	  "comment out a region of lisp code" t)
(autoload 'make-test-area "comment-stuff"
	  "make a test area for lisp code" t)
(autoload 'de-commentify-region-lisp "comment-stuff")
(autoload 'grind-comment-paragraph-lisp "comment-stuff")
(autoload 'weather "weather" "get current Boston Area weather" t)
(autoload 'manual-entry "man" "read a unix man page" t)

(autoload 'run-kcl "lisp-patches" "run kcl in emacs" t)
(autoload 'run-kcl-convex "lisp-patches" "run kcl in emacs on the convex" t)
(autoload 'gnus "gnus" "read the news in emacs" t)
(autoload 'flatten-paragraph "paragraph" "flatten a paragraph" t)

;;; See lisp-patches autoload, below.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Customize variables


(setq ilisp-site-hook '(lambda () (load "ilisp-hacks")))
(setq mail-mode-hook '(lambda()   
			(define-key mail-mode-map "\eS" 'to-shell)))





;;;(setq explicit-shell-file-name "/usr/bin/csh")
;;; (setq explicit-shell-file-name nil)
(setq require-final-newline t)
(setq shell-prompt-pattern "^[^#$%:>]*[#$%:>] *")

(setq c-indent-level 4)

(setq make-backup-files t)
(put 'eval-expression 'disabled nil)

(if (equal site "lincoln")
    (progn (setq *weather-program* "rsh")
	   (setq *weather-program-args* 
		 (list "-l" "pauld" "nearlink" "finger weather@synoptic"))))



(setq inhibit-startup-message t)
(setq search-slow-speed 4800)

;(setq outline-regexp "[;%][*]+")
;(setq outline-regexp "[%*;][*]+[\t]*")
(setq outline-regexp "[%*;][*]+")



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Do stuff

;(display-time) 

;(if (equal (getenv "HOSTTYPE") "sun4")
;    (progn 
;      (load "biff")
;      (biff 1)))
;
(require 'cl)

;;; The reason not to autoload shell is that it defines an autoload 
;;; for run-lisp which steps on the following patches:
(load "shell")
(fmakunbound 'run-lisp)
(autoload 'run-lisp "lisp-patches" "run lisp in emacs" t)

;(if (and (boundp 'window-system-version)
;	 (not (null window-system-version))
;	 (= window-system-version 11))
;    (load "xmouse-hack"))


(put 'eval-expression 'disabled nil)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Code

;(defvar previous-dot 0)

;(defun copy-line-as-kill ()
;  "copy a line to the kill buffer, but don't really delete it"
;  "append if a series of such commands are chained"
;  (interactive)
;  (let 
;      ((start (dot)))
;    (end-of-line)
;    (forward-char)
;    (let ((dot-not-moved (= previous-dot start)))
;      (when dot-not-moved (append-next-kill))
;      (kill-ring-save start (dot))
;      (setq previous-dot (dot)))))
    

(defun copy-line-as-kill ()
  "copy a line to the kill buffer, but don't really delete it"
  "append if a series of such commands are chained"
  (interactive)
  (let ((start (dot)))
    (end-of-line)
    (if (eobp) 
	(insert "\n")
      (forward-char))
    (when (eq last-command 'copy-line-as-kill) 
      (append-next-kill))
    (kill-ring-save start (dot))))


(defun scroll-up-cmd (x)
  "scroll up one line"
  (interactive "p")
  (scroll-up x))

(defun scroll-down-cmd (x)
  "scroll down one line"
  (interactive "p")
  (scroll-down x))

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

(defun insert-date (arg)
  "Insert the date into the buffer. With a prefix arg other than
   one also insert the time"
  (interactive "p")
  (insert (current-time-string))
  (if (= 1 arg)
      (progn 
	(backward-word 4)
	(delete-char 1)
	(kill-word 3)
	(backward-char 1)
	(insert ",")
	(delete-char 1)
	(backward-word 3)
	(kill-word 1)
	(delete-char 1)
	(forward-word 3))))

(defun capitalize-previous-word ()
  (interactive)
   (capitalize-word -1))

(defun upcase-previous-word ()
  (interactive)
  (upcase-word -1))

(defun downcase-previous-word ()
  (interactive)
  (downcase-word -1))

;;; stupid pea brains

(defun de-fontify-buffer ()
  "take the electric font lock controls out of a buffer"
  (interactive)
  (beginning-of-buffer)
  (if (search-forward "Begin using 006 escapes]" (point-max) t)	
      (let ((end-of-bullshit (point)))
	(search-backward "")
	(delete-region (point) end-of-bullshit)))
  (beginning-of-buffer)
  (replace-regexp "[0-9]" "")
  (beginning-of-buffer)
  (while (search-forward "" (point-max) t)
    (backward-delete-char 1)
    (kill-sexp 1)
    )
  (beginning-of-buffer))




(defun to-shell ()
  "if shell buffer exists and is active, pop to it, else start one"
  (interactive)
  (let ((process (get-process "shell")))
    (if (and process
	     (equal (process-status process) 'run))
	(pop-to-buffer (process-buffer process) t) 
      (shell)))
  (goto-char (point-max)))





;;; Obsolete ?:

(defun to-scheme ()
  "if scheme buffer exists and is active, pop to it, else start one"
  (interactive)
  (let ((process (get-process "scheme")))
    (if (and process
	     (equal (process-status process) 'run))
	(pop-to-buffer (process-buffer process)) 
	(run-scheme (or xscheme-process-command-line 
			(xscheme-default-command-line)))))
  (goto-char (point-max)))


(defun flush-carriage-returns ()
  (interactive)
  (save-excursion
    (goto-char 0)
    (replace-string "
" "")))

(defun line-to-shell ()
  (interactive)
  (let ((old-point (point)))
    (beginning-of-line)
    (let ((start (point)))
      (end-of-line)
      (copy-region-as-kill start (point))
      (goto-char old-point)
      (to-shell)
      (yank)
      (comint-send-input)
      )))


; Files ending in ".scm" are Scheme source, 
; so put their buffers in scheme-mode.

(setq auto-mode-alist 
      (cons '("\\.scm$" . scheme-mode)  
            auto-mode-alist))

(setq auto-mode-alist 
      (cons '("\\.stk$" . scheme-mode)  
            auto-mode-alist))

(setq auto-mode-alist 
      (cons '("\\.cc$" . c++-mode)
            auto-mode-alist))

(setq auto-mode-alist 
      (cons '("\\.hh$" . c++-mode)
            auto-mode-alist))



(if lucid 
    (progn
      (add-hook 'emacs-lisp-mode-hook	'turn-on-font-lock)
      (add-hook 'lisp-mode-hook	'turn-on-font-lock)
      (add-hook 'c-mode-hook		'turn-on-font-lock)
      (add-hook 'c++-mode-hook	'turn-on-font-lock)
      (add-hook 'postscript-mode-hook	'turn-on-font-lock)
      ))


(load (if lucid "mouse-hack-lucid" "mouse-hack-19"))




;;; Do various things is we are running under
;;; X windows (and we're not lucid emacs)



(when (and (eq window-system 'x) (not lucid)
	   (not (equal (getenv "DISPLAY") "colleen:0.0")))
  (setq x-pointer-shape x-pointer-center-ptr)
  (require 'hilit19)
  (hilit-translate  string	  'DarkGreen)
  (set-mouse-color "red")
  ;;
  ;;  some nice colored mode/menu lines
  ;;
  (set-face-foreground (quote default)  "black")
  (set-face-foreground (quote modeline) "LightGray")
  (set-face-background (quote modeline) "NavyBlue")
  (let ((bg "snow"))		; was snow
    ;; the background property for emacs in the X resource
    ;; database should be set to the background color.
    ;; (set-face-background (quote default) bg)
    ;; (set-background-color bg)
    ))

;;; Fixes echo of CR's by tcsh in emacs at hospital
(if (fboundp 'comint-strip-ctrl-m)
    (add-hook 'comint-output-filter-functions (function comint-strip-ctrl-m)))

(autoload 'vm "vm" "Start VM on your primary inbox." t)
(autoload 'vm-other-frame "vm" "Like `vm' but starts in another frame." t)
(autoload 'vm-visit-folder "vm" "Start VM on an arbitrary folder." t)
(autoload 'vm-visit-virtual-folder "vm" "Visit a VM virtual folder." t)
(autoload 'vm-mode "vm" "Run VM major mode on a buffer" t)
(autoload 'vm-mail "vm" "Send a mail message using VM." t)
(autoload 'vm-submit-bug-report "vm" "Send a bug report about VM." t)

(setq mail-archive-file-name "~/vm-folders/outgoing")
(setq vm-popup-menu-on-mouse-3 nil)

(setq vm-use-menus nil)

(setq auto-save-default nil)

(defun vm-frames (bool)
  (setq vm-frame-per-folder bool)
  (setq vm-frame-per-summary nil)
  (setq vm-frame-per-composition bool)
  (setq vm-frame-per-edit bool)
  (setq vm-frame-per-completion bool)
  (setq vm-frame-parameter-alist nil)
  (setq vm-mutable-frames nil))

(defun vm-no-frames ()
  (interactive)
  (vm-frames nil))

(setq hilit-quietly t)

(require 'c-mode)
(load "language-tools")

(setq doc-who-am-i '("Sandy Wells" "sw"))


(setq doc-where-am-i 
  (list "MIT Artificial Intelligence Laboratory" "ai.mit.edu"))

(setq doc-where-am-i 
  (list "Brigham and Women's Hospital" "ai.mit.edu"))

;(defun install-common-language-commands (map)
;  (define-key map "\C-\M-f" 'forward-sexp-ignore-comments)
;  (define-key map "\C-\M-b" 'backward-sexp-ignore-comments)
;  (define-key map "\C-ch" 'doc-header)
;  (define-key map "\C-cm" 'doc-modification)
;  (define-key map "\C-c;" 'skip-comment))

(setq doc-file-summary 
  (list nil 
	"* FUNCTION:
*
*
"))


(defun url-at-dot ()
  "get the url dot is pointing to, delimited on the left and right by
  by space, quote, lf, or cr"
  (save-excursion
   (re-search-backward "[ \",\011\012]")
   (forward-char)
   (let ((left (dot)))
     (re-search-forward "[^ \",\011\012][^ \",\011\012]*")
     (buffer-substring left (dot))
     )))



;;; Cause a nearby netscape to follow the url dot
;;; is pointed at.

(defun zap-url ()

  (interactive)
  (shell-command (concat "netscape -remote \"openURL(" 
			 (url-at-dot)
			 ")\">& /dev/null\n")))

(global-set-key "\eU" 'zap-url)




;; (setq mail-default-reply-to "sw@ai.mit.edu")