changeset 468:20ae8821c23d

[xemacs-hg @ 2001-04-13 09:11:17 by michaels] The Great Trunk Move from release-21-2.
author michaels
date Fri, 13 Apr 2001 09:11:46 +0000
parents 13d500863631
children ccaeb2a3c329
files CHANGES-beta dynodump/dynodump.c lisp/build-report.el lisp/ldap.el man/info.texi man/texinfo.texi man/xemacs-faq.texi netinstall/msg.cc netinstall/nio-ie5.cc netinstall/res.rc src/ChangeLog src/extents.c tests/automated/extent-tests.el
diffstat 13 files changed, 418 insertions(+), 25 deletions(-) [+]
line wrap: on
line diff
--- a/CHANGES-beta	Thu Apr 12 18:25:01 2001 +0000
+++ b/CHANGES-beta	Fri Apr 13 09:11:46 2001 +0000
@@ -1,3 +1,5 @@
+to 21.2.47 "Zephir"
+
 to 21.2.46 "Urania"
 -- GTK code has been merged as an experimental display type -- William Perry
 
--- a/dynodump/dynodump.c	Thu Apr 12 18:25:01 2001 +0000
+++ b/dynodump/dynodump.c	Fri Apr 13 09:11:46 2001 +0000
@@ -73,7 +73,7 @@
  * N.B. The above commentary is not quite correct in the flags have been hardwired
  *      to RTLD_SAVREL.
  */
-#pragma ident	"@(#) $Id: dynodump.c,v 1.8 2001/04/12 18:20:43 michaels Exp $ - SMI"
+#pragma ident	"@(#) $Id: dynodump.c,v 1.9 2001/04/13 09:11:20 michaels Exp $ - SMI"
 
 #define __EXTENSIONS__ 1
 
--- a/lisp/build-report.el	Thu Apr 12 18:25:01 2001 +0000
+++ b/lisp/build-report.el	Fri Apr 13 09:11:46 2001 +0000
@@ -4,7 +4,7 @@
 
 ;; Author: Adrian Aichner <adrian@xemacs.org>
 ;; Date: Sun., Apr. 20, 1997-2000.
-;; Version: $Revision: 1.8 $
+;; Version: $Revision: 1.9 $
 ;; Keywords: internal
 
 ;; This file is part of XEmacs.
--- a/lisp/ldap.el	Thu Apr 12 18:25:01 2001 +0000
+++ b/lisp/ldap.el	Fri Apr 13 09:11:46 2001 +0000
@@ -5,7 +5,7 @@
 ;; Author: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
 ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
 ;; Created: Jan 1998
-;; Version: $Revision: 1.10 $
+;; Version: $Revision: 1.11 $
 ;; Keywords: help comm
 
 ;; This file is part of XEmacs
--- a/man/info.texi	Thu Apr 12 18:25:01 2001 +0000
+++ b/man/info.texi	Fri Apr 13 09:11:46 2001 +0000
@@ -3,7 +3,7 @@
 @setfilename ../info/info.info
 @settitle Info
 @comment %**end of header
-@comment $Id: info.texi,v 1.8 2001/04/12 18:22:00 michaels Exp $
+@comment $Id: info.texi,v 1.9 2001/04/13 09:11:28 michaels Exp $
 
 @dircategory Texinfo documentation system
 @direntry
--- a/man/texinfo.texi	Thu Apr 12 18:25:01 2001 +0000
+++ b/man/texinfo.texi	Fri Apr 13 09:11:46 2001 +0000
@@ -1,5 +1,5 @@
 \input texinfo.tex    @c -*-texinfo-*-
-@c $Id: texinfo.texi,v 1.14 2001/04/12 18:22:02 michaels Exp $
+@c $Id: texinfo.texi,v 1.15 2001/04/13 09:11:29 michaels Exp $
 @c %**start of header
 
 @c All text is ignored before the setfilename.
--- a/man/xemacs-faq.texi	Thu Apr 12 18:25:01 2001 +0000
+++ b/man/xemacs-faq.texi	Fri Apr 13 09:11:46 2001 +0000
@@ -7,7 +7,7 @@
 @finalout
 @titlepage
 @title XEmacs FAQ
-@subtitle Frequently asked questions about XEmacs @* Last Modified: $Date: 2001/04/12 18:22:04 $
+@subtitle Frequently asked questions about XEmacs @* Last Modified: $Date: 2001/04/13 09:11:32 $
 @sp 1
 @author Tony Rossini <rossini@@biostat.washington.edu>
 @author Ben Wing <ben@@xemacs.org>
--- a/netinstall/msg.cc	Thu Apr 12 18:25:01 2001 +0000
+++ b/netinstall/msg.cc	Fri Apr 13 09:11:46 2001 +0000
@@ -16,7 +16,7 @@
 /* The purpose of this file is to centralize all the message
    functions. */
 
-static char *cvsid = "\n%%% $Id: msg.cc,v 1.2 2001/04/12 18:22:49 michaels Exp $\n";
+static char *cvsid = "\n%%% $Id: msg.cc,v 1.3 2001/04/13 09:11:35 michaels Exp $\n";
 
 #include "win32.h"
 #include <stdio.h>
--- a/netinstall/nio-ie5.cc	Thu Apr 12 18:25:01 2001 +0000
+++ b/netinstall/nio-ie5.cc	Fri Apr 13 09:11:46 2001 +0000
@@ -18,7 +18,7 @@
    must already have installed and configured IE5.  This module is
    called from netio.cc, which is called from geturl.cc */
 
-static char *cvsid = "\n%%% $Id: nio-ie5.cc,v 1.2 2001/04/12 18:22:51 michaels Exp $\n";
+static char *cvsid = "\n%%% $Id: nio-ie5.cc,v 1.3 2001/04/13 09:11:35 michaels Exp $\n";
 
 #include "win32.h"
 
--- a/netinstall/res.rc	Thu Apr 12 18:25:01 2001 +0000
+++ b/netinstall/res.rc	Fri Apr 13 09:11:46 2001 +0000
@@ -478,7 +478,7 @@
     IDS_ERR_OPEN_READ       "Can't open %s for reading: %s"
     IDS_ROOT_ABSOLUTE       "The install directory must be absolute, with both a drive letter and leading slash, like C:\\Cygwin"
     IDS_DOWNLOAD_COMPLETE   "Download Complete"
-    IDS_CVSID               "\n%%% $Id: res.rc,v 1.2 2001/04/12 18:22:53 michaels Exp $\n"
+    IDS_CVSID               "\n%%% $Id: res.rc,v 1.3 2001/04/13 09:11:35 michaels Exp $\n"
     IDS_NOLOGFILE           "Cannot open log file %s for writing"
     IDS_UNINSTALL_COMPLETE  "Uninstalls complete."
     IDS_WININET             "Unable to find or load the Internet Explorer 5 DLLs"
--- a/src/ChangeLog	Thu Apr 12 18:25:01 2001 +0000
+++ b/src/ChangeLog	Fri Apr 13 09:11:46 2001 +0000
@@ -1,3 +1,13 @@
+2001-04-07  Hrvoje Niksic  <hniksic@arsdigita.com>
+
+	* extents.c (Fset_extent_endpoints): Force creation of extent info
+	in buffer_or_string.
+
+2001-04-07  Hrvoje Niksic  <hniksic@arsdigita.com>
+
+	* extents.c (process_extents_for_insertion_mapper): Correctly
+	check for open-open zero-length extents.
+
 2001-04-02  Jan Vroonhof  <jan@xemacs.org>
 
 	* redisplay.c (add_bufbyte_string_runes): Update data->bytepos
--- a/src/extents.c	Thu Apr 12 18:25:01 2001 +0000
+++ b/src/extents.c	Fri Apr 13 09:11:46 2001 +0000
@@ -3843,6 +3843,7 @@
   get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e,
 				   GB_ALLOW_PAST_ACCESSIBLE);
 
+  buffer_or_string_extent_info_force (buffer_or_string);
   set_extent_endpoints (ext, s, e, buffer_or_string);
   return extent;
 }
@@ -4574,27 +4575,36 @@
 #endif
 
   /* The extent-adjustment code adjusted the extent's endpoints as if
-     they were markers -- endpoints at the gap (i.e. the insertion
-     point) go to the left of the insertion point, which is correct
-     for [) extents.  We need to fix the other kinds of extents.
-
-     Note that both conditions below will hold for zero-length (]
-     extents at the gap.  Zero-length () extents would get adjusted
-     such that their start is greater than their end; we treat them
-     as [) extents.  This is unfortunately an inelegant part of the
-     extent model, but there is no way around it. */
+     all extents were closed-open -- endpoints at the insertion point
+     remain unchanged.  We need to fix the other kinds of extents:
+
+     1. Start position of start-open extents needs to be moved.
+
+     2. End position of end-closed extents needs to be moved.
+
+     Note that both conditions hold for zero-length (] extents at the
+     insertion point.  But under these rules, zero-length () extents
+     would get adjusted such that their start is greater than their
+     end; instead of allowing that, we treat them as [) extents by
+     modifying condition #1 to not fire nothing when dealing with a
+     zero-length open-open extent.
+
+     Existence of zero-length open-open extents is unfortunately an
+     inelegant part of the extent model, but there is no way around
+     it. */
 
   {
-    Memind new_start, new_end;
-
-    new_start = extent_start (extent);
-    new_end = extent_end (extent);
-    if (indice == extent_start (extent) && extent_start_open_p (extent) &&
-	/* coerce zero-length () extents to [) */
-	new_start != new_end)
+    Memind new_start = extent_start (extent);
+    Memind new_end   = extent_end (extent);
+
+    if (indice == extent_start (extent) && extent_start_open_p (extent)
+	/* zero-length () extents are exempt; see comment above. */
+	&& !(new_start == new_end && extent_end_open_p (extent))
+	)
       new_start += closure->length;
     if (indice == extent_end (extent) && !extent_end_open_p (extent))
       new_end += closure->length;
+
     set_extent_endpoints_1 (extent, new_start, new_end);
   }
 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/automated/extent-tests.el	Fri Apr 13 09:11:46 2001 +0000
@@ -0,0 +1,371 @@
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; Author: Hrvoje Niksic <hniksic@xemacs.org>
+;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org>
+;; Created: 1999
+;; Keywords: tests
+
+;; This file is part of XEmacs.
+
+;; XEmacs 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, or (at your option)
+;; any later version.
+
+;; XEmacs 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.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF.
+
+;;; Commentary:
+
+;; Test extents operations.
+;; See test-harness.el for instructions on how to run these tests.
+
+(eval-when-compile
+  (condition-case nil
+      (require 'test-harness)
+    (file-error
+     (push "." load-path)
+     (when (and (boundp 'load-file-name) (stringp load-file-name))
+       (push (file-name-directory load-file-name) load-path))
+     (require 'test-harness))))
+
+
+;;-----------------------------------------------------
+;; Creating and attaching.
+;;-----------------------------------------------------
+
+(with-temp-buffer
+  (let ((extent (make-extent nil nil))
+	(string "somecoolstring"))
+
+    ;; Detached extent.
+    (Assert (extent-detached-p extent))
+
+    ;; Put it in a buffer.
+    (set-extent-endpoints extent 1 1 (current-buffer))
+    (Assert (eq (extent-object extent) (current-buffer)))
+
+    ;; And then into another buffer.
+    (with-temp-buffer
+      (set-extent-endpoints extent 1 1 (current-buffer))
+      (Assert (eq (extent-object extent) (current-buffer))))
+
+    ;; Now that the buffer doesn't exist, extent should be detached
+    ;; again.
+    (Assert (extent-detached-p extent))
+
+    ;; This line crashes XEmacs 21.2.46 and prior.
+    (set-extent-endpoints extent 1 (length string) string)
+    (Assert (eq (extent-object extent) string))
+    )
+
+  (let ((extent (make-extent 1 1)))
+    ;; By default, extent should be closed-open
+    (Assert (eq (get extent 'start-closed) t))
+    (Assert (eq (get extent 'start-open) nil))
+    (Assert (eq (get extent 'end-open) t))
+    (Assert (eq (get extent 'end-closed) nil))
+
+    ;; Make it closed-closed.
+    (set-extent-property extent 'end-closed t)
+
+    (Assert (eq (get extent 'start-closed) t))
+    (Assert (eq (get extent 'start-open) nil))
+    (Assert (eq (get extent 'end-open) nil))
+    (Assert (eq (get extent 'end-closed) t))
+
+    ;; open-closed
+    (set-extent-property extent 'start-open t)
+
+    (Assert (eq (get extent 'start-closed) nil))
+    (Assert (eq (get extent 'start-open) t))
+    (Assert (eq (get extent 'end-open) nil))
+    (Assert (eq (get extent 'end-closed) t))
+
+    ;; open-open
+    (set-extent-property extent 'end-open t)
+
+    (Assert (eq (get extent 'start-closed) nil))
+    (Assert (eq (get extent 'start-open) t))
+    (Assert (eq (get extent 'end-open) t))
+    (Assert (eq (get extent 'end-closed) nil)))
+
+  )
+
+;;-----------------------------------------------------
+;; Insertion behavior.
+;;-----------------------------------------------------
+
+(defun et-range (extent)
+  "List (START-POSITION END-POSITION) of EXTENT."
+  (list (extent-start-position extent)
+	(extent-end-position extent)))
+
+(defun et-insert-at (string position)
+  "Insert STRING at POSITION in the current buffer."
+  (save-excursion
+    (goto-char position)
+    (insert string)))
+
+;; Test insertion at the beginning, middle, and end of the extent.
+
+;; closed-open
+
+(with-temp-buffer
+  (insert "###eee###")
+  (let ((e (make-extent 4 7)))
+    ;; current state: "###[eee)###"
+    ;;                 123 456 789
+    (Assert (equal (et-range e) '(4 7)))
+
+    (et-insert-at "xxx" 4)
+
+    ;; current state: "###[xxxeee)###"
+    ;;                 123 456789 012
+    (Assert (equal (et-range e) '(4 10)))
+
+    (et-insert-at "yyy" 7)
+
+    ;; current state: "###[xxxyyyeee)###"
+    ;;                 123 456789012 345
+    (Assert (equal (et-range e) '(4 13)))
+
+    (et-insert-at "zzz" 13)
+
+    ;; current state: "###[xxxyyyeee)zzz###"
+    ;;                 123 456789012 345678
+    (Assert (equal (et-range e) '(4 13)))
+    ))
+
+;; closed-closed
+
+(with-temp-buffer
+  (insert "###eee###")
+  (let ((e (make-extent 4 7)))
+    (put e 'end-closed t)
+
+    ;; current state: "###[eee]###"
+    ;;                 123 456 789
+    (Assert (equal (et-range e) '(4 7)))
+
+    (et-insert-at "xxx" 4)
+
+    ;; current state: "###[xxxeee]###"
+    ;;                 123 456789 012
+    (Assert (equal (et-range e) '(4 10)))
+
+    (et-insert-at "yyy" 7)
+
+    ;; current state: "###[xxxyyyeee]###"
+    ;;                 123 456789012 345
+    (Assert (equal (et-range e) '(4 13)))
+
+    (et-insert-at "zzz" 13)
+
+    ;; current state: "###[xxxyyyeeezzz]###"
+    ;;                 123 456789012345 678
+    (Assert (equal (et-range e) '(4 16)))
+    ))
+
+;; open-closed
+
+(with-temp-buffer
+  (insert "###eee###")
+  (let ((e (make-extent 4 7)))
+    (put e 'start-open t)
+    (put e 'end-closed t)
+
+    ;; current state: "###(eee]###"
+    ;;                 123 456 789
+    (Assert (equal (et-range e) '(4 7)))
+
+    (et-insert-at "xxx" 4)
+
+    ;; current state: "###xxx(eee]###"
+    ;;                 123456 789 012
+    (Assert (equal (et-range e) '(7 10)))
+
+    (et-insert-at "yyy" 8)
+
+    ;; current state: "###xxx(eyyyee]###"
+    ;;                 123456 789012 345
+    (Assert (equal (et-range e) '(7 13)))
+
+    (et-insert-at "zzz" 13)
+
+    ;; current state: "###xxx(eyyyeezzz]###"
+    ;;                 123456 789012345 678
+    (Assert (equal (et-range e) '(7 16)))
+    ))
+
+;; open-open
+
+(with-temp-buffer
+  (insert "###eee###")
+  (let ((e (make-extent 4 7)))
+    (put e 'start-open t)
+
+    ;; current state: "###(eee)###"
+    ;;                 123 456 789
+    (Assert (equal (et-range e) '(4 7)))
+
+    (et-insert-at "xxx" 4)
+
+    ;; current state: "###xxx(eee)###"
+    ;;                 123456 789 012
+    (Assert (equal (et-range e) '(7 10)))
+
+    (et-insert-at "yyy" 8)
+
+    ;; current state: "###xxx(eyyyee)###"
+    ;;                 123456 789012 345
+    (Assert (equal (et-range e) '(7 13)))
+
+    (et-insert-at "zzz" 13)
+
+    ;; current state: "###xxx(eyyyee)zzz###"
+    ;;                 123456 789012 345678
+    (Assert (equal (et-range e) '(7 13)))
+    ))
+
+
+;;-----------------------------------------------------
+;; Deletion behavior.
+;;-----------------------------------------------------
+
+(dolist (props '((start-closed t end-open t)
+		 (start-closed t end-open nil)
+		 (start-closed nil end-open nil)
+		 (start-closed nil end-open t)))
+  ;; Deletion needs to behave the same regardless of the open-ness of
+  ;; the boundaries.
+
+  (with-temp-buffer
+    (insert "xxxxxxxxxx")
+    (let ((e (make-extent 3 9)))
+      (set-extent-properties e props)
+
+      ;; current state: xx[xxxxxx]xx
+      ;;                12 345678 90
+      (Assert (equal (et-range e) '(3 9)))
+
+      (delete-region 1 2)
+
+      ;; current state: x[xxxxxx]xx
+      ;;                1 234567 89
+      (Assert (equal (et-range e) '(2 8)))
+
+      (delete-region 2 4)
+
+      ;; current state: x[xxxx]xx
+      ;;                1 2345 67
+      (Assert (equal (et-range e) '(2 6)))
+
+      (delete-region 1 3)
+
+      ;; current state: [xxx]xx
+      ;;                 123 45
+      (Assert (equal (et-range e) '(1 4)))
+
+      (delete-region 3 5)
+
+      ;; current state: [xx]x
+      ;;                 12 3
+      (Assert (equal (et-range e) '(1 3)))
+
+      )))
+
+;;; #### Should have a test for read-only-ness and insertion and
+;;; deletion!
+
+;;-----------------------------------------------------
+;; `detachable' property
+;;-----------------------------------------------------
+
+(dolist (props '((start-closed t end-open t)
+		 (start-closed t end-open nil)
+		 (start-closed nil end-open nil)
+		 (start-closed nil end-open t)))
+  ;; `detachable' shouldn't relate to region properties, hence the
+  ;; loop.
+  (with-temp-buffer
+    (insert "###eee###")
+    (let ((e (make-extent 4 7)))
+      (set-extent-properties e props)
+      (Assert (get e 'detachable))
+
+      (Assert (not (extent-detached-p e)))
+
+      (delete-region 4 5)
+      ;; ###ee### (not detached yet)
+      (Assert (not (extent-detached-p e)))
+
+      (delete-region 4 6)
+      ;; ###### (should be detached now)
+      (Assert (extent-detached-p e))))
+
+  (with-temp-buffer
+    (insert "###eee###")
+    (let ((e (make-extent 4 7)))
+      (set-extent-properties e props)
+      (put e 'detachable nil)
+      (Assert (not (get e 'detachable)))
+    
+      (Assert (not (extent-detached-p e)))
+
+      (delete-region 4 5)
+      ;; ###ee###
+      (Assert (not (extent-detached-p e)))
+
+      (delete-region 4 6)
+      ;; ###[]###
+      (Assert (not (extent-detached-p e)))
+      (Assert (equal (et-range e) '(4 4)))
+      ))
+  )
+
+
+;;-----------------------------------------------------
+;; Zero-length extents.
+;;-----------------------------------------------------
+
+;; closed-open (should stay put)
+(with-temp-buffer
+  (insert "######")
+  (let ((e (make-extent 4 4)))
+    (et-insert-at "foo" 4)
+    (Assert (equal (et-range e) '(4 4)))))
+
+;; open-closed (should move)
+(with-temp-buffer
+  (insert "######")
+  (let ((e (make-extent 4 4)))
+    (put e 'start-open t)
+    (put e 'end-closed t)
+    (et-insert-at "foo" 4)
+    (Assert (equal (et-range e) '(7 7)))))
+
+;; closed-closed (should extend)
+(with-temp-buffer
+  (insert "######")
+  (let ((e (make-extent 4 4)))
+    (put e 'end-closed t)
+    (et-insert-at "foo" 4)
+    (Assert (equal (et-range e) '(4 7)))))
+
+;; open-open (illegal; forced to behave like closed-open)
+(with-temp-buffer
+  (insert "######")
+  (let ((e (make-extent 4 4)))
+    (put e 'start-open t)
+    (et-insert-at "foo" 4)
+    (Assert (equal (et-range e) '(4 4)))))