Mercurial > hg > xemacs-beta

changeset 5079:aa4cae427255

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Ben Wing <ben@xemacs.org>
date Thu, 25 Feb 2010 06:14:50 -0600
parents a04cf0fea770 (current diff) 868a9ffcc37b (diff)
children 5502045ec510
files lisp/ChangeLog src/ChangeLog
diffstat 8 files changed, 134 insertions(+), 65 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Thu Feb 25 06:11:07 2010 -0600
+++ b/lisp/ChangeLog	Thu Feb 25 06:14:50 2010 -0600
@@ -12,6 +12,16 @@
 	* help.el (function-arglist): If empty arg, don't display extra
 	space after function name.
 
+2010-02-24  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl-extra.el (constantly):
+	Normally return a compiled function from #'constantly if we are
+	handed a single argument. Shouldn't actually matter, the overhead
+	for returning a single constant in a lambda form vs. in a compiled
+	function is minuscule, but using compiled functions as much as
+	possible is good style in XEmacs, our interpreter is not stellar
+	(nor indeed should it need to be).
+
 2010-02-23  Ben Wing  <ben@xemacs.org>
 
 	* help.el: fux typo in comment. (oops)
--- a/lisp/cl-extra.el	Thu Feb 25 06:11:07 2010 -0600
+++ b/lisp/cl-extra.el	Thu Feb 25 06:14:50 2010 -0600
@@ -612,9 +612,7 @@
 	  ((memq (car plst) indicator-list)
 	   (return (values (car plst) (cadr plst) plst))))))
 
-;; See our compiler macro in cl-macs.el, we will only pass back the
-;; actual lambda list in interpreted code or if we've been funcalled
-;; (from #'apply or #'mapcar or whatever).
+;; See also the compiler macro in cl-macs.el.
 (defun constantly (value &rest more-values)
   "Construct a function always returning VALUE, and possibly MORE-VALUES.
 
@@ -622,7 +620,24 @@
 
 Members of MORE-VALUES, if provided, will be passed as multiple values; see
 `multiple-value-bind' and `multiple-value-setq'."
-  `(lambda (&rest ignore) (values-list ',(cons value more-values))))
+  (symbol-macrolet
+      ((arglist '(&rest ignore)))
+    (if (or more-values (eval-when-compile (not (cl-compiling-file))))
+        `(lambda ,arglist (values-list ',(cons value more-values)))
+      (make-byte-code
+       arglist
+       (eval-when-compile
+         (let ((compiled (byte-compile-sexp #'(lambda (&rest ignore)
+                                                (declare (ignore ignore))
+                                                'placeholder))))
+           (assert (and
+                    (equal [placeholder]
+                           (compiled-function-constants compiled))
+                    (= 1 (compiled-function-stack-depth compiled)))
+		   t
+		   "Our assumptions about compiled code appear not to hold.")
+           (compiled-function-instructions compiled)))
+       (vector value) 1))))
 
 ;;; Hash tables.
 
--- a/src/ChangeLog	Thu Feb 25 06:11:07 2010 -0600
+++ b/src/ChangeLog	Thu Feb 25 06:14:50 2010 -0600
@@ -118,6 +118,30 @@
 	Remove duplicated SET_TOOLBAR_WAS_VISIBLE_FLAG and put defn in
 	one place (toolbar.h).
 
+2010-02-24  Didier Verna  <didier@xemacs.org>
+
+	Modify XLIKE_get_gc's prototype.
+	* redisplay-xlike-inc.c (XLIKE_get_gc): Take a frame instead of a
+	device as first argument.
+	* redisplay-xlike-inc.c (XLIKE_output_string): Update caller.
+	* redisplay-xlike-inc.c (XLIKE_output_pixmap): Ditto.
+	* redisplay-xlike-inc.c (XLIKE_output_blank): Ditto.
+	* redisplay-xlike-inc.c (XLIKE_output_horizontal_line): Ditto.
+	* redisplay-xlike-inc.c (XLIKE_clear_region): Ditto.
+	* redisplay-xlike-inc.c (XLIKE_output_eol_cursor): Ditto.
+	* console-gtk.h (gtk_get_gc):  Take a frame instead of a device as
+	first argument.
+	* gtk-glue.c (face_to_gc): Update caller.
+
+2010-02-24  Didier Verna  <didier@xemacs.org>
+
+	* glyphs.c: Clarify comment about potential_pixmap_file_instantiator.
+	* glyphs.c (xbm_mask_file_munging): Clarify comment, remove
+	unreachable condition and provide a cuple of assertions.
+	* glyphs.c (xbm_normalize): Clarify comments, error on mask file
+	not found.
+	* glyphs.c (xface_normalize): Ditto, and handle inline data properly.
+
 2010-02-22  Ben Wing  <ben@xemacs.org>
 
 	* .gdbinit.in.in:
--- a/src/console-gtk.h	Thu Feb 25 06:11:07 2010 -0600
+++ b/src/console-gtk.h	Thu Feb 25 06:14:50 2010 -0600
@@ -64,7 +64,8 @@
 		      int start_pixpos, int width, face_index findex,
 		      int cursor, int cursor_start, int cursor_width,
 		      int cursor_height);
-GdkGC *gtk_get_gc (struct device *d, Lisp_Object font, Lisp_Object fg, Lisp_Object bg,
+GdkGC *gtk_get_gc (struct frame *f,
+		   Lisp_Object font, Lisp_Object fg, Lisp_Object bg,
 		   Lisp_Object bg_pmap, Lisp_Object lwidth);
 
 int gtk_initialize_frame_menubar (struct frame *f);
--- a/src/glyphs.c	Thu Feb 25 06:11:07 2010 -0600
+++ b/src/glyphs.c	Thu Feb 25 06:14:50 2010 -0600
@@ -4,7 +4,7 @@
    Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004, 2005 Ben Wing
    Copyright (C) 1995 Sun Microsystems
    Copyright (C) 1998, 1999, 2000 Andy Piper
-   Copyright (C) 2007 Didier Verna
+   Copyright (C) 2007, 2010 Didier Verna
 
 This file is part of XEmacs.
 
@@ -2521,15 +2521,16 @@
 /*                        pixmap file functions                         */
 /************************************************************************/
 
-/* If INSTANTIATOR refers to inline data, return Qt.
-   If INSTANTIATOR refers to data in a file, return the full filename
-   if it exists, Qnil if there's no console method for locating the file, or
-   (filename) if there was an error locating the file.
+/* - If INSTANTIATOR refers to inline data, or there is no file keyword, we
+     have nothing to do, so return Qt.
+   - If INSTANTIATOR refers to data in a file, return the full filename
+     if it exists; otherwise, return '(filename), meaning "file not found".
+   - If there is no locate_pixmap_file method for this console, return Qnil.
 
    FILE_KEYWORD and DATA_KEYWORD are symbols specifying the
    keywords used to look up the file and inline data,
-   respectively, in the instantiator.  Normally these would
-   be Q_file and Q_data, but might be different for mask data. */
+   respectively, in the instantiator.  These would be Q_file and Q_data,
+   Q_mask_file or Q_mask_data. */
 
 Lisp_Object
 potential_pixmap_file_instantiator (Lisp_Object instantiator,
@@ -2736,18 +2737,20 @@
   return Qnil; /* not reached */
 }
 
+/* This function attempts to find implicit mask files by appending "Mask" or
+   "msk" to the original bitmap file name. This is more or less standard: a
+   number of bitmaps in /usr/include/X11/bitmaps use it. */
 Lisp_Object
 xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file,
 		       Lisp_Object mask_file, Lisp_Object console_type)
 {
-  /* This is unclean but it's fairly standard -- a number of the
-     bitmaps in /usr/include/X11/bitmaps use it -- so we support
-     it. */
-  if (EQ (mask_file, Qt)
-      /* don't override explicitly specified mask data. */
-      && NILP (assq_no_quit (Q_mask_data, alist))
-      && !EQ (file, Qt))
+  /* Let's try to find an implicit mask file if we have neither an explicit
+     mask file name, nor inline mask data. Note that no errors are reported in
+     case of failure because the mask file we're looking for might not
+     exist. */ 
+  if (EQ (mask_file, Qt) && NILP (assq_no_quit (Q_mask_data, alist)))
     {
+      assert (!EQ (file, Qt) && !EQ (file, Qnil));
       mask_file = MAYBE_LISP_CONTYPE_METH
 	(decode_console_type(console_type, ERROR_ME),
 	 locate_pixmap_file, (concat2 (file, build_ascstring ("Mask"))));
@@ -2757,10 +2760,14 @@
 	   locate_pixmap_file, (concat2 (file, build_ascstring ("msk"))));
     }
 
+  /* We got a mask file, either explicitely or from the search above. */
   if (!NILP (mask_file))
     {
-      Lisp_Object mask_data =
-	bitmap_to_lisp_data (mask_file, 0, 0, 0);
+      Lisp_Object mask_data;
+
+      assert (!EQ (mask_file, Qt));
+
+      mask_data = bitmap_to_lisp_data (mask_file, 0, 0, 0);
       alist = remassq_no_quit (Q_mask_file, alist);
       /* there can't be a :mask-data at this point. */
       alist = Fcons (Fcons (Q_mask_file, mask_file),
@@ -2776,9 +2783,8 @@
 xbm_normalize (Lisp_Object inst, Lisp_Object console_type,
 	       Lisp_Object UNUSED (dest_mask))
 {
-  Lisp_Object file = Qnil, mask_file = Qnil;
+  Lisp_Object file = Qnil, mask_file = Qnil, alist = Qnil;
   struct gcpro gcpro1, gcpro2, gcpro3;
-  Lisp_Object alist = Qnil;
 
   GCPRO3 (file, mask_file, alist);
 
@@ -2796,7 +2802,9 @@
   mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
 						  Q_mask_data, console_type);
 
-  if (NILP (file)) /* normalization impossible for the console type */
+  /* No locate_pixmap_file method for this console type, so we can't get a
+     file (neither a mask file BTW). */
+  if (NILP (file))
     RETURN_UNGCPRO (Qnil);
 
   if (CONSP (file)) /* failure locating filename */
@@ -2804,6 +2812,11 @@
 			       "no such file or directory",
 			       Fcar (file));
 
+  if (CONSP (mask_file)) /* failure locating filename */
+    signal_double_image_error ("Opening bitmap mask file",
+			       "no such file or directory",
+			       Fcar (mask_file));
+
   if (EQ (file, Qt) && EQ (mask_file, Qt)) /* no conversion necessary */
     RETURN_UNGCPRO (inst);
 
@@ -2863,10 +2876,8 @@
 xface_normalize (Lisp_Object inst, Lisp_Object console_type,
 		 Lisp_Object UNUSED (dest_mask))
 {
-  /* This function can call lisp */
-  Lisp_Object file = Qnil, mask_file = Qnil;
+  Lisp_Object file = Qnil, mask_file = Qnil, alist = Qnil;
   struct gcpro gcpro1, gcpro2, gcpro3;
-  Lisp_Object alist = Qnil;
 
   GCPRO3 (file, mask_file, alist);
 
@@ -2884,28 +2895,34 @@
   mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
 						  Q_mask_data, console_type);
 
-  if (NILP (file)) /* normalization impossible for the console type */
+  /* No locate_pixmap_file method for this console type, so we can't get a
+     file (neither a mask file BTW). */
+  if (NILP (file))
     RETURN_UNGCPRO (Qnil);
 
   if (CONSP (file)) /* failure locating filename */
-    signal_double_image_error ("Opening bitmap file",
+    signal_double_image_error ("Opening face file",
 			       "no such file or directory",
 			       Fcar (file));
 
+  if (CONSP (mask_file)) /* failure locating filename */
+    signal_double_image_error ("Opening face mask file",
+			       "no such file or directory",
+			       Fcar (mask_file));
+
   if (EQ (file, Qt) && EQ (mask_file, Qt)) /* no conversion necessary */
     RETURN_UNGCPRO (inst);
 
   alist = tagged_vector_to_alist (inst);
 
-  {
-    /* #### FIXME: what if EQ (file, Qt) && !EQ (mask, Qt) ? Is that possible?
-       If so, we have a problem... -- dvl */
-    Lisp_Object data = make_string_from_file (file);
-    alist = remassq_no_quit (Q_file, alist);
-    /* there can't be a :data at this point. */
-    alist = Fcons (Fcons (Q_file, file),
-		   Fcons (Fcons (Q_data, data), alist));
-  }
+  if (!EQ (file, Qt))
+    {
+      Lisp_Object data = make_string_from_file (file);
+      alist = remassq_no_quit (Q_file, alist);
+      /* there can't be a :data at this point. */
+      alist = Fcons (Fcons (Q_file, file),
+		     Fcons (Fcons (Q_data, data), alist));
+    }
 
   alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
 
--- a/src/gtk-glue.c	Thu Feb 25 06:11:07 2010 -0600
+++ b/src/gtk-glue.c	Thu Feb 25 06:14:50 2010 -0600
@@ -208,17 +208,18 @@
 static GdkGC *
 face_to_gc (Lisp_Object face)
 {
-  Lisp_Object device = Fselected_device (Qnil);
+  Lisp_Object frame = Fselected_frame (Qnil);
 
-  return (gtk_get_gc (XDEVICE (device),
+  return (gtk_get_gc (XFRAME (frame),
 		      Fspecifier_instance (Fget (face, Qfont, Qnil),
-					   device, Qnil, Qnil),
+					   frame, Qnil, Qnil),
 		      Fspecifier_instance (Fget (face, Qforeground, Qnil),
-					   device, Qnil, Qnil),
+					   frame, Qnil, Qnil),
 		      Fspecifier_instance (Fget (face, Qbackground, Qnil),
-					   device, Qnil, Qnil),
+					   frame, Qnil, Qnil),
 		      Fspecifier_instance (Fget (face, Qbackground_pixmap,
-						 Qnil), device, Qnil, Qnil),
+						 Qnil),
+					   frame, Qnil, Qnil),
 		      Qnil));
 }
 
--- a/src/redisplay-output.c	Thu Feb 25 06:11:07 2010 -0600
+++ b/src/redisplay-output.c	Thu Feb 25 06:14:50 2010 -0600
@@ -1804,8 +1804,8 @@
   if (UNBOUNDP (background_pixmap))
     background_pixmap = Qnil;
 
-  DEVMETH (d, clear_region,
-	   (locale, d, f, findex, x, y, width, height, fcolor, bcolor, background_pixmap));
+  DEVMETH (d, clear_region, (locale, d, f, findex, x, y, width, height,
+			     fcolor, bcolor, background_pixmap));
 }
 
 /****************************************************************************
--- a/src/redisplay-xlike-inc.c	Thu Feb 25 06:11:07 2010 -0600
+++ b/src/redisplay-xlike-inc.c	Thu Feb 25 06:14:50 2010 -0600
@@ -812,7 +812,7 @@
 
 /* Called as gtk_get_gc from gtk-glue.c */
 
-XLIKE_GC XLIKE_get_gc (struct device *d, Lisp_Object font, Lisp_Object fg, 
+XLIKE_GC XLIKE_get_gc (struct frame *f, Lisp_Object font, Lisp_Object fg, 
 		       Lisp_Object bg, Lisp_Object bg_pmap,
 		       Lisp_Object lwidth);
 
@@ -822,9 +822,10 @@
  Given a number of parameters return a GC with those properties.
  ****************************************************************************/
 XLIKE_GC
-XLIKE_get_gc (struct device *d, Lisp_Object font, Lisp_Object fg, 
+XLIKE_get_gc (struct frame *f, Lisp_Object font, Lisp_Object fg, 
 	      Lisp_Object bg, Lisp_Object bg_pmap, Lisp_Object lwidth)
 {
+  struct device *d = XDEVICE (f->device);
   XLIKE_GCVALUES gcv;
   unsigned long mask;
 
@@ -1076,7 +1077,7 @@
        && !NILP (w->text_cursor_visible_p)) || NILP (bg_pmap))
     bgc = 0;
   else
-    bgc = XLIKE_get_gc (d, Qnil, cachel->foreground, cachel->background,
+    bgc = XLIKE_get_gc (f, Qnil, cachel->foreground, cachel->background,
 			bg_pmap, Qnil);
 
   if (bgc)
@@ -1157,7 +1158,7 @@
 	  fg = XFT_FROB_LISP_COLOR (cursor_cachel->foreground, 0);
 	  bg = XFT_FROB_LISP_COLOR (cursor_cachel->background, 0);
 #endif
-	  gc = XLIKE_get_gc (d, font, cursor_cachel->foreground,
+	  gc = XLIKE_get_gc (f, font, cursor_cachel->foreground,
 			     cursor_cachel->background, Qnil, Qnil);
 	}
       else if (cachel->dim)
@@ -1179,7 +1180,7 @@
 	  fg = XFT_FROB_LISP_COLOR (cachel->foreground, 1);
 	  bg = XFT_FROB_LISP_COLOR (cachel->background, 0);
 #endif
-	  gc = XLIKE_get_gc (d, font, cachel->foreground, cachel->background,
+	  gc = XLIKE_get_gc (f, font, cachel->foreground, cachel->background,
 			     Qdim, Qnil);
 	}
       else
@@ -1188,7 +1189,7 @@
 	  fg = XFT_FROB_LISP_COLOR (cachel->foreground, 0);
 	  bg = XFT_FROB_LISP_COLOR (cachel->background, 0);
 #endif
-	  gc = XLIKE_get_gc (d, font, cachel->foreground, cachel->background,
+	  gc = XLIKE_get_gc (f, font, cachel->foreground, cachel->background,
 			     Qnil, Qnil);
 	}
 #ifdef USE_XFT
@@ -1462,7 +1463,7 @@
 	    {
 	      XLIKE_RECTANGLE clip_box;
 	      XLIKE_GC cgc;
-	      cgc = XLIKE_get_gc (d, font, cursor_cachel->foreground,
+	      cgc = XLIKE_get_gc (f, font, cursor_cachel->foreground,
 				  cursor_cachel->background, Qnil, Qnil);
 
 	      clip_box.x = 0;
@@ -1534,12 +1535,12 @@
 
       if (!NILP (bar_cursor_value))
 	{
-	  gc = XLIKE_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil,
+	  gc = XLIKE_get_gc (f, Qnil, cursor_cachel->background, Qnil, Qnil,
 			     make_int (bar_width));
 	}
       else
 	{
-	  gc = XLIKE_get_gc (d, Qnil, cursor_cachel->background,
+	  gc = XLIKE_get_gc (f, Qnil, cursor_cachel->background,
 			     Qnil, Qnil, Qnil);
 	}
 
@@ -1728,7 +1729,7 @@
 			    get_builtin_face_cache_index
 			    (w, Vtext_cursor_face));
 
-      gc = XLIKE_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil, Qnil);
+      gc = XLIKE_get_gc (f, Qnil, cursor_cachel->background, Qnil, Qnil, Qnil);
 
       if (cursor_width > db->xpos + dga->width - cursor_start)
 	cursor_width = db->xpos + dga->width - cursor_start;
@@ -1872,10 +1873,10 @@
     bg_pmap = Qnil;
 
   if (NILP (bg_pmap))
-    gc = XLIKE_get_gc (d, Qnil, WINDOW_FACE_CACHEL_BACKGROUND (w, rb->findex),
+    gc = XLIKE_get_gc (f, Qnil, WINDOW_FACE_CACHEL_BACKGROUND (w, rb->findex),
 		       Qnil, Qnil, Qnil);
   else
-    gc = XLIKE_get_gc (d, Qnil, WINDOW_FACE_CACHEL_FOREGROUND (w, rb->findex),
+    gc = XLIKE_get_gc (f, Qnil, WINDOW_FACE_CACHEL_FOREGROUND (w, rb->findex),
 		       WINDOW_FACE_CACHEL_BACKGROUND (w, rb->findex), bg_pmap,
 		       Qnil);
 
@@ -1897,7 +1898,7 @@
 			   (WINDOW_FACE_CACHEL (w, rb->findex),
 			    Vcharset_ascii));
 
-      gc = XLIKE_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil, Qnil);
+      gc = XLIKE_get_gc (f, Qnil, cursor_cachel->background, Qnil, Qnil, Qnil);
 
       cursor_y = dl->ypos - fi->ascent;
       cursor_height = fi->height;
@@ -1915,7 +1916,7 @@
 	    {
 	      int bar_width = EQ (bar_cursor_value, Qt) ? 1 : 2;
 
-	      gc = XLIKE_get_gc (d, Qnil, cursor_cachel->background,
+	      gc = XLIKE_get_gc (f, Qnil, cursor_cachel->background,
 				 Qnil, Qnil, make_int (bar_width));
 	      XLIKE_DRAW_LINE (dpy, x_win, gc, cursor_start + bar_width - 1,
 			       cursor_y, cursor_start + bar_width - 1,
@@ -1959,7 +1960,7 @@
   /* First clear the area not covered by the line. */
   if (height - rb->object.hline.thickness > 0)
     {
-      gc = XLIKE_get_gc (d, Qnil,
+      gc = XLIKE_get_gc (f, Qnil,
 			 WINDOW_FACE_CACHEL_FOREGROUND (w, rb->findex),
 			 Qnil, Qnil, Qnil);
 
@@ -1977,7 +1978,7 @@
   }
 #else /* THIS_IS_X */
   /* Now draw the line. */
-  gc = XLIKE_get_gc (d, Qnil, WINDOW_FACE_CACHEL_BACKGROUND (w, rb->findex),
+  gc = XLIKE_get_gc (f, Qnil, WINDOW_FACE_CACHEL_BACKGROUND (w, rb->findex),
 		     Qnil, Qnil, Qnil);
 
   if (ypos2 < ypos1)
@@ -2008,7 +2009,7 @@
 
   if (!UNBOUNDP (background_pixmap))
     {
-      gc = XLIKE_get_gc (d, Qnil, fcolor, bcolor, background_pixmap, Qnil);
+      gc = XLIKE_get_gc (f, Qnil, fcolor, bcolor, background_pixmap, Qnil);
     }
 
   if (gc)
@@ -2054,7 +2055,7 @@
   if (NILP (w->text_cursor_visible_p))
     return;
 
-  gc = XLIKE_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil, Qnil);
+  gc = XLIKE_get_gc (f, Qnil, cursor_cachel->background, Qnil, Qnil, Qnil);
 
   default_face_font_info (window, &defascent, 0, 0, &defheight, 0);
 
@@ -2078,7 +2079,7 @@
 	{
 	  int bar_width = EQ (bar_cursor_value, Qt) ? 1 : 2;
 
-	  gc = XLIKE_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil,
+	  gc = XLIKE_get_gc (f, Qnil, cursor_cachel->background, Qnil, Qnil,
 			     make_int (bar_width));
 	  XLIKE_DRAW_LINE (dpy, x_win, gc, x + bar_width - 1, cursor_y,
 			   x + bar_width - 1, cursor_y + cursor_height - 1);