js-elisp / jane-common.el

Full commit
;; jane-common.el
;; Path setup and unobjectionable customizations.
;; Every emacs user should load this file.

;; Set site lisp dir for everyone and add load paths                          ;;

(defconst jane-site-lisp "/mnt/global/base/lib/elisp"
  "The location of Emacs libraries.  This is the same for all Emacs users,
regardless of whether they load prod, test, or local jane libraries such as

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

(defconst jane-libraries
  "Libraries to have available on startup")

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

;; Determine jane elisp library dir and set paths                             ;;

(defconst jane-home (directory-file-name (file-name-directory load-file-name)))

(add-to-list 'load-path jane-home)

(defconst jane-prod (expand-file-name "jane" jane-site-lisp)
  "The location of jane production libraries.")

(defconst jane-test (expand-file-name "jane-test" jane-site-lisp)
  "The default location of jane test libraries.")

;; type mode = 'prod | 'test | 'local
(defconst jane-mode
   ((equal jane-home jane-prod) 'prod)
   ((equal jane-home jane-test) 'test)
   (t 'local)))

(defconst jane-dirs

(dolist (dir jane-dirs)
  (add-to-list 'load-path (expand-file-name dir jane-home)))

(require 'jane-deprecated)
(require 'jane-micro-features)
(require 'jane-ocaml)
(require 'jane-cr)
(require 'omake)

;; omake server executable
   (case jane-mode
     ('prod "/mnt/global/base/bin/omake_server.exe")
     ('test "/mnt/global/base/bin/omake_server_test.exe")
     ('local (expand-file-name "ocaml/omake/omake_server.exe" jane-home)))))

;; Customizations for all Jane Street users                                   ;;

(add-hook 'c-mode-common-hook
          (lambda () (local-set-key "\C-c\C-a" 'ff-find-other-file)))

;; so we can enable or disable bits of this file for individual users
(defun i-am (users)
  "returns true if user-login-name is passed"
  (if (listp users)
      (member (user-login-name) users)
    (string= users (user-login-name))))

;; 2012-03-29 sweeks: I put (Jane.omake-jane) in jane-common rather than
;; jane-defaults, because I want it on by default for everyone, even people who
;; just require jane-common rather than jane-defaults.  People can still call
;; (Jane.omake-old) too if they want.
(unless (i-am "cfalls") (Jane.omake-jane))

;; 2012-04-24 sweeks: I want everyone to get the auto-modes.  I don't consider
;; them optional.

;; 2012-04-30 sweeks: I don't why Jane.find should be optional.

;; 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)


 ;; 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"
   (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"
  (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))))
     start stop
     (concat "perl -pale '" filter "'")

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

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

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

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

(defun ml-grep (directory-to-grep regexp-to-grep)
  "Grep through .ml files in chosen 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 jane-face-family "DejaVu LGC Sans Mono"
  "Default face family"
  :group 'js)

(defcustom jane-background "black"
  "Default blackground."
  :group 'js)

(defcustom jane-foreground "white"
  "Default blackground."
    :group 'js)

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

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

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

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

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

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

(defun toggle-full-screen ()
  "Toggle between full screen and partial screen display on X11;
    courtesy of"
  (x-send-client-message nil 0 nil "_NET_WM_STATE" 32
                         '(2 "_NET_WM_STATE_FULLSCREEN" 0)))

(setq Info-directory-list
      (list (format "%s/doc/" jane-home)

  ;; The code below deals with [whitespace-style], which affects both highlighting of
  ;; whitespace via [whitespace-mode] and with cleanup of whitespace via
  ;; [whitespace-cleanup] when a file is saved.  We attempt to achieve the following:
  ;;   * characters beyond column 90 are highlighted
  ;;   * trailing whitespace is not highlighted by default, but can be configured
  ;;   * trailing whitespace is cleaned up on file save
  ;; To achieve this, we need different settings of [whitespace-style] for highlighting
  ;; and cleanup.  So, we set the buffer-local [whitespace-style] to the way we want
  ;; highlighting to happen, and then use a temporary dynamic binding to set
  ;; [whitespace-style] to what we want for cleanup during file save.
  (require 'whitespace)
  ;; the following line fixes a bug in whitespace.el
  (set (make-local-variable 'whitespace-indent-tabs-mode) indent-tabs-mode)
  (defvar jane-highlight-whitespace-style '(lines-tail)
Determines how whitespace is highlighted in OCaml code and C
code.  See the documentation for whitespace-style for allowed
  (defun jane-highlight-whitespace ()
    (setq whitespace-line-column 90)
    (setq whitespace-style jane-highlight-whitespace-style)
    ;; Must set [whitespace-line-column] and [whitespace-style] before calling
    ;; [whitespace-mode].
    (whitespace-mode 1))
  (add-hook 'c-mode-hook 'jane-highlight-whitespace)
  (add-hook 'tuareg-mode-hook 'jane-highlight-whitespace)
  (defvar jane-cleanup-whitespace-in-these-major-modes '(c-mode tuareg-mode)
The modes that use the Jane rules for cleaning up whitespace on
file save.")
  (defvar jane-cleanup-whitespace-style '(trailing)
A list of atoms that determines how whitespace is cleaned up on
file save.  See the documentation for whitespace-cleanup for
allowed values.
  (add-hook 'before-save-hook 'jane-whitespace-cleanup)
  (defun jane-whitespace-cleanup ()
Clean up whitespace in certain modes when saving a file, using
    (when (member major-mode jane-cleanup-whitespace-in-these-major-modes)
      (let ((whitespace-style jane-cleanup-whitespace-style))
(provide 'jane-common)