;;; .emacs $Id$ ;;; mostly cribbed from Kevin Sitze's. (setq load-path (append (list (expand-file-name "~/emacs/misc")) (list (expand-file-name "~/emacs/vm")) load-path)) (setenv "MANPATH") (require 'vm) ;; gimme some useful filling (require 'filladapt) (setq-default filladapt-mode t) (setq filladapt-mode-line-string " FA") (setq filladapt-token-table (append '(("\\([Pp]\\. ?\\)+[Ss]\\." ps-ending) ("\\(To\\|From\\|Subject\\):" ps-ending) ("\\[[0-9]+\\]" bullet) ("--" citation->) ("|" citation->)) filladapt-token-table) filladapt-token-conversion-table (cons '(ps-ending . spaces) filladapt-token-conversion-table) ) ;; some useful colors (require 'font-lock) (setq font-lock-maximum-decoration t) (global-font-lock-mode 1) (set-face-attribute 'default nil :font "-outline-Lucida Console-normal-r-normal-normal-*-*-96-96-c-*-iso10646-1" :height 140 ;; :font "-outline-Lucida Sans Unicode-normal-r-normal-normal-*-*-96-96-c-*-iso10646-1" ;; :height 160 ) (set-face-background 'default "black") (set-face-foreground 'default "#bbbbbb") ; grey70 (set-cursor-color "#008800") (setq blink-cursor nil) (set-face-background 'cursor "#008800") (set-face-foreground 'font-lock-comment-face "grey50") (set-face-foreground 'modeline "green") (set-face-background 'modeline "grey30") (set-face-foreground 'highlight "grey90") (set-face-background 'highlight "green4") (set-face-background 'region "darkblue") (set-face-foreground 'font-lock-string-face "#8888ff") (set-face-foreground 'font-lock-keyword-face "Goldenrod") (set-face-foreground 'font-lock-variable-name-face "pink") (require 'ediff) (let ((bgh "60") (bgl "30") (bgo "00") ;; background high/low/off (fbh "90") (fbl "48") ;; fine background high/low (fine-fg "grey95") (active-fg "grey90") (inactive-fg "grey70")) (set-face-background 'ediff-current-diff-face-A (concat "#" bgh bgl bgl)) (set-face-background 'ediff-current-diff-face-B (concat "#" bgh bgl bgl)) (set-face-background 'ediff-current-diff-face-C (concat "#" bgh bgl bgl)) (set-face-background 'ediff-current-diff-face-Ancestor "#444444") (set-face-background 'ediff-fine-diff-face-A (concat "#" fbh fbl fbl)) (set-face-background 'ediff-fine-diff-face-B (concat "#" fbh fbl fbl)) (set-face-background 'ediff-fine-diff-face-C (concat "#" fbh fbl fbl)) (set-face-background 'ediff-fine-diff-face-Ancestor "#999999") (set-face-background 'ediff-even-diff-face-A (concat "#" bgo bgo bgl)) (set-face-background 'ediff-even-diff-face-B (concat "#" bgo bgo bgl)) (set-face-background 'ediff-even-diff-face-C (concat "#" bgo bgo bgl)) (set-face-background 'ediff-even-diff-face-Ancestor (concat "#" bgo bgo bgl)) (set-face-background 'ediff-odd-diff-face-A (concat "#" bgo bgl bgo)) (set-face-background 'ediff-odd-diff-face-B (concat "#" bgo bgl bgo)) (set-face-background 'ediff-odd-diff-face-C (concat "#" bgo bgl bgo)) (set-face-background 'ediff-odd-diff-face-Ancestor (concat "#" bgo bgl bgo)) ;; (set-face-background 'ediff-current-diff-face-A (concat "#" bgh bgl bgl)) ;; (set-face-background 'ediff-even-diff-face-A (concat "#" bgh bgl bgo)) ;; (set-face-background 'ediff-odd-diff-face-A (concat "#" bgh bgo bgl)) ;; (set-face-background 'ediff-fine-diff-face-A (concat "#" fbh fbl fbl)) ;; (set-face-background 'ediff-current-diff-face-B (concat "#" bgl bgh bgl)) ;; (set-face-background 'ediff-even-diff-face-B (concat "#" bgl bgh bgo)) ;; (set-face-background 'ediff-odd-diff-face-B (concat "#" bgo bgh bgl)) ;; (set-face-background 'ediff-fine-diff-face-B (concat "#" fbl fbh fbl)) ;; (set-face-background 'ediff-current-diff-face-C (concat "#" bgl bgl bgh)) ;; (set-face-background 'ediff-even-diff-face-C (concat "#" bgl bgo bgh)) ;; (set-face-background 'ediff-odd-diff-face-C (concat "#" bgo bgl bgh)) ;; (set-face-background 'ediff-fine-diff-face-C (concat "#" fbl fbl fbh)) ;; (set-face-background 'ediff-current-diff-face-Ancestor "#444444") ;; (set-face-background 'ediff-even-diff-face-Ancestor (concat "#" bgl bgo bgl)) ;; (set-face-background 'ediff-odd-diff-face-Ancestor (concat "#" bgo bgl bgl)) ;; (set-face-background 'ediff-fine-diff-face-Ancestor "#999999") (set-face-foreground 'ediff-current-diff-face-A active-fg) (set-face-foreground 'ediff-even-diff-face-A inactive-fg) (set-face-foreground 'ediff-odd-diff-face-A inactive-fg) (set-face-foreground 'ediff-fine-diff-face-A fine-fg) (set-face-foreground 'ediff-current-diff-face-B active-fg) (set-face-foreground 'ediff-even-diff-face-B inactive-fg) (set-face-foreground 'ediff-odd-diff-face-B inactive-fg) (set-face-foreground 'ediff-fine-diff-face-B fine-fg) (set-face-foreground 'ediff-current-diff-face-C active-fg) (set-face-foreground 'ediff-even-diff-face-C inactive-fg) (set-face-foreground 'ediff-odd-diff-face-C inactive-fg) (set-face-foreground 'ediff-fine-diff-face-C fine-fg) (set-face-foreground 'ediff-current-diff-face-Ancestor active-fg) (set-face-foreground 'ediff-even-diff-face-Ancestor inactive-fg) (set-face-foreground 'ediff-odd-diff-face-Ancestor inactive-fg) (set-face-foreground 'ediff-fine-diff-face-Ancestor fine-fg)) ; (set-face-background 'isearch "navy") ; (set-face-background 'text-cursor "green4") ; (set-face-foreground 'font-lock-comment-face "wheat") ; (set-face-italic-p 'font-lock-string-face t) ; (set-face-foreground 'font-lock-doc-string-face "yellow") ; (set-face-foreground 'font-lock-function-name-face "cyan") ; (set-face-bold-p 'font-lock-function-name-face t) ; (set-face-foreground 'font-lock-type-face "yellow") ; (set-face-foreground 'font-lock-reference-face "Aquamarine") ; (set-face-foreground 'font-lock-preprocessor-face "orange") ; ; (set-face-foreground 'highlight "cyan") ; (set-face-background 'highlight "grey30") ; (set-face-background 'zmacs-region "midnight blue") ; (set-face-background 'primary-selection "grey40") ; ; (set-face-foreground 'shell-prompt-face "green") ; (set-face-foreground 'shell-option-face "goldenrod") ; (set-face-foreground 'shell-output-face "grey80") ; (set-face-foreground 'comint-input-face "grey90") ; ; (set-face-foreground 'message-cited-text-face "Aquamarine") ; ; (set-face-foreground 'modeline-buffer-id "cyan") ; (set-face-background 'modeline-buffer-id "grey30") ; (set-face-foreground 'modeline-mousable "pink") ; (set-face-background 'modeline-mousable "grey30") ; (set-face-foreground 'modeline-mousable-minor-mode "orange") ; (set-face-background 'modeline-mousable-minor-mode "grey30") ; (set-face-foreground 'pointer "grey60") (let* ((fqdn (system-name)) (h (substring fqdn 0 (string-match "\\." fqdn))) (f (concat "[" h "] %b"))) (setq frame-title-format f) (setq icon-title-format f)) (require 'cperl-mode) (set-face-foreground 'cperl-hash-face "#ff88ff") (set-face-background 'cperl-hash-face "black") (set-face-bold-p 'cperl-hash-face nil) (set-face-foreground 'cperl-array-face "skyblue") (set-face-background 'cperl-array-face "black") (set-face-bold-p 'cperl-array-face nil) (set-face-foreground 'cperl-nonoverridable-face "coral") (require 'sh-script) (set-face-foreground 'sh-heredoc-face "#8888ff") (set-face-bold-p 'sh-heredoc-face nil) (add-hook 'cperl-mode-hook (lambda () (modify-syntax-entry ?_ "w"))) ;; kevin's indentation style (c-add-style "kls" '("bsd" (c-offsets-alist . ((inline-open . 0)))) nil) (add-hook 'c-mode-common-hook (lambda () (c-set-style "kls") ;; (c-toggle-hungry-state 1) ;; (setq defun-prompt-regexp "^ *") )) (setq completion-ignored-extensions '( ",v" ".Xdefaults" ".a" ".class" ".elc" ".exe" "+" ".keep" ".lib" ".ll" ".ln" ".o" ".obj" ".so" ".toc" )) ;;; key bindings (global-set-key "\C-xe" 'eval-last-sexp) (global-set-key "\M-g" 'goto-line) (global-set-key "\M-j" 'fill-paragraph) (global-set-key [mouse-4] 'tony-scroll-down-small) (global-set-key [mouse-5] 'tony-scroll-up-small) (require 'gud) (global-set-key [f8] 'gud-break) (global-set-key [f11] 'gud-up) (global-set-key [f12] 'gud-down) (defvar tony-scroll-small-lines 5 "*Number of lines considered a small scroll.") (defun tony-scroll-down-small () (interactive) (scroll-down tony-scroll-small-lines)) (defun tony-scroll-up-small () (interactive) (scroll-up tony-scroll-small-lines)) ;;; appearances. (display-time) (setq display-time-24hr-format t) (column-number-mode 1) (line-number-mode 1) ;;; cperl config (setq cperl-hairy t cperl-indent-level 4 cperl-continued-brace-offset -2 cperl-extra-newline-before-brace t cperl-extra-newline-before-brace-multiline t cperl-electric-parens-mark t cperl-merge-trailing-else nil ) ;;; various behavior configs (setq-default indent-tabs-mode nil) (setq next-line-add-newlines nil) ;; gimme beeps! (setq-default case-fold-search t) (setq case-fold-search t case-replace nil) ;;; i like this better in xemacs, i think... (transient-mark-mode 1) ;;; some utilities (defun tony-remove-trailing-whitespace () (interactive) (save-excursion (save-restriction (widen) (let ((m (point-max)) (c 0)) (goto-char (point-min)) (while (re-search-forward "[ \t]+$" m t) (replace-match "") (setq c (1+ c))) (message "Removed %d trailing whitespaces" c))))) ;;; enable all commands. (mapatoms (lambda (sym) (if (get sym 'disabled) (put sym 'disabled nil)))) ;;; try for unified diffs? (setq diff-switches "-u") ;;; must ... kill ... perl ... mode ;; look at: auto-mode-alist and interpreter-mode-alist (defun tony-remap-mode-aux(from to dp) "Helper for `tony-remap-mode'. Operates on a single dotted pair or sublist DP; returns the a copy of the cell we were given." (let* ((is-sublist (listp (cdr dp))) (mode (if is-sublist (car (cdr dp)) (cdr dp)))) (if (equal mode from) (if is-sublist (cons (car dp) (cons to (cdr (cdr dp)))) (cons (car dp) to)) dp))) (defun tony-remap-mode(from to) "Go through `auto-mode-alist' and `interpreter-mode-alist', replacing every target of FROM with TO. Example: (tony-remap-mode 'perl-mode 'cperl-mode)" (interactive) (setq auto-mode-alist (mapcar (function (lambda (dp) (tony-remap-mode-aux from to dp))) auto-mode-alist)) (setq interpreter-mode-alist (mapcar (function (lambda (dp) (tony-remap-mode-aux from to dp))) interpreter-mode-alist))) (tony-remap-mode 'perl-mode 'cperl-mode) (setq auto-mode-alist (cons '("\\.plx" . cperl-mode) auto-mode-alist)) ;;; sigh. (defun tony-dosify-buffer () (interactive) (save-excursion (save-restriction (widen) (goto-char (point-min)) (while (re-search-forward "[ \t]+$" (point-max) t) (replace-match "")) (goto-char (point-min)) (while (re-search-forward "\r?\n" (point-max) t) (replace-match "\r\n"))))) (defun tony-find-c++-class-name () (interactive) (save-excursion (save-restriction (widen) (if (re-search-backward (concat "\\(class\\|struct\\)\\s +" "\\(\\sw+\\)") (point-min) t) (match-string 2) (message "unable to find beginning of class!") "")))) (defun tony-insert-default-constructor () (interactive) (let ((c (tony-find-c++-class-name))) (insert c "()\n {\n }\n"))) (if (featurep 'tool-bar) (progn (tool-bar-mode nil))) (if (featurep 'scroll-bar) (progn (scroll-bar-mode nil))) (setq vc-make-backup-files t) (require 'compile) (setq compilation-error-regexp-alist (cons ;; error from "ant" tool ;; [javac] /path/to/file/Sequence.java:16: cannot resolve symbol '("\\s +\\[.+\\]\\s +\\(.+\\):\\([0-9]+\\):" 1 2) compilation-error-regexp-alist)) (require 'cc-mode) (setq c-basic-offset 4) (setq-default c-basic-offset 4) (defun tony-cc-mode-fixups () (interactive) (setq c-basic-offset 4)) (add-hook 'c-mode-hook 'tony-cc-mode-fixups) (add-hook 'c++-mode-hook 'tony-cc-mode-fixups) (make-variable-buffer-local 'filladapt-token-table) (add-hook 'c-mode-common-hook 'c-setup-filladapt) (defun tony-java-mode-fixups () (setq c-basic-offset 4) (setq indent-tabs-mode nil) (local-set-key "\C-x\C-e" 'compile) (make-variable-buffer-local 'case-replace) (setq case-replace t)) (add-hook 'java-mode-hook 'tony-java-mode-fixups) ;;; never worked anyway, and it complains on older SQL modes. ;; (add-hook 'sql-mode-hook 'sql-highlight-oracle-keywords) ;;; mule crap (set-language-environment 'Latin-1) ;; (if (featurep 'mule) ;; (progn ;; (add-hook 'comint-exec-hook ;; (lambda () ;; (set-buffer-process-coding-system 'raw-text ;; 'raw-text) ;; t)) ;; (set-language-environment "Latin-1"))) (add-hook 'comint-mode-hook (lambda () (if (not (member 'comint-watch-for-password-prompt comint-output-filter-functions)) (setq comint-output-filter-functions (cons 'comint-watch-for-password-prompt comint-output-filter-functions))))) ;;; -------------------------------------------------------------------- (defun tony-explain-sql (b e) "Send selected SQL to the nearest db buffer for explaining" (interactive "r") (let ((query (buffer-substring b e)) (proc (get-buffer-process (get-buffer "*db-prod*")))) (save-excursion (if (not (string-match ";\\s *$" query)) (setq query (concat query ";"))) (comint-simple-send proc "SET ECHO ON") (comint-simple-send proc (concat "EXPLAIN PLAN FOR " query)) (comint-simple-send proc "SET ECHO OFF") (comint-simple-send proc "@explain-plan")))) ;;; -------------------------------------------------------------------- (defconst tony-xml-font-lock-keywords (let* ((letter "a-zA-Z") (digit "0-9") (name (concat "[" letter "_:]" "[" letter digit "._:-]*"))) (list (list (concat "<\\([!?]" name "\\)") '(1 font-lock-keyword-face)) (list (concat "<\\(/?" name "\\)") '(1 font-lock-function-name-face)) '("[&%][a-z][-.a-z0-9]*;?" (0 font-lock-variable-name-face)) '("" (0 font-lock-comment-face))))) (defun tony-maybe-set-xml-fontlock () "Fix up the font-lock keywords for XML" (interactive) (if (string-match "\\.[xX][mM][lL]$" (or (buffer-file-name) "")) (progn (make-variable-buffer-local 'font-lock-defaults) (setq font-lock-defaults '(tony-xml-font-lock-keywords nil t))))) (add-hook 'sgml-mode-hook 'tony-maybe-set-xml-fontlock) ;;; -------------------------------------------------------------------- (require 'comint) (defun tony-make-db-buf (user pass db buf-name) (let ((buf (get-buffer-create buf-name))) (if (comint-check-proc buf) (switch-to-buffer buf) (shell buf) (let ((dir (expand-file-name "~/work/radio-tool/sql")) (conn (concat user "/" pass "@" db)) (proc (get-buffer-process buf))) (comint-simple-send proc (concat "cd " dir)) (comint-simple-send proc ". setup.sh") (comint-simple-send proc (concat "sqlplus " conn)) (comint-simple-send proc "@setup"))))) (defun tony-db-test () (interactive) (tony-make-db-buf "radio_test" "radio_test" "intdb" "*db-test*")) (defun tony-db-prod () (interactive) (tony-make-db-buf "radio_user" "radio_user" "intdb" "*db-prod*")) (defun tony-db-databuild-radio () (interactive) (tony-make-db-buf "databuild_radio" "databuild_radio" "webdb" "*db-dbr*")) (defun tony-db-meta-owner () (interactive) (tony-make-db-buf "meta_owner" "meta_owner" "racdb" "*db-mo*" )) (defun tony-xml-flense () (interactive) (goto-char (point-min)) (replace-string "><" ">\n<")) (autoload 'py-shell "python-mode" "Start an interactive Python interpreter in another window." t) (autoload 'python-mode "python-mode" "Major mode for editing Python files." t) (setq auto-mode-alist (cons '("\\.py" . python-mode) auto-mode-alist)) ;;; -------------------------------------------------------------------- (defun conv-le32-aux (chars mult) (if chars (+ (* mult (car chars)) (conv-le32-aux (cdr chars) (* mult 256))) 0)) (defun conv-le32 (b e) "Convert little-endian region to 32-bit integer." (interactive "r") (let ((chars (mapcar `string-to-char (split-string (buffer-substring b e) "")))) ;; (message (format "chars: %s" (prin1-to-string chars))) (message (format "%d" (conv-le32-aux chars 1))))) ;;; -------------------------------------------------------------------- ;;; next-gen xml mode configuration (load "~/emacs/nxml-mode/rng-auto.el") (setq auto-mode-alist (cons '("\\.\\(xml\\|xsl\\|rng\\|xhtml\\)\\'" . nxml-mode) auto-mode-alist)) (autoload 'rnc-mode "rnc-mode") (setq auto-mode-alist (cons '("\\.rnc\\'" . rnc-mode) auto-mode-alist)) ;;; -------------------------------------------------------------------- ;;; loathe java (defvar gen-bean-methods-indent " ") (defvar gen-bean-java-ident "[A-Za-z_$][A-Za-z_$0-9]+") (defvar gen-bean-immutable-types '("String" "Track" "Album" "Artist")) (defun gen-bean-copy (type field param) (let* ((case-fold-search nil) (in gen-bean-methods-indent) (is-array (numberp (string-match "\\(.*?\\)\\s *\\[.*\\]" type))) (real-type (if is-array (match-string 1 type) type)) (is-object (and (numberp (string-match "\\([A-Z][^.]+\\)" real-type)) (not (member (match-string 1 real-type) gen-bean-immutable-types))))) (cond ((and is-array is-object) (concat in in "for ( int i = 0; i < " param ".length; ++i )\n" in in in "this." field "[i] = new " real-type "( " param "[i] );\n")) (is-array (concat in in "this." field " = (" type ") " param ".clone();\n")) (is-object (concat in in "this." field " = new " type "( " param " );\n")) (t (concat in in "this." field " = " param ";\n" ))))) (defun gen-bean-method-aux (type field) (let* ((param field) (ucname (concat (upcase (substring param 0 1)) (substring param 1))) (in gen-bean-methods-indent)) (concat in "public " type " get" ucname "()\n" in "{\n" in " return " field ";\n" in "}\n" in "\n" in "public void set" ucname "( " type " " param " )\n" in "{\n" (gen-bean-copy type field param) in "}\n" in "\n"))) (defun gen-bean-methods (b e) (interactive "r") (let ((in " ") (member-re (concat "^\\s +private\\s +" ; assume all members private "\\(.*?\\)\\s +" ; and its type... "\\([a-zA-Z0-9_$]+\\);")) ; names assumed "_blahGoesHere" (rep-start) (rep-end)) (save-excursion (save-restriction (widen) (goto-char b) (let ((decls "\n")) (while (re-search-forward member-re e t) (setq decls (concat decls (gen-bean-method-aux (match-string 1) (match-string 2))))) (goto-char (point-min)) (if (re-search-forward "^\\s +/\\* -- automatically generated: begin -- \\*/\\s *$" (point-max) t) (progn (forward-line 1) (setq rep-start (point))) (error "No starting marker")) (if (re-search-forward "^\\s +/\\* -- automatically generated: end -- \\*/\\s *$" (point-max) t) (progn (forward-line 0) (setq rep-end (point))) (error "No ending marker")) (kill-region rep-start rep-end) (insert decls)))))) (require 'highlight-current-line) (set-face-background 'highlight-current-line-face "grey10") (set-face-foreground 'highlight-current-line-face nil) ;;; -------------------------------------------------------------------- ;;; windows-specific doom ;;; set some env vars to make cvs happy ;;; (setenv "CVS_RSH" "ssh") ;;; (setenv "CVS_RSH" "plink") ;;; (setenv "PATH" (concat "c:\\program files\\gnu\\cvsnt\\" ";" (getenv "PATH"))) ;;; (setq explicit-shell-file-name "c:\\cygwin\\bin\\bash.exe") (add-to-list 'vc-path "c:\\program files\\gnu\\cvsnt") (add-to-list 'completion-ignored-extensions "CVS/") (setq compilation-scroll-output t) (require 'dabbrev) (setq dabbrev-case-replace nil)