;;; MC's Emacs configuration file
;;; Time-stamp: <2005-10-14 00:06:54 by MC>
;;;
;;; If you copy anything from here, I won't be responsible if it
;;; doesn't behave the way you thought it would.
;;;
;;; M.C. Widerkrantz, mc@hack.org

;;; I want to enter the debugger on any error and see a
;;; backtrace. This is first in the file so I get a hint where any
;;; errors later on are.

(setq debug-on-error t)

;;; Use lots of memory and collect garbage less often. I have plenty
;;; of memory nowadays and things do go faster.
(setq gc-cons-threshold (* 12 1024 1024))

;;; I want to see when Emacs collects the trash.
(setq garbage-collection-messages t)

;;;; Files, where to load them and where to put them.

(setq load-path 
      (cons (expand-file-name "~/lib/elisp/ngnus-0.3/lisp")
	    (cons (expand-file-name "~mc/lib/elisp")
		  (cons (expand-file-name "~/lib/elisp/bbdb-2.34")
			(cons (expand-file-name "~/lib/elisp/zenirc")
				    load-path)))))

(setq Info-default-directory-list
      (cons "~/lib/info" Info-default-directory-list))

;;; I have a python-mode of my own if there isn't one in the standard
;;; installation. Be sure that we can load it.

(autoload 'python-mode "python-mode" "" t)

(setq interpreter-mode-alist
      (cons '("python" . python-mode)
            interpreter-mode-alist))

;;; I want to play some music, occasionally.
(autoload 'mpg123 "mpg123" "A Front-end to mpg123 and lookalikes" t)
(setq mpg123-mpg123-command "mpg321"
      mpg123-mpg123-command-args '("-r 48000")
      mpg123-face-playing '("indianred2" . "black")
      mpg123-need-slider nil
      mpg123-startup-volume 75
      mpg123-show-help nil)

;;; I want to use Lennart Staflin's PSGML mode to edit SGML and XML
;;; files.

(require 'psgml)
(autoload 'sgml-mode "psgml" "Major mode to edit SGML files." t)
(autoload 'xml-mode "psgml" "Major mode to edit XML files." t)
(setq sgml-catalog-files '("CATALOG" "/usr/local/share/sgml/catalog"))
(setq sgml-set-face t)
(add-to-list 'auto-mode-alist '("\\.html$" . sgml-mode))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Emacs' visual appearance and user interface

(setq cursor-in-non-selected-windows nil)

;;; Yank to where the cursor is, even in X. Don't mind that damn
;;; rodent thing.

(setq mouse-yank-at-point t)

;;; No silly menus, toolbars, line numbers or columns.

(if (fboundp 'menu-bar-mode)
    (menu-bar-mode -1))

(if (fboundp 'tool-bar-mode)
    (tool-bar-mode -1))

(if (fboundp 'scroll-bar-mode)
    (scroll-bar-mode -1))

(if (fboundp 'line-number-mode)
    (line-number-mode -1))

(if (fboundp 'column-number-mode)
    (column-number-mode -1))
     
;;; We don't need no steenking bell.

; Doesn't seem to work in emacs-nox, so see below.

(setq visible-bell t) 

(defun mc-ding ()
  (message "Woof! Woof!"))

(setq ring-bell-function 'mc-ding)

;;; I want unique buffer names with hints as to where the files are.

(require 'uniquify)

(setq uniquify-buffer-name-style 'post-forward-angle-brackets
      uniquify-after-kill-buffer-p t)

;;; Display the time in the mode line.

(setq display-time-24hr-format t)

;;; Get rid of that darn load message in the mode line.

(setq display-time-string-forms
      '((if display-time-day-and-date
	   (format "%s %s %s" dayname monthname day) "")
       (format "%s:%s"
	       24-hours minutes)
       (if mail " Incoming!")))

(setq display-time-interval 60)

;;;; Per Cederqvist's Maildir aware display-time hack.

;; Make display-time aware of Maildir.
(defvar ceder-maildir-dir nil)
(defvar ceder-maildir-boxes-to-check '("new" "cur"))

(setq ceder-maildir-dir "/home/mc/Maildir")

(defun ceder-display-time-check-mail-maildir ()
  (unless ceder-maildir-dir
    (setq ceder-maildir-dir
	  (expand-file-name "Maildir"
			    (expand-file-name (user-login-name)
					      "/var/mail"))))
  (catch 'got-mail
    (let ((mail nil)
	  (boxes ceder-maildir-boxes-to-check))
      (while boxes
	(let ((mails (directory-files
		      (expand-file-name (car boxes) ceder-maildir-dir)
		      nil nil t)))
	  (while mails
	    (cond
	     ((string= (car mails) "."))
	     ((string= (car mails) ".."))
	     (t (throw 'got-mail t)))
	    (setq mails (cdr mails))))
	(setq boxes (cdr boxes))))
    nil))

(setq display-time-mail-function
      'ceder-display-time-check-mail-maildir) (setq display-time-mail-file
						    "/no-such-file")

;;;; End of ceder's display-time hack.

(display-time)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Modes

;;; Dired
(setq dired-recursive-copies 'top)

;;; Swedish calendar settings. Comment this out if you don't have
;;; sv-kalender or fetch it from:
;;; http://hack.org/mc/software/sv-kalender.el

(load-library "sv-kalender")

;;; RMAIL and sendmail. Historic. See instead the .gnus.el file for
;;; Gnus settings.

(setq rmail-highlighted-headers
      "^From:\\|^Reply-To\\|^Organization:\\|^To:\\|^Cc:\\|^Newsgroups:\\|^Subject:\\|^Date:")

(require 'smtpmail)
(setq mail-user-agent 'sendmail-user-agent)

;;; For tunneled mail to my MTA.
(setq smtpmail-default-smtp-server "localhost"
      smtpmail-smtp-server "localhost"
      smtpmail-smtp-service 4712
      smtpmail-debug-info nil)

(defun mc-send-it ()
  "Send mail message to SMTP server we find in /etc/smtpserver"
  (setq smtpmail-default-smtp-server 
        (with-temp-buffer
          (insert-file-contents "/etc/smtpserver")
          (buffer-string)))
  (setq smtpmail-smtp-server smtpmail-default-smtp-server)
  (smtpmail-send-it))

(setq mail-default-headers "From: mc@hack.org\nFCC: /tmp/foo.txt\nMime-Version: 1.0\nContent-Type: text/plain; charset=\"iso-8859-1\"\nContent-Transfer-Encoding: 8bit\n")

;;; I'd like to have auto-fill on all text-mode buffers, please.

(add-hook 'text-mode-hook 'turn-on-auto-fill)

(global-font-lock-mode 1)

;;;;; Old C style mode.

;;; I use the BSD style for C programs...
;;; But I want RET to do a newline and indent to next line.

;; (defun mc-c-mode-hook ()
;;   "My personal C mode"
;;   (turn-on-font-lock)
;;   (c-set-style "BSD")
;;   (setq c-basic-offset 4)
;;   (setq-default indent-tabs-mode nil) ; Don't insert TAB chars.
;;   (define-key c-mode-map "\C-m" 'newline-and-indent))

;; (add-hook 'c-mode-common-hook 'mc-c-mode-hook)

;;;; New cc-mode style stuff.

;;; The Business Security C Programming Style. I created this cc-mode
;;; style to adher to the coding style used at work.

(defconst bs-c-style
  '((c-tab-always-indent        . t)
    (c-comment-only-line-offset . 0)
    (c-hanging-braces-alist     . ((substatement-open after)
                                   (brace-list-open)))
    (c-hanging-colons-alist     . ((member-init-intro before)
                                   (inher-intro)
                                   (case-label after)
                                   (label after)
                                   (access-label after)))
    (c-cleanup-list             . (scope-operator
                                   empty-defun-braces
                                   defun-close-semi))
    (c-offsets-alist            . (
                                   (defun-block-intro . +)
                                   (statement-block-intro . +)
                                   (knr-argdecl-intro . +)
                                   (substatement-open . +)
                                   (label . 0)
                                   (statement-cont . +)
                                   (inline-open . 0)
                                   (inexpr-class . 0)
                                   (arglist-close . c-lineup-arglist)
                                   (substatement-open . 0)
                                   (case-label        . +)
                                   (statement-case-intro . +)
                                   (block-open        . 0)
                                   ))
    (c-echo-syntactic-information-p . t))
  "Business Security Programming Style")

;; Customizations for all modes in CC Mode. What I actually use, at
;; least when I'm allowed to.

(defun mc-c-mode-common-hook ()
  ;; I use the BSD C style.
  (c-set-style "bsd")
  ;; Other customizations.

  ;; The offset is four spaces. Needs to be set after the style.
  (setq c-basic-offset 4
        tab-width 8                     ; Tab is always 8 spaces.
        ;; this will make sure spaces are used instead of tabs
        indent-tabs-mode nil)
  ;; Automagic newline and hungry delete when pressing magic buttons.
  (c-toggle-hungry-state 1)
  ;; Some extra keys.
  (define-key c-mode-base-map "\C-c;" 'indent-for-comment)
  (define-key c-mode-base-map "\C-m" 'c-context-line-break))

(add-hook 'c-mode-common-hook 'mc-c-mode-common-hook)

;;; The favourite language of all times must have a mode of its own.
(autoload 'forth-mode "gforth.el")
(setq auto-mode-alist
      (cons '("\\.fs\\'" . forth-mode) auto-mode-alist))

;;; Variables for the LysKOM conference system

(autoload 'lyskom "lyskom" "lyskom" t)

;;; I want to run clisp, not CMU/CL, in an inferior Lisp listener.

(setq inferior-lisp-program "lisp")

;;; For the ZenIRC Internet Relay Chat client

(autoload 'zenirc "~/.zenirc.el" "Major mode to waste time" t)

;;; My LiveJournal. Not used at the moment.

;; (require 'ljupdate)
;; (require 'lj-bbdb)

;; (setq lj-default-profile (lj-defprofile 'livejournal "stavrogin"))
;; (lj-defprofile 'livejournal "ljupdate")

;;; Support functions

;;; Support for exit protection

(defun exit ()
  "Exit emacs."
  (interactive)
  (if (y-or-n-p "Exit emacs? ")
      (save-buffers-kill-emacs)))

(define-key global-map "\C-x\C-c" 'exit)

(defun tea-time (timeval)
  "Ask how long the tea should draw and start a timer."
  (interactive "sHow long (min:sec)? ")
  (if (not (string-match "\\`\\([0-9]*\\)[.:]\\([0-5]?[0-9]?\\)\\'" timeval))
      (error "Strange time."))

  (let* ((minutes (string-to-int (substring timeval (match-beginning 1)
					    (match-end 1))))
	 (seconds (+ (* minutes 60)
		      (string-to-int (substring timeval (match-beginning 2)
						(match-end 2))))))
    (tea-timer seconds)))

(defun tea-timer (sec)
  "Ding when tea is ready."
  (interactive)
  (run-at-time sec nil '(lambda ()
                          (ding t) (ding t)
                          (message "Your tea is ready!"))))

(defun add-diary-entry ()
  "Add a diary entry to diary file"
  (interactive)
  (switch-to-buffer "temporary for diary add")
  (change-log-mode)
  (add-change-log-entry nil "~/public_www/mclog.txt")
  (kill-buffer "temporary for diary add"))

;;; I want to be able to write eight bit characters from a character
;;; terminal. If not a terminal, I want the mode line to be prettier.

(if (not window-system)
    (set-input-mode (car (current-input-mode))
		    (nth 1 (current-input-mode))
		    0)
;  (set-face-font 'mode-line "-*-lucida-medium-r-*-*-10-*-*-*-p-*-*-*")
  (set-face-font 'mode-line "-b&h-lucida-medium-r-normal-sans-10-100-75-75-p-58-iso8859-1")
  (set-face-background 'mode-line "black")
  (set-face-foreground 'mode-line "white"))

;;; Load support functions for inserting current time and Discordian
;;; time.

(require 'discdate)

;;; If Time-stamp: <> or Time-stamp "" exist within the first 8 lines
;;; in a file when saving, it will be written back like this
;;; "Time-stamp: <'date' 'time' by 'full name of user'>"

(require 'time-stamp)
(add-hook 'write-file-hooks 'time-stamp)
(setq time-stamp-format "%:y-%02m-%02d %02H:%02M:%02S by %U")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Key bindings

;; To make C-z do what C-x does if we can't use C-x, for some reason
;; (like, for instance, very stupid terminal switches with stupid
;; escape sequences. Nag, nag, nag.)

(global-set-key "\C-z" ctl-x-map)

(global-set-key "\M-," 'compile)
(global-set-key "\C-x\M-," 'remote-compile)
(global-set-key "\M-g" 'goto-line)
(global-set-key "\C-ha" 'apropos)

;;; Support functions to enter Latin characters with a 7 bit
;;; keyboard. Useful for terminals that can switch between at least
;;; two character sets. 
;; Now mostly historic.

(require 'mc-latin1-insert)

;(global-set-key "\C-x\C-m" 'sw-iso)
;(global-set-key "\C-xm" 'sw-ascii)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Misc settings

;;; Why shouldn't I be able to express myself?
(put 'eval-expression 'disabled nil)
(put 'upcase-region 'disabled nil)
(put 'downcase-region 'disabled nil)
(put 'set-goal-column 'disabled nil)
(setq truncate-partial-width-windows nil)
(put 'narrow-to-region 'disabled nil)

;;; Ask if there isn't a final newline...
(setq require-final-newline nil)

;;; but be sure not to insert a bunch of 'em at the same time.
(setq next-line-add-newlines nil)

;;; Ignore these extensions in file expansion
(setq completion-ignored-extensions '(".a" ".so" ".o" ".elc" "~" ".dvi"))

;;; Disable suspend if running under screen...
(cond
 ((getenv "WINDOW")
;  (global-unset-key "\C-z") FIXME!
  (message "Disabled suspend - running under screen.")))

;;; Big Brother Database

(autoload 'bbdb "bbdb" "The Insidious Big Brother Database" t)
(require 'bbdb)

(bbdb-initialize)
(autoload 'bbdb-insinuate-gnus "bbdb-gnus")
(setq bbdb-send-mail-style 'message
      bbdb-message-caching-enabled t
      bbdb-use-pop-up nil
      bbdb-electric-p nil
      bbdb-offer-save 'always
      bbdb/mail-auto-create-p 'bbdb-ignore-most-messages-hook
      bbdb-north-american-phone-numbers-p nil
      bbdb-completion-type 'primary-or-name)

(defun bbdb-add-gnus-group (record)
  "Put the current gnus group in this record's posted-to field if it's not there"
  (or bbdb-readonly-p
      (let* ((group gnus-newsgroup-name)
             (field (bbdb-record-getprop record 'posted-to))
             (pos (string-match ":" group)) ; we don't want the nnm[hl]: part
             )
        (setq group (substring group (cond
                                      (pos (1+ pos))
                                      (t 0)))) ; we didn't match on ":"
        (if (or
             (not field)                ; the field isn't there yet.
             (not (string-match (concat (regexp-quote group)
                                        "\\(\n\\|$\\)") field)))
            (bbdb-annotate-notes record group 'posted-to)))))

(setq bbdb-auto-notes-alist
      (append
       (list
        '("Organization" ("\\s-*\\(.*\\)\\s-*" company 1 t))
        '("Organisation" ("\\s-*\\(.*\\)\\s-*" company 1 t))
        '("X-Organization" ("\\s-*\\(.*\\)\\s-*" company 1 t))
        '("X-Organisation" ("\\s-*\\(.*\\)\\s-*" company 1 t))
        '("Web" ("\\s-*\\(.*\\)\\s-*" url 1))
        '("X-Web" ("\\s-*\\(.*\\)\\s-*" url 1))
        '("X-WWW-Homepage" ("\\s-*\\(.*\\)\\s-*" url 1))
        '("X-WWW-page" ("\\s-*\\(.*\\)\\s-*" url 1))
        '("X-Homepage" ("\\s-*\\(.*\\)\\s-*" url 0))
        ;; This is what Netscape puts in when sending a URL reference
        '("X-Url" ("\\s-*\\(.*\\)\\s-*" last-url 1))
        '("X-Mailer" ("\\s-*\\(.*\\)\\s-*" mailer 1 t))
        '("X-Newsreader" ("\\s-*\\(.*\\)\\s-*" mailer 1 t))
        '("X-Mua" ("\\s-*\\(.*\\)\\s-*" mailer 1 t))
        )))

(add-hook 'bbdb-notice-hook 'bbdb-auto-notes-hook)
(add-hook 'bbdb-notice-hook 'bbdb-add-gnus-group)

;;; I want the .bbdb file to be coded as straight Latin 1 please.

(modify-coding-system-alist 'file (regexp-quote (expand-file-name bbdb-file))
                            'iso-8859-1)

;;; WWW. Use Firefox as default browser.

(setq browse-url-generic-program "firefox")
(setq browse-url-browser-function 'browse-url-generic)

;;; TRAMP remote file access.

(setq tramp-default-method "rsync")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Characters, languages and stuff

(set-language-environment "Latin-1")
(set-terminal-coding-system 'latin-1)

(setq ispell-local-dictionary "british")