[nongnu] externals/caml aa800fa 018/197: Snapshot 99/01/29

[Stefan Monnier]

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

    Snapshot 99/01/29
    
    
    git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@2260 
f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
---
 Makefile     |  15 ++++----
 README       |  14 +++++++-
 caml-font.el |   1 +
 caml.el      |  56 +++++++++++++++++++++--------
 ocamltags.in | 115 ++++++++++++++++++++++++++++++-----------------------------
 5 files changed, 122 insertions(+), 79 deletions(-)

diff --git a/Makefile b/Makefile
index a9a4c67..b1bfb72 100644
--- a/Makefile
+++ b/Makefile
@@ -18,10 +18,6 @@ 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)") \
@@ -36,12 +32,19 @@ install:
           $(MAKE) simple-install; \
         fi
 
-simple-install:  ocamltags
+simple-install:
        @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
+
+ocamltags:     ocamltags.in
+       sed -e 's:@EMACS@:$(EMACS):' ocamltags.in >ocamltags
+       chmod a+x ocamltags
+
+install-ocamltags: ocamltags
+
+       cp ocamltags $(SCRIPTDIR)/olabltags
 
 clean:
        rm -f ocamltags *~ #*#
diff --git a/README b/README
index 72fe677..7c131be 100644
--- a/README
+++ b/README
@@ -1,4 +1,4 @@
-           O'Caml emacs mode, version 2.01+ of 1998/12/16
+           O'Caml emacs mode, snapshot of $Date$
 
 The files in this archive define a caml-mode for emacs, for editing
 Objective Caml and Objective Label programs, as well as an
@@ -24,6 +24,14 @@ I added camldebug.el from the original distribution, since 
there will
 soon be a debugger for Objective Caml, but I do not know enough about
 it.
 
+To install the mode itself, edit the Makefile and do
+
+       % make install
+
+To install ocamltags, set SCRIPTDIR in the Makefile and do
+
+       % make install-ocamltags
+
 To use highlighting capabilities, add ONE of the following two
 lines to your .emacs.
 
@@ -54,6 +62,10 @@ For other bindings, see C-h b.
 
 Changes log:
 -----------
+* improved ocamltags <ITZ and JG>
+
+* added support for multibyte characters in emacs 20
+
 Version 2.01+:
 --------------
 * corrected a bug in caml-font.el <Adam P. Jenkins>
diff --git a/caml-font.el b/caml-font.el
index 3366ab0..e10192a 100644
--- a/caml-font.el
+++ b/caml-font.el
@@ -91,6 +91,7 @@
                 '(caml-font-lock-keywords nil nil ((?' . "w") (?_ . "w")))))
          (t
           (setq font-lock-keywords 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 e6cbcc2..e6db098 100644
--- a/caml.el
+++ b/caml.el
@@ -237,6 +237,10 @@ Usually negative. nil is align on master.")
   "*Extra indent for caml lines starting with }.
 Usually negative. nil is align on master.")
 
+(defvar caml-rp-extra-indent -1
+  "*Extra indent for caml lines starting with ).
+Usually negative. nil is align on master.")
+
 (defvar caml-electric-indent t
   "*Non-nil means electrically indent lines starting with |, ] or }.
 
@@ -607,7 +611,26 @@ variable caml-mode-indentation."
              (caml-in-indentation))
         (backward-delete-char-untabify caml-mode-indentation))))
 
+;;;
 ;;; Error processing
+;;;
+
+;; Error positions are given in bytes, not in characters
+;; This function switches to monobyte mode
+
+(if (not (fboundp 'char-bytes))
+    (defalias forward-byte forward-char)
+  (defun caml-char-bytes (ch)
+    (let ((l (char-bytes ch)))
+      (if (> l 1) (- l 1) l)))
+  (defun forward-byte (count)
+    (if (> count 0)
+       (while (> count 0)
+         (setq count (- count (caml-char-bytes (char-after))))
+         (forward-char))
+      (while (< count 0)
+       (setq count (+ count (caml-char-bytes (char-before))))
+       (backward-char)))))
 
 (require 'compile)
 
@@ -652,7 +675,7 @@ fragment. The erroneous fragment is also temporarily 
highlighted if
 possible."
 
  (if (eq major-mode 'caml-mode)
-     (let ((beg nil) (end nil))
+     (let (bol beg end)
        (save-excursion
         (set-buffer
          (if (boundp 'compilation-last-buffer) 
@@ -668,9 +691,12 @@ possible."
                     (string-to-int
                      (buffer-substring (match-beginning 2) (match-end 2)))))))
        (cond (beg
+             (setq end (- end beg))
               (beginning-of-line)
-             (setq beg (+ (point) beg)
-                   end (+ (point) end))
+             (forward-byte beg)
+             (setq beg (point))
+             (forward-byte end)
+             (setq end (point))
              (goto-char beg)
              (push-mark end t)
              (cond ((fboundp 'make-overlay)
@@ -1296,7 +1322,13 @@ the line where the governing keyword occurs.")
        (setq kwop (funcall matching-fun))
        (if (looking-at kwop-list) (setq done t)))
        (t (let* ((kwop-info (assoc kwop caml-kwop-alist))
-                (is-op (nth 1 kwop-info)))
+                (is-op (and (nth 1 kwop-info)
+                            ; check that we are not at beginning of line
+                            (let ((pos (point)) bti)
+                              (back-to-indentation)
+                              (setq bti (point))
+                              (goto-char pos)
+                              (< bti pos)))))
            (if (and is-op (looking-at 
                            (concat (regexp-quote kwop)
                                    "|?[ \t]*\\(\n\\|(\\*\\)")))
@@ -1328,7 +1360,6 @@ Does not preserve point."
                  (aref caml-kwop-regexps caml-max-indent-priority))
                 (let* ((kwop (caml-match-string 0))
                        (kwop-info (assoc kwop caml-kwop-alist))
-                       (is-op (if kwop-info (nth 1 kwop-info)))
                        (prio (if kwop-info (nth 2 kwop-info)
                                caml-max-indent-priority)))
                   (if (and (looking-at (aref caml-kwop-regexps 0))
@@ -1349,21 +1380,15 @@ Does not preserve point."
            (let ((pos (point)))
              (back-to-indentation)
 ;            (if (looking-at "\\<let\\>") (goto-char pos))
-             (let* ((indent (symbol-value (nth 3 kwop-info)))
-                    (kwop-extra
-                     (if (looking-at "|")
-                         (assoc (caml-match-string 0)
-                                caml-leading-kwops-alist))))
-               (if kwop-extra
-                   (- indent (symbol-value (nth 1 kwop-extra)))
-                 indent))))))
+             (- (symbol-value (nth 3 kwop-info))
+                (if (looking-at "|") caml-|-extra-indent 0))))))
         (extra (if in-expr caml-apply-extra-indent 0)))
         (+ indent-diff extra (current-column))))
 
 (defconst caml-leading-kwops-regexp
   (concat
    "\\<\\(and\\|do\\(ne\\)?\\|e\\(lse\\|nd\\)\\|in"
-   "\\|t\\(hen\\|o\\)\\|with\\)\\>\\|[]|}]")
+   "\\|t\\(hen\\|o\\)\\|with\\)\\>\\|[]|})]")
 
   "Regexp matching caml keywords which need special indentation.")
 
@@ -1379,7 +1404,8 @@ Does not preserve point."
     ("with" caml-with-extra-indent 2)
     ("|" caml-|-extra-indent 2)
     ("]" caml-rb-extra-indent 0)
-    ("}" caml-rc-extra-indent 0))
+    ("}" caml-rc-extra-indent 0)
+    (")" caml-rp-extra-indent 0))
 
   "Association list of special caml keyword indent values.
 
diff --git a/ocamltags.in b/ocamltags.in
index 68bdc01..8da00e2 100644
--- a/ocamltags.in
+++ b/ocamltags.in
@@ -1,62 +1,65 @@
 ":" ; @EMACS@ -batch -l $0 "$@" ; status=$? ; : '--*-Emacs-Lisp-*--' <<';'
 
+;; Copyright (C) 1998 Ian Zimmerman <itz@transbay.net>
+;;  This program is free software; you can redistribute it and/or
+;;  modify it under the terms of the GNU General Public License as
+;;  published by the Free Software Foundation; either version 2 of the
+;;  License, or (at your option) any later version.
+
+;;  This program is distributed in the hope that it will be useful,
+;;  but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;  General Public License for more details.
+;; $Id$
+
 (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)))
+;; itz Sun Dec 27 10:26:08 PST 1998 adapted very slightly from
+;; Jacques' caml-create-index-function
+(defun caml-tags-create-index-function ()
+  (let (all-alist index)
+    (goto-char (point-max))
+    ;; collect definitions
+    (while (caml-prev-index-position-function)
+      (if (looking-at "[ \t]*val") nil
+       (setq index (cons (caml-match-string 5) (point)))
+       (setq all-alist (cons index all-alist))))
+    all-alist))
 
-(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")
+(defun caml-tags-file (filename)
+  (let* ((output-buffer (current-buffer))
+         (basename (file-name-nondirectory filename))
+         (backpatch (prog2
+                        (insert "\n" basename)
+                        (point))))
     (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)))
+    (let ((all-alist (caml-tags-create-index-function))
+          (done nil)
+          (current-line 1)
+          (last-point (point-min)))
+      (mapcar
+       (lambda (pair)
+         (let ((tag-name (car pair)) (tag-pos (cdr pair)))
+           (goto-char tag-pos)
+           (setq current-line
+                 (+ current-line (count-lines last-point (point))))
+           (setq last-point (point))
+           (end-of-line 1)
+           (let ((output-line (format "%s%s
%d,%d\n"
+                                      (buffer-substring last-point (point))
+                                      tag-name current-line tag-pos)))
+             (save-excursion
+               (set-buffer output-buffer)
+               (insert output-line)))))
+       all-alist))
+    (kill-buffer (current-buffer))
+    (set-buffer output-buffer)
+    (let ((index-size (- (point) backpatch)))
+      (goto-char backpatch)
+      (insert "," (int-to-string index-size) "\n")
+      (goto-char (point-max)))))
 
 (defsubst prefix-p (prefix str)
   (and (<= (length prefix) (length str))
@@ -112,12 +115,10 @@
       (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)))
+      (while command-line-args-left
+        (caml-tags-file (car command-line-args-left))
+        (setq command-line-args-left (cdr command-line-args-left)))
+      (save-buffer 0))
   (error (setq status 1) (print-error-message foobar)))
 
 (kill-emacs status)