[nongnu] externals/caml fc4b394 017/197: some changes due to ITZ

[Stefan Monnier]

branch: externals/caml
commit fc4b394b3d1d1b84c5aac671f51d711a91d53e08
Author: Jacques Garrigue <garrigue at math.nagoya-u.ac.jp>
Commit: Jacques Garrigue <garrigue at math.nagoya-u.ac.jp>

    some changes due to ITZ
    
    
    git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@2238 
f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
---
 .cvsignore   |   1 +
 Makefile     |  15 +++++--
 README       |  10 +++--
 caml-font.el |   1 +
 caml.el      |   7 +++-
 ocamltags.in | 127 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 6 files changed, 153 insertions(+), 8 deletions(-)

diff --git a/.cvsignore b/.cvsignore
new file mode 100644
index 0000000..ea6381f
--- /dev/null
+++ b/.cvsignore
@@ -0,0 +1 @@
+ocamltags
diff --git a/Makefile b/Makefile
index 56ee612..a9a4c67 100644
--- a/Makefile
+++ b/Makefile
@@ -1,5 +1,6 @@
 # Files to install
-FILES=caml-font.el caml-hilit.el caml.el camldebug.el inf-caml.el
+FILES= caml-font.el caml-hilit.el caml.el camldebug.el \
+       inf-caml.el caml-compat.el
 
 # Where to install. If empty, automatically determined.
 #EMACSDIR=
@@ -7,6 +8,9 @@ FILES=caml-font.el caml-hilit.el caml.el camldebug.el 
inf-caml.el
 # Name of Emacs executable
 EMACS=emacs
 
+# Where to install ocamltags script
+SCRIPTDIR = /usr/local/bin
+
 # Command for byte-compiling the files
 COMPILECMD=(progn \
               (setq load-path (cons "." load-path)) \
@@ -14,6 +18,10 @@ COMPILECMD=(progn \
               (byte-compile-file "inf-caml.el") \
               (byte-compile-file "camldebug.el"))
 
+ocamltags:     ocamltags.in
+       sed -e 's:@EMACS@:$(EMACS):' ocamltags.in >ocamltags
+       chmod a+x ocamltags
+
 install:
        @if test "$(EMACSDIR)" = ""; then \
           set xxx `($(EMACS) --batch --eval "(mapcar 'print load-path)") \
@@ -28,11 +36,12 @@ install:
           $(MAKE) simple-install; \
         fi
 
-simple-install:
+simple-install:  ocamltags
        @echo "Installing in $(EMACSDIR)..."
        if test -d $(EMACSDIR); then : ; else mkdir -p $(EMACSDIR); fi
        cp $(FILES) $(EMACSDIR)
        cd $(EMACSDIR); $(EMACS) --batch --eval '$(COMPILECMD)'
+       cp ocamltags $(SCRIPTDIR)/ocamltags
 
 clean:
-       rm -f *~ #*#
+       rm -f ocamltags *~ #*#
diff --git a/README b/README
index 57ed492..72fe677 100644
--- a/README
+++ b/README
@@ -1,4 +1,4 @@
-           O'Caml emacs mode, version 2.01 of 1998/10/14
+           O'Caml emacs mode, version 2.01+ of 1998/12/16
 
 The files in this archive define a caml-mode for emacs, for editing
 Objective Caml and Objective Label programs, as well as an
@@ -54,10 +54,14 @@ For other bindings, see C-h b.
 
 Changes log:
 -----------
+Version 2.01+:
+--------------
+* corrected a bug in caml-font.el <Adam P. Jenkins>
+
+* corrected abbreviations and added ocamltags script <Ian T Zimmerman>
+
 Version 2.01:
 ------------
-* abbreviation code corrected by ITZ
-
 * code for interactive errors added by ITZ
 
 Version 2.00:
diff --git a/caml-font.el b/caml-font.el
index bfd97c2..3366ab0 100644
--- a/caml-font.el
+++ b/caml-font.el
@@ -104,6 +104,7 @@
                   nil nil ((?' . "w") (?_ . "w")))))
          (t
           (setq font-lock-keywords inferior-caml-font-lock-keywords)))
+        (make-local-variable 'font-lock-keywords-only)
         (setq font-lock-keywords-only t)
         (font-lock-mode 1)))
 
diff --git a/caml.el b/caml.el
index 5b6e469..e6cbcc2 100644
--- a/caml.el
+++ b/caml.el
@@ -1533,8 +1533,11 @@ by |, insert one."
                            (current-column)))
                  (abbrev-correct (if (= last-command-char ?\ ) 1 0)))
              (indent-to (- indent
-                           (symbol-value
-                            (nth 1 (assoc kw caml-leading-kwops-alist)))
+                           (or
+                             (symbol-value
+                              (nth 1
+                                   (assoc kw caml-leading-kwops-alist)))
+                             0)
                            abbrev-correct)))))))
 
 (defun caml-indent-phrase ()
diff --git a/ocamltags.in b/ocamltags.in
new file mode 100644
index 0000000..68bdc01
--- /dev/null
+++ b/ocamltags.in
@@ -0,0 +1,127 @@
+":" ; @EMACS@ -batch -l $0 "$@" ; status=$? ; : '--*-Emacs-Lisp-*--' <<';'
+
+(require 'caml)
+
+;;itz Fri Oct 30 13:08:37 PST 1998 support for creating TAGS files
+(defun caml-tags-next-phrase ()
+  (re-search-forward (concat "^" caml-phrase-start-keywords) nil 'move)
+  (while (and (not (eobp))
+              (or (caml-in-comment-p)
+                  (caml-in-literal-p)
+                  (not (let ((p (point)))
+                         (condition-case nil
+                             (caml-mark-phrase)
+                           (error (goto-char p) nil))))))
+    (forward-line 1))
+  (not (eobp)))
+
+(defun caml-tags-file (filename output-buffer)
+  (let* ((basename (file-name-nondirectory filename))
+         (done nil)
+         (current-line 1)
+         last-phrase-point file-buffer)
+    (set-buffer output-buffer)
+    (insert "\n" basename ",\n")
+    (find-file-read-only filename)
+    (caml-mode)
+    (setq file-buffer (current-buffer))
+    (goto-char (point-min))
+    (setq last-phrase-point (point))
+    (while (caml-tags-next-phrase)
+      (save-excursion
+        (re-search-forward caml-phrase-start-keywords)
+        (let ((done nil))
+          (while (not done)
+            (cond
+             ((looking-at "\\s ")
+              (skip-syntax-forward " "))
+             ((char-equal (following-char) ?\( )
+              (forward-sexp 1))
+             ((char-equal (following-char) ?')
+              (skip-syntax-forward "w_"))
+             ((looking-at "\\(type\\|rec\\)\\>")
+              (goto-char (match-end 0)))
+             (t (setq done t)))))
+        (re-search-forward "\\(\\sw\\|\\s_\\)+")
+        (beginning-of-line 1)
+        (setq current-line
+              (+ current-line (count-lines last-phrase-point (point))))
+        (setq last-phrase-point (point))
+        (end-of-line 1)
+        (let ((output-line (format "%%s
%d,%d\n"
+                                   (buffer-substring last-phrase-point (point))
+                                   (match-string 0)
+                                   current-line
+                                   (match-beginning 0))))          
+          (set-buffer output-buffer)
+          (insert output-line)))
+      (exchange-point-and-mark))
+    (kill-buffer file-buffer)))
+
+(defsubst prefix-p (prefix str)
+  (and (<= (length prefix) (length str))
+       (string= prefix (substring str 0 (length prefix)))))
+
+(defsubst eat-args (n)
+  (setq command-line-args-left (nthcdr n command-line-args-left)))
+
+;; see Emacs source file print.c
+(defun print-error-message (data)
+  (let ((errname (car data)) errmsg is-file-error tail i)
+    (if (eq errname 'error)
+        (progn
+          (setq data (cdr data))
+          (if (not (consp data)) (setq data nil))
+          (setq errmsg (car data))
+          (setq is-file-error nil))
+      (setq errmsg (get errname 'error-message))
+      (setq is-file-error (memq 'file-error (get errname 'error-conditions))))
+    (setq tail (cdr-safe data))
+    (if (and is-file-error tail)
+        (setq errmsg (car tail) tail (cdr tail)))
+    (if (stringp errmsg) (princ errmsg)
+      (princ "peculiar error"))
+    (setq i 0)
+    (while (consp tail)
+      (princ (if (eq i 0) ": " ", "))
+      (if is-file-error (princ (car tail))
+        (prin1 (car tail)))
+      (setq tail (cdr tail) i (1+ i)))
+    (princ "\n")))
+   
+
+(setq gc-cons-threshold 1000000)
+
+(setq output-file "TAGS")
+(setq append-flag nil)
+(setq status 0)
+
+(condition-case foobar
+    (progn
+      (while (and command-line-args-left
+                  (let ((arg (car command-line-args-left)))
+                    (cond
+                     ((prefix-p arg "-output-file")
+                      (setq output-file (nth 1 command-line-args-left))
+                      (eat-args 2) t)
+                     ((prefix-p arg "-append")
+                      (setq append-flag t)
+                      (eat-args 1) t)
+                     (t nil)))))
+
+      (find-file output-file)
+      (if append-flag (goto-char (point-max))
+        (erase-buffer))
+      (let ((output-buffer (current-buffer)))
+        (while command-line-args-left
+          (caml-tags-file (car command-line-args-left) output-buffer)
+          (setq command-line-args-left (cdr command-line-args-left)))
+        (set-buffer output-buffer)
+        (save-buffer 0)))
+  (error (setq status 1) (print-error-message foobar)))
+
+(kill-emacs status)
+
+;
+
+":" ; exit $status