Source

js-elisp / js-common.el

Full commit

;;----------------------------------------------------------------------------;;
;; Path setup and unobjectionable customizations.                             ;;
;; Every emacs user should load this file.                                    ;;
;;----------------------------------------------------------------------------;;


(require 'cl)

(setq js-site-lisp-prod "/mnt/global/base/lib/elisp")

(defvar js-site-lisp js-site-lisp-prod
  "The location of Jane Street site-lisp directory.")

(add-to-list 'load-path js-site-lisp)

(defcustom js-elisp-dir (expand-file-name "js" js-site-lisp)
  "Location of js elisp library."
  :group 'js
  :type 'string)
;; (setq js-elisp-dir (expand-file-name "~/omake-mode"))

(add-to-list 'load-path js-elisp-dir)
(add-to-list 'load-path (expand-file-name "deprecated" js-elisp-dir))

(defvar js-libraries
  '("ahg"
    "ar"
    "auctex"
    "bbdb"
    "cql-mode"
    "deprecated"
    "dictionary"
    "ecb"
    "eieio"
    "elib"
    "ess"
    "haskell-mode"
    "jde"
    "nxhtml"
    "nxml-mode"
    "ocaml"
    "org/lisp"
    "sml-mode"
    "tuareg-mode")
  "Libraries to have available on startup")

(dolist (dir js-libraries)
  (add-to-list 'load-path (expand-file-name dir js-site-lisp)))

;; js libraries
(require 'js-micro-features)
(require 'js-ocaml)
(require 'js-cr)
(progn
  (require 'omake)
  (unless (equal js-elisp-dir (expand-file-name "js" js-site-lisp-prod))
    (Omake.set-server-program "/mnt/global/base/bin/omake_server_test.exe")))
(require 'js-omake-deprecated)

;; Make sure "jomake" is called by omake-server
(setq Omake.omake-command "jomake")

;; Delete trailing whitespace
(add-to-list 'write-file-functions 'delete-trailing-whitespace)

;; font-lock = colors
(global-font-lock-mode 1)

;; Highlight the matching paren
(show-paren-mode t)

;; Use y or n instead of yes or no
(fset 'yes-or-no-p 'y-or-n-p)

;; Make a script executable
(add-hook 'after-save-hook 'executable-make-buffer-file-executable-if-script-p)

;; Disabling fsync keeps emacs from blocking out for several seconds
;; at a time when omake is also running.  The downside is that if your
;; machine crashes after you save but before the file gets flushed,
;; you might lose some work.  Totally worth it!
(setq write-region-inhibit-fsync t)

(custom-set-variables

 ;; Quiet startup
 '(inhibit-startup-message t)
 '(inhibit-startup-screen t)
 '(inhibit-default-init t)
 `(inhibit-startup-echo-area-message ,(user-login-name))
 '(initial-scratch-message nil)

 ;; text-only questions, please
 '(use-dialog-box nil)

 ;; Editing remote files (e.g., C-x C-f /nyc-qws-r07:/etc/X11/xorg.conf RET)
 '(tramp-default-method "scp")
 '(remote-shell-program "/usr/bin/ssh")

 ;; Ignore parens inside comments for C-M-f and C-M-b
 '(parse-sexp-ignore-comments t)

 ;; length of *Messages* buffer -- default of 100 probably made sense in
 ;; 1990, but now just makes problems harder to debug
 '(message-log-max 10000)

 ;; echo keystrokes to the minibuffer
 '(echo-keystrokes 0.01)

 ;; Don't fontify large buffers in real time.  Fontification
 ;; can be very slow on large files.  Wait until you haven't
 ;; typed for awhile to fontify
 '(jit-lock-stealth-time 5)

 ;; Don't bother your colleagues with a beep
 '(visible-bell nil)

 ;;; clipboard
 ;; delete selections and use X clipboard
 '(x-select-enable-clipboard t)
 ;; use X clipboard and paste at point
 '(mouse-yank-at-point t)
 ;; M-y updates X clipboard
 '(yank-pop-change-selection t)
 ;; bigger kill ring
 '(kill-ring-max 200)
 ;; put X clipboard on kill-ring before overwriting it
 '(save-interprogram-paste-before-kill t)
 ;; when killing the same thing twice, ignore second one
 '(kill-do-not-save-duplicates t)

 ;; 100M = 10x larger than default
 '(large-file-warning-threshold (* 100 1000 1000))
 )

;;----------------------------------------------------------------------------;;
;; Misc small commands                                                        ;;
;;----------------------------------------------------------------------------;;

(defvar align-dwim-command "/mnt/global/dev/bin/line_up_words.exe")

(defun align-dwim ()
  "tries to align words in the region in an intelligent way"
  (interactive)
  (shell-command-on-region
   (region-beginning) (region-end) align-dwim-command t t
   shell-command-default-error-buffer t)
  (indent-region (region-beginning) (region-end)))

(defun bounce-sexp ()
  "Will bounce between matching parens -- alternates between forward-sexp/backward-sexp"
  (interactive)
  (let ((prev-char (char-to-string (preceding-char)))
        (next-char (char-to-string (following-char))))
    (cond ((string-match "[\]})>]" prev-char) (backward-sexp 1))
          ((string-match "[[{(<]" next-char) (forward-sexp 1))
          (t (backward-up-list)))))

;; Buffer modifying functions
;; execute a perl script on this buffer, or region if mark is active
(defun perl-filter (filter)
  (interactive "sFilter: ")
  (let* ((regionp (and mark-active transient-mark-mode))
         (start (if regionp (region-beginning) (point-min)))
         (stop (if regionp (region-end) (point-max))))
    (shell-command-on-region
     start stop
     (concat "perl -pale '" filter "'")
     nil
     t)))

(defun dos-unix ()
  "Convert DOS cr-lf to UNIX newline"
  (interactive)
  (goto-char (point-min))
  (while (search-forward "\r" nil t) (replace-match "")))

(defun unix-dos ()
  "Convert UNIX newline to DOS cr-lf"
  (interactive)
  (goto-char (point-min))
  (while (search-forward "\n" nil t) (replace-match "\r\n")))

(defun get-omake-root-or-current-dir ()
  (or
   (locate-dominating-file default-directory "OMakeroot")
   default-directory))

(defun dired-ml ()
  "Lookup up ml and mli files in current directory"
  (interactive)
  (dired "*.ml{,i}"))

(defun ml-grep (directory-to-grep regexp-to-grep)
  "Grep through .ml files in the current hg root or directory"
  (interactive "DDir: \nsRegexp: ")
  (grep (concat "find " directory-to-grep " -regex '.*\\.mli?$' | xargs grep --line-number --with-filename --no-messages --perl-regexp -- \"" regexp-to-grep "\"")))

(defcustom js-face-family "DejaVu LGC Sans Mono"
  "Default face family"
  :group 'js)

(defcustom js-background "black"
  "Default blackground.  If t, background is black, otherwise white."
  :group 'js)

(defcustom js-foreground "white"
  "Default blackground.  If t, background is black, otherwise white."
    :group 'js)

(defun set-default-face (size face)
  (custom-set-faces
   `(default ((t (:background ,js-background
                  :foreground ,js-foreground
                  :height ,size
                  :font ,face
                  :family ,face))))))

(defun small-face ()
  "Set the face size small"
  (interactive)
  (set-default-face 79 "lucidatypewriter"))

(defun medium-face ()
  "Set the face size medium"
  (interactive)
  (set-default-face 120 js-face-family))

(defun large-face ()
  "Set the face size large"
  (interactive)
  (set-default-face 140 js-face-family))

(defun sweeks-face ()
  "Set the face size sweeks-large"
  (interactive)
  (set-default-face 160 js-face-family))

(defun find-alternate-file-with-sudo ()
  "Open a file as root without restarting emacs"
  (interactive)
  (if buffer-file-name
      (find-alternate-file (concat "/sudo::" buffer-file-name))
      (error "Buffer %s does not visit a file" (current-buffer))))

(defcustom jane-untabify
  '(tuareg-mode c-mode c++-mode ruby-mode shell-script-mode python-mode)
  "*The list of modes whose files should be untabified before saving."
  :group 'js)

(defun jane-untabify ()
  (when (memq major-mode jane-untabify)
    (save-restriction (untabify (point-min) (point-max)))))

;;----------------------------------------------------------------------------;;
;; End                                                                        ;;
;;----------------------------------------------------------------------------;;

(provide 'js-common)