;; -*- Mode: Emacs-Lisp -*-

;;;       Extensively Windows-ized!!!!   Don't use on UNIX!!!!

;; (setq debug-on-quit t)

;;{{{ User options settings

(setq auto-mode-alist
    (append '(
              ("\\.yum$"  .       c++-mode)
              ("\\.c\\+\\+$"      .       c++-mode)
              ("\\.cxx$"  .       c++-mode)
              ("\\.cc$"           .       c++-mode)
              ("\\.C$"            .       c++-mode)
              ("\\.in$"           .       c++-mode)
              ("\\.i$"            .       c++-mode)
              ("\\.pdl$"  .       c++-mode)
              ("\\.yuk$"  .       c-mode)
              ("\\.rpc$"  .       c-mode)
              ("\\.uil$"  .       c-mode)
              ("\\.c$"    .       c-mode)
              ("\\.h$"    .       c++-mode)
              ("\\.a$"            .       ada-mode)
              ("\\.pl$"           .       perl-mode)
              ("\\.ms$"           .       nroff-mode)
              ("\\.mm$"           .       nroff-mode)
              ("\\.dm$"           .       nroff-mode)
              ("\\.man$"  .       nroff-mode)
              ("\\.nr$"           .       nroff-mode)
              ("\\.tr$"           .       nroff-mode)
              ("\\.emacs$"        .       emacs-lisp-mode)
              ("\\.sh$"           .       ksh-mode)
              ("\\.kshrc$"        .       ksh-mode)
              ("make_[a-z]*$"     .       ksh-mode)
              ("makeclient$"      .       ksh-mode)
              ("makelibdirs$"     .       ksh-mode)
              ("makeoptical$"     .       ksh-mode)
              ("makesql$" .       ksh-mode)
              ("/setup\\."        .       ksh-mode)
              ("fix.makefile$"  . ksh-mode)
              ("\\.tmpl$" .       makefile-mode)
              ("makeeng$" .       makefile-mode)
              ("\\.out$"  .       compilation-mode)
              ;;("\\.html$"       .     html-helper-mode)
       )
            auto-mode-alist))

(setq load-path (append
                 (list (expand-file-name "~/emacs"))
                 load-path))

(let (new-default-modeline-format)
  (mapcar
   (function (lambda (arg)
               (cond
                ((and (consp arg)
                      (eq 'line-number-mode (nth 0 arg)))
                 nil)
                ((eq 'modeline-buffer-identification (cdr-safe arg))
                 (setq new-default-modeline-format
                       (append new-default-modeline-format (list arg)))
                 (setq new-default-modeline-format
                       (append new-default-modeline-format
                               (list '(line-number-mode " L%l")))))
                (t
                 (setq new-default-modeline-format
                       (append new-default-modeline-format (list arg)))))))
   default-modeline-format)
  (setq default-modeline-format new-default-modeline-format))

;;}}}
;;{{{ Function definitions

;;{{{ add-hook

(defun my-add-hook (hook function &optional append)
  "Add to the value of HOOK the function FUNCTION unless already present.
\(It becomes the first hook on the list unless optional APPEND is non-nil, in 
which case it becomes the last).  HOOK should be a symbol, and FUNCTION may be
any valid function.  HOOK's value should be a list of functions, not a single
function.  If HOOK is void, it is first set to nil."
  (or (boundp hook) (set hook nil))
  (or (if (consp function)
          ;; Clever way to tell whether a given lambda-expression
   ;; is equal to anything in the hook.
   (let ((tail (assoc (cdr function) (symbol-value hook))))
            (equal function tail))
        (memq function (symbol-value hook)))
      (set hook 
           (if append
               (nconc (symbol-value hook) (list function))
             (cons function (symbol-value hook))))))
(if (not (fboundp 'add-hook)) (fset 'add-hook 'my-add-hook))

;;}}}

;;{{{ Hooks
;;{{{ my-ediff-load-hook

(defun my-ediff-load-hook ()
  (custom-set-variables '(ediff-use-faces t))
  )

;;}}}
;;{{{ my-cc-c++-hook

(defun my-cc-c++-hook ()

  (require 'cc-mode)

  (auto-fill-mode 1)

  (setq c-recognize-knr-p nil)

  (local-set-key [(control c) (tab)] 'c-set-offset)

  (if (and buffer-file-name
           (string-match ".*/var/tmp/cvintp[0-9]+/"
                         (file-name-directory buffer-file-name))
           (save-excursion
             (goto-char (point-min))
             (looking-at "{")))
      (save-excursion
        (add-hook 'local-write-file-hooks 'cream-f+c-marker)
        (add-hook (make-local-variable 'after-save-hook) 'stuff-f+c-marker))))

;;}}}
;;{{{ my-dired-mode-hook

(defun my-dired-mode-hook ()
  "Bind some private functions."
  (setq case-fold-search t)             ;because the mode overrides
  )

;;}}}
;;{{{ my-ksh-mode-hook

(defvar ksh-indent 4 "Default for ksh-mode")
(defvar ksh-group-offset -4 "Default for ksh-mode")
(defvar ksh-brace-offset -4 "Default for ksh-mode")
(defvar ksh-tab-always-indent t "Default for ksh-mode")
(defvar ksh-match-and-tell t "Default for ksh-mode")
(defvar ksh-align-to-keyword t "Default for ksh-mode")

(defun my-ksh-mode-hook nil
  (setq compile-command (concat (file-name-nondirectory
                                 (or (buffer-file-name)
                                     "/bin/false"))
                                " -n"))
  (font-lock-mode 1)
  (setq ksh-indent 4
        ksh-group-offset -4
        ksh-brace-offset -4
        ksh-tab-always-indent t
        ksh-match-and-tell t
        ksh-align-to-keyword t)
  )

;;}}}
;;{{{ my-lisp-hook

(defun my-lisp-hook ()
  ;;(local-set-key "\033q" 'indent-sexp)
  ;;(local-set-key "\033j" 'indent-sexp)
  (local-set-key "\M-\C-d" 'edebug-defun)
  ;;(local-set-key "\M-\C-r" 'eval-region)
  (local-set-key "\C-x\C-e" 'byte-compile-file)
  (make-local-variable 'edebug-all-defuns) ; when set, eval-region edebugs
  (auto-fill-mode 1))

;;}}}
;;{{{ my-lisp-interaction-mode-hook

(defun my-lisp-interaction-mode-hook ()
  (local-set-key "\r" 'newline-and-indent))

;;}}}
;;{{{ my-makefile-mode-hook

(defvar makefile-mkdep nil
  "Buffer-local save of mkdep data in makefiles.")
(make-variable-buffer-local 'makefile-mkdep)
;;(add-hook 'makefile-mode-hook 'my-makefile-mode-hook)
;; keep fume outta makefile mode, as it's a waste of time
(setq fume-function-name-regexp-make "zyzzyva")
(defun my-makefile-mode-hook ()
  "Hide mkdep stuff"
  ;; keep self on front, so our suppression protects everyone else
  (if (< 1 (length makefile-mode-hook))
      (setq makefile-mode-hook (list 'my-makefile-mode-hook
                                     (delq 'my-makefile-mode-hook
                                           makefile-mode-hook))))
  (if (save-excursion
        (goto-char (point-min))
        (re-search-forward "^# DO NOT DELETE THIS LINE" nil t))
      (save-excursion
        (goto-char (point-min))
        (re-search-forward "^# DO NOT DELETE THIS LINE" nil t)
        (forward-line 2)
        (setq makefile-mkdep
              (buffer-substring (point) (point-max)))
        (let (buffer-read-only)
          (setq buffer-read-only nil)
          (delete-region (point) (point-max))
          (set-buffer-modified-p nil)
          )

        (add-hook 'local-write-file-hooks 'my-makefile-write-hook)

        )))

(defvar my-makefile-write-hook-dont-ask nil
  "*Set to t to always replace mkdep stuff")

(defun my-makefile-write-hook ()
  "Restore mkdep stuff."
  (if makefile-mkdep
      (save-excursion
        (goto-char (point-min))
        (if (re-search-forward "^# DO NOT DELETE THIS LINE" nil t)
            (let ((bm (buffer-modified-p))
                  font-lock-mode)

              (forward-line 2)
              (if (or (= (point) (point-max))
                      my-makefile-write-hook-dont-ask
                      (y-or-n-p "Replace with original mkdep stuff? "))
                  (progn
                    (delete-region (point) (point-max))
                    (insert makefile-mkdep)

                    (set-buffer-modified-p bm)
                    )
                )
              )
          )
        (add-hook 'after-save-hook 'my-makefile-mode-hook)
        )
    )
  nil)

;;}}}
;;{{{ my-nroff-mode-hook

(defun my-nroff-mode-hook ()
  "Sets outline minor mode and outline-regexp."
  ;;(outline-minor-mode 1)
  (setq outline-regexp "\\.H\\s +[0-9]"))

;;}}}
;;{{{ my-perl-mode-hook

(defun my-perl-mode-hook ()
  (interactive)
  (modify-syntax-entry ?' "_")
  (local-set-key '(meta backspace) 'backward-kill-word)
  (set (make-local-variable 'compile-command) (file-name-nondirectory
                                               buffer-file-name))
  (set (make-local-variable 'auto-fill-inhibit-regexp)
       "[^#\n]*\\(\".*\"[^#\n]*\\)*\"")
  (auto-fill-mode 1))

;;}}}
;;{{{ my-sh-mode-hook
(defun my-sh-mode-hook nil
  "Shell mode?  Who cares about *shell* mode???"
  (ksh-mode))

;;}}}
;;{{{ my-text-hook

(defun my-text-hook ()
  (auto-fill-mode 1)
  (make-local-variable 'indent-line-function)
  (local-set-key "\C-?" 'backward-delete-char-untabify)
  (local-set-key "\M-\C-q" 'quote-paragraph)
  (local-set-key "\C-i" 'indent-relative)
  (local-set-key "\M-\C-r" 'append-rtn-addr-to-paragraph)
  (setq indent-line-function 'indent-relative-maybe)
  (setq paragraph-separate "^$\\|^\\|^ *$\\|^-+$"
        paragraph-start paragraph-separate)
  (setq fill-column 64)
  (modify-syntax-entry ?\" "\""))

;;}}}

;;{{{ my-write-file-hook

(defun my-write-file-hook ()
  (save-restriction
    (save-excursion
      (widen)
      (goto-char (point-min))
      (if (re-search-forward
           (cond
            ((eq major-mode 'text-mode)
             "\\(\\s *Modified:\\s *\\).*\\(\\S \\)")
            ((eq major-mode 'c-mode)
             "\\(\\s *\\*\\s *Modified:\\s *\\).*\\(\\S \\)")
            ((eq major-mode                           'jde-mode)
             (concat "\\(//\\s *Modified:\\s *\\).*\\(\\S \\)"))
            (t
             "\\(\\s<\\s *Modified:\\s *\\).*\\(\\s>*\\)"))
           nil 'x)
          (replace-match (concat "\\1" (current-time-string) "\\2")))
      (cond
       ((eq major-mode 'jde-mode)
        (tabify-anchored (point-min) (point-max))
        (clear-ws-eol (point-min) (point-max))))
      )
    )
  nil)

;;}}}

;;}}}

;;{{{ Hook settings

(add-hook 'ada-mode-hook 'ada-mode-hook)
(add-hook 'archie-display-hook 'server-make-window-visible)
(add-hook 'archie-load-hook 'archie-load-hook)
(add-hook 'c++-mode-hook 'my-cc-c++-hook)
(add-hook 'c-mode-hook 'my-cc-c++-hook)
(add-hook 'dired-mode-hook 'my-dired-mode-hook)
(add-hook 'emacs-lisp-mode-hook 'my-lisp-hook)
(add-hook 'hide-ifdef-mode-hook 'my-hide-ifdef-mode-hook)
(add-hook 'ksh-mode-hook 'my-ksh-mode-hook)
(add-hook 'lisp-interaction-mode-hook 'my-lisp-interaction-mode-hook)
(add-hook 'lisp-mode-hook 'my-lisp-hook)
(add-hook 'nroff-mode-hook 'my-nroff-mode-hook)
(add-hook 'perl-mode-hook 'my-perl-mode-hook)
(add-hook 'sh-mode-hook 'my-sh-mode-hook)
(add-hook 'text-mode-hook 'my-text-hook)
(add-hook 'write-file-hooks 'my-write-file-hook)

;;}}}

;;{{{ 411-2-csv
(defun 411-2-csv (save)
  "Convert 411.txt to 411.csv, suitable for import to PalmPilot.
With ARG, clean out 411.txt"
  (interactive "P")

  (let ((desktop "c:/WINNT/Profiles/jackr/Desktop"))

    (find-file-other-frame (concat desktop "/411.csv"))
    (widen)
    (kill-region (point-min) (point-max))

    (save-window-excursion
      (find-file (concat desktop "/My Briefcase/411.txt"))
      (widen)
      (if (not save)
          (and (kill-region (point-min) (point-max))
               (save-buffer))
        (copy-region-as-kill (point-min) (point-max))))

    (yank)
    (goto-char (point-min))
    ;; This is the default column order.
    ;; Unfortunately, "default" doesn't mean much - this is what you
    ;; get when you install the desktop, but any changes made
    ;; subsequently become the new default, and there's no "revert" or 
    ;; "reset to defaults".
    ;;
    ;; "Last,First,Title,Company,Work,Home,Fax,Other,E-Mail,"
    ;; "Address,City,State,Zip,Country,"
    ;; "Custom 1,Printer,B'day,Custom 4,"
    ;; "Note,Private,Category\n"
    ;; I use Custom 1 == 
    ;;       Custom 2 == Printer
    ;;          Custom 3 == B'day
    ;;          Custom 4 == Source (411)
    ;;
    ;; This is the order 411 produces them in:
    (insert (concat "First,Last,Email,City,Address,Title,Work,Post-SSP,Other,Extn,Source,Category\n"))

    (save-restriction
      (while (/= (point) (point-max))

        ;; Mark names: zero or more "first" names, one last name
 (save-restriction

          (narrow-to-region (point) (+ (point) 28))
          (save-excursion               ; comma after names
     (if (looking-at "\\(.*[^ ]\\) +")
                (replace-match "\\1,")))
          (save-excursion               ;comma before last name
     (if (looking-at "\\(.*[^ ]\\) +")
                (replace-match "\\1,")))
          (goto-char (point-max))
          )

        ;; mark remaining fields: column-delimited, possibly
 ;; blank-padded, possible empty (all blank), widths
 ;; preordained.
 (let ((len-list '(9             ; length of email (+ space)
                   4             ; length of "city" (MP, PORT, ...)
                   5             ; "address" (building + space)
                   5             ; "title" (department + space)
                   16            ; work phone number
                   5             ; post-ssp extension
                   4             ; SSP
                   5             ; extension
                   ))

              len)

          (while (setq len (car-safe len-list))
            (setq len-list (cdr-safe len-list))

            (save-restriction
              (narrow-to-region (point)
                                (min (+ len (point))
                                     (save-excursion
                                       (end-of-line 1)
                                       (point))))
              (if (looking-at "^ *\\([^ ]*\\) *")
                  (replace-match "\\1,"))))
          (insert "411,Business"))

        (beginning-of-line 2))

      (goto-char (point-min))
      ))
  (save-excursion
    (while (re-search-forward
            "\\(.*\\),\\(.*\\),\\(.*\\),\\(.*\\),.*,\\(.*\\),\\(.*\\),.*,\\(.*\\),.*,\\(.*\\),\\(.*\\)" nil t)
      (replace-match (concat "\\2,\\1,\\5,\"Informix Software, Inc.\",\\6,,,\\7,\\3,"
                             ",\\4,,,,,,,\\8,,,\\9"))))
  (save-excursion
    (set-buffer "411.csv")
    (if (file-exists-p "411.csv~")
        (delete-file "411.csv~"))
    (save-buffer-kill-buffer t))
  (set-buffer "411.txt")
  (if (file-exists-p "411.txt~")
      (delete-file "411.txt~"))
  (save-buffer-kill-buffer t)
  (delete-frame))
;;}}}

;;{{{ align-eq
(defun align-eq (start end)
  "Align assignment/comparison operators in region."
  (interactive "*r")

  (local-set-key '(control meta =) 'align-eq)

  (save-excursion
    (save-restriction

      ;; be sure we have BOL for first line
      (goto-char start)                  
      (beginning-of-line)
      (setq start (point))

      ;; be sure we have EOL for last line
      (goto-char end)
      (end-of-line)
      (setq end (point))

      (narrow-to-region start end)

      (save-excursion
        (goto-char (point-min))
        (while (> (point-max) (point))
          (and (looking-at "[^=\n]*=")
               (goto-char (match-end 0))
               (skip-syntax-backward ".")
               (fixup-whitespace))
          (beginning-of-line 2)))

      (let ((goalcol 0)
            thiscol)
        (goto-char (point-min))
        (while (> (point-max) (point))
          (and (looking-at "[^=\n]*=")
               (goto-char (match-end 0))
               (setq thiscol (current-column))
               (> thiscol goalcol)
               (setq goalcol thiscol)
               )
          (beginning-of-line 2))

        (goto-char (point-min))
        (while (> (point-max) (point))
          (cond
           ((and (looking-at "[^=\n]*=")
                 (goto-char (match-end 0))
                 (setq thiscol (current-column))
                 (< thiscol goalcol))

            (backward-char)
            (while (looking-at "[=!><~+-*/^&|.]")
              (backward-char)
              (setq thiscol (1- thiscol)))
            (forward-char)
            (setq thiscol (1+ thiscol))

            (insert (make-string (- goalcol thiscol) ? ))))
          (beginning-of-line 2))))))
;;}}}
;;{{{ append-rtn-addr-to-paragraph

(defun append-rtn-addr-to-paragraph ()
  (interactive "*")
  (save-excursion
    (forward-paragraph)
    (if (not (bolp)) (newline))
    (insert-file "~/.rtn-addr")))

;;}}}
;;{{{ dist-personal-env-file

(defun dist-personal-env-file (arg)
  "Copy current file from local home to net home."
  (interactive "P")
  (cond
   ((string= (system-name) "jabba5.informix.com")
    (progn
      (if (and (buffer-file-name)
               (buffer-modified-p)
               (or arg (y-or-n-p (format "Save buffer %s? " (buffer-name)))))
          (save-buffer nil))
      (copy-file (buffer-file-name)
                 (concat "~/uj/" (file-name-nondirectory (buffer-file-name)))
                 'ok-if-already-exists))
    (cerror "Can't dist-personal-env-file from non-home."))
   ((string= (system-name) "tweety.illustra.com")
    (shell-command (substitute-in-file-name "$HOME/bin/distenv -H &"))))
  )

;;;}}}
;;{{{ gnuserv-allow

(defun gnuserv-allow nil
  (interactive)
  (save-window-excursion
    (set-buffer "*server*")
    (goto-char (point-max))
    (backward-word 4)
    (let ((newhost (buffer-substring (point)
                                     (save-excursion
                                       (forward-word 4)
                                       (point)))))
      (set-buffer (find-file-noselect
                   (expand-file-name (getenv "GNU_SECURE"))))
      (goto-char (point-max))
      (insert newhost "\n")
      (write-file (expand-file-name (getenv "GNU_SECURE")))
      (gnuserv-start))))

;;;}}}
;;{{{ path-expand

(defun path-expand ()
  "Expand the word around point as a command name take from $PATH."
  (interactive "*")
  (let* ((fake-outs '(?- ?@ ?. ?_))
         (old-fakes (mapcar '(lambda (char) (cons char (char-syntax char)))
                            fake-outs))
         start end)
    (unwind-protect
        (progn
          (mapcar '(lambda (char) (modify-syntax-entry char "w")) fake-outs)
          (if (not (looking-at "\\<")) (forward-word -1))
          (setq start (point))
          (forward-word 1)
          (setq end (point))
          (shell-command-on-region
           start end
           (concat "/bin/ksh -c 'print -n `whence -p " (buffer-substring start end) "`'")
           t)
          )
      (mapcar '(lambda (char-val)
                 (modify-syntax-entry (car char-val) 
                                      (char-to-string (cdr char-val))))
              old-fakes))))

;;}}}
;;{{{ unfill-paragraph

(defun unfill-paragraph (arg)
  "Pull this whole paragraph up onto one line."
  (interactive "*p")
  (let ((fill-column 10000))
    (fill-paragraph arg))
  )

;;}}}
;;{{{ pilot-mark

(defvar pilot-mark "§"
  "*String to mark paragraphs for AportisDocs.")

(defun pilot-mark (arg)
  "Mark this spot (with ARG, this line) for AportisDoc bookmark."
  (interactive "*P")
  (unless arg
    (beginning-of-line 1))
  (insert pilot-mark " ")
  (save-restriction
    (save-excursion
      (goto-char (point-max))
      (skip-chars-backward (concat pilot-mark "<>\n"))
      (unless (looking-at (concat "\n<" pilot-mark ">\n"))
        (goto-char (point-max))
        (insert "\n<" pilot-mark ">\n")))))

;;}}}
;;{{{ quote-paragraph

(defvar quote-fill-prefix "\t"
  "*Fill prefix to use in quoted material.")

(defun quote-paragraph (arg)
  "Fill (with ARG, justify) the current paragraph as a quote (using quote-fill-prefix)."
  (interactive "*P")
  (save-restriction
    (mark-paragraph)
    (narrow-to-region (if (looking-at "\n") (1+ (point)) (point)) (mark))
    (let ((fill-prefix quote-fill-prefix)
          (case-replace nil)
          (case-fold-search nil))
      (replace-regexp "^" fill-prefix nil)
      (fill-paragraph arg))))

;;}}}

;;}}}

;;{{{ Source code editing

;;{{{ c-comment-ident

(defun c-comment-ident (arg)
  "Comment out a c identifier (or, arg contiguous ones)."
  (interactive "*P")
  (or (looking-at "\\b")
      (backward-sexp))
  (insert "/*")
  (forward-sexp arg)
  (insert "*/"))

;;}}}
;;{{{ check-next-DOC-entry

(defun check-next-DOC-entry ()
  "Check this DOC file for alignment with help-f."
  (interactive)
  (if (eq major-mode 'help-mode)
      (help-mode-quit))
  (if (buffer-modified-p)
      (save-buffer t))
  (re-search-forward "^F\\(.*\\)")
  (let* ((fname (buffer-substring (match-beginning 1) (match-end 1)))
         (fsym (intern-soft fname)))
    (if fsym (describe-function fsym)))
  )

;;}}}
;;{{{ clearmake-filter

(defun clearmake-filter (process output)
  "Insert and clean up clearmake output into *compilation*"
  (if (and process (process-status process))
      (save-excursion
        (set-buffer "*compilation*")
        (let* ((start (if (= (point) (point-max)) -1 (point))))
          (unwind-protect
              (progn
                (toggle-read-only -1)
                (goto-char (point-max))
                (save-excursion (insert output))
                (while (re-search-forward "\\[[0-9]*m" nil t)
                  (delete-region (match-beginning 0) (match-end 0))))
            (goto-char (if (= -1 start) (point-max) start))
            (toggle-read-only 1))))))

;;}}}
;;{{{ indent-includes

(defun indent-includes ()
  "Indents ``list-matching-lines ^#'' lines from *.in files."
  (interactive)
  (beginning-of-line)
  (re-search-forward "line 1\\s +\"")
  (beginning-of-line)
  (let ((including-file
         (save-excursion
           (re-search-backward "line [0-9]+ \"" nil t)
           (goto-char (match-end 0))
           (buffer-substring
            (point)
            (1- (progn (search-forward "\"") (point)))))))
    (save-restriction
      (save-excursion
        (narrow-to-region
         (point)
         (save-excursion
           (search-forward including-file) (end-of-line 0) (point)))
        (replace-regexp "^" " ")))
    (forward-line 1)))

;;}}}
;;{{{ insert-braces

;;; Dave Brennan <brennan@hal.com> has a copy; might as well forward
;;; him any improvements as well!
(defun insert-braces ()
  "Insert matched braces, leave point inside."
  (interactive "*")
  (let (blink-paren-function) ;nil it temporarily
    (execute-kbd-macro
     (if (and (eq major-mode 'cc-c++-mode) (not (looking-at ";")))
         "{};" "{}")))
  (backward-sexp 1)
  (if (save-excursion
        (forward-char -1)
        (looking-at "\\$"))
      nil
    (reindent-then-newline-and-indent)
    (c-indent-exp)
    (forward-char 1)
    (newline-and-indent)))

;;}}}

;;}}}

;;{{{ Display property fiddling

;;{{{ toggle-line-wrap

(defun toggle-line-wrap ()
  "Toggles the line-wrap (or line-truncate, depending on your
perspective) function.  Covers (and equates) both horizontal and
vertical splits."
  (interactive)
  (setq truncate-lines (setq truncate-partial-width-windows (not
                                                             truncate-lines)))
  (recenter (- (count-lines (window-start) (point))
               (if (bolp) 0 1)))
  )

;;}}}

;;}}}

;;{{{ Script creation and debugging

;;{{{ make-perl-script

(defun make-perl-script (arg)
  "Make the current buffer into a perl script.  With arg, nukes first."
  (interactive "*P")
  (cond
   ((or arg (= (- (point-min) (point-max)) 0))
    (erase-buffer)
    (insert-file "~/bin/debug.pl")))
  (save-excursion
    (shell-command (concat "chmod +x " (buffer-file-name))))
  (if (search-forward "gud-perldb-history: " nil t)
      (insert (concat "(\"perl "
                      (file-name-nondirectory (buffer-file-name))
                      "\")")))
  (save-buffer)
  (shell-command (concat "chmod a+x " (buffer-file-name)))
  (find-alternate-file (buffer-file-name)) ; set mode, fontification, etc.
  (beginning-of-buffer)
  (search-forward "usage=\"Usage: $0 \[-$flags\]" nil t))

;;}}}
;;{{{ make-shell-script

(defun make-shell-script (arg)
  "Make the current buffer into a ksh script.  With arg, nukes first."
  (interactive "*P")
  (cond
   ((or arg (= (- (point-min) (point-max)) 0))
    (erase-buffer)
    (insert-file "~/bin/debug.ksh")
    (if (search-forward "#    eval: (if (fboundp 'sh-mode) (sh-mode))\n" nil t)
        (insert
         "#   compile-command: \""
         (file-name-nondirectory (buffer-file-name))
         " -n \"\n"))))
  (save-buffer)
  (shell-command (concat "chmod a+x " (buffer-file-name)))
  (find-alternate-file (buffer-file-name)) ; set mode, fontification, etc.
  (beginning-of-buffer)
  (search-forward "usage=\"Usage: $0 \[-$flags\]" nil t))

;;}}}
;;{{{ pdb-down-to-here

(defun pdb-down-to-here (command-line)
  "Launch perl debugger, proceeding down to current line."
  (interactive
   (list (read-from-minibuffer "Run perldb (like this): "
                               (if (and (require 'gud)
                                        (consp gud-perldb-history))
                                   (car gud-perldb-history)
                                 "perl ") 
                               nil nil
                               '(gud-perldb-history . 1))))
  (require 'gud)
  (make-local-variable 'gud-perldb-history)
  (let ((buf (current-buffer))
        (line (+ (if (bolp) 1 0)
                 (count-lines (point-min) (point)))))
    (save-some-buffers t)
    (perldb command-line)               ; changes current buf
    (while (save-excursion
             (goto-char (point-max))
             (beginning-of-line)
             (not (looking-at " *DB<1>")))
      (sit-for 1)
      (accept-process-output)
      (if (save-excursion
            (goto-char (point-max))
            (beginning-of-line 0)
            (looking-at "Debugger exited abnormally.*"))
          (progn
            (pop-to-buffer buf)
            (error (buffer-substring (match-beginning 0) (match-end 0))))))
    (goto-char (point-max))             ; ... but doesn't do this, oddly
    (insert "c " (number-to-string (+ line (if (bolp) 1 0))))
    (comint-send-input)))

;;}}}

;;}}}

;;{{{ Misc

;;{{{ insert-time-stamp

(defun insert-time-stamp ()
  "Insert current date and time."
  (interactive "*")
  (insert (current-time-string)))

;;}}}
;;{{{ kill-buffer-other-window

(defun kill-buffer-other-window (arg)
  "Kill the buffer in the ARGth other window, or the current buffer if no
other window."
  (interactive "p")
  (let ((buf (save-window-excursion
               (other-window arg)
               (current-buffer))))
    (delete-windows-on buf)
    (kill-buffer buf))
  )

;;}}}
;;{{{ fill-rest-of-paragraph

(defun fill-rest-of-paragraph (arg)
  "Fill (with ARG, justify) paragraph from (point) to end,
eluding confusion above."
  (interactive "*P")
  (save-restriction
    (beginning-of-line 1)
    (narrow-to-region (point)
                      (save-excursion
                        (forward-paragraph)
                        (point)))
    (fill-paragraph arg)))

;;}}}
;;{{{ my-save-buffer-kill-frame

(defun my-save-buffer-kill-frame (arg)
  "Saves buffer, if necessary (with ARG, w/o asking), and then kills
it and its frame."
  (interactive "P")
  (let ((buf (current-buffer))
        (delete-frame nil)
        (kill-buffer nil))
    (if (and (buffer-file-name buf)
             (buffer-modified-p)
             (or arg (y-or-n-p (format "Save buffer %s? " (buffer-name)))))
        (save-buffer nil))
    (setq kill-buffer (or (not (buffer-modified-p buf))
                          (not (buffer-file-name buf))
                          (yes-or-no-p (concat "Buffer "
                                               (buffer-name buf)
                                               " modified; kill anyway? "))))
    (setq delete-frame (if (and (one-window-p)
                                (or arg
                                    (unwind-protect
                                        (y-or-n-p "Delete frame as well? ")
                                      (message ""))))
                           (selected-frame)
                         nil))
    (delete-windows-on buf)
    (if kill-buffer (progn (if (string-match "XEmacs" (emacs-version))
                               (set-buffer-modified-p nil buf)
                             (save-excursion
                               (set-buffer buf)
                               (set-buffer-modified-p nil)))
                           (kill-buffer buf)))
    (and delete-frame (delete-frame))))

;;}}}
;;{{{ my-set-sound-defaults

(defun my-set-sound-defaults (vol)
  (interactive "nSet sounds to what volume? ")
  (mapcar
   (function (lambda (entry)
               (let ((e (memq ':volume entry)))
                 (if e
                     (setcar (cdr (memq ':volume entry)) vol)
                   (nconc entry (list ':volume vol)))
                 (list (car entry) ':volume (car (cdr (memq ':volume entry)))))))
   sound-alist))

;;}}}
;;{{{ my-spell-word

(defun my-spell-word (arg)
  "Calls ispell-word, or with ARG, ispell-buffer."
  (interactive "P")
  (require 'ispell)
  (if arg
      (ispell-message)
    (ispell-word))
  )

;;}}}

;;{{{ pp-window-configuration

(defvar pp-window-configuration ()
  "Holds the stack of former window configurations.  
Form: (list (list window-configuration point-in-current)
            ...)")

(defvar pp-max 10
  "*Maximum number of window configurations stored by pp-window-configuration.")


(defun pp-window-configuration (arg)
  "Save current window config (with ARG, restore; with ARG>=16,
flush)"
  (interactive "p")
  (cond
   ((and (numberp arg) (>= arg 16))
    (setq pp-window-configuration nil)
    (message "Window configuration stack cleared."))
   ((or (not (numberp arg)) (and (numberp arg) (> arg 1)))
    (setq pp-window-configuration
          (append (list 
                   (list (current-window-configuration) (point)))
                  (if (>= (length pp-window-configuration) pp-max)
                      (reverse (cdr (reverse pp-window-configuration)))
                    pp-window-configuration))))
   (t
    (if (= 0 (length pp-window-configuration))
        (message "Window configuration stack is empty.")
      (let* ((ppwc (car pp-window-configuration))
             (wc (nth 0 ppwc))
             (p (nth 1 ppwc)))
        (setq pp-window-configuration (cdr pp-window-configuration))
        (set-window-configuration wc)
        (goto-char p))))))

;;}}}
;;{{{ remove-alist-name

(defun remove-alist-name (name alist)
  "Removes element whose car is NAME from ALIST."
  (cond ((equal name (car (car alist)))
         (cdr alist))
        ((null alist)
         nil)
        (t
         (cons (car alist)
               (remove-alist-name name (cdr alist))))))

;;}}}
;;{{{ remove-eudora-duplicates

(defconst eudora-marker (concat "^" (regexp-quote "From ???@??? ")))

(defun remove-eudora-duplicates ()
  "Find and remove duplicate messages in an Eudora mailbox."
  (interactive "*")
  (while (re-search-forward eudora-marker nil t)
    (save-excursion
      (when (re-search-forward "^message-id:" nil t)
        (beginning-of-line 1)
        (let ((msgid (buffer-substring (point)
                                       (progn
                                         (end-of-line 1)
                                         (point))))
              )
          (when (re-search-forward (concat "^" (regexp-quote msgid)) nil t)
            (message "Removing %s" msgid)
            (kill-whole-message)
            )))))
  (message ""))

(defun kill-whole-message ()
  "Kill one whole message, in Eudora format.
Helper function for remove-eudora-duplicates"
  (interactive "*")
  (let ((beg (save-excursion
               (re-search-backward eudora-marker nil t)
               (point)))
        (end (save-excursion
               (re-search-forward eudora-marker nil t)
               (beginning-of-line 1)
               (point))))
    (kill-region beg end)
    ))

;;}}}
;;{{{ set-vectra-keys

(defun set-vectra-keys ()
  "Set up key bindings needed when using PCTPC (or whoever's sending
the wrong key codes."
  (interactive)
  ;; key labelled "Insert"
  (global-set-key [ find ] 'fkey-overwrite-mode)
  ;; key labelled "Delete"
  (global-set-key [ select ] 'backward-delete-char-untabify)
  ;; key labelled "Home"
  (global-set-key [ insert ] 'beginning-of-buffer)
  ;; key labelled "End"
  (global-set-key [ prior ] 'end-of-buffer)
  ;; key labelled "Page Up" 
  (global-set-key "\C-[[3~" 'fkey-scroll-down)
  ;; key labelled "Page Down"
  (global-set-key [ next ] 'fkey-scroll-up)
  )

;;}}}
;;{{{ sum-column

(defun sum-column (start end arg)
  "Add up (presumed) numbers in the column defined by START and END.
Insert if ARG."
  (interactive "r\nP")
  (if (< end start) (let (tmp)
                      (setq tmp start)
                      (setq start end)
                      (setq end tmp)))
  (save-excursion
    (goto-char start)
    (let ((numcol (current-column))
          (numend (save-excursion (goto-char end) (current-column)))
          (sum 0))
      (while (< (point) end)
        (setq sum (+ sum (string-to-number
                          (buffer-substring (point)
                                            (progn
                                              (move-to-column numend t)
                                              (point))))))
        (beginning-of-line 2)
        (move-to-column numcol t))
      (if arg (insert (number-to-string sum)))
      (message "Total: %.2f" sum))))

;;}}}
;;{{{ save-buffer-kill-buffer

(defun save-buffer-kill-buffer (arg)
  "Saves buffer, if necessary (with ARG, w/o asking), and then kills it."
  (interactive "P")
  (let ((buf (current-buffer)))
    (if (and (buffer-file-name buf)
             (buffer-modified-p)
             (or arg (y-or-n-p (format "Save buffer %s? " (buffer-name)))))
        (save-buffer nil)
      )
    (delete-windows-on buf)
    (kill-buffer buf)))


;;}}}
;;{{{ xrdb

(defun xrdb ()
  "Display for edit the current X resources, saving into ~/.Xresources."
  (interactive)
  (pp-window-configuration t)
  (find-file "~/.Xresources")
  (delete-other-windows)
  (local-set-key "\C-c\C-c" 'reload-xrdb)

  ;; Set up comments appropriate for cpp
  ;; Note that white space can't be allowed between resource values
  ;; and the comment delimiter, or it will be included in the value
  ;; (producing things like "unrecognizable color name 'red       '")
  (modify-syntax-entry ?/ ". 14")
  (modify-syntax-entry ?* ". 23")
  (make-local-variable 'comment-start)
  (setq comment-start "/* ")
  (make-local-variable 'comment-end)
  (setq comment-end " */")
  (make-local-variable 'comment-column)
  (setq comment-column 0) 
  (make-local-variable 'comment-start-skip)
  (setq comment-start-skip "/\\*+ *")

  (message (substitute-command-keys "\\[reload-xrdb] to feed changes to xrdb"))
  )

;;}}}

;;}}}

;;}}}
;;{{{ Advice

(setq  ad-start-advice-on-load          t
       ad-activate-on-definition        t)

(require 'advice)

;;{{{ crontab

(defadvice crontab-get (before pp-for-crontab activate)
  "Stack window configuration"
  (pp-window-configuration t))

(defadvice crontab-save (after pp-for-crontab activate)
  "Unstack window configuration"
  (pp-window-configuration nil))

;;}}}
;;{{{ find-tag

(defadvice find-tag (before pp-for-tags activate)
  "Stack window configuration, as with function calls."
  (pp-window-configuration t))

;;}}}
;;{{{ tags-apropos

(defadvice tags-apropos (before pp-for-tags activate)
  "Stack window configuration, as with function calls."
  (pp-window-configuration t))

;;}}}
;;{{{ tags-search

(defadvice tags-search (before pp-for-tags activate)
  "Stack window configuration, as with function calls."
  (pp-window-configuration t))

;;}}}

;;}}}
;;{{{ Major packages and tweeks

;;{{{ auto-save
(cond
 ((string-match "XEmacs" (emacs-version))
  (require 'auto-save)
  (setq auto-save-directory (if (file-directory-p "/work/jackr/autosave")
                                "/work/jackr/autosave"
                              (expand-file-name "~/autosave")))))

;;}}}
;;{{{ autoinsert

(require 'autoinsert)                   ;needs my version
(setq auto-insert-directory (expand-file-name "~/emacs-templates/"))
(setq auto-insert-alist '(("\\.tex$" . "tex-insert.tex")
                          ("admin/weeklies/" . "weeklies-insert")))
(add-hook 'auto-insert-hooks 'my-auto-insert-hook)

(defun my-auto-insert-hook nil
  (cond
   ((string-match "admin/weeklies/[0-9]+$" (buffer-file-name))
    (goto-char (point-min))
    (search-forward "Weekly Status, ")
    (insert-time-stamp)
    (insert "\n\n")
    (insert-file-contents (car (last (directory-files "~/admin/weeklies"
                                                      t
                                                      "[0-9]+$"
                                                      nil
                                                      t))))
    (kill-region (point)
                 (progn
                   (search-forward "- Goals")
                   (beginning-of-line)
                   (point))))))

(defconst month-name-to-num-alist
  (list (cons "Jan" "01")
        (cons "Feb" "02")
        (cons "Mar" "03")
        (cons "Apr" "04")
        (cons "May" "05")
        (cons "Jun" "06")
        (cons "Jul" "07")
        (cons "Aug" "08")
        (cons "Sep" "09")
        (cons "Oct" "10")
        (cons "Nov" "11")
        (cons "Dec" "12"))
  "Alist mapping month name strings to month number.")

(defun make-weekly-status-report nil
  "Generate a weekly status report, based on last."
  (interactive)
  (let* ((date (current-time-string))   ; Mon Apr 29 11:24:53 1996
  (report-file-name (concat (substring date 22) ; year
                            (cdr-safe (assoc (substring date 4 7) ; mon
                                             month-name-to-num-alist))
                                   (substring date 8 10))) ;day
  where)
    (while (setq where (string-match " " report-file-name))
      (aset report-file-name where ?0))
    (find-file-other-frame (concat "~/admin/weeklies/"
                                   report-file-name))
    ))

;;}}}
;;{{{ c-mode, c++-mode

(autoload 'c-mode "cc-mode")
(autoload 'c++-mode "cc-mode")

;;}}}
;;{{{ compilation-mode
(autoload 'compilation-mode "compile.el")

(defun my-compilation-mode-hook nil
  (require 'compile)
  (mapcar
   (function (lambda (arg)
               (or (memq arg compilation-font-lock-keywords)
                   (setq compilation-font-lock-keywords
                         (append (list arg) compilation-font-lock-keywords)))))
   (list '("\\bcd\\b.*" . font-lock-comment-face)
         '("^======== \\(Rebuilding\\|Finished\\) .*" . font-lock-comment-face)
         '("^Unknown error message number.*" . font-lock-comment-face)
         '("^clearmake: Error:.*" . font-lock-comment-face)
         '("^clearmake: Warning.*" . font-lock-string-face)))
  (setq compilation-error-regexp-alist ius-compilation-error-regexp-alist))

(add-hook 'compilation-mode-hook 'my-compilation-mode-hook)

(defvar ius-compilation-error-regexp-alist
  '(
    ;; 4.3BSD grep, cc, lint pass 1:
    ("\
\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)\\([) \t]\\|\
:\\([^0-9\n]\\|\\([0-9]+:\\)\\)\\)" 1 2 5)

    ;; Microsoft C/C++:
    ("\\(\\([a-zA-Z]:\\)?[^:( \t\n-]+\\)[:(][ \t]*\\([0-9]+\\)[:) \t]" 1 3)

    ;; GNU messages with program name and optional column number.
    ("[a-zA-Z]?:?[^0-9 \n\t:]+:[ \t]*\\([^ \n\t:]+\\):\
\\([0-9]+\\):\\(\\([0-9]+\\)[: \t]\\)?" 1 2 4)

    ;; GNU messages with program name and optional column number
    ;; and a severity letter after that.  nsgmls makes them.
    ("[^0-9 \n\t:]+:[ \t]*\\([^ \n\t:]+\\):\
\\([0-9]+\\):\\(\\([0-9]+\\):\\)?[A-Za-z]:" 1 2 4)

    ;; clearmake
    ("clearmake: Error: Build script failed for \"\\(.*\\)/\\([^/]+\\)\""
     1 2 nil
     "%s/makefile")

    )
 "Alist that specifies how to match errors in compiler output.
Each elt has the form (REGEXP FILE-IDX LINE-IDX [COLUMN-IDX FILE-FORMAT...])
If REGEXP matches constrained to the beginning of the line, the
FILE-IDX'th subexpression gives the file name, and the LINE-IDX'th
subexpression gives the line number.  If COLUMN-IDX is given, the
COLUMN-IDX'th subexpression gives the column number on that line.  If
any FILE-FORMAT is given, each is a format string to produce a file name
to try; %s in the string is replaced by the text matching the
FILE-IDX'th subexpression.  Note previously REGEXP was not constrained
to the beginning of the line, so old patterns without leading `^' or `\\n'
may now require a leading `.*'.")


;;}}}
;;{{{ dabbrev

(setq dabbrev-case-replace nil)

(substitute-key-definition 'save-buffer-kill-buffer
                              'my-save-buffer-kill-frame
                              (current-global-map))

(substitute-key-definition 'save-buffer-kill-buffer
                              'save-buffers-kill-emacs
                              (current-global-map))

(substitute-key-definition 'save-buffers-kill-emacs
                              'my-save-buffer-kill-frame
                              (current-global-map))

;;}}}
;;{{{ filladapt

(cond
 ((string-match "XEmacs" (emacs-version))
  (require 'filladapt)
  (setq-default filladapt-mode t)))

;;}}}
;;{{{ folding

(require 'folding)

(fold-add-to-marks-list 'ksh "# {{{" "# }}}")

(defadvice fume-rescan-buffer (around unfold-around protect activate)
  "Unfold and refold around fume scans, so all functions are seen."
  (if (not folding-mode)
      ad-do-it
    (folding-mode)
    ad-do-it
    (folding-mode)))

;;}}}
;;{{{ func-menu

(cond
 ((string-match "XEmacs" (emacs-version))
  (require 'func-menu)
  ;;(define-key global-map 'f8 'function-menu)
  (add-hook 'find-file-hooks 'fume-add-menubar-entry)
  (define-key global-map "\C-cl" 'fume-list-functions)
  (define-key global-map "\C-cg" 'fume-prompt-function-goto)

  ;; For descriptions of the following user-customizable variables,
  ;; type C-h v <variable>
  (setq fume-max-items 25
        fume-fn-window-position 3
        fume-auto-position-popup t
        fume-display-in-modeline-p t
        fume-menubar-menu-location "Apps"
        fume-buffer-name " *Function List*"
        fume-no-prompt-on-valid-default t)

  (defconst fume-function-name-regexp-lisp
    (concat
     "\\(^(defun+\\s-*[#:?A-Za-z0-9_+->]+\\s-*(\\)"
     "\\|"
     "\\(^(defsubst+\\s-*[#:?A-Za-z0-9_+->]+\\s-*(\\)"
     "\\|"
     "\\(^(defmacro+\\s-*[#:?A-Za-z0-9_+->]+\\s-*(\\)"
     "\\|"
     "\\(^(defadvice+\\s-*[#:?A-Za-z0-9_+->]+\\s-*(\\)"
     "\\|"
     "\\(^(de+\\s-*[#:?A-Za-z0-9_+->]+\\s-*(\\)"
     "\\|"
     "\\(^(dmd+\\s-*[#:?A-Za-z0-9_+->]+\\s-*(\\)"
     )
    "Expression to get lisp function names")
  (defadvice fume-prompt-function-goto (before pp-for-fume activate)
    "Advised to stack window configuration"
    (pp-window-configuration t))))

;;}}}
;;{{{ ibuff-menu

(setq ibuff-initial-sublist-modes "fdpk"
      ibuff-bury-buffers-regexp (concat
                                 "^\\("
                                 (mapconcat
                                  'identity
                                  (list " .*"
                                        "sent .*"
                                        "\\*ftp .*"
                                        "\\*vc.*"
                                        "\\.ibuff-.*"
                                        "\\+.*"
                                        "\\*Help\\*"
                                        "\\*Directory\\*"
                                        "\\*Completions\\*"
                                        "\\*Dired log\\*"
                                        "\\*Compile-Log\\*"
                                        "\\.infonotes"
                                        "\\.newsrc")
                                  "\\|")
                                 "\\)$")
      ibuff-hide-buffers-regexp "^\\( \\|show-\\+\\|\\*info\\*\\|diary\\)"
      ibuff-preserve-match-and-mode t)
(autoload 'ibuff-menu "ibuff-menu" "Edit the buffer list." t)
(global-set-key "\C-x\C-b" 'ibuff-menu)

;;}}}
;;{{{ tabs-are-spaces

(defvar tabs-are-spaces nil
  "*If set, replace all tabs with equivalent spaces.  Automatically
buffer-local when set.")
(make-variable-buffer-local 'tabs-are-spaces)

(defadvice tab-to-tab-stop (around untabify-tab activate)
  "Advised to obey tabs-are-spaces"
  (if (not tabs-are-spaces)
      ad-do-it
    (let ((start (save-excursion
                   (skip-chars-backward "\\s ")
                   (point)))
          end)
      ad-do-it
      (setq end (set-marker (make-marker) (1+ (point-marker))))
      (untabify start end)
      (goto-char (1- end)))))

(defadvice indent-relative (around untabify-tab activate)
  "Advised to obey tabs-are-spaces"
  (if (not tabs-are-spaces)
      ad-do-it
    (let ((start (save-excursion
                   (skip-chars-backward "\\s ")
                   (point)))
          end)
      ad-do-it
      (setq end (set-marker (make-marker) (1+ (point-marker))))
      (untabify start end)
      (goto-char (1- end)))))

(defun tabify-anchored (start end)
  "Convert spaces at beginning of line in REGION to tabs when possible.
A group of spaces is partially replaced by tabs
when this can be done without changing the column they end at.
Only space strings at the beginning of their line are modified.
Called non-interactively, the region is specified by arguments
START and END, rather than by the position of point and mark.
The variable `tab-width' controls the spacing of tab stops.

Just like tabify, but anchored."
  (interactive "*r")
  (save-excursion
    (save-restriction
      ;; Include the beginning of the line in the narrowing
      ;; since otherwise it will throw off current-column.
      (goto-char start)
      (beginning-of-line)
      (narrow-to-region (point) end)
      (goto-char start)
      (while (re-search-forward "^\t* [ \t]*" nil t)
          (let ((column (current-column))
                (indent-tabs-mode t))
            (delete-region (match-beginning 0) (point))
            (indent-to column)
            )))))

(defun clear-ws-eol (start end)
  "Clear trailing white space from ends of lines in REGION."
  (interactive "*r")
  (save-excursion
    (goto-char start)
    (beginning-of-line 1)
    (setq start (point))
    (goto-char end)
    (end-of-line 1)
    (setq end (point))
    (save-restriction
      (narrow-to-region start end)
      (goto-char (point-min))
      (while (re-search-forward "\\s +$" nil t)
        (replace-match "")))))

;;}}}
;;{{{ minibuf

(load "minibuf" 'missing-ok 'no-messages)

;;}}}
;;{{{ resize-minibuffer-mode (rsz-minibuf)

(autoload 'resize-minibuffer-mode "rsz-minibuf" nil t)
(resize-minibuffer-mode)

;;}}}
;;{{{ vc (the cc-vc one)

;;(load "vc-hooks")
;;(load"vc")
;;(setq vc-diff-on-checkin nil)

;;}}}
;;{{{ zyzzyva (miscellany)

(autoload 'crontab-edit "crontab" "" t)

(autoload 'electric-command-history "echistory" t)

(autoload 'fast-apropos "fast-apr" "\
Show all symbols whose names contain matches for REGEXP.  If
optional argument DO-ALL is non-nil, does more (time-consuming) work
such as showing key bindings.  Returns list of symbols and
documentation found."
t)

;;(autoload 'html-mode "html-mode" "HTML major mode." t)
;;(autoload 'html-helper-mode "html-helper-mode" "Yay HTML" t)

(autoload 'ksh-mode "ksh-mode" nil t)

(autoload 'format-lisp-code-directory "lispdir" nil t)
(autoload 'lisp-dir-apropos "lispdir" nil t)
(autoload 'lisp-dir-retrieve "lispdir" nil t)
(autoload 'lisp-dir-verify "lispdir" nil t)

(autoload 'metamail-buffer "metamail" nil t)
(autoload 'metamail-interpret-body "metamail" nil t)
(autoload 'metamail-interpret-header "metamail" nil t)
(autoload 'metamail-region "metamail" nil t)

(autoload 'perldb "gud" "Not yet loaded." t)

(autoload 'super-apropos "fast-apr" "\
Show symbols whose names/documentation contain matches for REGEXP.
If optional argument DO-ALL is non-nil, does more (time-consuming)
work such as showing key bindings and documentation that is not stored
in the documentation file.  Returns list of symbols and documentation
found."
t)

;;}}}

;;}}}
;;{{{ Version-specific initializations
;;{{{ Java specializations
(require 'cc-mode)
(c-add-style "java-pure-block-aligned"
             (list '(c-basic-offset . 4)
                   '(c-comment-only-line-offset 0 . 0)
                   '(c-hanging-comment-starter-p . t)
                   (list 'c-offsets-alist
                         '(access-label . 0)
                         '(arglist-close . c-lineup-arglist)
                         '(arglist-intro . c-lineup-arglist-intro-after-paren)
                         '(block-close . 0)
                         '(class-open . +)
                         '(class-close . +)
                         '(defun-block-intro . 0)
                         '(func-decl-cont . c-lineup-java-throws)
                         '(inher-cont . c-lineup-java-inher)
                         '(inline-open . +)
                         '(knr-argdecl-intro . 5)
                         '(label . 0)
                         '(statement-block-intro . 0)
                         '(statement-case-open . +)
                         '(statement-cont . +)
                         '(substatement-open . +)
                         '(topmost-intro . -)
                         '(topmost-intro-cont . +)
                         )))
;;}}}
;;{{{ Windowing specializations

(if (not (eq (console-type) 'tty))
    (progn
      (require 'saveplace)
      (setq-default save-place t)

      ;; graphics updates faster if
      ;; they don't bother with
      ;; curses-like "optimizations"
      (set-device-baud-rate (frame-device (selected-frame)) 1000000)

      (setq minibuffer-frame-plist
            '(width 124
                    height 1
                    menubar-visible-p nil
                    default-toolbar-visible-p nil
                    top 710
                    left 0
                    ))

      (setq default-frame-plist
            '(minibuffer t))            ; nil to use minibuffer-frame
                                 ; doesn't work in NT:
                                 ;   can't ^X^F, M-x there
                                 ;   doesn't help ^X^C "attempt 
                                 ;    to delete last visible or
                                 ;    iconified frame" bug

      (setq initial-frame-plist
            '(minibuffer t
                         menubar-visible-p nil
                         default-toolbar-visible-p nil
                         width 0 height 0
                         top 710 left 900))
      
      (substitute-key-definition 'find-file
                                 (if  (fboundp 'find-file-other-frame)
                                     'find-file-other-frame
                                   'find-file-other-screen)
                                 (current-global-map))

      (global-set-key "\M-\C-x\M-\C-f" 'find-file) ; hidden in lisp

      (if  (string-match "XEmacs" emacs-version)
          (progn
            (require 'gnuserv)
            (or (getenv "GNU_SECURE")
                (setenv "GNU_SECURE" (concat (getenv "HOME") "/.gnusecure")))
            (gnuserv-start)

            (put 'newline-and-indent 'pending-delete t)
            (put 'newline 'pending-delete t)
            )
        )

      )
  )                                     ; if not tty

;;}}}
;;{{{ Global key bindings

(global-unset-key "\M-z")         ; Remove zap-to-char!!!!
(global-unset-key "\C-z")          ; Remove iconify-or-deiconify-frame

(global-set-key '(control meta =) 'align-eq)
(global-set-key "\M-\C-z"  'pp-window-configuration)
(global-set-key "\C-\\" 'compare-windows)
(global-set-key "\C-c\`" 'find-this-error)
(global-set-key "\C-r" 'isearch-backward-regexp)
(global-set-key "\C-s" 'isearch-forward-regexp)
;;(global-set-key "\C-x4k" 'kill-buffer-other-window)
(global-set-key "\C-x\C-e" 'compile)
(global-set-key "\C-x\C-k" 'kill-compilation)
(global-set-key "\C-x\M-\e" 'electric-command-history)
(global-unset-key "\C-xm")                ;normally "mail"
(global-set-key "\C-xw" 'toggle-line-wrap) ; Overrides widen
(global-set-key "\M-$" 'my-spell-word)
(global-set-key "\M-%" 'query-replace-regexp)
(global-set-key "\M-{" 'insert-braces)
(global-set-key "\M-G" 'goto-line)
(global-set-key "\M-\C-\\" 'two-window-command)
(global-set-key "\M-\C-g" 'what-line)
(global-set-key "\M-\C-r" 'append-rtn-addr-to-paragraph)
(global-set-key "\M-\C-s" 'isearch-forward)
(global-set-key "\M-\C-t" 'insert-time-stamp)
(global-set-key "\M-\C-u" 'up-list) ; instead of backward-up-list
(global-set-key "\M-\\" 'fixup-whitespace)
(global-set-key "\M-`" 'next-error)
(global-set-key "\M-g" 'goto-line)
(global-set-key "\M-s" 'center-line)

(global-set-key [f1] 'advertised-undo)
(global-set-key [f2] 'x-kill-primary-selection)
(global-set-key [f3] 'x-copy-primary-selection)
(global-set-key [f4] (function (lambda (arg)
                                 (interactive "*P")
                                 (funcall mouse-yank-function))))

;;}}}
(display-time)

(set-glyph-image frame-icon-glyph
                 (concat data-directory "gnu.xpm")
                 'global 'x)