;;; -*-Emacs-Lisp-*-

;;; ---- Hack av davidk
(defmacro try-require (package &rest forms)
  (` (condition-case error
	 (progn
	   (require (, package))
	   (message "Required %s" (, package))
	   (,@ forms))
       ('error
	(message "%s" (nth 1 error))))))
(put 'try-require 'lisp-indent-function 1)

(defmacro try-load (file &rest forms)
  (` (condition-case error
	 (progn
	   (load (, file))
	   (,@ forms))
       ('error
	(message "%s: \"%s\"" (nth 1 error) (nth 2 error))))))
(put 'try-load 'lisp-indent-function 1)

(defmacro try-eval (&rest forms)
  (` (condition-case error
	 (progn
	   (,@ forms))
       ('error
	(message "%s: \"%s\"" (nth 1 error) (nth 2 error))))))
(put 'try-eval 'lisp-indent-function 0)


;;; ---- Allmänt
(put 'eval-expression 'disabled nil)
(setq inhibit-startup-message t)
(setq garbage-collection-messages t) ; traditional

;;; ---- Globala inställningar
; (setq user-mail-address "nisse@lysator.liu.se")

;; Oidentifierbara filer ska öppnas i text-mode
(setq default-major-mode 'text-mode)

;; Avsluta alla filer med ett newline-tecken.
;;           nil - Gör ingenting
;;             t - Lägg till newline om det inte finns
;;   något annat - Fråga först
(setq require-final-newline 'ask)

;; Trevligare namngivning av buffertar
(require 'uniquify)
(setq uniquify-buffer-name-style 'post-forward-angle-brackets)

;; Gör så att ange-ftp använder anonym FTP om inget annat anges.
(setq ange-ftp-default-user "anonymous")
(setq ange-ftp-default-password user-mail-address)

;; Visa 24-timmarstid med display-time
(setq display-time-24hr-format t)


;; I Sverige börjar veckan med måndag.
(setq calendar-week-start-day 1)

;; Ange hur backupfiler ska sparas. När du sparar en fil kommer den
;; gamla kopian att sparas under namnet filnamn~, eller enligt följande.
;;   t   - Spara numrerade backupfiler. De heter fil.~1~, fil.~2~ etc.
;; nil   - Spara bara numrerade filer om det redan fanns numrerade filer.
;; never - Spara aldrig numrerade filer.
(setq version-control nil)

;; Gör backupfiler, även om de ligger under versionskontroll (RCS etc)
(setq vc-make-backup-files t)

;; När man programmerar kan det ibland vara väldigt trevligt om Emacs
;; blinkar matchande parenteser även om de står långt ifrån varandra.
;; Det kan göra Emacs lite långsammare någon gång ibland, men det är
;; det värt.
(setq blink-matching-paren-distance nil)

;; Utan den här raden kan man råka stoppa in en massa extra tomrader
;; sist i filen om man trycker C-n för många gånger.
(setq next-line-add-newlines nil)

;; Klistra in med mittenknappen
(substitute-key-definition 'mouse-yank-at-click 'yank global-map)

;; Döda inte emacs av misstag.
(setq kill-emacs-query-functions 
      (cons (lambda () 
                (y-or-n-p "Really kill Emacs? "))
             kill-emacs-query-functions))

;; Pauser

(type-break-mode 1) 

; Hanoi skickar för mycket data för att vara skoj på en slö textterminal
;(try-eval
  (setq type-break-demo-functions
	(delq 'type-break-demo-hanoi type-break-demo-functions))
;)

;;; ---- automode-alist
(defmacro apush (alist key value )
  `(setq ,alist (cons (cons ,key ,value) ,alist)))

(defmacro alist-add (alist key value)
  `(setq ,alist (cons (cons ,key ,value)
		      (delq (assoc ,key ,alist) ,alist) )))

(defmacro add-auto-mode (regexp mode)
  `(alist-add auto-mode-alist ,regexp ,mode))

;  (` (setq auto-mode-alist (cons (cons (, regexp) (, mode))
;				 (delq (assoc (, regexp) auto-mode-alist)
;				       auto-mode-alist) ))))

;;; ---- Emacs server
(try-require 'server
  (server-start))

;;; ---- Character sets /ture
 
;(load-library "iso-transl") ; Görs i default.el

(defun display-iso-646 ()
  (interactive)
  (standard-display-ascii ?\366 "|")
  (standard-display-ascii ?\326 "\\")
  (standard-display-ascii ?\344 "{")
  (standard-display-ascii ?\304 "[")
  (standard-display-ascii ?\345 "}")
  (standard-display-ascii ?\305 "]"))


;; Iso-8859 support
(defconst iso-swascii
  '((?ö . ?|)
    (?Ö . ?\\)
    (?ä . ?{)
    (?Ä . ?[)
    (?å . ?})
    (?Å . ?])))

(defun convert-region-to-swascii (beg end)
  "Convert region from ISO-8859/1 to ISO-646 (Swedish ASCII)."
  (interactive "r")
  (let ((l iso-swascii))
    (while l
      (subst-char-in-region beg end (car (car l)) (cdr (car l)))
      (setq l (cdr l)))))

(defun convert-region-to-iso (beg end)
  "Convert region from ISO-646 (Swedish ASCII) to ISO-8859/1."
  (interactive "r")
  (let ((l iso-swascii))
    (while l
      (subst-char-in-region beg end (cdr (car l)) (car (car l)))
      (setq l (cdr l)))))

(defun convert-buffer-to-swascii ()
  "Convert buffer from ISO-8859/1 to ISO-646 (Swedish ASCII)."
  (interactive)
  (convert-region-to-swascii (point-min) (point-max))) 

(defun convert-buffer-to-iso ()
  "Convert buffer from ISO-646 (Swedish ASCII) to ISO-8859/1."
  (interactive)
  (convert-region-to-iso (point-min) (point-max)))


;;; ---- ÅÄÖ trouble
(defvar keyboard-is-US-style nil 
  "Set this to non-nil if keyboard lacks keys for äåö.")

(defvar åäö-translate nil
  "Buffer local variable, set if you need åäö more than }{|")

(make-variable-buffer-local 'åäö-translate)

(defmacro cond-translate-key (pred key char)
  (` (local-set-key (, key)
		    (lambda ()
		      (interactive)
		      (insert (if (, pred)
				  (, char ) (, key)))))))

(defmacro do-åäö-translate ()
  '(and keyboard-is-US-style åäö-translate))

(defun cond-åäö-translate () (interactive)
  (cond-translate-key (do-åäö-translate) "}" "å")
  (cond-translate-key (do-åäö-translate) "{" "ä")
  (cond-translate-key (do-åäö-translate) "|" "ö")
  (cond-translate-key (do-åäö-translate) "]" "Å")
  (cond-translate-key (do-åäö-translate) "[" "Ä")
  (cond-translate-key (do-åäö-translate) "\\" "Ö"))

(defun stupid-US-keyboard (&optional arg)
  "Without argument, toggles the keyboard-is-US-style flag.
With positive argument, set the flag. 
Any other argument clears the flag."
  (interactive "P")
  (cond ((not arg) 
	 (setq keyboard-is-US-style (not keyboard-is-US-style)))
	((and (numberp arg) (> arg 0)) (setq keyboard-is-US-style t))
	(t (setq keyboard-is-US-style nil))))

(defun åäö-translate (&optional arg)
  "Without argument, toggles the åäö-translate flag.
With positive argument, set the flag. 
Any other argument clears the flag."
  (interactive "P")
  (cond ((not arg) 
	 (setq åäö-translate (not åäö-translate)))
	((and (numberp arg) (> arg 0)) (setq åäö-translate t))
	(t (setq åäö-translate nil)))
  (if åäö-translate
      ;; Bind keys
      (cond-åäö-translate)))
	 

;;; ---- Mail ---------------------------------------------------------
;; Sätt in filen ~/.signature sist i varje brev
;(setq mail-signature t)

;; Kommenterad text ska föregås av nedanstående sträng på varje rad.
(setq mail-yank-prefix "> ")

;; Detta är en rätt ful lösning. När man trycker C-c C-y i
;; *mail*-bufferten när man svarar på ett brev så sätter man in den
;; kommenterade texten, men för att den inte ska sätta in så mycket
;; onödigt junk så gör vi så här.
(setq mail-yank-ignored-headers "^.*:")

;; Skicka alla mail och newinlägg till mig själv så att jag kan arkivera dem.
;; föråldrat
;;(setq mail-self-blind t
;;      gnus-mail-self-blind t)


;; Lägg till MIME-headers
(setq mail-default-headers
      (concat "MIME-Version: 1.0\n"
	      "Content-type: text/plain; charset=iso-8859-1\n"
	      "Content-transfer-encoding: 8bit\n"))

(setq message-default-headers mail-default-headers)

(global-set-key "\C-xm" 'message-mail)

;; Kopierat från Lars Aronssons .emacs
;(defun mail-mime-latin1-headers ()
;  "Create some header fields."
;  (interactive)
;  (expand-abbrev)
;  (or (mail-position-on-field "content-type" t)
;      (progn (beginning-of-buffer)
;             (insert "Mime-Version: 1.0\n")
;	     (insert "Content-Type: text/plain; charset=iso-8859-1\n")
;             (insert "Content-Transfer-Encoding: 8bit\n")
;	     (mail-position-on-field "to"))))

;(add-hook 'mail-setup-hook 'mail-mime-latin1-headers)

;; Behövs inte med Gnus
; (try-load "mime-utils" 
;   (mu::attach-rmail))


;;; ---- bbdb
(autoload 'bbdb         "bbdb-com" "Insidious Big Brother Database" t)
(autoload 'bbdb-name    "bbdb-com" "Insidious Big Brother Database" t)
(autoload 'bbdb-company "bbdb-com" "Insidious Big Brother Database" t)
(autoload 'bbdb-net     "bbdb-com" "Insidious Big Brother Database" t)
(autoload 'bbdb-notes   "bbdb-com" "Insidious Big Brother Database" t)
(autoload 'bbdb-insinuate-vm       "bbdb-vm"    "Hook BBDB into VM")
(autoload 'bbdb-insinuate-rmail    "bbdb-rmail" "Hook BBDB into RMAIL")
(autoload 'bbdb-insinuate-mh       "bbdb-mhe"   "Hook BBDB into MH-E")
(autoload 'bbdb-insinuate-gnus     "bbdb-gnus"  "Hook BBDB into GNUS")
(autoload 'bbdb-insinuate-sendmail "bbdb"       "Hook BBDB into sendmail")

(setq bbdb-default-area-code nil)
(setq bbdb-north-american-phone-numbers-p nil)
(add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail)


;;; ---- recurse
(try-require 'recurse
  (global-set-key "\C-cr" 'recurse)
  (global-set-key "\C-cp" 'recurse-pop-task))


;;; ---- Göm ©-kommentarer
(defun hide-© ()
  "Hide copyright notice at the beginning of a file."
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (and (let ((case-fold-search t))
	   (search-forward "copyright" 2000 t))
	 ;; The word "Copyright" appears somewhere near the beginning
	 ;; of buffer. Is it a comment?
	 (hs-inside-comment-p)
	 (hs-hide-block))))


;;; ---- Info
(eval-after-load "info" 
'(progn 
   (define-key Info-mode-map " " 'scroll-up)
   (define-key Info-mode-map [backspace] 'scroll-down)))

(defun mr-yank-info-nodename ()
  (interactive)
  (kill-new (format "*Note %s: (%s)%s,"
		    Info-current-node
		    (file-name-nondirectory Info-current-file)
		    Info-current-node)))

;;; ---- Text-mode
(setq sentence-end-double-space nil)

;; Behövs det här?
;(setq sentence-end "[.?!][]\"')}]*\\($\\|\t\\|  ?\\)[\n]*")

(add-hook 'text-mode-hook '(lambda ()
			     (auto-fill-mode 1)
			     (åäö-translate 1)))



;;; ---- lyskom
(setq kom-ding-on-personal-messages '2)
(add-hook 'minibuffer-setup-hook '(lambda () (åäö-translate 1)))
(setq kom-delayed-printing t
      kom-continous-scrolling t)

;(setq kom-default-face-scheme
;      (cond
;       ((null window-system)
;	'default)
;       ((not (x-display-color-p))
;	'monochrome)
;       ((eq (cdr (assoc 'background-mode (frame-parameters))) 'dark)
;	'inverse)
;       (t
;	'default)))


;;;; Programmeringsmoder
;;; ---- perl-mode
(add-auto-mode "\\.pl\\'" 'perl-mode) 

;;; ---- python
(add-auto-mode "\\.py\\'" 'python-mode)
(alist-add interpreter-mode-alist "python" 'python-mode)

(setq py-indent-offset 3)

;;; ---- CC-mode
(if (< emacs-major-version 20)
    (progn
      (makunbound 'c-mode)
      (makunbound 'c-mode-map)
      (makunbound 'c-style-alist)
      (fmakunbound 'c-mode)
      (fmakunbound 'c++-mode)
      
      (autoload 'c++-mode  "cc-mode" "C++ Editing Mode" t)
      (autoload 'c-mode    "cc-mode" "C Editing Mode" t)
      (autoload 'objc-mode "cc-mode" "Objective-C Editing Mode" t)
      (add-auto-mode "\\.C\\'" 'c++-mode)
      (add-auto-mode "\\.cc\\'" 'c++-mode)
      (add-auto-mode "\\.c\\'" 'c-mode)
      (add-auto-mode "\\.h\\'" 'c-mode)
      (add-auto-mode "\\.m\\'" 'objc-mode)))

(defun read-from-file (filename &optional max-length)
  "Read the first expression from a file"
  (save-excursion
    (let ((buffer (generate-new-buffer " *file-contents*")))
      (set-buffer buffer)
      (unwind-protect
	  (and (condition-case nil
		   (if max-length
		       (insert-file-contents filename nil 0 max-length)
		     (insert-file-contents filename))
		 (file-error nil))
	       (read buffer))
	(kill-buffer buffer)))))

(setq c-style-variables-are-local-p t)

(defun load-c-style ()
  (interactive)
  (or (let ((load-path '(nil)))  ; Current directory
	(load ".c-mode-hook" t t))
      (c-set-style "bsd")))

(defun read-c-style (default)
  (interactive)
  (c-set-style (or (read-from-file ".c-style" 200) default)))

(add-hook 'c-mode-common-hook
	  '(lambda ()
	     ;; (c-make-styles-buffer-local)
	     (read-c-style "bsd")
	     (setq c-basic-offset 2)))

(add-hook 'c-mode-common-hook
	  '(lambda ()
	     (changes-mode 1)
	     (code-mode 1)
	     (hs-minor-mode 1)
	     (hide-©)
	     (show-paren-mode 1)))
	  

;;; ---- pike
(add-auto-mode "\\.pike\\'" 'c-mode)
(eval-after-load "compile"
		 '(progn
		    (setq compilation-error-regexp-alist
			  (cons '("^\\([^ \t\n]*\\):\\([0-9]+\\):" 1 2)
				compilation-error-regexp-alist))
		    (mapcar '(lambda (key)
			       (define-key compilation-minor-mode-map
				 key nil))
			    '("\ep" "\en" "\r" "\C-c\C-c"))
		    (define-key compilation-minor-mode-map
		      "\e\r" 'compile-goto-error)))
		   
			 

;;; ---- lisp
;(add-hook lisp-mode-hook
;	  (lambda (local-set-key "\M-q" 'lisp-fill-paragraph)))

(setq scheme-program-name "scsh")

(apush after-load-alist
       "scheme" 
       '((add-hook 'scheme-mode-hook
		   (lambda () (define-key scheme-mode-map
				"\M-q" 'lisp-fill-paragraph)))))

(apush interpreter-mode-alist "scsh" 'scheme-mode)

;;; ---- changes-mode
(autoload 'changes-mode "changes-mode" "Highlights changes made in a buffer" t)

;;; ---- code-mode
(autoload 'code-mode "code-mode" "Easy insertion of brackets" t)

;;; ---- cvs
;; Åttabitstecen är inga binärer.
(setq cvs-diff-flags '("-u" "-a"))

;;; ---- PARI/GP
(autoload 'gp "pari" "PARI/GP Calculator" 'interactive)


;;; ---- TeX
(try-load "tex-site")
(setq TeX-auto-save t)
(setq TeX-parse-self t)
(setq-default TeX-master nil)

(add-auto-mode "\\.cls\\'" 'latex-mode)


;;; ---- HTML 
(autoload 'html-helper-mode "html-helper-mode" 
  "Mode for editing HTML hypertext documents" 'interactive)

(add-auto-mode "\\.html\\'" 'html-helper-mode)

;; Fyll i nya HTML-dokument med ett skelett.
(setq html-helper-build-new-buffer t)

;; Färglägg HTML-filer
(if window-system
    (add-hook 'html-helper-mode-hook 'turn-on-font-lock))



;;; ---- makefile-mode
(add-auto-mode "^[Mm]akefile\\(\\..*\\)?'" 'makefile-mode)


;;; ---- font-lock
;; Lazy-lock gör så att font-lock kan färglägga i bakgrunden.
(autoload 'turn-on-lazy-lock "lazy-lock"
  "Unconditionally turn on Lazy Lock mode.")

(add-hook 'font-lock-mode-hook 'turn-on-lazy-lock)


;;; ---- Fönster, möss och sånt
(if window-system
    (progn
      (try-require 'avoid
	(mouse-avoidance-mode 'exile))
      ))


;;; ---- Dired
;; Denna flagga gör det väldigt enkelt att kopiera filer mellan två
;; dired-buffertar.
(setq dired-dwim-target t)


;;; ---- Autoadapt
;; autoadapt ger en bättre auto-fill
(try-require 'autoadapt
  ;; Specialized adaptive auto-fill tables
  (add-hook 'text-mode-hook 'autoadapt-text-table)
  (add-hook 'c-mode-common-hook 'autoadapt-c-comment-table)
  
  ;; Generic programming mode comment adaptive auto-fill tables
  (add-hook 'c++-mode-hook 'autoadapt-set-comment-table)
  (add-hook 'makefile-mode-hook 'autoadapt-set-comment-table)
  (add-hook 'lisp-mode-hook 'autoadapt-set-comment-table)
  (add-hook 'sh-mode-hook 'autoadapt-set-comment-table))


;;; ---- dabbrev
;; Funkar bara från emacs-19.29
(setq dabbrev-case-fold-search nil)
(add-hook 'text-mode-hook '(lambda ()
			     (make-local-variable 'dabbrev-case-fold-search)
			     (setq dabbrev-case-fold-search 'case-fold-search)))


;; ---- Diverse trevliga paket
;; Gör så att minibufferten ändrar storlek om man skriver flera rader.
(try-require 'rsz-mini)
;; En mycket trevligare sidbläddring. Ändrar funktionen på C-v/M-v.
(try-require 'scroll-in-place)
;; Bokmärken är bra att ha
(try-require 'bookmark)

;;; ---- från ceder
(defun recenter-bottom ()
  (interactive)
  (recenter -2))

(defun recenter-top ()
  (interactive)
  (recenter 1))

(global-set-key "\C-ca" 'recenter-top)
(global-set-key "\C-ce" 'recenter-bottom)

;;; ---- från petli
(defun goto-last-edit-point ()
  "Go to the last point where editing occured."
  (interactive)
  (let ((undos buffer-undo-list))
    (if (listp undos)
	(while (and undos
		    (let ((pos (or (cdr-safe (car undos))
				   (car undos))))
		      (not (and (integerp pos)
				(goto-char (abs pos))))))
	  (setq undos (cdr undos))))))

(global-set-key "\C-c " 'goto-last-edit-point)

;;; ---- Tangentbindningar
;; Bind upp några lämpliga kommandon på C-c <tecken>
;(global-set-key "\C-ca" 'åäö-translate)	; Slå av/på åäö-mode
(global-set-key "\C-cf" 'auto-fill-mode) ; Slå av/på auto-fill
(global-set-key "\C-cF" 'font-lock-mode) ; Slå av/på font-lock

(global-set-key "\M--" 'dabbrev-expand)
;; Hur binder man Control-Meta-minus?
; (global-set-key "\C-M--" 'dabbrev-completion)

;; Byt plats på RET och LF. Det gör att RET kommer att indentera
;; raderna i programkod.
(defun swap-return-linefeed ()
  (interactive)
  (let ((old-cr-binding (global-key-binding "\C-m")))
    (global-set-key "\C-m"
		    (global-key-binding "\C-j"))
    (global-set-key "\C-j" old-cr-binding) ))

(swap-return-linefeed)

;;; Misc
(defun clear-text-properties (start end)
  "Remove all text properties from region."
  (interactive "r")
  (set-text-properties start end nil))

;; C-h a är normalt command-apropos, som gör att man kan söka efter
;; kommandon. Om man använder apropos istället kan man söka efter
;; mycket mer.
(global-set-key "\C-hA" 'apropos)	; Bättre än command-apropos

(global-set-key "\C-cg" 'goto-line)

(global-set-key "\C-x\C-q" 'toggle-read-only)

;;; ssh (från hubbe)
(defun ssh (host)
  "Open a network login connection to host named HOST (a string).
Communication with HOST is recorded in a buffer `*ssh-HOST*'.
Normally input is edited in Emacs and sent a line at a time."
  (interactive "sOpen ssh connection to host: ")
  (require 'shell)
  (require 'telnet)
  (let ((name (concat "ssh-" host )))
    (pop-to-buffer (make-comint name "ssh" nil host))
    (set-process-filter (get-process name) 'telnet-initial-filter)
    (telnet-mode)
    (setq telnet-count -16)))

;;	Anv{nd sedan 'M-x ssh' f|r alla uppkopplingar d{r
;;	radhanteringen kan g|ras lokalt p} din burk.


;;; från bellman
(defun transpose-windows (arg)
  "Transpose the buffers shown in two windows."
  (interactive "p")

  (let ((window-selector (if (>= arg 0)
			     (function next-window)
			   (setq arg (- arg))
			   (function previous-window))))
    (while (>= (setq arg (1- arg)) 0)
      (let ((buffer-this-window (window-buffer))
	    (buffer-next-window (window-buffer (funcall window-selector))))
	(set-window-buffer (selected-window) buffer-next-window)
	(set-window-buffer (funcall window-selector) buffer-this-window)
	(select-window (funcall window-selector))))))

(global-set-key "\C-x4t"    'transpose-windows)


(message ".emacs loaded")

(put 'upcase-region 'disabled nil)