[A21.4] Adapt to differences in compiled font-lock lists

Vin Shelton <[email protected]> Wed, 24 Sep 2014 14:33:00 -0400
Newsgroups gmane.emacs.xemacs.patches
Message-ID <CACeGjnVMkeCPHRb9ogLj3mMmm0zry_QXWj9Lwq3zY1SML_pFhg@mail.gmail.com>
On Wed, Sep 24, 2014 at 11:43 AM, Jerry James <[email protected]> wrote:
> RECOMMEND 21.4
>
> This is the patch we discussed a few weeks ago.  It was applied to
> 21.5 back in 2008.  This patch adapts some code in font-lock.el to
> differences between the Emacs and XEmacs compiled font-lock lists.Thanks, Jerry!

I reformatted your ChangeLog and will commit the attached change to 21.4.

While I am there, I have a menubar patch from Byrel that was applied
to 21.5 at the end of 2013, so I have applied that (with some
massaging) to 21.4.

Byrel - the only changes I had to make were to change were to change
two occurrences (one in the patch and one in the context) of

(delete* item parent)

to

(delq item parent)

this latter seems to be the way the 21.4 code was written, but please review.

I will commit these patches pending your review.

Regards,
  Vin

_______________________________________________
XEmacs-Patches mailing list
[email protected]
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
x21.4_font-lock_and_menubar.patch (text/x-patch, 5.7 KB)
--- xemacs-21.4-2014-01-01/lisp/ChangeLog	2012-01-13 21:42:37.000000000 -0500
+++ xemacs-21.4-2014-09-24/lisp/ChangeLog	2014-09-24 12:13:39.000000000 -0400
@@ -0,0 +1,14 @@
+2014-09-24  Vin Shelton  <[email protected]>
+
+	* menubar.el:  (add-menu-item-1, delete-menu-item): Do not assume
+	every top-level menu is on current-menubar.
+	Patch from Byrel Mitchell; applied to 21.5 on 2013-12-30.
+
+2014-09-24  Jerry James  <[email protected]>
+
+	* font-lock.el (font-lock-add-keywords): Adapt to differences in
+	Emacs and XEmacs compiled font-lock lists.
+	(font-lock-remove-keywords): Ditto.
+	(font-lock-set-defaults-1): Make changes specified by
+	font-lock-keywords-alist and font-lock-removed-keywords-alist.
+
--- xemacs-21.4-2014-01-01/lisp/menubar.el	2012-01-13 21:42:37.000000000 -0500
+++ xemacs-21.4-2014-09-24/lisp/menubar.el	2014-09-24 12:10:09.000000000 -0400
@@ -230,7 +230,7 @@
 		      )))
     (unless menubar
       (error "`current-menubar' is nil: can't add menus to it."))
-    (unless menu
+    (unless menu  ; If we don't have all intervening submenus needed by menu-path, add them.
       (let ((rest menu-path)
 	    (so-far menubar))
 	(while rest
@@ -241,7 +241,7 @@
 		  (car (find-menu-item (cdr so-far) (list (car rest))))))
 	  (unless menu
 	    (let ((rest2 so-far))
-	      (while (and (cdr rest2) (car (cdr rest2)))
+	      (while (and (cdr rest2) (car (cdr rest2))) ; Walk rest2 down so-far till rest2 is the last item before divider or end of list.
 		(setq rest2 (cdr rest2)))
 	      (setcdr rest2
 		      (nconc (list (setq menu (list (car rest))))
@@ -250,15 +250,13 @@
 	  (setq rest (cdr rest)))))
     (if (and item-found (car item-found))
 	;; hack the item in place.
-	(if menu
+	(if (or menu (not (eq (car item-found) (car menubar)))) ;If either replacing in submenu, or replacing non-initial top-level item.  
 	    ;; Isn't it very bad form to use nsubstitute for side effects?
-	    (nsubstitute new-item (car item-found) menu)
-	  (setq current-menubar (nsubstitute new-item
-					     (car item-found)
-					     current-menubar)))
+	    (nsubstitute new-item (car item-found) (or menu menubar))
+	  (setcar menubar new-item))
       ;; OK, we have to add the whole thing...
       ;; if BEFORE is specified, try to add it there.
-      (unless menu (setq menu current-menubar))
+      (unless menu (setq menu menubar))
       (when before
 	(setq before (car (find-menu-item menu (list before)))))
       (let ((rest menu)
@@ -272,8 +270,9 @@
 	(when (not added-before)
 	  ;; adding before the first item on the menubar itself is harder
 	  (if (and (eq menu menubar) (eq before (car menu)))
-	      (setq menu (cons new-item menu)
-		    current-menubar menu)
+	      (let ((old-car (cons (car menubar) (cdr menubar))))
+		(setcar menubar new-item)
+		(setcdr menubar old-car))
 	    ;; otherwise, add the item to the end.
 	    (nconc menu (list new-item))))))
     (set-menubar-dirty-flag)
@@ -339,17 +338,17 @@
 menu paths.
 FROM-MENU, if provided, means use that instead of `current-menubar'
 as the menu to change."
-  (let* ((pair (condition-case nil (find-menu-item (or from-menu
-						       current-menubar) path)
+  (let* ((menubar (or from-menu current-menubar))
+	 (pair (condition-case nil (find-menu-item menubar path)
 		 (error nil)))
 	 (item (car pair))
-	 (parent (or (cdr pair) current-menubar)))
+	 (parent (or (cdr pair) menubar)))
     (if (not item)
 	nil
-      ;; the menubar is the only special case, because other menus begin
-      ;; with their name.
-      (if (eq parent current-menubar)
-	  (setq current-menubar (delq item parent))
+      (if (eq item (car menubar)) ; Deleting first item from a top-level menubar
+	  (progn
+	    (setcar menubar (car (cdr menubar)))
+	    (setcdr menubar (cdr (cdr menubar))))
 	(delq item parent))
       (set-menubar-dirty-flag)
       item)))
--- xemacs-21.4-2014-01-01/lisp/font-lock.el	2012-01-13 21:42:37.000000000 -0500
+++ xemacs-21.4-2014-09-24/lisp/font-lock.el	2014-09-24 11:52:21.000000000 -0400
@@ -951,7 +951,7 @@
 	 (let ((was-compiled (eq (car font-lock-keywords) t)))
 	   ;; Bring back the user-level (uncompiled) keywords.
 	   (if was-compiled
-	       (setq font-lock-keywords (cadr font-lock-keywords)))
+       (setq font-lock-keywords (cdr font-lock-keywords)))
 	   ;; Now modify or replace them.
 	   (if (eq how 'set)
 	       (setq font-lock-keywords keywords)
@@ -1061,7 +1061,7 @@
 	 (let ((was-compiled (eq (car font-lock-keywords) t)))
 	   ;; Bring back the user-level (uncompiled) keywords.
 	   (if was-compiled
-	       (setq font-lock-keywords (cadr font-lock-keywords)))
+       (setq font-lock-keywords (cdr font-lock-keywords)))
 
 	   ;; Edit them.
 	   (setq font-lock-keywords (copy-sequence font-lock-keywords))
@@ -2032,7 +2032,10 @@
 			     font-lock-defaults
 			     (font-lock-find-font-lock-defaults major-mode)))
 	       (keywords (font-lock-choose-keywords
-			  (nth 0 defaults) font-lock-maximum-decoration)))
+  (nth 0 defaults) font-lock-maximum-decoration))
+       (local (cdr (assq major-mode font-lock-keywords-alist)))
+       (removed-keywords
+ (cdr-safe (assq major-mode font-lock-removed-keywords-alist))))
 
 	  ;; Keywords?
 	  (setq font-lock-keywords (if (fboundp keywords)
@@ -2097,7 +2100,14 @@
 		 ;; older way:
 		 ;; defaults not specified at all, so use `beginning-of-defun'.
 		 (setq font-lock-beginning-of-syntax-function
-		       'beginning-of-defun)))))
+       'beginning-of-defun)))
+
+  ;; Local fontification?
+  (while local
+    (font-lock-add-keywords nil (car (car local)) (cdr (car local)))
+    (setq local (cdr local)))
+  (when removed-keywords
+    (font-lock-remove-keywords nil removed-keywords))))
 
     (setq font-lock-cache-position (make-marker))
     (setq font-lock-defaults-computed t)))