;; compile mode
;; FIXME: i can't imagine this isn't in there already..
(defun compilation-goto-next-error  (&optional argp)
  (interactive "P")
  (set-buffer (get-buffer "*compilation*"))
  (compilation-next-error 1)
  (compile-goto-error argp))
  


;; misc elisp functions
(defun toggle-truncate ()
  (interactive)
  (set 'truncate-partial-width-windows
       (not truncate-partial-width-windows))
  (redraw-frame))


(defvar menu-toggle-next 'menu-off)

(defun menu-on ()
  (set 'menu-toggle-next 'menu-off)
  (menu-bar-mode 1)
  (set-frame-height nil 56))

(defun menu-off ()
  (set 'menu-toggle-next 'menu-on)
  (menu-bar-mode 0)
  (set-frame-height nil 58))

(defun menu-toggle ()
  (interactive)
  (funcall menu-toggle-next))

;; BUFFERS
(defun get-or-create-buffer (name)
  (let ((buffer (get-buffer name)))
    (if buffer buffer
      (find-file name))))

(defun current-bufferp (buffer)
  ;;(message (pp-to-string buffer))
  (eq buffer (current-buffer)))

;; FIXME: doesn't work
(defun save-this-buffer (arg)
  (save-some-buffers arg 'current-bufferp)) 


;; files
(defun tempfile (suffix)
  (car
   (split-string
    (shell-command-to-string 
     (concat "tempfile --prefix=emcs- --suffix=-" suffix))
    "\n")))

;; list stuff
(require 'pp)
(defun pp-last-sexp () (interactive)
  (let ((end (point)))
    (backward-sexp)
    (let ((beg (point)))
      (let ((expr (buffer-substring-no-properties beg end)))
	(kill-region beg end)
	(insert
	 (pp-to-string (read expr)))))))



;;; log entry
(defun log-entry (name) 
  (interactive "sEntry: ")
  (insert "Entry: " name "\n" 
	  "Date: ")
  (insert-command "date"))

(defun kill-from-point () (interactive)
  (kill-region (point) (buffer-size)))



;; TERMINAL STUFF

(defun switch-or-create (progname)
  (let ((bufname (concat "*" progname "*")))
    (let ((buffer (get-buffer bufname)))
      (if (and buffer (get-buffer-process buffer))
	  (switch-to-buffer buffer)
	  (progn
	    (ansi-term progname progname) ;; creates a new window
	    )))))

(defun mutt () (interactive) (switch-or-create "zzz.mutt"))
(defun irssi  () (interactive) (switch-or-create "zzz.irssi"))


(defun boot () (interactive) 
  (load-file "~/.emacs"))

(defun scratch () (interactive) 
  (let ((scratch-buffer 
	 (or (get-buffer "*scratch*")
	     (create-file-buffer "*scratch*"))))
    (switch-to-buffer scratch-buffer)
    (lisp-interaction-mode)))

(defun scheme-scratch () (interactive) 
  (let ((scheme-scratch-buffer 
	 (or (get-buffer "*scheme-scratch*")
	     (create-file-buffer "*scheme-scratch*"))))
    (switch-to-buffer scheme-scratch-buffer)
    (scheme-mode)))

(defun toggle-selective-display ()
  (interactive)
  (set-selective-display (if selective-display nil 1)))


(defun guile () (interactive) 
  (let ((scratch-buffer 
	 (or (get-buffer "*guile-scratch*")
	     (create-file-buffer "*guile-scratch*"))))
    (switch-to-buffer scratch-buffer)
    (scheme-interaction-mode)))


(defun kill-other-buffer () (interactive)
  (other-window 1)
  (kill-current-buffer)
  (other-window 1))

;;; misc commands
(defun kill-current-buffer () (interactive) 
  (kill-buffer (current-buffer)))

(defun insert-command (command) (interactive "sshell command: ")
  (insert-string (shell-command-to-string command)))



;; project startup
(defun compile-pdp () (interactive) 
  (compile "make -C /home/tom/pdp-12 everything"))

(defun compile-pf  () (interactive) 
  (compile "make -C /home/tom/build/d stderr local"))

(defun project-pf () (interactive)
  (compile-pf)
  (visit-tags-table "/home/tom/libpf/TAGS"))


;; below is steve yegge's stuff
;; from http://www.cabochon.com/~stevey/blog-rants/my-dot-emacs-file.html

;; someday might want to rotate windows if more than 2 of them
(defun swap-windows ()
  "If you have 2 windows, it swaps them."
  (interactive)
  (cond
   ((not (= (count-windows) 2))
    (message "You need exactly 2 windows to do this."))
   (t
    (let* ((w1 (first (window-list)))
	   (w2 (second (window-list)))
	   (b1 (window-buffer w1))
	   (b2 (window-buffer w2))
	   (s1 (window-start w1))
	   (s2 (window-start w2)))
      (set-window-buffer w1 b2)
      (set-window-buffer w2 b1)
      (set-window-start w1 s2)
      (set-window-start w2 s1)))))

;;
;;  Never understood why Emacs doesn't have this function.
;;
(defun rename-file-and-buffer (new-name)
  "Renames both current buffer and file it's visiting to NEW-NAME."
  (interactive "sNew name: ")
  (let ((name (buffer-name))
	(filename (buffer-file-name)))
    (if (not filename)
	(message "Buffer '%s' is not visiting a file!" name)
      (if (get-buffer new-name)
	  (message "A buffer named '%s' already exists!" new-name)
	(progn
	  (rename-file name new-name 1)
	  (rename-buffer new-name)
	  (set-visited-file-name new-name)
	  (set-buffer-modified-p nil))))))

;;
;;  Never understood why Emacs doesn't have this function, either.
;;
(defun move-buffer-file (dir)
  "Moves both current buffer and file it's visiting to DIR."
  (interactive "DNew directory: ")
  (let* ((name (buffer-name))
	 (filename (buffer-file-name))
	 (dir
	  (if (string-match dir "\\(?:/\\|\\\\)$")
	      (substring dir 0 -1) dir))
	 (newname (concat dir "/" name)))

    (if (not filename)
	(message "Buffer '%s' is not visiting a file!" name)
      (progn
	(copy-file filename newname 1)
	(delete-file filename)
	(set-visited-file-name newname)
	(set-buffer-modified-p nil)
	t))))





;; UNICODE
;; http://lists.gnu.org/archive/html/help-gnu-emacs/2005-04/msg00794.html
;; (defun set-unicode ()
;;   (set-language-environment 'UTF-8)
;;   (set-default-coding-systems             'utf-8)
;;   (setq file-name-coding-system           'utf-8)
;;   (setq default-buffer-file-coding-system 'utf-8)
;;   (setq coding-system-for-write           'utf-8)
;;   (set-keyboard-coding-system             'utf-8)
;;   (set-terminal-coding-system             'utf-8)
;;   (set-clipboard-coding-system            'utf-8)
;;   (set-selection-coding-system            'utf-8))