Require CL.

(copy-tree, remprop): Remove, it's provided by CL.
(map-keymap): Define in terms of cl-map-keymap.
(extent-property, set-extent-end-glyph): New functions.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 455b94430fc8b2171fc7b72b0c2dfb57a0b466aa..83df703356bd380823f4f291147bc5173dfe4235 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,10 +1,18 @@
+2000-07-05  Stefan Monnier  <monnier@cs.yale.edu>
+
+       * emacs-lisp/lucid.el: Require CL.
+       (copy-tree, remprop): Remove, it's provided by CL.
+       (map-keymap): Define in terms of cl-map-keymap.
+       (extent-property, set-extent-end-glyph): New functions.
+
+       * emacs-lisp/cl-extra.el (cl-map-keymap): Handle char-tables.
+
 2000-07-05  Gerd Moellmann  <gerd@gnu.org>
 
        * Makefile.in (DONTCOMPILE): Add comment that the name may
        not be changed without changing the make-dist script.
 
-       * emacs-lisp/cl-extra.el (cl-old-mapc): Removed; don't defalias
-       mapc.
+       * emacs-lisp/cl-extra.el (cl-old-mapc): Removed; don't defalias mapc.
        (cl-mapc): Use mapc instead of cl-old-mapc.
        
 2000-07-05  Andrew Innes  <andrewi@gnu.org>

diff --git a/lisp/emacs-lisp/lucid.el b/lisp/emacs-lisp/lucid.el
index 80c5973046c3c8e920f69b89e1b5b674f6ce0670..11a246b0ea417dee78bc89e91965d74c511972c0 100644 (file)
--- a/lisp/emacs-lisp/lucid.el
+++ b/lisp/emacs-lisp/lucid.el
@@ -21,33 +21,14 @@
 
 ;;; Code:
 
-(defun copy-tree (tree)
-  (if (consp tree)
-      (cons (copy-tree (car tree))
-           (copy-tree (cdr tree)))
-    (if (vectorp tree)
-       (let* ((new (copy-sequence tree))
-              (i (1- (length new))))
-         (while (>= i 0)
-           (aset new i (copy-tree (aref new i)))
-           (setq i (1- i)))
-         new)
-      tree)))
+;; XEmacs autoloads CL so we might as well make use of it.
+(require 'cl)
 
 (defalias 'current-time-seconds 'current-time)
 
-(defun remprop (symbol prop)
-  (let ((plist (symbol-plist symbol)))
-    (while (eq (car plist) prop)
-      (setplist symbol (setq plist (cdr (cdr plist)))))
-    (while plist
-      (if (eq (nth 2 plist) prop)
-         (setcdr (cdr plist) (nthcdr 4 plist)))
-      (setq plist (cdr (cdr plist))))))
-
 (defun map-keymap (function keymap &optional sort-first)
   "Call FUNCTION for every binding in KEYMAP.
-This includes bindings inherited from a parent keymap.
+This does not include bindings inherited from a parent keymap.
 FUNCTION receives two arguments each time it is called:
 the character (more generally, the event type) that is bound,
 and the binding it has.
@@ -58,30 +39,19 @@ If your code does that, modify it to make a vector containing the event
 type that you get.  That will work in both versions of Emacs."
   (if sort-first
       (let (list)
-       (map-keymap (function (lambda (a b)
-                               (setq list (cons (cons a b) list))))
-                   keymap)
+       (cl-map-keymap (lambda (a b) (push (cons a b) list))
+                      keymap)
        (setq list (sort list
-                        (function (lambda (a b)
-                                    (setq a (car a) b (car b))
-                                    (if (integerp a)
-                                        (if (integerp b) (< a b)
-                                          t)
-                                      (if (integerp b) t
-                                        (string< a b)))))))
-       (while list
-         (funcall function (car (car list)) (cdr (car list)))
-         (setq list (cdr list))))
-    (while (consp keymap)
-      (if (consp (car keymap))
-         (funcall function (car (car keymap)) (cdr (car keymap)))
-       (if (vectorp (car keymap))
-           (let ((i (1- (length (car keymap))))
-                 (vector (car keymap)))
-             (while (>= i 0)
-               (funcall function i (aref vector i))
-               (setq i (1- i))))))
-      (setq keymap (cdr keymap)))))
+                        (lambda (a b)
+                          (setq a (car a) b (car b))
+                          (if (integerp a)
+                              (if (integerp b) (< a b)
+                                t)
+                            (if (integerp b) t
+                              (string< a b))))))
+       (dolist (p list)
+         (funcall function (car p) (cdr p))))
+    (cl-map-keymap function keymap)))
 
 (defun read-number (prompt &optional integers-only)
   "Read a number from the minibuffer.
@@ -141,8 +111,8 @@ bottom of the buffer stack."
 (defun make-extent (beg end &optional buffer)
   (make-overlay beg end buffer))
 
-(defun extent-properties (extent)
-  (overlay-properties extent))
+(defun extent-properties (extent) (overlay-properties extent))
+(unless (fboundp 'extent-property) (defalias 'extent-property 'overlay-get))
 
 (defun extent-at (pos &optional object property before)
   (with-current-buffer (or object (current-buffer))
@@ -197,6 +167,9 @@ bottom of the buffer stack."
 (defun set-extent-face (extent face)
   (set-extent-property extent 'face face))
 
+(defun set-extent-end-glyph (extent glyph)
+  (set-extent-property extent 'after-string glyph))
+
 (defun delete-extent (extent)
   (set-extent-property extent 'duplicable nil)
   (delete-overlay extent))