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

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

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

;;;
;;; general emacs setup
;;;
(set-input-mode t nil t)
(setq load-path (cons (expand-file-name "~/elisp")
		      load-path))
(when is-xemacs-p
  (setq load-path (cons (expand-file-name "~/xelisp")
			load-path)))
(setq make-backup-files nil)
(when (/= (user-uid) 0)
  (require 'saveplace)
  (setq-default save-place t))
(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)

(let ((hostname (getenv "HOSTNAME")))
  (when (or (string= hostname "nov.internal.itasoftware.com")
	    (string= hostname "jul.internal.itasoftware.com")
	    (string= hostname "may.internal.itasoftware.com"))
    (setq ps-lpr-command "ps-printer")))

;;;
;;; 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")))
;(if (locate-library "ilisp")
;    (add-hook 'lisp-mode-hook
;	      '(lambda ()
;		 (load-library "ilisp")
;		 (global-set-key [?\C-z ?\C-z] 'suspend-emacs))))
(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= "svn-commit.tmp" (buffer-name (current-buffer)))
	      (setq-default save-place nil))
	    (define-key text-mode-map "\t" 'indent-for-tab-command)))

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

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

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

;;; 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.\\)" . text-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)
  "Eliminate whitespace at ends of all lines in the buffer."
  (save-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-excursion
    (if (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-excursion
    (let (
	  (upto (buffer-size))
	  (old-point (point)))
      (if (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)
  ;; obsolete crap, now built into ,make
  (format ",make %s"
	  (if (and
	       (file-exists-p ".craflags")
	       (eq 0 (call-process "grep" nil nil nil "^doautomaticinstall$"
				   ".craflags")))
	      " install"
	      "")))

(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)))
  (compile cra-compile-command))

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

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

(defun useless-buffer-p (buffer)
  (let ((name buffer))
    (if (not (stringp name))
	(setf 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 start-cmucl-from-key ()
  (interactive)
  (cond ((firstbuffer-matching (buffer-list) "*allegro*")
	 (switch-to-buffer (firstbuffer-matching (buffer-list) "*allegro*")))
	((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*")))
	(t
	 (load "~/.ilisp")
	 (sbcl))))

(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 "*cmulisp*" (start-cmucl-from-key))
(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))
	  (setf res (cons (cons (buffer-name buffer) buffer) res))))
    (when res
      (setf res (reverse res))
      (setf res (cons "whatisthisfor?" res))
      (setf 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
;;;

(and (and is-emacs-p
	  (/= emacs-major-version 19))
     (or (file-exists-p "~/elisp/text-mode.elc")
	 (file-exists-p "~/elisp/indent.elc"))
     ;; not a bug, run into error when one exists and not the other
     (load "~/elisp/text-mode.elc")
     (load "~/elisp/indent.elc"))

(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]*)\\|==>\\) ")

(setq *in-newline* nil)
(defun crapoints ()
  (if (and (not *in-newline*)
	   (save-excursion (re-search-backward cra-parabreakers nil t)))
      (let ((len) (pos) (pos2))
	(setq len (length (match-string 0)))
	(setq pos (match-beginning 0))
	(save-excursion
	  (if (re-search-backward "\n|*\n" nil t)
	      (progn
		(setq pos2 (match-beginning 0))
;		(print (format "pos: %d, pos2: %d." pos pos2))
		(if (>= pos pos2)
		    len
		  0))
	    len)))
    0))

;(defun crapoints ()
;  (interactive)
;  (let ((bla (setq bla (crapoints2))))
;    (print (format "returned: %s" bla))
;    bla))

(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."
  (save-excursion
    (back-to-indentation)
    (max 0
	 (+ left-margin (or (get-text-property
			     (if (and (eobp) (not (bobp)))
				 (1- (point)) (point))
			     'left-margin) (crapoints))))))

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

(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 (first (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" (- (first 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 (first 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 (first (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 (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
      (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)
    (setf 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)
(global-set-key [delete] 'delete-char)

(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 -- don't edit or cut/paste it!
  ;; Your init file should contain only one such instance.
 '(load-home-init-file t t)
 '(require-final-newline nil))
(custom-set-faces
  ;; custom-set-faces was added by Custom -- don't edit or cut/paste it!
  ;; Your init file should contain only one such instance.
 )

;; [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)
	(setf quote (match-string 0))))
    (save-excursion
      (goto-char (point-min))
      (when (re-search-forward "\\(\\[/qb\\]\\)?\\[/q\\(uote\\)?\\]" nil t)
	(setf quoteend (match-string 0))))
    (when quoteend
      (insert "\n")
      (insert quoteend)
      (insert "\n")
      (insert "\n")
      (setf 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)
  (fundamental-mode))