Mercurial > hg > xemacs-beta

comparison src/glyphs.c @ 5126:2a462149bd6a ben-lisp-object

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Ben Wing <ben@xemacs.org>
date Wed, 24 Feb 2010 19:04:27 -0600
parents b5df3737028a 78a3c171a427
children a9c41067dd88
comparison
equal deleted inserted replaced
5125:b5df3737028a 5126:2a462149bd6a
2 Copyright (C) 1994, 1995 Board of Trustees, University of Illinois 2 Copyright (C) 1994, 1995 Board of Trustees, University of Illinois
3 Copyright (C) 1995 Tinker Systems 3 Copyright (C) 1995 Tinker Systems
4 Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004, 2005 Ben Wing 4 Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004, 2005 Ben Wing
5 Copyright (C) 1995 Sun Microsystems 5 Copyright (C) 1995 Sun Microsystems
6 Copyright (C) 1998, 1999, 2000 Andy Piper 6 Copyright (C) 1998, 1999, 2000 Andy Piper
7 Copyright (C) 2007 Didier Verna 7 Copyright (C) 2007, 2010 Didier Verna
8 8
9 This file is part of XEmacs. 9 This file is part of XEmacs.
10 10
11 XEmacs is free software; you can redistribute it and/or modify it 11 XEmacs is free software; you can redistribute it and/or modify it
12 under the terms of the GNU General Public License as published by the 12 under the terms of the GNU General Public License as published by the
2515 2515
2516 /************************************************************************/ 2516 /************************************************************************/
2517 /* pixmap file functions */ 2517 /* pixmap file functions */
2518 /************************************************************************/ 2518 /************************************************************************/
2519 2519
2520 /* If INSTANTIATOR refers to inline data, return Qt. 2520 /* - If INSTANTIATOR refers to inline data, or there is no file keyword, we
2521 If INSTANTIATOR refers to data in a file, return the full filename 2521 have nothing to do, so return Qt.
2522 if it exists, Qnil if there's no console method for locating the file, or 2522 - If INSTANTIATOR refers to data in a file, return the full filename
2523 (filename) if there was an error locating the file. 2523 if it exists; otherwise, return '(filename), meaning "file not found".
2524 - If there is no locate_pixmap_file method for this console, return Qnil.
2524 2525
2525 FILE_KEYWORD and DATA_KEYWORD are symbols specifying the 2526 FILE_KEYWORD and DATA_KEYWORD are symbols specifying the
2526 keywords used to look up the file and inline data, 2527 keywords used to look up the file and inline data,
2527 respectively, in the instantiator. Normally these would 2528 respectively, in the instantiator. These would be Q_file and Q_data,
2528 be Q_file and Q_data, but might be different for mask data. */ 2529 Q_mask_file or Q_mask_data. */
2529 2530
2530 Lisp_Object 2531 Lisp_Object
2531 potential_pixmap_file_instantiator (Lisp_Object instantiator, 2532 potential_pixmap_file_instantiator (Lisp_Object instantiator,
2532 Lisp_Object file_keyword, 2533 Lisp_Object file_keyword,
2533 Lisp_Object data_keyword, 2534 Lisp_Object data_keyword,
2730 } 2731 }
2731 2732
2732 return Qnil; /* not reached */ 2733 return Qnil; /* not reached */
2733 } 2734 }
2734 2735
2736 /* This function attempts to find implicit mask files by appending "Mask" or
2737 "msk" to the original bitmap file name. This is more or less standard: a
2738 number of bitmaps in /usr/include/X11/bitmaps use it. */
2735 Lisp_Object 2739 Lisp_Object
2736 xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file, 2740 xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file,
2737 Lisp_Object mask_file, Lisp_Object console_type) 2741 Lisp_Object mask_file, Lisp_Object console_type)
2738 { 2742 {
2739 /* This is unclean but it's fairly standard -- a number of the 2743 /* Let's try to find an implicit mask file if we have neither an explicit
2740 bitmaps in /usr/include/X11/bitmaps use it -- so we support 2744 mask file name, nor inline mask data. Note that no errors are reported in
2741 it. */ 2745 case of failure because the mask file we're looking for might not
2742 if (EQ (mask_file, Qt) 2746 exist. */
2743 /* don't override explicitly specified mask data. */ 2747 if (EQ (mask_file, Qt) && NILP (assq_no_quit (Q_mask_data, alist)))
2744 && NILP (assq_no_quit (Q_mask_data, alist)) 2748 {
2745 && !EQ (file, Qt)) 2749 assert (!EQ (file, Qt) && !EQ (file, Qnil));
2746 {
2747 mask_file = MAYBE_LISP_CONTYPE_METH 2750 mask_file = MAYBE_LISP_CONTYPE_METH
2748 (decode_console_type(console_type, ERROR_ME), 2751 (decode_console_type(console_type, ERROR_ME),
2749 locate_pixmap_file, (concat2 (file, build_ascstring ("Mask")))); 2752 locate_pixmap_file, (concat2 (file, build_ascstring ("Mask"))));
2750 if (NILP (mask_file)) 2753 if (NILP (mask_file))
2751 mask_file = MAYBE_LISP_CONTYPE_METH 2754 mask_file = MAYBE_LISP_CONTYPE_METH
2752 (decode_console_type(console_type, ERROR_ME), 2755 (decode_console_type(console_type, ERROR_ME),
2753 locate_pixmap_file, (concat2 (file, build_ascstring ("msk")))); 2756 locate_pixmap_file, (concat2 (file, build_ascstring ("msk"))));
2754 } 2757 }
2755 2758
2759 /* We got a mask file, either explicitely or from the search above. */
2756 if (!NILP (mask_file)) 2760 if (!NILP (mask_file))
2757 { 2761 {
2758 Lisp_Object mask_data = 2762 Lisp_Object mask_data;
2759 bitmap_to_lisp_data (mask_file, 0, 0, 0); 2763
2764 assert (!EQ (mask_file, Qt));
2765
2766 mask_data = bitmap_to_lisp_data (mask_file, 0, 0, 0);
2760 alist = remassq_no_quit (Q_mask_file, alist); 2767 alist = remassq_no_quit (Q_mask_file, alist);
2761 /* there can't be a :mask-data at this point. */ 2768 /* there can't be a :mask-data at this point. */
2762 alist = Fcons (Fcons (Q_mask_file, mask_file), 2769 alist = Fcons (Fcons (Q_mask_file, mask_file),
2763 Fcons (Fcons (Q_mask_data, mask_data), alist)); 2770 Fcons (Fcons (Q_mask_data, mask_data), alist));
2764 } 2771 }
2770 2777
2771 static Lisp_Object 2778 static Lisp_Object
2772 xbm_normalize (Lisp_Object inst, Lisp_Object console_type, 2779 xbm_normalize (Lisp_Object inst, Lisp_Object console_type,
2773 Lisp_Object UNUSED (dest_mask)) 2780 Lisp_Object UNUSED (dest_mask))
2774 { 2781 {
2775 Lisp_Object file = Qnil, mask_file = Qnil; 2782 Lisp_Object file = Qnil, mask_file = Qnil, alist = Qnil;
2776 struct gcpro gcpro1, gcpro2, gcpro3; 2783 struct gcpro gcpro1, gcpro2, gcpro3;
2777 Lisp_Object alist = Qnil;
2778 2784
2779 GCPRO3 (file, mask_file, alist); 2785 GCPRO3 (file, mask_file, alist);
2780 2786
2781 /* Now, convert any file data into inline data for both the regular 2787 /* Now, convert any file data into inline data for both the regular
2782 data and the mask data. At the end of this, `data' will contain 2788 data and the mask data. At the end of this, `data' will contain
2790 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data, 2796 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2791 console_type); 2797 console_type);
2792 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file, 2798 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
2793 Q_mask_data, console_type); 2799 Q_mask_data, console_type);
2794 2800
2795 if (NILP (file)) /* normalization impossible for the console type */ 2801 /* No locate_pixmap_file method for this console type, so we can't get a
2802 file (neither a mask file BTW). */
2803 if (NILP (file))
2796 RETURN_UNGCPRO (Qnil); 2804 RETURN_UNGCPRO (Qnil);
2797 2805
2798 if (CONSP (file)) /* failure locating filename */ 2806 if (CONSP (file)) /* failure locating filename */
2799 signal_double_image_error ("Opening bitmap file", 2807 signal_double_image_error ("Opening bitmap file",
2800 "no such file or directory", 2808 "no such file or directory",
2801 Fcar (file)); 2809 Fcar (file));
2810
2811 if (CONSP (mask_file)) /* failure locating filename */
2812 signal_double_image_error ("Opening bitmap mask file",
2813 "no such file or directory",
2814 Fcar (mask_file));
2802 2815
2803 if (EQ (file, Qt) && EQ (mask_file, Qt)) /* no conversion necessary */ 2816 if (EQ (file, Qt) && EQ (mask_file, Qt)) /* no conversion necessary */
2804 RETURN_UNGCPRO (inst); 2817 RETURN_UNGCPRO (inst);
2805 2818
2806 alist = tagged_vector_to_alist (inst); 2819 alist = tagged_vector_to_alist (inst);
2857 2870
2858 static Lisp_Object 2871 static Lisp_Object
2859 xface_normalize (Lisp_Object inst, Lisp_Object console_type, 2872 xface_normalize (Lisp_Object inst, Lisp_Object console_type,
2860 Lisp_Object UNUSED (dest_mask)) 2873 Lisp_Object UNUSED (dest_mask))
2861 { 2874 {
2862 /* This function can call lisp */ 2875 Lisp_Object file = Qnil, mask_file = Qnil, alist = Qnil;
2863 Lisp_Object file = Qnil, mask_file = Qnil;
2864 struct gcpro gcpro1, gcpro2, gcpro3; 2876 struct gcpro gcpro1, gcpro2, gcpro3;
2865 Lisp_Object alist = Qnil;
2866 2877
2867 GCPRO3 (file, mask_file, alist); 2878 GCPRO3 (file, mask_file, alist);
2868 2879
2869 /* Now, convert any file data into inline data for both the regular 2880 /* Now, convert any file data into inline data for both the regular
2870 data and the mask data. At the end of this, `data' will contain 2881 data and the mask data. At the end of this, `data' will contain
2878 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data, 2889 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2879 console_type); 2890 console_type);
2880 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file, 2891 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
2881 Q_mask_data, console_type); 2892 Q_mask_data, console_type);
2882 2893
2883 if (NILP (file)) /* normalization impossible for the console type */ 2894 /* No locate_pixmap_file method for this console type, so we can't get a
2895 file (neither a mask file BTW). */
2896 if (NILP (file))
2884 RETURN_UNGCPRO (Qnil); 2897 RETURN_UNGCPRO (Qnil);
2885 2898
2886 if (CONSP (file)) /* failure locating filename */ 2899 if (CONSP (file)) /* failure locating filename */
2887 signal_double_image_error ("Opening bitmap file", 2900 signal_double_image_error ("Opening face file",
2888 "no such file or directory", 2901 "no such file or directory",
2889 Fcar (file)); 2902 Fcar (file));
2890 2903
2904 if (CONSP (mask_file)) /* failure locating filename */
2905 signal_double_image_error ("Opening face mask file",
2906 "no such file or directory",
2907 Fcar (mask_file));
2908
2891 if (EQ (file, Qt) && EQ (mask_file, Qt)) /* no conversion necessary */ 2909 if (EQ (file, Qt) && EQ (mask_file, Qt)) /* no conversion necessary */
2892 RETURN_UNGCPRO (inst); 2910 RETURN_UNGCPRO (inst);
2893 2911
2894 alist = tagged_vector_to_alist (inst); 2912 alist = tagged_vector_to_alist (inst);
2895 2913
2896 { 2914 if (!EQ (file, Qt))
2897 /* #### FIXME: what if EQ (file, Qt) && !EQ (mask, Qt) ? Is that possible? 2915 {
2898 If so, we have a problem... -- dvl */ 2916 Lisp_Object data = make_string_from_file (file);
2899 Lisp_Object data = make_string_from_file (file); 2917 alist = remassq_no_quit (Q_file, alist);
2900 alist = remassq_no_quit (Q_file, alist); 2918 /* there can't be a :data at this point. */
2901 /* there can't be a :data at this point. */ 2919 alist = Fcons (Fcons (Q_file, file),
2902 alist = Fcons (Fcons (Q_file, file), 2920 Fcons (Fcons (Q_data, data), alist));
2903 Fcons (Fcons (Q_data, data), alist)); 2921 }
2904 }
2905 2922
2906 alist = xbm_mask_file_munging (alist, file, mask_file, console_type); 2923 alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
2907 2924
2908 { 2925 {
2909 Lisp_Object result = alist_to_tagged_vector (Qxface, alist); 2926 Lisp_Object result = alist_to_tagged_vector (Qxface, alist);