From: YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
Subject: Re: Image support for Carbon Emacs (Re: Consolidation of image support)
Date: Tue, 20 Apr 2004 17:43:07 +0900 [thread overview]
Message-ID: <wlisfvrqec.wl@church.math.s.chiba-u.ac.jp> (raw)
In-Reply-To: <20040113.211033.74742347.mituharu@math.s.chiba-u.ac.jp>
>>>>> On Tue, 13 Jan 2004 21:10:33 +0900 (JST), YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> said:
> Current status:
> - Unsupported image types: XPM and PostScript.
Below is an XPM support patch for Carbon Emacs. It does not depend on
libXpm, but only supports XPM version 3 without extensions.
YAMAMOTO Mitsuharu
mituharu@math.s.chiba-u.ac.jp
Index: src/image.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/image.c,v
retrieving revision 1.7
diff -c -r1.7 image.c
*** src/image.c 16 Apr 2004 20:08:15 -0000 1.7
--- src/image.c 20 Apr 2004 05:20:40 -0000
***************
*** 3161,3172 ****
XPM images
***********************************************************************/
! #ifdef HAVE_XPM
static int xpm_image_p P_ ((Lisp_Object object));
static int xpm_load P_ ((struct frame *f, struct image *img));
static int xpm_valid_color_symbols_p P_ ((Lisp_Object));
#ifdef HAVE_NTGUI
/* Indicate to xpm.h that we don't have Xlib. */
#define FOR_MSW
--- 3161,3175 ----
XPM images
***********************************************************************/
! #if defined (HAVE_XPM) || defined (MAC_OS)
static int xpm_image_p P_ ((Lisp_Object object));
static int xpm_load P_ ((struct frame *f, struct image *img));
static int xpm_valid_color_symbols_p P_ ((Lisp_Object));
+ #endif /* HAVE_XPM || MAC_OS */
+
+ #ifdef HAVE_XPM
#ifdef HAVE_NTGUI
/* Indicate to xpm.h that we don't have Xlib. */
#define FOR_MSW
***************
*** 3182,3187 ****
--- 3185,3193 ----
#else
#include "X11/xpm.h"
#endif /* HAVE_NTGUI */
+ #endif /* HAVE_XPM */
+
+ #if defined (HAVE_XPM) || defined (MAC_OS)
/* The symbol `xpm' identifying XPM-format images. */
***************
*** 3510,3519 ****
--- 3516,3527 ----
|| xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value)));
}
+ #endif /* HAVE_XPM || MAC_OS */
/* Load image IMG which will be displayed on frame F. Value is
non-zero if successful. */
+ #ifdef HAVE_XPM
static int
xpm_load (f, img)
struct frame *f;
***************
*** 3745,3750 ****
--- 3753,4218 ----
#endif /* HAVE_XPM */
+ #ifdef MAC_OS
+
+ /* XPM support functions for Mac OS where libxpm is not available.
+ Only XPM version 3 (without any extensions) is supported. */
+
+ static int xpm_scan P_ ((unsigned char **, unsigned char *,
+ unsigned char **, int *));
+ static Lisp_Object xpm_make_color_table_v
+ P_ ((void (**) (Lisp_Object, unsigned char *, int, Lisp_Object),
+ Lisp_Object (**) (Lisp_Object, unsigned char *, int)));
+ static void xpm_put_color_table_v P_ ((Lisp_Object, unsigned char *,
+ int, Lisp_Object));
+ static Lisp_Object xpm_get_color_table_v P_ ((Lisp_Object,
+ unsigned char *, int));
+ static Lisp_Object xpm_make_color_table_h
+ P_ ((void (**) (Lisp_Object, unsigned char *, int, Lisp_Object),
+ Lisp_Object (**) (Lisp_Object, unsigned char *, int)));
+ static void xpm_put_color_table_h P_ ((Lisp_Object, unsigned char *,
+ int, Lisp_Object));
+ static Lisp_Object xpm_get_color_table_h P_ ((Lisp_Object,
+ unsigned char *, int));
+ static int xpm_str_to_color_key P_ ((char *));
+ static int xpm_load_image P_ ((struct frame *, struct image *,
+ unsigned char *, unsigned char *));
+
+ /* Tokens returned from xpm_scan. */
+
+ enum xpm_token
+ {
+ XPM_TK_IDENT = 256,
+ XPM_TK_STRING,
+ XPM_TK_EOF
+ };
+
+ /* Scan an XPM data and return a character (< 256) or a token defined
+ by enum xpm_token above. *S and END are the start (inclusive) and
+ the end (exclusive) addresses of the data, respectively. Advance
+ *S while scanning. If token is either XPM_TK_IDENT or
+ XPM_TK_STRING, *BEG and *LEN are set to the start address and the
+ length of the corresponding token, respectively. */
+
+ static int
+ xpm_scan (s, end, beg, len)
+ unsigned char **s, *end, **beg;
+ int *len;
+ {
+ int c;
+
+ while (*s < end)
+ {
+ /* Skip white-space. */
+ while (*s < end && (c = *(*s)++, isspace (c)))
+ ;
+
+ /* gnus-pointer.xpm uses '-' in its identifier.
+ sb-dir-plus.xpm uses '+' in its identifier. */
+ if (isalpha (c) || c == '_' || c == '-' || c == '+')
+ {
+ *beg = *s - 1;
+ while (*s < end &&
+ (c = **s, isalnum (c) || c == '_' || c == '-' || c == '+'))
+ ++*s;
+ *len = *s - *beg;
+ return XPM_TK_IDENT;
+ }
+ else if (c == '"')
+ {
+ *beg = *s;
+ while (*s < end && **s != '"')
+ ++*s;
+ *len = *s - *beg;
+ if (*s < end)
+ ++*s;
+ return XPM_TK_STRING;
+ }
+ else if (c == '/')
+ {
+ if (*s < end && **s == '*')
+ {
+ /* C-style comment. */
+ ++*s;
+ do
+ {
+ while (*s < end && *(*s)++ != '*')
+ ;
+ }
+ while (*s < end && **s != '/');
+ if (*s < end)
+ ++*s;
+ }
+ else
+ return c;
+ }
+ else
+ return c;
+ }
+
+ return XPM_TK_EOF;
+ }
+
+ /* Functions for color table lookup in XPM data. A Key is a string
+ specifying the color of each pixel in XPM data. A value is either
+ an integer that specifies a pixel color, Qt that specifies
+ transparency, or Qnil for the unspecified color. If the length of
+ the key string is one, a vector is used as a table. Otherwise, a
+ hash table is used. */
+
+ static Lisp_Object
+ xpm_make_color_table_v (put_func, get_func)
+ void (**put_func) (Lisp_Object, unsigned char *, int, Lisp_Object);
+ Lisp_Object (**get_func) (Lisp_Object, unsigned char *, int);
+ {
+ *put_func = xpm_put_color_table_v;
+ *get_func = xpm_get_color_table_v;
+ return Fmake_vector (make_number (256), Qnil);
+ }
+
+ static void
+ xpm_put_color_table_v (color_table, chars_start, chars_len, color)
+ Lisp_Object color_table;
+ unsigned char *chars_start;
+ int chars_len;
+ Lisp_Object color;
+ {
+ XVECTOR (color_table)->contents[*chars_start] = color;
+ }
+
+ static Lisp_Object
+ xpm_get_color_table_v (color_table, chars_start, chars_len)
+ Lisp_Object color_table;
+ unsigned char *chars_start;
+ int chars_len;
+ {
+ return XVECTOR (color_table)->contents[*chars_start];
+ }
+
+ static Lisp_Object
+ xpm_make_color_table_h (put_func, get_func)
+ void (**put_func) (Lisp_Object, unsigned char *, int, Lisp_Object);
+ Lisp_Object (**get_func) (Lisp_Object, unsigned char *, int);
+ {
+ *put_func = xpm_put_color_table_h;
+ *get_func = xpm_get_color_table_h;
+ return make_hash_table (Qequal, make_number (DEFAULT_HASH_SIZE),
+ make_float (DEFAULT_REHASH_SIZE),
+ make_float (DEFAULT_REHASH_THRESHOLD),
+ Qnil, Qnil, Qnil);
+ }
+
+ static void
+ xpm_put_color_table_h (color_table, chars_start, chars_len, color)
+ Lisp_Object color_table;
+ unsigned char *chars_start;
+ int chars_len;
+ Lisp_Object color;
+ {
+ struct Lisp_Hash_Table *table = XHASH_TABLE (color_table);
+ unsigned hash_code;
+ Lisp_Object chars = make_unibyte_string (chars_start, chars_len);
+
+ hash_lookup (table, chars, &hash_code);
+ hash_put (table, chars, color, hash_code);
+ }
+
+ static Lisp_Object
+ xpm_get_color_table_h (color_table, chars_start, chars_len)
+ Lisp_Object color_table;
+ unsigned char *chars_start;
+ int chars_len;
+ {
+ struct Lisp_Hash_Table *table = XHASH_TABLE (color_table);
+ int i = hash_lookup (table, make_unibyte_string (chars_start, chars_len),
+ NULL);
+
+ return i >= 0 ? HASH_VALUE (table, i) : Qnil;
+ }
+
+ enum xpm_color_key {
+ XPM_COLOR_KEY_S,
+ XPM_COLOR_KEY_M,
+ XPM_COLOR_KEY_G4,
+ XPM_COLOR_KEY_G,
+ XPM_COLOR_KEY_C
+ };
+
+ static char xpm_color_key_strings[][4] = {"s", "m", "g4", "g", "c"};
+
+ static int
+ xpm_str_to_color_key (s)
+ char *s;
+ {
+ int i;
+
+ for (i = 0;
+ i < sizeof xpm_color_key_strings / sizeof xpm_color_key_strings[0];
+ i++)
+ if (strcmp (xpm_color_key_strings[i], s) == 0)
+ return i;
+ return -1;
+ }
+
+ static int
+ xpm_load_image (f, img, contents, end)
+ struct frame *f;
+ struct image *img;
+ unsigned char *contents, *end;
+ {
+ unsigned char *s = contents, *beg, *str;
+ unsigned char buffer[BUFSIZ];
+ int width, height, x, y;
+ int num_colors, chars_per_pixel;
+ int len, LA1;
+ void (*put_color_table) (Lisp_Object, unsigned char *, int, Lisp_Object);
+ Lisp_Object (*get_color_table) (Lisp_Object, unsigned char *, int);
+ Lisp_Object frame, color_symbols, color_table;
+ int best_key, have_mask = 0;
+ XImagePtr ximg = NULL, mask_img = NULL;
+
+ #define match() \
+ LA1 = xpm_scan (&s, end, &beg, &len)
+
+ #define expect(TOKEN) \
+ if (LA1 != (TOKEN)) \
+ goto failure; \
+ else \
+ match ()
+
+ #define expect_ident(IDENT) \
+ if (LA1 == XPM_TK_IDENT \
+ && strlen ((IDENT)) == len && memcmp ((IDENT), beg, len) == 0) \
+ match (); \
+ else \
+ goto failure
+
+ if (!(end - s >= 9 && memcmp (s, "/* XPM */", 9) == 0))
+ goto failure;
+ s += 9;
+ match();
+ expect_ident ("static");
+ expect_ident ("char");
+ expect ('*');
+ expect (XPM_TK_IDENT);
+ expect ('[');
+ expect (']');
+ expect ('=');
+ expect ('{');
+ expect (XPM_TK_STRING);
+ if (len >= BUFSIZ)
+ goto failure;
+ memcpy (buffer, beg, len);
+ buffer[len] = '\0';
+ if (sscanf (buffer, "%d %d %d %d", &width, &height,
+ &num_colors, &chars_per_pixel) != 4
+ || width <= 0 || height <= 0
+ || num_colors <= 0 || chars_per_pixel <= 0)
+ goto failure;
+ expect (',');
+
+ XSETFRAME (frame, f);
+ if (!NILP (Fxw_display_color_p (frame)))
+ best_key = XPM_COLOR_KEY_C;
+ else if (!NILP (Fx_display_grayscale_p (frame)))
+ best_key = (XFASTINT (Fx_display_planes (frame)) > 2
+ ? XPM_COLOR_KEY_G : XPM_COLOR_KEY_G4);
+ else
+ best_key = XPM_COLOR_KEY_M;
+
+ color_symbols = image_spec_value (img->spec, QCcolor_symbols, NULL);
+ if (chars_per_pixel == 1)
+ color_table = xpm_make_color_table_v (&put_color_table,
+ &get_color_table);
+ else
+ color_table = xpm_make_color_table_h (&put_color_table,
+ &get_color_table);
+
+ while (num_colors-- > 0)
+ {
+ unsigned char *color, *max_color;
+ int key, next_key, max_key = 0;
+ Lisp_Object symbol_color = Qnil, color_val;
+ XColor cdef;
+
+ expect (XPM_TK_STRING);
+ if (len <= chars_per_pixel || len >= BUFSIZ + chars_per_pixel)
+ goto failure;
+ memcpy (buffer, beg + chars_per_pixel, len - chars_per_pixel);
+ buffer[len - chars_per_pixel] = '\0';
+
+ str = strtok (buffer, " \t");
+ if (str == NULL)
+ goto failure;
+ key = xpm_str_to_color_key (str);
+ if (key < 0)
+ goto failure;
+ do
+ {
+ color = strtok (NULL, " \t");
+ if (color == NULL)
+ goto failure;
+
+ while (str = strtok (NULL, " \t"))
+ {
+ next_key = xpm_str_to_color_key (str);
+ if (next_key >= 0)
+ break;
+ color[strlen (color)] = ' ';
+ }
+
+ if (key == XPM_COLOR_KEY_S)
+ {
+ if (NILP (symbol_color))
+ symbol_color = build_string (color);
+ }
+ else if (max_key < key && key <= best_key)
+ {
+ max_key = key;
+ max_color = color;
+ }
+ key = next_key;
+ }
+ while (str);
+
+ color_val = Qnil;
+ if (!NILP (color_symbols) && !NILP (symbol_color))
+ {
+ Lisp_Object specified_color = Fassoc (symbol_color, color_symbols);
+
+ if (CONSP (specified_color) && STRINGP (XCDR (specified_color)))
+ if (xstricmp (SDATA (XCDR (specified_color)), "None") == 0)
+ color_val = Qt;
+ else if (x_defined_color (f, SDATA (XCDR (specified_color)),
+ &cdef, 0))
+ color_val = make_number (cdef.pixel);
+ }
+ if (NILP (color_val) && max_key > 0)
+ if (xstricmp (max_color, "None") == 0)
+ color_val = Qt;
+ else if (x_defined_color (f, max_color, &cdef, 0))
+ color_val = make_number (cdef.pixel);
+ if (!NILP (color_val))
+ (*put_color_table) (color_table, beg, chars_per_pixel, color_val);
+
+ expect (',');
+ }
+
+ if (!x_create_x_image_and_pixmap (f, width, height, 0,
+ &ximg, &img->pixmap)
+ || !x_create_x_image_and_pixmap (f, width, height, 1,
+ &mask_img, &img->mask))
+ {
+ image_error ("Out of memory (%s)", img->spec, Qnil);
+ goto error;
+ }
+
+ for (y = 0; y < height; y++)
+ {
+ expect (XPM_TK_STRING);
+ str = beg;
+ if (len < width * chars_per_pixel)
+ goto failure;
+ for (x = 0; x < width; x++, str += chars_per_pixel)
+ {
+ Lisp_Object color_val =
+ (*get_color_table) (color_table, str, chars_per_pixel);
+
+ XPutPixel (ximg, x, y,
+ (INTEGERP (color_val) ? XINT (color_val)
+ : FRAME_FOREGROUND_PIXEL (f)));
+ XPutPixel (mask_img, x, y,
+ (!EQ (color_val, Qt) ? PIX_MASK_DRAW (f)
+ : (have_mask = 1, PIX_MASK_RETAIN (f))));
+ }
+ if (y + 1 < height)
+ expect (',');
+ }
+
+ img->width = width;
+ img->height = height;
+
+ x_put_x_image (f, ximg, img->pixmap, width, height);
+ x_destroy_x_image (ximg);
+ if (have_mask)
+ {
+ x_put_x_image (f, mask_img, img->mask, width, height);
+ x_destroy_x_image (mask_img);
+ }
+ else
+ {
+ x_destroy_x_image (mask_img);
+ Free_Pixmap (FRAME_X_DISPLAY (f), img->mask);
+ img->mask = NO_PIXMAP;
+ }
+
+ return 1;
+
+ failure:
+ image_error ("Invalid XPM file (%s)", img->spec, Qnil);
+ error:
+ x_destroy_x_image (ximg);
+ x_destroy_x_image (mask_img);
+ x_clear_image (f, img);
+ return 0;
+
+ #undef match
+ #undef expect
+ #undef expect_ident
+ }
+
+ static int
+ xpm_load (f, img)
+ struct frame *f;
+ struct image *img;
+ {
+ int success_p = 0;
+ Lisp_Object file_name;
+
+ /* If IMG->spec specifies a file name, create a non-file spec from it. */
+ file_name = image_spec_value (img->spec, QCfile, NULL);
+ if (STRINGP (file_name))
+ {
+ Lisp_Object file;
+ unsigned char *contents;
+ int size;
+ struct gcpro gcpro1;
+
+ file = x_find_image_file (file_name);
+ GCPRO1 (file);
+ if (!STRINGP (file))
+ {
+ image_error ("Cannot find image file `%s'", file_name, Qnil);
+ UNGCPRO;
+ return 0;
+ }
+
+ contents = slurp_file (SDATA (file), &size);
+ if (contents == NULL)
+ {
+ image_error ("Error loading XPM image `%s'", img->spec, Qnil);
+ UNGCPRO;
+ return 0;
+ }
+
+ success_p = xpm_load_image (f, img, contents, contents + size);
+ xfree (contents);
+ UNGCPRO;
+ }
+ else
+ {
+ Lisp_Object data;
+
+ data = image_spec_value (img->spec, QCdata, NULL);
+ success_p = xpm_load_image (f, img, SDATA (data),
+ SDATA (data) + SBYTES (data));
+ }
+
+ return success_p;
+ }
+
+ #endif /* MAC_OS */
+
\f
/***********************************************************************
Color table
***************
*** 7417,7423 ****
Qxbm = intern ("xbm");
staticpro (&Qxbm);
! #ifdef HAVE_XPM
Qxpm = intern ("xpm");
staticpro (&Qxpm);
#endif
--- 7885,7891 ----
Qxbm = intern ("xbm");
staticpro (&Qxbm);
! #if defined (HAVE_XPM) || defined (MAC_OS)
Qxpm = intern ("xpm");
staticpro (&Qxpm);
#endif
***************
*** 7487,7493 ****
define_image_type (&xbm_type);
define_image_type (&pbm_type);
! #ifdef HAVE_XPM
IF_LIB_AVAILABLE(init_xpm_functions)
define_image_type (&xpm_type);
#endif
--- 7955,7961 ----
define_image_type (&xbm_type);
define_image_type (&pbm_type);
! #if defined (HAVE_XPM) || defined (MAC_OS)
IF_LIB_AVAILABLE(init_xpm_functions)
define_image_type (&xpm_type);
#endif
next prev parent reply other threads:[~2004-04-20 8:43 UTC|newest]
Thread overview: 22+ messages / expand[flat|nested] mbox.gz Atom feed top
2003-12-18 13:57 Consolidation of image support (was Re: Emacs on MAC OS X 10.3) YAMAMOTO Mitsuharu
2003-12-18 16:42 ` Kim F. Storm
2004-01-13 12:10 ` Image support for Carbon Emacs (Re: Consolidation of image support) YAMAMOTO Mitsuharu
2004-01-13 15:55 ` Stefan Monnier
2004-01-19 11:53 ` YAMAMOTO Mitsuharu
2004-01-28 12:48 ` Sébastien Kirche
2004-01-28 18:07 ` Steven Tamm
2004-01-14 0:20 ` Kim F. Storm
2004-01-15 21:22 ` Richard Stallman
2004-01-16 4:22 ` Steven Tamm
2004-01-16 19:54 ` Richard Stallman
2004-01-16 0:54 ` Image support for Carbon Emacs Hans-Peter Binder
2004-01-16 5:05 ` YAMAMOTO Mitsuharu
2004-01-16 10:44 ` Hans-Peter Binder
2004-04-20 8:43 ` YAMAMOTO Mitsuharu [this message]
2004-04-20 9:03 ` Image support for Carbon Emacs (Re: Consolidation of image support) Miles Bader
2004-04-20 9:31 ` YAMAMOTO Mitsuharu
2004-04-20 9:16 ` David Kastrup
2004-04-20 14:28 ` Stefan Monnier
2004-04-21 1:10 ` YAMAMOTO Mitsuharu
2004-04-21 15:58 ` Stefan Monnier
2004-04-22 1:08 ` YAMAMOTO Mitsuharu
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=wlisfvrqec.wl@church.math.s.chiba-u.ac.jp \
--to=mituharu@math.s.chiba-u.ac.jp \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.