; -*- mode: emacs-lisp; coding: latin-1; -*-
; Time-stamp: "2006-10-07 19:59:57 AKDT"

;  To haidafy:  \([kgx]\)_  =>  <u>\1</u>
;
;
;    New happy things:      ESC /      dabbrev-expand

;(setq dired-free-space-args "-Pkh")
;(setq dired-free-space-program nil)
(redisplay)

; TODO: alias detabify to untabify.

(defmacro define (what &rest rest)
  "Scheme-like alias to defvar/defun"
  (if (consp what)
    `(defun  ,(car what) ,(cdr what) ,@rest)
    `(defvar ,what ,@rest)))
 ; Syntaxes:
 ;  (define varname opt-defaultvalue "opt-docscring"
 ;  (define (fname arg1 arg2...) "opt-docstring" (interactive) (stmt1) ...)

(defmacro void (&rest body)
  "Evaluate body (0+ forms), returning nil."
  `(progn ,@body nil))

(define (Batchy-smb-woman-recache)
  (require 'woman)
  (woman-file-name "true" t)
  (message "Woman cache rebuilt.")
)

(define (mutter &rest opts)
  "Show text on the command line, wait, then clear it."
  (progn (apply 'message opts) (sit-for .02) (message nil) t))

; TODO: make a thing on the modeline "^" when buffer is active
; TODO: make dired sort case-insensitively?
; TODO: number formatting (at least commulation) of the sizes in the buffer list

; TODO: make a (truth X) macro that's just (if X t) ?

(setenv "UNDER_EMACS" "1")

(menu-bar-mode 0)
(when (functionp 'tool-bar-mode) (tool-bar-mode 0))

(setq am-root (string-equal
	       (expand-file-name "~"    )
	       (expand-file-name "~root")))

;(setq am-under-screen (string-equal "screen" (getenv "TERM")))
(setq am-under-screen (and (getenv "STY") t)) ; better, they say
(setq am-under-x      (string-equal "x" window-system))
(setq am-under-gnome  (and am-under-x (getenv "GNOME_DESKTOP_SESSION_ID") t))
(setq am-xemacs (featurep 'xemacs))
(setq am-gnu-emacs (not am-xemacs)) ; safe assumption, I think


(setq frame-title-format
      (if
       am-root  '(multiple-frames "%b" ("" "~#~#~#~ R00T Emacs ~#~#~#~"))
                '(multiple-frames "%b" ("" "Emacs"                     ))
      ))

      ;'(multiple-frames "%b" ("" invocation-name "@" system-name))



(setq my-icon (under-home
	       (if am-root
		   "s/icons/emacs_Gubinelli3.xbm"
 		   ;"s/icons/emacs_Gubinelli_color5050.png"
		   "s/icons/emacs_Gubinelli3_rev.xbm"
)))

(setq       
 initial-frame-alist
 ; Or: (modify-frame-parameters  (selected-frame) ...)
 '(
   (vertical-scroll-bars . right)
   (top . 0) (left . 0) (width . 88) (height . 41)
   (icon-type . 0)
))

(setcdr (assoc 'icon-type initial-frame-alist) my-icon)

;(setq calendar-latitude 35.12) (setq calendar-longitude -106.62) ;ABQ
;(setq calendar-latitude 58.4) (setq calendar-longitude -134.5) ;Juneau
(setq  calendar-latitude 55.3) (setq calendar-longitude -131.6) ;Ketchikan

(setq completion-ignore-case 't) ; ignore case differences in completion

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; set the machine-name variable and function
(define machine-name (system-name) "Machine name for this system.")

(define (machine-name)
  "Return the name of the machine you are running on, as a string.
Same as (system-name) up to the first '.'"
  (concat machine-name))
(let
  ((i 1) (s (system-name)) (sl (length (system-name))))
  (while (< i sl)
    (if
        (string-equal "." (substring s i (1+ i)))
        (setq i (length s))  ;; bail out
        (progn ;; keep looping
          (setq machine-name (substring s 0 (setq i (1+ i))))
          )
        )
    )
)

(when am-under-screen
  (send-string-to-terminal
   (concat "\033]0;"
     ;(user-login-name) "@"
     (machine-name)   "-Emacs"
     "\007F"
    )))

(defun cd-home () "change current directory to home" (cd (under-home "")))

(defun buffer-mode (buffer) (with-current-buffer buffer mode-name))

(defun sorting-buffers-by-mode (a b)
  (or
   (string<
    (downcase (with-current-buffer a mode-name))
    (downcase (with-current-buffer b mode-name))
    )
   (string<
    (downcase (buffer-name a))
    (downcase (buffer-name b))
    )
   (string<
    (buffer-name a)
    (buffer-name b)
    )
   ))

; TODO: make dired buffers sort by their full path!

(defun sorting-buffers-by-name (a b)
  (or
   (string<
    (downcase (buffer-name a))
    (downcase (buffer-name b))
    )
   (string<
    (buffer-name a)
    (buffer-name b)
    )
   ))

(defun sort-buffers ()
  "Show the buffer list, in alphabetical order.
An minor improvement on `buffer-menu'."
  (interactive)
  (dolist (buff (sort (buffer-list)
		      'sorting-buffers-by-name
		      ))
    (bury-buffer buff))
  (when (interactive-p) (list-buffers))
  )

(defun goto-random-line ()
  "Go to a random line in this buffer."
  ; good for electrobibliomancy.
  (interactive)
  (goto-line (1+ (random (buffer-line-count)))))

(defun buffer-line-count () 
  "Return the number of lines in this buffer."
  (count-lines (point-min) (point-max)))

(defun sort-buffers-by-mode ()
  "Put the buffer list in alphabetical order. An improvement on buffer-menu."
  (interactive)
  (dolist (buff (sort (buffer-list)
		      'sorting-buffers-by-mode
		      ))
    (bury-buffer buff))
  (when (interactive-p) (list-buffers))
  )

(cond
 (noninteractive (message "In batch mode."))
 (window-system
  (progn
    (message "In GUI mode.")
    (server-start)

    ; A workaround for face craziness:
    (require 'timer)
    (require 'faces)
    (run-with-idle-timer 0 nil (lambda ()

      (apply 'set-face-attribute  '(default () :background "#101020" :foreground "#ffffff" :inherit nil :stipple nil :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal  :width normal :height 193 :family "adobe-courier"))

      (set-face-attribute 'scroll-bar nil
	  :background "#889988" :foreground "#ff0000")
      (set-face-attribute 'mode-line  nil
	  :background "#898" :foreground "#000" :box
	  '(:line-width -1 :style released-button)
	  :height 0.9 :family "helv")
      (redisplay)
      (redraw-display)
      ))))
    
 (t (progn
    (message "In text mode.")
    ; anything that needs doing here?
    ))
)


;(setq regexp-history nil)
;(setq query-replace-history regexp-history)
(setq query-replace-from-history-variable
       'regexp-history)


; Because these are always the names I go looking for them as...

(defalias 'grow-window 'enlarge-window)
(defalias 'file-name-expand 'expand-file-name)

(defalias 'nilp 'null)
(defalias 'typeof 'type-of)
(defalias 'narrow	'narrow-to-region)
(defalias '!=		'/=)
(defalias '==		'=)  ; equality
(defalias '===		'eq) ; identity
(defalias 'foreach	'dolist)
(defalias 'for-each	'dolist)
(defalias 'history	'view-lossage)
(defalias 'process-list	'list-processes)
(defalias 'macro-expand	'macroexpand)
(defalias 'chdir         'cd)

(defalias 'string-to-symbol 'intern)
(defalias 'symbol-to-string 'symbol-name)

(defalias 'begin 'progn)
(defalias 'set! 'setq)
(defalias 'cell 'cons)
(defalias 'first 'car)
(defalias 'second 'cadr)
(defalias 'rest 'cdr)
(defalias 'endp 'null)

; These work for only a single object at a time
(defalias 'tostring	'prin1-to-string)
(defalias 'to-string	'prin1-to-string)
(defalias 'stringify	'prin1-to-string)


;;; Make modern "foo?" aliases for old-timey "foop"/"foo-p".
(dolist (name '(

 arrayp atom bool-vector-p bufferp byte-code-function-p case-table-p
 char-or-string-p char-table-p commandp consp display-table-p floatp
 frame-configuration-p frame-live-p framep functionp
 integer-or-marker-p integerp keymapp keywordp listp markerp nlistp
 null number-or-marker-p numberp overlayp processp sequencep stringp
 subrp symbolp syntax-table-p user-variable-p vectorp wholenump
 window-configuration-p window-live-p windowp zerop

 = /= < <= > >= char-equal string= string-equal string< string-lessp
 eq equal
 featurep
 memq member assq assoc

 != === endp ; my idiosyncracies that I want aliases for

)) (defalias (string-to-symbol
 (replace-regexp-in-string "\\(-?p\\)?$" "?" (symbol-to-string name))) name))


(defmacro f_x (&rest Body)
  "Make these expressions a function with 'x' holding its one parameter."
  (list 'function (cons 'lambda (cons (cons 'x nil) Body))))

(defmacro ++ (x)
  "Increment the value of symbol X, returning the new value."
  `(setq ,x (1+ ,x))
)

(setq *dumb-gensym-counter* 100)
(defun dumb-gensym ()
  (make-symbol (format "DG%d" (++ *dumb-gensym-counter*))))
(defun file-size (filename)
  "Return the size in bytes of file named FILENAME, as in integer.
Returns nil if no such file."
 (nth 7 (file-attributes filename)))


(defmacro xcase (expr &rest clauses)
  "Eval EXPR and choose from CLAUSES on that value.
Each clause looks like (THING BODY...).  EXPR is evaluated and compared
against THING using `equal'; the first matching THING's BODY is evaluated.
If no clause succeeds, case returns nil.
A THING value of `t' is allowed only in the final clause, and matches if
no other keys match."
  ; we don't actually inforce the finality-restriction on it
  (let*  (( temp (dumb-gensym)))
   `(let ((,temp ,expr))
      (cond
       ,@(mapcar
	 (function (lambda (x)
	  (if (eq t (car x))
	      x
	      `( 
		(equal ,temp ,(car x))   ; condition
		,(cadr x)                ; body
	       )
	  ; This is all because cl.el's case uses eq instead of equal!
	  ))) clauses )))))

;(begin (print (macroexpand
;'
;(xcase mode-name
;       ((concat "" "Lisp Interaction") (capitalize "foo"))
;       (t "Bar")
;)
;"Foo"



(defun truth (object) (if object t nil))
(defalias 'true? 'truth)

(defun find-files (files) "Open the given files" (interactive)
  (foreach (f files) (find-file f)))

(defun duplicate-sequence (seq n)
  "Return a sequence consisting of the given input sequence duplicated i times"
  ; All this to get basically just the Perl "x" operator.
  (let ((c 0) (out nil) (copier nil))
    (cond
     ((stringp seq) (setq copier 'concat  out  "" ))
     ((listp   seq) (setq copier 'append  out '() ))
     ((vectorp seq) (setq copier 'vconcat out  [] ))

     ((numberp seq) (setq copier 'concat  out  "" seq (number-to-string seq)))
       ;; implicit stringification

     (t (error "I don't know how to duplicate %s \"%s\"" (type-of seq) seq)))
       ;; it's meaningless to try to duplicate symbols or hashes

    (while (< c n) (setq c (1+ c) out (apply copier (list out seq))))
    out))


;(defmacro set-key-func (key expr)
;  "macro to save me typing"
;  (list 'local-set-key (list 'kbd key) 
;	(list 'lambda nil 
;	      (list 'interactive nil) expr)))
;(defmacro set-key (key str) (list 'local-set-key (list 'kbd key) str))


(setq Man-notify-method 'aggressive)

(setq rmail-display-summary t)

(setq grep-command "pwd;grep -nire about .")

(setq starting-process-sound "~/sound_effects/arcanewolf_misc/arrow3.wav")

(setq dired-listing-switches "--time-style=iso -algGh")

;(send-string-to-terminal (concat
;  "\033]0;"
;   ;(user-login-name)
;   ;"@"
;   (machine-name)   "   Emacs"    "\007F"
;))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; rewrite mode-line (A B C ... Y Z) as (A B C .. Y foo bar baz Z)
(let ((revx (reverse default-mode-line-format)))
  (setq default-mode-line-format
        (reverse (append
                  ;; Things to insert penultimately:
                  (reverse (list
                            (concat
                             "--"
                             ;(user-login-name)
                             ;"@"
                             ;"\244\244\244\244\244\244\244\244\244\244\244\244\244\244\244\244\244\244\244\244\244\244\244"
			         ; ^^ what's that for again?
                             ;machine-name
                             )
                            (car revx)
                            ))
                  (cdr revx)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(message (format-time-string "Start time: %Y-%02m-%02d %02H:%02M:%02S %Z"))
;(setq display-time-24hr-format 't)


(when am-root (message "Running as root!"))


(defun kill-ring-save-line () "Copy the current line to the kill ring"
  (interactive)
  (save-excursion
    (beginning-of-line)
    (kill-ring-save
     (progn (beginning-of-line) (point) )
     (progn (end-of-line) (point) )
     )
    )
  )

(defun copy-buffer-name () "Copy the current line's buffername to the kill ring"
  (interactive)
  (kill-new (buffer-name (Buffer-menu-buffer nil))))

(defun dired-copy-file-basename ()
  "Copy the file's basename to the kill ring"
  (interactive)
  (kill-new (dired-get-filename 'no-dir t)))

(defun dired-copy-filename-full ()
  "Copy the file's complete filename to the kill ring"
  (interactive)
  (kill-new (dired-get-filename)))



;(display-time)

(line-number-mode t)            ;;this slows down cursor response at 2400bd
(column-number-mode t)          ;;this slows down cursor response at 2400bd
;(setq blink-matching-paren nil)

;Maily things...
(setq user-full-name "Sean M. Burke")
(setq user-mail-address "sburke@cpan.org")
(setq mail-default-reply-to "sburke@cpan.org")
(setq mail-self-blind 't)


(autoload 'mode-compile "mode-compile"
 "Command to compile current buffer file based on the major mode" t)
(global-set-key "\C-cc" 'mode-compile)

(autoload 'mode-compile-kill "mode-compile"
 "Command to kill a compilation launched by `mode-compile'" t)
(global-set-key "\C-ck" 'mode-compile-kill)



; (setq case-fold-search nil) ;; turn ON case sensitivity in searches
(setq case-replace nil)  ;; turn OFF replication of case in replaces.

(setq inhibit-startup-message t)
(setq Info-fontify t)

;(defun tv ()  (interactive)  "Get TV listings"
;  (shell-command "tv|cat&" "*tv*")
;)

;----------------------------------------------------------------------------

(defmacro decf (place &optional x)
  "Decrement PLACE by X (1 by default).
PLACE may be a symbol, or any generalized variable allowed by `setf'.
The return value is the decremented value of PLACE."
  (if (symbolp place)
      (list 'setq place (if x (list '- place x) (list '1- place)))
    (list 'callf '- place (or x 1))))

(setq uptime-time-init (current-time))

(defun uptime () "Report emacs's uptime" (interactive)
  (let* ((tm (current-time))
	 (diff (list (- (car tm) (car uptime-time-init))
		     (- (cadr tm) (cadr uptime-time-init))))
	 (seconds (+ (* (float (car diff)) 65536) (float (cadr diff))))
	 (days  (floor (/ seconds 86400)))
         (hours (progn (decf seconds (* days  86400)) (floor (/ seconds 3600))))
         (mins  (progn (decf seconds (* hours 3600))  (floor (/ seconds 60)))))
    (message "Emacs has been running %dd %02dh %02dm" days hours mins)))

(setq start-time (current-time))

;----------------------------------------------------------------------------

(defun spawn-terminal ()
  "Spawn a new terminal window."
  (interactive)
  (cond
   (am-under-screen
    (shell-command "screen -X screen"))
   
   (am-under-gnome
    (shell-command-into-void "gnome-terminal"))
    ;or: (shell-command "gnome-terminal&"))
   
   (t (error "I don't know how to spawn a terminal"))))


(defun spawn-explore-pwd ()
  "Spawn a filesystem window on pwd."
  (interactive)
  ;(launch "gnome-open" "."))
  (launch "nautilus" "."))

(defun start-current-buffer ()
  "Call 'start' on the current buffer."
  (interactive)
  (unless (buffer-file-name) (error
    "You have to save this buffer someplace first"))
  (save-buffer)
  (launch "gnome-open" (buffer-file-name)))

(defun dired-start-this-file ()
  "Call 'start' on current/selected files"
  (interactive)
  (unwind-protect
      (progn
	(when starting-process-sound (play-sound-file starting-process-sound))
	(setenv "UNDER_EMACS")
	(mapc
	 (function (lambda (x)
		     (call-process "gnome-open" nil 0 nil x)))
                     ; TODO: change to use start-process?
	 (dired-get-marked-files t current-prefix-arg)))
    (setenv "UNDER_EMACS" "1")))



;----------------------------------------------------------------------------

(defun ascii-table ()
  "Print an ASCII table. Based on a defun by Alex Schroeder <asc@bsiag.com>"
  (interactive)  (switch-to-buffer "*ASCII*")  (erase-buffer)
  (insert (format "ASCII characters up to number %d.\n" 255))
    (let ((i 0))
      (while (<= i 255)
        (insert (format "%4d | o%03o | 0x%02x | %c\n" i i i i))
        (setq i (+ i 1))
      ))
  (beginning-of-buffer))



; For fancier, see the "apropos" command

(defun functions-table ()
  "Display a list of all functions."
  (interactive)  ; (not just commands!)
  (symbols-report "*Functions*" 'fboundp))

(defun variables-table ()
  "Display a list of all variables."
  (interactive)
  (symbols-report "*Variables*" 'boundp))

(defalias 'function-table 'functions-table)
(defalias 'variable-table 'variables-table)

(byte-compile ; to make the 'mapatoms' call speedy
(defun symbols-report (bufname pred)
  (with-output-to-temp-buffer bufname
  (let (syms)
    (mapatoms  ; = for each symbol in obarray (in no special order)
     (f_x
      (when (apply pred (list x))
	(setq syms (cons (symbol-to-string x) syms)))))
    (setq syms (sort syms 'string<))
    (dolist (sym syms)
      (princ (concat sym "\n")))))
)
)
;======================================================================
; A tweak to make file-name-history more comprehensive
(defadvice find-file-noselect (before snare-filespec (fs &rest guh))
  (unless (and (consp file-name-history)
	       (string-equal fs (car file-name-history)))
		 ; to avoid duplication
    (push fs file-name-history)))

(ad-activate 'find-file-noselect)

;======================================================================

(defun mru ()
  "Display the most-recently-used filespecs."
  (interactive)
  (if file-name-history 
    (with-output-to-temp-buffer "*File Name History*"
      (with-current-buffer standard-output
        ; ^^ makes our property stuff work right
	(dolist (item file-name-history)
	  (insert-xref-filespec item)
	  (insert "\n"))))
    (message "Nothing in file-name-history yet.")))


(defun insert-xref-filespec (fspec)
  (if am-xemacs
   (insert fspec)
   (progn
    (let ((p0) (p1))
     (setq p0 (point))
     (insert fspec)
     (setq p1 (point))
     (add-text-properties p0 p1 (append

       (list 'mouse-face 'highlight  
             'help-xref (cons #'find-file (list fspec)))

       (if (file-exists-p fspec)
	  '(help-echo "mouse-2, RET: open this file" face underline)
	  '(help-echo "mouse-2, RET: create this new file" )
	  )))))))

;======================================================================

(defun histories ()
  "Dump history variables and their values."
  (interactive)
  (switch-to-buffer "*Histories*")
  (erase-buffer)
  (dolist (sym (history-variables))
    (insert (concat "\n===== "
	      (symbol-to-string sym) " ====="))
    (center-line)
    (insert "\n")
    (dolist (val (symbol-value sym))
      (insert (concat val "\n")))
    (insert "\n\n"))
  (beginning-of-buffer))


(defun stringify* (&rest objs)
  "like prin1-to-string except takes plural arguments.
Returns one string."
  (apply 'concat (mapcar 'prin1-to-string objs)))


;(byte-compile
;(defun stringify (obj)
;  "Return hte printable "
;  (let ((stringify-collecting nil)
;	(collect (lambda (x)
;		   (setq stringify-collecting
;		      (append stringify-collecting (list x)))
;		   nil)))
;    (princ obj collect)
;    (apply 'string stringify-collecting)))
;)


(byte-compile
(defun string-match-p (regexp string)
  "Return simply whether the regexp matches the string.
Cf: `string-match'."
  (not (null (string-match regexp string))))
)

(byte-compile ; to make the 'mapatoms' call zippy
(defun history-variables ()
  "Return a list of all history variables.
(Items in the list are symbols, not strings; and the list is sorted.)"
  (let (val vars)
    (mapatoms (function (lambda (x)
      (and
       (boundp x) 
       (not (null (setq val (symbol-value x))))
       (listp val)
       (stringp (car val))
       (string-match-p "history" (symbol-to-string x))
       (setq vars (cons x vars))))))
    (sort vars 'string-lessp)))
)

;---------------------------------------------------------------------------
; Un-fillers:

(defun unfill-paragraph ()
  "Unfill the current paragraph."
  (interactive) (with-unfilling 'fill-paragraph))
(defalias 'unwrap-paragraph 'unfill-paragraph)

(defun unfill-region ()
  "Unfill the current region."
  (interactive) (with-unfilling 'fill-region))
(defalias 'unwrap-region 'unfill-region)

(defun unfill-individual-paragraphs ()
  "Unfill individual paragraphs in the current region."
  (interactive) (with-unfilling 'fill-individual-paragraphs))
(defalias 'unwrap-individual-paragraphs 'unfill-individual-paragraphs)

(defun with-unfilling (fn)
  (let ((fill-column 10000000)) (call-interactively fn)))

;---------------------------------------------------------------------------

(setq track-eol t)

(setq ange-ftp-default-user "anonymous")

(autoload 'time-stamp "time-stamp" "Update the time stamp in a buffer." t)
 (if (not (memq 'time-stamp write-file-hooks))
     (setq write-file-hooks
           (cons 'time-stamp write-file-hooks)))
;(setq time-stamp-format "%04y-%02m-%02d %02H:%02M:%02S %Z %u@%s")
;(setq time-stamp-format "%04y-%02m-%02d %02H:%02M:%02S %Z")
(setq time-stamp-format "%:y-%02m-%02d %02H:%02M:%02S %Z")



 	
;Example of interactive function with a parameter
;(defun multiply-by-seven (number) 
;  "Multiply NUMBER by seven."
;  (* 7 number))



; these functions convert the file to DOS/UNIX/Mac format
(defun dos-newlines () 
    "sets the buffer-file-coding-system to undecided-dos; changes the buffer
    by invisibly adding carriage returns"
    (interactive)
    (set-buffer-file-coding-system 'undecided-dos nil))
(defun unix-newlines () 
    "sets the buffer-file-coding-system to undecided-unix; changes the buffer
    by invisibly removing carriage returns"
    (interactive)
    (set-buffer-file-coding-system 'undecided-unix nil))
(defun mac-newlines () 
    "sets the buffer-file-coding-system to undecided-mac; may change the buffer
    by invisibly removing carriage returns"
    (interactive)
    (set-buffer-file-coding-system 'undecided-mac nil))

(defalias 'newlines-dos   'dos-newlines)
(defalias 'newlines-unix 'unix-newlines)
(defalias 'newlines-mac   'mac-newlines)


(defun latin1 () 
  "Set the buffer-file-coding-system to Latin-1."
  (interactive)
  (set-buffer-file-coding-system 'latin-1 nil))
(defun utf8 () 
  "Sets the buffer-file-coding-system to UTF8."
  (interactive)
  (set-buffer-file-coding-system 'utf-8 nil))


(defalias 'kill-window 'delete-window) ; because I always think it's called that!


(set-input-mode (car (current-input-mode))
                (nth 1 (current-input-mode))
                 0)

;(standard-display-european ()) ; <== bad: switches us out of utf8 mode
;  and may even disable it altogether for this session?

(autoload 'javascript-mode "javascript-mode" "JavaScript mode" t)
; (setq default-enable-multibyte-characters t) ????
; (default-value 'enable-multibyte-characters) ???


(add-to-list 'auto-mode-alist
  '("\\.js$" . javascript-mode))




(add-hook 'text-mode-hook '(lambda () (progn
 (auto-fill-mode 1)
 (flyspell-mode (if (< (buffer-size) 150000) 0 1))
)))

(add-hook 'html-mode-hook '(lambda () (progn
 (auto-fill-mode 0)
 (flyspell-mode (if (< (buffer-size) 150000) 0 1))
)))



(autoload 'css-mode "css-mode")
(setq auto-mode-alist       
     (cons '("\\.css\\'" . css-mode) auto-mode-alist))
(setq cssm-indent-function #'cssm-c-style-indenter)


(setq c-indent-level-1)
(setq perl-indent-level 2)
(setq perl-continued-statement-offset 2)


(setq max-mini-window-height 1)
(defun .hi ()
 (shell-command "ps x")
)
;(.hi)


(defun .hi.x ()
  (when (< 190 ; if the rmail file has anything in it...
	   ; TODO: change to "if anything recent"?
	   (or (file-size (expand-file-name "~/RMAIL")) 0 ))
    (rmail))

  ; Say hello:
  (when window-system (play-sound-file "~/sound_effects/mach20b.wav"
				       ;~/sound_effects/playstation.wav"

)))

(defun narrow-p ()
  "Returns true iff narrow is in effect for the current buffer."
  
  (let (real-point-min real-point-max)
    (save-excursion
      (save-restriction
	(widen)
	(setq real-point-min (point-min) real-point-max (point-max))
	))
    (or
     (/= real-point-min (point-min))
     (/= real-point-max (point-max)))))

(defun toggle-narrow (beg end)
  "If narrow, widen; if not narrowed, narrow!"
  (interactive "r") ;=region
  (if (narrow-p)
    (progn (widen)
      (mutter "Un-narrowing."))
    (progn (narrow-to-region beg end)
      (mutter "Narrowing to c%s - c%s." beg end))))


(defun shuffle-lines (beg end)
  "Scramble all the lines in region defined by BEG END.
If region contains less than 2 lines, lines are left untouched."
  (interactive "*r")
  (catch 'cancel
    (save-restriction
      (narrow-to-region beg end)
      ;;   Exit when there is not enough lines in region
      (if (< (- (point-max) (point-min)) 3)
      (throw 'cancel t))

      ;;    Prefix lines with a random number and a space
      (goto-char (point-min))
      (while (not (eobp))
        (insert (int-to-string (random 32000)) " ")
        (forward-line 1))

      ;;  Sort lines according to first field (random number)
      (sort-numeric-fields 1 (point-min) (point-max))

      (goto-char (point-min))  ;Remove the prefix fields
      (while (not (eobp))
        (delete-region (point) (progn (forward-word 1) (+ (point) 1)))
        (forward-line 1))
      )))

(setq shell-buffer-counter 100)



(defun buffer-basename-or (orelse)
  (if (buffer-file-name)
	      (file-name-nondirectory (buffer-file-name)) orelse))
(defun rep!!basename (str) 
  (replace-regexp-in-string "!!" (buffer-basename-or "WHATFILE") str))



(defun launch (cmd &rest args)
  "Launch cmd with given arguments, neither waiting for completion,
nor saving its output."
  (unwind-protect
      (progn
	(when starting-process-sound (play-sound-file starting-process-sound))
	(setenv "UNDER_EMACS")
	; The real meat of it:
	(apply
	 'start-process "" nil (rep!!basename cmd) args
	 ))
      (setenv "UNDER_EMACS" "1")))
; launch and shell-command-into-void seem to behave very differently as
; far as whether the resultant process show up in list-processes.
; The difference seems to be because launch doesn't start a subshell,
; whereas shell-command-into-void does.  Interesting.

(defun shell-command-into-void (&optional cmd)
  "Start a given command-line and ignore its output."
  (interactive)
  (setq cmd (or cmd
	    (read-from-minibuffer "Program to launch: "
				  nil nil nil 'shell-command-history)))
  (mutter "Launching: %s" cmd)
  (unwind-protect
      (progn
	(when starting-process-sound (play-sound-file starting-process-sound))
	(setenv "UNDER_EMACS")
        (start-process "" nil
	 shell-file-name shell-command-switch
	 (rep!!basename (concat cmd "&"))))
    (setenv "UNDER_EMACS" "1")))

;Was:
;(defun shell-command-into-void (interactive)
;  (let ((cmd (read-from-minibuffer "Program to launch: "
;	      nil nil nil 'launcher-command-history)))
;    (progn
;      (mutter "Launching: %s", cmd)
;      (launch cmd))))


(defun shell-command-to-new-scratch (command)
  (interactive (list (read-from-minibuffer
		      "Shell command: "
		      nil nil nil 'shell-command-history)))
  (shell-command
   (rep!!basename command)
   (gen-shell-output-buffer-name (rep!!basename command))
))

(defun gen-shell-output-buffer-name (&optional cmdstr)
  (concat
   ; "Shell Command Output "
   (int-to-string
    (setq shell-buffer-counter (+ 1 shell-buffer-counter )))
   "\242 "
   (or cmdstr "(command)")))


; For Java/JavaScript mode to use only two-space indent:

(defun my-c-mode-hook ()
  (c-set-offset 'substatement-open 0)
  (setq c-basic-offset 2)
)
(add-hook 'c-mode-common-hook 'my-c-mode-hook)




(setq cperl-invalid-face nil)
(setq cperl-highlight-variables-indiscriminately t) 
(load-library "cperl-mode")
(add-to-list 'auto-mode-alist '("\\.[Pp][LlMm]$" . cperl-mode))

(add-to-list 'auto-mode-alist '("\\.[Pp][Ss][Ll]$" . ps-mode))


(redisplay)
(require 'pod-mode)
(add-to-list 'auto-mode-alist '("\\.pod$" . pod-mode))

(add-hook 'pod-mode-hook '(lambda () (progn
 (font-lock-mode)
 (auto-fill-mode 1)
 (flyspell-mode (if (< (buffer-size) 150000) 0 1))
)))

(setq woman-use-own-frame nil)
(setq woman-cache-filename (under-home ".emacs.woman_cache.dat"))
(add-hook 'woman-post-format-hook
  'cd-home
  ; TODO: make it rename the buffer to something tidy sane,
  ; like "tcsh 1" instead of "*WoMan 1 tcsh*"
  
)
  ; because woman.el leaves the current directory at the
  ; manpage's dir, which is never ever what I actually want.

(when window-system (progn
  (redisplay)
  (require 'view)
  (redisplay)
  (require 'zoom-frm)
  (redisplay)
))

(setq default-cursor-color (frame-parameter (selected-frame) 'cursor-color))

(defun reset-cursor () (interactive)
  ; because w3m etc screw it up
  (set-cursor-color default-cursor-color)
)
(defalias 'cursor-reset	'reset-cursor)


; TODO: make this call some routine in "newcomment"
;   like comment-padleft or something

(defun hbar ()
  "Make a dividing-line of ='s (commented out, of course)."
  (interactive)
  (let ((str (xcase mode-name
    ; My specific prefs:
    ("Lisp Interaction" ";%s")
    ("Lisp"          ";%s")
    ("Scheme"        ";%s")
    ("Emacs-Lisp"    ";%s")
    
    ("Perl"          "#%s")
    ("CPerl"         "#%s")
    ("Shell-script"  "#%s")
    
    ("PostScript"   "%%%s")
      
    ("SGML"    "<!--%s-->")
    ("HTML"    "<!--%s-->")
    
    ("CSS"        "/*%s*/")
    ("JavaScript"   "//%s")
    
    ("Text"           "%s")
    ("Fundamental"    "%s")
      
    ;(t (concat "??" mode-name "%s"))
    ; else fall back on what newcomment knows:
    (t (progn
         (require 'newcomment)
         (push-mark)
         (insert (make-string 70 ?=))
         (comment-region (point) (mark))
         (insert "\n")
         (pop-mark)
         nil ; flag that we've already done it
         ))
    
    )))
    (when str (insert (format str
     (make-string 70 ?=)) "\n")))
)

;(defun perl-eval () "Run selected region as Perl code" (interactive)
; (shell-command-on-region (mark) (point) "perl ")
;)
;Better:

(defun perl-eval (beg end)
 "Run selected region as Perl code."
 (interactive "r")
 (shell-command-on-region beg end "perl ") ; is the space needed?
)

;Sample:
; Ñ'agaa! ñ'agaa! daajing.aay chii t'iisgwaay ýwaat'isgwaay ñ'agaa
; hlk'idaay kwaagijiigyagaay sk'uudst'awaay jambasgaay k'un.naay
; sdaask'aagaay sdaagingsgaay xaaya yaanang.aa daala taajuu hlçaahlçuu
; hiilang sçid çaauuldang taañaahl taada taak'inçad

(defun haida2underscory-buffer ()
  "Turn ñ to <u>k</u>, etc."
  (interactive) 
  (replace-by-table '( ; Yup, dot notation!
		    ("Ñ" . "K_")
		    ("ñ" . "k_")
		    ("Ç" . "G_")
		    ("ç" . "g_")
		    ("Ý" . "X_")
		    ("ý" . "x_")
		    ("Ð" . "X^")
		    ("ð" . "x^")
		    ("Þ" . "G^")
		    ("þ" . "g^")
		    ))
  (message "Done haidifying (ñ to <u>k</u> etc.)")
)

(defun haida2html-buffer ()
  "Turn ñ to <u>k</u>, etc."
  (interactive) 
  (replace-by-table '( ; Yup, dot notation!
		    ("Ñ" . "<u>K</u>")
		    ("ñ" . "<u>k</u>")
		    ("Ç" . "<u>G</u>")
		    ("ç" . "<u>g</u>")
		    ("Ý" . "<u>X</u>")
		    ("ý" . "<u>x</u>")
		    ("Ð" . "X^")
		    ("ð" . "x^")
		    ("Þ" . "G^")
		    ("þ" . "g^")
		    ))
  (message "Done haidifying (ñ to <u>k</u> etc.)")
)

(defun replace-by-table (table)
  "Given a list of pairs, replace from the cars to the cdrs, in current buffer."
  (dolist (fromto table)
    (dumb-replace (car fromto) (cdr fromto)))
)

(defalias 'haidify-html 'haida2html-buffer)

(defun dumb-replace (from to)
  "Replace all instances of FROM with TO, in current buffer."
  (let ((case-fold-search nil))
    (beginning-of-buffer)
    (while (search-forward from nil t) (replace-match to t t)))
)

; some sane aliases:
(defalias 'toggle-fill	 'auto-fill-mode)
(defalias 'toggle-wrap	 'auto-fill-mode)
(defalias 'word-wrap-mode 'auto-fill-mode)
(defalias 'wrap-mode	 'auto-fill-mode)
(defalias 'wrap-region	 'fill-region)
(defalias 'wrap-paragraph  'fill-paragraph)

(defun SMB-dired-do-shell-command (command &optional arg file-list)
  "Like dired-do-shell-command, but accepts !! as an alias to *"

  ; We basically just replicate the whole function just
  ;  so we can cram the setq in the middle.

  (interactive
   (let ((files (dired-get-marked-files t current-prefix-arg)))
     (list
      (dired-read-shell-command (concat "! on "
					"%s: ")
				current-prefix-arg
				files)
      current-prefix-arg
      files)))

  (setq command (dired-replace-in-string "!!" "*" command))

  (let* ((on-each (not (string-match "\\*" command))))
    (if on-each
	(dired-bunch-files
	 (- 10000 (length command))
	 (function (lambda (&rest files)
		     (SMB-dired-run-shell-command
		      (dired-shell-stuff-it command files t arg))))
	 nil
	 file-list)
      ;; execute the shell command
      (SMB-dired-run-shell-command
       (dired-shell-stuff-it command file-list nil arg)))))

(defun SMB-dired-run-shell-command (command)
  (let ((handler
	 (find-file-name-handler (directory-file-name default-directory)
				 'shell-command)))
    (if handler
      (apply handler 'shell-command (list command))
      (shell-command command 
		     (gen-shell-output-buffer-name command)
		     )))
  nil)

; TODO: make an SMB-shell-command that captures
; to (gen-shell-output-buffer-name command)

; And finally:
(redisplay)
(load-file-from-home ".emacs.keys")
(load-file-from-home ".emacs.private")
(redisplay)