add image fit option to emacs

emacs-24.5-image-fit.diff

--- ./lisp/image.el.orig	2015-02-02 02:27:17.000000000 +0900
+++ ./lisp/image.el	2015-04-11 07:30:10.847912500 +0900
@@ -126,6 +126,15 @@
   :type '(repeat (choice directory variable))
   :initialize 'custom-initialize-delay)
 
+;;;###autoload
+(defcustom image-fit-option-alist nil
+  "Alist of (IMAGE-TYPE . FIT-OPTION) pairs used by image loader to specify image size.
+the FIT-OPTION is one of 'never, 'frame, 'width-or-height, 'width or 'height.
+Note: All image loaders are not supporting this `fit' capability.
+"
+  :type 'sexp
+  :initialize 'custom-initialize-default
+  :group 'image)
 
 (defun image-load-path-for-library (library image &optional path no-error)
   "Return a suitable search path for images used by LIBRARY.
--- ./lisp/startup.el.orig	2015-04-02 16:23:06.000000000 +0900
+++ ./lisp/startup.el	2015-04-11 07:30:10.851912600 +0900
@@ -1630,7 +1630,7 @@
 (defun fancy-splash-head ()
   "Insert the head part of the splash screen into the current buffer."
   (let* ((image-file (fancy-splash-image-file))
-	 (img (create-image image-file))
+	 (img (create-image image-file nil nil :fit 'never))
 	 (image-width (and img (car (image-size img))))
 	 (window-width (window-width)))
     (when img
--- ./src/image.c.orig	2015-04-02 16:23:06.000000000 +0900
+++ ./src/image.c	2015-04-11 07:30:10.859918700 +0900
@@ -536,6 +536,10 @@
 
 static struct image_type *image_types;
 
+/* "Alist of (IMAGE-TYPE . FIT-OPTION) pairs used by image loader to specify image size.  */
+
+//static Lisp_Object Vimage_fit_option_alist;
+
 /* The symbol `xbm' which is used as the type symbol for XBM images.  */
 
 static Lisp_Object Qxbm;
@@ -544,6 +548,7 @@
 
 Lisp_Object QCascent, QCmargin, QCrelief;
 Lisp_Object QCconversion;
+Lisp_Object QCfit;
 static Lisp_Object QCheuristic_mask;
 static Lisp_Object QCcolor_symbols;
 static Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask, QCgeometry;
@@ -617,6 +622,102 @@
   return p;
 }
 
+Lisp_Object Qnever, Qframe, Qwidth_or_height;
+
+static void image_error (const char *, Lisp_Object, Lisp_Object);
+static int get_fit_size(Lisp_Object opt, const struct frame *f,
+			int *w, int *h,
+			Lisp_Object image_type, int rise_error)
+{
+  if (NILP(opt))
+    return 0;
+
+  if (EQ(opt, Qnever)) {
+    *w = *h = 0;
+  } else if (EQ(opt, Qframe)) {
+    *w = FRAME_PIXEL_WIDTH (f) - FRAME_CONFIG_SCROLL_BAR_WIDTH (f) - FRAME_SCROLL_BAR_AREA_WIDTH (f);
+    *h = FRAME_PIXEL_HEIGHT (f);
+  } else if (EQ(opt, Qwidth_or_height)) {
+    *w = -(FRAME_PIXEL_WIDTH (f) - FRAME_CONFIG_SCROLL_BAR_WIDTH (f) - FRAME_SCROLL_BAR_AREA_WIDTH (f));
+    *h = -FRAME_PIXEL_HEIGHT (f);
+  } else if (EQ(opt, Qwidth)) {
+    *w = FRAME_PIXEL_WIDTH (f) - FRAME_CONFIG_SCROLL_BAR_WIDTH (f) - FRAME_SCROLL_BAR_AREA_WIDTH (f);
+    *h = 0;
+  } else if (EQ(opt, Qheight)) {
+    *w = 0;
+    *h = FRAME_PIXEL_HEIGHT (f);
+  } else {
+    if (rise_error)
+      xsignal2 (Qnil, build_string("unknown fit type"), opt);
+    else
+      image_error ("Invalid fit option for %s", image_type, Qnil);
+    return -1;
+  }
+  return 1;
+}
+
+static Lisp_Object image_spec_value (Lisp_Object, Lisp_Object, bool *);
+static int
+lookup_fit_size(Lisp_Object image_type,
+		const struct frame *f,
+		const struct image *img,
+		int *w, int *h,	int rise_error)
+{
+  Lisp_Object a, err, pred;
+  static const struct frame f_ = {0};
+  int w_, h_;
+  int r;
+
+//  assert(SYMBOLP (image_type));
+
+  if (img &&
+      (r = get_fit_size(image_spec_value(img->spec, QCfit, NULL),
+			f, w, h, image_type, rise_error)) != 0)
+    return r;
+
+#if 0
+  if (!CONSP (err = Vimage_fit_option_alist)) {
+    pred = Qconsp;
+    goto error;
+  }
+#endif
+
+  for (a = Vimage_fit_option_alist; !NILP(a); a = XCDR(a)) {
+    Lisp_Object o;
+    {
+      Lisp_Object e = XCAR(a);
+
+      if (!CONSP(err = e)) {
+	pred = Qconsp;
+	goto error;
+      }
+
+      if (!EQ(XCAR(e), image_type))
+	continue;
+      o = XCDR(e);
+    }
+
+    if (!SYMBOLP(err = o)) {
+      pred = Qsymbolp;
+      goto error;
+    }
+    if (f)
+      return get_fit_size(o, f, w, h, image_type, rise_error);
+    get_fit_size(o, &f_, &w_, &h_, image_type, rise_error);
+  }
+
+  /* not found */
+  if (f)
+    *w = *h = 0;
+  return 0;
+
+ error:
+  if (rise_error)
+    wrong_type_argument(pred, err);
+  else
+    image_error ("Invalid fit option for %s", image_type, Qnil);
+  return -1;
+}
 
 /* Value is true if OBJECT is a valid Lisp image specification.  A
    valid image specification is a list whose car is the symbol
@@ -3096,6 +3197,8 @@
 #define XImage xpm_XImage
 #define Display xpm_Display
 #define PIXEL_ALREADY_TYPEDEFED
+#undef close
+#undef open
 #include "X11/xpm.h"
 #undef FOR_MSW
 #undef XColor
@@ -6483,6 +6586,10 @@
   XImagePtr ximg = NULL;
   unsigned long *colors;
   int width, height;
+  int fit_width = 0, fit_height = 0;
+
+  if (lookup_fit_size (Qjpeg, f, img, &fit_width, &fit_height, !0) < 0)
+    return 0;
 
   /* Open the JPEG file.  */
   specified_file = image_spec_value (img->spec, QCfile, NULL);
@@ -6560,6 +6667,43 @@
 
   fn_jpeg_read_header (&mgr->cinfo, 1);
 
+#define JPEG8C_UNIT 8
+
+  if (fit_width > 0 && fit_height == 0) {
+    if (mgr->cinfo.image_width > fit_width) { /* fit to width */
+      mgr->cinfo.scale_num = ((double) fit_width / mgr->cinfo.image_width) * JPEG8C_UNIT;
+      mgr->cinfo.scale_denom = JPEG8C_UNIT;
+    }
+  } else if (fit_width == 0 && fit_height > 0) {
+    if (mgr->cinfo.image_height > fit_height) { /* fit to width */
+      mgr->cinfo.scale_num = ((double)fit_height / mgr->cinfo.image_height) * JPEG8C_UNIT;
+      mgr->cinfo.scale_denom = JPEG8C_UNIT;
+    }
+  } else if (fit_width > 0 && fit_height > 0) { /* fit to frame */
+    if (mgr->cinfo.image_width > fit_width ||
+	mgr->cinfo.image_height > fit_height) {
+      if ((double)fit_width / mgr->cinfo.image_width <
+	  (double)fit_height / mgr->cinfo.image_height) {
+	mgr->cinfo.scale_num = ((double)fit_width / mgr->cinfo.image_width) * JPEG8C_UNIT;
+      } else {
+	mgr->cinfo.scale_num = ((double)fit_height / mgr->cinfo.image_height) * JPEG8C_UNIT;
+	mgr->cinfo.scale_denom = JPEG8C_UNIT;
+      }
+    }
+  } else if (fit_width < 0 && fit_height < 0) { /* fit to width or height */
+    if (mgr->cinfo.image_width > -fit_width &&
+	mgr->cinfo.image_height > -fit_height) {
+      if ((double)-fit_width / mgr->cinfo.image_width >
+	  (double)-fit_height / mgr->cinfo.image_height) {
+	mgr->cinfo.scale_num = ((double)-fit_width / mgr->cinfo.image_width) * JPEG8C_UNIT;
+	mgr->cinfo.scale_denom = JPEG8C_UNIT;
+      } else {
+	mgr->cinfo.scale_num = ((double)-fit_height / mgr->cinfo.image_height) * JPEG8C_UNIT;
+	mgr->cinfo.scale_denom = JPEG8C_UNIT;
+      }
+    }
+  }
+
   /* Customize decompression so that color quantization will be used.
 	 Start decompression.  */
   mgr->cinfo.quantize_colors = 1;
@@ -8512,6 +8656,12 @@
 {
   bool success_p = 0;
   Lisp_Object file_name;
+  int w, h;
+
+#if 0
+  if (lookup_fit_size(Qjpeg, NULL, NULL, NULL, NULL, !0) < 0)
+    return 0;
+#endif
 
   /* If IMG->spec specifies a file name, create a non-file spec from it.  */
   file_name = image_spec_value (img->spec, QCfile, NULL);
@@ -8722,6 +8872,7 @@
   LOAD_IMGLIB_FN (library, rsvg_handle_write);
   LOAD_IMGLIB_FN (library, rsvg_handle_close);
   LOAD_IMGLIB_FN (library, rsvg_handle_get_pixbuf);
+  LOAD_IMGLIB_FN (library, rsvg_handle_set_size_callback);
 
   LOAD_IMGLIB_FN (gdklib, gdk_pixbuf_get_width);
   LOAD_IMGLIB_FN (gdklib, gdk_pixbuf_get_height);
@@ -8749,6 +8900,7 @@
 #define fn_rsvg_handle_write		rsvg_handle_write
 #define fn_rsvg_handle_close		rsvg_handle_close
 #define fn_rsvg_handle_get_pixbuf	rsvg_handle_get_pixbuf
+#define fn_rsvg_handle_set_size_callback rsvg_handle_set_size_callback
 
 #define fn_gdk_pixbuf_get_width		  gdk_pixbuf_get_width
 #define fn_gdk_pixbuf_get_height	  gdk_pixbuf_get_height
@@ -8819,6 +8971,48 @@
   return success_p;
 }
 
+static void  rsvg_size_callback  (gint *width,
+				  gint *height,
+				  gpointer user_data)
+{
+  int *fit_size = (int *)user_data;
+
+  /*
+   * 0, 0: never
+   * 0, +: fit to height
+   * +, 0: fit to width
+   * +, +: fit to frame
+   * -, -: fit to width or height
+   */
+  if (fit_size[0] > 0 && fit_size[1] == 0) {
+    *height *= (double)fit_size[0] / *width;
+    *width = (gint)fit_size[0];
+  } else if (fit_size[0] == 0 && fit_size[1] > 0) {
+    *width *= (double)fit_size[1] / *height;
+    *height = (gint)fit_size[1];
+  } else if (fit_size[0] > 0 && fit_size[1] > 0) { /* fit to frame */
+    if ((double)fit_size[0] / *width < (double)fit_size[1] / *height) {
+      /* fit to width */
+      *height *= (double)fit_size[0] / *width;
+      *width = (gint)fit_size[0];
+    } else {
+      /* fit to height */
+      *width *= (double)fit_size[1] / *height;
+      *height = (gint)fit_size[1];
+    }
+  } else if (fit_size[0] < 0 && fit_size[1] < 0) { /* fit to width or height */
+    if ((double)-fit_size[0] / *width < (double)-fit_size[1] / *height) {
+      /* fit to height */
+      *width *= (double)-fit_size[1] / *height;
+      *height = (gint)-fit_size[1];
+    } else {
+      /* fit to width */
+      *height *= (double)-fit_size[0] / *width;
+      *width = (gint)-fit_size[0];
+    }
+  }
+}
+
 /* svg_load_image is a helper function for svg_load, which does the
    actual loading given contents and size, apart from frame and image
    structures, passed from svg_load.
@@ -8845,6 +9039,10 @@
   XColor background;
   int x;
   int y;
+  int fit_size[2] = {0, 0};
+
+  if (lookup_fit_size(Qsvg, f, img, fit_size, fit_size+1, 0) < 0)
+    return 0;
 
 #if ! GLIB_CHECK_VERSION (2, 36, 0)
   /* g_type_init is a glib function that must be called prior to
@@ -8855,6 +9053,9 @@
   /* Make a handle to a new rsvg object.  */
   rsvg_handle = fn_rsvg_handle_new ();
 
+  if (fit_size[0] || fit_size[1])
+    fn_rsvg_handle_set_size_callback(rsvg_handle, rsvg_size_callback, fit_size, NULL);
+
   /* Parse the contents argument and fill in the rsvg_handle.  */
   fn_rsvg_handle_write (rsvg_handle, contents, size, &err);
   if (err) goto rsvg_error;
@@ -9438,6 +9639,7 @@
   DEFSYM (QCmatrix, ":matrix");
   DEFSYM (QCcolor_adjustment, ":color-adjustment");
   DEFSYM (QCmask, ":mask");
+  DEFSYM (QCfit, ":fit");
 
   DEFSYM (Qlaplace, "laplace");
   DEFSYM (Qemboss, "emboss");
@@ -9484,12 +9686,26 @@
 	);
 #endif
 
+  DEFVAR_LISP ("image-fit-option-alist", Vimage_fit_option_alist,
+    doc: /* Alist of (IMAGE-TYPE . FIT-OPTION) pairs used by image loader to specify image size.
+the FIT-OPTION is one of 'never, 'frame, 'width-or-height, 'width or 'height.
+Note: All image loaders are not supporting this `fit' capability. */);
+  Vimage_fit_option_alist = Qnil;
+
   DEFSYM (Qpbm, "pbm");
   ADD_IMAGE_TYPE (Qpbm);
 
   DEFSYM (Qxbm, "xbm");
   ADD_IMAGE_TYPE (Qxbm);
 
+  Qnever = intern_c_string("never");
+  staticpro (&Qnever);
+  Qframe = intern_c_string("frame");
+  staticpro (&Qframe);
+  Qwidth_or_height = intern_c_string("width-or-height");
+  staticpro (&Qwidth_or_height);
+
+
 #if defined (HAVE_XPM) || defined (HAVE_NS)
   DEFSYM (Qxpm, "xpm");
   ADD_IMAGE_TYPE (Qxpm);