;;; Reminders how to do common things:
;;;
;;; C or C++ buffer in cra mode:
;;; /* -*- Mode: c; Mode: cra; default-tab-width: 4; -*- */

(setq transient-mark-mode nil)

(defun cra-execute-from-env ()
  (eval (car (read-from-string (getenv "CRADOT_CODE_EL")))))

(or (fboundp 'replace-in-string)
    (defun replace-in-string (target old new)
      (replace-regexp-in-string old new  target)))

;(when (= 0 (string-match "21.2" emacs-version))
;  (defun find-file (filename &optional wildcards)
;    "Edit file FILENAME.
;Switch to a buffer visiting file FILENAME,
;creating one if none already exists.
;Interactively, or if WILDCARDS is non-nil in a call from Lisp,
;expand wildcards (if any) and visit multiple files.  Wildcard expansion
;can be suppressed by setting `find-file-wildcards'."
;    (interactive "FFind file: \np")
;    (let ((value (find-file-noselect filename nil t wildcards)))
;      (if (listp value)
;	  (mapcar 'switch-to-buffer (nreverse value))
;	  (switch-to-buffer value)))))

(setq is-xemacs-p (string-match "XEmacs" emacs-version))
(setq is-emacs-p (not is-xemacs-p))

(require 'cl)

(when (/= (user-uid) 0)
  (require 'saveplace)
  (setq-default save-place t))

;;;
;;; general emacs setup
;;;
(set-input-mode t nil t)
(setq load-path (cons (expand-file-name "~/elisp")
		      load-path))

(defvar *slime-stuff-i-want*
  '(slime-editing-commands slime-references slime-highlight-edits))
(defun setup-slime ()
  (interactive)
  (slime-setup *slime-stuff-i-want*)
  ;; FIXME - this is broken, should run automatically
  (slime-setup-contribs))

(defvar *ita-slime* nil)
(defvar *slime-available* nil)
(if (and (getenv "QPXROOT") (getenv "ITASLIME"))
    (progn
      (setf *ita-slime* t)
      (setenv "QRSROOT" (getenv "QPXROOT"))
      (setenv "QRSINSTALL" (getenv "QPXINSTALL"))
      (let ((qpx-slime-loc (concat (getenv "QPXROOT") "/elisp")))
	(when (file-directory-p qpx-slime-loc)
	  (add-to-list 'load-path qpx-slime-loc)
	  (setq *slime-available* t)
	  (require 'qpx-slime)
	  (setq sbcl-program ",sbcl"))))
    (when (or (getenv "WANTSLIME")
	      (and (string-match "22\." emacs-version)
		   (not (getenv "NOSLIME"))))
      (setq *slime-available* t)
      (setq load-path (cons (expand-file-name "~/elisp/slime") load-path))
      (require 'slime)
      (require 'slime-autoloads)
      (setup-slime)
      (setq inferior-lisp-program ",sbcl")))

(when is-xemacs-p
  (setq load-path (cons (expand-file-name "~/xelisp")
			load-path)))
(setq make-backup-files nil)
(setq line-number-mode t)
(setq auto-save-default nil)
(setq visible-bell t)
(setq-default next-line-add-newlines nil)
;; ?useful
;(standard-display-european 1)
(put 'eval-expression 'disabled nil)
(put 'downcase-region 'disabled nil)
(setq sentence-end-double-space t)

;; 10 times the default.  Greetings from QPX.
(setq blink-matching-paren-distance 256000)

;;;
;;; Kills in minibuffer should not end up in the kill buffer or X11 selection.
;;;
;;; This code doesn't work if the selection buffer is not yet filled.
;;; The following line is supposed to fix that - but doesn't
;(if (not kill-ring)
;    (kill-new ""))
(when (and nil ;; turned off
	   (eq 'x window-system)
	   (not is-xemacs-p))
  (add-hook 'minibuffer-setup-hook
	    '(lambda ()
	      (setq old-kill (current-kill 0 nil))))
  (add-hook 'minibuffer-exit-hook
	    '(lambda ()
	      (if (not (eq old-kill (current-kill 0 nil)))
		  (kill-new old-kill)))))

;;;
;;; X11 frame titles
;;;
;(modify-frame-parameters (car (frame-list)) '((name . "baz")))
;(setq frame-title-format '("%b@" system-name))
(setq frame-title-format '("%b"))

;;;
;;; mixed autoload stuff
;;;
(autoload 'w3m "w3m")
(autoload 'python-mode "python-mode")
(autoload 'ruby-mode "ruby-mode")
(autoload 'w3-fetch    "w3" "Emacs WWW browser" t)
(defun cmucl () (interactive) (cmulisp))
(autoload 'cmulisp     "ilisp" "Inferior CMU Common LISP." t)
(autoload 'sbcl        "ilisp" "Inferior SBCL." t)
(autoload 'allegro     "ilisp" "Inferior Allegro Common LISP." t)
(defun clisp () (interactive) (clisp-hs))
(autoload 'clisp-hs       "ilisp" "Inferior CLISP." t)
(autoload 'lispworks   "ilisp" "Inferior Lispworks." t)
(autoload 'guile       "ilisp" "Inferior Guile." t)

;;(when (file-exists-p "~/.ilisp.el")
;;  (add-hook 'ilisp-load-hook
;;	    (load "~/.ilisp")))

(add-hook 'shell-mode-hook
	  (lambda ()
	    (let ((pat ".*([a-zA-Z0-9][a-zA-Z0-9/-]*)[0-9][0-9]*% \\|.*Yes, Master\\? \\|[0-9][0-9]*\\] "))
	      (setq shell-prompt-pattern pat)
	      (setq comint-prompt-regexp pat)
	      (define-key shell-mode-map "\C-a" 'comint-bol-or-process-mark)

(defun comint-dynamic-complete-filename ()
  ;; copy of emacs function to make it complete even when no
  ;; char has been entered so far
  ;; Martin Cracauer 20050107
  "Dynamically complete the filename at point.
Completes if after a filename.  See `comint-match-partial-filename' and
`comint-dynamic-complete-as-filename'.
This function is similar to `comint-replace-by-expanded-filename', except that
it won't change parts of the filename already entered in the buffer; it just
adds completion characters to the end of the filename.  A completions listing
may be shown in a help buffer if completion is ambiguous.

Completion is dependent on the value of `comint-completion-addsuffix',
`comint-completion-recexact' and `comint-completion-fignore', and the timing of
completions listing is dependent on the value of `comint-completion-autolist'.

Returns t if successful.

THIS IS MARTIN CRACAUER's changes version to complete in absense of first char"
  (interactive)
  (when t
    (unless (window-minibuffer-p (selected-window))
      (message "Completing file name..."))
    (comint-dynamic-complete-as-filename))))))

;;;
;;; mode-specific setting for modes that don't load their own ~/.?? -file
;;;
;; text mode
(add-hook 'text-mode-hook
	  '(lambda ()
	     (auto-fill-mode 1)
	     (when (string-match "svn-commit.*.tmp"
				 (buffer-name (current-buffer)))
	       (setq-default save-place nil))
	     (setq indent-tabs-mode t)))

;; TAB nonsense
;; this breaks c-mode
;;(global-set-key (kbd "TAB") 'tab-to-tab-stop)
;; I don't think I need this
;;(define-key text-mode-map (kbd "TAB") 'self-insert-command)


;; COMMENTS OUTDATED!
;; what I want is:
;; - use tabs when indendation is manual, namely in fundamental-mode and
;;   text-mode
;; - do not use tabs when indendation is tab-driven anyway

;; Since there is no fundamental-mode hook, I have no choice than default
;; to tabs and manually set it for all modes than I have indendation-modes
;; for.
;; Note that I do not use shell-mode for bournce shell script.
;;

(setq-default indent-tabs-mode nil)
(if nil
    (dolist (hook '(lisp-mode-hook cc-mode-hook perl-mode-hook))
      (add-hook hook
		'(lambda ()
		   (setq indent-tabs-mode nil)))))

(defvar fundaemental-mode-hooks nil)
(dolist (hook '(fundamental-mode-hooks text-mode-hook))
  (add-hook hook
	    '(lambda ()
	       ;;(print 'using-tabs)
	       (setq indent-tabs-mode t)
	       (local-set-key (kbd "TAB") 'tab-to-tab-stop))))

(add-hook 'find-file-hooks
	  '(lambda ()
	    (setq require-final-newline nil)))


;;(add-hook 'lisp-mode-hook
;;	  '(lambda ()
;;	     (global-set-key [?\C-z ?\C-z] 'suspend-emacs)))

(defun fu ()
  (interactive)
  (fundamental-mode)
  (local-set-key (kbd "TAB") 'tab-to-tab-stop))

(add-hook 'after-change-major-mode-hook
	  '(lambda ()
	     ;; Dudes, I actually use this mode for doing work.  Groan
	     (when (string= mode-name "Fundamental")
	       (run-hooks 'fundamental-mode-hooks))))

;;;
;;; shell-mode
;;; Doesn't work, disable
;;;
(setq sh-mode-backup (symbol-function 'sh-mode))
(defun sh-mode () (interactive))
;(add-hook 'shell-mode-hook '(lambda () (modify-syntax-entry ?. "w")))
;; shellscript editing mode
;(setq sh-shell-file "/bin/sh")
;(add-hook 'sh-mode-hook '(lambda () (setq tab-width 8)))
;(add-hook 'sh-mode-hook '(lambda () (setq indent-tabs-mode t)))
;(add-hook 'sh-mode-hook '(lambda ()
;			   (substitute-key-definition
;			    'backward-delete-char-untabify
;			    'delete-backward-char
;			    sh-mode-map)))
(add-hook 'comint-output-filter-functions 'comint-strip-ctrl-m)
(setq comint-input-ring-size 2000)

;; version control
(setq vc-follow-symlinks t)
(setq lpr-command ",lpr")

(set-default 'auto-mode-alist
	     (append '(("\\.py$" . python-mode)) auto-mode-alist))

(set-default 'auto-mode-alist
	     (append '(("\\.rb$" . ruby-mode)) auto-mode-alist))

(set-default 'auto-mode-alist
	     (append '(("\\.lisp$" . lisp-mode)) auto-mode-alist))

(unless *slime-available*
  (set-default 'auto-mode-alist
	       (append '(("\\.lsp$" . ilisp-ita-mode)) auto-mode-alist)))

(set-default 'auto-mode-alist
	     (append '(("\\.html4m$" . text-mode)) auto-mode-alist))

(set-default 'auto-mode-alist
	     (append '(("TODO" . text-mode)) auto-mode-alist))

(set-default 'auto-mode-alist
	     (append '(("svn-commit.*\\.tmp" . text-mode)) auto-mode-alist))

(set-default 'auto-mode-alist
	     (append '(("README" . text-mode)) auto-mode-alist))

(define-derived-mode cra-mail-mode text-mode
  "cramail"
  (flyspell-mode))

;;; Don't change the following to "^/tmp/mutt-". It should work for
;;; /var/tmp/ as well.
(set-default 'auto-mode-alist
	     (append '(("/tmp/cracauer/\\(mutt-\\|nn.\\)" . cra-mail-mode))
		   auto-mode-alist))
  
(set-default 'auto-mode-alist
	     (append '(("-titelliste-kommentiert.txt$" . fundamental-mode))
		   auto-mode-alist))

(set-default 'auto-mode-alist
	     (append '(("/mozex" . fundamental-mode))
		   auto-mode-alist))

(set-default 'auto-mode-alist
	     (append '(("^mozex" . fundamental-mode))
		   auto-mode-alist))

(set-default 'auto-mode-alist
	     (append '(("buecher.dat$" . text-mode))
		   auto-mode-alist))

(set-default 'auto-mode-alist
	     (append '(("buecher_kaufen$" . text-mode))
		   auto-mode-alist))

(set-default 'auto-mode-alist
	     (append '(("\\.m$" . objc-mode))
		   auto-mode-alist))

(set-default 'auto-mode-alist
	     (append '(("\\.i$" . objc-mode))
		   auto-mode-alist))

(set-default 'auto-mode-alist
	     (append '(("\\.cpp$" . ita-mode)) auto-mode-alist))

;;;
;;; Cracauer's keys and functions - simple setting.
;;; Symbolcis select-key stuff follows later.
;;;

(defun info-this-dir () (interactive)
  (if current-prefix-arg
      (setq Info-directory-list (list (read-from-minibuffer "Directory: ")))
    (setq Info-directory-list '(".")))
  (info))

(defun tab2four () (interactive) (setq default-tab-width 4))

(defun cradate () (interactive)
  "Inserts the current date into the buffer at current point"
  (let ((prev (or (and (/= 0 (point))
		       (char-before (point)))
		  10)))
    (call-process "sh" nil t t  "-c" "echo -n `date +%Y%m%d`")
    (if (= prev 10)
	(insert ":\n---------\n\n"))))

;;;
;;; This function deletes Whitespace from the end of every line.
;;; fixme - Don't do this in literal strings.
;;;

(defun whitespace ()
  (interactive)
  (save-window-excursion
    (goto-char (point-min))
    (while (re-search-forward "[ \t][ \t]*$" nil t)
      (delete-region (match-beginning 0) (point)))))

;;;
;;; This functions deletes whitespace - including newlines - up to the
;;; next non-whitespace char. Useful when working on Text cut'n'pasted
;;; from Netscape.
;;;

(defun del2white ()
  (interactive)
  "deletes whitespace up to the next non-whitespace char"
  (save-window-excursion
    (when (re-search-forward "[ \t\r\n]*[^ \t\r\n]" nil t)
      (delete-region (match-beginning 0) (- (point) 1)))))

;;;
;;; This function deletes whitespace from the beginning of all lines
;;; in the current paragraph following the point.
;;;

(defun del2whitelines ()
  (interactive)
  (save-window-excursion
    (let ((upto (buffer-size))
	  (old-point (point)))
      (when (re-search-forward "\n\n" nil t)
	(setq upto (match-beginning 0)))
      (save-restriction
	(print (format "%d %d" old-point upto))
	(narrow-to-region old-point upto)
	(goto-char (point-min))
	(perform-replace "^[ \t][ \t]*" "" nil t nil 10)))))

;;;
;;; Compilation command.  Will run contents of variable
;;; cra-compile-command in compilation buffer If cra-compile-command
;;; doesn't exist, a proper one is searched for. If GNUmakefile
;;; exists, or if Makefile contains GNU make specific statements,
;;; "gmake" is run, otherwise the value of compile-command is run or
;;; if that doesn't exit "make".  Calling this function with a prefix
;;; causes it to read a command from the minibuffer.
;;;

(defvar cra-compile-command nil)

(defun initial-cra-compile-command ()
  (interactive)
  ",make ")

(defun cra-compile () (interactive)
  (if current-prefix-arg
      (setq cra-compile-command
	    (if (not cra-compile-command)
		(read-from-minibuffer "Compile command: "
				      (initial-cra-compile-command))
              (read-from-minibuffer "Compile command: "
                                    cra-compile-command))))
  (if (not cra-compile-command)
      (setq cra-compile-command (initial-cra-compile-command)))
  (let ((cra-compile-command-tmp cra-compile-command)
        (maybe-first (cra-switch-hcpp-sub-sub
                      (buffer-name (current-buffer))
                      "\\.\\(cpp\\|cc\\|c\\|h\\)$"  ".o")))
    ;; fixme, include *.cc and *.c
    (when maybe-first
      (setq cra-compile-command-tmp
            (format "%s %s && %s"
                    cra-compile-command
                    maybe-first
                    cra-compile-command)))
    (compile cra-compile-command-tmp)))

(defun cra-run () (interactive)
  (compile "./run"))

;;;
;;; Symbolics-like select-key
;;;

(defun useless-buffer-p (buffer)
  (let ((name buffer))
    (if (not (stringp name))
	(setq name (buffer-name buffer)))
    (or (string= " *Minibuf-0*" name)
	(string= " *Minibuf-1*" name)
	(string= "*scratch*" name)
	(string= "*vc*" name)
	(string= "*ilisp-send*" name)
	(string= "*Completions*" name)
	(string= "*Messages*" name))))

(defun firstbuffer-matching (buffers regex)
  (if buffers
      (if (and
	   (string-match regex (buffer-name (car buffers)))
	   (not (string= " *Minibuf-0*" (buffer-name (car buffers))))
	   (not (string= " *Minibuf-1*" (buffer-name (car buffers))))
	   (not (string= " *vc*" (buffer-name (car buffers)))))
	  (car buffers)
	(firstbuffer-matching (cdr buffers) regex))
    nil))

;; (not (string= "*cmulisp*" (buffer-name (car buffers))))
;; (not (string= "*shell*" (buffer-name (car buffers))))

(defmacro crasel-def (name regex if-not-there)
  `(defun ,name ()
     (interactive)
     (let ((buf (firstbuffer-matching (cdr (buffer-list)) ,regex)))
       (if buf
	   (switch-to-buffer buf)
	 ,if-not-there))))

(setq selectmap (make-sparse-keymap))

(defun crasel_last ()
  (interactive)
  (let ((buf (firstbuffer-matching (cdr (buffer-list)) "")))
    (if buf
	(switch-to-buffer buf))))

(define-key selectmap [f12] 'crasel_last)

(defun load-makefile-sub (l)
  (if (file-exists-p (car l))
      (find-file (car l))
    (load-makefile-sub (cdr l))))

(defun load-makefile ()
  (let ((names
	 '("GNUmakefile.cra" "Imakefile" "GNUmakefile" "Makefile" "makefile")))
    (load-makefile-sub names)))

(defun cra-browse-http-url (url &optional new-window)
  (if new-window
      (call-process
       "sh" nil 0 nil
       "-c"
       (format "www -remote 'openUrl(%s,new-tab)'" url))
    (call-process "xcaller" nil 0 nil
		  "xterm" "-exec" "sh" "-c"
		  (format ",lynx %s #; sleep 10" url))))

(defvar *my-hyperspec-loc*
  (expand-file-name "~/doc/lisp/HyperSpec-6.0/HyperSpec/"))

;; slime/ilisp stuff
(setq common-lisp-hyperspec-root
      (if (file-exists-p
	   (format "~s/~s" *my-hyperspec-loc* "/Front/index.htm"))
	  (format "file://%s" *my-hyperspec-loc*)
	"http://www.lispworks.com/reference/HyperSpec/"))

(setq browse-url-browser-function )
(setq browse-url-browser-function '(("^mailto:" . browse-url-mail)
				    ("^file:" . cra-browse-http-url)
				    ("^http:" . cra-browse-http-url)
				    ;;("^ftp:" . cra-browse-ftp-url)
				    ("." . browse-url-netscape)))

(defun sbcl-or-cmucl ()
  (if (= 0 (call-process "which" nil nil nil "sbcl"))
      (sbcl)
    (cmucl)))

(defun start-a-lisp ()
  (if *slime-available*
      (setup-and-start-slime)
      (progn
	(load "~/.ilisp")
	(sbcl-or-cmucl))))

(defun switch-to-or-start-a-lisp ()
  (interactive)
  (cond 
    ((firstbuffer-matching (buffer-list) "*slime-repl \\|*inferior-lisp*")
     (switch-to-buffer (firstbuffer-matching (buffer-list) "*slime-repl \\|*inferior-lisp*")))
    ((firstbuffer-matching (buffer-list) "*sbcl*")
     (switch-to-buffer (firstbuffer-matching (buffer-list) "*sbcl*")))
    ((firstbuffer-matching (buffer-list) "*cmulisp*")
     (switch-to-buffer (firstbuffer-matching (buffer-list) "*cmulisp*")))
    ((firstbuffer-matching (buffer-list) "*allegro*")
     (switch-to-buffer (firstbuffer-matching (buffer-list) "*allegro*")))
    (t
     (start-a-lisp))))

(defun lisp ()
  (switch-to-or-start-a-lisp))

(crasel-def crasel_a "\\.awk$" nil)
(define-key selectmap [?a] 'crasel_a)

(crasel-def crasel_l "\\.\\(lisp\\|lsp\\|scm\\|el\\)$" nil)
(define-key selectmap [?l] 'crasel_l)

(crasel-def crasel__l "*slime-repl \\|*inferior-lisp*" (switch-to-or-start-a-lisp))
(define-key selectmap [?L] 'crasel__l)

(crasel-def crasel__q "^qpx-"nil)
(define-key selectmap [?Q] 'crasel__q)

(crasel-def crasel_h "\\.\\(h\\|hh\\)$" nil)
(define-key selectmap [?h] 'crasel_h)

(crasel-def crasel_c "\\.\\(c\\|m\\|cc\\|cpp\\)$" nil)
(define-key selectmap [?c] 'crasel_c)

(crasel-def crasel_s "\\.\\(s\\|S\\)$" nil)
(define-key selectmap [?s] 'crasel_s)

(crasel-def crasel_j "\\.java$" nil)
(define-key selectmap [?j] 'crasel_j)

(crasel-def crasel_d "\\.doc4m$" nil)
(define-key selectmap [?d] 'crasel_d)

(crasel-def crasel_4 "\\.\\(m4\\|html4m\\)" nil)
(define-key selectmap [?4] 'crasel_4)

(crasel-def crasel_s "\\.sh$" nil)
(define-key selectmap [?s] 'crasel_s)

(crasel-def crasel__s "\\*shell\\*" (shell))
(define-key selectmap [?S] 'crasel__s)

(crasel-def crasel_i "\\*info\\*" (info))
(define-key selectmap [?i] 'crasel_i)

(crasel-def crasel_m "\\*Man .*\\*" nil)
(define-key selectmap [?m] 'crasel_m)

(crasel-def crasel__r "README" nil)
(define-key selectmap [?R] 'crasel__r)

(crasel-def crasel__t "^TODO" nil)
(define-key selectmap [?T] 'crasel__t)

(crasel-def crasel__m "^\\(GNU\\|I\\)?makefile" (load-makefile))
(define-key selectmap [?M] 'crasel__m)

(crasel-def crasel__d "^DOC" nil)
(define-key selectmap [?D] 'crasel__d)

(crasel-def crasel_x "\\.xml$" nil)
(define-key selectmap [?x] 'crasel_x)

(defun crasel_prefix () (interactive)
  (let* ((regex (read-from-minibuffer "Buffer regex: "))
	 (buf (firstbuffer-matching (cdr (buffer-list)) regex)))
    (if buf
	(switch-to-buffer buf)
      (message "No buffer matching '%s'" regex))))
(define-key selectmap [?\r] 'crasel_prefix)

(define-key selectmap [?H] 'cra-switch-hcpp)

(defun buffer-list-to-menu ()
  (let ((res nil))
    (dolist (buffer (buffer-list))
      (if (not (useless-buffer-p buffer))
	  (setq res (cons (cons (buffer-name buffer) buffer) res))))
    (when res
      (setq res (reverse res))
      (setq res (cons "whatisthisfor?" res))
      (setq res (list "Buffer list" res)))
    res))

(defun buffer-select-menu ()
  (interactive)
  (let ((menu (buffer-list-to-menu)))
    (when menu
      (switch-to-buffer (x-popup-menu t (buffer-list-to-menu))))))

(global-set-key [down-mouse-3] 'buffer-select-menu)
; (define-key selectmap [?\\] 'buffer-select-menu) ; useless, menu doesn't take keyboard input

;;;
;;; C-Mode modifications
;;;
;;; TODO:
;;; toplvel
;;; char *s =
;;; "blabla";
;;; second line doesn't get indented.
;;; Folgendes geht nicht, weil
;;; dann Funktionsnamen am Zeilen-
;;; anfang auch eingerueckt werden.
;;;  (c-set-offset 'topmost-intro-cont 8)

(defun bsd-mode () (interactive)
  (c-set-style "bsd")
  (setq indent-tabs-mode t)
  ; Mit C-c C-s kann man sich anzeigen lassen, in was fuer einem
  ; Statement man gerade haengt.
  (c-set-offset 'defun-block-intro 8)
  (c-set-offset 'statement-block-intro 8)
  (c-set-offset 'statement-case-intro 8)
  (c-set-offset 'substatement-open 4)
  (c-set-offset 'substatement 8)
  (c-set-offset 'arglist-cont-nonempty 4)
  (c-set-offset 'inclass 8)
  (c-set-offset 'knr-argdecl-intro 8))

(defun cra-mode () (interactive)
  (c-set-style "bsd")
  (setq indent-tabs-mode t)
  (setq tab-width 4)
  ; Mit C-c C-s kann man sich anzeigen lassen, in was fuer einem
  ; Statement man gerade haengt.
  (c-set-offset 'topmost-intro-cont 2)
  (c-set-offset 'defun-block-intro 4)
  (c-set-offset 'statement-block-intro 4)
  (c-set-offset 'statement-case-intro 4)
  (c-set-offset 'statement-cont 2)
  (c-set-offset 'substatement-open 2)
  (c-set-offset 'substatement 4)
  (c-set-offset 'arglist-cont-nonempty 2)
  (c-set-offset 'arglist-close 2)
  (c-set-offset 'inclass 4)
  (c-set-offset 'knr-argdecl-intro 4))

(defun ita-mode () (interactive)
  (c-mode)
  (c-set-style "bsd")
  (setq indent-tabs-mode nil)
  (setq tab-width 8)
  (setq c-basic-offset 4)
  ; Mit C-c C-s kann man sich anzeigen lassen, in was fuer einem
  ; Statement man gerade haengt.
  ;(c-set-offset 'topmost-intro-cont 0)
  ;(c-set-offset 'defun-block-intro '+)
  (c-set-offset 'statement-block-intro '+)
  (c-set-offset 'substatement '+)
  (c-set-offset 'arglist-close 'c-lineup-arglist)
  (c-set-offset 'case-label 2)
  ;(c-set-offset 'statement-case-intro 0)
  ;(c-set-offset 'statement-cont 2)
  ;(c-set-offset 'substatement-open 2)
  ;(c-set-offset 'substatement 4)
  ;(c-set-offset 'arglist-cont-nonempty 'c-lineup-arglist)
  ;(c-set-offset 'arglist-close 2)
  ;(c-set-offset 'inclass 4)
  ;(c-set-offset 'knr-argdecl-intro 4)
  )

(defun gnu-mode () (interactive)
  (normal-mode))

;(setq cra-c-mode 5)
;(add-hook 'c-mode-hook '(lambda () (when (eq cra-c-mode 1) (print "jau"))))
;(add-hook 'c-mode-hook '(lambda () (print cra-c-mode)))
;(add-hook 'c++-mode-hook '(lambda () (print cra-c-mode)))

(add-hook 'c-mode-hook '(lambda ()
			 (define-key c-mode-base-map [(control meta h)]
			   'backward-kill-word)))


;;;
;;; Mixed setup for emacs mode I don't use anymore, but leave
;;; them in place so that I don't get surprising results should I call them.
;;;

;;; General Mail setup

(setq mail-default-headers "FCC: ~/private/Mail/sent\n")
(setq mail-signature t)
(setq mail-signature-file "~/.signature.mail")

;;; VM

(setq vm-included-text-prefix "> ")
(defvar vm-default-window-configuration nil)

(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)

;;; GNUS

(setq nnmail-spool-file "/var/mail/cracauer")
(setq gnus-message-archive-method
      '(nnfolder "archive" (nnfolder-directory "~/Mail/archive/")))
(setq gnus-outgoing-message-group "nnml:archive")

;;;
;;; Old stuff, commented out
;;; Dies wird benutzt, wenn ein File mit #! beginnt (shellscript)
;;; Insbesondere schalte ich den shell-script-mode (fuer /bin/sh) ab!
;;;

;(defconst interpreter-mode-alist
;  '(("perl" . perl-mode)
;    ("perl5" . perl-mode)
;    ("awk" . awk-mode)
;    ("mawk" . awk-mode)
;    ("nawk" . awk-mode)
;    ("gawk" . awk-mode)
;    ("scsh" . scheme-mode)
;    ("guile" . scheme-mode)
;    ))


(and (fboundp 'tool-bar-mode)
     (tool-bar-mode nil))
;(and (fboundp 'mouse-avoidance-mode) (boundp 'x-pointer-shape)
;     (mouse-avoidance-mode 'cat-and-mouse))
(and (fboundp 'blink-cursor-mode)
     (blink-cursor-mode nil))


;(setq-default global-font-lock-mode nil)
(global-font-lock-mode -1)
;(setq font-lock-display-type 'color)

;(menu-bar-mode -1)
;(require 'iso-syntax)
;(enable-flow-control)
;(setq default-major-mode 'text-mode)

;;cracauer
;(defun cracauer-startserver () (load "gnuserv") (gnuserv-start))
;(defun cracauer-startserver () (load "cracauer-startserver"))

;(defun cracauer-close ()
;  (interactive
;   (progn
;     (save-some-buffers)
;     (kill-buffer (current-buffer))
;     (delete-frame))))
;(interactive 'cracauer-close)
;(add-hook 'cracauer-close (lambda () (progn (kill-buffer) (delete-frame))))
;(fset 'fcracauer-close 'cracauer-close)
;(global-set-key "\M-o" 'cracauer-close)
;geht nicht, wie ist key fuer return? (global-set-key "\C-\r" 'cracauer-close)


(defun green ()
  (interactive)
  (if is-xemacs-p
      (progn
	(set-face-background 'default "black")
	(set-face-foreground 'default "green")
	;(set-cursor-color "green")
	)
      (progn
	(set-background-color "black")
	(set-foreground-color "green")
	(set-cursor-color "green"))))

;;;
;;; Cracauer's paragraph filling
;;;

(when is-emacs-p
  (let (hackmeup)
    (case emacs-major-version
      (22 (setq hackmeup t))
      (23 (setq hackmeup t)))
    (when (and hackmeup
               (or (file-exists-p "~/elisp/for-emacs22/text-mode.el")
                   (file-exists-p "~/elisp/for-emacs22/indent.el")))
      ;; not a bug, run into error when one exists and not the other
      (load "~/elisp/for-emacs22/text-mode.el")
      (load "~/elisp/for-emacs22/indent.el"))))


(defconst paragraph-start "\\([ \t\n\f]\\|\\(-\\|[0-9][0-9]*[a-z]*)\\|==>\\) \\|^[^ ].*:$\\)")

;; this is a copy of the middle term above
;; this comes up with how many blanks should be in front of the lines in this paragraph
(setq cra-parabreakers "^[ \t]*\\(-\\|[0-9][0-9]*[a-z]*)\\|==>\\) ")

;; what's the logic here?
;; 1) the line with the "-" gets to stay where it is
;; 2) the lines afterwards += 2
(setq *in-newline* nil)
(defvar debug-crapoints nil)
(defun crapoints-new (original-point)
  (if (and (not *in-newline*)
	   (save-excursion (re-search-backward cra-parabreakers nil t)))
      (let ((left (length (match-string 0)))
            (last-paragraph-beginning (match-beginning 0)))
       
        (if (not *in-newline*)
            (let ((last-line-beginning
                   (save-excursion (re-search-backward "^" nil t)))
                  (next-paragraph-beginning
                   (save-excursion
                     (beginning-of-line)
                     (re-search-forward cra-parabreakers nil t)
                     (match-beginning 0))))
              
              (if debug-crapoints
                  (print (format "trigger, left was %s last para: %s, next para: %s, last line: %s, point %s"
                                 left
                                 last-paragraph-beginning
                                 next-paragraph-beginning
                                 last-line-beginning
                                 original-point)))
              (if (= last-line-beginning next-paragraph-beginning)
                  (progn
                    (setf left (- original-point next-paragraph-beginning))))))
	(save-excursion
	  (if nil ;; (re-search-backward "\n|*\n" nil t)
	      (let ((pos2 (match-beginning 0)))
		;;(print (format "pos: %d, pos2: %d." pos pos2))
		(if (>= pos pos2)
		    left
		  0))
	    left)))
    0))

;; older version
(defun crapoints-old (original-point)
  (if (and (not *in-newline*)
           (save-excursion (re-search-backward cra-parabreakers nil t)))
      (let* ((parabreaker (match-string 0))
             (length-of-parabreaker (length parabreaker))
             (beginning-of-paragraph (match-beginning 0)))
        (if (save-excursion (re-search-backward "\n\n" nil t))
            (let ((last-double-newline (match-beginning 0))
                  (last-single-newline 0)
                  this-line-is-itemize-p)
              (when (save-excursion (re-search-backward "^" nil t))
                (setf last-single-newline (match-beginning 0))
                ;; if original point is not on the far side of a newline
                (if (= last-single-newline original-point)
                    ;; FIXME
                    (setf this-line-is-itemize-p nil)))
                
              (when debug-crapoints
                (print (format "point %d, len %d, last small para %d, last double newline %d, last single newline %d, breaker '%s'." 
                               original-point
                               length-of-parabreaker
                               beginning-of-paragraph
                               last-double-newline
                               last-single-newline
                               parabreaker)))
              (if (and (>= beginning-of-paragraph last-double-newline)
                       (not this-line-is-itemize-p))
                  length-of-parabreaker
                0))
          length-of-parabreaker))
    0))

(defun crapoints-sub (original-point)
  (if *in-newline*
      0
    (when (save-excursion (re-search-backward "\n *- " nil t))
      10
      )))

(defun crapoints (original-point)
  (crapoints-old original-point))

(defvar real-current-left-margin nil)
(if (not real-current-left-margin)
    (setf real-current-left-margin (symbol-function 'current-left-margin)))

(defun crapoints-debug (original-point)
  (interactive)
  (let ((crapoint (crapoints original-point)))
    (when debug-crapoints
      (print (format "meh: %s -> %s (old func %s), original point %d"
                     left-margin crapoint
                     (apply real-current-left-margin nil)
                     original-point)))
    crapoint))

(if  t
(defun current-left-margin ()
  "Return the left margin to use for this line.
This is the value of the buffer-local variable `left-margin' plus the value
of the `left-margin' text-property at the start of the line."
  (let ((original-point (point)))
    (save-excursion
    (back-to-indentation)
    (max 0
         (+ left-margin (or (get-text-property
                             (if (and (eobp) (not (bobp)))
                                 (1- (point)) (point))
                             'left-margin)
                            (crapoints-debug original-point))))))))

(defvar real-newline (symbol-function 'newline))
(defun newline (&rest args)
  (interactive)
  (setq *in-newline* t)
  (apply real-newline args)
  (setq *in-newline* nil))

;;;
;;; FIXME: Don't move to beginning of line, move back
;;;

(defun cravisitlink () (interactive)
  (save-excursion
    (beginning-of-line)
    (if (not (re-search-forward "\\(\\(ftp\\|http\\)://[^ \t\n]*\\)\\.[ \t\n]"
				nil t))
	(re-search-forward "\\(\\(ftp\\|http\\)://[^ \t\n]*\\)[ \t\n]" nil t)
      )
    (call-process "netscape" nil nil nil "-remote"
		  (concat "openURL(" (match-string 1) ")"))))

;;;
;;; Jumps to a random line within the buffer
;;;

(defun random-line () (interactive)
  (push-mark)
  (random t)
  (goto-line (random (count-lines (point-min) (point-max)))))

;;;
;;; Filter buffer through ubbwand
;;;
(defun ubbwand () (interactive)
  (let ((old-end (point-max))
        (old-longlines-status longlines-mode))
    (longlines-mode nil)
    (goto-char (point-max))
    (call-process-region
     (point-min) (point-max)
     "/bin/sh"
     nil
     (current-buffer)
     nil
     "-c" "text2ubb2")
    (kill-region (point-min) old-end)
    (longlines-mode old-longlines-status)))

(defun cra-region-to-x11-selection ()
  (interactive)
  (call-process-region
   (region-beginning) (region-end)
   "/bin/sh"
   nil
   0
   nil
   "-c" ",xclip"))

(defun cra-shorten-url () (interactive)
  (let ((old-end (region-end)))
    ;;(goto-char (region-beginning))
    (call-process-region
     (region-beginning) (region-end)
     "/bin/sh"
     nil
     (current-buffer)
     nil
     "-c" "cra-shorten-url")
    (kill-region (region-beginning) old-end)
    ))

(defun cra-insert-x11-selection ()
  (interactive)
  (call-process ",xclip" nil t t  "-o"))

;; font selection for x11 frames
;; fixme - doesn't work in xemacs
;;
(defvar cra-concentrate-font
  "-bitstream-terminal-medium-r-normal--18-140-100-100-c-110-iso8859-1")

(defvar crafonts
  `((1 . "5x7") (2 . "6x10") (3 . "7x13") (4 . "9x15") (5 . "10x20")
    (0 . "-misc-fixed-medium-r-normal--14-110-100-100-c-70-iso8859-1")
    (9 . "fixed")
    (8 . "vga")
    (7 . ,cra-concentrate-font)
    (6 . "-bitstream-terminal-bold-r-normal--18-140-100-100-c-110-iso8859-1")))

(defun setfont (fontname)
  (if is-xemacs-p
      (set-face-font 'default fontname)
      (set-frame-font fontname)))

(defun crafont ()
  (interactive)
  (let ((number (or
		     current-prefix-arg
		     (string-to-number
		      (read-from-minibuffer
		       "Size (1-5, 0, 9=fixed, 8=vga): ")))))
    
    (setfont (cdr (assoc number crafonts)))))

(defun crasnd-next () (interactive)
  (call-process "snd" nil nil nil "-n"))

(defun crasnd-stop-continue () (interactive)
  (call-process "snd" nil nil nil "-s"))

(defun cra-two-windows () (interactive)
  (split-window-vertically)
  (other-window 1)
  (crasel_last)
  (other-window 1))

(defun cra-other-window-and-end () (interactive)
  (other-window 1)
  (goto-char (point-max)))

(defun find-frame-geo ()
  (let* ((frame (car (frame-list)))
	(top (frame-parameter frame 'top))
	 (bottom (+ top (frame-pixel-height frame)))
	 (left (frame-parameter frame 'left))
	 (right (+ left (frame-pixel-width frame))))
    (list left right top bottom)))

(defun make-lone-window ()
  (call-process "xv" nil 0 nil "-max" "-geometry" "+0+0"
		"/home/cracauer/.background.gif")
  (sit-for 1)
  (raise-frame)
  (sit-for 1)
  (raise-frame))

(defun setviewport ()
  ;(interactive)
  (let ((geo (find-frame-geo)))
    (call-process "/home/cracauer/work/cvs-work/prg/test/x11-dga/vidmodeswitch"
		  nil ; infile
		  nil ; outfile
		  nil ; redisply on update?
		  "v"
		  (format "%d" (- (car geo) 1))
		  (format "%d" (- (third geo) 10)))))

(defun crawin ()
  (interactive)
  ;;(make-lone-window)
  (setfont cra-concentrate-font)
  (green)
  (call-process "sh" nil nil nil
		"-c" "grep -q emacs /etc/X11/XF86Config && xvidtune -next")
  (menu-bar-mode -1)
  (setviewport)
  (correct-position))

(defun correct-position ()
  (let* ((geo (find-frame-geo)) ; left right top bottom
	 (left (car geo))
	 (right (second geo))
	 (top (third geo))
	 (bottom (fourth geo))
	 (width (x-display-pixel-width))
	 (height (x-display-pixel-height))
	 (xdistance (- width right))
	 (ydistance (- height bottom)))
    (when (or (> 0 xdistance) (> 0 ydistance))
      (set-frame-position (car (frame-list))
			  (+ left (min 0 xdistance))
			  (+ top (min 0 ydistance))))))

(defun formatskeleton ()
  (interactive)
  (insert "(format t \"\")")
  (goto-char (- (point-max) 2)))

;; this looks at files
(defun cra-switch-hcpp-sub-sub (original regex new-suffix)
  (let ((new-name (replace-regexp-in-string regex new-suffix original)))
    (unless (string= new-name original) ; return nil if not different
      new-name)))
(defun cra-switch-hcpp-sub (original regex new-suffix)
  (let ((new-name (cra-switch-hcpp-sub-sub original regex new-suffix)))
    (when new-name
      (when (file-exists-p new-name) ; let caller know there's such a file
	new-name))))

;; this tries to visit existing buffers first, then tries files
(defun cra-switch-hcpp ()
  (interactive)
  (let ((original-name (buffer-name (current-buffer)))
	new-name)
    (setq new-name
	  (or (cra-switch-hcpp-sub original-name "\\.\\(cpp\\|cc\\|c\\)$" ".h")
	      (cra-switch-hcpp-sub original-name "\\.h$"  ".cpp")
	      (cra-switch-hcpp-sub original-name "\\.h$"  ".cc")
	      (cra-switch-hcpp-sub original-name "\\.h$"  ".c")))
    (if new-name ; now we know such a file exists, but ...
	(if (get-file-buffer new-name) ; ... try to switch to a buffer first, 
	    (switch-to-buffer new-name) ; before trying to load the file.
	    (when (file-exists-p new-name)
	      (load-file new-name)
	      (switch-to-buffer new-name)))
	;; fall back to just switching to the last *.h file
	(crasel_h))))

;;; tune some emacs keys
;;;
(global-set-key [?\C-x ?@] 'cra-two-windows)
(global-set-key [?\C-x ?O] 'cra-other-window-and-end)

;;;
;;; Local commands
;;;
(defun local-cmd-1 () (interactive) (load "~/preserve/local-cmd-1.el"))
(defun local-cmd-2 () (interactive) (load "~/preserve/local-cmd-2.el"))
(defun local-cmd-3 () (interactive) (load "~/preserve/local-cmd-3.el"))
(defun local-cmd-4 () (interactive) (load "~/preserve/local-cmd-4.el"))
(defun local-cmd-5 () (interactive) (load "~/preserve/local-cmd-5.el"))
(defun local-cmd-6 () (interactive) (load "~/preserve/local-cmd-6.el"))
(defun local-cmd-7 () (interactive) (load "~/preserve/local-cmd-7.el"))
(defun local-cmd-8 () (interactive) (load "~/preserve/local-cmd-8.el"))
(defun local-cmd-9 () (interactive) (load "~/preserve/local-cmd-9.el"))
(defun local-cmd-0 () (interactive) (load "~/preserve/local-cmd-0.el"))

;;;
;;; The following function will treat the current buffer like a
;;; compilation buffer. If it has lines like 'bla.c:67:<something>' in
;;; it, you will be able to use the usual compile-mode keystrokes to
;;; jump to errors. Please note that this command will rebind keys,
;;; especially it will rebind C-c C-c to "goto-error", so it makes
;;; sense to place invocation of this command on C-c C-c, since this
;;; command will not be used once the buffer is ready for error
;;; browsing.
;;;

(defun cra-fake-compilation-buffer () (interactive)
  (compilation-minor-mode))

;(global-set-key [?\C-h] 'backward-delete-char-untabify)
;(global-set-key [?\C-\M-h] 'backward-kill-word)
(define-key isearch-mode-map [?\C-h] 'isearch-delete-char)
;;; this breaks emacs-23
;;(global-set-key [delete] 'delete-char)

(defun switch-backspace-to-control-h ()
  (global-set-key [?\C-h] 'delete-char)
  (global-set-key [?\C-h] 'backward-delete-char-untabify))

(global-set-key [f12] selectmap)
;(global-set-key [?\C-c ?4] 'tab2four)
;(global-set-key [?\C-c ?b] 'bsd)
(global-set-key [?\C-c ?D] 'cradate)
(global-set-key [?\C-c ?f] 'fundamental-mode)
(global-set-key [?\C-c ?F] 'crafont)
(global-set-key [?\C-c ?g] 'cra-compile)
(global-set-key [?\C-c ?i] 'info-this-dir)
(global-set-key [?\C-c ?k] 'crasnd-stop-continue)
(global-set-key [?\C-c ?K] 'crasnd-next)
(global-set-key [?\C-c ?m] 'set-mark-command)
(global-set-key [?\C-c ?o] 'toggle-read-only)
(global-set-key [?\C-c ?r] 'revert-buffer)
(global-set-key [?\C-c ?R] 'random-line)
(global-set-key [?\C-c ?t] 'text-mode)
(global-set-key [?\C-c ?u] 'cra-shorten-url)
(global-set-key [?\C-c ?U] 'ubbwand)
(global-set-key [?\C-c ?v] 'cravisitlink)
(global-set-key [?\C-c ?V] 'crawin)
(global-set-key [?\C-c ?w] 'write-region)
(global-set-key [?\C-c ?W] 'whitespace)
(global-set-key [?\C-c ?x] 'cra-run)
(global-set-key [?\C-c ?q] 'forum-insert-quote-divider)
(global-set-key [?\C-c ?|] 'cra-region-to-x11-selection)
(global-set-key [?\C-c ?\C-|] 'cra-insert-x11-selection)
;; tty can't tell ?\C-| from ?\C-\\
(global-set-key [?\C-c ?\C-\\] 'cra-insert-x11-selection) 

(global-set-key [?\C-c ?1] 'local-cmd-1)
(global-set-key [?\C-c ?2] 'local-cmd-2)
(global-set-key [?\C-c ?3] 'local-cmd-3)
(global-set-key [?\C-c ?4] 'local-cmd-4)
(global-set-key [?\C-c ?5] 'local-cmd-5)
(global-set-key [?\C-c ?6] 'local-cmd-6)
(global-set-key [?\C-c ?7] 'local-cmd-7)
(global-set-key [?\C-c ?8] 'local-cmd-8)
(global-set-key [?\C-c ?9] 'local-cmd-9)
(global-set-key [?\C-c ?0] 'local-cmd-0)

;;(global-set-key [?\C-c ?\C-c] 'cra-fake-compilation-buffer) ; Re-sets C-c C-c
(global-set-key [?\C-c ?\C-d] 'del2white)
(global-set-key [?\C-c ?\C-e] 'eval-print-last-sexp)
(global-set-key [?\C-c ?\C-f] 'del2whitelines)
(global-set-key [?\C-c ?F] 'crafont)
(global-set-key [?\C-c ?L] (lambda () (interactive) (load "~/.emacs")))

(global-set-key [mouse-4] '(lambda () (interactive) (scroll-down 1)))
(global-set-key [mouse-5] '(lambda () (interactive) (scroll-up 1)))

;; code to be executed on loading
(when (and (eq window-system 'x)
	   (not is-xemacs-p))
  (correct-position))

(setq display-warning-suppressed-classes '(key-mapping font))

;; text fragments

(setq fragmentsmap (make-sparse-keymap))
(global-set-key  [?\C-c ?\r] fragmentsmap)

(define-key fragmentsmap [?f] '(lambda() (interactive)
				(insert "(format t \"\")")
				(goto-char (- (point) 2))))
(define-key fragmentsmap [?d] 'cradate)
(custom-set-variables
  ;; custom-set-variables was added by Custom.
  ;; If you edit it by hand, you could mess it up, so be careful.
  ;; Your init file should contain only one such instance.
  ;; If there is more than one, they won't work right.
 '(erc-modules (quote (autojoin button completion fill irccontrols match menu netsplit noncommands readonly ring stamp spelling track)))
 '(load-home-init-file t t)
 '(require-final-newline nil))
(custom-set-faces
  ;; custom-set-faces was added by Custom.
  ;; If you edit it by hand, you could mess it up, so be careful.
  ;; Your init file should contain only one such instance.
  ;; If there is more than one, they won't work right.
 )

;; [QUOTE][QB]l;aksd;
;; [/QB][/QUOTE]
;; [Quote="Martin Cracauer"][qb]
;; [/qb][/quote]

(defun forum-insert-quote-divider ()
  (interactive)
  (let (quote quoteend newpoint)
    (save-excursion
      (goto-char (point-min))
      (when (re-search-forward
	     "\\[q\\(uote\\)?\\(=[^]]+\\)?\\]\\(\\[qb\\]\\)?" nil t)
	(setq quote (match-string 0))))
    (save-excursion
      (goto-char (point-min))
      (when (re-search-forward "\\(\\[/qb\\]\\)?\\[/q\\(uote\\)?\\]" nil t)
	(setq quoteend (match-string 0))))
    (when quoteend
      (insert "\n")
      (insert quoteend)
      (insert "\n")
      (insert "\n")
      (setq newpoint (point))
      (insert "\n")
      (insert "\n")
      (when quote
	(insert quote))
      (insert "\n")
      (goto-char newpoint))))
(setq inhibit-startup-message t)

(defun renamerposition ()
  (interactive)
  (find-file "newname")
  (goto-char (point-min))
  (re-search-forward "__" nil t))

(defun itsalltext-helper ()
  (interactive)
  (end-of-buffer)
  (flyspell-mode)
  (if (>= emacs-major-version 22)
      (progn
	(longlines-mode)
	;;(longlines-show-hard-newlines)
	)
      (fundamental-mode)))


;; SLIME section

(defun setup-and-start-slime ()
  (setup-slime)
  (slime))

;;
;;(when (getenv "WANTSLIME")
;;  (setq *want-slime* t))
;;
;;(when *want-slime*
;;  (setenv "QRSINSTALL" (getenv "QPXROOT"))
;;  (let ((qpx-slime-loc (concat (getenv "QPXROOT") "/elisp")))
;;    (when (file-directory-p qpx-slime-loc)
;;      (add-to-list 'load-path qpx-slime-loc)
;;      (require 'qpx-slime))))
;;
;;(defun craslime (&optional cmd)
;;  (interactive)
;;  (if (comint-check-proc "*inferior-lisp*")
;;      (slime-repl)
;;      (progn
;;	(setq sbcl-program (or cmd ",sbcl"))
;;	(add-hook 'slime-connected-hook
;;		  (lambda ()
;;		    (slime-interactive-eval "(print 'hello-world)")))
;;	(slime)
;;	;(funcall *slime-start-function*)
;;	)))
;;
;;(defvar *tmp-slime-dir* nil)
;;
;;(defun qpxslime (&optional cmd mydir)
;;  (interactive)
;;  (if (comint-check-proc "*inferior-lisp*")
;;      (slime-repl)
;;      (progn
;;	(setq sbcl-program (or cmd "qpxlisp noexit -runtime"))
;;	(setq *tmp-slime-dir* mydir)
;;	(add-hook 'slime-connected-hook
;;		  (lambda ()
;;		    (slime-repl-set-package "scheduling")
;;		    (slime-interactive-eval "(print 'hello-world)")
;;		    (when *tmp-slime-dir*
;;		      (slime-interactive-eval
;;		       (concat 
;;			"(cra:cd \"" *tmp-slime-dir* "\")"))
;;		      (slime-interactive-eval "(cra:cd)"))))
;;	(funcall *qpx-slime-start-function*)
;;	)))
;;

(defvar *slime-target-dir* nil)
(defun qpxslime (&optional cmd mydir)
  (interactive)
  (if (comint-check-proc "*inferior-lisp*")
      (slime-repl)
      (progn
	(setq inferior-lisp-program
	      (setq sbcl-program (or cmd "qpxlisp noexit -runtime")))
	(setf *slime-target-dir* mydir)
	(add-hook 'slime-connected-hook
		  (lambda ()
		    (slime-repl-set-package "scheduling")
		    ;;(slime-interactive-eval "(print 'hello-world)")
		    (when *slime-target-dir*
		      (slime-interactive-eval
		       (concat 
			"(cra:cd \"" *slime-target-dir* "\")"))
		      ;;(slime-interactive-eval "(cra:cd)")
		      )))
	(if *ita-slime*
	    (funcall *qpx-slime-start-function*)
	    (setup-and-start-slime)))))

(defun testme ()
  (interactive)
  (qpxslime nil "/tmp"))

(load-file "~/.emacs2")