Commits

Anonymous committed 3062825 Merge

merge

  • Participants
  • Parent commits d57fcb4, d5f2b71

Comments (0)

Files changed (2)

 
 	* Makefile (VERSION): XEmacs package 1.06 released.
 
+2011-12-01  Didier Verna  <didier@xemacs.org>
+
+	* mmm-class.el: Add compiler magic so code using
+	multiple-value-list compiled on 21.4 works on 21.5.
+
+2011-12-01  Didier Verna  <didier@xemacs.org>
+
+	* mmm-class.el (mmm-ify): Fix infinite loop in mmm-ify introduced
+	by revision f9f3c7b63268 (2010-02-07  Aidan Kehoe
+	<kehoea@parhasard.net> below). Re-incorporate the call to
+	mmm-match-region in the loop).
+
 2010-02-09  Norbert Koch  <viteno@xemacs.org>
 
 	* Makefile (VERSION): XEmacs package 1.05 released.

File mmm-class.el

 (eval-when-compile (when (eq 'list (symbol-function 'values))
                      (define-compiler-macro values (&rest args)
                        `(list ,@args))
-		     (define-compiler-macro values-list (arg) arg)))
+		     (define-compiler-macro values-list (arg) arg)
+		     (define-compiler-macro multiple-value-list (arg) arg)))
 
 ;;; CLASS SPECIFICATIONS
 ;;{{{ Get Class Specifications
 ;;{{{ Scan for Regions
 
 (defun* mmm-ify
-    (&rest all &key classes handler
-	   submode match-submode
-           (start (point-min)) (stop (point-max))
-           front back save-matches (case-fold-search t)
-           (beg-sticky (not (number-or-marker-p front)))
-           (end-sticky (not (number-or-marker-p back)))
-           include-front include-back
-           (front-offset 0) (back-offset 0)
-	   (front-delim nil) (back-delim nil)
-	   (delimiter-mode mmm-delimiter-mode)
-	   front-face back-face
-           front-verify back-verify
-           front-form back-form
-	   creation-hook
-           face match-face
-	   save-name match-name
-	   (front-match 0) (back-match 0)
-	   end-not-begin
-           ;insert private
-           &allow-other-keys
-           )
+    (&rest all
+     &key classes handler
+	  submode match-submode
+	  (start (point-min)) (stop (point-max))
+	  front back save-matches (case-fold-search t)
+	  (beg-sticky (not (number-or-marker-p front)))
+	  (end-sticky (not (number-or-marker-p back)))
+	  include-front include-back
+	  (front-offset 0) (back-offset 0)
+	  (front-delim nil) (back-delim nil)
+	  (delimiter-mode mmm-delimiter-mode)
+	  front-face back-face
+	  front-verify back-verify
+	  front-form back-form
+	  creation-hook
+	  face match-face
+	  save-name match-name
+	  (front-match 0) (back-match 0)
+	  end-not-begin
+	  ;insert private
+	  &allow-other-keys)
   "Create submode regions from START to STOP according to arguments.
 If CLASSES is supplied, it must be a list of valid CLASSes. Otherwise,
 the rest of the arguments are for an actual class being applied. See
 `mmm-classes-alist' for information on what they all mean."
   ;; Make sure we get the default values in the `all' list.
   (setq all (append
-             all
-             (list :start start :stop stop
+	     all
+	     (list :start start :stop stop
 		   :beg-sticky beg-sticky :end-sticky end-sticky
 		   :front-offset front-offset :back-offset back-offset
 		   :front-delim front-delim :back-delim back-delim
-		   :front-match 0 :back-match 0
-		   )))
+		   :front-match 0 :back-match 0)))
   (cond
-   ;; If we have a class list, apply them all.
-   (classes
-    (mmm-apply-classes classes :start start :stop stop :face face))
-   ;; Otherwise, apply this class.
-   ;; If we have a handler, call it.
-   (handler
-    (apply handler all))
-   ;; Otherwise, we search from START to STOP for submode regions,
-   ;; continuining over errors, until we don't find any more. If FRONT
-   ;; and BACK are number-or-markers, this should only execute once.
-   (t
-    (mmm-save-all
-     (goto-char start)
-     (multiple-value-bind
-         (beg end front-pos back-pos matched-front matched-back
-              matched-submode matched-face matched-name invalid-resume
-              ok-resume)
-         (apply #'mmm-match-region :start (point) all)
-       (loop
-         while beg
-         if end	       ; match-submode, if present, succeeded.
-         do
-         (condition-case nil
-             (progn
-               (mmm-make-region
-                (or matched-submode submode) beg end
-                :face (or matched-face face)
-                :front front-pos :back back-pos
-                :evaporation 'front
-                :match-front matched-front :match-back matched-back
-                :beg-sticky beg-sticky :end-sticky end-sticky
-                :name matched-name
-                :delimiter-mode delimiter-mode
-                :front-face front-face :back-face back-face
-                :creation-hook creation-hook
-                )
-               (goto-char ok-resume))
-           ;; If our region is invalid, go back to the end of the
-           ;; front match and continue on.
-           (mmm-error (goto-char invalid-resume)))
-         ;; If match-submode was unable to find a match, go back to
-         ;; the end of the front match and continue on.
-         else do (goto-char invalid-resume)))))))
+    ;; If we have a class list, apply them all.
+    (classes
+     (mmm-apply-classes classes :start start :stop stop :face face))
+    ;; Otherwise, apply this class.
+    ;; If we have a handler, call it.
+    (handler
+     (apply handler all))
+    ;; Otherwise, we search from START to STOP for submode regions,
+    ;; continuining over errors, until we don't find any more. If FRONT
+    ;; and BACK are number-or-markers, this should only execute once.
+    (t
+     (mmm-save-all
+      (goto-char start)
+      (loop for (beg end front-pos back-pos matched-front matched-back
+		     matched-submode matched-face matched-name
+		     invalid-resume ok-resume)
+	      = (multiple-value-list
+		    (apply #'mmm-match-region :start (point) all))
+	    while beg
+	    if end	       ; match-submode, if present, succeeded.
+	      do
+	   (condition-case nil
+	       (progn
+		 (mmm-make-region
+		  (or matched-submode submode) beg end
+		  :face (or matched-face face)
+		  :front front-pos :back back-pos
+		  :evaporation 'front
+		  :match-front matched-front :match-back matched-back
+		  :beg-sticky beg-sticky :end-sticky end-sticky
+		  :name matched-name
+		  :delimiter-mode delimiter-mode
+		  :front-face front-face :back-face back-face
+		  :creation-hook creation-hook)
+		 (goto-char ok-resume))
+	     ;; If our region is invalid, go back to the end of the
+	     ;; front match and continue on.
+	     (mmm-error (goto-char invalid-resume)))
+	   ;; If match-submode was unable to find a match, go back to
+	   ;; the end of the front match and continue on.
+	    else do (goto-char invalid-resume))))))
 
 ;;}}}
 ;;{{{ Match Regions
 
 (provide 'mmm-class)
 
-;;; mmm-class.el ends here
+;;; mmm-class.el ends here