Commits

Stephen Weeks committed 7fc367a Merge

auto merge

Comments (0)

Files changed (26)

+new stuff
+=========
+
+- Support for missing package errors, eg
+
+  *** omake: targets were not rebuilt because of errors:
+     lib/bug.cmx
+        depends on: lib/bug.ml
+        depends on: lib/bug.mli
+        - build lib bug.cmx
+        + ocamlfind ocamlopt -thread -w @a-4-7-9-29-28 -pp 'camlp4o /usr/local/lib/ocaml/site-lib/type-conv/pa_type_conv.cma /usr/local/lib/ocaml/site-lib/sexplib/pa_sexp_conv.cma /usr/local/lib/ocaml/site-lib/fieldslib/pa_fields_conv.cma /usr/local/lib/ocaml/site-lib/pa_pipebang/pa_pipebang.cma' -strict-sequence -annot -inline 20 -nodynlink -g -package core -package core_extended -package async -package pcre -c bug.mli
+        ocamlfind: Package `core_extended' not found
+        - exit lib bug.cmx, 0.10 sec, code 2
+
+- New error handling framework.  For example, when you try to start omake in a
+  tramp buffer, show a message in the minibuffer and abort the current stack
+  but don't raise an exn.
+
+changes
+=========
+
+bug fixes
+=========
+
+
+--------------------------------------------------------------------------------
 
 new stuff
 =========
 =========
 
 - Support new error-enabled warnings format in ocaml 4.0
-- Verbose mode shows the settings of the environment variables 
+- Verbose mode shows the settings of the environment variables
   on the next compilation as well as the current one.
-- Changed variable 
+- Changed variable
   Omake.create-dedicated-frame --> Omake.create-dedicated-status-frame
 - In project buffer, 'w' now toggles between watched and unwatched.
   'u' was removed.
 
 bug fixes
 =========
+
 - Eliminated nohup.out files
 - toggle-env/set-env prompts are the same now
 

elisp/omake/make.sh

 file=/tmp/all.el
 
 files="
+omake-file.el
+omake-errors.el
 omake-version.el
 omake-custom.el
 omake-face.el
 omake-failure.el
 omake-result.el
 omake-status.el
-omake-file.el
 omake-buffer.el
 omake-spinner.el
 omake-project.el

elisp/omake/omake-connection.el

 ;; (macroexpand '(Omake.with-connection 5))
 
 (defmacro Omake.with-updated-projects (&rest body)
-  "wEnsure the project list is up to date"
+  "Ensure the project list is up to date"
   (declare (indent defun))
   (declare (debug (body)))
   `(Omake.with-connection

elisp/omake/omake-errors.el

+
+(defun Omake.Errors.new-error-sym (sym msg)
+  (assert (symbolp sym) t)
+  (assert (stringp msg) t)
+  (put sym 'error-conditions '(error Omake.Errors.all))
+  (put sym 'error-message msg))
+
+(defconst Omake.Errors.errors
+  (list
+   (cons
+    'Omake.Errors.tramp
+    "Omake mode does not support remote files")
+   (cons
+    'Omake.Errors.abort
+    "Aborted")
+   (cons
+    'Omake.Errors.file-perms
+    (format "Can't read/write file.  Check the permissions in %s" Omake.File.root))))
+
+(mapc (lambda (c)
+        (let ((sym (car c)) (msg (cdr c)))
+          (Omake.Errors.new-error-sym sym msg)))
+      Omake.Errors.errors)
+
+(defmacro Omake.handle-errors (&rest body)
+  "Handle omake-mode errors"
+  (declare (indent defun))
+  (declare (debug (body)))
+  `(condition-case err
+       (progn ,@body)
+     (Omake.Errors.all (message "Error: %s" (error-message-string err)))))
+;; (Omake.handle-errors (signal 'Omake.Errors.tramp '(1 2 3)))
+;; (defun foo (&optional x) (interactive) (Omake.handle-errors (let* ((x (if x x 5))) (message "%d" x))))
+;; (macroexpand '(Omake.handle-errors (signal 'Omake.Errors.tramp '(1 2 3))))
+
+(font-lock-add-keywords
+ 'emacs-lisp-mode
+ '(("\\<\\(Omake.handle-errors\\)" 1 font-lock-keyword-face))
+ t)
+
+;; (setq command-error-function nil)
+;; (setq command-error-function
+;;       (lambda (data context caller)
+;;         (message "in command-error-function")))
+
+;; (signal 'Omake.Errors.tramp '(1 2 3))
+;; (error "abc")
+
+(provide 'omake-errors)

elisp/omake/omake-file.el

 (defconst Omake.File.mode-log-dir
   (expand-file-name "mode-log" Omake.File.top))
 
-(make-directory Omake.File.mode-log-dir t)
-
+(condition-case _
+    (make-directory Omake.File.mode-log-dir t)
+  (error "Couldn't create the Omake mode-log.  Check the permissions on %s" Omake.File.root))
+    
 (defconst Omake.File.mode-log
   (format "%s/%d" Omake.File.mode-log-dir (emacs-pid)))
 
 (defconst Omake.File.socket
   (format "%s/%s/socket" Omake.File.root Omake.user))
 
+;; (defun Omake.File.check-perms (f &optional socket)
+;;   ;; Don't worry about readability.  The socket can't be read, so
+;;   ;; just consider writability (for uniformity).
+;;   (unless (file-writable-p f)
+;;     (signal 'Omake.Errors.file-perms (list f))))
+
+;; (mapc 'Omake.File.check-perms
+;;       (list 
+;;        Omake.File.root
+;;        Omake.File.top
+;;        Omake.File.socket
+;;        Omake.File.mode-log-dir
+;;        Omake.File.mode-log
+;;        Omake.File.server-log))
+
 (provide 'omake-file)

elisp/omake/omake-interface.el

 
 (defun Omake.next-error (&optional user-num id)
   (interactive "P")
-  ;; We'll definitely show the error window, so uniconify the error frame if it exists
-  (Omake.Frame.uniconify 'status)
-  (assert (or (null id) (Omake.Id.is id)))
-  (let* ((id (if id id (Omake.Id.current)))
-         (model (Omake.Model.get id))
-         (project (Omake.Model.project model))
-         (result (Omake.Model.result model))
-         (status (Omake.Model.status model))
-         (comp-dir (Omake.Project.compilation-dir project))
-         (current-file (buffer-file-name)))
-    (if (Omake.Result.failure-p result)
-        (message "There is problem with omake.")
-      ;; Otherwise find the error.  The tricky thing is figuring out
-      ;; which error is next.  Recall C-u resets the error index to 0.
-      ;; Cases:
-      ;;   C-u ---> 0
-      ;;   current error (visited)
-      ;;     C-0 ---> 0 (a special case of the next rule)
-      ;;     C-N ---> N mod num-errors
-      ;;   current error (pending)
-      ;;     C-N ---> N mod num-errors       (N <= 0)
-      ;;     C-N ---> (M+N-1) mod num-errors (N >  0)
-      (let* ((ring (Omake.Result.ring result))
-             (ring (if current-file
-                       (Omake.Ring.current-file-errors-to-front ring current-file)
-                     ring)))
-        (setf (Omake.Model.result model) (Omake.Result.Ring ring))
-        (if (Omake.Ring.is-empty ring)
-            (let* ((ws (Omake.show-status-buffer id))
-                   (cw (car ws))
-                   (ew (cdr ws)))
-              (when (equal (window-buffer cw) (window-buffer ew))
-                (let ((db (dired-noselect comp-dir)))
-                  (set-window-buffer cw db)))
-              (when Omake.Frame.Status (raise-frame Omake.Frame.Status))
-              (if (Omake.Status.polling-p status)
-                  (message "There are no errors.")
-                (message "There are no errors, but omake is still running")))
-          (let* ((current (Omake.Ring.current ring))
-                 (user-num
-                  (cond
-                   ;; \C-u sends (list N) where N>0.
-                   ((consp user-num) 0)
-                   ;; No arg is equivalent to \C-1
-                   ((null user-num) 1)
-                   ;; I'm not sure what type '-' has interactively
-                   ;; \C-- is equivalent to \C--\C-1
-                   ((equal (prin1-to-string user-num) "-") -1)
-                   ((integerp user-num) user-num)
-                   (t (error "I can't parse user-num: %s" (prin1-to-string user-num)))))
-                 (user-num
-                  (if (<= user-num 0) user-num
-                    (if current user-num (- user-num 1))))
-                 (num-errors (Omake.Ring.num-errors ring))
-                 (n (mod user-num num-errors))
-                 (_ (assert (< n num-errors)))
-                 (e (Omake.Ring.nth ring n)))
-            ;; Make sure the code frame is visible
-            (Omake.Frame.uniconify 'code)
-            (message "There are errors")
-            (Omake.Error.eval e)))))))
+  (Omake.handle-errors
+    (catch 'exit
+    ;; We'll definitely show the error window, so uniconify the error frame if it exists
+    (Omake.Frame.uniconify 'status)
+    (assert (or (null id) (Omake.Id.is id)))
+    (let* ((id (if id id (Omake.Id.current)))
+           (ids (Omake.Id.to-string id))
+           (_ (unless (Omake.Project.find id)
+                (message "Project %s is not currently compiling." ids)
+                (throw 'exit nil)))
+           (_ (unless (Omake.Model.has id) (Omake.watch id)))
+           (model (Omake.Model.get id))
+           (project (Omake.Model.project model))
+           (result (Omake.Model.result model))
+           (status (Omake.Model.status model))
+           (comp-dir (Omake.Project.compilation-dir project))
+           (current-file (buffer-file-name)))
+      (if (Omake.Result.failure-p result)
+          (message "There is problem with omake.")
+        ;; Otherwise find the error.  The tricky thing is figuring out
+        ;; which error is next.  Recall C-u resets the error index to 0.
+        ;; Cases:
+        ;;   C-u ---> 0
+        ;;   current error (visited)
+        ;;     C-0 ---> 0 (a special case of the next rule)
+        ;;     C-N ---> N mod num-errors
+        ;;   current error (pending)
+        ;;     C-N ---> N mod num-errors       (N <= 0)
+        ;;     C-N ---> (M+N-1) mod num-errors (N >  0)
+        (let* ((ring (Omake.Result.ring result))
+               (ring (if current-file
+                         (Omake.Ring.current-file-errors-to-front ring current-file)
+                       ring)))
+          (setf (Omake.Model.result model) (Omake.Result.Ring ring))
+          (if (Omake.Ring.is-empty ring)
+              (let* ((ws (Omake.show-status-buffer id))
+                     (cw (car ws))
+                     (ew (cdr ws)))
+                (when (equal (window-buffer cw) (window-buffer ew))
+                  (let ((db (dired-noselect comp-dir)))
+                    (set-window-buffer cw db)))
+                (when Omake.Frame.Status (raise-frame Omake.Frame.Status))
+                (if (Omake.Status.polling-p status)
+                    (message "There are no errors.")
+                  (message "There are no errors, but omake is still running")))
+            (let* ((current (Omake.Ring.current ring))
+                   (user-num
+                    (cond
+                     ;; \C-u sends (list N) where N>0.
+                     ((consp user-num) 0)
+                     ;; No arg is equivalent to \C-1
+                     ((null user-num) 1)
+                     ;; I'm not sure what type '-' has interactively
+                     ;; \C-- is equivalent to \C--\C-1
+                     ((equal (prin1-to-string user-num) "-") -1)
+                     ((integerp user-num) user-num)
+                     (t (error "I can't parse user-num: %s" (prin1-to-string user-num)))))
+                   (user-num
+                    (if (<= user-num 0) user-num
+                      (if current user-num (- user-num 1))))
+                   (num-errors (Omake.Ring.num-errors ring))
+                   (n (mod user-num num-errors))
+                   (_ (assert (< n num-errors)))
+                   (e (Omake.Ring.nth ring n)))
+              ;; Make sure the code frame is visible
+              (Omake.Frame.uniconify 'code)
+              (message "There are errors")
+              (Omake.Error.eval e)))))))))
 
 ;;----------------------------------------------------------------------------;;
 ;; Starting and watching projects                                             ;;
 ;;----------------------------------------------------------------------------;;
 
-(defun Omake.compile  (&optional read-command)
-  (interactive "P")
-  (warn "Omake.compile is gone.  Use Omake.start-project"))
+(defalias 'Omake.compile 'Omake.start-project)
 
 ;; Postcondition: a project for the current directory exists
 ;; and is being watched, unless the user cancels the opeation.
 (defun Omake.start-project (&optional read-command)
   "Create a project from the current directory."
   (interactive "P")
-  (Omake.with-updated-projects
-    (let* ((path (Filename.default-directory))
-           (id (Omake.Id.of-path path))
-           (root-dir (Omake.Path.omakeroot-dir path))
-           ;; path must be a full path for ocaml
-           (path (expand-file-name path))
-           (project (Omake.Project.find id)))
-      (catch 'exit
-        ;; If the project exists but is not being watched, watch it.
-        (if (and project (not (Omake.Project.is-watching id)))
-            (progn
-              (Omake.Project.watch id)
-              (Omake.show-status-buffer id))
-          ;; If it exists and is being watched, ask to kill and restart
+  (Omake.handle-errors
+    (Omake.with-updated-projects
+      (let* ((path (Filename.default-directory))
+             (id (Omake.Id.of-path path))
+             (root-dir (Omake.Path.omakeroot-dir path))
+             ;; path must be a full path for ocaml
+             (path (expand-file-name path))
+             (project (Omake.Project.find id)))
+        (catch 'exit
+          ;; If the project exists but is not being watched, watch it.
+          (when (and project (not (Omake.Project.is-watching id)))
+            (Omake.Project.watch id))
+          ;; If it exists, ask to kill and restart
           (when project
             (let* ((num-watchers (Omake.Project.num-watchers project))
                    (watch-msg
 (defun Omake.watch (&optional id)
   (interactive)
   (assert (or (null id) (Omake.Id.is id)))
-  (Omake.with-updated-projects
-    (let* ((ps (mapcar (lambda (p) (Omake.Id.to-string (Omake.Project.id p)))
-                       Omake.Project.list))
-           (ws (mapcar (lambda (m) (Omake.Id.to-string (Omake.Model.id m)))
-                       (Omake.Model.models)))
-           (ps (set-difference ps ws))
-           (cid (condition-case nil (Omake.Id.to-string (Omake.Id.current)) (error nil)))
-           (initial (when (member cid ps) cid))
-           (id (if id id (Omake.Id.of-path
-                          (completing-read "Project: " ps nil t initial)))))
-      (Omake.Project.watch id)
-      (Omake.show-status-buffer id))))
+  (Omake.handle-errors
+    (Omake.with-updated-projects
+      (let* ((ps (mapcar (lambda (p) (Omake.Id.to-string (Omake.Project.id p)))
+                         Omake.Project.list))
+             (ws (mapcar (lambda (m) (Omake.Id.to-string (Omake.Model.id m)))
+                         (Omake.Model.models)))
+             (ps (set-difference ps ws))
+             (cid (condition-case nil (Omake.Id.to-string (Omake.Id.current)) (error nil)))
+             (initial (when (member cid ps) cid))
+             (id (if id id (Omake.Id.of-path
+                            (completing-read "Project: " ps nil t initial)))))
+        (Omake.Project.watch id)
+        (Omake.show-status-buffer id)))))
 
 (defun Omake.unwatch (&optional id)
   (interactive)
   (assert (or (null id) (Omake.Id.is id)))
-  (Omake.with-updated-projects
-    (let* ((ps (mapcar (lambda (m) (Omake.Id.to-string (Omake.Model.id m)))
-                       (Omake.Model.models)))
-           (cid (condition-case nil (Omake.Id.current) (error nil)))
-           (initial (when (and cid (Omake.Model.has cid)) (Omake.Id.to-string cid)))
-           (id (if id id (Omake.Id.of-path
-                          (completing-read "Project: " ps nil t initial)))))
-      (Omake.Project.unwatch id))))
+  (Omake.handle-errors
+    (Omake.with-updated-projects
+      (let* ((ps (mapcar (lambda (m) (Omake.Id.to-string (Omake.Model.id m)))
+                         (Omake.Model.models)))
+             (cid (condition-case nil (Omake.Id.current) (error nil)))
+             (initial (when (and cid (Omake.Model.has cid)) (Omake.Id.to-string cid)))
+             (id (if id id (Omake.Id.of-path
+                            (completing-read "Project: " ps nil t initial)))))
+        (Omake.Project.unwatch id)))))
 
 (defun Omake.kill-project (&optional id &key force)
   "Kill a project"
   (interactive)
-  (Omake.with-updated-projects
-    (let* ((ps (mapcar (lambda (p) (Omake.Id.to-string (Omake.Project.id p)))
-                       Omake.Project.list))
-           (cid (condition-case nil (Omake.Id.current) (error nil)))
-           (initial (when (and cid (Omake.Model.has cid))
-                      (Omake.Id.to-string cid)))
-           (id (if id id (Omake.Id.of-path
-                          (completing-read "Project: " ps nil t initial)))))
-      (when (or force
-                (not Omake.prompt-before-killing-project)
-                (y-or-n-p (format "Really kill project %s "
-                                  (Omake.Id.to-string id))))
-        (Omake.Model.kill id)
-        (Omake.Server.kill-project id)
-        (message "Killed")))))
+  (Omake.handle-errors
+    (Omake.with-updated-projects
+      (let* ((ps (mapcar (lambda (p) (Omake.Id.to-string (Omake.Project.id p)))
+                         Omake.Project.list))
+             (cid (condition-case nil (Omake.Id.current) (error nil)))
+             (initial (when (and cid (Omake.Model.has cid))
+                        (Omake.Id.to-string cid)))
+             (id (if id id (Omake.Id.of-path
+                            (completing-read "Project: " ps nil t initial)))))
+        (when (or force
+                  (not Omake.prompt-before-killing-project)
+                  (y-or-n-p (format "Really kill project %s "
+                                    (Omake.Id.to-string id))))
+          (Omake.Model.kill id)
+          (Omake.Server.kill-project id)
+          (message "Killed"))))))
 
 (defun Omake.shutdown ()
   (interactive)
 
 (defun Omake.show-projects-buffer ()
   (interactive)
-  (Omake.Project.create-buffer :display t))
+  (Omake.with-updated-projects
+    (Omake.Project.create-buffer :display t)))
 
 ;;----------------------------------------------------------------------------;;
 ;; Env variables                                                              ;;
 ;;----------------------------------------------------------------------------;;
 
-;; CR sweeks: Do we need Omake.set-server-program anymore?
-(defun Omake.set-server-program (p)
-  (unless (equal Omake.Server.program p)
-    (if (Omake.Server.running-p)
-        (message "The server is running. Kill it with M-x Omake.shutdown before changing programs.")
-      (setq Omake.Server.program p))))
-
 (defun Omake.getenv ()
   (interactive)
   (let ((id (Omake.Id.current)))
   (let* ((id (if id id (Omake.Id.current)))
          (model (Omake.Model.get id))
          (eb (Omake.Buffer.get 'status (Omake.Project.current)))
-         (ws (Omake.choose-windows id nil))
+         (ws (Omake.choose-windows id))
          (ew (cdr ws)))
     (set-window-buffer ew eb)
     ws))

elisp/omake/omake-path.el

 ;; Paths                                                                      ;;
 ;;============================================================================;;
 
+(defun Omake.Path.is-tramp (path)
+  "Tramp filenames begin with /scp:.  We don't support tramp, but would like
+to give the user a good error message."
+  (assert (stringp path))
+  (string-match "^/scp:" path))
+
 (defun Omake.Path.ok (path)
   "A legal path has no spaces and doesn't end with a slash"
   (assert (stringp path))
+  (when (Omake.Path.is-tramp path) (signal 'Omake.Errors.tramp nil))
   (let ((legal (progn
                  (string-match "[.~a-zA-Z0-9/_-]*[.a-zA-Z0-9~_-]" path)
                  (match-string 0 path))))

elisp/omake/omake-project.el

 (defun Omake.Project.find (id)
   (assert (Omake.Id.is id))
   (List.find (lambda (p) (equal (Omake.Project.id p) id)) Omake.Project.list))
-;; (Omake.Project.find (Omake.Id.of-path "/home/seanmcl/ocaml"))
+;; (Omake.Project.find (Omake.Id.of-path "/home/seanmcl/ocaml/ocaml1"))
 
 (defun Omake.Project.watch (id)
   (assert (Omake.Id.is id))
          (dir (if (equal dir "") "." dir)))
     dir))
 
+(defun Omake.Project.show-dired-buffer (p)
+  (assert (Omake.Project.is p))
+  (let* ((id (Omake.Project.id p))
+         (dir (Omake.Project.compilation-dir p))
+         (ws (Omake.choose-windows id))
+         (code-window (car ws)))
+    (with-selected-window code-window
+      (dired dir))))
+
 (defun Omake.Project.to-line (i p)
   (assert (Omake.Project.is p))
   ;; Use lexical-let so we can put the line in a closure
           "Jump to the next error for the project on the given line."
           (interactive)
           (Omake.next-error nil id)))
+       (dired
+        (lambda ()
+          "Jump to the next error for the project on the given line."
+          (interactive)
+          (Omake.Project.show-dired-buffer p)))
        (line-keymap (make-sparse-keymap))
        (_ (define-key line-keymap "w" watch))
        (_ (define-key line-keymap "k" kill))
        (_ (define-key line-keymap "l" goto-error))
+       (_ (define-key line-keymap (kbd "C-m") dired))
        (fullroot (expand-file-name root))
        (dir (Omake.Project.compilation-dir-relpath p))
        (watched (if (Omake.Model.has id) "yes" "no"))
   w . toggle the watched/unwatched status of the project
   k . kill the project
   l . jump to the next error in the project
+  RET . open a dired buffer in the compilation-dir of the project
 "
   :group 'omake
   :lighter " Omake Project"
 ;; in the middle of a synchronous update when the async updating occurrs.
 ;; (defconst Omake.Project.buffer-semaphore (Semaphore.create))
 
+;; NB: Don't call Omake.Server.update-projects here (equivalently
+;; Omake.with-updated-projects.  It hammers the server.
 (defun* Omake.Project.create-buffer (&key display)
   (interactive)
-  (let* ((buf (Omake.Buffer.get 'projects))
-         (lines (List.mapi 'Omake.Project.to-line Omake.Project.list)))
-    (Buffer.edit-read-only buf
-      (let ((pt (point)))
-        (Buffer.clear buf)
-        (insertf "%3s %-8s %-11s %-25s %s \n\n" "" "watching" "#watching" "omakeroot" "dir")
-        (mapc 'insert lines)
-        (goto-char pt)
-        (omake-project-mode 1)))
-    (when display (display-buffer buf))))
+    (let* ((buf (Omake.Buffer.get 'projects))
+           (lines (List.mapi 'Omake.Project.to-line Omake.Project.list)))
+      (Buffer.edit-read-only buf
+        (let ((pt (point)))
+          (Buffer.clear buf)
+          (insertf "%3s %-8s %-11s %-25s %s \n\n" "" "watching" "#watching" "omakeroot" "dir")
+          (mapc 'insert lines)
+          (goto-char pt)
+          (omake-project-mode 1)))
+      (when display (display-buffer buf))))
 ;; (Omake.Project.create-buffer)
 
 (defun Omake.Project.update (ps)

elisp/omake/omake-version.el

 
 ;; Detect version changes
 
-(defconst Omake.pre-version 12
+(defconst Omake.pre-version 13
   "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

elisp/omake/omake-window.el

      (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"
+(defun Omake.choose-windows (id &optional code-buffer-opt)
+  "Return (code-window . error-window) and set the code and error buffers.
+code-buffer-opt is a buffer with ocaml code.  Used by Omake.Error.show when
+you're certain you have a buffer showing the correct file."
   (assert (Omake.Id.is id))
   (assert (or (null code-buffer-opt) (bufferp code-buffer-opt)))
   (Omake.check-dedicated)

elisp/omake/omake.el

 (require 'jane-lib)
 (require 'warnings)
 
+(require 'omake-file)
+(require 'omake-errors)
 (require 'omake-version)
 (require 'omake-custom)
 (require 'omake-face)
 (require 'omake-failure)
 (require 'omake-result)
 (require 'omake-status)
-(require 'omake-file)
 (require 'omake-buffer)
 (require 'omake-spinner)
 (require 'omake-project)

ocaml/omake/Makefile

 
 LIB=/usr/local/lib/ocaml/site-lib
 
-PP='camlp4o $(LIB)/type-conv/pa_type_conv.cma $(LIB)/sexplib/pa_sexp_conv.cma $(LIB)/fieldslib/pa_fields_conv.cma $(LIB)/pa_pipebang/pa_pipebang.cma'
+PP='camlp4o $(LIB)/type_conv/pa_type_conv.cma $(LIB)/sexplib/pa_sexp_conv.cma $(LIB)/fieldslib/pa_fields_conv.cma $(LIB)/pa_pipebang/pa_pipebang.cma'
 
 OCAMLOPT=ocamlfind ocamlopt -thread -w @a-4-7-9-29-28 \
         -pp $(PP) \
 FILES=          \
 process         \
 std             \
+id		\
+files		\
+log		\
 config		\
-id		\
+server_config   \
 elisp		\
 regex		\
 error		\
 omake		\
 version		\
-files		\
-log		\
 emacs		\
 env		\
 omake_command	\

ocaml/omake/config.ml

-
 open Std
 
-type t = {
-  omake_command : string;
-  kill_when_unwatched : bool;
-} with sexp
+module T = String.Table
+type t = string T.t
 
-let default = {
-  omake_command = "jomake -j 12";
-  kill_when_unwatched = true;
-}
+let create () = T.create ()
 
-let t = ref default
+let lookup t ~key ~default =
+  let key = String.lowercase key in
+  let default = String.lowercase default in
+  Hashtbl.find_or_add t key ~default:(fun () -> default)
 
-let getenv_exn key = match Sys.getenv key with
-| None -> failwithf "No env: %s" key ()
-| Some data -> data
+let read_file file =
+  try
+    let s = Sexp.load_sexp file in
+    let sexp_of_string s = String.lowercase (String.t_of_sexp s) in
+    Ok (T.t_of_sexp sexp_of_string s)
+  with exn -> Error exn
 
-let home = getenv_exn "HOME"
+let write_file f t =
+  let s = Sexp.to_string_hum (T.sexp_of_t String.sexp_of_t t) in
+  let header = ";; -*- scheme -*- ;;\n\n" in
+  Out_channel.write_all f ~data:(header ^ s)
 
-let config_dir = sprintf "%s/.omake-server" home
-
-let config_file = sprintf "%s/config" config_dir
-
-let has_config_file () = Sys.file_exists_exn config_file
-
-let write_default_file () =
-  if not (has_config_file ()) then
-    Out_channel.write_lines config_file
-      [";; -*- scheme -*- ;;"; ""; Sexp.to_string_hum (sexp_of_t default) ]
-
-let init () =
-  begin
-    Shell.mkdir ~p:() config_dir;
-    write_default_file ();
-    let chan = open_in config_file in
-    t := t_of_sexp (Sexp.input_sexp chan)
-  end
-
-(* CR smclaughlin: maybe I shouldn't do this at load-time. *)
-let _ = init ()
-
-let omake_command () = !t.omake_command
-let kill_when_unwatched () = !t.kill_when_unwatched
+let update t ~key ~value =
+  let key = String.lowercase key in
+  let value = String.lowercase value in
+  T.replace t ~key ~data:value

ocaml/omake/config.mli

 
 open Std
 
-val omake_command : unit -> string
-val kill_when_unwatched : unit -> bool
+type t
+
+val create : unit -> t
+val read_file : string -> t result
+val write_file : string -> t -> unit
+
+val lookup : t -> key:string -> default:string -> string
+val update : t -> key:string -> value:string -> unit

ocaml/omake/env.ml

 open Std
 
 type var =
-| X_LIBRARY_INLINING
+| FOUR_POINT_ZERO
+| LIMIT_SUBDIRS_FOR_SPEED
 | LINK_EXECUTABLES
 | VERSION_UTIL_SUPPORT
-| LIMIT_SUBDIRS_FOR_SPEED
-| FOUR_POINT_ZERO
+| X_LIBRARY_INLINING
 with sexp
 
 let var_to_string x = Sexp.to_string (sexp_of_var x)
 let var_of_string x = var_of_sexp (Sexp.of_string x)
 
-type t = {
-  version_util_support : bool;
-  link_executables : bool;
-  x_library_inlining : bool;
-  limit_subdirs_for_speed : bool;
-  four_point_zero : bool;
-} with sexp, fields
+type t = Config.t
 
-let value t = function
-| X_LIBRARY_INLINING -> t.x_library_inlining
-| LINK_EXECUTABLES -> t.link_executables
-| VERSION_UTIL_SUPPORT -> t.version_util_support
-| LIMIT_SUBDIRS_FOR_SPEED -> t.limit_subdirs_for_speed
-| FOUR_POINT_ZERO -> t.four_point_zero
+(* These defaults should match the variables in OMakeroot.  We
+   thought about parsing OMakeroot to get the defaults, but decided
+   it was too much trouble.  They shouldn't ever change. *)
+let default = function
+| FOUR_POINT_ZERO         -> false
+| LIMIT_SUBDIRS_FOR_SPEED -> false
+| LINK_EXECUTABLES        -> true
+| VERSION_UTIL_SUPPORT    -> true
+| X_LIBRARY_INLINING      -> true
+
+let all_vars =
+  [ FOUR_POINT_ZERO
+  ; LIMIT_SUBDIRS_FOR_SPEED
+  ; LINK_EXECUTABLES
+  ; VERSION_UTIL_SUPPORT
+  ; X_LIBRARY_INLINING ]
+
+let value t v =
+  let key = var_to_string v in
+  let default = Bool.to_string (default v) in
+  Bool.of_string (Config.lookup t ~key ~default)
 
 let to_elisp t = sprintf "
       (Omake.Env.create
+        :four-point-zero %s
+        :limit-subdirs-for-speed %s
+        :link-executables %s
         :version-util-support %s
-        :link-executables %s
-        :x-library-inlining %s
-        :limit-subdirs-for-speed %s
-        :four-point-zero %s)"
-  (Elisp.env_value t.version_util_support)
-  (Elisp.env_value t.link_executables)
-  (Elisp.env_value t.x_library_inlining)
-  (Elisp.env_value t.limit_subdirs_for_speed)
-  (Elisp.env_value t.four_point_zero)
+        :x-library-inlining %s)"
+  (Elisp.env_value (value t FOUR_POINT_ZERO))
+  (Elisp.env_value (value t LIMIT_SUBDIRS_FOR_SPEED))
+  (Elisp.env_value (value t LINK_EXECUTABLES))
+  (Elisp.env_value (value t VERSION_UTIL_SUPPORT))
+  (Elisp.env_value (value t X_LIBRARY_INLINING))
 
-  (*** make sure all the env variables are set. ***)
-
+(* Make sure all the env variables are set. *)
 let () =
-  let assure_set ~default ~key =
+  let assure_set key =
+    let default = Bool.to_string (default key) in
+    let key = var_to_string key in
     match Sys.getenv key with
     | None -> Unix.putenv ~key ~data:default
     | Some _ -> ()
   in
-    (* These defaults should match the variables in OMakeroot.  We
-       thought about parsing OMakeroot to get the defaults, but decided
-       it was too much trouble.  They shouldn't ever change. *)
-  begin
-    assure_set ~default:"true"  ~key:"VERSION_UTIL_SUPPORT"   ;
-    assure_set ~default:"true"  ~key:"LINK_EXECUTABLES"       ;
-    assure_set ~default:"true"  ~key:"X_LIBRARY_INLINING"     ;
-    assure_set ~default:"false" ~key:"LIMIT_SUBDIRS_FOR_SPEED";
-    assure_set ~default:"false" ~key:"FOUR_POINT_ZERO";
-  end
+  List.iter ~f:assure_set all_vars
 
-  (* Save the variables in a file in ~/.omake-server/PROJ/env.sexp *)
+(* Save the variables in a file in ~/.omake-server/PROJ/env.sexp *)
 
 let get_exn key = match Sys.getenv key with
 | None -> failwithf "No env: %s" key ()
 let save id t =
   let ids = Id.to_string id in
   Shell.mkdir ~p:() (env_dir ids);
-  Writer.save_sexp (env_file ids) (sexp_of_t t)
+  Config.write_file (env_file ids) t
 
-  (* Read the initial state of the variables out of the process environment
-     if there is no file.  We do this instead of using the defaults because
-     the user may set the variable in their .bashrc *)
+let ensure_set t var =
+  let env key = get_exn (var_to_string key) |! Bool.of_string in
+  let key = var_to_string var in
+  let default = Bool.to_string (env var) in
+  ignore (Config.lookup t ~key ~default)
+
+(* Read the initial state of the variables out of the process environment
+   if there is no file.  We do this instead of using the defaults because
+   the user may set the variable in their .bashrc *)
 let create_default id =
-  let get_bool_exn key = get_exn key |! Bool.of_string in
-  let t = {
-    version_util_support = get_bool_exn "VERSION_UTIL_SUPPORT";
-    link_executables = get_bool_exn "LINK_EXECUTABLES";
-    x_library_inlining = get_bool_exn "X_LIBRARY_INLINING";
-    limit_subdirs_for_speed = get_bool_exn "LIMIT_SUBDIRS_FOR_SPEED";
-    four_point_zero = get_bool_exn "FOUR_POINT_ZERO";
-  }
-  in
-  save id t >>| fun () ->
+  let t = Config.create () in
+  List.iter ~f:(ensure_set t) all_vars;
+  save id t;
   t
 
 let get id =
   let file = env_file (Id.to_string id) in
-  Asys.file_exists_exn file >>= function
-  | true ->
+  if Sys.file_exists_exn file then
     begin
-      Reader.load_sexp file t_of_sexp >>= function
-      | Ok t -> return t
-      | Error error ->
+      match Config.read_file file with
+      | Ok t ->
+        List.iter ~f:(ensure_set t) all_vars;
+        save id t;
+        t
+      | Error exn ->
         Log.printf
           "Can't read env file for %s (%s).  Writing new file from bash env."
           (Id.to_string id)
-          (Exn.to_string error);
+          (Exn.to_string exn);
         create_default id
     end
-  | false -> create_default id
+  else
+    create_default id
 
 (* Set the variable of a project. *)
 let set id x b =
-  get id >>= fun t ->
-  let t = match x with
-  | X_LIBRARY_INLINING -> {t with x_library_inlining = b}
-  | VERSION_UTIL_SUPPORT -> {t with version_util_support = b}
-  | LINK_EXECUTABLES -> {t with link_executables = b}
-  | LIMIT_SUBDIRS_FOR_SPEED -> {t with limit_subdirs_for_speed = b}
-  | FOUR_POINT_ZERO -> {t with four_point_zero = b}
-  in
+  let t = get id in
+  Config.update t ~key:(var_to_string x) ~value:(Bool.to_string b);
   save id t
 
 (* Set the variables before starting the process. *)
 let set_env t =
-  begin
-    Unix.putenv ~key:(var_to_string X_LIBRARY_INLINING) ~data:(string_of_bool t.x_library_inlining);
-    Unix.putenv ~key:(var_to_string LINK_EXECUTABLES) ~data:(string_of_bool t.link_executables);
-    Unix.putenv ~key:(var_to_string VERSION_UTIL_SUPPORT) ~data:(string_of_bool t.version_util_support);
-    Unix.putenv ~key:(var_to_string LIMIT_SUBDIRS_FOR_SPEED) ~data:(string_of_bool t.limit_subdirs_for_speed);
-    Unix.putenv ~key:(var_to_string FOUR_POINT_ZERO) ~data:(string_of_bool t.four_point_zero);
-  end
+  let put k =
+    let key = var_to_string k in
+    let default = Bool.to_string (default k) in
+    let data = Config.lookup t ~key ~default in
+    Unix.putenv ~key ~data
+  in
+  List.iter ~f:put all_vars

ocaml/omake/env.mli

 open Std
 
 type var =
-| X_LIBRARY_INLINING
+| FOUR_POINT_ZERO
+| LIMIT_SUBDIRS_FOR_SPEED
 | LINK_EXECUTABLES
 | VERSION_UTIL_SUPPORT
-| LIMIT_SUBDIRS_FOR_SPEED
-| FOUR_POINT_ZERO
+| X_LIBRARY_INLINING
 with sexp
 
 val var_to_string : var -> string
 val var_of_string : string -> var
 
-type t = {
-  version_util_support : bool;
-  link_executables : bool;
-  x_library_inlining : bool;
-  limit_subdirs_for_speed : bool;
-  four_point_zero : bool;
-}
+type t
 
 val value : t -> var -> bool
 
 val to_elisp : t -> Elisp.t
-val get : Id.t -> t deferred
-val set : Id.t -> var -> bool -> unit deferred
+val get : Id.t -> t
+val set : Id.t -> var -> bool -> unit
 val set_env : t -> unit

ocaml/omake/files.ml

 
 open Std
 
+let check_perms f = match Unix.access f [`Read; `Write] with
+| Ok () -> ()
+| Error _ ->
+  begin
+    printf "I can't read and write %s.  Please fix the permissions and try again.\n" f;
+    exit 1
+  end
+
 let shared_root = "/tmp/omake-server"
 let _ = Shell.mkdir ~p:() ~perm:0o777 shared_root
+let _ = check_perms shared_root
 let user = Shell.whoami ()
 let root = sprintf "%s/%s" shared_root user
 let _ = Shell.mkdir ~p:() root
+let _ = check_perms root
 
 let project_dir id =
   let dir = sprintf "%s%s" root (Id.to_string id) in
 | "/" | "" -> None
 | p ->
   match
-    Array.findi (Sys.readdir p) ~f:(fun _ -> function "OMakeroot" -> true | _ -> false)
+    Array.findi (Sys.readdir p)
+      ~f:(fun _ -> function "OMakeroot" -> true | _ -> false)
   with
   | Some _ -> Some p
   | None -> omakeroot_dir (Filename.dirname p)

ocaml/omake/omake.ml

 
 open Std
 
-type error = Error.t with sexp
-
 (* -------------------------------------------------------------------------- *)
 (*  Util                                                                      *)
 (* -------------------------------------------------------------------------- *)
     let error6 = " *Error: Files" in
     let error7 = " *File \".*\\.cmx\"" in
     let error8 = "\\*\\*\\* omake: deadlock" in
-    Regex.of_string (sprintf "(%s|%s|%s|%s|%s|%s|%s|%s)"
-                       error1 error2 error3 error4 error5 error6 error7 error8)
+    let error9 = "ocamlfind: Package `.*' not found" in
+    Regex.of_string (sprintf "(%s|%s|%s|%s|%s|%s|%s|%s|%s)"
+                       error1 error2 error3 error4 error5 error6
+                       error7 error8 error9)
 end
 
 (* -------------------------------------------------------------------------- *)
   type t = {
     msg : string;
     window : string;
-  } with sexp
+  } with sexp_of
   val equal : t -> t -> bool
   val to_string : t -> string
 end = struct
   type t = {
     msg : string;
     window : string;
-  } with sexp
+  } with sexp_of
   let equal { msg; window } { msg = m; window = w } = msg = m && window = w
   let to_string = Sexp.to_string_hum ** sexp_of_t
 end
   | Reading_omakefiles_failed
   | Finished_omakefiles
   | Building
-  with sexp
+  with sexp_of
   let to_string s = Sexp.to_string (sexp_of_t s)
   let to_elisp = function
     | Starting -> "Omake.Status.Starting"
     | Reading_omakefiles_failed -> "Omake.Status.Reading_omakefiles_failed"
     | Finished_omakefiles -> "Omake.Status.Finished_omakefiles"
     | Building -> "Omake.Status.Building"
+  let _ = ignore_unused_warning (to_string)
 end
 
 (* -------------------------------------------------------------------------- *)
   | Refresh_file of [`Dir of path] * [`Filename_with_no_extension of string]
   | Done
   | Last_line of string
-  with sexp
+  with sexp_of
   val parse_events : string Pipe.Reader.t -> t result Pipe.Reader.t
 end = struct
   type t =
   | Refresh_file of [`Dir of path] * [`Filename_with_no_extension of string]
   | Done
   | Last_line of string
-  with sexp
+  with sexp_of
 
   let parse_events string_reader =
     let (event_reader, event_writer) = Pipe.create () in

ocaml/omake/project.ml

       (* cd to the directory where omake should run *)
       Asys.chdir compilation_dir >>= fun () ->
       (* set the environment *)
-      Env.get id >>= fun env ->
+      let env = Env.get id in
       Env.set_env env;
       let new_env = env in
       (* start omake *)
 let kill_when_unwatched t =
   let ivar = Ivar.create () in
   let stop = Ivar.read ivar in
-  if Config.kill_when_unwatched () then
+  if Server_config.kill_when_unwatched () then
     Clock.every'
       ~start:(Clock.after (Time.Span.of_sec 3.))
       ~stop

ocaml/omake/query.ml

           begin
             let proj = Projects.get_exn id in
             Emacs.unwatch t id;
-            if Config.kill_when_unwatched () && Project.num_watching proj = 0 then
+            if Server_config.kill_when_unwatched () && Project.num_watching proj = 0 then
               begin
                 Log.printf "Killing unwatched project: %s" (Id.to_string id);
                 Projects.kill (id, None)
         Deferred.unit
       end
     | Get_project_env (id, x) ->
-      Env.get id >>| fun env ->
+      let env = Env.get id in
       let b = Env.value env x in
       let res = if b then "'true" else "'false" in
-      Emacs.Sync.send writer "%s" res
+      Emacs.Sync.send writer "%s" res;
+      Deferred.unit
     | Set_project_env (id, x, b) ->
       let p = Projects.get_exn id in
-      Env.set id x b >>= fun () ->
+      Env.set id x b;
       Log.printf "Server: %s set to %b" (Env.var_to_string x) b;
-      Env.get id >>= fun env ->
+      let env = Env.get id in
       p.Project.new_env <- env;
       Projects.update_all ()
     | Running -> Deferred.unit
     | Kill_when_unwatched ->
-      Writer.writef writer "%s\n" (Elisp.bool (Config.kill_when_unwatched ()));
+      Writer.writef writer "%s\n" (Elisp.bool (Server_config.kill_when_unwatched ()));
       Deferred.unit
     | Omake_command ->
-      Writer.writef writer "%s\n" (String.quote (Config.omake_command ()));
+      Writer.writef writer "%s\n" (String.quote (Server_config.omake_command ()));
       Deferred.unit)
   >>| function
   | Error exn ->

ocaml/omake/server.ml

 
 let start () =
   (* Ignore SIGTERM due to a bug where emacsclient mysteriously
-     kills the server. (Issue #56) *)
-  Signal.handle [Signal.term] ~f:ignore;
+     kills the server. (Issue #56)
+     Update: Try to remove this, as it makes it harder to kill the server. *)
+  (* Signal.handle [Signal.term] ~f:ignore; *)
   Ashell.rm Files.socket >>= fun () ->
   (* Wait for the log to open *)
   Log.wait ()
         Reader.close reader >>= fun () ->
         failwith "Read error"
       | `Ok s ->
+        (* Don't close the reader.  The writer gets saved in the hashtable. *)
         Log.printf "omake server received: %s" (Sexp.to_string s);
-        (* Don't close the reader.  The writer gets saved in the hashtable. *)
+        (* When Emacs is killed, the server will still be writing messages to
+           its writer for a few seconds until the server notices emacs is dead.
+           Ignore the pipe failures. *)
+        Writer.set_raise_epipe writer false;
         Query.handle writer (Query.t_of_sexp s)) >>= function
     | Ok () -> Deferred.unit
     | Error exn ->

ocaml/omake/server_config.ml

+
+open Std
+
+type t = Config.t
+
+let default_omake_command = "jomake -j 12"
+let default_kill_when_unwatched = true
+
+let omake_command (t:t) =
+  Config.lookup t ~key:"omake_command" ~default:default_omake_command
+
+let kill_when_unwatched t =
+  Config.lookup t ~key:"kill_when_unwatched"
+    ~default:(Bool.to_string default_kill_when_unwatched)
+
+let ensure_all_fields t =
+  begin
+    ignore (omake_command t);
+    ignore (kill_when_unwatched t);
+  end
+
+let default =
+  let t = Config.create () in
+  ensure_all_fields t;
+  t
+
+let t = ref default
+
+let getenv_exn key = match Sys.getenv key with
+| None -> failwithf "No env: %s" key ()
+| Some data -> data
+
+let home = getenv_exn "HOME"
+
+let config_dir = sprintf "%s/.omake-server" home
+
+let config_file = sprintf "%s/config" config_dir
+
+let has_config_file () = Sys.file_exists_exn config_file
+
+let write_default_file () =
+  if not (has_config_file ()) then
+    Config.write_file config_file default
+
+let init () =
+  begin
+    Shell.mkdir ~p:() config_dir;
+    write_default_file ();
+    match Config.read_file config_file with
+    | Ok c ->
+      ensure_all_fields c;
+      t := c
+    | Error exn ->
+      Log.printf "Can't read server config file (%s)." config_file;
+      Log.printf "  (%s)" (Exn.to_string exn);
+      t := default
+  end
+
+(* CR smclaughlin: maybe I shouldn't do this at load-time. *)
+let _ = init ()
+
+let omake_command () = omake_command (!t)
+let kill_when_unwatched () = Bool.of_string (kill_when_unwatched (!t))

ocaml/omake/server_config.mli

+
+open Std
+
+val omake_command : unit -> string
+val kill_when_unwatched : unit -> bool

ocaml/omake/std.ml

   module Hash_set = Hash_set
   module Hashable = Hashable
   module Hashtbl = Hashtbl
+  module In_channel = In_channel
   module Int = Int
   module List = List
   module Option = Option
 let ( ** ) f g x = f (g x)
 
 let some x = Some x
+
+let ignore_unused_warning x = x

ocaml/omake/top.ml

       let compilation_dir = dir in
       let user_command = match cmd with
       | Some c -> c
-      | None -> Config.omake_command ()
+      | None -> Server_config.omake_command ()
       in
       let c = { Project.Create.id; omakeroot_dir; compilation_dir; user_command } in
       send (Q.Create_project c))

ocaml/omake/version.ml

 
 (* Use a version number to synchronize with the elisp code. *)
-let version = 12
+let version = 13