;; Random utilities gathered from all around.
;; Be careful, I don't use all of them regularly, so they may die
;; under new versions of emacs, etc.

(defun my-gnus-move ()
  (interactive)
  (let ((x 0))
    (while (< x 10)
      (gnus-summary-move-article
       nil
       (concat
	"nnml:personal-"
	(format-time-string
	 "%Y-%m"
	 (safe-date-to-time
	  (mail-header-date
	   (gnus-summary-article-header))))))
      (gnus-summary-next-article)
      (setq x (1+ x)))))

(defconst daveg-c-style
  '((c-tab-always-indent            . t)
    (c-comment-only-line-offset     . 4)
    (c-hanging-braces-alist         . ((defun-open after)
				       (defun-close after)
				       (class-open after)
				       (class-close after)
				       (inline-open after)
				       (inline-close after)
				       (block-open after)
;				       (block-close after)
;				       (block-close . c-snug-do-while)
				       (substatement-open after)
				       (statement-case-open after)
				       (extern-lang-open after)
				       (extern-lang-close after)
				       (brace-list-open after)
				       (brace-list-close after)
				       (brace-list-intro after)
				       (brace-list-entry after)
				       ))
    (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-basic-offset                 . 4)
    )  "DaveG's programming mode")

(defvar zsend-last-long-zgram "")
(defvar zsend-logging t)
(defvar zsend-log-file (concat "~/Zephyr/zsendlog." (getenv "USER")))
(defvar zsend-logged-something nil)

(setq vc-make-backup-files 'true)

(defun date ()
  (interactive)
  (call-process "date" nil t))

(defun athena-path ()
  (interactive)
  (let ((ch (read-char))
	(ch2 (read-char)))
    (insert (format "/afs/athena.mit.edu/user/%c/%c/%c%c" ch ch2 ch ch2))))

(defun smiley ()
  (interactive)
  (insert ":-)"))

(defun daveg-work-email ()
  (interactive)
  (insert "dgolombek@blackducksoftware.com"))

(defun zwgc-nuke-instance (instance)
  (interactive "sInstance to nuke: ")
  (zwgc-nuke-msgs (concat "\\` *" (regexp-quote instance))))

(defun zwgc-nuke-msgs (regexp)
  (interactive "sRegexp to nuke: ")
  (zwgc-notice-iter 'zwgc-nuke-iter regexp))

(defun zwgc-nuke-iter (regexp)
  (if (re-search-forward regexp nil t)
      (zwgc-punt)))

(defun zwgc-handle-ping (data)
  (message "%s" (buffer-substring (match-beginning 0) (match-end 0)))
  (zwgc-punt t))

(defun zwgc-handle-noc (data)
  (message "%s" (buffer-substring (match-beginning 0) (match-end 0)))
  (zwgc-punt t))

(defun znol ()
  "Reset zwgc hooks for znol-only operation.  Note that this destroys
the value of zwgc-running-hook."
  (interactive)
  (let (zwgc-mode-hook)
    (setq
     zwgc-mode-hook
     (function
      (lambda ()
	(setq zwgc-notice-regexp-alist nil
	      zwgc-environment '("EMACS=t" "WGFILE=/tmp/wg.ddg.emacs"
				 "TERM=emacs" "DISPLAY=emacs-znol")
	      )))
     
     zwgc-running-hook
     (function
      (lambda ()
	(zwgc-znol)
	(setq zwgc-notice-regexp-alist
	      (cons '("." . zwgc-punt) zwgc-notice-regexp-alist)
	      )
	)))
    (zwgc)
    ))

(defun zsend-insert-last-long-zgram ()
  (interactive)
  (insert zsend-last-long-zgram))

(defun zsend-save-last-long-zgram ()
  (setq zsend-last-long-zgram (buffer-substring (point-min) (point-max))))

(defun zsend-log-zgram ()
  (if zsend-logging
      (progn
        (let ((savebuf (generate-new-buffer " *zsend-log*"))
              (msg (buffer-substring (point-min) (point-max)))
              (dest (concat (zsend-tuplestr zsend-dest)
                            (if (or (eq (car zsend-dest) 'user)
                                    (not (boundp 'zsend-append-realm)))
                                "" zsend-append-realm))))
          (save-excursion
            (set-buffer savebuf)
            (insert msg)
            (goto-char (point-max))
            (if (not (eq (preceding-char) ?\n))
                (insert "\n"))
            (goto-char (point-min))
            (insert (format "[zsend (%d) %s-><<%s>> %s]\n"
                            (count-lines (point) (point-max))
                            (getenv "USER")
                            dest
                            (current-time-string)))
            (goto-char (point-max))
            (insert "\n")
            (write-region (point-min) (point-max) zsend-log-file t 'nomessage)
            (if (not zsend-logged-something)
                (progn
                  (set-file-modes zsend-log-file 384)    ; 0600 = 384
                  (setq zsend-logged-something t)))
            (kill-buffer savebuf))))))

;; This depends on hacks from my .zwgc.desc, otherwise does random stuff...
(defun reply-get-dest ()
  (if (<= zwgc-notices 0)
      (error "No message to reply to"))
  (zwgc-push-to-buffer)
  ; make sure I get the end of the first line
  (goto-char (point-min))
  (end-of-line)
  (setq reply-dest (buffer-substring (point-min) (point)))
  (if (string-match (substring reply-dest -1) "*")
      (setq reply-dest (substring reply-dest 0 -1)))
  (zwgc-pop-from-buffer)
  reply-dest)

(defun my-zreply (destination &optional message)
  "A neat little hack"
  (interactive
   (let* ((dest (cons 'tuple (reply-get-dest)))
	  (msg (zsend-get-msg dest)))
     (list dest msg)))
  
   (if (not (fboundp 'zsend-get-msg))
       (error "Load zsend before trying to zreply"))

  (if (not message) (setq message (zsend-get-msg destination)))
  
  (let* ((cwc (current-window-configuration))
	 (tempbuf (generate-new-buffer (concat " *zsend "
					       (zsend-deststr destination)
					       "*"))))
    (switch-to-buffer-other-window tempbuf)
    (zsend-mode destination cwc)
    (if (not (equal message ""))
	(progn (insert message)
	       (zsend-send-zgram)))))

(defun scheme-or-lisp-mode ()
  "Enters scheme-interaction-mode if it exists, lisp-mode otherwise."
  (if (memq 'scheme features)
      (if (fboundp 'scheme-interaction-mode)
	  (scheme-interaction-mode)
	(scheme-mode))
    (lisp-mode)))

;;;; Write hooks and associated paraphernalia

(defun write-executable-file ()
  "Writes the current buffer to the file buffer-file-name, setting all
the execute bits for which the corresponding read bit is set."
  (if (not (file-exists-p buffer-file-name))
      (let (auto-write-alist mode)
	(message "Writing executable file, setting mode.")
	(write-file buffer-file-name)
	(setq mode (file-modes buffer-file-name))
	(set-file-modes buffer-file-name
			(logior mode (lsh (logand mode 292) -2)))
	)))

(defun alias-check ()
  "A write-file hook that sets mail-aliases to t when a file named
'.mailrc' is  written.  This causes the mail aliases file to be reread
before the next send."
  (if (equal ".mailrc" (file-name-nondirectory buffer-file-name)) 
      (setq mail-aliases t))
  nil)

;;;; Random, non-mode-related functions.

; replacement for insert-file which zcat's input from compressed files
; --- David N. Blank <dnb@meshugge.media.mit.edu> 11/5/90
(defun insert-file (filename)
  "Insert contents of file FILENAME into buffer after point.  Run
input through zcat if FILENAME ends in .Z.  Set mark after the inserted text."
  (interactive "fInsert file: ")
  (let ((endinsrt (insert-file-contents filename)))
    (if (and (not (null filename))
             (string-match "^\\(.*\\)\\.g?[zZ]$" filename))
        (let ((begofinsrt (point)))                 ; if we have a .Z
          (message "Uncompressing inserted text...")
          (call-process-region (point)
                               (+ (point) (car (cdr endinsrt))) "zcat" t t)
          (push-mark (- (point) 1))
          (goto-char begofinsrt)
          (message "done."))
      (push-mark (+ (point) (car (cdr endinsrt))))  ; else be normal
      )))

(defun unhilit ()
  "Gets rid of hilit19 hilighting for the current buffer."
  (interactive)
  (hilit-unhighlight-region (point-min) (point-max)))

(defun make-nil (&rest args)
  "Takes a list of SYMBOLS and setq's them to nil.  Interactively, it
prompts for a variable name."
  (interactive (list (read-variable "Nil variable: ")))
  (mapcar (function (lambda (arg) (eval (list 'setq arg 'nil)))) args))

(defun make-t (&rest args)
  "Takes a list of SYMBOLS and setq's them to t.  Interactively, it
prompts for a variable name."
  (interactive (list (read-variable "T variable: ")))
  (mapcar (function (lambda (arg) (eval (list 'setq arg 't)))) args))

; This should be renamed
(defun highlight-region (string)
  "Inserts STRING at the beginning of every line in the region.
Called interactively, STRING defaults to comment-start (or '>> ' if
none is defined) unless a prefix argument is given, in which case it
prompts for a string."
  (interactive (list (if current-prefix-arg
			 (read-string "String to insert: ")
		       (or comment-start
			   ">> "))))
  (save-excursion
    (if (bolp)
	(forward-line -1))
    (save-restriction 
      (narrow-to-region (point) (mark))
      (goto-char (point-min))
      (while (re-search-forward "^" nil t)
	(replace-match string))
      )))

; As should this...
(defun unhighlight-region (string)
  "Deletes STRING from the beginning of every line in the region.
Called interactively, STRING defaults to comment-start (or '>> ' if
none is defined) unless a prefix argument is given, in which case it
prompts for a string."
  (interactive (list (if current-prefix-arg
			 (read-string "String to delete: ")
		       (or comment-start
			   ">> "))))
  (save-excursion
    (if (bolp)
	(forward-line -1))
    (save-restriction 
      (narrow-to-region (point) (mark))
      (goto-char (point-min))
      (while (re-search-forward (concat "^" string) nil t)
	(replace-match ""))
      )))

(defun incr-region-regexp (beg end cnt &optional regexp)
  (interactive "r\np\nsRegexp to increment: ")
  (incr-region beg end cnt regexp))
		    
(defun incr-region (beg end cnt &optional regexp)
  "Increments all integers in a region.  Called interactively,
increments numbers by the prefix argument (which can be negative).
From a program, expects BEGIN END COUNT.  If an optional arg REGEXP is
provided, the integers to increment are taken from the first
parenthesized expression."
  (interactive "r\np")
  (if regexp nil
    (setq regexp "\\([0-9]+\\)"))
  (save-excursion
    (save-restriction
      (narrow-to-region beg end)
      (goto-char (point-min))
      (while (re-search-forward regexp nil t)
	(replace-match
	 (concat
	  (buffer-substring (match-beginning 0)
			    (match-beginning 1))
	  (int-to-string
	   (+ cnt
	      (string-to-int (buffer-substring (match-beginning 1)
					       (match-end 1)))))
	  (buffer-substring (match-end 1)
			    (match-end 0))
	  )))
      )))

(defun count-words-in-buffer ()
  "Counts the words in the current buffer, displaying the current count,
along with a timestamp and the buffer name, in the *Word Count* buffer."
  (interactive)
  (count-words-in-region (point-min) (point-max)))

(defun count-words-in-region (min max)
  "Counts the words in the current region, displaying the current count,
along with a timestamp and the buffer name, in the *Word Count* buffer.
If called from a program, expects MIN and MAX args as start and end
buffer addresses."
  (interactive "r")
  (let ((real-buffer (current-buffer))
	(buffer (get-buffer-create "*Word Count*")))
    (set-buffer real-buffer)	
    (call-process-region min max "/usr/bin/wc" nil buffer nil)
    (set-buffer real-buffer)	
    (princ (buffer-name) buffer)
    (princ " (region) as of " buffer)
    (princ (current-time-string) buffer)
    (terpri buffer)
    (pop-to-buffer buffer)
    (goto-char (point-min))
    (pop-to-buffer real-buffer)))


(defun center-rectangle (beg end)
  (interactive "r")
  (let ((maxlen 0) len)
    (save-excursion
      (save-restriction
	(narrow-to-region beg end)
	(goto-char (point-min))
	(while (not (eobp))
	  (setq beg (point))
	  (save-excursion
	    (end-of-line)
	    (setq maxlen (max (- (point) beg) maxlen)))
	  (forward-line 1))
	(goto-char (point-min))
	(setq len (/ (- fill-column maxlen) 2))
	(while (not (eobp))
	  (insert-char ?  len)
	  (forward-line 1))
	))))

(defun c-comment-line () 
  (interactive) 
  (save-excursion
    (beginning-of-line)
    (insert "/*")
    (end-of-line)
    (insert "*/")))

(defun c-comment-region () 
  (interactive) 
  (save-excursion
    (if (< (mark) (point)) (exchange-point-and-mark))
    (let ((end (make-marker))
          (beginning (make-marker)))
      (set-marker end (mark))
      (set-marker beginning (point))
      (fill-region end beginning nil)
      (goto-char beginning)
      (newline 2)
      (previous-line 1)
      (beginning-of-line)
      (insert "/*")
      (while (< (point) end) 
        (next-line 1)
        (beginning-of-line) 
        (insert " * "))
      (next-line 1) 
      (insert " */"))
    (newline 2)))

(defun c-uncomment-region ()
  (interactive) 
  (save-excursion
    (let ((beginning (make-marker))
          (end (make-marker)))
      (search-backward "
/*") 
      (beginning-of-line)
      (delete-char 3)
      (next-line 1) 
      (beginning-of-line) 
      (set-marker beginning (point))
      (search-forward "
 */")
      (beginning-of-line)
      (delete-char 3)
      (set-marker end (point))
      (goto-char beginning)
      (while (< (point) end)
        (beginning-of-line)
        (delete-char 3)
        (next-line 1)))))


(defun searchlib (file &optional explicit-name) 
  "Find where the Emacs Lisp library FILE is in the current
'`load-path'.  Tries appending \".el\" and \".elc\" unless the file
already ends in one of these suffixes. If a prefix arg is given or
the filename ends in \".elc\" then the filename is searched for
without changes."
  (interactive "sSearch for library: \nP")
  (let* ((path load-path)
         (file        (if (or explicit-name (string-match ".elc?\\'" file))
                          file
                        (concat file ".el")))
         (try-elc-too (and (string-match ".el\\'" file)
                           (not explicit-name))))
    (let ((test-file)
          (found))
      (while (and path 
                  (not found))
        (and (car path) 
             (or (file-exists-p
                  (setq test-file (concat (car path)
                                          (if (string-match "/\\'" (car path)) "
" "/")
                                          file)))
                 (if try-elc-too
                     (file-exists-p
                      (setq test-file (concat (car path)
                                              (if (string-match "/\\'" (car path
)) "" "/")
                                              file
                                              "c")))))
             (setq found test-file))
        (setq path (cdr path)))
      found)))

(defun wherelib (file &optional explicit-name)
  "Find where the Emacs Lisp library FILE is in the current
'`load-path'.  Tries appending \".el\" and \".elc\" unless the file
already ends in one of these suffixes. If a prefix arg is given or
the filename ends in \".elc\" then the filename is searched for
without changes."
  (interactive "sSearch for library: \nP")
  (let ((path (searchlib file explicit-name)))
    (if path 
        (message "Library %s is in %s." file path)
      (message "Library %s is not found." file))
    path))
(defun findlib (file &optional explicit-name)
  "Find where the Emacs Lisp library FILE is in the current
'`load-path'.  Tries appending \".el\" and \".elc\" unless the file
already ends in one of these suffixes. If a prefix arg is given or
the filename ends in \".elc\" then the filename is searched for
without changes. Then find-file the library."
  (interactive "sSearch for Library: \nP")
  (let ((path (wherelib file explicit-name)))
    (if path 
        (find-file path))))

(fset 'enlarge-window-twelve 	"\C-u12\C-x^")
(fset 'make 			'compile)

(defun choose-or-funcall (bufname func)
  (if (get-buffer bufname)
      (switch-to-buffer bufname)
    (funcall func)))


(defun rot13-region (start end)
  "Applies rot13 formatting to region, with UNIX 'tr' command."
  (interactive "r")
  (call-process-region start end "tr" t t nil
                       "a-zA-Z" "n-za-mN-ZA-M"))


(defun flip-debug-on-error ()
  (interactive)
  (setq debug-on-error (not debug-on-error))
  (if debug-on-error
      (message "Debugger enabled.")
      (message "Debugger disabled.")))


(defun force-byte-compile-directory (directory &optional arg)
  "Recompile every .el file in DIRECTORY."
  (interactive "DByte compile whole directory: \nP")
  (save-some-buffers)
  (setq directory (expand-file-name directory))
  (let ((files (directory-files directory nil "\\.el\\'"))
	(count 0)
	source dest)
    (while files
      (if (and (not (auto-save-file-name-p (car files)))
	       (setq source (expand-file-name (car files) directory))
	       (setq dest (concat (file-name-sans-versions source) "c")))
	  (progn (byte-compile-file source)
		 (setq count (1+ count))))
      (setq files (cdr files)))
    (message "Done (Total of %d file%s compiled)"
	     count (if (= count 1) "" "s"))))


(defun clear-kill-ring ()
  "Clear the kill ring and garbage collect."
  (interactive)
  (setq kill-ring '()) ;; check mouse-selection functions
                       ;; if they're ok, set the kill ring to include
                       ;; something like `kill ring cleared on <date>'
                       ;; after clearing.
  (garbage-collect))


(defun turn-off-auto-fill ()
  "Turn off auto-fill-mode.  Kinda kludgey."
  (interactive)
  (turn-on-auto-fill)   ; shouldn't need to do this, but I do.  Investigate.
  (auto-fill-mode -1))


(defun dq ()
  "Show current Disk Quotas"
  (interactive)
  (pop-to-buffer (get-buffer-create "*disk quota*"))
  (start-process "dq" "*disk quota*" 
		 "fs" "lq" 
		 "/afs/athena.mit.edu/user/d/a/daveg"))

;; macro to kill buffer and window
(fset 'my-kill-buffer-and-window "\C-xk")

(defun save-and-byte-compile-buffer (&optional file)
  "Custom function to save a bufer and then byte-compile it."
  (interactive "p")
  (save-buffer file)
  (byte-compile-file (buffer-file-name)))

(defun query-quit-emacs ()
  "Solves problems for poor typists and ^X^C."
  (interactive)
  (if (yes-or-no-p "Really quit? ")
      (save-buffers-kill-emacs)))

(defun query-suspend-emacs ()
  "Solves problems for poor typists and ^X^Z."
  (interactive)
  (if (yes-or-no-p "Really suspend? ")
      (suspend-emacs)))

(defun expn (arg)
  "Prompts user for name to expand at mail hub.  If provided with
numerical arg, prompts for alternate mailhub to contact (defaults is
mit.edu). Displays results an another buffer when done."
  (interactive "P")
  (let ((who (read-from-minibuffer "name to expand: "))
        (p
         (open-network-stream
          "expn" "*expn-output*"
          (if arg (read-from-minibuffer "mail hub to contact: ") "pacific-access-annex.mit.edu")
          "smtp")))
    (set-buffer (process-buffer p))
    (erase-buffer)
    (set-process-filter
     p
     '(lambda (proc s)
        (save-excursion
          (set-buffer (process-buffer proc))
          (while (< 0 (length s))
            (let ((l (string-match "\r" s)))
              (insert (substring s 0 l))
              (setq s (cond (l (substring s (1+ l)))
                            (t ""))))))))
    (set-process-sentinel
     p
     '(lambda (proc s)
        (display-buffer (process-buffer proc))))
    (process-send-string p (concat "expn " who "\r\n"))
    (process-send-string p "quit\r\n")))


(defun move-line-to-top ()
  (interactive)
  (recenter 0))


(defun flip-truncate ()
  (interactive)
  (setq truncate-lines (not truncate-lines))
  (shrink-window 1)
  (enlarge-window 1))


(defun mv (fname)
  "MV for Emacs.  Written by kkkken."
  (interactive "FNew filename: ")
  (let ((oldfname (buffer-file-name (current-buffer))))
    (write-file fname)
    (if (and oldfname 
	     (file-exists-p oldfname)
	     (not (string-equal (expand-file-name fname)
				(expand-file-name oldfname))))
	(delete-file oldfname))
    (if (not (file-exists-p fname))
	(write-file fname))))


(defun ln-s ()
  "Create symbolic links in Emacs.  A placebo for make-symbolic-link."
  (interactive)
  (call-interactively 'make-symbolic-link))


(defun mkdir (dirname)
  "MKDIR for Emacs.  Written by blade, because I'm a bonehead."
  (interactive "FEnter directory name: ")
  (let ((dname (expand-file-name dirname)))
    (make-directory dirname)
    (message "`make-directory %s' %s." dname (if (file-directory-p dname)
						 "successful"
					       "failed"))))


(defun focus-next-or-previous-frame (parg)
  "   Switch the focus to the next logical frame (and raise that frame to
   the front).  Keyboard input will go to the newly selected frame.
   Prefix arg means go to previous frame, not next frame.
   The mouse cursor will not follow you, which is kind of a weird
   feeling, but you'll get used to it."
  (interactive "P")
  (let* ((nowframe (selected-frame))
	 (nextframe (if parg (previous-frame) (next-frame)))
	 (visip (frame-visible-p nextframe)))
    (and visip
         (progn
           (select-frame nextframe)
           (if (eq visip 'icon) (iconify-or-deiconify-frame))
           (set-mouse-position nextframe (- (frame-width nextframe) 1) 0)
           (unfocus-frame)))))

(defun toggle-menu-bar/tools (arg)
  "Toggle whether or not the selected frame has menu bars.
With arg, turn menu bars on if and only if arg is positive.
Author: Tasuki Hirata (sukes@eng.umd.edu)"
    (interactive "P")
  (if (null arg)
      (setq arg
	    (if (not (zerop
		      (cdr (assq 'menu-bar-lines
				 (frame-parameters (selected-frame))))))
		-1 1)))
  (modify-frame-parameters (selected-frame)
			   (list (if (> arg 0)
				     '(menu-bar-lines . 1)
				   '(menu-bar-lines . 0))))
  ;; refresh doesn't take place, sometimes...
  (recenter))


(defun byte-compile-buffer ()
  "Byte-compile the current buffer."
  (interactive)
  (call-interactively 'save-some-buffers)
  (byte-compile-file buffer-file-name))


(defun glitter ()
  "Pseudo-screensaver program for emacs.  Opens window of scrolling stars until
   a key is pressed, after which the buffer is destroyed.  Fun fun fun!"
  (interactive)
    (switch-to-buffer "*glitter*")
    (while (not (input-pending-p))
      (progn 
	(setq count 0)
	(while (and (< count 1000)
		    (not (input-pending-p)))
	  (progn
	    (insert "\n")
	    (setq pos (mod (random) (window-width)))
	    (if (< pos 0)
		(setq pos (- pos)))
	    (insert-char 32 (- pos 1))
	    (insert "*")
	    (if (= (+ (count-lines (window-start) (point))
		      (if (= (current-column) 0) 1 0))
		   (- (window-height) 1))
		(scroll-up 1))
	    (setq count (1+ count))
	    (sit-for 0)))
	(if (not (input-pending-p)) (kill-region (point-min) (point-max)))))
    (kill-buffer "*glitter*"))

;; Taken from Jacob Morinski (jmorzins@mit.edu)
(defun ctl-h-is-del ()
  "Set the \"\\C-h\" key so that it acts as a Delete key."
  (interactive)
  (define-key global-map "\C-h" nil)
  (or key-translation-map
      (setq key-translation-map (make-sparse-keymap)))
  (define-key key-translation-map "\C-h" [127]))

(defun ctl-h-is-help ()
  "Set the \"\\C-h\" key so that it acts as a Help key."
  (interactive)
  (define-key global-map "\C-h" 'help-command)
  (or key-translation-map
      (setq key-translation-map (make-sparse-keymap)))
  (define-key key-translation-map "\C-h" nil)
  (or (member ?\C-h help-event-list)
      (setq help-event-list (cons ?\C-h help-event-list))))

(defun fix-bs ()
  "Swap C-h and DEL."
  (interactive)
  (keyboard-translate ?\C-h ?\C-?)
  (keyboard-translate ?\C-? ?\C-h))

(defun unfix-bs ()
  "Unswap C-h and DEL."
  (interactive)
  (keyboard-translate ?\C-h ?\C-h)
  (keyboard-translate ?\C-? ?\C-?))


; From devnull@gnu.org (nemo@mit.edu) 
(defun strip-control-m ()
  "Strip C-m characters from (point) to (point-max)."
  (interactive)
  (replace-string "\r" ""))

; From devnull@gnu.org (nemo@mit.edu) 
;; Allow ... to stand for ../.. (more precisely, for anything which is a
;; directory name or file name which consists of some number of dots N,
;; make this an alias for the N - 1 th ansestor of the current directory).
(fset 'builtin-expand-file-name (symbol-function 'expand-file-name))
(defun expand-file-name (name &optional default-dir)
  (while (string-match "/\\(\\.\\.\\.\\)\\.*/" name)
    (setq name (replace-match "../.." nil nil name 1)))
  (while (string-match "/\\(\\.\\.\\.\\)\\.*$" name)
    (setq name (replace-match "../.." nil nil name 1)))
  (builtin-expand-file-name name default-dir))

(defun my-cd-handler (text)
  "Handle my .. alias to cd .. in shell mode"
  (if (string= text "..
")
      (shell-process-cd "..")))
(add-hook 'comint-input-filter-functions 'my-cd-handler nil t)
(add-hook 'comint-output-filter-functions
	  'comint-watch-for-password-prompt nil t)

(defun my-add-to-bbdb (name username)
  "Create BBDB entry for a given user"
  (interactive)
  (bbdb-annotate-message-sender (format "%s <%s>" name username) nil
				t))

(defun switch-to-gnus ()
  "Change buffer to gnus"
  (interactive)
  (switch-to-buffer "*Group*"))

(defun switch-to-shell ()
  "Change buffer to gnus"
  (interactive)
  (switch-to-buffer "*shell*"))

(defun reload-file ()
  "reload the current buffer from it's file"
  (interactive)
  (find-alternate-file (buffer-file-name)))