[MLton-commit] r4011 - mlton/trunk/ide/emacs

MLton@mlton.org MLton@mlton.org
Sat, 20 Aug 2005 03:09:32 -0700


Author: vesak
Date: 2005-08-20 03:09:26 -0700 (Sat, 20 Aug 2005)
New Revision: 4011

Modified:
   mlton/trunk/ide/emacs/esml-gen.el
   mlton/trunk/ide/emacs/esml-mlb-mode.el
   mlton/trunk/ide/emacs/esml-util.el
Log:
Support <longstrid> as an annotation value.  Proper completion of paths
starting with "../".  No longer using eval-when-compile with require as
it makes compiled files unusable.


Modified: mlton/trunk/ide/emacs/esml-gen.el
===================================================================
--- mlton/trunk/ide/emacs/esml-gen.el	2005-08-20 03:43:25 UTC (rev 4010)
+++ mlton/trunk/ide/emacs/esml-gen.el	2005-08-20 10:09:26 UTC (rev 4011)
@@ -3,9 +3,8 @@
 ;; MLton is released under a BSD-style license.
 ;; See the file MLton-LICENSE for details.
 
-(eval-when-compile
-  (require 'cl)
-  (require 'esml-util))
+(require 'cl)
+(require 'esml-util)
 
 ;; Installation
 ;; ============

Modified: mlton/trunk/ide/emacs/esml-mlb-mode.el
===================================================================
--- mlton/trunk/ide/emacs/esml-mlb-mode.el	2005-08-20 03:43:25 UTC (rev 4010)
+++ mlton/trunk/ide/emacs/esml-mlb-mode.el	2005-08-20 10:09:26 UTC (rev 4011)
@@ -3,9 +3,8 @@
 ;; MLton is released under a BSD-style license.
 ;; See the file MLton-LICENSE for details.
 
-(eval-when-compile
-  (require 'cl)
-  (require 'esml-util))
+(require 'cl)
+(require 'esml-util)
 
 ;; Emacs mode for editing ML Basis files
 ;;
@@ -71,7 +70,7 @@
     ("allowPrim" "false" "true")
     ("allowRebindEquals" "false" "true")
     ("deadCode" "false" "true")
-    ("ffiStr" "[A-Za-z0-9_]*")
+    ("ffiStr" "<longstrid>")
     ("forceUsed")
     ("nonexhaustiveExnMatch" "default" "ignore")
     ("nonexhaustiveMatch" "warn" "ignore" "error")
@@ -82,7 +81,7 @@
   :type '(repeat (cons :tag "Annotation"
                        (string :tag "Name")
                        (repeat :tag "Values starting with the default"
-                               regexp)))
+                               string)))
   :set 'esml-mlb-set-custom-and-update
   :group 'esml-mlb)
 
@@ -166,10 +165,7 @@
                                                (apply 'call-process
                                                       (car cmd-and-args) nil t nil (cdr cmd-and-args)))
                                            (error -1)))
-                                        (esml-replace-regexp-in-string
-                                         (buffer-string)
-                                         "{[ \t]*None[ \t]*|[ \t]*Some[ \t]*<[^>]+>}"
-                                         "{[A-Za-z0-9_]*}")
+                                        (buffer-string)
                                       (message "Show annotations command failed.")
                                       ""))
                                   "[ \t]*\n+[ \t]*"))))
@@ -241,6 +237,14 @@
 (defconst esml-mlb-unquoted-path-or-ref-chars
   (concat esml-mlb-unquoted-path-chars "()$"))
 
+(defun esml-mlb-<token>-to-regexp (<token>)
+  (let* ((<token>-to-regexp
+          '(("<longstrid>" . "[A-Za-z0-9_]*")))
+         (<token>-regexp (assoc <token> <token>-to-regexp)))
+    (if <token>-regexp
+        (cdr <token>-regexp)
+      <token>)))
+
 (defconst esml-mlb-keywords
   '("and" "ann" "bas" "basis" "end" "functor" "in" "let" "local" "open"
     "signature" "structure")
@@ -293,9 +297,14 @@
                            (concat (car name-values) "[ \t\n]+\\("
                                    (reduce (function
                                             (lambda (r s)
-                                              (concat r "\\|\\(" s "\\)")))
+                                              (concat r "\\|\\("
+                                                      (esml-mlb-<token>-to-regexp s)
+                                                      "\\)")))
                                            (cddr name-values)
-                                           :initial-value (concat "\\(" (cadr name-values) "\\)"))
+                                           :initial-value (concat "\\("
+                                                                  (esml-mlb-<token>-to-regexp
+                                                                   (cadr name-values))
+                                                                  "\\)"))
                                    "\\)")
                          (car name-values))
                        regexps)))
@@ -443,13 +452,17 @@
    ((esml-point-preceded-by (concat "\"[ \t\n]*\\("
                                     (regexp-opt (mapcar 'car esml-mlb-annotations))
                                     "\\)[ \t\n]+\\(" esml-mlb-str-chr-regexp "*\\)"))
-    ;; TBD: do not auto-complete non-trivial regexps
     (let* ((annot (assoc (match-string 1) esml-mlb-annotations))
-           (values (cdr annot))
+           (all-values (cdr annot))
+           (values (remove* nil all-values
+                            :test (function
+                                   (lambda (_ s)
+                                     (and (< 0 (length s))
+                                          (= ?< (aref s 0)))))))
            (value-prefix (match-string 2))
            (value-completion (try-completion value-prefix (mapcar 'list values)))
            (value (if (eq t value-completion) value-prefix value-completion)))
-      (message "Annotation: %s %s" (car annot) (if values values ""))
+      (message "Annotation: %s %s" (car annot) (if all-values all-values ""))
       (when (stringp value-completion)
         (esml-insert-or-skip-if-looking-at
          (substring value (length value-prefix))))
@@ -526,7 +539,9 @@
                                      nondir-prefix
                                      (mapcar 'list esml-mlb-keywords))
                                     files))
-                        (esml-mlb-filter-file-completions files)))))
+                        (esml-mlb-filter-file-completions
+                         files
+                         (esml-string-matches-p "\\(\.\./\\)+" dir))))))
            (nondir-completion (try-completion nondir-prefix nondir-completions))
            (nondir (if (eq t nondir-completion)
                        nondir-prefix
@@ -541,10 +556,10 @@
         (if (eq t (try-completion nondir nondir-completions))
             (cond ((file-name-directory nondir)
                    (message "Completions: %s"
-                            (sort (esml-mlb-filter-file-completions
-                                   (file-name-all-completions
-                                    ""
-                                    (concat dir nondir)))
+                            (sort (let ((dir (concat dir nondir)))
+                                    (esml-mlb-filter-file-completions
+                                     (file-name-all-completions "" dir)
+                                     (esml-string-matches-p "\\(\.\./\\)+" dir)))
                                   'string-lessp)))
                   ((member nondir esml-mlb-keywords)
                    (esml-mlb-indent-line)

Modified: mlton/trunk/ide/emacs/esml-util.el
===================================================================
--- mlton/trunk/ide/emacs/esml-util.el	2005-08-20 03:43:25 UTC (rev 4010)
+++ mlton/trunk/ide/emacs/esml-util.el	2005-08-20 10:09:26 UTC (rev 4011)
@@ -3,8 +3,7 @@
 ;; MLton is released under a BSD-style license.
 ;; See the file MLton-LICENSE for details.
 
-(eval-when-compile
-  (require 'cl))
+(require 'cl)
 
 ;; Some general purpose Emacs Lisp utility functions
 
@@ -34,19 +33,23 @@
     (insert str)))
 
 ;; workaround for incompatibility between GNU Emacs and XEmacs
-(if (string-match "XEmacs" emacs-version)
-    (defun esml-split-string (string separator)
-      (split-string string separator t))
-  (defun esml-split-string (string separator)
+(defun esml-split-string (string separator)
+  (if (string-match "XEmacs" emacs-version)
+      (split-string string separator t)
     (remove* "" (split-string string separator))))
 
 ;; workaround for incompatibility between GNU Emacs and XEmacs
-(if (string-match "XEmacs" emacs-version)
-    (defun esml-replace-regexp-in-string (str regexp rep)
-      (replace-in-string str regexp rep t))
-  (defun esml-replace-regexp-in-string (str regexp rep)
+(defun esml-replace-regexp-in-string (str regexp rep)
+  (if (string-match "XEmacs" emacs-version)
+      (replace-in-string str regexp rep t)
     (replace-regexp-in-string regexp rep str t t)))
 
+(defun esml-string-matches-p (regexp str)
+  "Non-nil iff the entire string matches the regexp."
+  (and (string-match regexp str)
+       (= 0 (match-beginning 0))
+       (= (length str) (match-end 0))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (provide 'esml-util)