Merge from emacs--devo--0

Patches applied:

 * emacs--devo--0  (patch 887-889)

   - Update from CVS
   - Merge from emacs--rel--22

 * emacs--rel--22  (patch 116-121)

   - Update from CVS

Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-268

4 files changed, 83 insertions, 69 deletions

diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index d04550c187d..cabd0dd391e 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -2603,17 +2603,13 @@ Like `interactive-form', but also works on pieces of advice."
 		    (if (ad-interactive-form definition) 1 0))
 		 (cdr (cdr (ad-lambda-expression definition)))))))
 
-;; Matches the docstring of an advised definition.
-;; The first group of the regexp matches the function name:
-(defvar ad-advised-definition-docstring-regexp "^\\$ad-doc: \\(.+\\)\\$$")
-
 (defun ad-make-advised-definition-docstring (function)
   "Make an identifying docstring for the advised definition of FUNCTION.
 Put function name into the documentation string so we can infer
 the name of the advised function from the docstring.  This is needed
 to generate a proper advised docstring even if we are just given a
-definition (also see the defadvice for `documentation')."
-  (format "$ad-doc: %s$" (prin1-to-string function)))
+definition (see the code for `documentation')."
+  (propertize "Advice doc string" 'ad-advice-info function))
 
 (defun ad-advised-definition-p (definition)
   "Return non-nil if DEFINITION was generated from advice information."
@@ -2622,8 +2618,7 @@ definition (also see the defadvice for `documentation')."
 	  (ad-compiled-p definition))
       (let ((docstring (ad-docstring definition)))
 	(and (stringp docstring)
-	     (string-match
-	      ad-advised-definition-docstring-regexp docstring)))))
+	     (get-text-property 0 'ad-advice-info docstring)))))
 
 (defun ad-definition-type (definition)
   "Return symbol that describes the type of DEFINITION."
@@ -3917,24 +3912,6 @@ undone on exit of this macro."
 ;; during bootstrapping.
 (ad-define-subr-args 'documentation '(function &optional raw))
 
-(defadvice documentation (after ad-advised-docstring first disable preact)
-  "Builds an advised docstring if FUNCTION is advised."
-  ;; Because we get the function name from the advised docstring
-  ;; this will work for function names as well as for definitions:
-  (if (and (stringp ad-return-value)
-	   (string-match
-	    ad-advised-definition-docstring-regexp ad-return-value))
-      (let ((function
-	     (car (read-from-string
-		   ad-return-value (match-beginning 1) (match-end 1)))))
-	(cond ((ad-is-advised function)
-	       (setq ad-return-value (ad-make-advised-docstring function))
-	       ;; Handle optional `raw' argument:
-	       (if (not (ad-get-arg 1))
-		   (setq ad-return-value
-			 (substitute-command-keys ad-return-value))))))))
-
-
 ;; @@ Starting, stopping and recovering from the advice package magic:
 ;; ===================================================================
 
@@ -3943,9 +3920,7 @@ undone on exit of this macro."
   (interactive)
   ;; Advising `ad-activate-internal' means death!!
   (ad-set-advice-info 'ad-activate-internal nil)
-  (ad-safe-fset 'ad-activate-internal 'ad-activate)
-  (ad-enable-advice 'documentation 'after 'ad-advised-docstring)
-  (ad-activate 'documentation 'compile))
+  (ad-safe-fset 'ad-activate-internal 'ad-activate))
 
 (defun ad-stop-advice ()
   "Stop the automatic advice handling magic.
@@ -3953,8 +3928,6 @@ You should only need this in case of Advice-related emergencies."
   (interactive)
   ;; Advising `ad-activate-internal' means death!!
   (ad-set-advice-info 'ad-activate-internal nil)
-  (ad-disable-advice 'documentation 'after 'ad-advised-docstring)
-  (ad-update 'documentation)
   (ad-safe-fset 'ad-activate-internal 'ad-activate-internal-off))
 
 (defun ad-recover-normality ()
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 2dea1d0a347..39cb8dce1ff 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -269,6 +269,7 @@ That buffer should be current already."
   (setq buffer-read-only nil)
   (erase-buffer)
   (set-buffer-multibyte nil)
+  (setq buffer-undo-list t)
   (let ((standard-output (current-buffer))
 	(print-escape-newlines t)
 	(print-level 8)
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 01d883d63be..e3ade01a4a0 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -3675,44 +3675,6 @@ Return the result of the last expression."
 
 ;;; Printing
 
-;; Replace printing functions.
-
-;; obsolete names
-(define-obsolete-function-alias 'edebug-install-custom-print-funcs
-    'edebug-install-custom-print "22.1")
-(define-obsolete-function-alias 'edebug-reset-print-funcs
-    'edebug-uninstall-custom-print "22.1")
-(define-obsolete-function-alias 'edebug-uninstall-custom-print-funcs
-    'edebug-uninstall-custom-print "22.1")
-
-(defun edebug-install-custom-print ()
-  "Replace print functions used by Edebug with custom versions."
-  ;; Modifying the custom print functions, or changing print-length,
-  ;; print-level, print-circle, custom-print-list or custom-print-vector
-  ;; have immediate effect.
-  (interactive)
-  (require 'cust-print)
-  (defalias 'edebug-prin1 'custom-prin1)
-  (defalias 'edebug-print 'custom-print)
-  (defalias 'edebug-prin1-to-string 'custom-prin1-to-string)
-  (defalias 'edebug-format 'custom-format)
-  (defalias 'edebug-message 'custom-message)
-  "Installed")
-
-(eval-and-compile
-  (defun edebug-uninstall-custom-print ()
-    "Replace edebug custom print functions with internal versions."
-    (interactive)
-    (defalias 'edebug-prin1 'prin1)
-    (defalias 'edebug-print 'print)
-    (defalias 'edebug-prin1-to-string 'prin1-to-string)
-    (defalias 'edebug-format 'format)
-    (defalias 'edebug-message 'message)
-    "Uninstalled")
-
-  ;; Default print functions are the same as Emacs'.
-  (edebug-uninstall-custom-print))
-
 
 (defun edebug-report-error (edebug-value)
   ;; Print an error message like command level does.
@@ -3759,6 +3721,12 @@ Return the result of the last expression."
 
 ;;; Read, Eval and Print
 
+(defalias 'edebug-prin1 'prin1)
+(defalias 'edebug-print 'print)
+(defalias 'edebug-prin1-to-string 'prin1-to-string)
+(defalias 'edebug-format 'format)
+(defalias 'edebug-message 'message)
+
 (defun edebug-eval-expression (edebug-expr)
   "Evaluate an expression in the outside environment.
 If interactive, prompt for the expression.
diff --git a/lisp/emacs-lisp/ring.el b/lisp/emacs-lisp/ring.el
index 2c8e0a29faf..93cf434292a 100644
--- a/lisp/emacs-lisp/ring.el
+++ b/lisp/emacs-lisp/ring.el
@@ -164,6 +164,78 @@ will be performed."
     (dotimes (var (cadr ring) lst)
       (push (aref vect (mod (+ start var) size)) lst))))
 
+(defun ring-member (ring item)
+  "Return index of ITEM if on RING, else nil.  Comparison via `equal'.
+The index is 0-based."
+  (let ((ind 0)
+        (len (1- (ring-length ring)))
+        (memberp nil))
+    (while (and (<= ind len)
+                (not (setq memberp (equal item (ring-ref ring ind)))))
+      (setq ind (1+ ind)))
+    (and memberp ind)))
+
+(defun ring-next (ring item)
+  "Return the next item in the RING, after ITEM.
+Raise error if ITEM is not in the RING."
+  (let ((curr-index (ring-member ring item)))
+    (unless curr-index (error "Item is not in the ring: `%s'" item))
+    (ring-ref ring (ring-plus1 curr-index (ring-length ring)))))
+
+(defun ring-previous (ring item)
+  "Return the previous item in the RING, before ITEM.
+Raise error if ITEM is not in the RING."
+  (let ((curr-index (ring-member ring item)))
+    (unless curr-index (error "Item is not in the ring: `%s'" item))
+    (ring-ref ring (ring-minus1 curr-index (ring-length ring)))))
+
+(defun ring-insert+extend (ring item &optional grow-p)
+  "Like ring-insert, but if GROW-P is non-nil, then enlarge ring.
+Insert onto ring RING the item ITEM, as the newest (last) item.
+If the ring is full, behavior depends on GROW-P:
+  If GROW-P is non-nil, enlarge the ring to accommodate the new item.
+  If GROW-P is nil, dump the oldest item to make room for the new."
+  (let* ((vec (cdr (cdr ring)))
+	 (veclen (length vec))
+	 (hd (car ring))
+	 (ringlen (ring-length ring)))
+    (prog1
+        (cond ((and grow-p (= ringlen veclen)) ; Full ring.  Enlarge it.
+               (setq veclen (1+ veclen))
+               (setcdr ring (cons (setq ringlen (1+ ringlen))
+                                  (setq vec (vconcat vec (vector item)))))
+               (setcar ring hd))
+              (t (aset vec (mod (+ hd ringlen) veclen) item)))
+      (if (= ringlen veclen)
+          (setcar ring (ring-plus1 hd veclen))
+        (setcar (cdr ring) (1+ ringlen))))))
+
+(defun ring-remove+insert+extend (ring item &optional grow-p)
+  "`ring-remove' ITEM from RING, then `ring-insert+extend' it.
+This ensures that there is only one ITEM on RING.
+
+If the RING is full, behavior depends on GROW-P:
+  If GROW-P is non-nil, enlarge the ring to accommodate the new ITEM.
+  If GROW-P is nil, dump the oldest item to make room for the new."
+  (let (ind)
+    (while (setq ind (ring-member ring item)) (ring-remove ring ind)))
+  (ring-insert+extend ring item grow-p))
+
+(defun ring-convert-sequence-to-ring (seq)
+  "Convert sequence SEQ to a ring.  Return the ring.
+If SEQ is already a ring, return it."
+  (if (ring-p seq)
+      seq
+    (let* ((size (length seq))
+           (ring (make-ring size))
+           (count 0))
+      (while (< count size)
+        (if (or (ring-empty-p ring)
+                (not (equal (ring-ref ring 0) (elt seq count))))
+            (ring-insert-at-beginning ring (elt seq count)))
+        (setq count (1+ count)))
+      ring)))
+
 ;;; provide ourself:
 
 (provide 'ring)