Stephen Weeks avatar Stephen Weeks committed ab31b2a Merge

auto merge

Comments (0)

Files changed (9)

RELEASE_PROCEDURE

 
 * Try getenv, setenv, and toggle with restarts to make sure the variables
   are being set properly
+
 * Window selection
-Experiments with two frames
 
 F1   = F1 contents before next-error
 F2   = F2 contents before next-error
 s-w' = the selected window after next-error
 X    = I think disagrees with the spec
 
+Experiments with two frames
+
  | F1        | F2        | n-e | F1'       | X | F2'       | X | s-w' | X |
  |-----------+-----------+-----+-----------+---+-----------+---+------+---|
  | code      | *scratch* | F1  | split     |   | *scratch* |   | code |   |

elisp-for-ocaml-programmers.el

-
-;; This file contains utilities for emacs-lisp programming with the
-;; function naming conventions of OCaml code at Jane Street.  The most
-;; important features are `defunl' and `letl' for defining lexically
-;; scoped functions.
-
-;;; NOTES:
-;;
-;; Conventions due to dynamic scope hell.
-;;
-;; We must be careful with function arguments and local variables due to dynamic scope.
-;; (defun List.iter (f l)
-;;   (mapc f l)
-;;   nil)
-;;
-;; (defun List.iteri (f l)
-;;   (let ((ctr 0))
-;;     (List.iter (lambda (b)
-;;                  (funcall f ctr b)
-;;                  (setq ctr (+ ctr 1))) l)))
-;;
-;; This definition of List.iteri fails.  In (List.iteri g l)
-;; `f' is bound to g in the beginning of the body of List.iteri, but when List.iter
-;; is called, f gets rebound to (lambda (b) ...).  Thus the funcall fails
-;; because it expects only 1 argument.
-;;
-;; For example
-;;
-;; (defun List.iteri (f l)
-;;   (let ((ctr 0))
-;;     (List.iter (lambda (x)
-;;                  (funcall f ctr x)
-;;                  (setq ctr (+ ctr 1))) l)))
-;;
-;; (let ((ctr 0))
-;;   (List.iteri (lambda (i x) (setq ctr (+ ctr i x))) '(1 1 1 1 1))
-;;   (Jane.test ctr 15))
-;;
-;; This test fails, as `ctr' is rebound in the body of List.iteri.
-;;
-;; To avoid this, for any higher-order function we use `letl'
-;; to define local variables and `defunl' to define the function.
-
-;; Don't show warnings that cl is being used at runtime
-;; Using the cl package at runtime is considered bad style among
-;; purist emacs-lisp hackers.
-;; http://www.gnu.org/software/emacs/manual/html_node/cl/Overview.html
-;; In particular:
-;;
-;;   Please note: the CL functions are not standard parts of the Emacs Lisp name
-;;   space, so it is legitimate for users to define them with other, conflicting
-;;   meanings. To avoid conflicting with those user activities, we have a policy that
-;;   packages installed in Emacs must not load CL at run time. (It is ok for them to
-;;   load CL at compile time only, with eval-when-compile, and use the macros it
-;;   provides.) If you are writing packages that you plan to distribute and invite
-;;   widespread use for, you might want to observe the same rule.
-;;
-;; I don't think there's any reason to reimplement efficient folds just
-;; to avoid importing cl.  It seems to be another internecine war
-;; among Emacs factions.
-
-(require 'bytecomp)
-(setq byte-compile-warnings (remove 'cl-functions byte-compile-warning-types))
-(require 'cl)
-
-
-;; Util
-
-(defun Jane.test (e1 e2)
-  (assert (equal e1 e2))
-  t)
-
-(defmacro Jane.with-current-directory (dir &rest form)
-  (declare (indent defun))
-  (declare (debug (stringp body)))
-  ;; We [expand-file-name] so that a relative [dir] will work.  We use a trailing "/"
-  ;; because otherwise the last arc in the path is dropped.
-  `(let ((default-directory (format "%s/" (expand-file-name ,dir))))
-     ,@form))
-
-(defmacro Emacs.protect-from-quit (&rest form)
-  (declare (indent defun))
-  (declare (debug (body)))
-  `(let ((inhibit-quit t))
-     ,@form))
-
-(defun nequal (x y) (not (equal x y)))
-
-
-;; Lexical defun and let
-
-(defmacro defunl (name arglist &rest body)
-  "Lexical defun.  Not for use with interactive functions"
-  (declare (indent defun))
-  (let* (;; remove &optional and &rest
-         (args (remove-if
-                (lambda (s) (equal (substring (symbol-name s) 0 1) "&"))
-                arglist))
-         (args (mapcar (lambda (arg) (list arg arg)) args))
-         ;; put the doc string before the lexical-let
-         (doc_body (if (and (> (length body) 1)
-                            (stringp (car body)))
-                       `(,(car body) . ,(cdr body))
-                     `(nil . ,body)))
-         (doc (car doc_body))
-         (body (cdr doc_body)))
-    `(defun ,name ,arglist
-       ,(if doc doc)
-       (lexical-let
-           ,args
-         ,@body))))
-;; (macroexpand '(defunl f (x y) (+ x y)))
-;; (macroexpand '(defunl f (x y) "abc" (+ x y)))
-
-(def-edebug-spec defunl
-  (&define name lambda-list
-           [&optional stringp]   ; Match the doc string, if present.
-           [&optional ("interactive" interactive)]
-           def-body))
-
-(defmacro letl (varlist &rest body)
-  (declare (indent 1))
-  `(lexical-let ,varlist ,@body))
-;; (macroexpand '(letl ((x 5)) (+ x x)))
-;; (letl ((x 5)) (+ x x))
-
-(def-edebug-spec letl
-  ((&rest
-    &or symbolp (gate symbolp &optional form))
-   body))
-
-(defmacro letl* (varlist &rest body)
-  (declare (indent 1))
-  (declare (debug (form &rest form)))
-  `(lexical-let* ,varlist ,@body))
-
-(def-edebug-spec letl*
-  ((&rest
-    &or symbolp (gate symbolp &optional form))
-   body))
-
-(font-lock-add-keywords
- 'emacs-lisp-mode
- '(("\\<\\(defunl\\)" 1 font-lock-keyword-face)
-   ("\\<\\(letl\\*?\\)" 1 font-lock-keyword-face))
- t)
-
-
-;; Options
-
-(defun Option.value (x default) (if x x default))
-
-
-;; Lists
-
-;; Ahh, the beauty of dynamic scoping.  Uniquify variable names by appending
-;; the defining function name.  Blech...
-
-(defunl List.foldr (f b l)
-  (reduce f l :initial-value b :from-end t))
-(Jane.test (List.foldr 'concat "" '("a" "b" "c")) "abc")
-(Jane.test (List.foldr 'cons nil '(1 2 3)) '(1 2 3))
-(Jane.test (List.foldr (lambda (x y) (- x y)) 0 '(1 2 3)) 2)
-
-(defunl List.foldl (f b l)
-  (reduce f l :initial-value b))
-(Jane.test (List.foldl 'concat "" '("a" "b" "c")) "abc")
-(Jane.test (List.foldl 'cons nil '("a" "b" "c")) '(((nil . "a") . "b") . "c"))
-(Jane.test (List.foldl (lambda (x y) (- x y)) 0 '(1 2 3)) -6)
-
-(defunl List.filter (f l) (remove-if-not f l))
-(Jane.test (List.filter (lambda (x) (> x 3)) '(1 2 3 4 5 6)) '(4 5 6))
-
-(defunl List.find (f l)
-  (if (null l) nil
-    (let ((hd (car l))
-          (tl (cdr l)))
-      (if (funcall f hd) hd (List.find f tl)))))
-(Jane.test (List.find (lambda (x) (> x 3)) '()) nil)
-(Jane.test (List.find (lambda (x) (> x 3)) '(1 2 3 4 5 6)) 4)
-
-(defunl List.exists (p l)
-  (if (List.find p l) t nil))
-(Jane.test (List.exists (lambda (x) (< x 10)) '(1 2 3 4 5)) t)
-(Jane.test (List.exists (lambda (x) (> x 10)) '(1 2 3 4 5)) nil)
-
-(defunl List.mem (l x)
-  (not (null (List.find (lambda (y) (equal x y)) l))))
-(Jane.test (List.mem '(1 2 3) 4) nil)
-(Jane.test (List.mem '(1 2 3 4) 4) t)
-
-(defunl List.assoc (x l)
-  (let ((res (assoc x l)))
-    (when res (cdr res))))
-(Jane.test (List.assoc 5 '((5 . 6) (1 . 3))) 6)
-(Jane.test (List.assoc 5 '((5 6) (1 3))) '(6))
-
-(defunl List.iter (f l) (mapc f l) nil)
-(let ((ctr 0))
-  (List.iter (lambda (x) (setq ctr (+ ctr x))) '(1 2 3 4 5))
-  (Jane.test ctr 15))
-
-(defunl List.iteri (f l)
-  (letl ((ctr 0))
-    (List.iter (lambda (x)
-                 (funcall f ctr x)
-                 (setq ctr (+ ctr 1))) l)))
-(let ((ctr 0))
-  (List.iteri (lambda (i x) (setq ctr (+ ctr i x))) '(1 1 1 1 1))
-  (Jane.test ctr 15))
-
-(defunl List.concat (l) (apply 'append l))
-(Jane.test (List.concat '((1 2) (3 4) (5 6))) '(1 2 3 4 5 6))
-
-(defunl List.map (f l) (mapcar f l))
-(Jane.test (List.map '1+ '(1 2 3)) '(2 3 4))
-
-(defunl List.mapi (f l)
-  (letl ((i 0))
-    (mapcar (lambda (x)
-              (letl ((y (funcall f i x)))
-                (setq i (1+ i))
-                y)) l)))
-(Jane.test (List.mapi (lambda (i _) i) '(0 0 0)) '(0 1 2))
-(Jane.test (List.mapi (lambda (a b) (+ a b)) '(1 2 3)) '(1 3 5))
-
-(defunl List.upto-aux (n from acc)
-  (if (< n from) acc
-    (List.upto-aux (1- n) from (cons n acc))))
-
-(defunl List.upto (n &optional from)
-  (let ((from (if from from 0)))
-    (if (< n from) nil (List.upto-aux n from nil))))
-
-(Jane.test (List.upto 3) '(0 1 2 3))
-(Jane.test (List.upto 3 2) '(2 3))
-
-(defunl List.concat-map (f l)
-  (apply 'append (List.map f l)))
-(Jane.test (List.concat-map 'List.upto '(0 1 2)) '(0 0 1 0 1 2))
-
-(defunl List.filter-map (f l)
-  (List.foldr (lambda (x acc)
-                (let ((y (apply f (list x))))
-                  (if y (cons y acc) acc)))
-              () l))
-(Jane.test (List.filter-map (lambda (x) (if (< x 4) (1+ x) nil)) '(1 2 3 4 5)) '(2 3 4))
-
-(defunl List.partition (p l)
-  (List.foldr (lambda (x acc)
-                (let ((yes (car acc))
-                      (no  (cdr acc))
-                      (res (funcall p x)))
-                  (if res
-                      (cons (cons x yes) no)
-                    (cons yes (cons x no)))))
-              (cons nil nil) l))
-(Jane.test (List.partition (lambda (x) (< x 4)) '(1 2 3 4 5)) '((1 2 3) . (4 5)))
-
-(defunl List.inter (l1 l2)
-  (List.filter (lambda (x) (List.mem l2 x)) l1))
-(Jane.test (List.inter '(1 2 3) '(2 3 4)) '(2 3))
-(Jane.test (List.inter '(1 2 3) '()) '())
-
-(defunl List.intersperse (sep l)
-  (if (null l) l
-    (cons (car l)
-          (apply 'append (mapcar (lambda (x) (list sep x)) (cdr l))))))
-(Jane.test (List.intersperse 5 '()) '())
-(Jane.test (List.intersperse 5 '(1)) '(1))
-(Jane.test (List.intersperse 5 '(1 2)) '(1 5 2))
-(Jane.test (List.intersperse 5 '(1 2 3)) '(1 5 2 5 3))
-
-(defunl List.last (l)
-  (car (last l)))
-(Jane.test (List.last '()) nil)
-(Jane.test (List.last '(1 2 3)) 3)
-
-(defunl List.take (l n)
-  (cond
-   ((equal n 0) nil)
-   ((equal l nil) nil)
-   (t (cons (car l) (List.take (cdr l) (1- n))))))
-(Jane.test (List.take '(1 2 3 4) 2) '(1 2))
-(Jane.test (List.take '(1 2 3 4) 6) '(1 2 3 4))
-
-(defunl List.drop (l n)
-  (cond
-   ((equal n 0) l)
-   ((equal l nil) nil)
-   (t (List.drop (cdr l) (1- n)))))
-(Jane.test (List.drop '(1 2 3 4) 2) '(3 4))
-(Jane.test (List.drop '(1 2 3 4) 6) '())
-
-(defunl List.butlast (l)
-  (let ((zero-or-one (lambda (l) (or (null l) (null (cdr l))))))
-  (cond
-   ((null l) nil)
-   ((null (cdr l)) nil)
-   (t (cons (car l) (List.butlast (cdr l)))))))
-(Jane.test (List.butlast '(1 2 3 4)) '(1 2 3))
-
-
-;; Strings
-
-(defun String.strip-newlines (s)
-  (if (null s) nil
-    (assert (string-or-null-p s) "strip-newlines: %s" s)
-    (replace-regexp-in-string "\n" "" s)))
-(Jane.test (String.strip-newlines nil) nil)
-(Jane.test (String.strip-newlines "a\nb\nc") "abc")
-
-(defun String.truncate (s n)
-  (let ((k (length s)))
-    (if (< k n) s
-      (substring s 0 n))))
-(Jane.test (String.truncate "abcdef" 3) "abc")
-(Jane.test (String.truncate "abcdef" 300) "abcdef")
-
-(defun String.lines (s)
-  (split-string s "\n"))
-(Jane.test (String.lines "a\nb\nc") '("a" "b" "c"))
-(Jane.test (String.lines "abc") '("abc"))
-(Jane.test (String.lines "\n") '("" ""))
-
-(defun String.strip (s)
-  "Replace space before and after a string"
-  (let ((s (replace-regexp-in-string "^[[:space:]]*" "" s)))
-    (replace-regexp-in-string "[[:space:]]*$" "" s)))
-(Jane.test (String.strip " abc def ") "abc def")
-
-(defun String.eval (s)
-  "Eval a string as code"
-  (with-temp-buffer (insert s) (eval-buffer)))
-;; Can't test.  Always returns nil.
-
-(defun String.escaped (s)
-  "Escape newlines and quotes"
-  (let ((tab '(("\n" . "\\\\n")
-               ;;("\"" . "\\\\\"")
-               )))
-    (List.foldl (lambda (s p)
-                  (let ((l (car p))
-                        (r (cdr p)))
-                    (replace-regexp-in-string l r s)))
-                s tab)))
-(Jane.test (String.escaped "abc\ndef\"ghi\"") "abc\\ndef\"ghi\"")
-(Jane.test (String.escaped "abc") "abc")
-
-
-;; Hash tables
-
-(setq tbl (make-hash-table :test 'equal))
-(puthash 'a 5 tbl)
-(puthash 'b 6 tbl)
-(puthash 'c 7 tbl)
-
-(defun Hashtbl.to-alist (tbl)
-  (let ((data nil))
-    (maphash (lambda (k v) (setq data (cons `(,k ,v) data))) tbl)
-    (reverse data)))
-(Jane.test (Hashtbl.to-alist tbl) '((a 5) (b 6) (c 7)))
-
-(defun Hashtbl.keys (tbl)
-  (List.map 'car (Hashtbl.to-alist tbl)))
-(Jane.test (Hashtbl.keys tbl) '(a b c))
-
-(defun Hashtbl.data (tbl)
-  (List.map 'cadr (Hashtbl.to-alist tbl)))
-(Jane.test (Hashtbl.data tbl) '(5 6 7))
-
-(defunl Hashtbl.iter (f tbl)
-  (maphash f tbl))
-(let ((ctr 0))
-  (Hashtbl.iter (lambda (_ x) (setq ctr (+ ctr x))) tbl)
-  (Jane.test ctr 18))
-
-
-;; Shell
-
-(defun Shell.readlink (path)
-  "Canonize the path by eliminating symlinks and dots"
-  (if (not path) nil
-    (let ((res (String.strip-newlines
-                (shell-command-to-string (format "readlink -f %s" path)))))
-      (if (equal res "") nil res))))
-;; (Shell.readlink "/usr/../home")
-;; (Shell.readlink "/usr/local//share")
-;; (Shell.readlink "/..")
-;; (Shell.readlink "/...")
-;; (Shell.readlink "/../.")
-;; (Shell.readlink nil)
-
-(defun Shell.dirname (path)
-  (if (not path) nil
-    (let ((res (String.strip-newlines
-                (shell-command-to-string (format "dirname %s" path)))))
-      (if (equal res "") nil res))))
-;; (Shell.dirname nil)
-;; (Shell.dirname "/")
-;; (Shell.dirname "/a/b")
-;; (Shell.dirname "/../b")
-
-(defun Shell.basename (path)
-  (if (not path) nil
-    (let ((res (String.strip-newlines
-                (shell-command-to-string (format "basename %s" path)))))
-      (if (equal res "") nil res))))
-;; (Shell.basename "/a/b/c")
-;; (Shell.basename "/")
-;; (Shell.basename "/../b")
-
-(defun Shell.mail (subject addr body)
-  (shell-command-to-string (format "echo \"%s\" | mail -s \"%s\" \"%s\"" body subject addr))
-  nil)
-;; (Shell.mail "test" "smclaughlin@janestreet.com" "abc")
-
-
-;; Buffers
-
-(defun Buffer.name (buffer-or-name)
-  "Allow the (string) name of a buffer to be passed to buffer-name"
-  (if (bufferp buffer-or-name) (buffer-name buffer-or-name) buffer-or-name))
-;; (Buffer.name nil)
-;; (Buffer.name "abc")
-;; (Buffer.name (get-buffer "*shell*"))
-
-(defun Buffer.safe-get (buffer-or-name)
-  "Allow the (string) name of a buffer to be passed to buffer-name"
-  (if (bufferp buffer-or-name) (buffer-name buffer-or-name) buffer-or-name))
-
-(defun Buffer.get (buffer-or-name)
-  "get-buffer that returns nil on a nil argument"
-  (if (null buffer-or-name) nil (get-buffer buffer-or-name)))
-
-(defun Buffer.kill (buffer-or-name)
-  "Kill a buffer.  Don't raise an exception of there is no such buffer.
-Just return nil.  This is the spec of `kill-buffer', but the former
-raises an exception."
-  (condition-case nil
-      (kill-buffer buffer-or-name)
-    (error nil)))
-;;(Buffer.kill "abc")
-;;(Buffer.kill "abcccc")
-
-(defun Buffer.kill-no-query-no-hooks (&optional buffer-or-name)
-  (interactive)
-  "Kill a buffer without any questions.  If there's no such buffer, just
-return nil"
-  (let ((buffer-or-name (if buffer-or-name buffer-or-name (current-buffer)))
-        (funs kill-buffer-query-functions)
-        (hook kill-buffer-hook))
-    (unwind-protect
-        (progn
-          (setq kill-buffer-query-functions nil)
-          (setq kill-buffer-hook nil)
-          (Buffer.kill buffer-or-name))
-      (setq kill-buffer-query-functions funs)
-      (setq kill-buffer-hook hook))))
-;;(Buffer.kill-no-query "*Backtrace*")
-
-(defun Buffer.num-lines (buf)
-  (save-excursion
-    (with-current-buffer buf
-      (count-lines (point-min) (point-max)))))
-;; (Buffer.num-lines path)
-
-(defun Buffer.clear (buffer)
-  "Remove all contents of a given buffer"
-  (with-current-buffer buffer
-    (delete-region (point-min) (point-max))))
-
-
-;; Filename
-
-(defun Filename.strip-final-slash (path)
-  "/a/b/c/ ---> /a/b/c"
-  (let ((n (length path)))
-    (if (equal (elt path (- n 1)) ?/)
-        (substring path 0 (- n 1))
-      path)))
-;; (Filename.strip-final-slash "/a/b/c")
-;; (Filename.strip-final-slash "/a/b/c/")
-
-(defun Filename.root-dir-p (path) (equal (Shell.readlink path) "/"))
-;; (Filename.root-dir-p nil)
-;; (Filename.root-dir-p "/")
-;; (Filename.root-dir-p "/usr/local/../../")
-
-(defun Filename.up1-dir (dir)
-  "Go up 1 directory.  The input must be an existing directory."
-  (if (null dir) (Emacs.error "up1-dir: %s" dir)
-    (assert (file-directory-p dir))
-    (Shell.readlink (concat dir "/.."))))
-;; (Filename.up1-dir nil)
-;; (Filename.up1-dir "/")
-;; (Filename.up1-dir "/doesnt-exist")
-;; (Filename.up1-dir "/usr/local")
-
-(defun Filename.directory-of (file-or-dir)
-  "Get the directory of a path.  If a file, give the enclosing dir.
-If a dir, return the dir"
-  (if (null file-or-dir) (Emacs.error "directory-of: %s" file-or-dir)
-    (let ((res (if (file-directory-p file-or-dir)
-                   file-or-dir
-                 (Shell.dirname file-or-dir))))
-      (assert (file-directory-p res))
-      (Shell.readlink res))))
-;; (Filename.directory-of nil)
-;; (Filename.directory-of "/usr/local")
-;; (Filename.directory-of "~/tmp")
-;; (Filename.directory-of "/usr/local/a.txt")
-
-(defun Filename.default-directory ()
-  (Filename.strip-final-slash default-directory))
-;; (Filename.strip-final-slash "/home/sweeks/jane/base/core/lib_test/")
-
-
-;; Windows
-
-(defun Window.select-another-window (&optional w)
-  "Select a window other than w.  Return nil if there is no such window."
-  (let ((w (if w w (selected-window))))
-    (get-window-with-predicate (lambda (w1) (not (equal w w1))) nil t)))
-
-(defun Window.all-visible ()
-  "Return all visible windows in all visible frames."
-  (apply 'append (mapcar (lambda (f) (window-list f "no-mini")) (frame-list))))
-;; (Window.all-visible)
-
-
-;; Timers
-
-(defunl Timer.handle-exn (f handler)
-  (assert (functionp f))
-  (assert (functionp handler))
-  (condition-case err
-      (funcall f)
-    ((error arith-error)
-     (funcall handler err))))
-
-(defunl Timer.run (secs repeat f handler)
-  (lexical-let*
-      ((f f)
-       (handler handler)
-       (fn (lambda () (Timer.handle-exn f handler))))
-    (run-with-timer secs repeat fn)))
-
-;; (defun tmp () (error "bug"))
-;; (defun tmp-handler (err)
-;; (tmp)
-;; (tmp-handler nil)
-;; (setq timer (Timer.run 1 1 'tmp 'tmp-handler))
-;; (Timer.handle-exn 'tmp 'tmp-handler)
-;; (Timer.handle-exn (lambda () (error "bug"))
-;;                   (lambda (err) (message "tmp raised an exn: %s" err)))
-;; (setq timer
-;;       (Timer.run 1 1
-;;                  (lambda () (error "bug"))
-;;                  (lambda (err) (message "tmp raised an exn: %s" err))))
-;; (cancel-timer timer)
-
-
-;; Logging
-;; inspired by log-buffer.el Cedric Lallain <kandjar76@hotmail.com>
-
-(defun Log.create (buffer-name)
-  "Create a new log buffer, called BUFFER-NAME.
-If BUFFER-NAME already exist, the function will just set the read-only flag.
-The log buffer is returned as a result of this call."
-  (let ((buffer (get-buffer-create buffer-name)))
-    (with-current-buffer buffer (toggle-read-only 1))
-    buffer))
-
-(defconst Log.buffer-max-size 100000
-  "Max size of the log buffer in characters")
-
-(defun Log.printf(log-buffer format-string &rest args)
-  "Display the text in the log buffer at the very end of it."
-  (let ((inhibit-read-only t) ;; the log is probably read-only
-	(auto-window-vscroll t)
-	(kill-whole-line t) ;; kill the newline as well as the line contents
-        (fmt (concat "[%s] " format-string "\n"))
-        (time (format-time-string "%y/%m/%d %H:%M:%S" (current-time)))
-	(user-buffer (current-buffer))
-	(user-window (selected-window))
-	(log-window (get-buffer-window log-buffer)))
-    (with-current-buffer log-buffer
-      (let* ((marker (point-marker))
-             (log-point (point))
-             (at-bottom (= log-point (point-max))))
-        ;; insert the log message on the last line
-        (goto-char (point-max))
-        (insert (apply 'format (cons fmt (cons time args))))
-        ;; maybe delete the first line of the log
-        (when (> (buffer-size log-buffer) Log.buffer-max-size)
-          (let ((beg (point-min)))
-            (goto-char (point-min))
-            (forward-line 1)
-            (delete-region beg (point))))
-        ;; restore window point
-        (when log-window
-          (if at-bottom
-              (progn (select-window log-window)
-                     (goto-char (point-max))
-                     (recenter (1- (window-body-height log-window))))
-            (goto-char (marker-position marker)))
-          (select-window user-window))
-        (set-marker marker nil)))))
-;; (Omake.Server.logf "sean: %s %d" "abc" 8)
-
-
-;; Misc commands
-
-(defun Emacs.grab-line ()
-  "Grab the line of point"
-  (interactive)
-  (save-excursion
-    (end-of-line)
-    (let ((end (point)))
-      (beginning-of-line)
-      (buffer-substring-no-properties (point) end))))
-
-(defun Buffer.last-lines (buffer-or-name n)
-  "return the last N lines of a buffer"
-  (save-excursion
-    (with-current-buffer buffer-or-name
-      (goto-char (point-max))
-      (let* ((aux nil) ;; dummy for compilation warning
-             (aux (lambda (k)
-                    (if (equal k 0) nil
-                      (let* ((l (Emacs.grab-line))
-                             (res (forward-line -1))
-                             (rest (when (equal res 0) (funcall aux (- k 1)))))
-                        (cons l rest))))))
-        (reverse (funcall aux n))))))
-;; (length (Buffer.last-lines "*Help*" 10))
-;; (with-current-buffer "tmp" (goto-char (point-min) (Emacs.grab-line)))
-
-(defun Buffer.goto-line (n)
-  (goto-char (point-min))
-  (forward-line (1- n)))
-
-(defun Emacs.error (str &rest args)
-  (error (concat "[ERROR] " str) args))
-
-(defun Emacs.window-buffers ()
-  "Get all buffers being displayed in a window"
-  (List.map 'window-buffer (window-list)))
-
-(defun Emacs.window-files ()
-  "Get the file names of all buffers being displayed in a window"
-  (List.filter-map 'buffer-file-name (Emacs.window-buffers)))
-
-(defun Emacs.add-hook-append (hook f) (add-hook hook f t))
-
-(defun Emacs.insert (s)
-  "Don't raise an exception when s is nil"
-  (when s (insert s)))
-
-(defun Emacs.color (s face) (propertize s 'face face))
-
-(defun Overlay.delete-soon (overlay)
-  "Set an overlay for some period of time"
-  (unwind-protect
-      (sit-for 60)
-    (delete-overlay overlay)))
-
-(defun Emacs.y-or-n-p (prompt)
-  (let ((result (y-or-n-p prompt)))
-    ;; The [(message nil)] is necessary to clear the minibuffer.
-    (message nil)
-    result))
-
-(defun Emacs.insert-object (x) (insert (prin1-to-string x)))
-;; (Emacs.insert-object "sean")
-
-(defun File.byte-compile-check ()
-  (interactive)
-  (let ((file (read-file-name "File: ")))
-    (byte-compile-file file)
-    (message "removing compiled file")
-    (remove-file (concat file "c"))))
-
-
-;; Hg
-
-(defun hg-resolve-file ()
-  (interactive)
-  "Run 'hg resolve -m' on the current file"
-  (let* ((file (buffer-file-name (current-buffer))))
-    (shell-command (format "hg resolve -m %s" file))))
-
-(require 'dired)
-(defun hg-resolve-file-dired ()
-  (interactive)
-  "Run 'hg resolve -m' on the current file in a dired buffer"
-  (let* ((file (dired-file-name-at-point)))
-    (shell-command (format "hg resolve -m %s" file))))
-
-(provide 'elisp-for-ocaml-programmers)
+
+;; This file contains utilities for emacs-lisp programming with the
+;; function naming conventions of OCaml code at Jane Street.  The most
+;; important features are `defunl' and `letl' for defining lexically
+;; scoped functions.
+
+;;; NOTES:
+;;
+;; Conventions due to dynamic scope hell.
+;;
+;; We must be careful with function arguments and local variables due to dynamic scope.
+;; (defun List.iter (f l)
+;;   (mapc f l)
+;;   nil)
+;;
+;; (defun List.iteri (f l)
+;;   (let ((ctr 0))
+;;     (List.iter (lambda (b)
+;;                  (funcall f ctr b)
+;;                  (setq ctr (+ ctr 1))) l)))
+;;
+;; This definition of List.iteri fails.  In (List.iteri g l)
+;; `f' is bound to g in the beginning of the body of List.iteri, but when List.iter
+;; is called, f gets rebound to (lambda (b) ...).  Thus the funcall fails
+;; because it expects only 1 argument.
+;;
+;; For example
+;;
+;; (defun List.iteri (f l)
+;;   (let ((ctr 0))
+;;     (List.iter (lambda (x)
+;;                  (funcall f ctr x)
+;;                  (setq ctr (+ ctr 1))) l)))
+;;
+;; (let ((ctr 0))
+;;   (List.iteri (lambda (i x) (setq ctr (+ ctr i x))) '(1 1 1 1 1))
+;;   (Jane.test ctr 15))
+;;
+;; This test fails, as `ctr' is rebound in the body of List.iteri.
+;;
+;; To avoid this, for any higher-order function we use `letl'
+;; to define local variables and `defunl' to define the function.
+
+;; Don't show warnings that cl is being used at runtime
+;; Using the cl package at runtime is considered bad style among
+;; purist emacs-lisp hackers.
+;; http://www.gnu.org/software/emacs/manual/html_node/cl/Overview.html
+;; In particular:
+;;
+;;   Please note: the CL functions are not standard parts of the Emacs Lisp name
+;;   space, so it is legitimate for users to define them with other, conflicting
+;;   meanings. To avoid conflicting with those user activities, we have a policy that
+;;   packages installed in Emacs must not load CL at run time. (It is ok for them to
+;;   load CL at compile time only, with eval-when-compile, and use the macros it
+;;   provides.) If you are writing packages that you plan to distribute and invite
+;;   widespread use for, you might want to observe the same rule.
+;;
+;; I don't think there's any reason to reimplement efficient folds just
+;; to avoid importing cl.  It seems to be another internecine war
+;; among Emacs factions.
+
+(require 'bytecomp)
+(setq byte-compile-warnings (remove 'cl-functions byte-compile-warning-types))
+(require 'cl)
+
+
+;; Util
+
+(defun Jane.test (e1 e2)
+  (assert (equal e1 e2))
+  t)
+
+(defmacro Jane.with-current-directory (dir &rest form)
+  (declare (indent defun))
+  (declare (debug (stringp body)))
+  ;; We [expand-file-name] so that a relative [dir] will work.  We use a trailing "/"
+  ;; because otherwise the last arc in the path is dropped.
+  `(let ((default-directory (format "%s/" (expand-file-name ,dir))))
+     ,@form))
+
+(defmacro Emacs.protect-from-quit (&rest form)
+  (declare (indent defun))
+  (declare (debug (body)))
+  `(let ((inhibit-quit t))
+     ,@form))
+
+(defun nequal (x y) (not (equal x y)))
+
+
+;; Lexical defun and let
+
+(defmacro defunl (name arglist &rest body)
+  "Lexical defun.  Not for use with interactive functions"
+  (declare (indent defun))
+  (let* (;; remove &optional and &rest
+         (args (remove-if
+                (lambda (s) (equal (substring (symbol-name s) 0 1) "&"))
+                arglist))
+         (args (mapcar (lambda (arg) (list arg arg)) args))
+         ;; put the doc string before the lexical-let
+         (doc_body (if (and (> (length body) 1)
+                            (stringp (car body)))
+                       `(,(car body) . ,(cdr body))
+                     `(nil . ,body)))
+         (doc (car doc_body))
+         (body (cdr doc_body)))
+    `(defun ,name ,arglist
+       ,(if doc doc)
+       (lexical-let
+           ,args
+         ,@body))))
+;; (macroexpand '(defunl f (x y) (+ x y)))
+;; (macroexpand '(defunl f (x y) "abc" (+ x y)))
+
+(def-edebug-spec defunl
+  (&define name lambda-list
+           [&optional stringp]   ; Match the doc string, if present.
+           [&optional ("interactive" interactive)]
+           def-body))
+
+(defmacro letl (varlist &rest body)
+  (declare (indent 1))
+  `(lexical-let ,varlist ,@body))
+;; (macroexpand '(letl ((x 5)) (+ x x)))
+;; (letl ((x 5)) (+ x x))
+
+(def-edebug-spec letl
+  ((&rest
+    &or symbolp (gate symbolp &optional form))
+   body))
+
+(defmacro letl* (varlist &rest body)
+  (declare (indent 1))
+  (declare (debug (form &rest form)))
+  `(lexical-let* ,varlist ,@body))
+
+(def-edebug-spec letl*
+  ((&rest
+    &or symbolp (gate symbolp &optional form))
+   body))
+
+(font-lock-add-keywords
+ 'emacs-lisp-mode
+ '(("\\<\\(defunl\\)" 1 font-lock-keyword-face)
+   ("\\<\\(letl\\*?\\)" 1 font-lock-keyword-face))
+ t)
+
+
+;; Options
+
+(defun Option.value (x default) (if x x default))
+
+
+;; Lists
+
+;; Ahh, the beauty of dynamic scoping.  Uniquify variable names by appending
+;; the defining function name.  Blech...
+
+(defunl List.foldr (f b l)
+  (reduce f l :initial-value b :from-end t))
+(Jane.test (List.foldr 'concat "" '("a" "b" "c")) "abc")
+(Jane.test (List.foldr 'cons nil '(1 2 3)) '(1 2 3))
+(Jane.test (List.foldr (lambda (x y) (- x y)) 0 '(1 2 3)) 2)
+
+(defunl List.foldl (f b l)
+  (reduce f l :initial-value b))
+(Jane.test (List.foldl 'concat "" '("a" "b" "c")) "abc")
+(Jane.test (List.foldl 'cons nil '("a" "b" "c")) '(((nil . "a") . "b") . "c"))
+(Jane.test (List.foldl (lambda (x y) (- x y)) 0 '(1 2 3)) -6)
+
+(defunl List.filter (f l) (remove-if-not f l))
+(Jane.test (List.filter (lambda (x) (> x 3)) '(1 2 3 4 5 6)) '(4 5 6))
+
+(defunl List.find (f l)
+  (if (null l) nil
+    (let ((hd (car l))
+          (tl (cdr l)))
+      (if (funcall f hd) hd (List.find f tl)))))
+(Jane.test (List.find (lambda (x) (> x 3)) '()) nil)
+(Jane.test (List.find (lambda (x) (> x 3)) '(1 2 3 4 5 6)) 4)
+
+(defunl List.exists (p l)
+  (if (List.find p l) t nil))
+(Jane.test (List.exists (lambda (x) (< x 10)) '(1 2 3 4 5)) t)
+(Jane.test (List.exists (lambda (x) (> x 10)) '(1 2 3 4 5)) nil)
+
+(defunl List.mem (l x)
+  (not (null (List.find (lambda (y) (equal x y)) l))))
+(Jane.test (List.mem '(1 2 3) 4) nil)
+(Jane.test (List.mem '(1 2 3 4) 4) t)
+
+(defunl List.assoc (x l)
+  (let ((res (assoc x l)))
+    (when res (cdr res))))
+(Jane.test (List.assoc 5 '((5 . 6) (1 . 3))) 6)
+(Jane.test (List.assoc 5 '((5 6) (1 3))) '(6))
+
+(defunl List.iter (f l) (mapc f l) nil)
+(let ((ctr 0))
+  (List.iter (lambda (x) (setq ctr (+ ctr x))) '(1 2 3 4 5))
+  (Jane.test ctr 15))
+
+(defunl List.iteri (f l)
+  (letl ((ctr 0))
+    (List.iter (lambda (x)
+                 (funcall f ctr x)
+                 (setq ctr (+ ctr 1))) l)))
+(let ((ctr 0))
+  (List.iteri (lambda (i x) (setq ctr (+ ctr i x))) '(1 1 1 1 1))
+  (Jane.test ctr 15))
+
+(defunl List.concat (l) (apply 'append l))
+(Jane.test (List.concat '((1 2) (3 4) (5 6))) '(1 2 3 4 5 6))
+
+(defunl List.map (f l) (mapcar f l))
+(Jane.test (List.map '1+ '(1 2 3)) '(2 3 4))
+
+(defunl List.mapi (f l)
+  (letl ((i 0))
+    (mapcar (lambda (x)
+              (letl ((y (funcall f i x)))
+                (setq i (1+ i))
+                y)) l)))
+(Jane.test (List.mapi (lambda (i _) i) '(0 0 0)) '(0 1 2))
+(Jane.test (List.mapi (lambda (a b) (+ a b)) '(1 2 3)) '(1 3 5))
+
+(defunl List.upto-aux (n from acc)
+  (if (< n from) acc
+    (List.upto-aux (1- n) from (cons n acc))))
+
+(defunl List.upto (n &optional from)
+  (let ((from (if from from 0)))
+    (if (< n from) nil (List.upto-aux n from nil))))
+
+(Jane.test (List.upto 3) '(0 1 2 3))
+(Jane.test (List.upto 3 2) '(2 3))
+
+(defunl List.concat-map (f l)
+  (apply 'append (List.map f l)))
+(Jane.test (List.concat-map 'List.upto '(0 1 2)) '(0 0 1 0 1 2))
+
+(defunl List.filter-map (f l)
+  (List.foldr (lambda (x acc)
+                (let ((y (apply f (list x))))
+                  (if y (cons y acc) acc)))
+              () l))
+(Jane.test (List.filter-map (lambda (x) (if (< x 4) (1+ x) nil)) '(1 2 3 4 5)) '(2 3 4))
+
+(defunl List.partition (p l)
+  (List.foldr (lambda (x acc)
+                (let ((yes (car acc))
+                      (no  (cdr acc))
+                      (res (funcall p x)))
+                  (if res
+                      (cons (cons x yes) no)
+                    (cons yes (cons x no)))))
+              (cons nil nil) l))
+(Jane.test (List.partition (lambda (x) (< x 4)) '(1 2 3 4 5)) '((1 2 3) . (4 5)))
+
+(defunl List.inter (l1 l2)
+  (List.filter (lambda (x) (List.mem l2 x)) l1))
+(Jane.test (List.inter '(1 2 3) '(2 3 4)) '(2 3))
+(Jane.test (List.inter '(1 2 3) '()) '())
+
+(defunl List.intersperse (sep l)
+  (if (null l) l
+    (cons (car l)
+          (apply 'append (mapcar (lambda (x) (list sep x)) (cdr l))))))
+(Jane.test (List.intersperse 5 '()) '())
+(Jane.test (List.intersperse 5 '(1)) '(1))
+(Jane.test (List.intersperse 5 '(1 2)) '(1 5 2))
+(Jane.test (List.intersperse 5 '(1 2 3)) '(1 5 2 5 3))
+
+(defunl List.last (l)
+  (car (last l)))
+(Jane.test (List.last '()) nil)
+(Jane.test (List.last '(1 2 3)) 3)
+
+(defunl List.take (l n)
+  (cond
+   ((equal n 0) nil)
+   ((equal l nil) nil)
+   (t (cons (car l) (List.take (cdr l) (1- n))))))
+(Jane.test (List.take '(1 2 3 4) 2) '(1 2))
+(Jane.test (List.take '(1 2 3 4) 6) '(1 2 3 4))
+
+(defunl List.drop (l n)
+  (cond
+   ((equal n 0) l)
+   ((equal l nil) nil)
+   (t (List.drop (cdr l) (1- n)))))
+(Jane.test (List.drop '(1 2 3 4) 2) '(3 4))
+(Jane.test (List.drop '(1 2 3 4) 6) '())
+
+(defunl List.butlast (l)
+  (let ((zero-or-one (lambda (l) (or (null l) (null (cdr l))))))
+  (cond
+   ((null l) nil)
+   ((null (cdr l)) nil)
+   (t (cons (car l) (List.butlast (cdr l)))))))
+(Jane.test (List.butlast '(1 2 3 4)) '(1 2 3))
+
+
+;; Strings
+
+(defun String.strip-newlines (s)
+  (if (null s) nil
+    (assert (string-or-null-p s) "strip-newlines: %s" s)
+    (replace-regexp-in-string "\n" "" s)))
+(Jane.test (String.strip-newlines nil) nil)
+(Jane.test (String.strip-newlines "a\nb\nc") "abc")
+
+(defun String.truncate (s n)
+  (let ((k (length s)))
+    (if (< k n) s
+      (substring s 0 n))))
+(Jane.test (String.truncate "abcdef" 3) "abc")
+(Jane.test (String.truncate "abcdef" 300) "abcdef")
+
+(defun String.lines (s)
+  (split-string s "\n"))
+(Jane.test (String.lines "a\nb\nc") '("a" "b" "c"))
+(Jane.test (String.lines "abc") '("abc"))
+(Jane.test (String.lines "\n") '("" ""))
+
+(defun String.strip (s)
+  "Replace space before and after a string"
+  (let ((s (replace-regexp-in-string "^[[:space:]]*" "" s)))
+    (replace-regexp-in-string "[[:space:]]*$" "" s)))
+(Jane.test (String.strip " abc def ") "abc def")
+
+(defun String.eval (s)
+  "Eval a string as code"
+  (with-temp-buffer (insert s) (eval-buffer)))
+;; Can't test.  Always returns nil.
+
+(defun String.escaped (s)
+  "Escape newlines and quotes"
+  (let ((tab '(("\n" . "\\\\n")
+               ;;("\"" . "\\\\\"")
+               )))
+    (List.foldl (lambda (s p)
+                  (let ((l (car p))
+                        (r (cdr p)))
+                    (replace-regexp-in-string l r s)))
+                s tab)))
+(Jane.test (String.escaped "abc\ndef\"ghi\"") "abc\\ndef\"ghi\"")
+(Jane.test (String.escaped "abc") "abc")
+
+
+;; Hash tables
+
+(setq tbl (make-hash-table :test 'equal))
+(puthash 'a 5 tbl)
+(puthash 'b 6 tbl)
+(puthash 'c 7 tbl)
+
+(defun Hashtbl.to-alist (tbl)
+  (let ((data nil))
+    (maphash (lambda (k v) (setq data (cons `(,k ,v) data))) tbl)
+    (reverse data)))
+(Jane.test (Hashtbl.to-alist tbl) '((a 5) (b 6) (c 7)))
+
+(defun Hashtbl.keys (tbl)
+  (List.map 'car (Hashtbl.to-alist tbl)))
+(Jane.test (Hashtbl.keys tbl) '(a b c))
+
+(defun Hashtbl.data (tbl)
+  (List.map 'cadr (Hashtbl.to-alist tbl)))
+(Jane.test (Hashtbl.data tbl) '(5 6 7))
+
+(defunl Hashtbl.iter (f tbl)
+  (maphash f tbl))
+(let ((ctr 0))
+  (Hashtbl.iter (lambda (_ x) (setq ctr (+ ctr x))) tbl)
+  (Jane.test ctr 18))
+
+
+;; Shell
+
+(defun Shell.readlink (path)
+  "Canonize the path by eliminating symlinks and dots"
+  (if (not path) nil
+    (let ((res (String.strip-newlines
+                (shell-command-to-string (format "readlink -f %s" path)))))
+      (if (equal res "") nil res))))
+;; (Shell.readlink "/usr/../home")
+;; (Shell.readlink "/usr/local//share")
+;; (Shell.readlink "/..")
+;; (Shell.readlink "/...")
+;; (Shell.readlink "/../.")
+;; (Shell.readlink nil)
+
+(defun Shell.dirname (path)
+  (if (not path) nil
+    (let ((res (String.strip-newlines
+                (shell-command-to-string (format "dirname %s" path)))))
+      (if (equal res "") nil res))))
+;; (Shell.dirname nil)
+;; (Shell.dirname "/")
+;; (Shell.dirname "/a/b")
+;; (Shell.dirname "/../b")
+
+(defun Shell.basename (path)
+  (if (not path) nil
+    (let ((res (String.strip-newlines
+                (shell-command-to-string (format "basename %s" path)))))
+      (if (equal res "") nil res))))
+;; (Shell.basename "/a/b/c")
+;; (Shell.basename "/")
+;; (Shell.basename "/../b")
+
+(defun Shell.mail (subject addr body)
+  (shell-command-to-string (format "echo \"%s\" | mail -s \"%s\" \"%s\"" body subject addr))
+  nil)
+;; (Shell.mail "test" "smclaughlin@janestreet.com" "abc")
+
+
+;; Buffers
+
+(defun Buffer.name (buffer-or-name)
+  "Allow the (string) name of a buffer to be passed to buffer-name"
+  (if (bufferp buffer-or-name) (buffer-name buffer-or-name) buffer-or-name))
+;; (Buffer.name nil)
+;; (Buffer.name "abc")
+;; (Buffer.name (get-buffer "*shell*"))
+
+(defun Buffer.safe-get (buffer-or-name)
+  "Allow the (string) name of a buffer to be passed to buffer-name"
+  (if (bufferp buffer-or-name) (buffer-name buffer-or-name) buffer-or-name))
+
+(defun Buffer.get (buffer-or-name)
+  "get-buffer that returns nil on a nil argument"
+  (if (null buffer-or-name) nil (get-buffer buffer-or-name)))
+
+(defun Buffer.kill (buffer-or-name)
+  "Kill a buffer.  Don't raise an exception of there is no such buffer.
+Just return nil.  This is the spec of `kill-buffer', but the former
+raises an exception."
+  (condition-case nil
+      (kill-buffer buffer-or-name)
+    (error nil)))
+;;(Buffer.kill "abc")
+;;(Buffer.kill "abcccc")
+
+(defun Buffer.kill-no-query-no-hooks (&optional buffer-or-name)
+  (interactive)
+  "Kill a buffer without any questions.  If there's no such buffer, just
+return nil"
+  (let ((buffer-or-name (if buffer-or-name buffer-or-name (current-buffer)))
+        (funs kill-buffer-query-functions)
+        (hook kill-buffer-hook))
+    (unwind-protect
+        (progn
+          (setq kill-buffer-query-functions nil)
+          (setq kill-buffer-hook nil)
+          (Buffer.kill buffer-or-name))
+      (setq kill-buffer-query-functions funs)
+      (setq kill-buffer-hook hook))))
+;;(Buffer.kill-no-query "*Backtrace*")
+
+(defun Buffer.num-lines (buf)
+  (save-excursion
+    (with-current-buffer buf
+      (count-lines (point-min) (point-max)))))
+;; (Buffer.num-lines path)
+
+(defun Buffer.clear (buffer)
+  "Remove all contents of a given buffer"
+  (with-current-buffer buffer
+    (delete-region (point-min) (point-max))))
+
+
+;; Filename
+
+(defun Filename.strip-final-slash (path)
+  "/a/b/c/ ---> /a/b/c"
+  (let ((n (length path)))
+    (if (equal (elt path (- n 1)) ?/)
+        (substring path 0 (- n 1))
+      path)))
+;; (Filename.strip-final-slash "/a/b/c")
+;; (Filename.strip-final-slash "/a/b/c/")
+
+(defun Filename.root-dir-p (path) (equal (Shell.readlink path) "/"))
+;; (Filename.root-dir-p nil)
+;; (Filename.root-dir-p "/")
+;; (Filename.root-dir-p "/usr/local/../../")
+
+(defun Filename.up1-dir (dir)
+  "Go up 1 directory.  The input must be an existing directory."
+  (if (null dir) (Emacs.error "up1-dir: %s" dir)
+    (assert (file-directory-p dir))
+    (Shell.readlink (concat dir "/.."))))
+;; (Filename.up1-dir nil)
+;; (Filename.up1-dir "/")
+;; (Filename.up1-dir "/doesnt-exist")
+;; (Filename.up1-dir "/usr/local")
+
+(defun Filename.directory-of (file-or-dir)
+  "Get the directory of a path.  If a file, give the enclosing dir.
+If a dir, return the dir"
+  (if (null file-or-dir) (Emacs.error "directory-of: %s" file-or-dir)
+    (let ((res (if (file-directory-p file-or-dir)
+                   file-or-dir
+                 (Shell.dirname file-or-dir))))
+      (assert (file-directory-p res))
+      (Shell.readlink res))))
+;; (Filename.directory-of nil)
+;; (Filename.directory-of "/usr/local")
+;; (Filename.directory-of "~/tmp")
+;; (Filename.directory-of "/usr/local/a.txt")
+
+(defun Filename.default-directory ()
+  (Filename.strip-final-slash default-directory))
+;; (Filename.strip-final-slash "/home/sweeks/jane/base/core/lib_test/")
+
+
+;; Windows
+
+(defun Window.select-another-window (&optional w)
+  "Select a window other than w.  Return nil if there is no such window."
+  (let ((w (if w w (selected-window))))
+    (get-window-with-predicate (lambda (w1) (not (equal w w1))) nil t)))
+
+(defun Window.all-visible ()
+  "Return all visible windows in all visible frames."
+  (apply 'append (mapcar (lambda (f) (window-list f "no-mini")) (frame-list))))
+;; (Window.all-visible)
+
+
+;; Timers
+
+(defunl Timer.handle-exn (f handler)
+  (assert (functionp f))
+  (assert (functionp handler))
+  (condition-case err
+      (funcall f)
+    ((error arith-error)
+     (funcall handler err))))
+
+(defunl Timer.run (secs repeat f handler)
+  (lexical-let*
+      ((f f)
+       (handler handler)
+       (fn (lambda () (Timer.handle-exn f handler))))
+    (run-with-timer secs repeat fn)))
+
+;; (defun tmp () (error "bug"))
+;; (defun tmp-handler (err)
+;; (tmp)
+;; (tmp-handler nil)
+;; (setq timer (Timer.run 1 1 'tmp 'tmp-handler))
+;; (Timer.handle-exn 'tmp 'tmp-handler)
+;; (Timer.handle-exn (lambda () (error "bug"))
+;;                   (lambda (err) (message "tmp raised an exn: %s" err)))
+;; (setq timer
+;;       (Timer.run 1 1
+;;                  (lambda () (error "bug"))
+;;                  (lambda (err) (message "tmp raised an exn: %s" err))))
+;; (cancel-timer timer)
+
+
+;; Logging
+;; inspired by log-buffer.el Cedric Lallain <kandjar76@hotmail.com>
+
+(defun Log.create (buffer-name)
+  "Create a new log buffer, called BUFFER-NAME.
+If BUFFER-NAME already exist, the function will just set the read-only flag.
+The log buffer is returned as a result of this call."
+  (let ((buffer (get-buffer-create buffer-name)))
+    (with-current-buffer buffer (toggle-read-only 1))
+    buffer))
+
+(defconst Log.buffer-max-size 100000
+  "Max size of the log buffer in characters")
+
+(defun Log.printf(log-buffer format-string &rest args)
+  "Display the text in the log buffer at the very end of it."
+  (let ((inhibit-read-only t) ;; the log is probably read-only
+	(auto-window-vscroll t)
+	(kill-whole-line t) ;; kill the newline as well as the line contents
+        (fmt (concat "[%s] " format-string "\n"))
+        (time (format-time-string "%y/%m/%d %H:%M:%S" (current-time)))
+	(user-buffer (current-buffer))
+	(user-window (selected-window))
+	(log-window (get-buffer-window log-buffer)))
+    (with-current-buffer log-buffer
+      (let* ((marker (point-marker))
+             (log-point (point))
+             (at-bottom (= log-point (point-max))))
+        ;; insert the log message on the last line
+        (goto-char (point-max))
+        (insert (apply 'format (cons fmt (cons time args))))
+        ;; maybe delete the first line of the log
+        (when (> (buffer-size log-buffer) Log.buffer-max-size)
+          (let ((beg (point-min)))
+            (goto-char (point-min))
+            (forward-line 1)
+            (delete-region beg (point))))
+        ;; restore window point
+        (when log-window
+          (if at-bottom
+              (progn (select-window log-window)
+                     (goto-char (point-max))
+                     (recenter (1- (window-body-height log-window))))
+            (goto-char (marker-position marker)))
+          (select-window user-window))
+        (set-marker marker nil)))))
+;; (Omake.Server.logf "sean: %s %d" "abc" 8)
+
+
+;; Misc commands
+
+(defun Emacs.grab-line ()
+  "Grab the line of point"
+  (interactive)
+  (save-excursion
+    (end-of-line)
+    (let ((end (point)))
+      (beginning-of-line)
+      (buffer-substring-no-properties (point) end))))
+
+(defun Buffer.last-lines (buffer-or-name n)
+  "return the last N lines of a buffer"
+  (save-excursion
+    (with-current-buffer buffer-or-name
+      (goto-char (point-max))
+      (let* ((aux nil) ;; dummy for compilation warning
+             (aux (lambda (k)
+                    (if (equal k 0) nil
+                      (let* ((l (Emacs.grab-line))
+                             (res (forward-line -1))
+                             (rest (when (equal res 0) (funcall aux (- k 1)))))
+                        (cons l rest))))))
+        (reverse (funcall aux n))))))
+;; (length (Buffer.last-lines "*Help*" 10))
+;; (with-current-buffer "tmp" (goto-char (point-min) (Emacs.grab-line)))
+
+(defun Buffer.goto-line (n)
+  (goto-char (point-min))
+  (forward-line (1- n)))
+
+(defun Emacs.error (str &rest args)
+  (error (concat "[ERROR] " str) args))
+
+(defun Emacs.window-buffers ()
+  "Get all buffers being displayed in a window"
+  (List.map 'window-buffer (window-list)))
+
+(defun Emacs.window-files ()
+  "Get the file names of all buffers being displayed in a window"
+  (List.filter-map 'buffer-file-name (Emacs.window-buffers)))
+
+(defun Emacs.add-hook-append (hook f) (add-hook hook f t))
+
+(defun Emacs.insert (s)
+  "Don't raise an exception when s is nil"
+  (when s (insert s)))
+
+(defun Emacs.color (s face) (propertize s 'face face))
+
+(defun Overlay.delete-soon (overlay)
+  "Set an overlay for some period of time"
+  (unwind-protect
+      (sit-for 60)
+    (delete-overlay overlay)))
+
+(defun Emacs.y-or-n-p (prompt)
+  (let ((result (y-or-n-p prompt)))
+    ;; The [(message nil)] is necessary to clear the minibuffer.
+    (message nil)
+    result))
+
+(defun Emacs.insert-object (x) (insert (prin1-to-string x)))
+;; (Emacs.insert-object "sean")
+
+(defun File.byte-compile-check ()
+  (interactive)
+  (let ((file (read-file-name "File: ")))
+    (byte-compile-file file)
+    (message "removing compiled file")
+    (remove-file (concat file "c"))))
+
+
+;; Hg
+
+(defun hg-resolve-file ()
+  (interactive)
+  "Run 'hg resolve -m' on the current file"
+  (let* ((file (buffer-file-name (current-buffer))))
+    (shell-command (format "hg resolve -m %s" file))))
+
+(require 'dired)
+(defun hg-resolve-file-dired ()
+  (interactive)
+  "Run 'hg resolve -m' on the current file in a dired buffer"
+  (let* ((file (dired-file-name-at-point)))
+    (shell-command (format "hg resolve -m %s" file))))
+
+(provide 'jane-lib)

notes/window_selection.ml

+open Core.Std
+
+module F (M : sig
+  type window
+
+  module Code_and_error : sig
+    type 'a t =
+      { code : 'a;
+        error : 'a;
+      }
+  end
+
+  module Buffer : sig
+    type t
+  end
+
+  module Frame : sig
+    type t
+
+    val selected_window : t -> window
+    (* [split] will only be called on a frame that has one window, and encapsulates
+       emacs-config options [Omake.split-window-horizontally] and
+       [Omake.show-error-buffer-in-top-or-left-window]. *)
+    val split : t -> window Code_and_error.t
+    val windows : t -> window list
+  end
+
+  module Window : sig
+    type t = window
+
+    val buffer : t -> Buffer.t
+    val frame : t -> Frame.t
+    val lru : t list -> t
+  end
+
+  module Kind : sig
+    type t =
+      { buffer : Buffer.t;
+        dedicated_window : Window.t option;
+        dedicated_frame : Frame.t option;
+      }
+
+  end
+end) : sig
+  open M
+
+  val choose_windows
+    :  code:Kind.t
+    -> error:Kind.t
+    -> selected_window:Window.t
+    -> visible_windows:Window.t list
+    -> Window.t Code_and_error.t
+
+end = struct
+  open M
+  open Code_and_error
+  open Kind
+
+  let choose_windows ~code ~error ~selected_window ~visible_windows =
+    (* Requirements that emacs is expected to guarantee. *)
+    assert (code.buffer <> error.buffer);
+    assert (code.dedicated_window <> error.dedicated_window);
+    (* The algorithm. *)
+    let choose_frame_and_maybe_window kind ~other =
+      match kind.dedicated_window with
+      | Some w -> Window.frame w, Some w
+      | None ->
+        let try_windows, or_else_frame =
+          match kind.dedicated_frame with
+          | Some frame -> (Frame.windows frame, frame)
+          | None -> (visible_windows, Window.frame selected_window)
+        in
+        match
+          List.find try_windows ~f:(fun window ->
+            Window.buffer window = kind.buffer
+            && Some window <> other.dedicated_window)
+        with
+        | Some w -> Window.frame w, Some w
+        | None -> or_else_frame, None
+    in
+    let code_frame, code_window_opt =
+      choose_frame_and_maybe_window code ~other:error
+    in
+    let error_frame, error_window_opt =
+      choose_frame_and_maybe_window error ~other:code
+    in
+    let choice =
+      if code_frame = error_frame then begin
+        let frame = code_frame in
+        let selected_window = Frame.selected_window frame in
+        let windows = Frame.windows frame in
+        match List.filter windows ~f:(fun w -> w <> selected_window) with
+        | [] -> Frame.split frame
+        | unselected_windows ->
+          let lru = Window.lru unselected_windows in
+          let other_than w = if w <> selected_window then selected_window else lru in
+          match code_window_opt, error_window_opt with
+          | Some code, Some error -> { code; error }
+          | Some code, None -> { code; error = other_than code}
+          | None, Some error -> { code = other_than error; error }
+          | None, None -> { code = selected_window; error = lru }
+      end else begin
+        let or_selected window_opt frame =
+          Option.value window_opt ~default:(Frame.selected_window frame)
+        in
+        { code  = or_selected code_window_opt  code_frame ;
+          error = or_selected error_window_opt error_frame;
+        }
+      end
+    in
+    (* Properties guaranteed by the algorithm. *)
+    (* Error window and code window are distinct. *)
+    assert (choice.error <> choice.code);
+    (* Choices obey dedicated windows and frames. *)
+    let obeys_dedicated kind choice =
+      match kind.dedicated_window with
+      | Some w -> choice = w
+      | None ->
+        match kind.dedicated_frame with
+        | Some f -> Window.frame choice = f
+        | None -> true
+    in
+    assert (obeys_dedicated code  choice.code );
+    assert (obeys_dedicated error choice.error);
+    (* Return *)
+    choice
+  ;;
+end
 ;; in a clean and elegant fashion.
 ;;
 ;; The relevant files are:
-;; - `elisp-for-ocaml-programmers.el'       Utility functions
+;; - `jane-lib.el'     Utility functions
 ;; - `omake.ml'        Ocaml code that does the actual error parsing
 ;; - `omake_server.ml' The ocaml omake server (o-server)
 ;; - `omake.el'        Elisp code that calls out to ocaml, formats the
 ;;
 
 (require 'autorevert)
-(require 'elisp-for-ocaml-programmers)
+(require 'jane-lib)
 
 ;;============================================================================;;
 ;; Custom                                                                     ;;
 (defun Omake.choose-frame-and-maybe-window (kind buffer other-dedicated-window)
   (assert (Omake.Window.kindp kind))
   (let ((dw (Omake.Window.get kind))
-        (df (Omake.Frame.get kind)))
+        (df (Omake.Frame.get kind))
+        (sw (selected-window)))
     (if dw (cons (window-frame dw) dw)
       (let* ((try-windows
               (if df (window-list df) (Window.all-visible)))
              ;; Make sure it tries the selected window first
-             ;; to make selection roughly symmetric between frames
-             (try-windows (cons (selected-window) try-windows))
+             ;; to make selection symmetric between frames
+             ;; if you don't do this, and have two frames
+             ;; [Code]  [Code]
+             ;; doing next-error in one will give
+             ;; [Code|Errors] [Code]
+             ;; while doing next-error in the other will give
+             ;; [Code] [Errors]
+             ;; because of the order the windows are tried
+             (try-windows (if (member sw try-windows) (cons sw try-windows) try-windows))
              (or-else-frame
-              (if df df (window-frame (selected-window))))
+              (if df df (window-frame sw)))
              (final-window
               (List.find
                (lambda (w)
     (set-window-buffer cw code-buffer)
     (select-window cw)
     (select-frame-set-input-focus (window-frame cw))
-    ;;(raise-frame (window-frame cw))
+    (raise-frame (window-frame cw))
+    (raise-frame (window-frame ew))
     ;;(select-frame (window-frame cw))
     ;;(redirect-frame-focus (window-frame cw))
     (switch-to-buffer code-buffer)
+;;============================================================================;;
+;; Omake mode                                                                 ;;
+;;============================================================================;;
+
+;; Omake is a useful compilation system, but the output isn't ideal for
+;; users interested in fixing compilation errors.  This module parses
+;; the output of omake and present the compilation errors to the users
+;; in a clean and elegant fashion.
+;;
+;; The relevant files are:
+;; - `jane-lib.el'     Utility functions
+;; - `omake.ml'        Ocaml code that does the actual error parsing
+;; - `omake_server.ml' The ocaml omake server (o-server)
+;; - `omake.el'        Elisp code that calls out to ocaml, formats the
+;;                     result, and implements error navigation
+;;
+;; * The importance of the OMakeroot path
+;;
+;; `omake' supports running multiple concurrent compilation projects
+;; The primary data structure is a 'model'.  There is a model for each
+;; compilation process (called a project).  The id of a model is the full
+;; 'readlinked' path to the omakeroot file above the directory
+;; where the compilation started.  There can be at most one OMakeroot
+;; file in a project, so this path uniquely specifies the project.  The
+;; user is not permitted to start two projects within the same
+;; OMakeroot path.
+;;
+;; * The error buffer
+;;
+;; Each project has an associated error-buffer where errors are shown.
+;; The error buffer is always displayed in a window, chosen using
+;; `Omake.set-dedicated-error-window'
+;;
+;; * Starting a compilation project
+;;
+;; When the user wishes to start their first project, they should pick
+;; a window where they wish to see errors, and run
+;; `Omake.set-dedicated-error-window'.  Then the user begins a
+;; compilation project using `Omake.compile' in the directory they
+;; want compiled.
+;;
+;; * Stopping a project
+;;
+;; Run `Omake.kill-project' in a directory below the Omakeroot file of
+;; the project.
+;;
+;; * Error navigation
+;;
+;; To jump to the next error in the error buffer, the user calls
+;; `Omake.next-error' (C-c C-l)
+;; Some errors are very large (10^5 lines) and are shown as truncated
+;; in the error buffer.  To expand the full text of the current error
+;; into a new buffer, use `Omake.toggle-expanded-error' (C-c C-h).
+;; The same command deletes the buffer and returns to the error buffer.
+;; If the error buffer is hidden for some reason, the user can type
+;; `Omake.show-error-buffer' (C-c C-e)
+;;
+;; Changelog:
+;;  Version 2:
+;;  - Added versioning
+;;  - Support for omake variables
+;;    X_LIBRARY_INLINING, VERSION_UTIL_SUPPORT, LINK_EXECUTABLES
+;;  - More metadata in the error buffer in verbose mode
+;;  Version 7:
+;;  - Pings get ids
+
+;; FIXME: model-done --> model-finished  (grammar annoyance)
+
+;; Invariants (not yet implemented or checked)
+;;  - If the server is not running, the model table is empty
+;;
+
+(require 'autorevert)
+(require 'jane-lib)
+
+;;============================================================================;;
+;; Custom                                                                     ;;
+;;============================================================================;;
+
+(defcustom Omake.Server.program
+  "/mnt/global/base/bin/omake_server.exe"
+  "location of the executable program to find the next error"
+  :group 'omake
+  :type 'string)
+
+(defcustom Omake.error-file-dir "/dropoff/sweeks/omake-mode-bugs"
+  "where to put omake-mode errors as bug reports"
+  :group 'omake
+  :type 'string)
+
+(defcustom Omake.maintainer-email-addr "sweeks@janestreet.com"
+  "who to contact with problems"
+  :group 'omake
+  :type 'string)
+
+(defcustom Omake.omake-command "omake"
+  "How to run omake"
+  :group 'omake
+  :type 'string)
+
+(defcustom Omake.prompt-before-killing-project t
+  "If t, prompt y/n before killing a project"
+  :group 'omake
+  :type 'boolean)
+;; (setq Omake.prompt-before-killing-project nil)
+
+(defcustom Omake.split-frame-horizontally t
+  "See the info documentation for when this variable takes effect."
+  :group 'omake
+  :type 'boolean)
+;; (setq Omake.split-frame-horizontally t)
+;; (setq Omake.split-frame-horizontally nil)
+
+(defcustom Omake.show-error-buffer-in-top-or-left-window nil
+  "See the info documentation for what this is and when it takes effect."
+  :group 'omake
+  :type 'boolean)
+;; (setq Omake.show-error-buffer-in-top-or-left-window t)
+;; (setq Omake.show-error-buffer-in-top-or-left-window nil)
+
+;;============================================================================;;
+;; Faces                                                                      ;;
+;;============================================================================;;
+
+;; Note: If you add a face, add it to omake-{dark,light}-theme.el as well
+
+(defface Omake.Face.error
+  '((t (:foreground "red")))
+  "red"
+  :group 'omake)
+
+(defface Omake.Face.eval
+  '((t (:foreground "orange")))
+  "orange"
+  :group 'omake)
+
+(defface Omake.Face.async
+  '((t (:foreground "yellow")))
+  "yellow"
+  :group 'omake)
+
+(defface Omake.Face.help
+  '((t (:foreground "PaleTurquoise1")))
+  "blue"
+  :group 'omake)
+
+(defface Omake.Face.event
+  '((t (:foreground "cyan")))
+  "blue"
+  :group 'omake)
+
+(defface Omake.Face.debug
+  '((t (:foreground "magenta")))
+  "For debug messages"
+  :group 'omake)
+
+(defface Omake.Face.progress-working
+  '((t (:foreground "yellow")))
+  "Face for progress line of the error buffer"
+  :group 'omake)
+
+(defface Omake.Face.progress-successful
+  '((t (:foreground "green")))
+  "Face for progress line of the error buffer"
+  :group 'omake)
+
+(defface Omake.Face.progress-stopped
+  '((t (:foreground "red")))
+  "Face for progress line of the error buffer"
+  :group 'omake)
+
+(defface Omake.Face.spinner
+  '((t (:foreground "cyan")))
+  "Face for progress line of the error buffer"
+  :group 'omake)
+
+(defface Omake.Face.last-line
+  '((t (:foreground "pink")))
+  "Face for the last line of the error-buffer"
+  :group 'omake)
+
+(defface Omake.Face.verbose
+  '((t (:foreground "light cyan")))
+  "Face for the env line of the error-buffer"
+  :group 'omake)
+
+(defface Omake.Face.error-current
+  '((t (:foreground "orange")))
+  "Face for the current error"
+  :group 'omake)
+
+(defface Omake.Face.error-pending
+  '((t (:foreground "PaleTurquoise1")))
+  "Face for errors"
+  :group 'omake)
+
+(defface Omake.Face.ocaml-error
+  '((t (:foreground "red")))
+  "Face for error layovers in ocaml files"
+  :group 'omake)
+
+(defface Omake.Face.error
+  '((t (:foreground "red")))
+  "Face for error layovers in ocaml files"
+  :group 'omake)
+
+(defface Omake.Face.error-mouse
+  '((t (:foreground "cyan")))
+  "Face for the error when a mouse is over the error"
+  :group 'omake)
+
+;;============================================================================;;
+;; Util                                                                       ;;
+;;============================================================================;;
+
+(defun Omake.date () (format-time-string "%Y-%m-%d"))
+
+;;============================================================================;;
+;; Versioning                                                                 ;;
+;;============================================================================;;
+
+;; When upgrading, there are a couple things to watch out for
+;; - An emacs running an older version of omake-mode tries to
+;;   start a newer o-server.  In this case, the o-server should
+;;   refuse to start and tell the user (via emacsclient) that
+;;   they should (load-library "omake")
+;; - The user loads a new omake-mode version while the old o-server
+;;   is still running.  In this case, we should detect an omake-mode
+;;   upgrade and kill the server when it happens.
+
+;; Detect version changes
+
+(defconst Omake.pre-version 11
+  "We use a version number to synchronize the elisp code the omake server
+To roll a new version of elisp that is incompatible with ocaml or vice
+versa, you must bump the version number.  This prevents old elisp code
+from trying to start a new server.  Please describe the
+changes in the Changelog.")
+
+;; If there has been a version change upon loading this library,
+;; kill the o-server.
+(when (and (boundp 'Omake.version)
+           (nequal Omake.pre-version Omake.version)
+           (Omake.Server.running-p))
+  (let ((res (y-or-n-p
+    "Omake was updated.  Kill your server and reload? ")))
+    (if res (Omake.Server.stop-and-kill-projects)
+      ;; Set the version back to the loaded version
+      (error "Aborting omake-mode library load"))))
+
+(defconst Omake.version Omake.pre-version)
+
+;;============================================================================;;
+;; Windows and frames
+;;============================================================================;;
+
+(defvar Omake.Window.Error nil)
+(defvar Omake.Window.Code nil)
+(defvar Omake.Frame.Error nil)
+(defvar Omake.Frame.Code nil)
+
+(defun Omake.Window.clear-dedicated ()
+  (setq Omake.Window.Error nil)
+  (setq Omake.Window.Code nil)
+  (setq Omake.Frame.Error nil)
+  (setq Omake.Frame.Code nil))
+
+(defmacro Omake.Window.check (w)
+  `(and ,w
+       (not (window-live-p ,w))
+       (setq ,w nil)))
+;; (macroexpand '(Omake.Window.check Omake.Window.Error))
+
+(defmacro Omake.Frame.check (f)
+  `(and ,f
+        (or (not (frame-live-p ,f))
+            (not (frame-visible-p ,f)))
+        (setq ,f nil)))
+;; (macroexpand '(Omake.Frame.check Omake.Frame.Error))
+;; (frame-visible-p Omake.Frame.Error)
+
+(defun Omake.Window.kindp (kind)
+  (case kind
+    ((code error) t)
+    (t nil)))
+;; (Omake.Window.kindp 'code)
+;; (Omake.Window.kindp 'error)
+;; (Omake.Window.kindp 'abc)
+;; (Omake.Window.kindp nil)
+
+(defun Omake.Window.other (kind)
+  (assert (Omake.Window.kindp kind))
+  (case kind
+    (code 'error)
+    (error 'code)
+    (t (error "Impossible"))))
+;; (Omake.Window.other 'error)
+;; (Omake.Window.other 'code)
+;; (Omake.Window.other nil)
+
+(defun Omake.check-dedicated ()
+  (Omake.Window.check Omake.Window.Error)
+  (Omake.Window.check Omake.Window.Code)
+  (Omake.Frame.check Omake.Frame.Error)
+  (Omake.Frame.check Omake.Frame.Code)
+  (assert (or (null Omake.Window.Code)
+              (null Omake.Window.Error)
+              (nequal Omake.Window.Code Omake.Window.Error))))
+
+(defun Frame.show (f)
+  (make-frame-visible ,f)
+  (raise-frame ,f))
+
+(defun Omake.Frame.show (w f)
+  (Omake.check-dedicated)
+  (Frame.show f)
+  (when w (Frame.show (window-frame w))))
+
+(defun Omake.Frame.uniconify (kind)
+  (assert (Omake.Window.kindp kind))
+  (case kind
+    ('error (Omake.Frame.uniconify1 Omake.Window.Error Omake.Frame.Error))
+    ('code (Omake.Frame.uniconify1 Omake.Window.Code Omake.Frame.Code))
+    (t (error "Impossible"))))
+
+(defun Omake.Window.get (kind)
+  (assert (Omake.Window.kindp kind))
+  (case kind
+    ('error Omake.Window.Error)
+    ('code Omake.Window.Code)
+    (t (error "Impossible"))))
+
+(defun Omake.Frame.get (kind)
+  (assert (Omake.Window.kindp kind))
+  (case kind
+    ('error Omake.Frame.Error)
+    ('code Omake.Frame.Code)
+    (t (error "Impossible"))))
+
+(defun Omake.Frame.split ()
+  ;; If we're splitting, there's a single frame with a single window.  If it's
+  ;; dedicated, we have no hope of maintaining it
+  (Omake.Window.clear-dedicated)
+  (let ((right (if Omake.split-frame-horizontally
+                   (split-window-horizontally)
+                 (split-window-vertically)))
+        (left (selected-window)))
+    (if Omake.show-error-buffer-in-top-or-left-window
+        (cons right left)
+      (cons left right))))
+
+(defun Omake.choose-frame-and-maybe-window (kind buffer other-dedicated-window)
+  (assert (Omake.Window.kindp kind))
+  (let ((dw (Omake.Window.get kind))
+        (df (Omake.Frame.get kind)))
+    (if dw (cons (window-frame dw) dw)
+      (let* ((try-windows
+              (if df (window-list df) (Window.all-visible)))
+             ;; Make sure it tries the selected window first
+             ;; to make selection roughly symmetric between frames
+             (try-windows (cons (selected-window) try-windows))
+             (or-else-frame
+              (if df df (window-frame (selected-window))))
+             (final-window
+              (List.find
+               (lambda (w)
+                 (and
+                  buffer
+                  (equal (window-buffer w) buffer)
+                  (or (null other-dedicated-window)
+                      (nequal w other-dedicated-window))))
+               try-windows)))
+        (if final-window
+            (cons (window-frame final-window) final-window)
+          (cons or-else-frame nil))))))
+
+(defun Omake.obeys-dedicated (kind w)
+  (assert (Omake.Window.kindp kind))
+  (assert (window-live-p w))
+  (let ((dw (Omake.Window.get kind))
+        (df (Omake.Frame.get kind)))
+    (cond
+     (dw (equal dw w))
+     (df (equal df (window-frame w)))
+     (t t))))
+
+(defun Omake.choose-windows (id code-buffer-opt)
+  "Return (code-window . error-window) and set the code and error buffers"
+  (assert (Omake.id-p id))
+  (assert (or (null code-buffer-opt) (bufferp code-buffer-opt)))
+  (Omake.check-dedicated)
+  (let* ((model (Omake.Model.get id))
+         (error-buffer (Omake.model-error-buffer model))
+         (_ (assert (nequal code-buffer-opt error-buffer)))
+         (code (Omake.choose-frame-and-maybe-window
+                'code code-buffer-opt Omake.Window.Error))
+         (code-frame (car code))
+         (code-window (cdr code))
+         (err (Omake.choose-frame-and-maybe-window
+               'error error-buffer Omake.Window.Code))
+         (error-frame (car err))
+         (error-window (cdr err))
+         (_ (assert code-frame))
+         (_ (assert error-frame))
+         (or-selected (lambda (w f) (if w w (frame-selected-window f))))
+         (choice
+          (if (equal code-frame error-frame)
+              (let* ((frame code-frame)
+                     (sw (frame-selected-window frame))
+                     (windows (window-list frame))
+                     (unselected-ws (remove-if-not (lambda (w) (nequal w sw)) windows)))
+                (if (null unselected-ws)
+                    (with-selected-frame frame (Omake.Frame.split))
+                  (let* ((lru (when unselected-ws (car unselected-ws)))
+                         ;; Can't get lru from an arbitrary list of windows without digging into C
+                         (other-than (lambda (w) (if (equal w sw) lru sw))))
+                    (cond
+                     ((and code-window error-window) (cons code-window error-window))
+                     (code-window (cons code-window (funcall other-than code-window)))
+                     (error-window (cons (funcall other-than error-window) error-window))
+                     (t (cons sw lru))))))
+            ;; else
+            (cons (funcall or-selected code-window code-frame)
+                  (funcall or-selected error-window error-frame))))
+         (code (car choice))
+         (err (cdr choice)))
+    (assert (nequal code err))
+    (assert code)
+    (assert err)
+    (assert (Omake.obeys-dedicated 'code code))
+    (assert (Omake.obeys-dedicated 'error err))
+    choice))
+
+;;============================================================================;;
+;; Progress bar                                                               ;;
+;;============================================================================;;
+
+(defconst Omake.Progress.bar-size 30)
+
+(defun* Omake.Progress.make-bar (num denom &key full)
+  "if `full' is specified, force the bar to be full with num = denom"
+  (assert (integerp num))
+  (assert (integerp denom))
+  (if (equal denom 0) "No files processed yet"
+    (let* ((num (float num))
+           (num (if full denom num))
+           (denom (float denom))
+           (num-syms (if full Omake.Progress.bar-size
+                       (floor (* (/ num denom) (float Omake.Progress.bar-size)))))
+           (syms (make-string num-syms ?=))
+           (space (make-string (- Omake.Progress.bar-size num-syms) ? ))
+           (bar (format "[%s%s]" syms space)))
+      (format "%s %d / %d" bar num denom))))
+;; (Omake.Progress.make-bar 12239. 16429)
+;; (Omake.Progress.make-bar 12239 16429 :full t)
+
+;;============================================================================;;
+;; Paths                                                                      ;;
+;;============================================================================;;
+
+(defun Omake.Path.ok (path)
+  "A legal path has no spaces and doesn't end with a slash"
+  (assert (stringp path))
+  (let ((legal (progn
+                 (string-match "[.~a-zA-Z0-9/_-]*[.a-zA-Z0-9~_-]" path)
+                 (match-string 0 path))))
+    (equal path legal)))
+
+(progn
+  (Jane.test (Omake.Path.ok "/home/sweeks/live/107.15.00/live/lib") t)
+  (Jane.test (Omake.Path.ok "/home/sweeks/live/107.15.00/live/lib/aSet.ml") t)
+  (Jane.test (Omake.Path.ok "/mnt/local/sda1/smclaughlin/elisp/dev/omake-mode") t)
+  (Jane.test (Omake.Path.ok "/mnt/local.a.b.c/sda1/smclaughlin/elisp/dev/omake-mode") t)
+  (Jane.test (Omake.Path.ok "~/gord-test") t))
+
+(defun Omake.Path.omakeroot-dir (path)
+  "Get the full, unaliased path to the OMakeroot file above the given path.
+Raise an exception if there is no such directory."
+  (assert (stringp path))
+  (let* ((dir (locate-dominating-file path "OMakeroot"))
+         ;; locate-dominating-file leaves the last slash on the path
+         (dir (Filename.strip-final-slash dir)))
+    (if (not dir)
+        (error "Can't determine OMake project: no OMakeroot in %s or any of its ancestors"
+               path))
+    (assert (file-directory-p dir))
+    dir))
+;; (Omake.Path.omakeroot-dir "/mnt/local/sda1/smclaughlin/elisp/dev/omake-mode")
+;; (Omake.Path.omakeroot-dir "~/gord-test")
+;; (Omake.Path.omakeroot-dir "/mnt/local.a.b.c/sda1/smclaughlin/elisp/dev/omake-mode")
+
+;;============================================================================;;
+;; Ids                                                                        ;;
+;;============================================================================;;
+
+(defconst Omake.Id.cache (make-hash-table :test 'equal))
+
+(defvar Omake.Id.cache-misses 0)
+;; (setq Omake.Id.cache-misses 0)
+
+(defstruct
+  (Omake.id
+   (:constructor nil)
+   (:constructor
+    Omake.Id.of-path
+    (path
+     &aux (to-string
+           (let ((cached (gethash path Omake.Id.cache)))
+             (if cached cached
+               (assert (Omake.Path.ok path))
+               (let ((p (Shell.readlink (Omake.Path.omakeroot-dir path))))
+                 (assert p)
+                 (incf Omake.Id.cache-misses)
+                 (puthash path p Omake.Id.cache)
+                 p)))))))
+  (to-string nil :read-only t))
+;; (Omake.id-to-string (Omake.error-id current))
+
+(defun Omake.Id.current ()
+  (let ((path (Filename.default-directory)))
+    (Omake.Id.of-path path)))
+
+;;============================================================================;;
+;; Error                                                                      ;;
+;;============================================================================;;
+
+(defstruct
+  (Omake.error
+   (:constructor nil)
+   (:constructor Omake.Error
+                 (&key
+                  id
+                  relpath
+                  file
+                  line
+                  char-beg
+                  char-end
+                  text
+                  full-text
+                  &aux
+                  (_ (assert (stringp id)))
+                  (id (Omake.Id.of-path id))
+                  (_ (assert (Omake.id-p id)))
+                  (_ (assert (stringp relpath)))
+                  (_ (assert (stringp file)))
+                  (_ (assert (integerp line)))
+                  (_ (assert (integerp char-beg)))
+                  (_ (assert (integerp char-end)))
+                  (_ (assert (stringp text)))
+                  (_ (assert (stringp full-text)))
+                  (full-text-visible-p nil)
+                  )))
+  (id              nil :read-only t)
+  (relpath         nil :read-only t)
+  (file            nil :read-only t)
+  (line            nil :read-only t)
+  (char-beg        nil :read-only t)
+  (char-end        nil :read-only t)
+  (text            nil :read-only t)
+  (full-text       nil :read-only t)
+  full-text-visible-p)
+
+(defun Omake.Error.visible-text (e)
+  (if (Omake.error-full-text-visible-p e)
+      (Omake.error-full-text e)
+    (Omake.error-text e)))
+
+(defun Omake.Error.to-error-buffer-string (e)
+  (let* ((text (Omake.Error.visible-text e))
+         (relpath (Omake.error-relpath e))
+         ;; don't let relpath be too long
+         (relpath-len (length relpath))
+         (relpath-max-len 100) ;; ignore this for now
+         (relpath (if (< relpath-len relpath-max-len) relpath
+                    (concat "..." (substring relpath
+                                             (- relpath-max-len 3)
+                                             relpath-len)))))
+    (replace-regexp-in-string "File \"" (format "File \"%s/" relpath) text)))
+
+(defun Omake.Error.same-error (e1 e2)
+  "It's common for errors at line=1, char_beg=0, char_end=1 in the same file to be different,
+since those locations can mean interface mismatches.  We really have to compare
+the text."
+  (assert (Omake.error-p e1))
+  (assert (Omake.error-p e2))
+  (and
+   (equal (Omake.error-id e1) (Omake.error-id e2))
+   (equal (Omake.error-relpath e1) (Omake.error-relpath e2))
+   (equal (Omake.error-file e1) (Omake.error-file e2))
+   (equal (Omake.error-line e1) (Omake.error-line e2))
+   (equal (Omake.error-char-beg e1) (Omake.error-char-beg e2))
+   (equal (Omake.error-char-end e1) (Omake.error-char-end e2))
+   (equal (Omake.error-full-text e1) (Omake.error-full-text e2))))
+
+(defun Omake.Error.hash (e)
+  (assert (Omake.error-p e))
+  (sxhash (list
+           (Omake.error-full-text e)
+           (Omake.error-id e)
+           (Omake.error-relpath e)
+           (Omake.error-file e)
+           (Omake.error-line e)
+           (Omake.error-char-beg e)
+           (Omake.error-char-end e)
+           (Omake.error-full-text e))))
+;; (Omake.Error.hash current)
+
+(defun Omake.Error.file-path (e)
+  "The fullpath of a file"
+  (assert (Omake.error-p e))
+  (let* ((id (Omake.error-id e))
+         (model (Omake.Model.get id))
+         (root (Omake.model-omakeroot-dir model))
+         (relpath (Omake.error-relpath e))
+         (file (Omake.error-file e)))
+  (format "%s/%s/%s" root relpath file)))
+
+(defun Omake.Error.show (e)
+  (assert (Omake.error-p e))
+  (let* ((id (Omake.error-id e))
+         (model (Omake.Model.get id))
+         (error-buffer (Omake.model-error-buffer model))
+         (file (Omake.Error.file-path e))
+         (code-buffer (find-file-noselect file))
+         (ws (Omake.choose-windows id code-buffer))
+         (cw (car ws))
+         (ew (cdr ws))
+         (line (Omake.error-line e))
+         (char-beg (Omake.error-char-beg e))
+         (char-end (Omake.error-char-end e)))
+    ;; This part is finicky.  I'm not sure at the moment why
+    ;; the `switch-to-buffer' call is needed, but it is.
+    (set-window-buffer ew error-buffer)
+    (set-window-buffer cw code-buffer)
+    (select-window cw)
+    (select-frame-set-input-focus (window-frame cw))
+    ;;(raise-frame (window-frame cw))
+    ;;(select-frame (window-frame cw))
+    ;;(redirect-frame-focus (window-frame cw))
+    (switch-to-buffer code-buffer)
+    (remove-overlays (point-min) (point-max))
+    (Buffer.goto-line line)
+    (forward-char char-beg)
+    (let* ((left (point))
+           (right (+ left (- char-end char-beg)))
+           (overlay (make-overlay left right (current-buffer))))
+      (overlay-put overlay 'face 'Omake.Face.ocaml-error)
+      (Overlay.delete-soon overlay))))
+
+(defun Omake.Error.eval (e)
+  (let* ((id (Omake.error-id e))
+         (model (Omake.Model.get id))
+         (error-buffer (Omake.model-error-buffer model)))
+    (Omake.Model.make-current model e)
+    (with-current-buffer error-buffer (goto-char (point-min)))
+    (Omake.Error.show e)))
+
+(defun* Omake.Error.to-string (e &key is-current)
+  (assert (Omake.error-p e))
+  ;; Use lexical-let so we can put the error in a closure
+  (lexical-let*
+      (;; error jumping
+       (e e) ;; !!! close on e !!!
+       (error-face (if is-current 'Omake.Face.error-current 'Omake.Face.error-pending))
+       (goto-error (lambda ()
+                     (interactive)
+                     (Omake.Error.eval e)))
+       (goto-keymap   (make-sparse-keymap))
+       (_ (define-key goto-keymap   [mouse-1] goto-error))
+       (_ (define-key goto-keymap   "\C-m"     goto-error))
+       (error-str (Omake.Error.to-error-buffer-string e)))
+    (propertize error-str
+                'face            error-face
+                'mouse-face      'Omake.Face.error-mouse
+                'keymap          goto-keymap)))
+;; (Omake.Error.to-string e 0)
+
+(defun Omake.Error.mem (e es)
+  (List.exists (lambda (e1) (Omake.Error.same-error e e1)) es))
+
+(defun Omake.Error.toggle-full-text (e)
+  (let ((b (Omake.error-full-text-visible-p e)))
+    (setf (Omake.error-full-text-visible-p e) (not b))))
+
+(defun Omake.Error.contract (e)
+  (setf (Omake.error-full-text-visible-p e) nil))
+
+(defun Omake.Error.expand (e)
+  (setf (Omake.error-full-text-visible-p e) t))
+
+;;============================================================================;;
+;; Sets of errors                                                             ;;
+;;============================================================================;;
+
+(define-hash-table-test
+  'Omake.Error.hash-test 'Omake.Error.same-error 'Omake.Error.hash)
+
+(defun Omake.Error.make-hash-set (l)