Mercurial > hg > xemacs-beta
annotate src/glyphs.c @ 5353:38e24b8be4ea
Improve the lexical scoping in #'block, #'return-from.
lisp/ChangeLog addition:
2011-02-07 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el:
* bytecomp.el (byte-compile-initial-macro-environment):
Shadow `block', `return-from' here, we implement them differently
when byte-compiling.
* bytecomp.el (byte-compile-active-blocks): New.
* bytecomp.el (byte-compile-block-1): New.
* bytecomp.el (byte-compile-return-from-1): New.
* bytecomp.el (return-from-1): New.
* bytecomp.el (block-1): New.
These are two aliases that exist to have their own associated
byte-compile functions, which functions implement `block' and
`return-from'.
* cl-extra.el (cl-macroexpand-all):
Fix a bug here when macros in the environment have been compiled.
* cl-macs.el (block):
* cl-macs.el (return):
* cl-macs.el (return-from):
Be more careful about lexical scope in these macros.
* cl.el:
* cl.el ('cl-block-wrapper): Removed.
* cl.el ('cl-block-throw): Removed.
These aren't needed in code generated by this XEmacs. They
shouldn't be needed in code generated by XEmacs 21.4, but if it
turns out the packages do need them, we can put them back.
2011-01-30 Mike Sperber <mike@xemacs.org>
* font-lock.el (font-lock-fontify-pending-extents): Don't fail if
`font-lock-mode' is unset, which can happen in the middle of
`revert-buffer'.
2011-01-23 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete):
* cl-macs.el (delq):
* cl-macs.el (remove):
* cl-macs.el (remq):
Don't use the compiler macro if these functions were given the
wrong number of arguments, as happens in lisp-tests.el.
* cl-seq.el (remove, remq): Removed.
I added these to subr.el, and forgot to remove them from here.
2011-01-22 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-setq, byte-compile-set):
Remove kludge allowing keywords' values to be set, all the code
that does that is gone.
* cl-compat.el (elt-satisfies-test-p):
* faces.el (set-face-parent):
* faces.el (face-doc-string):
* gtk-font-menu.el:
* gtk-font-menu.el (gtk-reset-device-font-menus):
* msw-font-menu.el:
* msw-font-menu.el (mswindows-reset-device-font-menus):
* package-get.el (package-get-installedp):
* select.el (select-convert-from-image-data):
* sound.el:
* sound.el (load-sound-file):
* x-font-menu.el (x-reset-device-font-menus-core):
Don't quote keywords, they're self-quoting, and the
win from backward-compatibility is sufficiently small now that the
style problem overrides it.
2011-01-22 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (block, return-from): Require that NAME be a symbol
in these macros, as always documented in the #'block docstring and
as required by Common Lisp.
* descr-text.el (unidata-initialize-unihan-database):
Correct the use of non-symbols in #'block and #'return-from in
this function.
2011-01-15 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (concatenate): Accept more complicated TYPEs in this
function, handing the sequences over to #'coerce if we don't
understand them here.
* cl-macs.el (inline): Don't proclaim #'concatenate as inline, its
compiler macro is more useful than doing that.
2011-01-11 Aidan Kehoe <kehoea@parhasard.net>
* subr.el (delete, delq, remove, remq): Move #'remove, #'remq
here, they don't belong in cl-seq.el; move #'delete, #'delq here
from fns.c, implement them in terms of #'delete*, allowing support
for sequences generally.
* update-elc.el (do-autoload-commands): Use #'delete*, not #'delq
here, now the latter's no longer dumped.
* cl-macs.el (delete, delq): Add compiler macros transforming
#'delete and #'delq to #'delete* calls.
2011-01-10 Aidan Kehoe <kehoea@parhasard.net>
* dialog.el (make-dialog-box): Correct a misplaced parenthesis
here, thank you Mats Lidell in 87zkr9gqrh.fsf@mail.contactor.se !
2011-01-02 Aidan Kehoe <kehoea@parhasard.net>
* dialog.el (make-dialog-box):
* list-mode.el (display-completion-list):
These functions used to use cl-parsing-keywords; change them to
use defun* instead, fixing the build. (Not sure what led to me
not including this change in d1b17a33450b!)
2011-01-02 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (define-star-compiler-macros):
Make sure the form has ITEM and LIST specified before attempting
to change to calls with explicit tests; necessary for some tests
in lisp-tests.el to compile correctly.
(stable-union, stable-intersection): Add compiler macros for these
functions, in the same way we do for most of the other functions
in cl-seq.el.
2011-01-01 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (dolist, dotimes, do-symbols, macrolet)
(symbol-macrolet):
Define these macros with defmacro* instead of parsing the argument
list by hand, for the sake of style and readability; use backquote
where appropriate, instead of calling #'list and and friends, for
the same reason.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* x-misc.el (device-x-display):
Provide this function, documented in the Lispref for years, but
not existing previously. Thank you Julian Bradfield, thank you
Jeff Mincy.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl-seq.el:
Move the heavy lifting from this file to C. Dump the
cl-parsing-keywords macro, but don't use defun* for the functions
we define that do take keywords, dynamic scope lossage makes that
not practical.
* subr.el (sort, fillarray): Move these aliases here.
(map-plist): #'nsublis is now built-in, but at this point #'eql
isn't necessarily available as a test; use #'eq.
* obsolete.el (cl-delete-duplicates): Make this available for old
compiler macros and old code.
(memql): Document that this is equivalent to #'member*, and worse.
* cl.el (adjoin, subst): Removed. These are in C.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* simple.el (assoc-ignore-case): Remove a duplicate definition of
this function (it's already in subr.el).
* iso8859-1.el (char-width):
On non-Mule, make this function equivalent to that produced by
(constantly 1), but preserve its docstring.
* subr.el (subst-char-in-string): Define this in terms of
#'substitute, #'nsubstitute.
(string-width): Define this using #'reduce and #'char-width.
(char-width): Give this a simpler definition, it makes far more
sense to check for mule at load time and redefine, as we do in
iso8859-1.el.
(store-substring): Implement this in terms of #'replace, now
#'replace is cheap.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* update-elc.el (lisp-files-needed-for-byte-compilation)
(lisp-files-needing-early-byte-compilation):
cl-macs belongs in the former, not the latter, it is as
fundamental as bytecomp.el.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl.el:
Provde the Common Lisp program-error, type-error as error
symbols. This doesn't nearly go far enough for anyone using the
Common Lisp errors.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete-duplicates):
If the form has an incorrect number of arguments, don't attempt a
compiler macroexpansion.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (cl-safe-expr-p):
Forms that start with the symbol lambda are also safe.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (= < > <= >=):
For these functions' compiler macros, the optimisation is safe
even if the first and the last arguments have side effects, since
they're only used the once.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (inline-side-effect-free-compiler-macros):
Unroll a loop here at macro-expansion time, so these compiler
macros are compiled. Use #'eql instead of #'eq in a couple of
places for better style.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (notany, notevery): Avoid some dynamic scope
stupidity with local variable names in these functions, when they
weren't prefixed with cl-; go into some more detail in the doc
strings.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns): #'remove, #'remq are
free of side-effects.
(side-effect-and-error-free-fns):
Drop dot, dot-marker from the list.
2010-11-17 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (coerce):
In the argument list, name the first argument OBJECT, not X; the
former name was always used in the doc string and is clearer.
Handle vector type specifications which include the length of the
target sequence, error if there's a mismatch.
* cl-macs.el (cl-make-type-test): Handle type specifications
starting with the symbol 'eql.
2010-11-14 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (eql): Don't remove the byte-compile property of this
symbol. That was necessary to override a bug in bytecomp.el where
#'eql was confused with #'eq, which bug we no longer have.
If neither expression is constant, don't attempt to handle the
expression in this compiler macro, leave it to byte-compile-eql,
which produces better code anyway.
* bytecomp.el (eq): #'eql is not the function associated with the
byte-eq byte code.
(byte-compile-eql): Add an explicit compile method for this
function, for cases where the cl-macs compiler macro hasn't
reduced it to #'eq or #'equal.
2010-10-25 Aidan Kehoe <kehoea@parhasard.net>
Add compiler macros and compilation sanity-checking for various
functions that take keywords.
* byte-optimize.el (side-effect-free-fns): #'symbol-value is
side-effect free and not error free.
* bytecomp.el (byte-compile-normal-call): Check keyword argument
lists for sanity; store information about the positions where
keyword arguments start using the new byte-compile-keyword-start
property.
* cl-macs.el (cl-const-expr-val): Take a new optional argument,
cl-not-constant, defaulting to nil, in this function; return it if
the expression is not constant.
(cl-non-fixnum-number-p): Make this into a separate function, we
want to pass it to #'every.
(eql): Use it.
(define-star-compiler-macros): Use the same code to generate the
member*, assoc* and rassoc* compiler macros; special-case some
code in #'add-to-list in subr.el.
(remove, remq): Add compiler macros for these two functions, in
preparation for #'remove being in C.
(define-foo-if-compiler-macros): Transform (remove-if-not ...) calls to
(remove ... :if-not) at compile time, which will be a real win
once the latter is in C.
(define-substitute-if-compiler-macros)
(define-subst-if-compiler-macros): Similarly for these functions.
(delete-duplicates): Change this compiler macro to use
#'plists-equal; if we don't have information about the type of
SEQUENCE at compile time, don't bother attempting to inline the
call, the function will be in C soon enough.
(equalp): Remove an old commented-out compiler macro for this, if
we want to see it it's in version control.
(subst-char-in-string): Transform this to a call to nsubstitute or
nsubstitute, if that is appropriate.
* cl.el (ldiff): Don't call setf here, this makes for a load-time
dependency problem in cl-macs.el
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* term/vt100.el:
Refer to XEmacs, not GNU Emacs, in permissions.
* term/bg-mouse.el:
* term/sup-mouse.el:
Put copyright notice in canonical "Copyright DATE AUTHOR" form.
Refer to XEmacs, not GNU Emacs, in permissions.
* site-load.el:
Add permission boilerplate.
* mule/canna-leim.el:
* alist.el:
Refer to XEmacs, not APEL/this program, in permissions.
* mule/canna-leim.el:
Remove my copyright, I've assigned it to the FSF.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* gtk.el:
* gtk-widget-accessors.el:
* gtk-package.el:
* gtk-marshal.el:
* gtk-compose.el:
* gnome.el:
Add copyright notice based on internal evidence.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* easymenu.el: Add reference to COPYING to permission notice.
* gutter.el:
* gutter-items.el:
* menubar-items.el:
Fix typo "Xmacs" in permissions notice.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* auto-save.el:
* font.el:
* fontconfig.el:
* mule/kinsoku.el:
Add "part of XEmacs" text to permission notice.
2010-10-14 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns):
* cl-macs.el (remf, getf):
* cl-extra.el (tailp, cl-set-getf, cl-do-remf):
* cl.el (ldiff, endp):
Tighten up Common Lisp compatibility for #'ldiff, #'endp, #'tailp;
add circularity checking for the first two.
#'cl-set-getf and #'cl-do-remf were Lisp implementations of
#'plist-put and #'plist-remprop; change the names to aliases,
changes the macros that use them to using #'plist-put and
#'plist-remprop directly.
2010-10-12 Aidan Kehoe <kehoea@parhasard.net>
* abbrev.el (fundamental-mode-abbrev-table, global-abbrev-table):
Create both these abbrev tables using the usual
#'define-abbrev-table calls, rather than attempting to
special-case them.
* cl-extra.el: Force cl-macs to be loaded here, if cl-extra.el is
being loaded interpreted. Previously other, later files would
redundantly call (load "cl-macs") when interpreted, it's more
reasonable to do it here, once.
* cmdloop.el (read-quoted-char-radix): Use defcustom here, we
don't have any dump-order dependencies that would prevent that.
* custom.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling, rely on cl-extra.el in the
former case and the appropriate entry in bytecomp-load-hook in the
latter. Get rid of custom-declare-variable-list, we have no
dump-time dependencies that would require it.
* faces.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling.
* packages.el: Remove some inaccurate comments.
* post-gc.el (cleanup-simple-finalizers): Use #'delete-if-not
here, now the order of preloaded-file-list has been changed to
make it available.
* subr.el (custom-declare-variable-list): Remove. No need for it.
Also remove a stub define-abbrev-table from this file, given the
current order of preloaded-file-list there's no need for it.
2010-10-10 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-constp) Forms quoted with FUNCTION are
also constant.
(byte-compile-initial-macro-environment): In #'the, if FORM is
constant and does not match TYPE, warn at byte-compile time.
2010-10-10 Aidan Kehoe <kehoea@parhasard.net>
* backquote.el (bq-vector-contents, bq-list*): Remove; the former
is equivalent to (append VECTOR nil), the latter to (list* ...).
(bq-process-2): Use (append VECTOR nil) instead of using
#'bq-vector-contents to convert to a list.
(bq-process-1): Now we use list* instead of bq-list
* subr.el (list*): Moved from cl.el, since it is now required to
be available the first time a backquoted form is encountered.
* cl.el (list*): Move to subr.el.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* test-harness.el (Check-Message):
Add an omitted comma here, thank you the buildbot.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* hash-table.el (hash-table-key-list, hash-table-value-list)
(hash-table-key-value-alist, hash-table-key-value-plist):
Remove some useless #'nreverse calls in these files; our hash
tables have no order, it's not helpful to pretend they do.
* behavior.el (read-behavior):
Do the same in this file, in some code evidently copied from
hash-table.el.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* info.el (Info-insert-dir):
* format.el (format-deannotate-region):
* files.el (cd, save-buffers-kill-emacs):
Use #'some, #'every and related functions for applying boolean
operations to lists, instead of rolling our own ones that cons and
don't short-circuit.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-initial-macro-environment):
* cl-macs.el (the):
Rephrase the docstring, make its implementation when compiling
files a little nicer.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* descr-text.el (unidata-initialize-unicodedata-database)
(unidata-initialize-unihan-database, describe-char-unicode-data)
(describe-char-unicode-data):
Wrap calls to the database functions with (with-fboundp ...),
avoiding byte compile warnings on builds without support for the
database functions.
(describe-char): (reduce #'max ...), not (apply #'max ...), no
need to cons needlessly.
(describe-char): Remove a redundant lambda wrapping
#'extent-properties.
(describe-char-unicode-data): Call #'nsubst when replacing "" with
nil in the result of #'split-string, instead of consing inside
mapcar.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* x-faces.el (x-available-font-sizes):
* specifier.el (let-specifier):
* package-ui.el (pui-add-required-packages):
* msw-faces.el (mswindows-available-font-sizes):
* modeline.el (modeline-minor-mode-menu):
* minibuf.el (minibuf-directory-files):
Replace the O2N (delq nil (mapcar (lambda (W) (and X Y)) Z)) with
the ON (mapcan (lambda (W) (and X (list Y))) Z) in these files.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (= < > <= >=):
When these functions are handed more than two arguments, and those
arguments have no side effects, transform to a series of two
argument calls, avoiding funcall in the byte-compiled code.
* mule/mule-cmds.el (finish-set-language-environment):
Take advantage of this change in a function called 256 times at
startup.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-function-form, byte-compile-quote)
(byte-compile-quote-form):
Warn at compile time, and error at runtime, if a (quote ...) or a
(function ...) form attempts to quote more than one object.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (byte-optimize-apply): Transform (apply 'nconc
(mapcar ...)) to (mapcan ...); warn about use of the first idiom.
* update-elc.el (do-autoload-commands):
* packages.el (packages-find-package-library-path):
* frame.el (frame-list):
* extents.el (extent-descendants):
* etags.el (buffer-tag-table-files):
* dumped-lisp.el (preloaded-file-list):
* device.el (device-list):
* bytecomp-runtime.el (proclaim-inline, proclaim-notinline)
Use #'mapcan, not (apply #'nconc (mapcar ...) in all these files.
* bytecomp-runtime.el (eval-when-compile, eval-and-compile):
In passing, mention that these macros also evaluate the body when
interpreted.
tests/ChangeLog addition:
2011-02-07 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
Test lexical scope for `block', `return-from'; add a
Known-Bug-Expect-Failure for a contorted example that fails when
byte-compiled.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Mon, 07 Feb 2011 12:01:24 +0000 |
| parents | c096d8051f89 |
| children | 8d29f1c4bb98 |
| rev | line source |
|---|---|
| 428 | 1 /* Generic glyph/image implementation + display tables |
| 4226 | 2 Copyright (C) 1994, 1995 Board of Trustees, University of Illinois |
| 428 | 3 Copyright (C) 1995 Tinker Systems |
| 2959 | 4 Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004, 2005 Ben Wing |
| 428 | 5 Copyright (C) 1995 Sun Microsystems |
| 438 | 6 Copyright (C) 1998, 1999, 2000 Andy Piper |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
7 Copyright (C) 2007, 2010 Didier Verna |
| 428 | 8 |
| 9 This file is part of XEmacs. | |
| 10 | |
| 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 | |
| 13 Free Software Foundation; either version 2, or (at your option) any | |
| 14 later version. | |
| 15 | |
| 16 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 17 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 18 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 19 for more details. | |
| 20 | |
| 21 You should have received a copy of the GNU General Public License | |
| 22 along with XEmacs; see the file COPYING. If not, write to | |
| 23 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 24 Boston, MA 02111-1307, USA. */ | |
| 25 | |
| 26 /* Synched up with: Not in FSF. */ | |
| 27 | |
| 2959 | 28 /* This file mostly written by Ben Wing, with some code by Chuck Thompson. |
| 29 Heavily modified / rewritten by Andy Piper. | |
| 30 | |
| 31 Earliest glyph support, Jamie Zawinski for 19.8? | |
| 32 subwindow support added by Chuck Thompson | |
| 33 additional XPM support added by Chuck Thompson | |
| 34 initial X-Face support added by Stig | |
| 35 Majorly rewritten/restructured by Ben Wing, including creation of | |
| 36 glyph and image-instance objects, for 19.12/19.13 | |
| 37 GIF/JPEG/etc. support originally in this file -- see glyph-eimage.c | |
| 38 Pointer/icon overhaul, more restructuring by Ben Wing for 19.14 | |
| 39 Many changes for color work and optimizations by Jareth Hein for 21.0 | |
| 40 Switch of GIF/JPEG/PNG to new EImage intermediate code by Jareth Hein for 21.0 | |
| 41 TIFF code by Jareth Hein for 21.0 | |
| 42 Generalization for ms-windows by Andy Piper for 21.0 | |
| 43 TODO: | |
| 44 Convert images.el to C and stick it in here? | |
| 45 */ | |
| 428 | 46 |
| 47 #include <config.h> | |
| 48 #include "lisp.h" | |
| 49 | |
| 442 | 50 #include "blocktype.h" |
| 428 | 51 #include "buffer.h" |
| 442 | 52 #include "chartab.h" |
| 872 | 53 #include "device-impl.h" |
| 428 | 54 #include "elhash.h" |
| 55 #include "faces.h" | |
| 872 | 56 #include "frame-impl.h" |
| 442 | 57 #include "glyphs.h" |
| 800 | 58 #include "gui.h" |
| 428 | 59 #include "insdel.h" |
|
5176
8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents:
5013
diff
changeset
|
60 #include "fontcolor-impl.h" |
| 428 | 61 #include "opaque.h" |
| 442 | 62 #include "rangetab.h" |
| 428 | 63 #include "redisplay.h" |
| 442 | 64 #include "specifier.h" |
| 428 | 65 #include "window.h" |
| 66 | |
| 771 | 67 #include "sysfile.h" |
| 68 | |
| 462 | 69 #if defined (HAVE_XPM) && !defined (HAVE_GTK) |
| 428 | 70 #include <X11/xpm.h> |
| 71 #endif | |
| 72 | |
| 73 Lisp_Object Qimage_conversion_error; | |
| 74 | |
| 75 Lisp_Object Qglyphp, Qcontrib_p, Qbaseline; | |
| 76 Lisp_Object Qbuffer_glyph_p, Qpointer_glyph_p, Qicon_glyph_p; | |
| 77 Lisp_Object Qnothing_image_instance_p, Qtext_image_instance_p; | |
| 78 Lisp_Object Qmono_pixmap_image_instance_p; | |
| 79 Lisp_Object Qcolor_pixmap_image_instance_p; | |
| 80 Lisp_Object Qpointer_image_instance_p; | |
| 81 Lisp_Object Qsubwindow_image_instance_p; | |
| 82 Lisp_Object Qwidget_image_instance_p; | |
| 83 Lisp_Object Qconst_glyph_variable; | |
| 84 Lisp_Object Qmono_pixmap, Qcolor_pixmap, Qsubwindow; | |
|
5223
acc4a6c9f5f9
Remove the definition of Q_data from glyphs.c, fixing C++ build.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
85 Lisp_Object Q_file, Q_face, Q_pixel_width, Q_pixel_height; |
| 428 | 86 Lisp_Object Qformatted_string; |
| 87 Lisp_Object Vcurrent_display_table; | |
| 88 Lisp_Object Vtruncation_glyph, Vcontinuation_glyph, Voctal_escape_glyph; | |
| 89 Lisp_Object Vcontrol_arrow_glyph, Vinvisible_text_glyph, Vhscroll_glyph; | |
| 90 Lisp_Object Vxemacs_logo; | |
| 91 Lisp_Object Vthe_nothing_vector; | |
| 92 Lisp_Object Vimage_instantiator_format_list; | |
| 93 Lisp_Object Vimage_instance_type_list; | |
| 94 Lisp_Object Vglyph_type_list; | |
| 95 | |
| 96 int disable_animated_pixmaps; | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
97 static Lisp_Object Vimage_instance_hash_table_test; |
| 428 | 98 |
| 99 DEFINE_IMAGE_INSTANTIATOR_FORMAT (nothing); | |
| 100 DEFINE_IMAGE_INSTANTIATOR_FORMAT (inherit); | |
| 101 DEFINE_IMAGE_INSTANTIATOR_FORMAT (string); | |
| 102 DEFINE_IMAGE_INSTANTIATOR_FORMAT (formatted_string); | |
| 103 DEFINE_IMAGE_INSTANTIATOR_FORMAT (subwindow); | |
| 104 DEFINE_IMAGE_INSTANTIATOR_FORMAT (text); | |
| 442 | 105 DEFINE_IMAGE_INSTANTIATOR_FORMAT (pointer); |
| 428 | 106 |
| 107 #ifdef HAVE_WINDOW_SYSTEM | |
| 108 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xbm); | |
| 109 Lisp_Object Qxbm; | |
| 110 | |
| 111 Lisp_Object Q_mask_file, Q_mask_data, Q_hotspot_x, Q_hotspot_y; | |
| 112 Lisp_Object Q_foreground, Q_background; | |
| 113 #ifndef BitmapSuccess | |
| 114 #define BitmapSuccess 0 | |
| 115 #define BitmapOpenFailed 1 | |
| 116 #define BitmapFileInvalid 2 | |
| 117 #define BitmapNoMemory 3 | |
| 118 #endif | |
| 119 #endif | |
| 120 | |
| 121 #ifdef HAVE_XFACE | |
| 122 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xface); | |
| 123 Lisp_Object Qxface; | |
| 124 #endif | |
| 125 | |
| 126 #ifdef HAVE_XPM | |
| 127 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xpm); | |
| 128 Lisp_Object Qxpm; | |
| 129 Lisp_Object Q_color_symbols; | |
| 130 #endif | |
| 131 | |
| 132 typedef struct image_instantiator_format_entry image_instantiator_format_entry; | |
| 133 struct image_instantiator_format_entry | |
| 134 { | |
| 135 Lisp_Object symbol; | |
| 136 Lisp_Object device; | |
| 137 struct image_instantiator_methods *meths; | |
| 138 }; | |
| 139 | |
| 140 typedef struct | |
| 141 { | |
| 142 Dynarr_declare (struct image_instantiator_format_entry); | |
| 143 } image_instantiator_format_entry_dynarr; | |
| 144 | |
| 442 | 145 /* This contains one entry per format, per device it's defined on. */ |
| 428 | 146 image_instantiator_format_entry_dynarr * |
| 147 the_image_instantiator_format_entry_dynarr; | |
| 148 | |
| 442 | 149 static Lisp_Object allocate_image_instance (Lisp_Object governing_domain, |
| 150 Lisp_Object parent, | |
| 151 Lisp_Object instantiator); | |
| 428 | 152 static void image_validate (Lisp_Object instantiator); |
| 153 static void glyph_property_was_changed (Lisp_Object glyph, | |
| 154 Lisp_Object property, | |
| 155 Lisp_Object locale); | |
| 442 | 156 static void set_image_instance_dirty_p (Lisp_Object instance, int dirty); |
| 428 | 157 static void register_ignored_expose (struct frame* f, int x, int y, int width, int height); |
| 442 | 158 static void cache_subwindow_instance_in_frame_maybe (Lisp_Object instance); |
| 159 static void update_image_instance (Lisp_Object image_instance, | |
| 160 Lisp_Object instantiator); | |
| 428 | 161 /* Unfortunately windows and X are different. In windows BeginPaint() |
| 162 will prevent WM_PAINT messages being generated so it is unnecessary | |
| 163 to register exposures as they will not occur. Under X they will | |
| 164 always occur. */ | |
| 165 int hold_ignored_expose_registration; | |
| 166 | |
| 167 EXFUN (Fimage_instance_type, 1); | |
| 168 EXFUN (Fglyph_type, 1); | |
| 442 | 169 EXFUN (Fnext_window, 4); |
| 428 | 170 |
| 171 | |
| 172 /**************************************************************************** | |
| 173 * Image Instantiators * | |
| 174 ****************************************************************************/ | |
| 175 | |
| 176 struct image_instantiator_methods * | |
| 177 decode_device_ii_format (Lisp_Object device, Lisp_Object format, | |
| 578 | 178 Error_Behavior errb) |
| 428 | 179 { |
| 180 int i; | |
| 181 | |
| 182 if (!SYMBOLP (format)) | |
| 183 { | |
| 184 if (ERRB_EQ (errb, ERROR_ME)) | |
| 185 CHECK_SYMBOL (format); | |
| 186 return 0; | |
| 187 } | |
| 188 | |
| 189 for (i = 0; i < Dynarr_length (the_image_instantiator_format_entry_dynarr); | |
| 190 i++) | |
| 191 { | |
| 192 if ( EQ (format, | |
| 193 Dynarr_at (the_image_instantiator_format_entry_dynarr, i). | |
| 194 symbol) ) | |
| 195 { | |
| 196 Lisp_Object d = Dynarr_at (the_image_instantiator_format_entry_dynarr, i). | |
| 197 device; | |
| 198 if ((NILP (d) && NILP (device)) | |
| 199 || | |
| 200 (!NILP (device) && | |
| 440 | 201 EQ (CONSOLE_TYPE (XCONSOLE |
| 428 | 202 (DEVICE_CONSOLE (XDEVICE (device)))), d))) |
| 203 return Dynarr_at (the_image_instantiator_format_entry_dynarr, i).meths; | |
| 204 } | |
| 205 } | |
| 206 | |
| 563 | 207 maybe_invalid_argument ("Invalid image-instantiator format", format, |
| 872 | 208 Qimage, errb); |
| 428 | 209 |
| 210 return 0; | |
| 211 } | |
| 212 | |
| 213 struct image_instantiator_methods * | |
| 578 | 214 decode_image_instantiator_format (Lisp_Object format, Error_Behavior errb) |
| 428 | 215 { |
| 216 return decode_device_ii_format (Qnil, format, errb); | |
| 217 } | |
| 218 | |
| 219 static int | |
| 220 valid_image_instantiator_format_p (Lisp_Object format, Lisp_Object locale) | |
| 221 { | |
| 222 int i; | |
| 223 struct image_instantiator_methods* meths = | |
| 224 decode_image_instantiator_format (format, ERROR_ME_NOT); | |
| 225 Lisp_Object contype = Qnil; | |
| 226 /* mess with the locale */ | |
| 227 if (!NILP (locale) && SYMBOLP (locale)) | |
| 228 contype = locale; | |
| 229 else | |
| 230 { | |
| 231 struct console* console = decode_console (locale); | |
| 232 contype = console ? CONSOLE_TYPE (console) : locale; | |
| 233 } | |
| 234 /* nothing is valid in all locales */ | |
| 235 if (EQ (format, Qnothing)) | |
| 236 return 1; | |
| 237 /* reject unknown formats */ | |
| 238 else if (NILP (contype) || !meths) | |
| 239 return 0; | |
| 240 | |
| 241 for (i = 0; i < Dynarr_length (meths->consoles); i++) | |
| 242 if (EQ (contype, Dynarr_at (meths->consoles, i).symbol)) | |
| 243 return 1; | |
| 244 return 0; | |
| 245 } | |
| 246 | |
| 247 DEFUN ("valid-image-instantiator-format-p", Fvalid_image_instantiator_format_p, | |
| 248 1, 2, 0, /* | |
| 249 Given an IMAGE-INSTANTIATOR-FORMAT, return non-nil if it is valid. | |
| 444 | 250 If LOCALE is non-nil then the format is checked in that locale. |
| 428 | 251 If LOCALE is nil the current console is used. |
| 442 | 252 |
| 2959 | 253 Valid formats are some subset of `nothing', `string', `formatted-string', |
| 254 `xpm', `xbm', `xface', `gif', `jpeg', `png', `tiff', `cursor-font', `font', | |
| 255 `autodetect', `subwindow', `inherit', `mswindows-resource', `bmp', | |
| 256 `native-layout', `layout', `label', `tab-control', `tree-view', | |
| 257 `progress-gauge', `scrollbar', `combo-box', `edit-field', `button', | |
| 258 `widget', `pointer', and `text', depending on how XEmacs was compiled. | |
| 428 | 259 */ |
| 260 (image_instantiator_format, locale)) | |
| 261 { | |
| 442 | 262 return valid_image_instantiator_format_p (image_instantiator_format, |
| 263 locale) ? | |
| 428 | 264 Qt : Qnil; |
| 265 } | |
| 266 | |
| 267 DEFUN ("image-instantiator-format-list", Fimage_instantiator_format_list, | |
| 268 0, 0, 0, /* | |
| 269 Return a list of valid image-instantiator formats. | |
| 270 */ | |
| 271 ()) | |
| 272 { | |
| 273 return Fcopy_sequence (Vimage_instantiator_format_list); | |
| 274 } | |
| 275 | |
| 276 void | |
| 277 add_entry_to_device_ii_format_list (Lisp_Object device, Lisp_Object symbol, | |
| 278 struct image_instantiator_methods *meths) | |
| 279 { | |
| 280 struct image_instantiator_format_entry entry; | |
| 281 | |
| 282 entry.symbol = symbol; | |
| 283 entry.device = device; | |
| 284 entry.meths = meths; | |
| 285 Dynarr_add (the_image_instantiator_format_entry_dynarr, entry); | |
| 442 | 286 if (NILP (memq_no_quit (symbol, Vimage_instantiator_format_list))) |
| 287 Vimage_instantiator_format_list = | |
| 288 Fcons (symbol, Vimage_instantiator_format_list); | |
| 428 | 289 } |
| 290 | |
| 291 void | |
| 292 add_entry_to_image_instantiator_format_list (Lisp_Object symbol, | |
| 293 struct | |
| 294 image_instantiator_methods *meths) | |
| 295 { | |
| 296 add_entry_to_device_ii_format_list (Qnil, symbol, meths); | |
| 297 } | |
| 298 | |
| 299 static Lisp_Object * | |
| 300 get_image_conversion_list (Lisp_Object console_type) | |
| 301 { | |
| 302 return &decode_console_type (console_type, ERROR_ME)->image_conversion_list; | |
| 303 } | |
| 304 | |
| 305 DEFUN ("set-console-type-image-conversion-list", Fset_console_type_image_conversion_list, | |
| 306 2, 2, 0, /* | |
| 444 | 307 Set the image-conversion-list for consoles of the given CONSOLE-TYPE. |
| 428 | 308 The image-conversion-list specifies how image instantiators that |
| 309 are strings should be interpreted. Each element of the list should be | |
| 310 a list of two elements (a regular expression string and a vector) or | |
| 311 a list of three elements (the preceding two plus an integer index into | |
| 312 the vector). The string is converted to the vector associated with the | |
| 313 first matching regular expression. If a vector index is specified, the | |
| 314 string itself is substituted into that position in the vector. | |
| 315 | |
| 316 Note: The conversion above is applied when the image instantiator is | |
| 317 added to an image specifier, not when the specifier is actually | |
| 318 instantiated. Therefore, changing the image-conversion-list only affects | |
| 319 newly-added instantiators. Existing instantiators in glyphs and image | |
| 320 specifiers will not be affected. | |
| 321 */ | |
| 322 (console_type, list)) | |
| 323 { | |
| 324 Lisp_Object *imlist = get_image_conversion_list (console_type); | |
| 325 | |
| 326 /* Check the list to make sure that it only has valid entries. */ | |
| 327 | |
| 2367 | 328 EXTERNAL_LIST_LOOP_2 (mapping, list) |
| 428 | 329 { |
| 330 /* Mapping form should be (STRING VECTOR) or (STRING VECTOR INTEGER) */ | |
| 331 if (!CONSP (mapping) || | |
| 332 !CONSP (XCDR (mapping)) || | |
| 333 (!NILP (XCDR (XCDR (mapping))) && | |
| 334 (!CONSP (XCDR (XCDR (mapping))) || | |
| 335 !NILP (XCDR (XCDR (XCDR (mapping))))))) | |
| 563 | 336 invalid_argument ("Invalid mapping form", mapping); |
| 428 | 337 else |
| 338 { | |
| 1885 | 339 Lisp_Object regexp = XCAR (mapping); |
| 428 | 340 Lisp_Object typevec = XCAR (XCDR (mapping)); |
| 341 Lisp_Object pos = Qnil; | |
| 342 Lisp_Object newvec; | |
| 343 struct gcpro gcpro1; | |
| 344 | |
| 1885 | 345 CHECK_STRING (regexp); |
| 428 | 346 CHECK_VECTOR (typevec); |
| 347 if (!NILP (XCDR (XCDR (mapping)))) | |
| 348 { | |
| 349 pos = XCAR (XCDR (XCDR (mapping))); | |
| 350 CHECK_INT (pos); | |
| 351 if (XINT (pos) < 0 || | |
| 352 XINT (pos) >= XVECTOR_LENGTH (typevec)) | |
| 353 args_out_of_range_3 | |
| 354 (pos, Qzero, make_int (XVECTOR_LENGTH (typevec) - 1)); | |
| 355 } | |
| 356 | |
| 357 newvec = Fcopy_sequence (typevec); | |
| 358 if (INTP (pos)) | |
| 1885 | 359 XVECTOR_DATA (newvec)[XINT (pos)] = regexp; |
| 428 | 360 GCPRO1 (newvec); |
| 361 image_validate (newvec); | |
| 362 UNGCPRO; | |
| 363 } | |
| 364 } | |
| 365 | |
| 366 *imlist = Fcopy_tree (list, Qt); | |
| 367 return list; | |
| 368 } | |
| 369 | |
| 370 DEFUN ("console-type-image-conversion-list", Fconsole_type_image_conversion_list, | |
| 371 1, 1, 0, /* | |
| 444 | 372 Return the image-conversion-list for devices of the given CONSOLE-TYPE. |
| 428 | 373 The image-conversion-list specifies how to interpret image string |
| 374 instantiators for the specified console type. See | |
| 375 `set-console-type-image-conversion-list' for a description of its syntax. | |
| 376 */ | |
| 377 (console_type)) | |
| 378 { | |
| 379 return Fcopy_tree (*get_image_conversion_list (console_type), Qt); | |
| 380 } | |
| 381 | |
| 382 /* Process a string instantiator according to the image-conversion-list for | |
| 383 CONSOLE_TYPE. Returns a vector. */ | |
| 384 | |
| 385 static Lisp_Object | |
| 386 process_image_string_instantiator (Lisp_Object data, | |
| 387 Lisp_Object console_type, | |
| 388 int dest_mask) | |
| 389 { | |
| 390 Lisp_Object tail; | |
| 391 | |
| 392 LIST_LOOP (tail, *get_image_conversion_list (console_type)) | |
| 393 { | |
| 394 Lisp_Object mapping = XCAR (tail); | |
| 1885 | 395 Lisp_Object regexp = XCAR (mapping); |
| 428 | 396 Lisp_Object typevec = XCAR (XCDR (mapping)); |
| 397 | |
| 398 /* if the result is of a type that can't be instantiated | |
| 399 (e.g. a string when we're dealing with a pointer glyph), | |
| 400 skip it. */ | |
| 401 if (!(dest_mask & | |
| 402 IIFORMAT_METH (decode_image_instantiator_format | |
| 450 | 403 (INSTANTIATOR_TYPE (typevec), ERROR_ME), |
| 428 | 404 possible_dest_types, ()))) |
| 405 continue; | |
| 1885 | 406 if (fast_string_match (regexp, 0, data, 0, -1, 0, ERROR_ME, 0) >= 0) |
| 428 | 407 { |
| 408 if (!NILP (XCDR (XCDR (mapping)))) | |
| 409 { | |
| 410 int pos = XINT (XCAR (XCDR (XCDR (mapping)))); | |
| 411 Lisp_Object newvec = Fcopy_sequence (typevec); | |
| 412 XVECTOR_DATA (newvec)[pos] = data; | |
| 413 return newvec; | |
| 414 } | |
| 415 else | |
| 416 return typevec; | |
| 417 } | |
| 418 } | |
| 419 | |
| 420 /* Oh well. */ | |
| 563 | 421 invalid_argument ("Unable to interpret glyph instantiator", |
| 428 | 422 data); |
| 423 | |
| 1204 | 424 RETURN_NOT_REACHED (Qnil); |
| 428 | 425 } |
| 426 | |
| 427 Lisp_Object | |
| 428 find_keyword_in_vector_or_given (Lisp_Object vector, Lisp_Object keyword, | |
| 429 Lisp_Object default_) | |
| 430 { | |
| 431 Lisp_Object *elt; | |
| 432 int instantiator_len; | |
| 433 | |
| 434 elt = XVECTOR_DATA (vector); | |
| 435 instantiator_len = XVECTOR_LENGTH (vector); | |
| 436 | |
| 437 elt++; | |
| 438 instantiator_len--; | |
| 439 | |
| 440 while (instantiator_len > 0) | |
| 441 { | |
| 442 if (EQ (elt[0], keyword)) | |
| 443 return elt[1]; | |
| 444 elt += 2; | |
| 445 instantiator_len -= 2; | |
| 446 } | |
| 447 | |
| 448 return default_; | |
| 449 } | |
| 450 | |
| 451 Lisp_Object | |
| 452 find_keyword_in_vector (Lisp_Object vector, Lisp_Object keyword) | |
| 453 { | |
| 454 return find_keyword_in_vector_or_given (vector, keyword, Qnil); | |
| 455 } | |
| 456 | |
| 442 | 457 static Lisp_Object |
| 2959 | 458 find_instantiator_differences (Lisp_Object new_, Lisp_Object old) |
| 442 | 459 { |
| 460 Lisp_Object alist = Qnil; | |
| 2959 | 461 Lisp_Object *elt = XVECTOR_DATA (new_); |
| 442 | 462 Lisp_Object *old_elt = XVECTOR_DATA (old); |
| 2959 | 463 int len = XVECTOR_LENGTH (new_); |
| 442 | 464 struct gcpro gcpro1; |
| 465 | |
| 466 /* If the vector length has changed then consider everything | |
| 467 changed. We could try and figure out what properties have | |
| 468 disappeared or been added, but this code is only used as an | |
| 469 optimization anyway so lets not bother. */ | |
| 470 if (len != XVECTOR_LENGTH (old)) | |
| 2959 | 471 return new_; |
| 442 | 472 |
| 473 GCPRO1 (alist); | |
| 474 | |
| 475 for (len -= 2; len >= 1; len -= 2) | |
| 476 { | |
| 477 /* Keyword comparisons can be done with eq, the value must be | |
| 4252 | 478 done with equal. |
| 479 #### Note that this does not optimize re-ordering. */ | |
| 442 | 480 if (!EQ (elt[len], old_elt[len]) |
| 481 || !internal_equal (elt[len+1], old_elt[len+1], 0)) | |
| 482 alist = Fcons (Fcons (elt[len], elt[len+1]), alist); | |
| 483 } | |
| 484 | |
| 485 { | |
| 486 Lisp_Object result = alist_to_tagged_vector (elt[0], alist); | |
| 487 free_alist (alist); | |
| 488 RETURN_UNGCPRO (result); | |
| 489 } | |
| 490 } | |
| 491 | |
| 492 DEFUN ("set-instantiator-property", Fset_instantiator_property, | |
| 493 3, 3, 0, /* | |
| 444 | 494 Destructively set the property KEYWORD of INSTANTIATOR to VALUE. |
| 442 | 495 If the property is not set then it is added to a copy of the |
| 496 instantiator and the new instantiator returned. | |
| 497 Use `set-glyph-image' on glyphs to register instantiator changes. */ | |
| 444 | 498 (instantiator, keyword, value)) |
| 442 | 499 { |
| 500 Lisp_Object *elt; | |
| 501 int len; | |
| 502 | |
| 503 CHECK_VECTOR (instantiator); | |
| 504 if (!KEYWORDP (keyword)) | |
| 563 | 505 invalid_argument ("instantiator property must be a keyword", keyword); |
| 442 | 506 |
| 507 elt = XVECTOR_DATA (instantiator); | |
| 508 len = XVECTOR_LENGTH (instantiator); | |
| 509 | |
| 510 for (len -= 2; len >= 1; len -= 2) | |
| 511 { | |
| 512 if (EQ (elt[len], keyword)) | |
| 513 { | |
| 444 | 514 elt[len+1] = value; |
| 442 | 515 break; |
| 516 } | |
| 517 } | |
| 518 | |
| 519 /* Didn't find it so add it. */ | |
| 520 if (len < 1) | |
| 521 { | |
| 522 Lisp_Object alist = Qnil, result; | |
| 523 struct gcpro gcpro1; | |
| 524 | |
| 525 GCPRO1 (alist); | |
| 526 alist = tagged_vector_to_alist (instantiator); | |
| 444 | 527 alist = Fcons (Fcons (keyword, value), alist); |
| 442 | 528 result = alist_to_tagged_vector (elt[0], alist); |
| 529 free_alist (alist); | |
| 530 RETURN_UNGCPRO (result); | |
| 531 } | |
| 532 | |
| 533 return instantiator; | |
| 534 } | |
| 535 | |
| 428 | 536 void |
| 537 check_valid_string (Lisp_Object data) | |
| 538 { | |
| 539 CHECK_STRING (data); | |
| 540 } | |
| 541 | |
| 542 void | |
| 543 check_valid_vector (Lisp_Object data) | |
| 544 { | |
| 545 CHECK_VECTOR (data); | |
| 546 } | |
| 547 | |
| 548 void | |
| 549 check_valid_face (Lisp_Object data) | |
| 550 { | |
| 551 Fget_face (data); | |
| 552 } | |
| 553 | |
| 554 void | |
| 555 check_valid_int (Lisp_Object data) | |
| 556 { | |
| 557 CHECK_INT (data); | |
| 558 } | |
| 559 | |
| 560 void | |
| 561 file_or_data_must_be_present (Lisp_Object instantiator) | |
| 562 { | |
| 563 if (NILP (find_keyword_in_vector (instantiator, Q_file)) && | |
| 564 NILP (find_keyword_in_vector (instantiator, Q_data))) | |
| 563 | 565 sferror ("Must supply either :file or :data", |
| 428 | 566 instantiator); |
| 567 } | |
| 568 | |
| 569 void | |
| 570 data_must_be_present (Lisp_Object instantiator) | |
| 571 { | |
| 572 if (NILP (find_keyword_in_vector (instantiator, Q_data))) | |
| 563 | 573 sferror ("Must supply :data", instantiator); |
| 428 | 574 } |
| 575 | |
| 576 static void | |
| 577 face_must_be_present (Lisp_Object instantiator) | |
| 578 { | |
| 579 if (NILP (find_keyword_in_vector (instantiator, Q_face))) | |
| 563 | 580 sferror ("Must supply :face", instantiator); |
| 428 | 581 } |
| 582 | |
| 583 /* utility function useful in retrieving data from a file. */ | |
| 584 | |
| 585 Lisp_Object | |
| 586 make_string_from_file (Lisp_Object file) | |
| 587 { | |
| 588 /* This function can call lisp */ | |
| 589 int count = specpdl_depth (); | |
| 590 Lisp_Object temp_buffer; | |
| 591 struct gcpro gcpro1; | |
| 592 Lisp_Object data; | |
| 593 | |
| 594 specbind (Qinhibit_quit, Qt); | |
| 595 record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
596 temp_buffer = Fget_buffer_create (build_ascstring (" *pixmap conversion*")); |
| 428 | 597 GCPRO1 (temp_buffer); |
| 598 set_buffer_internal (XBUFFER (temp_buffer)); | |
| 599 Ferase_buffer (Qnil); | |
| 600 specbind (intern ("format-alist"), Qnil); | |
| 601 Finsert_file_contents_internal (file, Qnil, Qnil, Qnil, Qnil, Qnil, Qnil); | |
| 602 data = Fbuffer_substring (Qnil, Qnil, Qnil); | |
| 771 | 603 unbind_to (count); |
| 428 | 604 UNGCPRO; |
| 605 return data; | |
| 606 } | |
| 607 | |
| 608 /* The following two functions are provided to make it easier for | |
| 609 the normalize methods to work with keyword-value vectors. | |
| 610 Hash tables are kind of heavyweight for this purpose. | |
| 611 (If vectors were resizable, we could avoid this problem; | |
| 612 but they're not.) An alternative approach that might be | |
| 613 more efficient but require more work is to use a type of | |
| 614 assoc-Dynarr and provide primitives for deleting elements out | |
| 615 of it. (However, you'd also have to add an unwind-protect | |
| 616 to make sure the Dynarr got freed in case of an error in | |
| 617 the normalization process.) */ | |
| 618 | |
| 619 Lisp_Object | |
| 620 tagged_vector_to_alist (Lisp_Object vector) | |
| 621 { | |
| 622 Lisp_Object *elt = XVECTOR_DATA (vector); | |
| 623 int len = XVECTOR_LENGTH (vector); | |
| 624 Lisp_Object result = Qnil; | |
| 625 | |
| 626 assert (len & 1); | |
| 627 for (len -= 2; len >= 1; len -= 2) | |
| 628 result = Fcons (Fcons (elt[len], elt[len+1]), result); | |
| 629 | |
| 630 return result; | |
| 631 } | |
| 632 | |
| 633 Lisp_Object | |
| 634 alist_to_tagged_vector (Lisp_Object tag, Lisp_Object alist) | |
| 635 { | |
| 636 int len = 1 + 2 * XINT (Flength (alist)); | |
| 637 Lisp_Object *elt = alloca_array (Lisp_Object, len); | |
| 638 int i; | |
| 639 Lisp_Object rest; | |
| 640 | |
| 641 i = 0; | |
| 642 elt[i++] = tag; | |
| 643 LIST_LOOP (rest, alist) | |
| 644 { | |
| 645 Lisp_Object pair = XCAR (rest); | |
| 646 elt[i] = XCAR (pair); | |
| 647 elt[i+1] = XCDR (pair); | |
| 648 i += 2; | |
| 649 } | |
| 650 | |
| 651 return Fvector (len, elt); | |
| 652 } | |
| 653 | |
| 442 | 654 #ifdef ERROR_CHECK_GLYPHS |
| 655 static int | |
| 2286 | 656 check_instance_cache_mapper (Lisp_Object UNUSED (key), Lisp_Object value, |
| 442 | 657 void *flag_closure) |
| 658 { | |
| 659 /* This function can GC */ | |
| 660 /* value can be nil; we cache failures as well as successes */ | |
| 661 if (!NILP (value)) | |
| 662 { | |
| 663 Lisp_Object window; | |
| 5013 | 664 window = GET_LISP_FROM_VOID (flag_closure); |
| 442 | 665 assert (EQ (XIMAGE_INSTANCE_DOMAIN (value), window)); |
| 666 } | |
| 667 | |
| 668 return 0; | |
| 669 } | |
| 670 | |
| 671 void | |
| 672 check_window_subwindow_cache (struct window* w) | |
| 673 { | |
| 793 | 674 Lisp_Object window = wrap_window (w); |
| 675 | |
| 442 | 676 |
| 677 assert (!NILP (w->subwindow_instance_cache)); | |
| 678 elisp_maphash (check_instance_cache_mapper, | |
| 679 w->subwindow_instance_cache, | |
| 5013 | 680 STORE_LISP_IN_VOID (window)); |
| 442 | 681 } |
| 682 | |
| 683 void | |
| 684 check_image_instance_structure (Lisp_Object instance) | |
| 685 { | |
| 686 /* Weird nothing images exist at startup when the console is | |
| 687 deleted. */ | |
| 688 if (!NOTHING_IMAGE_INSTANCEP (instance)) | |
| 689 { | |
| 690 assert (DOMAIN_LIVE_P (instance)); | |
| 691 assert (VECTORP (XIMAGE_INSTANCE_INSTANTIATOR (instance))); | |
| 692 } | |
| 693 if (WINDOWP (XIMAGE_INSTANCE_DOMAIN (instance))) | |
| 694 check_window_subwindow_cache | |
| 695 (XWINDOW (XIMAGE_INSTANCE_DOMAIN (instance))); | |
| 696 } | |
| 697 #endif | |
| 698 | |
| 699 /* Determine what kind of domain governs the image instance. | |
| 700 Verify that the given domain is at least as specific, and extract | |
| 701 the governing domain from it. */ | |
| 428 | 702 static Lisp_Object |
| 442 | 703 get_image_instantiator_governing_domain (Lisp_Object instantiator, |
| 704 Lisp_Object domain) | |
| 705 { | |
| 706 int governing_domain; | |
| 707 | |
| 708 struct image_instantiator_methods *meths = | |
| 450 | 709 decode_image_instantiator_format (INSTANTIATOR_TYPE (instantiator), |
| 442 | 710 ERROR_ME); |
| 711 governing_domain = IIFORMAT_METH_OR_GIVEN (meths, governing_domain, (), | |
| 712 GOVERNING_DOMAIN_DEVICE); | |
| 713 | |
| 714 if (governing_domain == GOVERNING_DOMAIN_WINDOW | |
| 715 && NILP (DOMAIN_WINDOW (domain))) | |
| 563 | 716 invalid_argument_2 |
| 717 ("Domain for this instantiator must be resolvable to a window", | |
| 718 instantiator, domain); | |
| 442 | 719 else if (governing_domain == GOVERNING_DOMAIN_FRAME |
| 720 && NILP (DOMAIN_FRAME (domain))) | |
| 563 | 721 invalid_argument_2 |
| 442 | 722 ("Domain for this instantiator must be resolvable to a frame", |
| 723 instantiator, domain); | |
| 724 | |
| 725 if (governing_domain == GOVERNING_DOMAIN_WINDOW) | |
| 726 domain = DOMAIN_WINDOW (domain); | |
| 727 else if (governing_domain == GOVERNING_DOMAIN_FRAME) | |
| 728 domain = DOMAIN_FRAME (domain); | |
| 729 else if (governing_domain == GOVERNING_DOMAIN_DEVICE) | |
| 730 domain = DOMAIN_DEVICE (domain); | |
| 731 else | |
| 2500 | 732 ABORT (); |
| 442 | 733 |
| 734 return domain; | |
| 735 } | |
| 736 | |
| 737 Lisp_Object | |
| 428 | 738 normalize_image_instantiator (Lisp_Object instantiator, |
| 739 Lisp_Object contype, | |
| 740 Lisp_Object dest_mask) | |
| 741 { | |
| 742 if (IMAGE_INSTANCEP (instantiator)) | |
| 743 return instantiator; | |
| 744 | |
| 745 if (STRINGP (instantiator)) | |
| 746 instantiator = process_image_string_instantiator (instantiator, contype, | |
| 747 XINT (dest_mask)); | |
| 442 | 748 /* Subsequent validation will pick this up. */ |
| 749 if (!VECTORP (instantiator)) | |
| 750 return instantiator; | |
| 428 | 751 /* We have to always store the actual pixmap data and not the |
| 752 filename even though this is a potential memory pig. We have to | |
| 753 do this because it is quite possible that we will need to | |
| 754 instantiate a new instance of the pixmap and the file will no | |
| 755 longer exist (e.g. w3 pixmaps are almost always from temporary | |
| 756 files). */ | |
| 757 { | |
| 758 struct gcpro gcpro1; | |
| 759 struct image_instantiator_methods *meths; | |
| 760 | |
| 761 GCPRO1 (instantiator); | |
| 440 | 762 |
| 450 | 763 meths = decode_image_instantiator_format (INSTANTIATOR_TYPE (instantiator), |
| 428 | 764 ERROR_ME); |
| 765 RETURN_UNGCPRO (IIFORMAT_METH_OR_GIVEN (meths, normalize, | |
| 442 | 766 (instantiator, contype, dest_mask), |
| 428 | 767 instantiator)); |
| 768 } | |
| 769 } | |
| 770 | |
| 771 static Lisp_Object | |
| 442 | 772 instantiate_image_instantiator (Lisp_Object governing_domain, |
| 773 Lisp_Object domain, | |
| 428 | 774 Lisp_Object instantiator, |
| 775 Lisp_Object pointer_fg, Lisp_Object pointer_bg, | |
| 438 | 776 int dest_mask, Lisp_Object glyph) |
| 428 | 777 { |
| 442 | 778 Lisp_Object ii = allocate_image_instance (governing_domain, |
| 779 IMAGE_INSTANCEP (domain) ? | |
| 780 domain : glyph, instantiator); | |
| 781 Lisp_Image_Instance* p = XIMAGE_INSTANCE (ii); | |
| 782 struct image_instantiator_methods *meths, *device_meths; | |
| 428 | 783 struct gcpro gcpro1; |
| 784 | |
| 785 GCPRO1 (ii); | |
| 450 | 786 if (!valid_image_instantiator_format_p (INSTANTIATOR_TYPE (instantiator), |
| 442 | 787 DOMAIN_DEVICE (governing_domain))) |
| 563 | 788 invalid_argument |
| 428 | 789 ("Image instantiator format is invalid in this locale.", |
| 790 instantiator); | |
| 791 | |
| 450 | 792 meths = decode_image_instantiator_format (INSTANTIATOR_TYPE (instantiator), |
| 428 | 793 ERROR_ME); |
| 794 MAYBE_IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg, | |
| 795 pointer_bg, dest_mask, domain)); | |
| 440 | 796 |
| 442 | 797 /* Now do device specific instantiation. */ |
| 798 device_meths = decode_device_ii_format (DOMAIN_DEVICE (governing_domain), | |
| 450 | 799 INSTANTIATOR_TYPE (instantiator), |
| 442 | 800 ERROR_ME_NOT); |
| 801 | |
| 802 if (!HAS_IIFORMAT_METH_P (meths, instantiate) | |
| 803 && (!device_meths || !HAS_IIFORMAT_METH_P (device_meths, instantiate))) | |
| 563 | 804 invalid_argument |
| 428 | 805 ("Don't know how to instantiate this image instantiator?", |
| 806 instantiator); | |
| 442 | 807 |
| 808 /* In general native window system methods will require sane | |
| 809 geometry values, thus the instance needs to have been laid-out | |
| 810 before they get called. */ | |
| 811 image_instance_layout (ii, XIMAGE_INSTANCE_WIDTH (ii), | |
| 812 XIMAGE_INSTANCE_HEIGHT (ii), | |
| 813 IMAGE_UNCHANGED_GEOMETRY, | |
| 814 IMAGE_UNCHANGED_GEOMETRY, domain); | |
| 815 | |
| 816 MAYBE_IIFORMAT_METH (device_meths, instantiate, (ii, instantiator, pointer_fg, | |
| 817 pointer_bg, dest_mask, domain)); | |
| 818 /* Do post instantiation. */ | |
| 819 MAYBE_IIFORMAT_METH (meths, post_instantiate, (ii, instantiator, domain)); | |
| 820 MAYBE_IIFORMAT_METH (device_meths, post_instantiate, (ii, instantiator, domain)); | |
| 821 | |
| 822 /* We're done. */ | |
| 823 IMAGE_INSTANCE_INITIALIZED (p) = 1; | |
| 824 /* Now that we're done verify that we really are laid out. */ | |
| 825 if (IMAGE_INSTANCE_LAYOUT_CHANGED (p)) | |
| 826 image_instance_layout (ii, XIMAGE_INSTANCE_WIDTH (ii), | |
| 827 XIMAGE_INSTANCE_HEIGHT (ii), | |
| 828 IMAGE_UNCHANGED_GEOMETRY, | |
| 829 IMAGE_UNCHANGED_GEOMETRY, domain); | |
| 830 | |
| 831 /* We *must* have a clean image at this point. */ | |
| 832 IMAGE_INSTANCE_TEXT_CHANGED (p) = 0; | |
| 833 IMAGE_INSTANCE_SIZE_CHANGED (p) = 0; | |
| 834 IMAGE_INSTANCE_LAYOUT_CHANGED (p) = 0; | |
| 835 IMAGE_INSTANCE_DIRTYP (p) = 0; | |
| 836 | |
| 837 assert ( XIMAGE_INSTANCE_HEIGHT (ii) >= 0 | |
| 838 && XIMAGE_INSTANCE_WIDTH (ii) >= 0 ); | |
| 839 | |
| 840 ERROR_CHECK_IMAGE_INSTANCE (ii); | |
| 841 | |
| 842 RETURN_UNGCPRO (ii); | |
| 428 | 843 } |
| 844 | |
| 845 | |
| 846 /**************************************************************************** | |
| 847 * Image-Instance Object * | |
| 848 ****************************************************************************/ | |
| 849 | |
| 850 Lisp_Object Qimage_instancep; | |
| 851 | |
| 1204 | 852 /* %%#### KKCC: Don't yet handle the equivalent of setting the device field |
| 853 of image instances w/dead devices to nil. */ | |
| 854 | |
| 855 static const struct memory_description text_image_instance_description_1 [] = { | |
| 856 { XD_LISP_OBJECT, offsetof (struct text_image_instance, string) }, | |
| 857 { XD_END } | |
| 858 }; | |
| 859 | |
| 860 static const struct sized_memory_description text_image_instance_description = { | |
| 861 sizeof (struct text_image_instance), text_image_instance_description_1 | |
| 862 }; | |
| 863 | |
| 864 static const struct memory_description pixmap_image_instance_description_1 [] = { | |
| 865 { XD_LISP_OBJECT, offsetof (struct pixmap_image_instance, hotspot_x) }, | |
| 866 { XD_LISP_OBJECT, offsetof (struct pixmap_image_instance, hotspot_x) }, | |
| 867 { XD_LISP_OBJECT, offsetof (struct pixmap_image_instance, filename) }, | |
| 868 { XD_LISP_OBJECT, offsetof (struct pixmap_image_instance, mask_filename) }, | |
| 869 { XD_LISP_OBJECT, offsetof (struct pixmap_image_instance, fg) }, | |
| 870 { XD_LISP_OBJECT, offsetof (struct pixmap_image_instance, bg) }, | |
| 871 { XD_LISP_OBJECT, offsetof (struct pixmap_image_instance, auxdata) }, | |
| 872 { XD_END } | |
| 873 }; | |
| 874 | |
| 875 static const struct sized_memory_description pixmap_image_instance_description = { | |
| 876 sizeof (struct pixmap_image_instance), pixmap_image_instance_description_1 | |
| 877 }; | |
| 878 | |
| 879 static const struct memory_description subwindow_image_instance_description_1 [] = { | |
| 880 { XD_LISP_OBJECT, offsetof (struct subwindow_image_instance, face) }, | |
| 881 { XD_LISP_OBJECT, offsetof (struct subwindow_image_instance, type) }, | |
| 882 { XD_LISP_OBJECT, offsetof (struct subwindow_image_instance, props) }, | |
| 883 { XD_LISP_OBJECT, offsetof (struct subwindow_image_instance, items) }, | |
| 884 { XD_LISP_OBJECT, offsetof (struct subwindow_image_instance, pending_items) }, | |
| 885 { XD_LISP_OBJECT, offsetof (struct subwindow_image_instance, children) }, | |
| 886 { XD_LISP_OBJECT, offsetof (struct subwindow_image_instance, width) }, | |
| 887 { XD_LISP_OBJECT, offsetof (struct subwindow_image_instance, height) }, | |
| 888 { XD_END } | |
| 889 }; | |
| 890 | |
| 891 static const struct sized_memory_description subwindow_image_instance_description = { | |
| 892 sizeof (struct subwindow_image_instance), subwindow_image_instance_description_1 | |
| 893 }; | |
| 894 | |
| 895 static const struct memory_description image_instance_data_description_1 [] = { | |
| 2367 | 896 { XD_BLOCK_ARRAY, IMAGE_TEXT, |
| 2551 | 897 1, { &text_image_instance_description } }, |
| 2367 | 898 { XD_BLOCK_ARRAY, IMAGE_MONO_PIXMAP, |
| 2551 | 899 1, { &pixmap_image_instance_description } }, |
| 2367 | 900 { XD_BLOCK_ARRAY, IMAGE_COLOR_PIXMAP, |
| 2551 | 901 1, { &pixmap_image_instance_description } }, |
| 2367 | 902 { XD_BLOCK_ARRAY, IMAGE_WIDGET, |
| 2551 | 903 1, { &subwindow_image_instance_description } }, |
| 1204 | 904 { XD_END } |
| 905 }; | |
| 906 | |
| 907 static const struct sized_memory_description image_instance_data_description = { | |
| 908 0, image_instance_data_description_1 | |
| 909 }; | |
| 910 | |
| 911 static const struct memory_description image_instance_description[] = { | |
| 912 { XD_INT, offsetof (struct Lisp_Image_Instance, type) }, | |
| 913 { XD_LISP_OBJECT, offsetof (Lisp_Image_Instance, domain) }, | |
| 914 { XD_LISP_OBJECT, offsetof (Lisp_Image_Instance, device) }, | |
| 915 { XD_LISP_OBJECT, offsetof (Lisp_Image_Instance, name) }, | |
| 916 { XD_LISP_OBJECT, offsetof (Lisp_Image_Instance, parent) }, | |
| 917 { XD_LISP_OBJECT, offsetof (Lisp_Image_Instance, instantiator) }, | |
| 4252 | 918 { XD_UNION, offsetof (struct Lisp_Image_Instance, u), |
| 2551 | 919 XD_INDIRECT (0, 0), { &image_instance_data_description } }, |
| 1204 | 920 { XD_END } |
| 921 }; | |
| 922 | |
| 428 | 923 static Lisp_Object |
| 924 mark_image_instance (Lisp_Object obj) | |
| 925 { | |
| 440 | 926 Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj); |
| 428 | 927 |
| 442 | 928 /* #### I want to check the instance here, but there are way too |
| 929 many instances of the instance being marked while the domain is | |
| 930 dead. For instance you can get marked through an event when using | |
| 931 callback_ex.*/ | |
| 932 #if 0 | |
| 933 ERROR_CHECK_IMAGE_INSTANCE (obj); | |
| 934 #endif | |
| 935 | |
| 428 | 936 mark_object (i->name); |
| 442 | 937 mark_object (i->instantiator); |
| 1204 | 938 /* #### Is this legal in marking? We may get in the situation where the |
| 442 | 939 domain has been deleted - making the instance unusable. It seems |
| 940 better to remove the domain so that it can be finalized. */ | |
| 941 if (!DOMAIN_LIVE_P (i->domain)) | |
| 942 i->domain = Qnil; | |
| 943 else | |
| 944 mark_object (i->domain); | |
| 945 | |
| 438 | 946 /* We don't mark the glyph reference since that would create a |
| 442 | 947 circularity preventing GC. Ditto the instantiator. */ |
| 428 | 948 switch (IMAGE_INSTANCE_TYPE (i)) |
| 949 { | |
| 950 case IMAGE_TEXT: | |
| 951 mark_object (IMAGE_INSTANCE_TEXT_STRING (i)); | |
| 952 break; | |
| 953 case IMAGE_MONO_PIXMAP: | |
| 954 case IMAGE_COLOR_PIXMAP: | |
| 955 mark_object (IMAGE_INSTANCE_PIXMAP_FILENAME (i)); | |
| 956 mark_object (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i)); | |
| 957 mark_object (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i)); | |
| 958 mark_object (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i)); | |
| 959 mark_object (IMAGE_INSTANCE_PIXMAP_FG (i)); | |
| 960 mark_object (IMAGE_INSTANCE_PIXMAP_BG (i)); | |
| 961 break; | |
| 962 | |
| 963 case IMAGE_WIDGET: | |
| 964 mark_object (IMAGE_INSTANCE_WIDGET_TYPE (i)); | |
| 965 mark_object (IMAGE_INSTANCE_WIDGET_PROPS (i)); | |
| 442 | 966 mark_object (IMAGE_INSTANCE_SUBWINDOW_FACE (i)); |
| 428 | 967 mark_object (IMAGE_INSTANCE_WIDGET_ITEMS (i)); |
| 442 | 968 mark_object (IMAGE_INSTANCE_LAYOUT_CHILDREN (i)); |
| 969 mark_object (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (i)); | |
| 970 mark_object (IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR (i)); | |
| 971 mark_object (IMAGE_INSTANCE_WIDGET_WIDTH_SUBR (i)); | |
| 428 | 972 case IMAGE_SUBWINDOW: |
| 973 break; | |
| 974 | |
| 975 default: | |
| 976 break; | |
| 977 } | |
| 978 | |
| 442 | 979 /* The image may have been previously finalized (yes that's weird, |
| 980 see Fdelete_frame() and mark_window_as_deleted()), in which case | |
| 981 the domain will be nil, so cope with this. */ | |
| 982 if (!NILP (IMAGE_INSTANCE_DEVICE (i))) | |
| 983 MAYBE_DEVMETH (XDEVICE (IMAGE_INSTANCE_DEVICE (i)), | |
| 984 mark_image_instance, (i)); | |
| 428 | 985 |
| 986 return i->device; | |
| 987 } | |
| 988 | |
| 989 static void | |
| 990 print_image_instance (Lisp_Object obj, Lisp_Object printcharfun, | |
| 991 int escapeflag) | |
| 992 { | |
| 440 | 993 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (obj); |
| 428 | 994 |
| 995 if (print_readably) | |
|
5142
f965e31a35f0
reduce lcrecord headers to 2 words, rename printing_unreadable_object
Ben Wing <ben@xemacs.org>
parents:
5127
diff
changeset
|
996 printing_unreadable_lisp_object (obj, 0); |
| 800 | 997 write_fmt_string_lisp (printcharfun, "#<image-instance (%s) ", 1, |
| 998 Fimage_instance_type (obj)); | |
| 428 | 999 if (!NILP (ii->name)) |
| 800 | 1000 write_fmt_string_lisp (printcharfun, "%S ", 1, ii->name); |
| 1001 write_fmt_string_lisp (printcharfun, "on %s ", 1, ii->domain); | |
| 428 | 1002 switch (IMAGE_INSTANCE_TYPE (ii)) |
| 1003 { | |
| 1004 case IMAGE_NOTHING: | |
| 1005 break; | |
| 1006 | |
| 1007 case IMAGE_TEXT: | |
| 1008 print_internal (IMAGE_INSTANCE_TEXT_STRING (ii), printcharfun, 1); | |
| 1009 break; | |
| 1010 | |
| 1011 case IMAGE_MONO_PIXMAP: | |
| 1012 case IMAGE_COLOR_PIXMAP: | |
| 1013 case IMAGE_POINTER: | |
| 1014 if (STRINGP (IMAGE_INSTANCE_PIXMAP_FILENAME (ii))) | |
| 1015 { | |
| 867 | 1016 Ibyte *s; |
| 428 | 1017 Lisp_Object filename = IMAGE_INSTANCE_PIXMAP_FILENAME (ii); |
| 771 | 1018 s = qxestrrchr (XSTRING_DATA (filename), '/'); |
| 428 | 1019 if (s) |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1020 print_internal (build_istring (s + 1), printcharfun, 1); |
| 428 | 1021 else |
| 1022 print_internal (filename, printcharfun, 1); | |
| 1023 } | |
| 1024 if (IMAGE_INSTANCE_PIXMAP_DEPTH (ii) > 1) | |
| 800 | 1025 write_fmt_string (printcharfun, " %dx%dx%d", |
| 1026 IMAGE_INSTANCE_PIXMAP_WIDTH (ii), | |
| 1027 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii), | |
| 1028 IMAGE_INSTANCE_PIXMAP_DEPTH (ii)); | |
| 428 | 1029 else |
| 800 | 1030 write_fmt_string (printcharfun, " %dx%d", |
| 1031 IMAGE_INSTANCE_PIXMAP_WIDTH (ii), | |
| 1032 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii)); | |
| 428 | 1033 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) || |
| 1034 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii))) | |
| 1035 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1036 write_ascstring (printcharfun, " @"); |
| 428 | 1037 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii))) |
| 800 | 1038 write_fmt_string (printcharfun, "%ld", |
| 1039 XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii))); | |
| 428 | 1040 else |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1041 write_ascstring (printcharfun, "??"); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1042 write_ascstring (printcharfun, ","); |
| 428 | 1043 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii))) |
| 800 | 1044 write_fmt_string (printcharfun, "%ld", |
| 1045 XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii))); | |
| 428 | 1046 else |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1047 write_ascstring (printcharfun, "??"); |
| 428 | 1048 } |
| 1049 if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)) || | |
| 1050 !NILP (IMAGE_INSTANCE_PIXMAP_BG (ii))) | |
| 1051 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1052 write_ascstring (printcharfun, " ("); |
| 428 | 1053 if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii))) |
| 1054 { | |
| 1055 print_internal | |
| 1056 (XCOLOR_INSTANCE | |
| 1057 (IMAGE_INSTANCE_PIXMAP_FG (ii))->name, printcharfun, 0); | |
| 1058 } | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1059 write_ascstring (printcharfun, "/"); |
| 428 | 1060 if (!NILP (IMAGE_INSTANCE_PIXMAP_BG (ii))) |
| 1061 { | |
| 1062 print_internal | |
| 1063 (XCOLOR_INSTANCE | |
| 1064 (IMAGE_INSTANCE_PIXMAP_BG (ii))->name, printcharfun, 0); | |
| 1065 } | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1066 write_ascstring (printcharfun, ")"); |
| 428 | 1067 } |
| 1068 break; | |
| 1069 | |
| 1070 case IMAGE_WIDGET: | |
| 442 | 1071 print_internal (IMAGE_INSTANCE_WIDGET_TYPE (ii), printcharfun, 0); |
| 1072 | |
| 1073 if (GUI_ITEMP (IMAGE_INSTANCE_WIDGET_ITEM (ii))) | |
| 800 | 1074 write_fmt_string_lisp (printcharfun, " %S", 1, |
| 1075 IMAGE_INSTANCE_WIDGET_TEXT (ii)); | |
| 442 | 1076 |
| 428 | 1077 if (!NILP (IMAGE_INSTANCE_WIDGET_FACE (ii))) |
| 800 | 1078 write_fmt_string_lisp (printcharfun, " face=%s", 1, |
| 1079 IMAGE_INSTANCE_WIDGET_FACE (ii)); | |
| 454 | 1080 /* fallthrough */ |
| 428 | 1081 |
| 1082 case IMAGE_SUBWINDOW: | |
| 800 | 1083 write_fmt_string (printcharfun, " %dx%d", IMAGE_INSTANCE_WIDTH (ii), |
| 1084 IMAGE_INSTANCE_HEIGHT (ii)); | |
| 428 | 1085 |
| 1086 /* This is stolen from frame.c. Subwindows are strange in that they | |
| 1087 are specific to a particular frame so we want to print in their | |
| 1088 description what that frame is. */ | |
| 1089 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1090 write_ascstring (printcharfun, " on #<"); |
| 428 | 1091 { |
| 442 | 1092 struct frame* f = XFRAME (IMAGE_INSTANCE_FRAME (ii)); |
| 440 | 1093 |
| 428 | 1094 if (!FRAME_LIVE_P (f)) |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1095 write_ascstring (printcharfun, "dead"); |
| 440 | 1096 else |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1097 write_ascstring (printcharfun, |
| 4252 | 1098 DEVICE_TYPE_NAME (XDEVICE (FRAME_DEVICE (f)))); |
| 428 | 1099 } |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1100 write_ascstring (printcharfun, "-frame>"); |
| 800 | 1101 write_fmt_string (printcharfun, " 0x%p", |
| 1102 IMAGE_INSTANCE_SUBWINDOW_ID (ii)); | |
| 440 | 1103 |
| 428 | 1104 break; |
| 1105 | |
| 1106 default: | |
| 2500 | 1107 ABORT (); |
| 428 | 1108 } |
| 1109 | |
| 442 | 1110 MAYBE_DEVMETH (DOMAIN_XDEVICE (ii->domain), print_image_instance, |
| 428 | 1111 (ii, printcharfun, escapeflag)); |
|
5146
88bd4f3ef8e4
make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents:
5142
diff
changeset
|
1112 write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); |
| 428 | 1113 } |
| 1114 | |
| 1115 static void | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5126
diff
changeset
|
1116 finalize_image_instance (Lisp_Object obj) |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5126
diff
changeset
|
1117 { |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5126
diff
changeset
|
1118 Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj); |
| 428 | 1119 |
| 442 | 1120 /* objects like this exist at dump time, so don't bomb out. */ |
| 1121 if (IMAGE_INSTANCE_TYPE (i) == IMAGE_NOTHING | |
| 1122 || | |
| 1123 NILP (IMAGE_INSTANCE_DEVICE (i))) | |
| 428 | 1124 return; |
| 1125 | |
| 442 | 1126 /* We can't use the domain here, because it might have |
| 1127 disappeared. */ | |
| 1128 MAYBE_DEVMETH (XDEVICE (IMAGE_INSTANCE_DEVICE (i)), | |
| 1129 finalize_image_instance, (i)); | |
| 1130 | |
| 1131 /* Make sure we don't try this twice. */ | |
| 1132 IMAGE_INSTANCE_DEVICE (i) = Qnil; | |
| 428 | 1133 } |
| 1134 | |
| 1135 static int | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1136 image_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1137 int UNUSED (foldcase)) |
| 428 | 1138 { |
| 440 | 1139 Lisp_Image_Instance *i1 = XIMAGE_INSTANCE (obj1); |
| 1140 Lisp_Image_Instance *i2 = XIMAGE_INSTANCE (obj2); | |
| 442 | 1141 |
| 1142 ERROR_CHECK_IMAGE_INSTANCE (obj1); | |
| 1143 ERROR_CHECK_IMAGE_INSTANCE (obj2); | |
| 1144 | |
| 1145 if (!EQ (IMAGE_INSTANCE_DOMAIN (i1), | |
| 1146 IMAGE_INSTANCE_DOMAIN (i2)) | |
| 1147 || IMAGE_INSTANCE_TYPE (i1) != IMAGE_INSTANCE_TYPE (i2) | |
| 438 | 1148 || IMAGE_INSTANCE_WIDTH (i1) != IMAGE_INSTANCE_WIDTH (i2) |
| 442 | 1149 || IMAGE_INSTANCE_MARGIN_WIDTH (i1) != |
| 1150 IMAGE_INSTANCE_MARGIN_WIDTH (i2) | |
| 438 | 1151 || IMAGE_INSTANCE_HEIGHT (i1) != IMAGE_INSTANCE_HEIGHT (i2) |
| 1152 || IMAGE_INSTANCE_XOFFSET (i1) != IMAGE_INSTANCE_XOFFSET (i2) | |
| 1153 || IMAGE_INSTANCE_YOFFSET (i1) != IMAGE_INSTANCE_YOFFSET (i2)) | |
| 428 | 1154 return 0; |
| 1155 if (!internal_equal (IMAGE_INSTANCE_NAME (i1), IMAGE_INSTANCE_NAME (i2), | |
| 1156 depth + 1)) | |
| 1157 return 0; | |
| 442 | 1158 if (!internal_equal (IMAGE_INSTANCE_INSTANTIATOR (i1), |
| 1159 IMAGE_INSTANCE_INSTANTIATOR (i2), | |
| 1160 depth + 1)) | |
| 1161 return 0; | |
| 428 | 1162 |
| 1163 switch (IMAGE_INSTANCE_TYPE (i1)) | |
| 1164 { | |
| 1165 case IMAGE_NOTHING: | |
| 1166 break; | |
| 1167 | |
| 1168 case IMAGE_TEXT: | |
| 1169 if (!internal_equal (IMAGE_INSTANCE_TEXT_STRING (i1), | |
| 1170 IMAGE_INSTANCE_TEXT_STRING (i2), | |
| 1171 depth + 1)) | |
| 1172 return 0; | |
| 1173 break; | |
| 1174 | |
| 1175 case IMAGE_MONO_PIXMAP: | |
| 1176 case IMAGE_COLOR_PIXMAP: | |
| 1177 case IMAGE_POINTER: | |
| 438 | 1178 if (!(IMAGE_INSTANCE_PIXMAP_DEPTH (i1) == |
| 428 | 1179 IMAGE_INSTANCE_PIXMAP_DEPTH (i2) && |
| 1180 IMAGE_INSTANCE_PIXMAP_SLICE (i1) == | |
| 1181 IMAGE_INSTANCE_PIXMAP_SLICE (i2) && | |
| 1182 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i1), | |
| 1183 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i2)) && | |
| 1184 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i1), | |
| 1185 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i2)) && | |
| 1186 internal_equal (IMAGE_INSTANCE_PIXMAP_FILENAME (i1), | |
| 1187 IMAGE_INSTANCE_PIXMAP_FILENAME (i2), | |
| 1188 depth + 1) && | |
| 1189 internal_equal (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i1), | |
| 1190 IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i2), | |
| 1191 depth + 1))) | |
| 1192 return 0; | |
| 1193 break; | |
| 1194 | |
| 1195 case IMAGE_WIDGET: | |
| 1196 if (!(EQ (IMAGE_INSTANCE_WIDGET_TYPE (i1), | |
| 1197 IMAGE_INSTANCE_WIDGET_TYPE (i2)) | |
| 438 | 1198 && IMAGE_INSTANCE_SUBWINDOW_ID (i1) == |
| 1199 IMAGE_INSTANCE_SUBWINDOW_ID (i2) | |
| 442 | 1200 && |
| 1201 EQ (IMAGE_INSTANCE_WIDGET_FACE (i1), | |
| 1202 IMAGE_INSTANCE_WIDGET_TYPE (i2)) | |
| 428 | 1203 && internal_equal (IMAGE_INSTANCE_WIDGET_ITEMS (i1), |
| 1204 IMAGE_INSTANCE_WIDGET_ITEMS (i2), | |
| 1205 depth + 1) | |
| 442 | 1206 && internal_equal (IMAGE_INSTANCE_LAYOUT_CHILDREN (i1), |
| 1207 IMAGE_INSTANCE_LAYOUT_CHILDREN (i2), | |
| 1208 depth + 1) | |
| 428 | 1209 && internal_equal (IMAGE_INSTANCE_WIDGET_PROPS (i1), |
| 1210 IMAGE_INSTANCE_WIDGET_PROPS (i2), | |
| 1211 depth + 1) | |
| 442 | 1212 && internal_equal (IMAGE_INSTANCE_WIDGET_WIDTH_SUBR (i1), |
| 1213 IMAGE_INSTANCE_WIDGET_WIDTH_SUBR (i2), | |
| 1214 depth + 1) | |
| 1215 && internal_equal (IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR (i1), | |
| 1216 IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR (i2), | |
| 1217 depth + 1) | |
| 428 | 1218 )) |
| 1219 return 0; | |
| 438 | 1220 break; |
| 440 | 1221 |
| 428 | 1222 case IMAGE_SUBWINDOW: |
| 438 | 1223 if (!(IMAGE_INSTANCE_SUBWINDOW_ID (i1) == |
| 428 | 1224 IMAGE_INSTANCE_SUBWINDOW_ID (i2))) |
| 1225 return 0; | |
| 1226 break; | |
| 1227 | |
| 1228 default: | |
| 2500 | 1229 ABORT (); |
| 428 | 1230 } |
| 1231 | |
| 442 | 1232 return DEVMETH_OR_GIVEN (DOMAIN_XDEVICE (i1->domain), |
| 1233 image_instance_equal, (i1, i2, depth), 1); | |
| 1234 } | |
| 1235 | |
| 1236 /* Image instance domain manipulators. We can't error check in these | |
| 1237 otherwise we get into infinite recursion. */ | |
| 1238 Lisp_Object | |
| 1239 image_instance_device (Lisp_Object instance) | |
| 1240 { | |
| 1241 return XIMAGE_INSTANCE_DEVICE (instance); | |
| 1242 } | |
| 1243 | |
| 1244 Lisp_Object | |
| 1245 image_instance_frame (Lisp_Object instance) | |
| 1246 { | |
| 1247 return XIMAGE_INSTANCE_FRAME (instance); | |
| 1248 } | |
| 1249 | |
| 1250 Lisp_Object | |
| 1251 image_instance_window (Lisp_Object instance) | |
| 1252 { | |
| 1253 return DOMAIN_WINDOW (XIMAGE_INSTANCE_DOMAIN (instance)); | |
| 1254 } | |
| 1255 | |
| 1256 int | |
| 1257 image_instance_live_p (Lisp_Object instance) | |
| 1258 { | |
| 1259 return DOMAIN_LIVE_P (XIMAGE_INSTANCE_DOMAIN (instance)); | |
| 428 | 1260 } |
| 1261 | |
| 665 | 1262 static Hashcode |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
1263 image_instance_hash (Lisp_Object obj, int depth, Boolint UNUSED (equalp)) |
| 428 | 1264 { |
| 440 | 1265 Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj); |
| 665 | 1266 Hashcode hash = HASH5 (LISP_HASH (IMAGE_INSTANCE_DOMAIN (i)), |
| 647 | 1267 IMAGE_INSTANCE_WIDTH (i), |
| 1268 IMAGE_INSTANCE_MARGIN_WIDTH (i), | |
| 1269 IMAGE_INSTANCE_HEIGHT (i), | |
| 1270 internal_hash (IMAGE_INSTANCE_INSTANTIATOR (i), | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
1271 depth + 1, 0)); |
| 442 | 1272 |
| 1273 ERROR_CHECK_IMAGE_INSTANCE (obj); | |
| 428 | 1274 |
| 1275 switch (IMAGE_INSTANCE_TYPE (i)) | |
| 1276 { | |
| 1277 case IMAGE_NOTHING: | |
| 1278 break; | |
| 1279 | |
| 1280 case IMAGE_TEXT: | |
| 1281 hash = HASH2 (hash, internal_hash (IMAGE_INSTANCE_TEXT_STRING (i), | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
1282 depth + 1, 0)); |
| 428 | 1283 break; |
| 1284 | |
| 1285 case IMAGE_MONO_PIXMAP: | |
| 1286 case IMAGE_COLOR_PIXMAP: | |
| 1287 case IMAGE_POINTER: | |
| 438 | 1288 hash = HASH4 (hash, IMAGE_INSTANCE_PIXMAP_DEPTH (i), |
| 428 | 1289 IMAGE_INSTANCE_PIXMAP_SLICE (i), |
| 1290 internal_hash (IMAGE_INSTANCE_PIXMAP_FILENAME (i), | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
1291 depth + 1, 0)); |
| 428 | 1292 break; |
| 1293 | |
| 1294 case IMAGE_WIDGET: | |
| 442 | 1295 /* We need the hash to be equivalent to what should be |
| 4252 | 1296 displayed. */ |
| 442 | 1297 hash = HASH5 (hash, |
| 1298 LISP_HASH (IMAGE_INSTANCE_WIDGET_TYPE (i)), | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
1299 internal_hash (IMAGE_INSTANCE_WIDGET_PROPS (i), |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
1300 depth + 1, 0), |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
1301 internal_hash (IMAGE_INSTANCE_WIDGET_ITEMS (i), |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
1302 depth + 1, 0), |
| 442 | 1303 internal_hash (IMAGE_INSTANCE_LAYOUT_CHILDREN (i), |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
1304 depth + 1, 0)); |
| 438 | 1305 case IMAGE_SUBWINDOW: |
| 442 | 1306 hash = HASH2 (hash, (EMACS_INT) IMAGE_INSTANCE_SUBWINDOW_ID (i)); |
| 438 | 1307 break; |
| 1308 | |
| 428 | 1309 default: |
| 2500 | 1310 ABORT (); |
| 428 | 1311 } |
| 1312 | |
| 442 | 1313 return HASH2 (hash, DEVMETH_OR_GIVEN |
| 1314 (XDEVICE (image_instance_device (obj)), | |
| 1315 image_instance_hash, (i, depth), | |
| 1316 0)); | |
| 428 | 1317 } |
| 1318 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
1319 DEFINE_NODUMP_LISP_OBJECT ("image-instance", image_instance, |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
1320 mark_image_instance, print_image_instance, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
1321 finalize_image_instance, image_instance_equal, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
1322 image_instance_hash, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
1323 image_instance_description, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
1324 Lisp_Image_Instance); |
| 428 | 1325 |
| 1326 static Lisp_Object | |
| 442 | 1327 allocate_image_instance (Lisp_Object governing_domain, Lisp_Object parent, |
| 1328 Lisp_Object instantiator) | |
| 428 | 1329 { |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5126
diff
changeset
|
1330 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (image_instance); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
1331 Lisp_Image_Instance *lp = XIMAGE_INSTANCE (obj); |
| 428 | 1332 |
| 442 | 1333 /* It's not possible to simply keep a record of the domain in which |
| 1334 the instance was instantiated. This is because caching may mean | |
| 1335 that the domain becomes invalid but the instance remains | |
| 1336 valid. However, the only truly relevant domain is the domain in | |
| 1337 which the instance is cached since this is the one that will be | |
| 1338 common to the instances. */ | |
| 1339 lp->domain = governing_domain; | |
| 1340 /* The cache domain is not quite sufficient since the domain can get | |
| 1341 deleted before the image instance does. We need to know the | |
| 1342 domain device in order to finalize the image instance | |
| 1343 properly. We therefore record the device also. */ | |
| 1344 lp->device = DOMAIN_DEVICE (governing_domain); | |
| 428 | 1345 lp->type = IMAGE_NOTHING; |
| 1346 lp->name = Qnil; | |
| 442 | 1347 lp->width = IMAGE_UNSPECIFIED_GEOMETRY; |
| 1348 lp->height = IMAGE_UNSPECIFIED_GEOMETRY; | |
| 1349 lp->parent = parent; | |
| 1350 lp->instantiator = instantiator; | |
| 1351 /* So that layouts get done. */ | |
| 1352 lp->layout_changed = 1; | |
| 1353 | |
| 1354 MARK_GLYPHS_CHANGED; | |
| 1355 | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
1356 return obj; |
| 428 | 1357 } |
| 1358 | |
| 1359 static enum image_instance_type | |
| 578 | 1360 decode_image_instance_type (Lisp_Object type, Error_Behavior errb) |
| 428 | 1361 { |
| 1362 if (ERRB_EQ (errb, ERROR_ME)) | |
| 1363 CHECK_SYMBOL (type); | |
| 1364 | |
| 1365 if (EQ (type, Qnothing)) return IMAGE_NOTHING; | |
| 1366 if (EQ (type, Qtext)) return IMAGE_TEXT; | |
| 1367 if (EQ (type, Qmono_pixmap)) return IMAGE_MONO_PIXMAP; | |
| 1368 if (EQ (type, Qcolor_pixmap)) return IMAGE_COLOR_PIXMAP; | |
| 1369 if (EQ (type, Qpointer)) return IMAGE_POINTER; | |
| 1370 if (EQ (type, Qsubwindow)) return IMAGE_SUBWINDOW; | |
| 1371 if (EQ (type, Qwidget)) return IMAGE_WIDGET; | |
| 1372 | |
| 563 | 1373 maybe_invalid_constant ("Invalid image-instance type", type, |
| 428 | 1374 Qimage, errb); |
| 1375 | |
| 1376 return IMAGE_UNKNOWN; /* not reached */ | |
| 1377 } | |
| 1378 | |
| 1379 static Lisp_Object | |
| 1380 encode_image_instance_type (enum image_instance_type type) | |
| 1381 { | |
| 1382 switch (type) | |
| 1383 { | |
| 1384 case IMAGE_NOTHING: return Qnothing; | |
| 1385 case IMAGE_TEXT: return Qtext; | |
| 1386 case IMAGE_MONO_PIXMAP: return Qmono_pixmap; | |
| 1387 case IMAGE_COLOR_PIXMAP: return Qcolor_pixmap; | |
| 1388 case IMAGE_POINTER: return Qpointer; | |
| 1389 case IMAGE_SUBWINDOW: return Qsubwindow; | |
| 1390 case IMAGE_WIDGET: return Qwidget; | |
| 1391 default: | |
| 2500 | 1392 ABORT (); |
| 428 | 1393 } |
| 1394 | |
| 1395 return Qnil; /* not reached */ | |
| 1396 } | |
| 1397 | |
| 1398 static int | |
| 1399 decode_image_instance_type_list (Lisp_Object list) | |
| 1400 { | |
| 1401 int mask = 0; | |
| 1402 | |
| 1403 if (NILP (list)) | |
| 1404 return ~0; | |
| 1405 | |
| 1406 if (!CONSP (list)) | |
| 1407 { | |
| 1408 enum image_instance_type type = | |
| 1409 decode_image_instance_type (list, ERROR_ME); | |
| 1410 return image_instance_type_to_mask (type); | |
| 1411 } | |
| 1412 | |
| 2367 | 1413 { |
| 1414 EXTERNAL_LIST_LOOP_2 (elt, list) | |
| 1415 { | |
| 1416 enum image_instance_type type = | |
| 1417 decode_image_instance_type (elt, ERROR_ME); | |
| 1418 mask |= image_instance_type_to_mask (type); | |
| 1419 } | |
| 1420 } | |
| 428 | 1421 |
| 1422 return mask; | |
| 1423 } | |
| 1424 | |
| 1425 static Lisp_Object | |
| 1426 encode_image_instance_type_list (int mask) | |
| 1427 { | |
| 1428 int count = 0; | |
| 1429 Lisp_Object result = Qnil; | |
| 1430 | |
| 1431 while (mask) | |
| 1432 { | |
| 1433 count++; | |
| 1434 if (mask & 1) | |
| 1435 result = Fcons (encode_image_instance_type | |
| 1436 ((enum image_instance_type) count), result); | |
| 1437 mask >>= 1; | |
| 1438 } | |
| 1439 | |
| 1440 return Fnreverse (result); | |
| 1441 } | |
| 1442 | |
| 1443 DOESNT_RETURN | |
| 1444 incompatible_image_types (Lisp_Object instantiator, int given_dest_mask, | |
| 1445 int desired_dest_mask) | |
| 1446 { | |
| 563 | 1447 signal_error_1 |
| 1448 (Qinvalid_argument, | |
| 428 | 1449 list2 |
| 771 | 1450 (emacs_sprintf_string_lisp |
| 1451 ("No compatible image-instance types given: wanted one of %s, got %s", | |
| 1452 Qnil, 2, encode_image_instance_type_list (desired_dest_mask), | |
| 428 | 1453 encode_image_instance_type_list (given_dest_mask)), |
| 1454 instantiator)); | |
| 1455 } | |
| 1456 | |
| 1457 static int | |
| 1458 valid_image_instance_type_p (Lisp_Object type) | |
| 1459 { | |
| 1460 return !NILP (memq_no_quit (type, Vimage_instance_type_list)); | |
| 1461 } | |
| 1462 | |
| 1463 DEFUN ("valid-image-instance-type-p", Fvalid_image_instance_type_p, 1, 1, 0, /* | |
| 1464 Given an IMAGE-INSTANCE-TYPE, return non-nil if it is valid. | |
| 2959 | 1465 Valid types are some subset of `nothing', `text', `mono-pixmap', |
| 1466 `color-pixmap', `pointer', `subwindow', and `widget', depending on how | |
| 1467 XEmacs was compiled. | |
| 428 | 1468 */ |
| 1469 (image_instance_type)) | |
| 1470 { | |
| 1471 return valid_image_instance_type_p (image_instance_type) ? Qt : Qnil; | |
| 1472 } | |
| 1473 | |
| 1474 DEFUN ("image-instance-type-list", Fimage_instance_type_list, 0, 0, 0, /* | |
| 1475 Return a list of valid image-instance types. | |
| 1476 */ | |
| 1477 ()) | |
| 1478 { | |
| 1479 return Fcopy_sequence (Vimage_instance_type_list); | |
| 1480 } | |
| 1481 | |
| 578 | 1482 Error_Behavior |
| 444 | 1483 decode_error_behavior_flag (Lisp_Object noerror) |
| 1484 { | |
| 1485 if (NILP (noerror)) return ERROR_ME; | |
| 1486 else if (EQ (noerror, Qt)) return ERROR_ME_NOT; | |
| 793 | 1487 else if (EQ (noerror, Qdebug)) return ERROR_ME_DEBUG_WARN; |
| 444 | 1488 else return ERROR_ME_WARN; |
| 428 | 1489 } |
| 1490 | |
| 1491 Lisp_Object | |
| 578 | 1492 encode_error_behavior_flag (Error_Behavior errb) |
| 428 | 1493 { |
| 1494 if (ERRB_EQ (errb, ERROR_ME)) | |
| 1495 return Qnil; | |
| 1496 else if (ERRB_EQ (errb, ERROR_ME_NOT)) | |
| 1497 return Qt; | |
| 793 | 1498 else if (ERRB_EQ (errb, ERROR_ME_DEBUG_WARN)) |
| 1499 return Qdebug; | |
| 428 | 1500 else |
| 1501 { | |
| 1502 assert (ERRB_EQ (errb, ERROR_ME_WARN)); | |
| 1503 return Qwarning; | |
| 1504 } | |
| 1505 } | |
| 1506 | |
| 442 | 1507 /* Recurse up the hierarchy looking for the topmost glyph. This means |
| 1508 that instances in layouts will inherit face properties from their | |
| 1509 parent. */ | |
| 1510 Lisp_Object image_instance_parent_glyph (Lisp_Image_Instance* ii) | |
| 1511 { | |
| 1512 if (IMAGE_INSTANCEP (IMAGE_INSTANCE_PARENT (ii))) | |
| 1513 { | |
| 1514 return image_instance_parent_glyph | |
| 1515 (XIMAGE_INSTANCE (IMAGE_INSTANCE_PARENT (ii))); | |
| 1516 } | |
| 1517 return IMAGE_INSTANCE_PARENT (ii); | |
| 1518 } | |
| 1519 | |
| 428 | 1520 static Lisp_Object |
| 442 | 1521 make_image_instance_1 (Lisp_Object data, Lisp_Object domain, |
| 428 | 1522 Lisp_Object dest_types) |
| 1523 { | |
| 1524 Lisp_Object ii; | |
| 1525 struct gcpro gcpro1; | |
| 1526 int dest_mask; | |
| 442 | 1527 Lisp_Object governing_domain; |
| 1528 | |
| 428 | 1529 if (IMAGE_INSTANCEP (data)) |
| 563 | 1530 invalid_argument ("Image instances not allowed here", data); |
| 428 | 1531 image_validate (data); |
| 442 | 1532 domain = decode_domain (domain); |
| 1533 /* instantiate_image_instantiator() will abort if given an | |
| 1534 image instance ... */ | |
| 428 | 1535 dest_mask = decode_image_instance_type_list (dest_types); |
| 442 | 1536 data = normalize_image_instantiator (data, |
| 1537 DEVICE_TYPE (DOMAIN_XDEVICE (domain)), | |
| 428 | 1538 make_int (dest_mask)); |
| 1539 GCPRO1 (data); | |
| 442 | 1540 /* After normalizing the data, it's always either an image instance (which |
| 1541 we filtered out above) or a vector. */ | |
| 450 | 1542 if (EQ (INSTANTIATOR_TYPE (data), Qinherit)) |
| 563 | 1543 invalid_argument ("Inheritance not allowed here", data); |
| 442 | 1544 governing_domain = |
| 1545 get_image_instantiator_governing_domain (data, domain); | |
| 1546 ii = instantiate_image_instantiator (governing_domain, domain, data, | |
| 438 | 1547 Qnil, Qnil, dest_mask, Qnil); |
| 428 | 1548 RETURN_UNGCPRO (ii); |
| 1549 } | |
| 1550 | |
| 1551 DEFUN ("make-image-instance", Fmake_image_instance, 1, 4, 0, /* | |
| 1552 Return a new `image-instance' object. | |
| 1553 | |
| 1554 Image-instance objects encapsulate the way a particular image (pixmap, | |
| 1555 etc.) is displayed on a particular device. In most circumstances, you | |
| 1556 do not need to directly create image instances; use a glyph instead. | |
| 1557 However, it may occasionally be useful to explicitly create image | |
| 1558 instances, if you want more control over the instantiation process. | |
| 1559 | |
| 1560 DATA is an image instantiator, which describes the image; see | |
| 442 | 1561 `make-image-specifier' for a description of the allowed values. |
| 428 | 1562 |
| 1563 DEST-TYPES should be a list of allowed image instance types that can | |
| 1564 be generated. The recognized image instance types are | |
| 1565 | |
| 2959 | 1566 `nothing' |
| 428 | 1567 Nothing is displayed. |
| 2959 | 1568 `text' |
| 428 | 1569 Displayed as text. The foreground and background colors and the |
| 1570 font of the text are specified independent of the pixmap. Typically | |
| 1571 these attributes will come from the face of the surrounding text, | |
| 1572 unless a face is specified for the glyph in which the image appears. | |
| 2959 | 1573 `mono-pixmap' |
| 428 | 1574 Displayed as a mono pixmap (a pixmap with only two colors where the |
| 1575 foreground and background can be specified independent of the pixmap; | |
| 1576 typically the pixmap assumes the foreground and background colors of | |
| 1577 the text around it, unless a face is specified for the glyph in which | |
| 1578 the image appears). | |
| 2959 | 1579 `color-pixmap' |
| 428 | 1580 Displayed as a color pixmap. |
| 2959 | 1581 `pointer' |
| 428 | 1582 Used as the mouse pointer for a window. |
| 2959 | 1583 `subwindow' |
| 428 | 1584 A child window that is treated as an image. This allows (e.g.) |
| 1585 another program to be responsible for drawing into the window. | |
| 2959 | 1586 `widget' |
| 428 | 1587 A child window that contains a window-system widget, e.g. a push |
| 442 | 1588 button, text field, or slider. |
| 1589 | |
| 1590 The DEST-TYPES list is unordered. If multiple destination types are | |
| 1591 possible for a given instantiator, the "most natural" type for the | |
| 1592 instantiator's format is chosen. (For XBM, the most natural types are | |
| 1593 `mono-pixmap', followed by `color-pixmap', followed by `pointer'. For | |
| 1594 the other normal image formats, the most natural types are | |
| 1595 `color-pixmap', followed by `mono-pixmap', followed by `pointer'. For | |
| 1596 the string and formatted-string formats, the most natural types are | |
| 1597 `text', followed by `mono-pixmap' (not currently implemented), | |
| 1598 followed by `color-pixmap' (not currently implemented). For MS | |
| 1599 Windows resources, the most natural type for pointer resources is | |
| 1600 `pointer', and for the others it's `color-pixmap'. The other formats | |
| 1601 can only be instantiated as one type. (If you want to control more | |
| 1602 specifically the order of the types into which an image is | |
| 1603 instantiated, just call `make-image-instance' repeatedly until it | |
| 1604 succeeds, passing less and less preferred destination types each | |
| 1605 time.) | |
| 1606 | |
| 1607 See `make-image-specifier' for a description of the different image | |
| 1608 instantiator formats. | |
| 428 | 1609 |
| 1610 If DEST-TYPES is omitted, all possible types are allowed. | |
| 1611 | |
| 442 | 1612 DOMAIN specifies the domain to which the image instance will be attached. |
| 1613 This domain is termed the \"governing domain\". The type of the governing | |
| 1614 domain depends on the image instantiator format. (Although, more correctly, | |
| 1615 it should probably depend on the image instance type.) For example, pixmap | |
| 1616 image instances are specific to a device, but widget image instances are | |
| 1617 specific to a particular XEmacs window because in order to display such a | |
| 1618 widget when two windows onto the same buffer want to display the widget, | |
| 1619 two separate underlying widgets must be created. (That's because a widget | |
| 1620 is actually a child window-system window, and all window-system windows have | |
| 1621 a unique existence on the screen.) This means that the governing domain for | |
| 1622 a pixmap image instance will be some device (most likely, the only existing | |
| 1623 device), whereas the governing domain for a widget image instance will be | |
| 1624 some XEmacs window. | |
| 1625 | |
| 1626 If you specify an overly general DOMAIN (e.g. a frame when a window was | |
| 1627 wanted), an error is signaled. If you specify an overly specific DOMAIN | |
| 1628 \(e.g. a window when a device was wanted), the corresponding general domain | |
| 1629 is fetched and used instead. For `make-image-instance', it makes no | |
| 1630 difference whether you specify an overly specific domain or the properly | |
| 1631 general domain derived from it. However, it does matter when creating an | |
| 1632 image instance by instantiating a specifier or glyph (e.g. with | |
| 1633 `glyph-image-instance'), because the more specific domain causes spec lookup | |
| 1634 to start there and proceed to more general domains. (It would also matter | |
| 1635 when creating an image instance with an instantiator format of `inherit', | |
| 1636 but we currently disallow this. #### We should fix this.) | |
| 1637 | |
| 1638 If omitted, DOMAIN defaults to the selected window. | |
| 1639 | |
| 444 | 1640 NOERROR controls what happens when the image cannot be generated. |
| 428 | 1641 If nil, an error message is generated. If t, no messages are |
| 1642 generated and this function returns nil. If anything else, a warning | |
| 440 | 1643 message is generated and this function returns nil. |
| 428 | 1644 */ |
| 444 | 1645 (data, domain, dest_types, noerror)) |
| 1646 { | |
| 578 | 1647 Error_Behavior errb = decode_error_behavior_flag (noerror); |
| 428 | 1648 |
| 1649 return call_with_suspended_errors ((lisp_fn_t) make_image_instance_1, | |
| 1650 Qnil, Qimage, errb, | |
| 442 | 1651 3, data, domain, dest_types); |
| 428 | 1652 } |
| 1653 | |
| 1654 DEFUN ("image-instance-p", Fimage_instance_p, 1, 1, 0, /* | |
| 1655 Return non-nil if OBJECT is an image instance. | |
| 1656 */ | |
| 1657 (object)) | |
| 1658 { | |
| 1659 return IMAGE_INSTANCEP (object) ? Qt : Qnil; | |
| 1660 } | |
| 1661 | |
| 1662 DEFUN ("image-instance-type", Fimage_instance_type, 1, 1, 0, /* | |
| 1663 Return the type of the given image instance. | |
| 2959 | 1664 The return value will be one of `nothing', `text', `mono-pixmap', |
| 1665 `color-pixmap', `pointer', `subwindow', or `widget'. | |
| 428 | 1666 */ |
| 1667 (image_instance)) | |
| 1668 { | |
| 1669 CHECK_IMAGE_INSTANCE (image_instance); | |
| 442 | 1670 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
| 428 | 1671 return encode_image_instance_type (XIMAGE_INSTANCE_TYPE (image_instance)); |
| 1672 } | |
| 1673 | |
| 1674 DEFUN ("image-instance-name", Fimage_instance_name, 1, 1, 0, /* | |
| 1675 Return the name of the given image instance. | |
| 1676 */ | |
| 1677 (image_instance)) | |
| 1678 { | |
| 1679 CHECK_IMAGE_INSTANCE (image_instance); | |
| 1680 return XIMAGE_INSTANCE_NAME (image_instance); | |
| 1681 } | |
| 1682 | |
| 872 | 1683 DEFUN ("image-instance-instantiator", Fimage_instance_instantiator, 1, 1, 0, /* |
| 1684 Return the instantiator that was used to create the image instance. | |
| 1685 */ | |
| 1686 (image_instance)) | |
| 1687 { | |
| 1688 CHECK_IMAGE_INSTANCE (image_instance); | |
| 1689 return XIMAGE_INSTANCE_INSTANTIATOR (image_instance); | |
| 1690 } | |
| 1691 | |
| 442 | 1692 DEFUN ("image-instance-domain", Fimage_instance_domain, 1, 1, 0, /* |
| 1693 Return the governing domain of the given image instance. | |
| 1694 The governing domain of an image instance is the domain that the image | |
| 1695 instance is specific to. It is NOT necessarily the domain that was | |
| 1696 given to the call to `specifier-instance' that resulted in the creation | |
| 1697 of this image instance. See `make-image-instance' for more information | |
| 1698 on governing domains. | |
| 1699 */ | |
| 1700 (image_instance)) | |
| 1701 { | |
| 1702 CHECK_IMAGE_INSTANCE (image_instance); | |
| 1703 return XIMAGE_INSTANCE_DOMAIN (image_instance); | |
| 1704 } | |
| 1705 | |
| 428 | 1706 DEFUN ("image-instance-string", Fimage_instance_string, 1, 1, 0, /* |
| 1707 Return the string of the given image instance. | |
| 1708 This will only be non-nil for text image instances and widgets. | |
| 1709 */ | |
| 1710 (image_instance)) | |
| 1711 { | |
| 1712 CHECK_IMAGE_INSTANCE (image_instance); | |
| 1713 if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_TEXT) | |
| 1714 return XIMAGE_INSTANCE_TEXT_STRING (image_instance); | |
| 1715 else if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_WIDGET) | |
| 1716 return XIMAGE_INSTANCE_WIDGET_TEXT (image_instance); | |
| 1717 else | |
| 1718 return Qnil; | |
| 1719 } | |
| 1720 | |
| 1721 DEFUN ("image-instance-property", Fimage_instance_property, 2, 2, 0, /* | |
| 440 | 1722 Return the given property of the given image instance. |
| 428 | 1723 Returns nil if the property or the property method do not exist for |
| 440 | 1724 the image instance in the domain. |
| 428 | 1725 */ |
| 1726 (image_instance, prop)) | |
| 1727 { | |
| 440 | 1728 Lisp_Image_Instance* ii; |
| 428 | 1729 Lisp_Object type, ret; |
| 1730 struct image_instantiator_methods* meths; | |
| 1731 | |
| 1732 CHECK_IMAGE_INSTANCE (image_instance); | |
| 442 | 1733 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
| 428 | 1734 CHECK_SYMBOL (prop); |
| 1735 ii = XIMAGE_INSTANCE (image_instance); | |
| 1736 | |
| 1737 /* ... then try device specific methods ... */ | |
| 1738 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii)); | |
| 442 | 1739 meths = decode_device_ii_format (image_instance_device (image_instance), |
| 428 | 1740 type, ERROR_ME_NOT); |
| 1741 if (meths && HAS_IIFORMAT_METH_P (meths, property) | |
| 440 | 1742 && |
| 428 | 1743 !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop)))) |
| 1744 { | |
| 1745 return ret; | |
| 1746 } | |
| 1747 /* ... then format specific methods ... */ | |
| 1748 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT); | |
| 1749 if (meths && HAS_IIFORMAT_METH_P (meths, property) | |
| 1750 && | |
| 1751 !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop)))) | |
| 1752 { | |
| 1753 return ret; | |
| 1754 } | |
| 1755 /* ... then fail */ | |
| 1756 return Qnil; | |
| 1757 } | |
| 1758 | |
| 1759 DEFUN ("image-instance-file-name", Fimage_instance_file_name, 1, 1, 0, /* | |
| 1760 Return the file name from which IMAGE-INSTANCE was read, if known. | |
| 1761 */ | |
| 1762 (image_instance)) | |
| 1763 { | |
| 1764 CHECK_IMAGE_INSTANCE (image_instance); | |
| 442 | 1765 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
| 428 | 1766 |
| 1767 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
| 1768 { | |
| 1769 case IMAGE_MONO_PIXMAP: | |
| 1770 case IMAGE_COLOR_PIXMAP: | |
| 1771 case IMAGE_POINTER: | |
| 1772 return XIMAGE_INSTANCE_PIXMAP_FILENAME (image_instance); | |
| 1773 | |
| 1774 default: | |
| 1775 return Qnil; | |
| 1776 } | |
| 1777 } | |
| 1778 | |
| 1779 DEFUN ("image-instance-mask-file-name", Fimage_instance_mask_file_name, 1, 1, 0, /* | |
| 1780 Return the file name from which IMAGE-INSTANCE's mask was read, if known. | |
| 1781 */ | |
| 1782 (image_instance)) | |
| 1783 { | |
| 1784 CHECK_IMAGE_INSTANCE (image_instance); | |
| 442 | 1785 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
| 428 | 1786 |
| 1787 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
| 1788 { | |
| 1789 case IMAGE_MONO_PIXMAP: | |
| 1790 case IMAGE_COLOR_PIXMAP: | |
| 1791 case IMAGE_POINTER: | |
| 1792 return XIMAGE_INSTANCE_PIXMAP_MASK_FILENAME (image_instance); | |
| 1793 | |
| 1794 default: | |
| 1795 return Qnil; | |
| 1796 } | |
| 1797 } | |
| 1798 | |
| 1799 DEFUN ("image-instance-depth", Fimage_instance_depth, 1, 1, 0, /* | |
| 1800 Return the depth of the image instance. | |
| 1801 This is 0 for a bitmap, or a positive integer for a pixmap. | |
| 1802 */ | |
| 1803 (image_instance)) | |
| 1804 { | |
| 1805 CHECK_IMAGE_INSTANCE (image_instance); | |
| 442 | 1806 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
| 428 | 1807 |
| 1808 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
| 1809 { | |
| 1810 case IMAGE_MONO_PIXMAP: | |
| 1811 case IMAGE_COLOR_PIXMAP: | |
| 1812 case IMAGE_POINTER: | |
| 1813 return make_int (XIMAGE_INSTANCE_PIXMAP_DEPTH (image_instance)); | |
| 1814 | |
| 1815 default: | |
| 1816 return Qnil; | |
| 1817 } | |
| 1818 } | |
| 1819 | |
| 1820 DEFUN ("image-instance-height", Fimage_instance_height, 1, 1, 0, /* | |
| 1821 Return the height of the image instance, in pixels. | |
| 1822 */ | |
| 1823 (image_instance)) | |
| 1824 { | |
| 1825 CHECK_IMAGE_INSTANCE (image_instance); | |
| 442 | 1826 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
| 428 | 1827 |
| 1828 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
| 1829 { | |
| 1830 case IMAGE_MONO_PIXMAP: | |
| 1831 case IMAGE_COLOR_PIXMAP: | |
| 1832 case IMAGE_POINTER: | |
| 1833 case IMAGE_SUBWINDOW: | |
| 1834 case IMAGE_WIDGET: | |
| 438 | 1835 return make_int (XIMAGE_INSTANCE_HEIGHT (image_instance)); |
| 428 | 1836 |
| 1837 default: | |
| 1838 return Qnil; | |
| 1839 } | |
| 1840 } | |
| 1841 | |
| 1842 DEFUN ("image-instance-width", Fimage_instance_width, 1, 1, 0, /* | |
| 1843 Return the width of the image instance, in pixels. | |
| 1844 */ | |
| 1845 (image_instance)) | |
| 1846 { | |
| 1847 CHECK_IMAGE_INSTANCE (image_instance); | |
| 442 | 1848 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
| 428 | 1849 |
| 1850 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
| 1851 { | |
| 1852 case IMAGE_MONO_PIXMAP: | |
| 1853 case IMAGE_COLOR_PIXMAP: | |
| 1854 case IMAGE_POINTER: | |
| 1855 case IMAGE_SUBWINDOW: | |
| 1856 case IMAGE_WIDGET: | |
| 438 | 1857 return make_int (XIMAGE_INSTANCE_WIDTH (image_instance)); |
| 428 | 1858 |
| 1859 default: | |
| 1860 return Qnil; | |
| 1861 } | |
| 1862 } | |
| 1863 | |
| 1864 DEFUN ("image-instance-hotspot-x", Fimage_instance_hotspot_x, 1, 1, 0, /* | |
| 1865 Return the X coordinate of the image instance's hotspot, if known. | |
| 1866 This is a point relative to the origin of the pixmap. When an image is | |
| 1867 used as a mouse pointer, the hotspot is the point on the image that sits | |
| 1868 over the location that the pointer points to. This is, for example, the | |
| 1869 tip of the arrow or the center of the crosshairs. | |
| 1870 This will always be nil for a non-pointer image instance. | |
| 1871 */ | |
| 1872 (image_instance)) | |
| 1873 { | |
| 1874 CHECK_IMAGE_INSTANCE (image_instance); | |
| 442 | 1875 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
| 428 | 1876 |
| 1877 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
| 1878 { | |
| 1879 case IMAGE_MONO_PIXMAP: | |
| 1880 case IMAGE_COLOR_PIXMAP: | |
| 1881 case IMAGE_POINTER: | |
| 1882 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_X (image_instance); | |
| 1883 | |
| 1884 default: | |
| 1885 return Qnil; | |
| 1886 } | |
| 1887 } | |
| 1888 | |
| 1889 DEFUN ("image-instance-hotspot-y", Fimage_instance_hotspot_y, 1, 1, 0, /* | |
| 1890 Return the Y coordinate of the image instance's hotspot, if known. | |
| 1891 This is a point relative to the origin of the pixmap. When an image is | |
| 1892 used as a mouse pointer, the hotspot is the point on the image that sits | |
| 1893 over the location that the pointer points to. This is, for example, the | |
| 1894 tip of the arrow or the center of the crosshairs. | |
| 1895 This will always be nil for a non-pointer image instance. | |
| 1896 */ | |
| 1897 (image_instance)) | |
| 1898 { | |
| 1899 CHECK_IMAGE_INSTANCE (image_instance); | |
| 442 | 1900 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
| 428 | 1901 |
| 1902 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
| 1903 { | |
| 1904 case IMAGE_MONO_PIXMAP: | |
| 1905 case IMAGE_COLOR_PIXMAP: | |
| 1906 case IMAGE_POINTER: | |
| 1907 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (image_instance); | |
| 1908 | |
| 1909 default: | |
| 1910 return Qnil; | |
| 1911 } | |
| 1912 } | |
| 1913 | |
| 1914 DEFUN ("image-instance-foreground", Fimage_instance_foreground, 1, 1, 0, /* | |
| 1915 Return the foreground color of IMAGE-INSTANCE, if applicable. | |
| 1916 This will be a color instance or nil. (It will only be non-nil for | |
| 1917 colorized mono pixmaps and for pointers.) | |
| 1918 */ | |
| 1919 (image_instance)) | |
| 1920 { | |
| 1921 CHECK_IMAGE_INSTANCE (image_instance); | |
| 442 | 1922 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
| 428 | 1923 |
| 1924 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
| 1925 { | |
| 1926 case IMAGE_MONO_PIXMAP: | |
| 1927 case IMAGE_COLOR_PIXMAP: | |
| 1928 case IMAGE_POINTER: | |
| 1929 return XIMAGE_INSTANCE_PIXMAP_FG (image_instance); | |
| 1930 | |
| 1931 case IMAGE_WIDGET: | |
| 1932 return FACE_FOREGROUND ( | |
| 1933 XIMAGE_INSTANCE_WIDGET_FACE (image_instance), | |
| 442 | 1934 XIMAGE_INSTANCE_FRAME |
| 428 | 1935 (image_instance)); |
| 1936 | |
| 1937 default: | |
| 1938 return Qnil; | |
| 1939 } | |
| 1940 } | |
| 1941 | |
| 1942 DEFUN ("image-instance-background", Fimage_instance_background, 1, 1, 0, /* | |
| 1943 Return the background color of IMAGE-INSTANCE, if applicable. | |
| 1944 This will be a color instance or nil. (It will only be non-nil for | |
| 1945 colorized mono pixmaps and for pointers.) | |
| 1946 */ | |
| 1947 (image_instance)) | |
| 1948 { | |
| 1949 CHECK_IMAGE_INSTANCE (image_instance); | |
| 442 | 1950 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
| 428 | 1951 |
| 1952 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
| 1953 { | |
| 1954 case IMAGE_MONO_PIXMAP: | |
| 1955 case IMAGE_COLOR_PIXMAP: | |
| 1956 case IMAGE_POINTER: | |
| 1957 return XIMAGE_INSTANCE_PIXMAP_BG (image_instance); | |
| 1958 | |
| 1959 case IMAGE_WIDGET: | |
| 1960 return FACE_BACKGROUND ( | |
| 1961 XIMAGE_INSTANCE_WIDGET_FACE (image_instance), | |
| 442 | 1962 XIMAGE_INSTANCE_FRAME |
| 428 | 1963 (image_instance)); |
| 1964 | |
| 1965 default: | |
| 1966 return Qnil; | |
| 1967 } | |
| 1968 } | |
| 1969 | |
| 1970 | |
| 1971 DEFUN ("colorize-image-instance", Fcolorize_image_instance, 3, 3, 0, /* | |
| 1972 Make the image instance be displayed in the given colors. | |
| 1973 This function returns a new image instance that is exactly like the | |
| 1974 specified one except that (if possible) the foreground and background | |
| 1975 colors and as specified. Currently, this only does anything if the image | |
| 1976 instance is a mono pixmap; otherwise, the same image instance is returned. | |
| 1977 */ | |
| 1978 (image_instance, foreground, background)) | |
| 1979 { | |
| 2959 | 1980 Lisp_Object new_; |
| 428 | 1981 Lisp_Object device; |
| 1982 | |
| 1983 CHECK_IMAGE_INSTANCE (image_instance); | |
| 442 | 1984 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
| 428 | 1985 CHECK_COLOR_INSTANCE (foreground); |
| 1986 CHECK_COLOR_INSTANCE (background); | |
| 1987 | |
| 442 | 1988 device = image_instance_device (image_instance); |
| 428 | 1989 if (!HAS_DEVMETH_P (XDEVICE (device), colorize_image_instance)) |
| 1990 return image_instance; | |
| 1991 | |
| 430 | 1992 /* #### There should be a copy_image_instance(), which calls a |
| 1993 device-specific method to copy the window-system subobject. */ | |
| 2959 | 1994 new_ = allocate_image_instance (XIMAGE_INSTANCE_DOMAIN (image_instance), |
| 442 | 1995 Qnil, Qnil); |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5126
diff
changeset
|
1996 copy_lisp_object (new_, image_instance); |
| 428 | 1997 /* note that if this method returns non-zero, this method MUST |
| 1998 copy any window-system resources, so that when one image instance is | |
| 1999 freed, the other one is not hosed. */ | |
| 2959 | 2000 if (!DEVMETH (XDEVICE (device), colorize_image_instance, (new_, foreground, |
| 428 | 2001 background))) |
| 2002 return image_instance; | |
| 2959 | 2003 return new_; |
| 428 | 2004 } |
| 2005 | |
| 438 | 2006 |
| 2007 /************************************************************************/ | |
| 2008 /* Geometry calculations */ | |
| 2009 /************************************************************************/ | |
| 2010 | |
| 2011 /* Find out desired geometry of the image instance. If there is no | |
| 2012 special function then just return the width and / or height. */ | |
| 2013 void | |
| 440 | 2014 image_instance_query_geometry (Lisp_Object image_instance, |
| 442 | 2015 int* width, int* height, |
| 438 | 2016 enum image_instance_geometry disp, |
| 2017 Lisp_Object domain) | |
| 2018 { | |
| 440 | 2019 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); |
| 438 | 2020 Lisp_Object type; |
| 2021 struct image_instantiator_methods* meths; | |
| 442 | 2022 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
| 438 | 2023 |
| 2024 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii)); | |
| 2025 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT); | |
| 440 | 2026 |
| 438 | 2027 if (meths && HAS_IIFORMAT_METH_P (meths, query_geometry)) |
| 2028 { | |
| 440 | 2029 IIFORMAT_METH (meths, query_geometry, (image_instance, width, height, |
| 438 | 2030 disp, domain)); |
| 2031 } | |
| 2032 else | |
| 2033 { | |
| 2034 if (width) | |
| 2035 *width = IMAGE_INSTANCE_WIDTH (ii); | |
| 2036 if (height) | |
| 2037 *height = IMAGE_INSTANCE_HEIGHT (ii); | |
| 2038 } | |
| 2039 } | |
| 2040 | |
| 2041 /* Layout the image instance using the provided dimensions. Layout | |
| 2042 widgets are going to do different kinds of calculations to | |
| 2043 determine what size to give things so we could make the layout | |
| 2044 function relatively simple to take account of that. An alternative | |
| 2045 approach is to consider separately the two cases, one where you | |
| 2046 don't mind what size you have (normal widgets) and one where you | |
| 442 | 2047 want to specify something (layout widgets). */ |
| 438 | 2048 void |
| 440 | 2049 image_instance_layout (Lisp_Object image_instance, |
| 442 | 2050 int width, int height, |
| 2051 int xoffset, int yoffset, | |
| 438 | 2052 Lisp_Object domain) |
| 2053 { | |
| 440 | 2054 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); |
| 438 | 2055 Lisp_Object type; |
| 2056 struct image_instantiator_methods* meths; | |
| 2057 | |
| 442 | 2058 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
| 2059 | |
| 2060 /* Nothing is as nothing does. */ | |
| 2061 if (NOTHING_IMAGE_INSTANCEP (image_instance)) | |
| 2062 return; | |
| 2063 | |
| 2064 /* We don't want carefully calculated offsets to be mucked up by | |
| 2065 random layouts. */ | |
| 2066 if (xoffset != IMAGE_UNCHANGED_GEOMETRY) | |
| 2067 XIMAGE_INSTANCE_XOFFSET (image_instance) = xoffset; | |
| 2068 if (yoffset != IMAGE_UNCHANGED_GEOMETRY) | |
| 2069 XIMAGE_INSTANCE_YOFFSET (image_instance) = yoffset; | |
| 2070 | |
| 2071 assert (XIMAGE_INSTANCE_YOFFSET (image_instance) >= 0 | |
| 2072 && XIMAGE_INSTANCE_XOFFSET (image_instance) >= 0); | |
| 2073 | |
| 438 | 2074 /* If geometry is unspecified then get some reasonable values for it. */ |
| 2075 if (width == IMAGE_UNSPECIFIED_GEOMETRY | |
| 2076 || | |
| 2077 height == IMAGE_UNSPECIFIED_GEOMETRY) | |
| 2078 { | |
| 442 | 2079 int dwidth = IMAGE_UNSPECIFIED_GEOMETRY; |
| 2080 int dheight = IMAGE_UNSPECIFIED_GEOMETRY; | |
| 438 | 2081 /* Get the desired geometry. */ |
| 450 | 2082 image_instance_query_geometry (image_instance, |
| 2083 &dwidth, &dheight, | |
| 2084 IMAGE_DESIRED_GEOMETRY, | |
| 2085 domain); | |
| 438 | 2086 /* Compare with allowed geometry. */ |
| 2087 if (width == IMAGE_UNSPECIFIED_GEOMETRY) | |
| 2088 width = dwidth; | |
| 2089 if (height == IMAGE_UNSPECIFIED_GEOMETRY) | |
| 2090 height = dheight; | |
| 2091 } | |
| 2092 | |
| 442 | 2093 /* If we don't have sane values then we cannot layout at this point and |
| 2094 must just return. */ | |
| 2095 if (width == IMAGE_UNSPECIFIED_GEOMETRY | |
| 2096 || | |
| 2097 height == IMAGE_UNSPECIFIED_GEOMETRY) | |
| 2098 return; | |
| 2099 | |
| 438 | 2100 /* At this point width and height should contain sane values. Thus |
| 2101 we set the glyph geometry and lay it out. */ | |
| 442 | 2102 if (IMAGE_INSTANCE_WIDTH (ii) != width |
| 2103 || | |
| 2104 IMAGE_INSTANCE_HEIGHT (ii) != height) | |
| 2105 { | |
| 2106 IMAGE_INSTANCE_SIZE_CHANGED (ii) = 1; | |
| 2107 } | |
| 2108 | |
| 438 | 2109 IMAGE_INSTANCE_WIDTH (ii) = width; |
| 2110 IMAGE_INSTANCE_HEIGHT (ii) = height; | |
| 440 | 2111 |
| 450 | 2112 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii)); |
| 2113 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT); | |
| 2114 | |
| 2115 MAYBE_IIFORMAT_METH (meths, layout, | |
| 2116 (image_instance, width, height, xoffset, yoffset, | |
| 2117 domain)); | |
| 2118 /* Do not clear the dirty flag here - redisplay will do this for | |
| 2119 us at the end. */ | |
| 2120 IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 0; | |
| 442 | 2121 } |
| 2122 | |
| 2123 /* Update an image instance from its changed instantiator. */ | |
| 2124 static void | |
| 2125 update_image_instance (Lisp_Object image_instance, | |
| 2126 Lisp_Object instantiator) | |
| 2127 { | |
| 2128 struct image_instantiator_methods* meths; | |
| 2129 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); | |
| 2130 | |
| 2131 ERROR_CHECK_IMAGE_INSTANCE (image_instance); | |
| 2132 | |
| 2133 if (NOTHING_IMAGE_INSTANCEP (image_instance)) | |
| 2134 return; | |
| 2135 | |
| 2136 assert (!internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, 0) | |
| 2137 || (internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, 0) | |
| 2138 && internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, -10))); | |
| 2139 | |
| 2140 /* If the instantiator is identical then do nothing. We must use | |
| 2141 equal here because the specifier code copies the instantiator. */ | |
| 2142 if (!internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, 0)) | |
| 438 | 2143 { |
| 442 | 2144 /* Extract the changed properties so that device / format |
| 2145 methods only have to cope with these. We assume that | |
| 2146 normalization has already been done. */ | |
| 2147 Lisp_Object diffs = find_instantiator_differences | |
| 2148 (instantiator, | |
| 2149 IMAGE_INSTANCE_INSTANTIATOR (ii)); | |
| 2150 Lisp_Object type = encode_image_instance_type | |
| 2151 (IMAGE_INSTANCE_TYPE (ii)); | |
| 2152 struct gcpro gcpro1; | |
| 2153 GCPRO1 (diffs); | |
| 2154 | |
| 2155 /* try device specific methods first ... */ | |
| 2156 meths = decode_device_ii_format (image_instance_device (image_instance), | |
| 2157 type, ERROR_ME_NOT); | |
| 2158 MAYBE_IIFORMAT_METH (meths, update, (image_instance, diffs)); | |
| 2159 /* ... then format specific methods ... */ | |
| 2160 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT); | |
| 2161 MAYBE_IIFORMAT_METH (meths, update, (image_instance, diffs)); | |
| 2162 | |
| 2163 /* Instance and therefore glyph has changed so mark as dirty. | |
| 2164 If we don't do this output optimizations will assume the | |
| 2165 glyph is unchanged. */ | |
| 2166 set_image_instance_dirty_p (image_instance, 1); | |
| 2167 /* Structure has changed. */ | |
| 2168 IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 1; | |
| 2169 | |
| 2170 UNGCPRO; | |
| 438 | 2171 } |
| 442 | 2172 /* We should now have a consistent instantiator so keep a record of |
| 2173 it. It is important that we don't actually update the window | |
| 2174 system widgets here - we must do that when redisplay tells us | |
| 2175 to. | |
| 2176 | |
| 2177 #### should we delay doing this until the display is up-to-date | |
| 2178 also? */ | |
| 2179 IMAGE_INSTANCE_INSTANTIATOR (ii) = instantiator; | |
| 440 | 2180 } |
| 2181 | |
| 2182 /* | |
| 2183 * Mark image instance in W as dirty if (a) W's faces have changed and | |
| 2184 * (b) GLYPH_OR_II instance in W is a string. | |
| 2185 * | |
| 2186 * Return non-zero if instance has been marked dirty. | |
| 2187 */ | |
| 2188 int | |
| 2189 invalidate_glyph_geometry_maybe (Lisp_Object glyph_or_ii, struct window* w) | |
| 2190 { | |
| 2191 if (XFRAME(WINDOW_FRAME(w))->faces_changed) | |
| 2192 { | |
| 2193 Lisp_Object image = glyph_or_ii; | |
| 2194 | |
| 2195 if (GLYPHP (glyph_or_ii)) | |
| 2196 { | |
| 793 | 2197 Lisp_Object window = wrap_window (w); |
| 2198 | |
| 2199 image = glyph_image_instance (glyph_or_ii, window, | |
| 2200 ERROR_ME_DEBUG_WARN, 1); | |
| 440 | 2201 } |
| 2202 | |
| 2203 if (TEXT_IMAGE_INSTANCEP (image)) | |
| 2204 { | |
| 442 | 2205 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image); |
| 2206 IMAGE_INSTANCE_DIRTYP (ii) = 1; | |
| 2207 IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 1; | |
| 440 | 2208 if (GLYPHP (glyph_or_ii)) |
| 2209 XGLYPH_DIRTYP (glyph_or_ii) = 1; | |
| 2210 return 1; | |
| 2211 } | |
| 2212 } | |
| 2213 | |
| 2214 return 0; | |
| 438 | 2215 } |
| 2216 | |
| 428 | 2217 |
| 2218 /************************************************************************/ | |
| 2219 /* error helpers */ | |
| 2220 /************************************************************************/ | |
| 2221 DOESNT_RETURN | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
2222 signal_image_error (const Ascbyte *reason, Lisp_Object frob) |
| 428 | 2223 { |
| 563 | 2224 signal_error (Qimage_conversion_error, reason, frob); |
| 428 | 2225 } |
| 2226 | |
| 2227 DOESNT_RETURN | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
2228 signal_image_error_2 (const Ascbyte *reason, Lisp_Object frob0, |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
2229 Lisp_Object frob1) |
| 428 | 2230 { |
| 563 | 2231 signal_error_2 (Qimage_conversion_error, reason, frob0, frob1); |
| 2232 } | |
| 2233 | |
| 2234 DOESNT_RETURN | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
2235 signal_double_image_error (const Ascbyte *reason1, const Ascbyte *reason2, |
| 563 | 2236 Lisp_Object data) |
| 2237 { | |
| 2238 signal_error_1 (Qimage_conversion_error, | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
2239 list3 (build_msg_string (reason1), |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
2240 build_msg_string (reason2), |
| 563 | 2241 data)); |
| 2242 } | |
| 2243 | |
| 2244 DOESNT_RETURN | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
2245 signal_double_image_error_2 (const Ascbyte *reason1, const Ascbyte *reason2, |
| 563 | 2246 Lisp_Object data1, Lisp_Object data2) |
| 2247 { | |
| 2248 signal_error_1 (Qimage_conversion_error, | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
2249 list4 (build_msg_string (reason1), |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
2250 build_msg_string (reason2), |
| 563 | 2251 data1, data2)); |
| 428 | 2252 } |
| 2253 | |
| 2254 /**************************************************************************** | |
| 2255 * nothing * | |
| 2256 ****************************************************************************/ | |
| 2257 | |
| 2258 static int | |
| 2259 nothing_possible_dest_types (void) | |
| 2260 { | |
| 2261 return IMAGE_NOTHING_MASK; | |
| 2262 } | |
| 2263 | |
| 2264 static void | |
| 2265 nothing_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, | |
| 2286 | 2266 Lisp_Object UNUSED (pointer_fg), |
| 2267 Lisp_Object UNUSED (pointer_bg), | |
| 2268 int dest_mask, Lisp_Object UNUSED (domain)) | |
| 428 | 2269 { |
| 440 | 2270 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); |
| 428 | 2271 |
| 2272 if (dest_mask & IMAGE_NOTHING_MASK) | |
| 442 | 2273 { |
| 2274 IMAGE_INSTANCE_TYPE (ii) = IMAGE_NOTHING; | |
| 2275 IMAGE_INSTANCE_HEIGHT (ii) = 0; | |
| 2276 IMAGE_INSTANCE_WIDTH (ii) = 0; | |
| 2277 } | |
| 428 | 2278 else |
| 2279 incompatible_image_types (instantiator, dest_mask, IMAGE_NOTHING_MASK); | |
| 2280 } | |
| 2281 | |
| 2282 | |
| 2283 /**************************************************************************** | |
| 2284 * inherit * | |
| 2285 ****************************************************************************/ | |
| 2286 | |
| 2287 static void | |
| 2288 inherit_validate (Lisp_Object instantiator) | |
| 2289 { | |
| 2290 face_must_be_present (instantiator); | |
| 2291 } | |
| 2292 | |
| 2293 static Lisp_Object | |
| 2286 | 2294 inherit_normalize (Lisp_Object inst, Lisp_Object UNUSED (console_type), |
| 2295 Lisp_Object UNUSED (dest_mask)) | |
| 428 | 2296 { |
| 2297 Lisp_Object face; | |
| 2298 | |
| 2299 assert (XVECTOR_LENGTH (inst) == 3); | |
| 2300 face = XVECTOR_DATA (inst)[2]; | |
| 2301 if (!FACEP (face)) | |
| 2302 inst = vector3 (Qinherit, Q_face, Fget_face (face)); | |
| 2303 return inst; | |
| 2304 } | |
| 2305 | |
| 2306 static int | |
| 2307 inherit_possible_dest_types (void) | |
| 2308 { | |
| 2309 return IMAGE_MONO_PIXMAP_MASK; | |
| 2310 } | |
| 2311 | |
| 2312 static void | |
| 2286 | 2313 inherit_instantiate (Lisp_Object UNUSED (image_instance), |
| 2314 Lisp_Object UNUSED (instantiator), | |
| 2315 Lisp_Object UNUSED (pointer_fg), | |
| 2316 Lisp_Object UNUSED (pointer_bg), | |
| 2317 int UNUSED (dest_mask), Lisp_Object UNUSED (domain)) | |
| 428 | 2318 { |
| 2319 /* handled specially in image_instantiate */ | |
| 2500 | 2320 ABORT (); |
| 428 | 2321 } |
| 2322 | |
| 2323 | |
| 2324 /**************************************************************************** | |
| 2325 * string * | |
| 2326 ****************************************************************************/ | |
| 2327 | |
| 2328 static void | |
| 2329 string_validate (Lisp_Object instantiator) | |
| 2330 { | |
| 2331 data_must_be_present (instantiator); | |
| 2332 } | |
| 2333 | |
| 2334 static int | |
| 2335 string_possible_dest_types (void) | |
| 2336 { | |
| 2337 return IMAGE_TEXT_MASK; | |
| 2338 } | |
| 2339 | |
| 438 | 2340 /* Called from autodetect_instantiate() */ |
| 428 | 2341 void |
| 2342 string_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, | |
| 2286 | 2343 Lisp_Object UNUSED (pointer_fg), |
| 2344 Lisp_Object UNUSED (pointer_bg), | |
| 428 | 2345 int dest_mask, Lisp_Object domain) |
| 2346 { | |
| 434 | 2347 Lisp_Object string = find_keyword_in_vector (instantiator, Q_data); |
| 440 | 2348 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); |
| 2349 | |
| 1411 | 2350 assert (!NILP (string)); |
| 2351 | |
| 438 | 2352 /* Should never get here with a domain other than a window. */ |
| 1411 | 2353 #ifndef NDEBUG |
| 2354 /* Work Around for an Intel Compiler 7.0 internal error */ | |
| 2355 /* assert (WINDOWP (DOMAIN_WINDOW (domain))); internal error: 0_5086 */ | |
| 2356 { | |
| 2357 Lisp_Object w = DOMAIN_WINDOW (domain); | |
| 2358 assert (WINDOWP (w)); | |
| 2359 } | |
| 2360 #endif | |
| 2361 | |
| 428 | 2362 if (dest_mask & IMAGE_TEXT_MASK) |
| 2363 { | |
| 2364 IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT; | |
| 434 | 2365 IMAGE_INSTANCE_TEXT_STRING (ii) = string; |
| 428 | 2366 } |
| 2367 else | |
| 2368 incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK); | |
| 2369 } | |
| 2370 | |
| 438 | 2371 /* Sort out the size of the text that is being displayed. Calculating |
| 2372 it dynamically allows us to change the text and still see | |
| 2373 everything. Note that the following methods are for text not string | |
| 2374 since that is what the instantiated type is. The first method is a | |
| 2375 helper that is used elsewhere for calculating text geometry. */ | |
| 2376 void | |
| 2377 query_string_geometry (Lisp_Object string, Lisp_Object face, | |
| 442 | 2378 int* width, int* height, int* descent, Lisp_Object domain) |
| 438 | 2379 { |
| 2380 struct font_metric_info fm; | |
| 2381 unsigned char charsets[NUM_LEADING_BYTES]; | |
|
4815
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2382 struct face_cachel cachel; |
|
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2383 struct face_cachel *the_cachel; |
|
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2384 Lisp_Object window = DOMAIN_WINDOW (domain); |
|
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2385 Lisp_Object frame = DOMAIN_FRAME (domain); |
| 438 | 2386 |
| 903 | 2387 CHECK_STRING (string); |
| 2388 | |
| 438 | 2389 /* Compute height */ |
| 2390 if (height) | |
| 2391 { | |
| 2392 /* Compute string metric info */ | |
| 867 | 2393 find_charsets_in_ibyte_string (charsets, |
| 438 | 2394 XSTRING_DATA (string), |
| 2395 XSTRING_LENGTH (string)); | |
| 440 | 2396 |
| 438 | 2397 /* Fallback to the default face if none was provided. */ |
| 2398 if (!NILP (face)) | |
| 2399 { | |
|
4815
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2400 reset_face_cachel (&cachel); |
|
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2401 update_face_cachel_data (&cachel, |
|
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2402 /* #### NOTE: in fact, I'm not sure if it's |
|
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2403 #### possible to *not* get a window |
|
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2404 #### here, but you never know... |
|
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2405 #### -- dvl */ |
|
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2406 NILP (window) ? frame : window, |
|
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2407 face); |
|
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2408 the_cachel = &cachel; |
| 438 | 2409 } |
| 2410 else | |
|
4815
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2411 the_cachel = WINDOW_FACE_CACHEL (DOMAIN_XWINDOW (domain), |
|
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2412 DEFAULT_INDEX); |
|
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2413 |
|
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2414 ensure_face_cachel_complete (the_cachel, domain, charsets); |
|
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2415 face_cachel_charset_font_metric_info (the_cachel, charsets, &fm); |
| 440 | 2416 |
| 438 | 2417 *height = fm.ascent + fm.descent; |
| 2418 /* #### descent only gets set if we query the height as well. */ | |
| 2419 if (descent) | |
| 2420 *descent = fm.descent; | |
| 2421 } | |
| 440 | 2422 |
| 438 | 2423 /* Compute width */ |
| 2424 if (width) | |
|
4815
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2425 *width = redisplay_text_width_string (domain, |
|
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2426 NILP (face) ? Vdefault_face : face, |
|
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2427 0, string, 0, -1); |
| 438 | 2428 } |
| 2429 | |
| 2430 Lisp_Object | |
| 2431 query_string_font (Lisp_Object string, Lisp_Object face, Lisp_Object domain) | |
| 2432 { | |
| 2433 unsigned char charsets[NUM_LEADING_BYTES]; | |
|
4816
576f09d387d5
Fix query_string_font lookup domains
Didier Verna <didier@lrde.epita.fr>
parents:
4815
diff
changeset
|
2434 struct face_cachel cachel; |
| 438 | 2435 int i; |
|
4816
576f09d387d5
Fix query_string_font lookup domains
Didier Verna <didier@lrde.epita.fr>
parents:
4815
diff
changeset
|
2436 Lisp_Object window = DOMAIN_WINDOW (domain); |
|
576f09d387d5
Fix query_string_font lookup domains
Didier Verna <didier@lrde.epita.fr>
parents:
4815
diff
changeset
|
2437 Lisp_Object frame = DOMAIN_FRAME (domain); |
| 438 | 2438 |
| 2439 /* Compute string font info */ | |
| 867 | 2440 find_charsets_in_ibyte_string (charsets, |
|
4816
576f09d387d5
Fix query_string_font lookup domains
Didier Verna <didier@lrde.epita.fr>
parents:
4815
diff
changeset
|
2441 XSTRING_DATA (string), |
|
576f09d387d5
Fix query_string_font lookup domains
Didier Verna <didier@lrde.epita.fr>
parents:
4815
diff
changeset
|
2442 XSTRING_LENGTH (string)); |
|
576f09d387d5
Fix query_string_font lookup domains
Didier Verna <didier@lrde.epita.fr>
parents:
4815
diff
changeset
|
2443 |
|
576f09d387d5
Fix query_string_font lookup domains
Didier Verna <didier@lrde.epita.fr>
parents:
4815
diff
changeset
|
2444 reset_face_cachel (&cachel); |
|
576f09d387d5
Fix query_string_font lookup domains
Didier Verna <didier@lrde.epita.fr>
parents:
4815
diff
changeset
|
2445 update_face_cachel_data (&cachel, NILP (window) ? frame : window, face); |
|
576f09d387d5
Fix query_string_font lookup domains
Didier Verna <didier@lrde.epita.fr>
parents:
4815
diff
changeset
|
2446 ensure_face_cachel_complete (&cachel, domain, charsets); |
| 440 | 2447 |
| 438 | 2448 for (i = 0; i < NUM_LEADING_BYTES; i++) |
|
4816
576f09d387d5
Fix query_string_font lookup domains
Didier Verna <didier@lrde.epita.fr>
parents:
4815
diff
changeset
|
2449 if (charsets[i]) |
|
576f09d387d5
Fix query_string_font lookup domains
Didier Verna <didier@lrde.epita.fr>
parents:
4815
diff
changeset
|
2450 return FACE_CACHEL_FONT |
|
576f09d387d5
Fix query_string_font lookup domains
Didier Verna <didier@lrde.epita.fr>
parents:
4815
diff
changeset
|
2451 ((&cachel), charset_by_leading_byte (i + MIN_LEADING_BYTE)); |
| 438 | 2452 |
| 2453 return Qnil; /* NOT REACHED */ | |
| 2454 } | |
| 2455 | |
| 2456 static void | |
| 2457 text_query_geometry (Lisp_Object image_instance, | |
| 442 | 2458 int* width, int* height, |
| 2286 | 2459 enum image_instance_geometry UNUSED (disp), |
| 2460 Lisp_Object domain) | |
| 438 | 2461 { |
| 440 | 2462 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); |
| 442 | 2463 int descent = 0; |
| 438 | 2464 |
| 2465 query_string_geometry (IMAGE_INSTANCE_TEXT_STRING (ii), | |
| 2466 IMAGE_INSTANCE_FACE (ii), | |
| 2467 width, height, &descent, domain); | |
| 2468 | |
| 2469 /* The descent gets set as a side effect of querying the | |
| 2470 geometry. */ | |
| 2471 IMAGE_INSTANCE_TEXT_DESCENT (ii) = descent; | |
| 2472 } | |
| 2473 | |
| 428 | 2474 /* set the properties of a string */ |
| 442 | 2475 static void |
| 2476 text_update (Lisp_Object image_instance, Lisp_Object instantiator) | |
| 2477 { | |
| 2478 Lisp_Object val = find_keyword_in_vector (instantiator, Q_data); | |
| 2479 | |
| 2480 if (!NILP (val)) | |
| 428 | 2481 { |
| 2482 CHECK_STRING (val); | |
| 442 | 2483 XIMAGE_INSTANCE_TEXT_STRING (image_instance) = val; |
| 428 | 2484 } |
| 2485 } | |
| 2486 | |
| 2487 | |
| 2488 /**************************************************************************** | |
| 2489 * formatted-string * | |
| 2490 ****************************************************************************/ | |
| 2491 | |
| 2492 static void | |
| 2493 formatted_string_validate (Lisp_Object instantiator) | |
| 2494 { | |
| 2495 data_must_be_present (instantiator); | |
| 2496 } | |
| 2497 | |
| 2498 static int | |
| 2499 formatted_string_possible_dest_types (void) | |
| 2500 { | |
| 2501 return IMAGE_TEXT_MASK; | |
| 2502 } | |
| 2503 | |
| 2504 static void | |
| 2505 formatted_string_instantiate (Lisp_Object image_instance, | |
| 2506 Lisp_Object instantiator, | |
| 2507 Lisp_Object pointer_fg, Lisp_Object pointer_bg, | |
| 2508 int dest_mask, Lisp_Object domain) | |
| 2509 { | |
| 2510 /* #### implement this */ | |
| 2511 warn_when_safe (Qunimplemented, Qnotice, | |
| 2512 "`formatted-string' not yet implemented; assuming `string'"); | |
| 438 | 2513 |
| 440 | 2514 string_instantiate (image_instance, instantiator, |
| 438 | 2515 pointer_fg, pointer_bg, dest_mask, domain); |
| 428 | 2516 } |
| 2517 | |
| 2518 | |
| 2519 /************************************************************************/ | |
| 2520 /* pixmap file functions */ | |
| 2521 /************************************************************************/ | |
| 2522 | |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2523 /* - If INSTANTIATOR refers to inline data, or there is no file keyword, we |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2524 have nothing to do, so return Qt. |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2525 - If INSTANTIATOR refers to data in a file, return the full filename |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2526 if it exists; otherwise, return '(filename), meaning "file not found". |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2527 - If there is no locate_pixmap_file method for this console, return Qnil. |
| 428 | 2528 |
| 2529 FILE_KEYWORD and DATA_KEYWORD are symbols specifying the | |
| 2530 keywords used to look up the file and inline data, | |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2531 respectively, in the instantiator. These would be Q_file and Q_data, |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2532 Q_mask_file or Q_mask_data. */ |
| 428 | 2533 |
| 2534 Lisp_Object | |
| 2535 potential_pixmap_file_instantiator (Lisp_Object instantiator, | |
| 2536 Lisp_Object file_keyword, | |
| 2537 Lisp_Object data_keyword, | |
| 2538 Lisp_Object console_type) | |
| 2539 { | |
| 2540 Lisp_Object file; | |
| 2541 Lisp_Object data; | |
| 2542 | |
| 2543 assert (VECTORP (instantiator)); | |
| 2544 | |
| 2545 data = find_keyword_in_vector (instantiator, data_keyword); | |
| 2546 file = find_keyword_in_vector (instantiator, file_keyword); | |
| 2547 | |
| 2548 if (!NILP (file) && NILP (data)) | |
| 2549 { | |
| 4226 | 2550 struct console_methods *meths |
| 4252 | 2551 = decode_console_type(console_type, ERROR_ME); |
| 4226 | 2552 |
| 2553 if (HAS_CONTYPE_METH_P (meths, locate_pixmap_file)) | |
| 4252 | 2554 { |
| 2555 Lisp_Object retval | |
| 2556 = CONTYPE_METH (meths, locate_pixmap_file, (file)); | |
| 2557 | |
| 2558 if (!NILP (retval)) | |
| 2559 return retval; | |
| 2560 else | |
| 2561 return Fcons (file, Qnil); /* should have been file */ | |
| 2562 } | |
| 2563 else /* method unavailable */ | |
| 2564 return Qnil; | |
| 428 | 2565 } |
| 2566 | |
| 4226 | 2567 return Qt; |
| 2568 } | |
| 2569 | |
| 428 | 2570 Lisp_Object |
| 2571 simple_image_type_normalize (Lisp_Object inst, Lisp_Object console_type, | |
| 2572 Lisp_Object image_type_tag) | |
| 2573 { | |
| 2574 /* This function can call lisp */ | |
| 2575 Lisp_Object file = Qnil; | |
| 2576 struct gcpro gcpro1, gcpro2; | |
| 2577 Lisp_Object alist = Qnil; | |
| 2578 | |
| 2579 GCPRO2 (file, alist); | |
| 2580 | |
| 2581 /* Now, convert any file data into inline data. At the end of this, | |
| 2582 `data' will contain the inline data (if any) or Qnil, and `file' | |
| 2583 will contain the name this data was derived from (if known) or | |
| 2584 Qnil. | |
| 2585 | |
| 2586 Note that if we cannot generate any regular inline data, we | |
| 2587 skip out. */ | |
| 2588 | |
| 2589 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data, | |
| 2590 console_type); | |
| 2591 | |
| 4226 | 2592 if (NILP (file)) /* normalization impossible for the console type */ |
| 2593 RETURN_UNGCPRO (Qnil); | |
| 2594 | |
| 428 | 2595 if (CONSP (file)) /* failure locating filename */ |
| 563 | 2596 signal_double_image_error ("Opening pixmap file", |
| 2597 "no such file or directory", | |
| 2598 Fcar (file)); | |
| 428 | 2599 |
| 4226 | 2600 if (EQ (file, Qt)) /* no conversion necessary */ |
| 428 | 2601 RETURN_UNGCPRO (inst); |
| 2602 | |
| 2603 alist = tagged_vector_to_alist (inst); | |
| 2604 | |
| 2605 { | |
| 2606 Lisp_Object data = make_string_from_file (file); | |
| 2607 alist = remassq_no_quit (Q_file, alist); | |
| 2608 /* there can't be a :data at this point. */ | |
| 2609 alist = Fcons (Fcons (Q_file, file), | |
| 2610 Fcons (Fcons (Q_data, data), alist)); | |
| 2611 } | |
| 2612 | |
| 2613 { | |
| 2614 Lisp_Object result = alist_to_tagged_vector (image_type_tag, alist); | |
| 2615 free_alist (alist); | |
| 2616 RETURN_UNGCPRO (result); | |
| 2617 } | |
| 2618 } | |
| 2619 | |
| 2620 | |
| 2621 #ifdef HAVE_WINDOW_SYSTEM | |
| 2622 /********************************************************************** | |
| 2623 * XBM * | |
| 2624 **********************************************************************/ | |
| 2625 | |
| 2626 /* Check if DATA represents a valid inline XBM spec (i.e. a list | |
| 2627 of (width height bits), with checking done on the dimensions). | |
| 2628 If not, signal an error. */ | |
| 2629 | |
| 2630 static void | |
| 2631 check_valid_xbm_inline (Lisp_Object data) | |
| 2632 { | |
|
5307
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5223
diff
changeset
|
2633 Lisp_Object width, height, bits, args[2]; |
| 428 | 2634 |
| 2635 if (!CONSP (data) || | |
| 2636 !CONSP (XCDR (data)) || | |
| 2637 !CONSP (XCDR (XCDR (data))) || | |
| 2638 !NILP (XCDR (XCDR (XCDR (data))))) | |
| 563 | 2639 sferror ("Must be list of 3 elements", data); |
| 428 | 2640 |
| 2641 width = XCAR (data); | |
| 2642 height = XCAR (XCDR (data)); | |
| 2643 bits = XCAR (XCDR (XCDR (data))); | |
| 2644 | |
| 2645 CHECK_STRING (bits); | |
| 2646 | |
| 2647 if (!NATNUMP (width)) | |
| 563 | 2648 invalid_argument ("Width must be a natural number", width); |
| 428 | 2649 |
| 2650 if (!NATNUMP (height)) | |
| 563 | 2651 invalid_argument ("Height must be a natural number", height); |
| 428 | 2652 |
|
5307
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5223
diff
changeset
|
2653 args[0] = width; |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5223
diff
changeset
|
2654 args[1] = height; |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5223
diff
changeset
|
2655 |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5223
diff
changeset
|
2656 args[0] = Ftimes (countof (args), args); |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5223
diff
changeset
|
2657 args[1] = make_integer (8); |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5223
diff
changeset
|
2658 |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5223
diff
changeset
|
2659 args[0] = Fquo (countof (args), args); |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5223
diff
changeset
|
2660 args[1] = make_integer (string_char_length (bits)); |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5223
diff
changeset
|
2661 |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5223
diff
changeset
|
2662 if (!NILP (Fgtr (countof (args), args))) |
| 563 | 2663 invalid_argument ("data is too short for width and height", |
| 428 | 2664 vector3 (width, height, bits)); |
| 2665 } | |
| 2666 | |
| 2667 /* Validate method for XBM's. */ | |
| 2668 | |
| 2669 static void | |
| 2670 xbm_validate (Lisp_Object instantiator) | |
| 2671 { | |
| 2672 file_or_data_must_be_present (instantiator); | |
| 2673 } | |
| 2674 | |
| 2675 /* Given a filename that is supposed to contain XBM data, return | |
| 2676 the inline representation of it as (width height bits). Return | |
| 2677 the hotspot through XHOT and YHOT, if those pointers are not 0. | |
| 2678 If there is no hotspot, XHOT and YHOT will contain -1. | |
| 2679 | |
| 2680 If the function fails: | |
| 2681 | |
| 2682 -- if OK_IF_DATA_INVALID is set and the data was invalid, | |
| 2683 return Qt. | |
| 2684 -- maybe return an error, or return Qnil. | |
| 2685 */ | |
| 2686 | |
| 2687 #ifdef HAVE_X_WINDOWS | |
| 2688 #include <X11/Xlib.h> | |
| 2689 #else | |
| 2690 #define XFree(data) free(data) | |
| 2691 #endif | |
| 2692 | |
| 2693 Lisp_Object | |
| 2694 bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot, | |
| 2695 int ok_if_data_invalid) | |
| 2696 { | |
| 647 | 2697 int w, h; |
| 2367 | 2698 Binbyte *data; |
| 428 | 2699 int result; |
| 771 | 2700 |
| 2701 result = read_bitmap_data_from_file (name, &w, &h, &data, xhot, yhot); | |
| 428 | 2702 |
| 2703 if (result == BitmapSuccess) | |
| 2704 { | |
| 2705 Lisp_Object retval; | |
| 2706 int len = (w + 7) / 8 * h; | |
| 2707 | |
| 2708 retval = list3 (make_int (w), make_int (h), | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2709 make_extstring ((Extbyte *) data, len, Qbinary)); |
| 444 | 2710 XFree (data); |
| 428 | 2711 return retval; |
| 2712 } | |
| 2713 | |
| 2714 switch (result) | |
| 2715 { | |
| 2716 case BitmapOpenFailed: | |
| 2717 { | |
| 2718 /* should never happen */ | |
| 563 | 2719 signal_double_image_error ("Opening bitmap file", |
| 2720 "no such file or directory", | |
| 2721 name); | |
| 428 | 2722 } |
| 2723 case BitmapFileInvalid: | |
| 2724 { | |
| 2725 if (ok_if_data_invalid) | |
| 2726 return Qt; | |
| 563 | 2727 signal_double_image_error ("Reading bitmap file", |
| 2728 "invalid data in file", | |
| 2729 name); | |
| 428 | 2730 } |
| 2731 case BitmapNoMemory: | |
| 2732 { | |
| 563 | 2733 signal_double_image_error ("Reading bitmap file", |
| 2734 "out of memory", | |
| 2735 name); | |
| 428 | 2736 } |
| 2737 default: | |
| 2738 { | |
| 563 | 2739 signal_double_image_error_2 ("Reading bitmap file", |
| 2740 "unknown error code", | |
| 2741 make_int (result), name); | |
| 428 | 2742 } |
| 2743 } | |
| 2744 | |
| 2745 return Qnil; /* not reached */ | |
| 2746 } | |
| 2747 | |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2748 /* This function attempts to find implicit mask files by appending "Mask" or |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2749 "msk" to the original bitmap file name. This is more or less standard: a |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2750 number of bitmaps in /usr/include/X11/bitmaps use it. */ |
| 428 | 2751 Lisp_Object |
| 2752 xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file, | |
| 2753 Lisp_Object mask_file, Lisp_Object console_type) | |
| 2754 { | |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2755 /* Let's try to find an implicit mask file if we have neither an explicit |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2756 mask file name, nor inline mask data. Note that no errors are reported in |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2757 case of failure because the mask file we're looking for might not |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2758 exist. */ |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2759 if (EQ (mask_file, Qt) && NILP (assq_no_quit (Q_mask_data, alist))) |
| 428 | 2760 { |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2761 assert (!EQ (file, Qt) && !EQ (file, Qnil)); |
| 428 | 2762 mask_file = MAYBE_LISP_CONTYPE_METH |
| 2763 (decode_console_type(console_type, ERROR_ME), | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
2764 locate_pixmap_file, (concat2 (file, build_ascstring ("Mask")))); |
| 428 | 2765 if (NILP (mask_file)) |
| 2766 mask_file = MAYBE_LISP_CONTYPE_METH | |
| 2767 (decode_console_type(console_type, ERROR_ME), | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
2768 locate_pixmap_file, (concat2 (file, build_ascstring ("msk")))); |
| 428 | 2769 } |
| 2770 | |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2771 /* We got a mask file, either explicitely or from the search above. */ |
| 428 | 2772 if (!NILP (mask_file)) |
| 2773 { | |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2774 Lisp_Object mask_data; |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2775 |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2776 assert (!EQ (mask_file, Qt)); |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2777 |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2778 mask_data = bitmap_to_lisp_data (mask_file, 0, 0, 0); |
| 428 | 2779 alist = remassq_no_quit (Q_mask_file, alist); |
| 2780 /* there can't be a :mask-data at this point. */ | |
| 2781 alist = Fcons (Fcons (Q_mask_file, mask_file), | |
| 2782 Fcons (Fcons (Q_mask_data, mask_data), alist)); | |
| 2783 } | |
| 2784 | |
| 2785 return alist; | |
| 2786 } | |
| 2787 | |
| 2788 /* Normalize method for XBM's. */ | |
| 2789 | |
| 2790 static Lisp_Object | |
| 442 | 2791 xbm_normalize (Lisp_Object inst, Lisp_Object console_type, |
| 2286 | 2792 Lisp_Object UNUSED (dest_mask)) |
| 428 | 2793 { |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2794 Lisp_Object file = Qnil, mask_file = Qnil, alist = Qnil; |
| 428 | 2795 struct gcpro gcpro1, gcpro2, gcpro3; |
| 2796 | |
| 2797 GCPRO3 (file, mask_file, alist); | |
| 2798 | |
| 2799 /* Now, convert any file data into inline data for both the regular | |
| 2800 data and the mask data. At the end of this, `data' will contain | |
| 2801 the inline data (if any) or Qnil, and `file' will contain | |
| 2802 the name this data was derived from (if known) or Qnil. | |
| 2803 Likewise for `mask_file' and `mask_data'. | |
| 2804 | |
| 2805 Note that if we cannot generate any regular inline data, we | |
| 2806 skip out. */ | |
| 2807 | |
| 2808 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data, | |
| 2809 console_type); | |
| 2810 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file, | |
| 2811 Q_mask_data, console_type); | |
| 2812 | |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2813 /* No locate_pixmap_file method for this console type, so we can't get a |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2814 file (neither a mask file BTW). */ |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2815 if (NILP (file)) |
| 4226 | 2816 RETURN_UNGCPRO (Qnil); |
| 2817 | |
| 428 | 2818 if (CONSP (file)) /* failure locating filename */ |
| 563 | 2819 signal_double_image_error ("Opening bitmap file", |
| 2820 "no such file or directory", | |
| 2821 Fcar (file)); | |
| 428 | 2822 |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2823 if (CONSP (mask_file)) /* failure locating filename */ |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2824 signal_double_image_error ("Opening bitmap mask file", |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2825 "no such file or directory", |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2826 Fcar (mask_file)); |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2827 |
| 4226 | 2828 if (EQ (file, Qt) && EQ (mask_file, Qt)) /* no conversion necessary */ |
| 428 | 2829 RETURN_UNGCPRO (inst); |
| 2830 | |
| 2831 alist = tagged_vector_to_alist (inst); | |
| 2832 | |
| 4226 | 2833 if (!EQ (file, Qt)) |
| 428 | 2834 { |
| 2835 int xhot, yhot; | |
| 2836 Lisp_Object data = bitmap_to_lisp_data (file, &xhot, &yhot, 0); | |
| 2837 alist = remassq_no_quit (Q_file, alist); | |
| 2838 /* there can't be a :data at this point. */ | |
| 2839 alist = Fcons (Fcons (Q_file, file), | |
| 2840 Fcons (Fcons (Q_data, data), alist)); | |
| 2841 | |
| 2842 if (xhot != -1 && NILP (assq_no_quit (Q_hotspot_x, alist))) | |
| 2843 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)), | |
| 2844 alist); | |
| 2845 if (yhot != -1 && NILP (assq_no_quit (Q_hotspot_y, alist))) | |
| 2846 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)), | |
| 2847 alist); | |
| 2848 } | |
| 2849 | |
| 2850 alist = xbm_mask_file_munging (alist, file, mask_file, console_type); | |
| 2851 | |
| 2852 { | |
| 2853 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist); | |
| 2854 free_alist (alist); | |
| 2855 RETURN_UNGCPRO (result); | |
| 2856 } | |
| 2857 } | |
| 2858 | |
| 2859 | |
| 2860 static int | |
| 2861 xbm_possible_dest_types (void) | |
| 2862 { | |
| 2863 return | |
| 2864 IMAGE_MONO_PIXMAP_MASK | | |
| 2865 IMAGE_COLOR_PIXMAP_MASK | | |
| 2866 IMAGE_POINTER_MASK; | |
| 2867 } | |
| 2868 | |
| 2869 #endif | |
| 2870 | |
| 2871 | |
| 2872 #ifdef HAVE_XFACE | |
| 2873 /********************************************************************** | |
| 2874 * X-Face * | |
| 2875 **********************************************************************/ | |
| 2876 | |
| 2877 static void | |
| 2878 xface_validate (Lisp_Object instantiator) | |
| 2879 { | |
| 2880 file_or_data_must_be_present (instantiator); | |
| 2881 } | |
| 2882 | |
| 2883 static Lisp_Object | |
| 442 | 2884 xface_normalize (Lisp_Object inst, Lisp_Object console_type, |
| 2286 | 2885 Lisp_Object UNUSED (dest_mask)) |
| 428 | 2886 { |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2887 Lisp_Object file = Qnil, mask_file = Qnil, alist = Qnil; |
| 428 | 2888 struct gcpro gcpro1, gcpro2, gcpro3; |
| 2889 | |
| 2890 GCPRO3 (file, mask_file, alist); | |
| 2891 | |
| 2892 /* Now, convert any file data into inline data for both the regular | |
| 2893 data and the mask data. At the end of this, `data' will contain | |
| 2894 the inline data (if any) or Qnil, and `file' will contain | |
| 2895 the name this data was derived from (if known) or Qnil. | |
| 2896 Likewise for `mask_file' and `mask_data'. | |
| 2897 | |
| 2898 Note that if we cannot generate any regular inline data, we | |
| 2899 skip out. */ | |
| 2900 | |
| 2901 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data, | |
| 2902 console_type); | |
| 2903 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file, | |
| 2904 Q_mask_data, console_type); | |
| 2905 | |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2906 /* No locate_pixmap_file method for this console type, so we can't get a |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2907 file (neither a mask file BTW). */ |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2908 if (NILP (file)) |
| 4226 | 2909 RETURN_UNGCPRO (Qnil); |
| 2910 | |
| 428 | 2911 if (CONSP (file)) /* failure locating filename */ |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2912 signal_double_image_error ("Opening face file", |
| 563 | 2913 "no such file or directory", |
| 2914 Fcar (file)); | |
| 428 | 2915 |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2916 if (CONSP (mask_file)) /* failure locating filename */ |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2917 signal_double_image_error ("Opening face mask file", |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2918 "no such file or directory", |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2919 Fcar (mask_file)); |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2920 |
| 4226 | 2921 if (EQ (file, Qt) && EQ (mask_file, Qt)) /* no conversion necessary */ |
| 428 | 2922 RETURN_UNGCPRO (inst); |
| 2923 | |
| 2924 alist = tagged_vector_to_alist (inst); | |
| 2925 | |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2926 if (!EQ (file, Qt)) |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2927 { |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2928 Lisp_Object data = make_string_from_file (file); |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2929 alist = remassq_no_quit (Q_file, alist); |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2930 /* there can't be a :data at this point. */ |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2931 alist = Fcons (Fcons (Q_file, file), |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2932 Fcons (Fcons (Q_data, data), alist)); |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2933 } |
| 428 | 2934 |
| 2935 alist = xbm_mask_file_munging (alist, file, mask_file, console_type); | |
| 2936 | |
| 2937 { | |
| 2938 Lisp_Object result = alist_to_tagged_vector (Qxface, alist); | |
| 2939 free_alist (alist); | |
| 2940 RETURN_UNGCPRO (result); | |
| 2941 } | |
| 2942 } | |
| 2943 | |
| 2944 static int | |
| 2945 xface_possible_dest_types (void) | |
| 2946 { | |
| 2947 return | |
| 2948 IMAGE_MONO_PIXMAP_MASK | | |
| 2949 IMAGE_COLOR_PIXMAP_MASK | | |
| 2950 IMAGE_POINTER_MASK; | |
| 2951 } | |
| 2952 | |
| 2953 #endif /* HAVE_XFACE */ | |
| 2954 | |
| 2955 | |
| 2956 #ifdef HAVE_XPM | |
| 2957 | |
| 2958 /********************************************************************** | |
| 2959 * XPM * | |
| 2960 **********************************************************************/ | |
| 2961 | |
| 462 | 2962 #ifdef HAVE_GTK |
| 2963 /* Gtk has to be gratuitously different, eh? */ | |
| 2964 Lisp_Object | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4906
diff
changeset
|
2965 pixmap_to_lisp_data (Lisp_Object name, int UNUSED (ok_if_data_invalid)) |
| 462 | 2966 { |
| 2967 return (make_string_from_file (name)); | |
| 2968 } | |
| 2969 #else | |
| 428 | 2970 Lisp_Object |
| 2971 pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid) | |
| 2972 { | |
| 2526 | 2973 Ascbyte **data; |
| 428 | 2974 int result; |
| 2526 | 2975 Extbyte *fname = 0; |
| 2976 Ibyte *resolved; | |
| 2977 | |
| 2978 LISP_PATHNAME_RESOLVE_LINKS (name, resolved); | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4968
diff
changeset
|
2979 fname = ITEXT_TO_EXTERNAL (resolved, Qfile_name); |
| 428 | 2980 result = XpmReadFileToData (fname, &data); |
| 2981 | |
| 2982 if (result == XpmSuccess) | |
| 2983 { | |
| 2984 Lisp_Object retval = Qnil; | |
| 2985 struct buffer *old_buffer = current_buffer; | |
| 2986 Lisp_Object temp_buffer = | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
2987 Fget_buffer_create (build_ascstring (" *pixmap conversion*")); |
| 428 | 2988 int elt; |
| 2989 int height, width, ncolors; | |
| 2990 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 2991 int speccount = specpdl_depth (); | |
| 2992 | |
| 2993 GCPRO3 (name, retval, temp_buffer); | |
| 2994 | |
| 2995 specbind (Qinhibit_quit, Qt); | |
| 2996 set_buffer_internal (XBUFFER (temp_buffer)); | |
| 2997 Ferase_buffer (Qnil); | |
| 2998 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2999 buffer_insert_ascstring (current_buffer, "/* XPM */\r"); |
|
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
3000 buffer_insert_ascstring (current_buffer, "static char *pixmap[] = {\r"); |
| 428 | 3001 |
| 3002 sscanf (data[0], "%d %d %d", &height, &width, &ncolors); | |
| 3003 for (elt = 0; elt <= width + ncolors; elt++) | |
| 3004 { | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
3005 buffer_insert_ascstring (current_buffer, "\""); |
|
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
3006 buffer_insert_ascstring (current_buffer, data[elt]); |
| 428 | 3007 |
| 3008 if (elt < width + ncolors) | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
3009 buffer_insert_ascstring (current_buffer, "\",\r"); |
| 428 | 3010 else |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
3011 buffer_insert_ascstring (current_buffer, "\"};\r"); |
| 428 | 3012 } |
| 3013 | |
| 3014 retval = Fbuffer_substring (Qnil, Qnil, Qnil); | |
| 3015 XpmFree (data); | |
| 3016 | |
| 3017 set_buffer_internal (old_buffer); | |
| 771 | 3018 unbind_to (speccount); |
| 428 | 3019 |
| 3020 RETURN_UNGCPRO (retval); | |
| 3021 } | |
| 3022 | |
| 3023 switch (result) | |
| 3024 { | |
| 3025 case XpmFileInvalid: | |
| 3026 { | |
| 3027 if (ok_if_data_invalid) | |
| 3028 return Qt; | |
| 3029 signal_image_error ("invalid XPM data in file", name); | |
| 3030 } | |
| 3031 case XpmNoMemory: | |
| 3032 { | |
| 563 | 3033 signal_double_image_error ("Reading pixmap file", |
| 3034 "out of memory", name); | |
| 428 | 3035 } |
| 3036 case XpmOpenFailed: | |
| 3037 { | |
| 3038 /* should never happen? */ | |
| 563 | 3039 signal_double_image_error ("Opening pixmap file", |
| 3040 "no such file or directory", name); | |
| 428 | 3041 } |
| 3042 default: | |
| 3043 { | |
| 563 | 3044 signal_double_image_error_2 ("Parsing pixmap file", |
| 3045 "unknown error code", | |
| 3046 make_int (result), name); | |
| 428 | 3047 break; |
| 3048 } | |
| 3049 } | |
| 3050 | |
| 3051 return Qnil; /* not reached */ | |
| 3052 } | |
| 462 | 3053 #endif /* !HAVE_GTK */ |
| 428 | 3054 |
| 3055 static void | |
| 3056 check_valid_xpm_color_symbols (Lisp_Object data) | |
| 3057 { | |
| 3058 Lisp_Object rest; | |
| 3059 | |
| 3060 for (rest = data; !NILP (rest); rest = XCDR (rest)) | |
| 3061 { | |
| 3062 if (!CONSP (rest) || | |
| 3063 !CONSP (XCAR (rest)) || | |
| 3064 !STRINGP (XCAR (XCAR (rest))) || | |
| 3065 (!STRINGP (XCDR (XCAR (rest))) && | |
| 3066 !COLOR_SPECIFIERP (XCDR (XCAR (rest))))) | |
| 563 | 3067 sferror ("Invalid color symbol alist", data); |
| 428 | 3068 } |
| 3069 } | |
| 3070 | |
| 3071 static void | |
| 3072 xpm_validate (Lisp_Object instantiator) | |
| 3073 { | |
| 3074 file_or_data_must_be_present (instantiator); | |
| 3075 } | |
| 3076 | |
| 3077 Lisp_Object Vxpm_color_symbols; | |
| 3078 | |
| 3079 Lisp_Object | |
| 3080 evaluate_xpm_color_symbols (void) | |
| 3081 { | |
| 3082 Lisp_Object rest, results = Qnil; | |
| 3083 struct gcpro gcpro1, gcpro2; | |
| 3084 | |
| 3085 GCPRO2 (rest, results); | |
| 3086 for (rest = Vxpm_color_symbols; !NILP (rest); rest = XCDR (rest)) | |
| 3087 { | |
| 3088 Lisp_Object name, value, cons; | |
| 3089 | |
| 3090 CHECK_CONS (rest); | |
| 3091 cons = XCAR (rest); | |
| 3092 CHECK_CONS (cons); | |
| 3093 name = XCAR (cons); | |
| 3094 CHECK_STRING (name); | |
| 3095 value = XCDR (cons); | |
| 3096 CHECK_CONS (value); | |
| 3097 value = XCAR (value); | |
|
4677
8f1ee2d15784
Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4426
diff
changeset
|
3098 value = IGNORE_MULTIPLE_VALUES (Feval (value)); |
| 428 | 3099 if (NILP (value)) |
| 3100 continue; | |
| 3101 if (!STRINGP (value) && !COLOR_SPECIFIERP (value)) | |
| 563 | 3102 invalid_argument |
| 428 | 3103 ("Result from xpm-color-symbols eval must be nil, string, or color", |
| 3104 value); | |
| 3105 results = Fcons (Fcons (name, value), results); | |
| 3106 } | |
| 3107 UNGCPRO; /* no more evaluation */ | |
| 3108 return results; | |
| 3109 } | |
| 3110 | |
| 3111 static Lisp_Object | |
| 442 | 3112 xpm_normalize (Lisp_Object inst, Lisp_Object console_type, |
| 2286 | 3113 Lisp_Object UNUSED (dest_mask)) |
| 428 | 3114 { |
| 3115 Lisp_Object file = Qnil; | |
| 3116 Lisp_Object color_symbols; | |
| 3117 struct gcpro gcpro1, gcpro2; | |
| 3118 Lisp_Object alist = Qnil; | |
| 3119 | |
| 3120 GCPRO2 (file, alist); | |
| 3121 | |
| 3122 /* Now, convert any file data into inline data. At the end of this, | |
| 3123 `data' will contain the inline data (if any) or Qnil, and | |
| 3124 `file' will contain the name this data was derived from (if | |
| 3125 known) or Qnil. | |
| 3126 | |
| 3127 Note that if we cannot generate any regular inline data, we | |
| 3128 skip out. */ | |
| 3129 | |
| 3130 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data, | |
| 3131 console_type); | |
| 3132 | |
| 4226 | 3133 if (NILP (file)) /* normalization impossible for the console type */ |
| 3134 RETURN_UNGCPRO (Qnil); | |
| 3135 | |
| 428 | 3136 if (CONSP (file)) /* failure locating filename */ |
| 563 | 3137 signal_double_image_error ("Opening pixmap file", |
| 3138 "no such file or directory", | |
| 3139 Fcar (file)); | |
| 428 | 3140 |
| 3141 color_symbols = find_keyword_in_vector_or_given (inst, Q_color_symbols, | |
| 3142 Qunbound); | |
| 3143 | |
| 4226 | 3144 if (EQ (file, Qt) && !UNBOUNDP (color_symbols)) |
| 428 | 3145 /* no conversion necessary */ |
| 3146 RETURN_UNGCPRO (inst); | |
| 3147 | |
| 3148 alist = tagged_vector_to_alist (inst); | |
| 3149 | |
| 4226 | 3150 if (!NILP (file) && !EQ (file, Qt)) |
| 428 | 3151 { |
| 3152 Lisp_Object data = pixmap_to_lisp_data (file, 0); | |
| 3153 alist = remassq_no_quit (Q_file, alist); | |
| 3154 /* there can't be a :data at this point. */ | |
| 3155 alist = Fcons (Fcons (Q_file, file), | |
| 3156 Fcons (Fcons (Q_data, data), alist)); | |
| 3157 } | |
| 3158 | |
| 3159 if (UNBOUNDP (color_symbols)) | |
| 3160 { | |
| 3161 color_symbols = evaluate_xpm_color_symbols (); | |
| 3162 alist = Fcons (Fcons (Q_color_symbols, color_symbols), | |
| 3163 alist); | |
| 3164 } | |
| 3165 | |
| 3166 { | |
| 3167 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist); | |
| 3168 free_alist (alist); | |
| 3169 RETURN_UNGCPRO (result); | |
| 3170 } | |
| 3171 } | |
| 3172 | |
| 3173 static int | |
| 3174 xpm_possible_dest_types (void) | |
| 3175 { | |
| 3176 return | |
| 3177 IMAGE_MONO_PIXMAP_MASK | | |
| 3178 IMAGE_COLOR_PIXMAP_MASK | | |
| 3179 IMAGE_POINTER_MASK; | |
| 3180 } | |
| 3181 | |
| 3182 #endif /* HAVE_XPM */ | |
| 3183 | |
| 3184 | |
| 3185 /**************************************************************************** | |
| 3186 * Image Specifier Object * | |
| 3187 ****************************************************************************/ | |
| 3188 | |
| 1204 | 3189 static const struct memory_description image_specifier_description[] = { |
| 3190 { XD_LISP_OBJECT, offsetof (struct image_specifier, attachee) }, | |
| 3191 { XD_LISP_OBJECT, offsetof (struct image_specifier, attachee_property) }, | |
| 3192 { XD_END } | |
| 3193 }; | |
| 3194 | |
| 3195 DEFINE_SPECIFIER_TYPE_WITH_DATA (image); | |
| 428 | 3196 |
| 3197 static void | |
| 3198 image_create (Lisp_Object obj) | |
| 3199 { | |
| 440 | 3200 Lisp_Specifier *image = XIMAGE_SPECIFIER (obj); |
| 428 | 3201 |
| 3202 IMAGE_SPECIFIER_ALLOWED (image) = ~0; /* all are allowed */ | |
| 3203 IMAGE_SPECIFIER_ATTACHEE (image) = Qnil; | |
| 3204 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = Qnil; | |
| 3205 } | |
| 3206 | |
| 3207 static void | |
| 3208 image_mark (Lisp_Object obj) | |
| 3209 { | |
| 440 | 3210 Lisp_Specifier *image = XIMAGE_SPECIFIER (obj); |
| 428 | 3211 |
| 3212 mark_object (IMAGE_SPECIFIER_ATTACHEE (image)); | |
| 3213 mark_object (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image)); | |
| 3214 } | |
| 3215 | |
| 450 | 3216 static int |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
3217 instantiator_eq_equal (const Hash_Table_Test *UNUSED (http), |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
3218 Lisp_Object obj1, Lisp_Object obj2) |
| 450 | 3219 { |
| 3220 if (EQ (obj1, obj2)) | |
| 3221 return 1; | |
| 3222 | |
| 3223 else if (CONSP (obj1) && CONSP (obj2)) | |
| 3224 { | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
3225 return instantiator_eq_equal (NULL, XCAR (obj1), XCAR (obj2)) |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
3226 && instantiator_eq_equal (NULL, XCDR (obj1), XCDR (obj2)); |
| 450 | 3227 } |
| 3228 return 0; | |
| 3229 } | |
| 3230 | |
| 665 | 3231 static Hashcode |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
3232 instantiator_eq_hash (const Hash_Table_Test *UNUSED (http), Lisp_Object obj) |
| 450 | 3233 { |
| 3234 if (CONSP (obj)) | |
| 3235 { | |
| 3236 /* no point in worrying about tail recursion, since we're not | |
| 3237 going very deep */ | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
3238 return HASH2 (instantiator_eq_hash (NULL, XCAR (obj)), |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
3239 instantiator_eq_hash (NULL, XCDR (obj))); |
| 450 | 3240 } |
| 3241 return LISP_HASH (obj); | |
| 3242 } | |
| 3243 | |
| 3244 /* We need a special hash table for storing image instances. */ | |
| 3245 Lisp_Object | |
| 3246 make_image_instance_cache_hash_table (void) | |
| 3247 { | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
3248 return make_general_lisp_hash_table (Vimage_instance_hash_table_test, 30, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
3249 -1.0, -1.0, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
3250 HASH_TABLE_KEY_CAR_VALUE_WEAK); |
| 450 | 3251 } |
| 3252 | |
| 428 | 3253 static Lisp_Object |
| 3254 image_instantiate_cache_result (Lisp_Object locative) | |
| 3255 { | |
| 442 | 3256 /* locative = (instance instantiator . subtable) |
| 3257 | |
| 3258 So we are using the instantiator as the key and the instance as | |
| 3259 the value. Since the hashtable is key-weak this means that the | |
| 3260 image instance will stay around as long as the instantiator stays | |
| 3261 around. The instantiator is stored in the `image' slot of the | |
| 3262 glyph, so as long as the glyph is marked the instantiator will be | |
| 3263 as well and hence the cached image instance also.*/ | |
| 428 | 3264 Fputhash (XCAR (XCDR (locative)), XCAR (locative), XCDR (XCDR (locative))); |
| 853 | 3265 free_cons (XCDR (locative)); |
| 3266 free_cons (locative); | |
| 428 | 3267 return Qnil; |
| 3268 } | |
| 3269 | |
| 3270 /* Given a specification for an image, return an instance of | |
| 3271 the image which matches the given instantiator and which can be | |
| 3272 displayed in the given domain. */ | |
| 3273 | |
| 3274 static Lisp_Object | |
| 2286 | 3275 image_instantiate (Lisp_Object specifier, Lisp_Object UNUSED (matchspec), |
| 428 | 3276 Lisp_Object domain, Lisp_Object instantiator, |
|
4426
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
4252
diff
changeset
|
3277 Lisp_Object depth, int no_fallback) |
| 428 | 3278 { |
| 438 | 3279 Lisp_Object glyph = IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier)); |
| 428 | 3280 int dest_mask = XIMAGE_SPECIFIER_ALLOWED (specifier); |
| 3281 int pointerp = dest_mask & image_instance_type_to_mask (IMAGE_POINTER); | |
| 3282 | |
| 3283 if (IMAGE_INSTANCEP (instantiator)) | |
| 3284 { | |
| 442 | 3285 /* make sure that the image instance's governing domain and type are |
| 428 | 3286 matching. */ |
| 442 | 3287 Lisp_Object governing_domain = XIMAGE_INSTANCE_DOMAIN (instantiator); |
| 3288 | |
| 3289 if ((DEVICEP (governing_domain) | |
| 3290 && EQ (governing_domain, DOMAIN_DEVICE (domain))) | |
| 3291 || (FRAMEP (governing_domain) | |
| 3292 && EQ (governing_domain, DOMAIN_FRAME (domain))) | |
| 3293 || (WINDOWP (governing_domain) | |
| 3294 && EQ (governing_domain, DOMAIN_WINDOW (domain)))) | |
| 428 | 3295 { |
| 3296 int mask = | |
| 3297 image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instantiator)); | |
| 3298 if (mask & dest_mask) | |
| 3299 return instantiator; | |
| 3300 else | |
| 563 | 3301 invalid_argument ("Type of image instance not allowed here", |
| 428 | 3302 instantiator); |
| 3303 } | |
| 3304 else | |
| 563 | 3305 invalid_argument_2 ("Wrong domain for image instance", |
| 442 | 3306 instantiator, domain); |
| 428 | 3307 } |
| 452 | 3308 /* How ugly !! An image instanciator that uses a kludgy syntax to snarf in |
| 3309 face properties. There's a design flaw here. -- didier */ | |
| 428 | 3310 else if (VECTORP (instantiator) |
| 450 | 3311 && EQ (INSTANTIATOR_TYPE (instantiator), Qinherit)) |
| 428 | 3312 { |
| 3313 assert (XVECTOR_LENGTH (instantiator) == 3); | |
| 3314 return (FACE_PROPERTY_INSTANCE | |
| 3315 (Fget_face (XVECTOR_DATA (instantiator)[2]), | |
|
4426
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
4252
diff
changeset
|
3316 Qbackground_pixmap, domain, no_fallback, depth)); |
| 428 | 3317 } |
| 3318 else | |
| 3319 { | |
| 442 | 3320 Lisp_Object instance = Qnil; |
| 3321 Lisp_Object subtable = Qnil; | |
| 450 | 3322 /* #### Should this be GCPRO'd? */ |
| 3323 Lisp_Object hash_key = Qnil; | |
| 428 | 3324 Lisp_Object pointer_fg = Qnil; |
| 3325 Lisp_Object pointer_bg = Qnil; | |
| 442 | 3326 Lisp_Object governing_domain = |
| 3327 get_image_instantiator_governing_domain (instantiator, domain); | |
| 3328 struct gcpro gcpro1; | |
| 3329 | |
| 3330 GCPRO1 (instance); | |
| 3331 | |
| 3332 /* We have to put subwindow, widget and text image instances in | |
| 3333 a per-window cache so that we can see the same glyph in | |
| 3334 different windows. We use governing_domain to determine the type | |
| 3335 of image_instance that will be created. */ | |
| 428 | 3336 |
| 3337 if (pointerp) | |
| 3338 { | |
| 3339 pointer_fg = FACE_FOREGROUND (Vpointer_face, domain); | |
| 3340 pointer_bg = FACE_BACKGROUND (Vpointer_face, domain); | |
| 452 | 3341 hash_key = list4 (glyph, INSTANTIATOR_TYPE (instantiator), |
| 450 | 3342 pointer_fg, pointer_bg); |
| 428 | 3343 } |
| 450 | 3344 else |
| 3345 /* We cannot simply key on the glyph since fallbacks could use | |
| 3346 the same glyph but have a totally different instantiator | |
| 3347 type. Thus we key on the glyph and the type (but not any | |
| 3348 other parts of the instantiator. */ | |
| 3349 hash_key = list2 (glyph, INSTANTIATOR_TYPE (instantiator)); | |
| 428 | 3350 |
| 442 | 3351 /* First look in the device cache. */ |
| 3352 if (DEVICEP (governing_domain)) | |
| 428 | 3353 { |
| 442 | 3354 subtable = Fgethash (make_int (dest_mask), |
| 3355 XDEVICE (governing_domain)-> | |
| 3356 image_instance_cache, | |
| 3357 Qunbound); | |
| 3358 if (UNBOUNDP (subtable)) | |
| 3359 { | |
| 3360 /* For the image instance cache, we do comparisons with | |
| 3361 EQ rather than with EQUAL, as we do for color and | |
| 3362 font names. The reasons are: | |
| 3363 | |
| 3364 1) pixmap data can be very long, and thus the hashing | |
| 3365 and comparing will take awhile. | |
| 3366 | |
| 3367 2) It's not so likely that we'll run into things that | |
| 3368 are EQUAL but not EQ (that can happen a lot with | |
| 3369 faces, because their specifiers are copied around); | |
| 3370 but pixmaps tend not to be in faces. | |
| 3371 | |
| 3372 However, if the image-instance could be a pointer, we | |
| 3373 have to use EQUAL because we massaged the | |
| 3374 instantiator into a cons3 also containing the | |
| 3375 foreground and background of the pointer face. */ | |
| 450 | 3376 subtable = make_image_instance_cache_hash_table (); |
| 3377 | |
| 442 | 3378 Fputhash (make_int (dest_mask), subtable, |
| 3379 XDEVICE (governing_domain)->image_instance_cache); | |
| 3380 instance = Qunbound; | |
| 3381 } | |
| 3382 else | |
| 3383 { | |
| 450 | 3384 instance = Fgethash (hash_key, subtable, Qunbound); |
| 442 | 3385 } |
| 3386 } | |
| 3387 else if (WINDOWP (governing_domain)) | |
| 3388 { | |
| 3389 /* Subwindows have a per-window cache and have to be treated | |
| 3390 differently. */ | |
| 3391 instance = | |
| 450 | 3392 Fgethash (hash_key, |
| 442 | 3393 XWINDOW (governing_domain)->subwindow_instance_cache, |
| 3394 Qunbound); | |
| 428 | 3395 } |
| 3396 else | |
| 2500 | 3397 ABORT (); /* We're not allowed anything else currently. */ |
| 442 | 3398 |
| 3399 /* If we don't have an instance at this point then create | |
| 4252 | 3400 one. */ |
| 428 | 3401 if (UNBOUNDP (instance)) |
| 3402 { | |
| 3403 Lisp_Object locative = | |
| 3404 noseeum_cons (Qnil, | |
| 450 | 3405 noseeum_cons (hash_key, |
| 442 | 3406 DEVICEP (governing_domain) ? subtable |
| 3407 : XWINDOW (governing_domain) | |
| 3408 ->subwindow_instance_cache)); | |
| 428 | 3409 int speccount = specpdl_depth (); |
| 440 | 3410 |
| 442 | 3411 /* Make sure we cache the failures, too. Use an |
| 3412 unwind-protect to catch such errors. If we fail, the | |
| 3413 unwind-protect records nil in the hash table. If we | |
| 3414 succeed, we change the car of the locative to the | |
| 3415 resulting instance, which gets recorded instead. */ | |
| 428 | 3416 record_unwind_protect (image_instantiate_cache_result, |
| 3417 locative); | |
| 442 | 3418 instance = |
| 3419 instantiate_image_instantiator (governing_domain, | |
| 3420 domain, instantiator, | |
| 3421 pointer_fg, pointer_bg, | |
| 3422 dest_mask, glyph); | |
| 3423 | |
| 3424 /* We need a per-frame cache for redisplay. */ | |
| 3425 cache_subwindow_instance_in_frame_maybe (instance); | |
| 440 | 3426 |
| 428 | 3427 Fsetcar (locative, instance); |
| 442 | 3428 #ifdef ERROR_CHECK_GLYPHS |
| 3429 if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance)) | |
| 3430 & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK)) | |
| 3431 assert (EQ (XIMAGE_INSTANCE_FRAME (instance), | |
| 3432 DOMAIN_FRAME (domain))); | |
| 3433 #endif | |
| 771 | 3434 unbind_to (speccount); |
| 442 | 3435 #ifdef ERROR_CHECK_GLYPHS |
| 428 | 3436 if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance)) |
| 442 | 3437 & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK)) |
| 450 | 3438 assert (EQ (Fgethash (hash_key, |
| 442 | 3439 XWINDOW (governing_domain) |
| 3440 ->subwindow_instance_cache, | |
| 3441 Qunbound), instance)); | |
| 3442 #endif | |
| 428 | 3443 } |
| 442 | 3444 else if (NILP (instance)) |
| 563 | 3445 gui_error ("Can't instantiate image (probably cached)", instantiator); |
| 442 | 3446 /* We found an instance. However, because we are using the glyph |
| 4252 | 3447 as the hash key instead of the instantiator, the current |
| 3448 instantiator may not be the same as the original. Thus we | |
| 3449 must update the instance based on the new | |
| 3450 instantiator. Preserving instance identity like this is | |
| 3451 important to stop excessive window system widget creation and | |
| 3452 deletion - and hence flashing. */ | |
| 442 | 3453 else |
| 3454 { | |
| 3455 /* #### This function should be able to cope with *all* | |
| 3456 changes to the instantiator, but currently only copes | |
| 3457 with the most used properties. This means that it is | |
| 3458 possible to make changes that don't get reflected in the | |
| 3459 display. */ | |
| 3460 update_image_instance (instance, instantiator); | |
| 450 | 3461 free_list (hash_key); |
| 442 | 3462 } |
| 3463 | |
| 3464 #ifdef ERROR_CHECK_GLYPHS | |
| 3465 if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance)) | |
| 3466 & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK)) | |
| 3467 assert (EQ (XIMAGE_INSTANCE_FRAME (instance), | |
| 3468 DOMAIN_FRAME (domain))); | |
| 3469 #endif | |
| 3470 ERROR_CHECK_IMAGE_INSTANCE (instance); | |
| 3471 RETURN_UNGCPRO (instance); | |
| 428 | 3472 } |
| 3473 | |
| 2500 | 3474 ABORT (); |
| 428 | 3475 return Qnil; /* not reached */ |
| 3476 } | |
| 3477 | |
| 3478 /* Validate an image instantiator. */ | |
| 3479 | |
| 3480 static void | |
| 3481 image_validate (Lisp_Object instantiator) | |
| 3482 { | |
| 3483 if (IMAGE_INSTANCEP (instantiator) || STRINGP (instantiator)) | |
| 3484 return; | |
| 3485 else if (VECTORP (instantiator)) | |
| 3486 { | |
| 3487 Lisp_Object *elt = XVECTOR_DATA (instantiator); | |
| 3488 int instantiator_len = XVECTOR_LENGTH (instantiator); | |
| 3489 struct image_instantiator_methods *meths; | |
| 3490 Lisp_Object already_seen = Qnil; | |
| 3491 struct gcpro gcpro1; | |
| 3492 int i; | |
| 3493 | |
| 3494 if (instantiator_len < 1) | |
| 563 | 3495 sferror ("Vector length must be at least 1", |
| 428 | 3496 instantiator); |
| 3497 | |
| 3498 meths = decode_image_instantiator_format (elt[0], ERROR_ME); | |
| 3499 if (!(instantiator_len & 1)) | |
| 563 | 3500 sferror |
| 428 | 3501 ("Must have alternating keyword/value pairs", instantiator); |
| 3502 | |
| 3503 GCPRO1 (already_seen); | |
| 3504 | |
| 3505 for (i = 1; i < instantiator_len; i += 2) | |
| 3506 { | |
| 3507 Lisp_Object keyword = elt[i]; | |
| 3508 Lisp_Object value = elt[i+1]; | |
| 3509 int j; | |
| 3510 | |
| 3511 CHECK_SYMBOL (keyword); | |
| 3512 if (!SYMBOL_IS_KEYWORD (keyword)) | |
| 563 | 3513 invalid_argument ("Symbol must begin with a colon", keyword); |
| 428 | 3514 |
| 3515 for (j = 0; j < Dynarr_length (meths->keywords); j++) | |
| 3516 if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword)) | |
| 3517 break; | |
| 3518 | |
| 3519 if (j == Dynarr_length (meths->keywords)) | |
| 563 | 3520 invalid_argument ("Unrecognized keyword", keyword); |
| 428 | 3521 |
| 3522 if (!Dynarr_at (meths->keywords, j).multiple_p) | |
| 3523 { | |
| 3524 if (!NILP (memq_no_quit (keyword, already_seen))) | |
| 563 | 3525 sferror |
| 428 | 3526 ("Keyword may not appear more than once", keyword); |
| 3527 already_seen = Fcons (keyword, already_seen); | |
| 3528 } | |
| 3529 | |
| 3530 (Dynarr_at (meths->keywords, j).validate) (value); | |
| 3531 } | |
| 3532 | |
| 3533 UNGCPRO; | |
| 3534 | |
| 3535 MAYBE_IIFORMAT_METH (meths, validate, (instantiator)); | |
| 3536 } | |
| 3537 else | |
| 563 | 3538 invalid_argument ("Must be string or vector", instantiator); |
| 428 | 3539 } |
| 3540 | |
| 3541 static void | |
| 3542 image_after_change (Lisp_Object specifier, Lisp_Object locale) | |
| 3543 { | |
| 3544 Lisp_Object attachee = | |
| 3545 IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier)); | |
| 3546 Lisp_Object property = | |
| 3547 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (XIMAGE_SPECIFIER (specifier)); | |
| 3548 if (FACEP (attachee)) | |
| 448 | 3549 { |
| 3550 face_property_was_changed (attachee, property, locale); | |
| 3551 if (BUFFERP (locale)) | |
| 3552 XBUFFER (locale)->buffer_local_face_property = 1; | |
| 3553 } | |
| 428 | 3554 else if (GLYPHP (attachee)) |
| 3555 glyph_property_was_changed (attachee, property, locale); | |
| 3556 } | |
| 3557 | |
| 3558 void | |
| 3559 set_image_attached_to (Lisp_Object obj, Lisp_Object face_or_glyph, | |
| 3560 Lisp_Object property) | |
| 3561 { | |
| 440 | 3562 Lisp_Specifier *image = XIMAGE_SPECIFIER (obj); |
| 428 | 3563 |
| 3564 IMAGE_SPECIFIER_ATTACHEE (image) = face_or_glyph; | |
| 3565 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = property; | |
| 3566 } | |
| 3567 | |
| 3568 static Lisp_Object | |
| 2286 | 3569 image_going_to_add (Lisp_Object specifier, Lisp_Object UNUSED (locale), |
| 428 | 3570 Lisp_Object tag_set, Lisp_Object instantiator) |
| 3571 { | |
| 3572 Lisp_Object possible_console_types = Qnil; | |
| 3573 Lisp_Object rest; | |
| 3574 Lisp_Object retlist = Qnil; | |
| 3575 struct gcpro gcpro1, gcpro2; | |
| 3576 | |
| 3577 LIST_LOOP (rest, Vconsole_type_list) | |
| 3578 { | |
| 3579 Lisp_Object contype = XCAR (rest); | |
| 3580 if (!NILP (memq_no_quit (contype, tag_set))) | |
| 3581 possible_console_types = Fcons (contype, possible_console_types); | |
| 3582 } | |
| 3583 | |
| 3584 if (XINT (Flength (possible_console_types)) > 1) | |
| 3585 /* two conflicting console types specified */ | |
| 3586 return Qnil; | |
| 3587 | |
| 3588 if (NILP (possible_console_types)) | |
| 3589 possible_console_types = Vconsole_type_list; | |
| 3590 | |
| 3591 GCPRO2 (retlist, possible_console_types); | |
| 3592 | |
| 3593 LIST_LOOP (rest, possible_console_types) | |
| 3594 { | |
| 3595 Lisp_Object contype = XCAR (rest); | |
| 3596 Lisp_Object newinst = call_with_suspended_errors | |
| 3597 ((lisp_fn_t) normalize_image_instantiator, | |
| 793 | 3598 Qnil, Qimage, ERROR_ME_DEBUG_WARN, 3, instantiator, contype, |
| 428 | 3599 make_int (XIMAGE_SPECIFIER_ALLOWED (specifier))); |
| 3600 | |
| 3601 if (!NILP (newinst)) | |
| 3602 { | |
| 3603 Lisp_Object newtag; | |
| 3604 if (NILP (memq_no_quit (contype, tag_set))) | |
| 3605 newtag = Fcons (contype, tag_set); | |
| 3606 else | |
| 3607 newtag = tag_set; | |
| 3608 retlist = Fcons (Fcons (newtag, newinst), retlist); | |
| 3609 } | |
| 3610 } | |
| 3611 | |
| 3612 UNGCPRO; | |
| 3613 | |
| 3614 return retlist; | |
| 3615 } | |
| 3616 | |
| 434 | 3617 /* Copy an image instantiator. We can't use Fcopy_tree since widgets |
| 3618 may contain circular references which would send Fcopy_tree into | |
| 3619 infloop death. */ | |
| 3620 static Lisp_Object | |
| 3621 image_copy_vector_instantiator (Lisp_Object instantiator) | |
| 3622 { | |
| 3623 int i; | |
| 3624 struct image_instantiator_methods *meths; | |
| 3625 Lisp_Object *elt; | |
| 3626 int instantiator_len; | |
| 3627 | |
| 3628 CHECK_VECTOR (instantiator); | |
| 3629 | |
| 3630 instantiator = Fcopy_sequence (instantiator); | |
| 3631 elt = XVECTOR_DATA (instantiator); | |
| 3632 instantiator_len = XVECTOR_LENGTH (instantiator); | |
| 440 | 3633 |
| 434 | 3634 meths = decode_image_instantiator_format (elt[0], ERROR_ME); |
| 3635 | |
| 3636 for (i = 1; i < instantiator_len; i += 2) | |
| 3637 { | |
| 3638 int j; | |
| 3639 Lisp_Object keyword = elt[i]; | |
| 3640 Lisp_Object value = elt[i+1]; | |
| 3641 | |
| 3642 /* Find the keyword entry. */ | |
| 3643 for (j = 0; j < Dynarr_length (meths->keywords); j++) | |
| 3644 { | |
| 3645 if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword)) | |
| 3646 break; | |
| 3647 } | |
| 3648 | |
| 3649 /* Only copy keyword values that should be copied. */ | |
| 3650 if (Dynarr_at (meths->keywords, j).copy_p | |
| 3651 && | |
| 3652 (CONSP (value) || VECTORP (value))) | |
| 3653 { | |
| 3654 elt [i+1] = Fcopy_tree (value, Qt); | |
| 3655 } | |
| 3656 } | |
| 3657 | |
| 3658 return instantiator; | |
| 3659 } | |
| 3660 | |
| 3661 static Lisp_Object | |
| 3662 image_copy_instantiator (Lisp_Object arg) | |
| 3663 { | |
| 3664 if (CONSP (arg)) | |
| 3665 { | |
| 3666 Lisp_Object rest; | |
| 3667 rest = arg = Fcopy_sequence (arg); | |
| 3668 while (CONSP (rest)) | |
| 3669 { | |
| 3670 Lisp_Object elt = XCAR (rest); | |
| 3671 if (CONSP (elt)) | |
| 3672 XCAR (rest) = Fcopy_tree (elt, Qt); | |
| 3673 else if (VECTORP (elt)) | |
| 3674 XCAR (rest) = image_copy_vector_instantiator (elt); | |
| 3675 if (VECTORP (XCDR (rest))) /* hack for (a b . [c d]) */ | |
| 3676 XCDR (rest) = Fcopy_tree (XCDR (rest), Qt); | |
| 3677 rest = XCDR (rest); | |
| 3678 } | |
| 3679 } | |
| 3680 else if (VECTORP (arg)) | |
| 3681 { | |
| 3682 arg = image_copy_vector_instantiator (arg); | |
| 3683 } | |
| 3684 return arg; | |
| 3685 } | |
| 3686 | |
| 428 | 3687 DEFUN ("image-specifier-p", Fimage_specifier_p, 1, 1, 0, /* |
| 3688 Return non-nil if OBJECT is an image specifier. | |
| 442 | 3689 See `make-image-specifier' for a description of image instantiators. |
| 428 | 3690 */ |
| 3691 (object)) | |
| 3692 { | |
| 3693 return IMAGE_SPECIFIERP (object) ? Qt : Qnil; | |
| 3694 } | |
| 3695 | |
| 3696 | |
| 3697 /**************************************************************************** | |
| 3698 * Glyph Object * | |
| 3699 ****************************************************************************/ | |
| 3700 | |
| 3701 static Lisp_Object | |
| 3702 mark_glyph (Lisp_Object obj) | |
| 3703 { | |
| 440 | 3704 Lisp_Glyph *glyph = XGLYPH (obj); |
| 428 | 3705 |
| 3706 mark_object (glyph->image); | |
| 3707 mark_object (glyph->contrib_p); | |
| 3708 mark_object (glyph->baseline); | |
| 3709 mark_object (glyph->face); | |
| 3710 | |
| 3711 return glyph->plist; | |
| 3712 } | |
| 3713 | |
| 3714 static void | |
| 2286 | 3715 print_glyph (Lisp_Object obj, Lisp_Object printcharfun, |
| 3716 int UNUSED (escapeflag)) | |
| 428 | 3717 { |
| 440 | 3718 Lisp_Glyph *glyph = XGLYPH (obj); |
| 428 | 3719 |
| 3720 if (print_readably) | |
|
5142
f965e31a35f0
reduce lcrecord headers to 2 words, rename printing_unreadable_object
Ben Wing <ben@xemacs.org>
parents:
5127
diff
changeset
|
3721 printing_unreadable_lisp_object (obj, 0); |
| 428 | 3722 |
| 800 | 3723 write_fmt_string_lisp (printcharfun, "#<glyph (%s", 1, Fglyph_type (obj)); |
| 3724 write_fmt_string_lisp (printcharfun, ") %S", 1, glyph->image); | |
|
5146
88bd4f3ef8e4
make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
Ben Wing <ben@xemacs.org>
parents:
5142
diff
changeset
|
3725 write_fmt_string (printcharfun, "0x%x>", LISP_OBJECT_UID (obj)); |
| 428 | 3726 } |
| 3727 | |
| 3728 /* Glyphs are equal if all of their display attributes are equal. We | |
| 3729 don't compare names or doc-strings, because that would make equal | |
| 3730 be eq. | |
| 3731 | |
| 3732 This isn't concerned with "unspecified" attributes, that's what | |
| 3733 #'glyph-differs-from-default-p is for. */ | |
| 3734 static int | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
3735 glyph_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
3736 int UNUSED (foldcase)) |
| 428 | 3737 { |
| 440 | 3738 Lisp_Glyph *g1 = XGLYPH (obj1); |
| 3739 Lisp_Glyph *g2 = XGLYPH (obj2); | |
| 428 | 3740 |
| 3741 depth++; | |
| 3742 | |
| 3743 return (internal_equal (g1->image, g2->image, depth) && | |
| 3744 internal_equal (g1->contrib_p, g2->contrib_p, depth) && | |
| 3745 internal_equal (g1->baseline, g2->baseline, depth) && | |
| 3746 internal_equal (g1->face, g2->face, depth) && | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
3747 !plists_differ (g1->plist, g2->plist, 0, 0, depth + 1, 0)); |
| 428 | 3748 } |
| 3749 | |
| 665 | 3750 static Hashcode |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
3751 glyph_hash (Lisp_Object obj, int depth, Boolint UNUSED (equalp)) |
| 428 | 3752 { |
| 3753 depth++; | |
| 3754 | |
| 3755 /* No need to hash all of the elements; that would take too long. | |
| 3756 Just hash the most common ones. */ | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
3757 return HASH2 (internal_hash (XGLYPH (obj)->image, depth, 0), |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
3758 internal_hash (XGLYPH (obj)->face, depth, 0)); |
| 428 | 3759 } |
| 3760 | |
| 3761 static Lisp_Object | |
| 3762 glyph_getprop (Lisp_Object obj, Lisp_Object prop) | |
| 3763 { | |
| 440 | 3764 Lisp_Glyph *g = XGLYPH (obj); |
| 428 | 3765 |
| 3766 if (EQ (prop, Qimage)) return g->image; | |
| 3767 if (EQ (prop, Qcontrib_p)) return g->contrib_p; | |
| 3768 if (EQ (prop, Qbaseline)) return g->baseline; | |
| 3769 if (EQ (prop, Qface)) return g->face; | |
| 3770 | |
| 3771 return external_plist_get (&g->plist, prop, 0, ERROR_ME); | |
| 3772 } | |
| 3773 | |
| 3774 static int | |
| 3775 glyph_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value) | |
| 3776 { | |
| 3777 if (EQ (prop, Qimage) || | |
| 3778 EQ (prop, Qcontrib_p) || | |
| 3779 EQ (prop, Qbaseline)) | |
| 3780 return 0; | |
| 3781 | |
| 3782 if (EQ (prop, Qface)) | |
| 3783 { | |
| 3784 XGLYPH (obj)->face = Fget_face (value); | |
| 3785 return 1; | |
| 3786 } | |
| 3787 | |
| 3788 external_plist_put (&XGLYPH (obj)->plist, prop, value, 0, ERROR_ME); | |
| 3789 return 1; | |
| 3790 } | |
| 3791 | |
| 3792 static int | |
| 3793 glyph_remprop (Lisp_Object obj, Lisp_Object prop) | |
| 3794 { | |
| 3795 if (EQ (prop, Qimage) || | |
| 3796 EQ (prop, Qcontrib_p) || | |
| 3797 EQ (prop, Qbaseline)) | |
| 3798 return -1; | |
| 3799 | |
| 3800 if (EQ (prop, Qface)) | |
| 3801 { | |
| 3802 XGLYPH (obj)->face = Qnil; | |
| 3803 return 1; | |
| 3804 } | |
| 3805 | |
| 3806 return external_remprop (&XGLYPH (obj)->plist, prop, 0, ERROR_ME); | |
| 3807 } | |
| 3808 | |
| 3809 static Lisp_Object | |
| 3810 glyph_plist (Lisp_Object obj) | |
| 3811 { | |
| 440 | 3812 Lisp_Glyph *glyph = XGLYPH (obj); |
| 428 | 3813 Lisp_Object result = glyph->plist; |
| 3814 | |
| 3815 result = cons3 (Qface, glyph->face, result); | |
| 3816 result = cons3 (Qbaseline, glyph->baseline, result); | |
| 3817 result = cons3 (Qcontrib_p, glyph->contrib_p, result); | |
| 3818 result = cons3 (Qimage, glyph->image, result); | |
| 3819 | |
| 3820 return result; | |
| 3821 } | |
| 3822 | |
| 1204 | 3823 static const struct memory_description glyph_description[] = { |
| 440 | 3824 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, image) }, |
| 3825 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, contrib_p) }, | |
| 3826 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, baseline) }, | |
| 3827 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, face) }, | |
| 3828 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, plist) }, | |
| 428 | 3829 { XD_END } |
| 3830 }; | |
| 3831 | |
|
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
3832 DEFINE_DUMPABLE_LISP_OBJECT ("glyph", glyph, |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
3833 mark_glyph, print_glyph, 0, |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
3834 glyph_equal, glyph_hash, |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
3835 glyph_description, |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
3836 Lisp_Glyph); |
| 428 | 3837 |
| 3838 Lisp_Object | |
| 3839 allocate_glyph (enum glyph_type type, | |
| 3840 void (*after_change) (Lisp_Object glyph, Lisp_Object property, | |
| 3841 Lisp_Object locale)) | |
| 3842 { | |
| 3843 /* This function can GC */ | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5126
diff
changeset
|
3844 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (glyph); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
3845 Lisp_Glyph *g = XGLYPH (obj); |
| 428 | 3846 |
| 3847 g->type = type; | |
| 3848 g->image = Fmake_specifier (Qimage); /* This function can GC */ | |
| 3849 g->dirty = 0; | |
| 3850 switch (g->type) | |
| 3851 { | |
| 3852 case GLYPH_BUFFER: | |
| 3853 XIMAGE_SPECIFIER_ALLOWED (g->image) = | |
| 440 | 3854 IMAGE_NOTHING_MASK | IMAGE_TEXT_MASK |
| 3855 | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK | |
| 442 | 3856 | IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK; |
| 428 | 3857 break; |
| 3858 case GLYPH_POINTER: | |
| 3859 XIMAGE_SPECIFIER_ALLOWED (g->image) = | |
| 3860 IMAGE_NOTHING_MASK | IMAGE_POINTER_MASK; | |
| 3861 break; | |
| 3862 case GLYPH_ICON: | |
| 3863 XIMAGE_SPECIFIER_ALLOWED (g->image) = | |
| 438 | 3864 IMAGE_NOTHING_MASK | IMAGE_MONO_PIXMAP_MASK |
| 3865 | IMAGE_COLOR_PIXMAP_MASK; | |
| 428 | 3866 break; |
| 3867 default: | |
| 2500 | 3868 ABORT (); |
| 428 | 3869 } |
| 3870 | |
| 3871 /* I think Fmake_specifier can GC. I think set_specifier_fallback can GC. */ | |
| 3872 /* We're getting enough reports of odd behavior in this area it seems */ | |
| 3873 /* best to GCPRO everything. */ | |
| 3874 { | |
| 3875 Lisp_Object tem1 = list1 (Fcons (Qnil, Vthe_nothing_vector)); | |
| 3876 Lisp_Object tem2 = list1 (Fcons (Qnil, Qt)); | |
| 3877 Lisp_Object tem3 = list1 (Fcons (Qnil, Qnil)); | |
| 3878 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
| 3879 | |
| 3880 GCPRO4 (obj, tem1, tem2, tem3); | |
| 3881 | |
| 3882 set_specifier_fallback (g->image, tem1); | |
| 3883 g->contrib_p = Fmake_specifier (Qboolean); | |
| 3884 set_specifier_fallback (g->contrib_p, tem2); | |
| 3885 /* #### should have a specifier for the following */ | |
| 3886 g->baseline = Fmake_specifier (Qgeneric); | |
| 3887 set_specifier_fallback (g->baseline, tem3); | |
| 3888 g->face = Qnil; | |
| 3889 g->plist = Qnil; | |
| 3890 g->after_change = after_change; | |
| 3891 | |
| 3892 set_image_attached_to (g->image, obj, Qimage); | |
| 3893 UNGCPRO; | |
| 3894 } | |
| 3895 | |
| 3896 return obj; | |
| 3897 } | |
| 3898 | |
| 3899 static enum glyph_type | |
| 578 | 3900 decode_glyph_type (Lisp_Object type, Error_Behavior errb) |
| 428 | 3901 { |
| 3902 if (NILP (type)) | |
| 3903 return GLYPH_BUFFER; | |
| 3904 | |
| 3905 if (ERRB_EQ (errb, ERROR_ME)) | |
| 3906 CHECK_SYMBOL (type); | |
| 3907 | |
| 3908 if (EQ (type, Qbuffer)) return GLYPH_BUFFER; | |
| 3909 if (EQ (type, Qpointer)) return GLYPH_POINTER; | |
| 3910 if (EQ (type, Qicon)) return GLYPH_ICON; | |
| 3911 | |
| 563 | 3912 maybe_invalid_constant ("Invalid glyph type", type, Qimage, errb); |
| 428 | 3913 |
| 3914 return GLYPH_UNKNOWN; | |
| 3915 } | |
| 3916 | |
| 3917 static int | |
| 3918 valid_glyph_type_p (Lisp_Object type) | |
| 3919 { | |
| 3920 return !NILP (memq_no_quit (type, Vglyph_type_list)); | |
| 3921 } | |
| 3922 | |
| 3923 DEFUN ("valid-glyph-type-p", Fvalid_glyph_type_p, 1, 1, 0, /* | |
| 3924 Given a GLYPH-TYPE, return non-nil if it is valid. | |
| 3925 Valid types are `buffer', `pointer', and `icon'. | |
| 3926 */ | |
| 3927 (glyph_type)) | |
| 3928 { | |
| 3929 return valid_glyph_type_p (glyph_type) ? Qt : Qnil; | |
| 3930 } | |
| 3931 | |
| 3932 DEFUN ("glyph-type-list", Fglyph_type_list, 0, 0, 0, /* | |
| 3933 Return a list of valid glyph types. | |
| 3934 */ | |
| 3935 ()) | |
| 3936 { | |
| 3937 return Fcopy_sequence (Vglyph_type_list); | |
| 3938 } | |
| 3939 | |
| 3940 DEFUN ("make-glyph-internal", Fmake_glyph_internal, 0, 1, 0, /* | |
| 442 | 3941 Create and return a new uninitialized glyph of type TYPE. |
| 428 | 3942 |
| 3943 TYPE specifies the type of the glyph; this should be one of `buffer', | |
| 3944 `pointer', or `icon', and defaults to `buffer'. The type of the glyph | |
| 3945 specifies in which contexts the glyph can be used, and controls the | |
| 3946 allowable image types into which the glyph's image can be | |
| 3947 instantiated. | |
| 3948 | |
| 3949 `buffer' glyphs can be used as the begin-glyph or end-glyph of an | |
| 3950 extent, in the modeline, and in the toolbar. Their image can be | |
| 3951 instantiated as `nothing', `mono-pixmap', `color-pixmap', `text', | |
| 3952 and `subwindow'. | |
| 3953 | |
| 3954 `pointer' glyphs can be used to specify the mouse pointer. Their | |
| 3955 image can be instantiated as `pointer'. | |
| 3956 | |
| 3957 `icon' glyphs can be used to specify the icon used when a frame is | |
| 3958 iconified. Their image can be instantiated as `mono-pixmap' and | |
| 3959 `color-pixmap'. | |
| 3960 */ | |
| 3961 (type)) | |
| 3962 { | |
| 3963 enum glyph_type typeval = decode_glyph_type (type, ERROR_ME); | |
| 3964 return allocate_glyph (typeval, 0); | |
| 3965 } | |
| 3966 | |
| 3967 DEFUN ("glyphp", Fglyphp, 1, 1, 0, /* | |
| 3968 Return non-nil if OBJECT is a glyph. | |
| 3969 | |
| 442 | 3970 A glyph is an object used for pixmaps, widgets and the like. It is used |
| 428 | 3971 in begin-glyphs and end-glyphs attached to extents, in marginal and textual |
| 3972 annotations, in overlay arrows (overlay-arrow-* variables), in toolbar | |
| 442 | 3973 buttons, and the like. Much more detailed information can be found at |
| 3974 `make-glyph'. Its image is described using an image specifier -- | |
| 3975 see `make-image-specifier'. See also `make-image-instance' for further | |
| 3976 information. | |
| 428 | 3977 */ |
| 3978 (object)) | |
| 3979 { | |
| 3980 return GLYPHP (object) ? Qt : Qnil; | |
| 3981 } | |
| 3982 | |
| 3983 DEFUN ("glyph-type", Fglyph_type, 1, 1, 0, /* | |
| 3984 Return the type of the given glyph. | |
| 2959 | 3985 The return value will be one of `buffer', `pointer', or `icon'. |
| 428 | 3986 */ |
| 3987 (glyph)) | |
| 3988 { | |
| 3989 CHECK_GLYPH (glyph); | |
| 3990 switch (XGLYPH_TYPE (glyph)) | |
| 3991 { | |
| 2500 | 3992 default: ABORT (); |
| 428 | 3993 case GLYPH_BUFFER: return Qbuffer; |
| 3994 case GLYPH_POINTER: return Qpointer; | |
| 3995 case GLYPH_ICON: return Qicon; | |
| 3996 } | |
| 3997 } | |
| 3998 | |
| 438 | 3999 Lisp_Object |
| 4000 glyph_image_instance (Lisp_Object glyph, Lisp_Object domain, | |
| 578 | 4001 Error_Behavior errb, int no_quit) |
| 438 | 4002 { |
| 4003 Lisp_Object specifier = GLYPH_IMAGE (XGLYPH (glyph)); | |
| 4004 | |
| 2959 | 4005 /* This can never return Qunbound. All glyphs have `nothing' as |
| 438 | 4006 a fallback. */ |
| 440 | 4007 Lisp_Object image_instance = specifier_instance (specifier, Qunbound, |
| 438 | 4008 domain, errb, no_quit, 0, |
| 4009 Qzero); | |
| 440 | 4010 assert (!UNBOUNDP (image_instance)); |
| 442 | 4011 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
| 438 | 4012 |
| 4013 return image_instance; | |
| 4014 } | |
| 4015 | |
| 4016 static Lisp_Object | |
| 4017 glyph_image_instance_maybe (Lisp_Object glyph_or_image, Lisp_Object window) | |
| 4018 { | |
| 4019 Lisp_Object instance = glyph_or_image; | |
| 4020 | |
| 4021 if (GLYPHP (glyph_or_image)) | |
| 793 | 4022 instance = glyph_image_instance (glyph_or_image, window, |
| 4023 ERROR_ME_DEBUG_WARN, 1); | |
| 438 | 4024 |
| 4025 return instance; | |
| 4026 } | |
| 4027 | |
| 1411 | 4028 inline static int |
| 4029 image_instance_needs_layout (Lisp_Object instance) | |
| 4030 { | |
| 4031 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (instance); | |
| 4032 | |
| 4033 if (IMAGE_INSTANCE_DIRTYP (ii) && IMAGE_INSTANCE_LAYOUT_CHANGED (ii)) | |
| 4034 { | |
| 4035 return 1; | |
| 4036 } | |
| 4037 else | |
| 4038 { | |
| 4039 Lisp_Object iif = IMAGE_INSTANCE_FRAME (ii); | |
| 4040 return FRAMEP (iif) && XFRAME (iif)->size_changed; | |
| 4041 } | |
| 4042 } | |
| 4043 | |
| 428 | 4044 /***************************************************************************** |
| 4045 glyph_width | |
| 4046 | |
| 438 | 4047 Return the width of the given GLYPH on the given WINDOW. |
| 4048 Calculations are done based on recursively querying the geometry of | |
| 4049 the associated image instances. | |
| 428 | 4050 ****************************************************************************/ |
| 4051 unsigned short | |
| 438 | 4052 glyph_width (Lisp_Object glyph_or_image, Lisp_Object domain) |
| 428 | 4053 { |
| 438 | 4054 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image, |
| 4055 domain); | |
| 428 | 4056 if (!IMAGE_INSTANCEP (instance)) |
| 4057 return 0; | |
| 4058 | |
| 1411 | 4059 if (image_instance_needs_layout (instance)) |
| 438 | 4060 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY, |
| 442 | 4061 IMAGE_UNSPECIFIED_GEOMETRY, |
| 4062 IMAGE_UNCHANGED_GEOMETRY, | |
| 4063 IMAGE_UNCHANGED_GEOMETRY, domain); | |
| 438 | 4064 |
| 4065 return XIMAGE_INSTANCE_WIDTH (instance); | |
| 428 | 4066 } |
| 4067 | |
| 4068 DEFUN ("glyph-width", Fglyph_width, 1, 2, 0, /* | |
| 4069 Return the width of GLYPH on WINDOW. | |
| 4070 This may not be exact as it does not take into account all of the context | |
| 4071 that redisplay will. | |
| 4072 */ | |
| 4073 (glyph, window)) | |
| 4074 { | |
| 793 | 4075 window = wrap_window (decode_window (window)); |
| 428 | 4076 CHECK_GLYPH (glyph); |
| 4077 | |
| 438 | 4078 return make_int (glyph_width (glyph, window)); |
| 428 | 4079 } |
| 4080 | |
| 4081 unsigned short | |
| 438 | 4082 glyph_ascent (Lisp_Object glyph_or_image, Lisp_Object domain) |
| 428 | 4083 { |
| 438 | 4084 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image, |
| 4085 domain); | |
| 4086 if (!IMAGE_INSTANCEP (instance)) | |
| 4087 return 0; | |
| 4088 | |
| 1411 | 4089 if (image_instance_needs_layout (instance)) |
| 438 | 4090 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY, |
| 442 | 4091 IMAGE_UNSPECIFIED_GEOMETRY, |
| 4092 IMAGE_UNCHANGED_GEOMETRY, | |
| 4093 IMAGE_UNCHANGED_GEOMETRY, domain); | |
| 438 | 4094 |
| 4095 if (XIMAGE_INSTANCE_TYPE (instance) == IMAGE_TEXT) | |
| 4096 return XIMAGE_INSTANCE_TEXT_ASCENT (instance); | |
| 4097 else | |
| 4098 return XIMAGE_INSTANCE_HEIGHT (instance); | |
| 428 | 4099 } |
| 4100 | |
| 4101 unsigned short | |
| 438 | 4102 glyph_descent (Lisp_Object glyph_or_image, Lisp_Object domain) |
| 428 | 4103 { |
| 438 | 4104 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image, |
| 4105 domain); | |
| 4106 if (!IMAGE_INSTANCEP (instance)) | |
| 4107 return 0; | |
| 4108 | |
| 1411 | 4109 if (image_instance_needs_layout (instance)) |
| 438 | 4110 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY, |
| 442 | 4111 IMAGE_UNSPECIFIED_GEOMETRY, |
| 4112 IMAGE_UNCHANGED_GEOMETRY, | |
| 4113 IMAGE_UNCHANGED_GEOMETRY, domain); | |
| 438 | 4114 |
| 4115 if (XIMAGE_INSTANCE_TYPE (instance) == IMAGE_TEXT) | |
| 4116 return XIMAGE_INSTANCE_TEXT_DESCENT (instance); | |
| 4117 else | |
| 4118 return 0; | |
| 428 | 4119 } |
| 4120 | |
| 4121 /* strictly a convenience function. */ | |
| 4122 unsigned short | |
| 438 | 4123 glyph_height (Lisp_Object glyph_or_image, Lisp_Object domain) |
| 428 | 4124 { |
| 438 | 4125 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image, |
| 4126 domain); | |
| 440 | 4127 |
| 438 | 4128 if (!IMAGE_INSTANCEP (instance)) |
| 4129 return 0; | |
| 4130 | |
| 1411 | 4131 if (image_instance_needs_layout (instance)) |
| 438 | 4132 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY, |
| 442 | 4133 IMAGE_UNSPECIFIED_GEOMETRY, |
| 4134 IMAGE_UNCHANGED_GEOMETRY, | |
| 4135 IMAGE_UNCHANGED_GEOMETRY, domain); | |
| 438 | 4136 |
| 4137 return XIMAGE_INSTANCE_HEIGHT (instance); | |
| 428 | 4138 } |
| 4139 | |
| 4140 DEFUN ("glyph-ascent", Fglyph_ascent, 1, 2, 0, /* | |
| 4141 Return the ascent value of GLYPH on WINDOW. | |
| 4142 This may not be exact as it does not take into account all of the context | |
| 4143 that redisplay will. | |
| 4144 */ | |
| 4145 (glyph, window)) | |
| 4146 { | |
| 793 | 4147 window = wrap_window (decode_window (window)); |
| 428 | 4148 CHECK_GLYPH (glyph); |
| 4149 | |
| 438 | 4150 return make_int (glyph_ascent (glyph, window)); |
| 428 | 4151 } |
| 4152 | |
| 4153 DEFUN ("glyph-descent", Fglyph_descent, 1, 2, 0, /* | |
| 4154 Return the descent value of GLYPH on WINDOW. | |
| 4155 This may not be exact as it does not take into account all of the context | |
| 4156 that redisplay will. | |
| 4157 */ | |
| 4158 (glyph, window)) | |
| 4159 { | |
| 793 | 4160 window = wrap_window (decode_window (window)); |
| 428 | 4161 CHECK_GLYPH (glyph); |
| 4162 | |
| 438 | 4163 return make_int (glyph_descent (glyph, window)); |
| 428 | 4164 } |
| 4165 | |
| 4166 /* This is redundant but I bet a lot of people expect it to exist. */ | |
| 4167 DEFUN ("glyph-height", Fglyph_height, 1, 2, 0, /* | |
| 4168 Return the height of GLYPH on WINDOW. | |
| 4169 This may not be exact as it does not take into account all of the context | |
| 4170 that redisplay will. | |
| 4171 */ | |
| 4172 (glyph, window)) | |
| 4173 { | |
| 793 | 4174 window = wrap_window (decode_window (window)); |
| 428 | 4175 CHECK_GLYPH (glyph); |
| 4176 | |
| 438 | 4177 return make_int (glyph_height (glyph, window)); |
| 428 | 4178 } |
| 4179 | |
| 4180 static void | |
| 4181 set_glyph_dirty_p (Lisp_Object glyph_or_image, Lisp_Object window, int dirty) | |
| 4182 { | |
| 4183 Lisp_Object instance = glyph_or_image; | |
| 4184 | |
| 4185 if (!NILP (glyph_or_image)) | |
| 4186 { | |
| 4187 if (GLYPHP (glyph_or_image)) | |
| 4188 { | |
| 4189 instance = glyph_image_instance (glyph_or_image, window, | |
| 793 | 4190 ERROR_ME_DEBUG_WARN, 1); |
| 428 | 4191 XGLYPH_DIRTYP (glyph_or_image) = dirty; |
| 4192 } | |
| 4193 | |
| 442 | 4194 if (!IMAGE_INSTANCEP (instance)) |
| 4195 return; | |
| 4196 | |
| 428 | 4197 XIMAGE_INSTANCE_DIRTYP (instance) = dirty; |
| 4198 } | |
| 4199 } | |
| 4200 | |
| 442 | 4201 static void |
| 4202 set_image_instance_dirty_p (Lisp_Object instance, int dirty) | |
| 4203 { | |
| 4204 if (IMAGE_INSTANCEP (instance)) | |
| 4205 { | |
| 4206 XIMAGE_INSTANCE_DIRTYP (instance) = dirty; | |
| 4207 /* Now cascade up the hierarchy. */ | |
| 4208 set_image_instance_dirty_p (XIMAGE_INSTANCE_PARENT (instance), | |
| 4209 dirty); | |
| 4210 } | |
| 4211 else if (GLYPHP (instance)) | |
| 4212 { | |
| 4213 XGLYPH_DIRTYP (instance) = dirty; | |
| 4214 } | |
| 4215 } | |
| 4216 | |
| 428 | 4217 /* #### do we need to cache this info to speed things up? */ |
| 4218 | |
| 4219 Lisp_Object | |
| 4220 glyph_baseline (Lisp_Object glyph, Lisp_Object domain) | |
| 4221 { | |
| 4222 if (!GLYPHP (glyph)) | |
| 4223 return Qnil; | |
| 4224 else | |
| 4225 { | |
| 4226 Lisp_Object retval = | |
| 4227 specifier_instance_no_quit (GLYPH_BASELINE (XGLYPH (glyph)), | |
| 793 | 4228 /* #### look into error flag */ |
| 4229 Qunbound, domain, ERROR_ME_DEBUG_WARN, | |
| 428 | 4230 0, Qzero); |
| 4231 if (!NILP (retval) && !INTP (retval)) | |
| 4232 retval = Qnil; | |
| 4233 else if (INTP (retval)) | |
| 4234 { | |
| 4235 if (XINT (retval) < 0) | |
| 4236 retval = Qzero; | |
| 4237 if (XINT (retval) > 100) | |
| 4238 retval = make_int (100); | |
| 4239 } | |
| 4240 return retval; | |
| 4241 } | |
| 4242 } | |
| 4243 | |
| 4244 Lisp_Object | |
| 2286 | 4245 glyph_face (Lisp_Object glyph, Lisp_Object UNUSED (domain)) |
| 428 | 4246 { |
| 4247 /* #### Domain parameter not currently used but it will be */ | |
| 4248 return GLYPHP (glyph) ? GLYPH_FACE (XGLYPH (glyph)) : Qnil; | |
| 4249 } | |
| 4250 | |
| 4251 int | |
| 4252 glyph_contrib_p (Lisp_Object glyph, Lisp_Object domain) | |
| 4253 { | |
| 4254 if (!GLYPHP (glyph)) | |
| 4255 return 0; | |
| 4256 else | |
| 4257 return !NILP (specifier_instance_no_quit | |
| 4258 (GLYPH_CONTRIB_P (XGLYPH (glyph)), Qunbound, domain, | |
| 793 | 4259 /* #### look into error flag */ |
| 4260 ERROR_ME_DEBUG_WARN, 0, Qzero)); | |
| 428 | 4261 } |
| 4262 | |
| 4263 static void | |
| 4264 glyph_property_was_changed (Lisp_Object glyph, Lisp_Object property, | |
| 4265 Lisp_Object locale) | |
| 4266 { | |
| 4267 if (XGLYPH (glyph)->after_change) | |
| 4268 (XGLYPH (glyph)->after_change) (glyph, property, locale); | |
| 4269 } | |
| 4270 | |
| 442 | 4271 void |
| 4272 glyph_query_geometry (Lisp_Object glyph_or_image, int* width, int* height, | |
| 438 | 4273 enum image_instance_geometry disp, Lisp_Object domain) |
| 4274 { | |
| 4275 Lisp_Object instance = glyph_or_image; | |
| 4276 | |
| 4277 if (GLYPHP (glyph_or_image)) | |
| 793 | 4278 instance = glyph_image_instance (glyph_or_image, domain, |
| 4279 ERROR_ME_DEBUG_WARN, 1); | |
| 440 | 4280 |
| 438 | 4281 image_instance_query_geometry (instance, width, height, disp, domain); |
| 4282 } | |
| 4283 | |
| 442 | 4284 void |
| 4285 glyph_do_layout (Lisp_Object glyph_or_image, int width, int height, | |
| 4286 int xoffset, int yoffset, Lisp_Object domain) | |
| 438 | 4287 { |
| 4288 Lisp_Object instance = glyph_or_image; | |
| 4289 | |
| 4290 if (GLYPHP (glyph_or_image)) | |
| 793 | 4291 instance = glyph_image_instance (glyph_or_image, domain, |
| 4292 ERROR_ME_DEBUG_WARN, 1); | |
| 442 | 4293 |
| 4294 image_instance_layout (instance, width, height, xoffset, yoffset, domain); | |
| 4295 } | |
| 438 | 4296 |
| 428 | 4297 |
| 4298 /***************************************************************************** | |
| 4968 | 4299 * glyph cachel functions * |
| 428 | 4300 *****************************************************************************/ |
| 4301 | |
| 4968 | 4302 #define NUM_PRECACHED_GLYPHS 6 |
| 4303 #define LOOP_OVER_PRECACHED_GLYPHS \ | |
| 4304 FROB (Vcontinuation_glyph, CONT_GLYPH_INDEX) \ | |
| 4305 FROB (Vtruncation_glyph, TRUN_GLYPH_INDEX) \ | |
| 4306 FROB (Vhscroll_glyph, HSCROLL_GLYPH_INDEX) \ | |
| 4307 FROB (Vcontrol_arrow_glyph, CONTROL_GLYPH_INDEX) \ | |
| 4308 FROB (Voctal_escape_glyph, OCT_ESC_GLYPH_INDEX) \ | |
| 4309 FROB (Vinvisible_text_glyph, INVIS_GLYPH_INDEX) | |
| 4310 | |
| 4311 | |
| 442 | 4312 /* #### All of this is 95% copied from face cachels. Consider |
| 4313 consolidating. | |
| 4314 | |
| 4315 Why do we need glyph_cachels? Simply because a glyph_cachel captures | |
| 4316 per-window information about a particular glyph. A glyph itself is | |
| 4317 not created in any particular context, so if we were to rely on a | |
| 4318 glyph to tell us about its dirtiness we would not be able to reset | |
| 4319 the dirty flag after redisplaying it as it may exist in other | |
| 4320 contexts. When we have redisplayed we need to know which glyphs to | |
| 4321 reset the dirty flags on - the glyph_cachels give us a nice list we | |
| 4322 can iterate through doing this. */ | |
| 428 | 4323 void |
| 4324 mark_glyph_cachels (glyph_cachel_dynarr *elements) | |
| 4325 { | |
| 4326 int elt; | |
| 4327 | |
| 4328 if (!elements) | |
| 4329 return; | |
| 4330 | |
| 4331 for (elt = 0; elt < Dynarr_length (elements); elt++) | |
| 4332 { | |
| 4333 struct glyph_cachel *cachel = Dynarr_atp (elements, elt); | |
| 4334 mark_object (cachel->glyph); | |
| 4335 } | |
| 4336 } | |
| 4337 | |
| 4338 static void | |
| 4339 update_glyph_cachel_data (struct window *w, Lisp_Object glyph, | |
| 4340 struct glyph_cachel *cachel) | |
| 4341 { | |
| 4342 if (!cachel->updated || NILP (cachel->glyph) || !EQ (cachel->glyph, glyph) | |
| 440 | 4343 || XGLYPH_DIRTYP (cachel->glyph) |
| 4344 || XFRAME(WINDOW_FRAME(w))->faces_changed) | |
| 428 | 4345 { |
| 4346 Lisp_Object window, instance; | |
| 4347 | |
| 793 | 4348 window = wrap_window (w); |
| 428 | 4349 |
| 4350 cachel->glyph = glyph; | |
| 440 | 4351 /* Speed things up slightly by grabbing the glyph instantiation |
| 4352 and passing it to the size functions. */ | |
| 793 | 4353 instance = glyph_image_instance (glyph, window, ERROR_ME_DEBUG_WARN, 1); |
| 440 | 4354 |
| 442 | 4355 if (!IMAGE_INSTANCEP (instance)) |
| 4356 return; | |
| 4357 | |
| 440 | 4358 /* Mark text instance of the glyph dirty if faces have changed, |
| 4359 because its geometry might have changed. */ | |
| 4360 invalidate_glyph_geometry_maybe (instance, w); | |
| 4361 | |
| 4362 /* #### Do the following 2 lines buy us anything? --kkm */ | |
| 4363 XGLYPH_DIRTYP (glyph) = XIMAGE_INSTANCE_DIRTYP (instance); | |
| 4364 cachel->dirty = XGLYPH_DIRTYP (glyph); | |
| 438 | 4365 cachel->width = glyph_width (instance, window); |
| 4366 cachel->ascent = glyph_ascent (instance, window); | |
| 4367 cachel->descent = glyph_descent (instance, window); | |
| 428 | 4368 } |
| 4369 | |
| 4370 cachel->updated = 1; | |
| 4371 } | |
| 4372 | |
| 4373 static void | |
| 4374 add_glyph_cachel (struct window *w, Lisp_Object glyph) | |
| 4375 { | |
| 4376 struct glyph_cachel new_cachel; | |
| 4377 | |
| 4378 xzero (new_cachel); | |
| 4379 new_cachel.glyph = Qnil; | |
| 4380 | |
| 4381 update_glyph_cachel_data (w, glyph, &new_cachel); | |
| 4382 Dynarr_add (w->glyph_cachels, new_cachel); | |
| 4383 } | |
| 4384 | |
| 4968 | 4385 #ifdef ERROR_CHECK_GLYPHS |
| 4386 | |
| 4387 /* The precached glyphs should always occur in slots 0 - 5, with each glyph in the | |
| 4388 slot reserved for it. Meanwhile any other glyphs should always occur in slots | |
| 4389 6 or greater. */ | |
| 4390 static void | |
| 4391 verify_glyph_index (Lisp_Object glyph, glyph_index idx) | |
| 4392 { | |
| 4393 if (0) | |
| 4394 ; | |
| 4395 #define FROB(glyph_obj, gindex) \ | |
| 4396 else if (EQ (glyph, glyph_obj)) \ | |
| 4397 assert (gindex == idx); | |
| 4398 LOOP_OVER_PRECACHED_GLYPHS | |
| 4399 else | |
| 4400 assert (idx >= NUM_PRECACHED_GLYPHS); | |
| 4401 #undef FROB | |
| 4402 } | |
| 4403 | |
| 4404 #endif /* ERROR_CHECK_GLYPHS */ | |
| 4405 | |
| 428 | 4406 glyph_index |
| 4407 get_glyph_cachel_index (struct window *w, Lisp_Object glyph) | |
| 4408 { | |
| 4409 int elt; | |
| 4410 | |
| 4411 if (noninteractive) | |
| 4412 return 0; | |
| 4413 | |
| 4414 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++) | |
| 4415 { | |
| 4416 struct glyph_cachel *cachel = | |
| 4417 Dynarr_atp (w->glyph_cachels, elt); | |
| 4418 | |
| 4419 if (EQ (cachel->glyph, glyph) && !NILP (glyph)) | |
| 4420 { | |
| 4968 | 4421 #ifdef ERROR_CHECK_GLYPHS |
| 4422 verify_glyph_index (glyph, elt); | |
| 4423 #endif /* ERROR_CHECK_GLYPHS */ | |
| 428 | 4424 update_glyph_cachel_data (w, glyph, cachel); |
| 4425 return elt; | |
| 4426 } | |
| 4427 } | |
| 4428 | |
| 4429 /* If we didn't find the glyph, add it and then return its index. */ | |
| 4430 add_glyph_cachel (w, glyph); | |
| 4431 return elt; | |
| 4432 } | |
| 4433 | |
| 4434 void | |
| 4435 reset_glyph_cachels (struct window *w) | |
| 4436 { | |
| 4437 Dynarr_reset (w->glyph_cachels); | |
| 4968 | 4438 #define FROB(glyph_obj, gindex) \ |
| 4439 get_glyph_cachel_index (w, glyph_obj); | |
| 4440 LOOP_OVER_PRECACHED_GLYPHS | |
| 4441 #undef FROB | |
| 428 | 4442 } |
| 4443 | |
| 4444 void | |
| 4445 mark_glyph_cachels_as_not_updated (struct window *w) | |
| 4446 { | |
| 4447 int elt; | |
| 4448 | |
| 4968 | 4449 /* A previous bug resulted from the glyph cachels never getting reset |
| 4450 in the minibuffer window after creation, and another glyph added before | |
| 4451 we got a chance to add the six normal glyphs that should go first, and | |
| 4452 we got called with only one glyph present. */ | |
| 4453 assert (Dynarr_length (w->glyph_cachels) >= NUM_PRECACHED_GLYPHS); | |
| 428 | 4454 /* We need to have a dirty flag to tell if the glyph has changed. |
| 4455 We can check to see if each glyph variable is actually a | |
| 4456 completely different glyph, though. */ | |
| 4457 #define FROB(glyph_obj, gindex) \ | |
| 4458 update_glyph_cachel_data (w, glyph_obj, \ | |
| 4968 | 4459 Dynarr_atp (w->glyph_cachels, gindex)); |
| 4460 LOOP_OVER_PRECACHED_GLYPHS | |
| 428 | 4461 #undef FROB |
| 4462 | |
| 4463 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++) | |
| 4464 { | |
| 4465 Dynarr_atp (w->glyph_cachels, elt)->updated = 0; | |
| 4466 } | |
| 4467 } | |
| 4468 | |
| 4469 /* Unset the dirty bit on all the glyph cachels that have it. */ | |
| 440 | 4470 void |
| 428 | 4471 mark_glyph_cachels_as_clean (struct window* w) |
| 4472 { | |
| 4473 int elt; | |
| 793 | 4474 Lisp_Object window = wrap_window (w); |
| 4475 | |
| 428 | 4476 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++) |
| 4477 { | |
| 4478 struct glyph_cachel *cachel = Dynarr_atp (w->glyph_cachels, elt); | |
| 4479 cachel->dirty = 0; | |
| 4480 set_glyph_dirty_p (cachel->glyph, window, 0); | |
| 4481 } | |
| 4482 } | |
| 4483 | |
| 4484 #ifdef MEMORY_USAGE_STATS | |
| 4485 | |
| 4486 int | |
| 4487 compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels, | |
|
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
4488 struct usage_stats *ustats) |
| 428 | 4489 { |
| 4490 int total = 0; | |
| 4491 | |
| 4492 if (glyph_cachels) | |
|
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
4493 total += Dynarr_memory_usage (glyph_cachels, ustats); |
| 428 | 4494 |
| 4495 return total; | |
| 4496 } | |
| 4497 | |
| 4498 #endif /* MEMORY_USAGE_STATS */ | |
| 4499 | |
| 4500 | |
| 4501 | |
| 4502 /***************************************************************************** | |
| 4968 | 4503 * subwindow cachel functions * |
| 428 | 4504 *****************************************************************************/ |
| 438 | 4505 /* Subwindows are curious in that you have to physically unmap them to |
| 428 | 4506 not display them. It is problematic deciding what to do in |
| 4507 redisplay. We have two caches - a per-window instance cache that | |
| 4508 keeps track of subwindows on a window, these are linked to their | |
| 4509 instantiator in the hashtable and when the instantiator goes away | |
| 4510 we want the instance to go away also. However we also have a | |
| 4511 per-frame instance cache that we use to determine if a subwindow is | |
| 4512 obscuring an area that we want to clear. We need to be able to flip | |
| 4513 through this quickly so a hashtable is not suitable hence the | |
| 442 | 4514 subwindow_cachels. This is a weak list so unreference instances |
| 4515 will get deleted properly. */ | |
| 428 | 4516 |
| 4517 /* redisplay in general assumes that drawing something will erase | |
| 4518 what was there before. unfortunately this does not apply to | |
| 4519 subwindows that need to be specifically unmapped in order to | |
| 4520 disappear. we take a brute force approach - on the basis that its | |
| 4521 cheap - and unmap all subwindows in a display line */ | |
| 442 | 4522 |
| 4523 /* Put new instances in the frame subwindow cache. This is less costly than | |
| 4524 doing it every time something gets mapped, and deleted instances will be | |
| 4525 removed automatically. */ | |
| 4526 static void | |
| 4527 cache_subwindow_instance_in_frame_maybe (Lisp_Object instance) | |
| 4528 { | |
| 4529 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (instance); | |
| 4530 if (!NILP (DOMAIN_FRAME (IMAGE_INSTANCE_DOMAIN (ii)))) | |
| 428 | 4531 { |
| 442 | 4532 struct frame* f = DOMAIN_XFRAME (IMAGE_INSTANCE_DOMAIN (ii)); |
| 4533 XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)) | |
| 4534 = Fcons (instance, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))); | |
| 4535 } | |
| 4536 } | |
| 4537 | |
| 4538 /* Unmap and finalize all subwindow instances in the frame cache. This | |
| 4539 is necessary because GC will not guarantee the order things get | |
| 4540 deleted in and moreover, frame finalization deletes the window | |
| 4541 system windows before deleting XEmacs windows, and hence | |
| 4542 subwindows. */ | |
| 4543 int | |
| 2286 | 4544 unmap_subwindow_instance_cache_mapper (Lisp_Object UNUSED (key), |
| 4545 Lisp_Object value, void* finalize) | |
| 442 | 4546 { |
| 4547 /* value can be nil; we cache failures as well as successes */ | |
| 4548 if (!NILP (value)) | |
| 4549 { | |
| 4550 struct frame* f = XFRAME (XIMAGE_INSTANCE_FRAME (value)); | |
| 4551 unmap_subwindow (value); | |
| 4552 if (finalize) | |
| 428 | 4553 { |
| 442 | 4554 /* In case GC doesn't catch up fast enough, remove from the frame |
| 4555 cache also. Otherwise code that checks the sanity of the instance | |
| 4556 will fail. */ | |
| 4557 XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)) | |
| 4558 = delq_no_quit (value, | |
| 4559 XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))); | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5126
diff
changeset
|
4560 finalize_image_instance (value); |
| 428 | 4561 } |
| 4562 } | |
| 442 | 4563 return 0; |
| 4564 } | |
| 4565 | |
| 4566 static void | |
| 4567 finalize_all_subwindow_instances (struct window *w) | |
| 4568 { | |
| 4569 if (!NILP (w->next)) finalize_all_subwindow_instances (XWINDOW (w->next)); | |
| 4570 if (!NILP (w->vchild)) finalize_all_subwindow_instances (XWINDOW (w->vchild)); | |
| 4571 if (!NILP (w->hchild)) finalize_all_subwindow_instances (XWINDOW (w->hchild)); | |
| 4572 | |
| 4573 elisp_maphash (unmap_subwindow_instance_cache_mapper, | |
| 4574 w->subwindow_instance_cache, (void*)1); | |
| 428 | 4575 } |
| 4576 | |
| 4577 void | |
| 442 | 4578 free_frame_subwindow_instances (struct frame* f) |
| 4579 { | |
| 4580 /* Make sure all instances are finalized. We have to do this via the | |
| 4581 instance cache since some instances may be extant but not | |
| 4582 displayed (and hence not in the frame cache). */ | |
| 4583 finalize_all_subwindow_instances (XWINDOW (f->root_window)); | |
| 4584 } | |
| 4585 | |
| 4586 /* Unmap all instances in the frame cache. */ | |
| 4587 void | |
| 4588 reset_frame_subwindow_instance_cache (struct frame* f) | |
| 4589 { | |
| 4590 Lisp_Object rest; | |
| 4591 | |
| 4592 LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))) | |
| 4593 { | |
| 4594 Lisp_Object value = XCAR (rest); | |
| 4595 unmap_subwindow (value); | |
| 4596 } | |
| 4597 } | |
| 428 | 4598 |
| 4599 /***************************************************************************** | |
| 4968 | 4600 * subwindow exposure ignorance * |
| 428 | 4601 *****************************************************************************/ |
| 4602 /* when we unmap subwindows the associated window system will generate | |
| 4603 expose events. This we do not want as redisplay already copes with | |
| 4604 the repainting necessary. Worse, we can get in an endless cycle of | |
| 4605 redisplay if we are not careful. Thus we keep a per-frame list of | |
| 4606 expose events that are going to come and ignore them as | |
| 4607 required. */ | |
| 4608 | |
| 3092 | 4609 #ifndef NEW_GC |
| 428 | 4610 struct expose_ignore_blocktype |
| 4611 { | |
| 4612 Blocktype_declare (struct expose_ignore); | |
| 4613 } *the_expose_ignore_blocktype; | |
| 3092 | 4614 #endif /* not NEW_GC */ |
| 428 | 4615 |
| 4616 int | |
| 647 | 4617 check_for_ignored_expose (struct frame* f, int x, int y, int width, int height) |
| 428 | 4618 { |
| 4619 struct expose_ignore *ei, *prev; | |
| 4620 /* the ignore list is FIFO so we should generally get a match with | |
| 4621 the first element in the list */ | |
| 4622 for (ei = f->subwindow_exposures, prev = 0; ei; ei = ei->next) | |
| 4623 { | |
| 4624 /* Checking for exact matches just isn't good enough as we | |
| 442 | 4625 might get exposures for partially obscured subwindows, thus |
| 4626 we have to check for overlaps. Being conservative, we will | |
| 4627 check for exposures wholly contained by the subwindow - this | |
| 428 | 4628 might give us what we want.*/ |
| 440 | 4629 if (ei->x <= x && ei->y <= y |
| 428 | 4630 && ei->x + ei->width >= x + width |
| 4631 && ei->y + ei->height >= y + height) | |
| 4632 { | |
| 4633 #ifdef DEBUG_WIDGETS | |
| 4634 stderr_out ("ignored %d+%d, %dx%d for exposure %d+%d, %dx%d\n", | |
| 4635 x, y, width, height, ei->x, ei->y, ei->width, ei->height); | |
| 4636 #endif | |
| 4637 if (!prev) | |
| 4638 f->subwindow_exposures = ei->next; | |
| 4639 else | |
| 4640 prev->next = ei->next; | |
| 440 | 4641 |
| 428 | 4642 if (ei == f->subwindow_exposures_tail) |
| 4643 f->subwindow_exposures_tail = prev; | |
| 4644 | |
| 4117 | 4645 #ifndef NEW_GC |
| 428 | 4646 Blocktype_free (the_expose_ignore_blocktype, ei); |
| 3092 | 4647 #endif /* not NEW_GC */ |
| 428 | 4648 return 1; |
| 4649 } | |
| 4650 prev = ei; | |
| 4651 } | |
| 4652 return 0; | |
| 4653 } | |
| 4654 | |
| 4655 static void | |
| 4656 register_ignored_expose (struct frame* f, int x, int y, int width, int height) | |
| 4657 { | |
| 4658 if (!hold_ignored_expose_registration) | |
| 4659 { | |
| 4660 struct expose_ignore *ei; | |
| 440 | 4661 |
| 3092 | 4662 #ifdef NEW_GC |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5126
diff
changeset
|
4663 ei = XEXPOSE_IGNORE (ALLOC_NORMAL_LISP_OBJECT (expose_ignore)); |
| 3092 | 4664 #else /* not NEW_GC */ |
| 428 | 4665 ei = Blocktype_alloc (the_expose_ignore_blocktype); |
| 3092 | 4666 #endif /* not NEW_GC */ |
| 440 | 4667 |
| 428 | 4668 ei->next = NULL; |
| 4669 ei->x = x; | |
| 4670 ei->y = y; | |
| 4671 ei->width = width; | |
| 4672 ei->height = height; | |
| 440 | 4673 |
| 428 | 4674 /* we have to add the exposure to the end of the list, since we |
| 4675 want to check the oldest events first. for speed we keep a record | |
| 4676 of the end so that we can add right to it. */ | |
| 4677 if (f->subwindow_exposures_tail) | |
| 4678 { | |
| 4679 f->subwindow_exposures_tail->next = ei; | |
| 4680 } | |
| 4681 if (!f->subwindow_exposures) | |
| 4682 { | |
| 4683 f->subwindow_exposures = ei; | |
| 4684 } | |
| 4685 f->subwindow_exposures_tail = ei; | |
| 4686 } | |
| 4687 } | |
| 4688 | |
| 4689 /**************************************************************************** | |
| 4690 find_matching_subwindow | |
| 4691 | |
| 4692 See if there is a subwindow that completely encloses the requested | |
| 4693 area. | |
| 4694 ****************************************************************************/ | |
| 647 | 4695 int |
| 4696 find_matching_subwindow (struct frame* f, int x, int y, int width, int height) | |
| 428 | 4697 { |
| 442 | 4698 Lisp_Object rest; |
| 4699 | |
| 4700 LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))) | |
| 428 | 4701 { |
| 442 | 4702 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (XCAR (rest)); |
| 4703 | |
| 4704 if (IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) | |
| 4705 && | |
| 4706 IMAGE_INSTANCE_DISPLAY_X (ii) <= x | |
| 428 | 4707 && |
| 442 | 4708 IMAGE_INSTANCE_DISPLAY_Y (ii) <= y |
| 440 | 4709 && |
| 442 | 4710 IMAGE_INSTANCE_DISPLAY_X (ii) |
| 4711 + IMAGE_INSTANCE_DISPLAY_WIDTH (ii) >= x + width | |
| 428 | 4712 && |
| 442 | 4713 IMAGE_INSTANCE_DISPLAY_Y (ii) |
| 4714 + IMAGE_INSTANCE_DISPLAY_HEIGHT (ii) >= y + height) | |
| 428 | 4715 { |
| 4716 return 1; | |
| 4717 } | |
| 4718 } | |
| 4719 return 0; | |
| 4720 } | |
| 4721 | |
| 4722 | |
| 4723 /***************************************************************************** | |
| 4724 * subwindow functions * | |
| 4725 *****************************************************************************/ | |
| 4726 | |
| 442 | 4727 /* Update the displayed characteristics of a subwindow. This function |
| 4728 should generally only get called if the subwindow is actually | |
| 4729 dirty. */ | |
| 4730 void | |
| 4731 redisplay_subwindow (Lisp_Object subwindow) | |
| 428 | 4732 { |
| 440 | 4733 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); |
| 442 | 4734 int count = specpdl_depth (); |
| 4735 | |
| 4736 /* The update method is allowed to call eval. Since it is quite | |
| 4737 common for this function to get called from somewhere in | |
| 4738 redisplay we need to make sure that quits are ignored. Otherwise | |
| 4739 Fsignal will abort. */ | |
| 4740 specbind (Qinhibit_quit, Qt); | |
| 4741 | |
| 4742 ERROR_CHECK_IMAGE_INSTANCE (subwindow); | |
| 4743 | |
| 4744 if (WIDGET_IMAGE_INSTANCEP (subwindow)) | |
| 4745 { | |
| 4746 if (image_instance_changed (subwindow)) | |
| 4747 redisplay_widget (subwindow); | |
| 4748 /* Reset the changed flags. */ | |
| 4749 IMAGE_INSTANCE_WIDGET_FACE_CHANGED (ii) = 0; | |
| 4750 IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii) = 0; | |
| 4751 IMAGE_INSTANCE_WIDGET_ACTION_OCCURRED (ii) = 0; | |
| 4752 IMAGE_INSTANCE_TEXT_CHANGED (ii) = 0; | |
| 4753 } | |
| 4754 else if (IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW | |
| 4755 && | |
| 4756 !NILP (IMAGE_INSTANCE_FRAME (ii))) | |
| 4757 { | |
| 4758 MAYBE_DEVMETH (DOMAIN_XDEVICE (ii->domain), | |
| 4759 redisplay_subwindow, (ii)); | |
| 4760 } | |
| 4761 | |
| 4762 IMAGE_INSTANCE_SIZE_CHANGED (ii) = 0; | |
| 4763 /* This function is typically called by redisplay just before | |
| 4764 outputting the information to the screen. Thus we record a hash | |
| 4765 of the output to determine whether on-screen is the same as | |
| 4766 recorded structure. This approach has limitations in there is a | |
| 4767 good chance that hash values will be different for the same | |
| 4768 visual appearance. However, we would rather that then the other | |
| 4769 way round - it simply means that we will get more displays than | |
| 4770 we might need. We can get better hashing by making the depth | |
| 4771 negative - currently it will recurse down 7 levels.*/ | |
| 4772 IMAGE_INSTANCE_DISPLAY_HASH (ii) = internal_hash (subwindow, | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
4773 IMAGE_INSTANCE_HASH_DEPTH, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
4774 0); |
| 442 | 4775 |
| 771 | 4776 unbind_to (count); |
| 442 | 4777 } |
| 4778 | |
| 4779 /* Determine whether an image_instance has changed structurally and | |
| 4780 hence needs redisplaying in some way. | |
| 4781 | |
| 4782 #### This should just look at the instantiator differences when we | |
| 4783 get rid of the stored items altogether. In fact we should probably | |
| 4784 store the new instantiator as well as the old - as we do with | |
| 4785 gui_items currently - and then pick-up the new on the next | |
| 4786 redisplay. This would obviate the need for any of this trickery | |
| 4787 with hashcodes. */ | |
| 4788 int | |
| 4789 image_instance_changed (Lisp_Object subwindow) | |
| 4790 { | |
| 4791 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); | |
| 4792 | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
4793 if (internal_hash (subwindow, IMAGE_INSTANCE_HASH_DEPTH, 0) != |
| 442 | 4794 IMAGE_INSTANCE_DISPLAY_HASH (ii)) |
| 4795 return 1; | |
| 4796 /* #### I think there is probably a bug here. This gets called for | |
| 4797 layouts - and yet the pending items are always nil for | |
| 4798 layouts. We are saved by layout optimization, but I'm undecided | |
| 4799 as to what the correct fix is. */ | |
| 4800 else if (WIDGET_IMAGE_INSTANCEP (subwindow) | |
| 853 | 4801 && (!internal_equal_trapping_problems |
| 4802 (Qglyph, "bad subwindow instantiator", | |
| 4803 /* in this case we really don't want to be | |
| 4804 interrupted by QUIT because we care about | |
| 4805 the return value; and we know that any loops | |
| 4806 will ultimately cause errors to be issued. | |
| 4807 We specify a retval of 1 in that case so that | |
| 4808 the glyph code doesn't try to keep reoutputting | |
| 4809 a bad subwindow. */ | |
| 4810 INHIBIT_QUIT, 0, 1, IMAGE_INSTANCE_WIDGET_ITEMS (ii), | |
| 4811 IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii), 0) | |
| 442 | 4812 || !NILP (IMAGE_INSTANCE_LAYOUT_CHILDREN (ii)) |
| 4813 || IMAGE_INSTANCE_WIDGET_ACTION_OCCURRED (ii))) | |
| 4814 return 1; | |
| 4815 else | |
| 4816 return 0; | |
| 428 | 4817 } |
| 4818 | |
| 438 | 4819 /* Update all the subwindows on a frame. */ |
| 428 | 4820 void |
| 442 | 4821 update_widget_instances (Lisp_Object frame) |
| 4822 { | |
| 4823 struct frame* f; | |
| 4824 Lisp_Object rest; | |
| 4825 | |
| 4826 /* Its possible for the preceding callback to have deleted the | |
| 4827 frame, so cope with this. */ | |
| 4828 if (!FRAMEP (frame) || !FRAME_LIVE_P (XFRAME (frame))) | |
| 4829 return; | |
| 4830 | |
| 4831 CHECK_FRAME (frame); | |
| 4832 f = XFRAME (frame); | |
| 4833 | |
| 4834 /* If we get called we know something has changed. */ | |
| 4835 LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))) | |
| 4836 { | |
| 4837 Lisp_Object widget = XCAR (rest); | |
| 4838 | |
| 4839 if (XIMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (widget) | |
| 4840 && | |
| 4841 image_instance_changed (widget)) | |
| 4842 { | |
| 4843 set_image_instance_dirty_p (widget, 1); | |
| 4844 MARK_FRAME_GLYPHS_CHANGED (f); | |
| 4845 } | |
| 4846 } | |
| 428 | 4847 } |
| 4848 | |
| 4849 /* remove a subwindow from its frame */ | |
| 793 | 4850 void |
| 4851 unmap_subwindow (Lisp_Object subwindow) | |
| 428 | 4852 { |
| 440 | 4853 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); |
| 428 | 4854 struct frame* f; |
| 4855 | |
| 442 | 4856 ERROR_CHECK_IMAGE_INSTANCE (subwindow); |
| 4857 | |
| 1204 | 4858 if (!(image_instance_type_to_mask (IMAGE_INSTANCE_TYPE (ii)) |
| 4859 & (IMAGE_WIDGET_MASK | IMAGE_SUBWINDOW_MASK)) | |
| 4860 || !IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii)) | |
| 428 | 4861 return; |
| 442 | 4862 |
| 428 | 4863 #ifdef DEBUG_WIDGETS |
| 442 | 4864 stderr_out ("unmapping subwindow %p\n", IMAGE_INSTANCE_SUBWINDOW_ID (ii)); |
| 428 | 4865 #endif |
| 442 | 4866 f = XFRAME (IMAGE_INSTANCE_FRAME (ii)); |
| 428 | 4867 |
| 4868 /* make sure we don't get expose events */ | |
| 442 | 4869 register_ignored_expose (f, IMAGE_INSTANCE_DISPLAY_X (ii), |
| 4870 IMAGE_INSTANCE_DISPLAY_Y (ii), | |
| 4871 IMAGE_INSTANCE_DISPLAY_WIDTH (ii), | |
| 4252 | 4872 IMAGE_INSTANCE_DISPLAY_HEIGHT (ii)); |
| 428 | 4873 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0; |
| 4874 | |
| 442 | 4875 MAYBE_DEVMETH (XDEVICE (IMAGE_INSTANCE_DEVICE (ii)), |
| 4876 unmap_subwindow, (ii)); | |
| 428 | 4877 } |
| 4878 | |
| 4879 /* show a subwindow in its frame */ | |
| 793 | 4880 void |
| 4881 map_subwindow (Lisp_Object subwindow, int x, int y, | |
| 4882 struct display_glyph_area *dga) | |
| 428 | 4883 { |
| 440 | 4884 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); |
| 428 | 4885 |
| 442 | 4886 ERROR_CHECK_IMAGE_INSTANCE (subwindow); |
| 4887 | |
| 1204 | 4888 if (!(image_instance_type_to_mask (IMAGE_INSTANCE_TYPE (ii)) |
| 4889 & (IMAGE_WIDGET_MASK | IMAGE_SUBWINDOW_MASK))) | |
| 428 | 4890 return; |
| 4891 | |
| 4892 #ifdef DEBUG_WIDGETS | |
| 442 | 4893 stderr_out ("mapping subwindow %p, %dx%d@%d+%d\n", |
| 428 | 4894 IMAGE_INSTANCE_SUBWINDOW_ID (ii), |
| 4895 dga->width, dga->height, x, y); | |
| 4896 #endif | |
| 2286 | 4897 /* Error check by side effect */ |
| 4898 (void) XFRAME (IMAGE_INSTANCE_FRAME (ii)); | |
| 442 | 4899 IMAGE_INSTANCE_DISPLAY_X (ii) = x; |
| 4900 IMAGE_INSTANCE_DISPLAY_Y (ii) = y; | |
| 4901 IMAGE_INSTANCE_DISPLAY_WIDTH (ii) = dga->width; | |
| 4902 IMAGE_INSTANCE_DISPLAY_HEIGHT (ii) = dga->height; | |
| 4903 | |
| 4904 MAYBE_DEVMETH (DOMAIN_XDEVICE (ii->domain), | |
| 4905 map_subwindow, (ii, x, y, dga)); | |
| 428 | 4906 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 1; |
| 4907 } | |
| 4908 | |
| 4909 static int | |
| 4910 subwindow_possible_dest_types (void) | |
| 4911 { | |
| 4912 return IMAGE_SUBWINDOW_MASK; | |
| 4913 } | |
| 4914 | |
| 442 | 4915 int |
| 4916 subwindow_governing_domain (void) | |
| 4917 { | |
| 4918 return GOVERNING_DOMAIN_WINDOW; | |
| 4919 } | |
| 4920 | |
| 428 | 4921 /* Partially instantiate a subwindow. */ |
| 4922 void | |
| 4923 subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, | |
| 2286 | 4924 Lisp_Object UNUSED (pointer_fg), |
| 4925 Lisp_Object UNUSED (pointer_bg), | |
| 428 | 4926 int dest_mask, Lisp_Object domain) |
| 4927 { | |
| 440 | 4928 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); |
| 442 | 4929 Lisp_Object device = image_instance_device (image_instance); |
| 4930 Lisp_Object frame = DOMAIN_FRAME (domain); | |
| 428 | 4931 Lisp_Object width = find_keyword_in_vector (instantiator, Q_pixel_width); |
| 4932 Lisp_Object height = find_keyword_in_vector (instantiator, Q_pixel_height); | |
| 4933 | |
| 4934 if (NILP (frame)) | |
| 563 | 4935 invalid_state ("No selected frame", device); |
| 440 | 4936 |
| 428 | 4937 if (!(dest_mask & IMAGE_SUBWINDOW_MASK)) |
| 4938 incompatible_image_types (instantiator, dest_mask, IMAGE_SUBWINDOW_MASK); | |
| 4939 | |
| 4940 ii->data = 0; | |
| 4941 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = 0; | |
| 4942 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0; | |
| 442 | 4943 |
| 4944 if (INTP (width)) | |
| 428 | 4945 { |
| 4946 int w = 1; | |
| 4947 if (XINT (width) > 1) | |
| 4948 w = XINT (width); | |
| 442 | 4949 IMAGE_INSTANCE_WIDTH (ii) = w; |
| 4950 IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii) = 0; | |
| 428 | 4951 } |
| 442 | 4952 |
| 4953 if (INTP (height)) | |
| 428 | 4954 { |
| 4955 int h = 1; | |
| 4956 if (XINT (height) > 1) | |
| 4957 h = XINT (height); | |
| 442 | 4958 IMAGE_INSTANCE_HEIGHT (ii) = h; |
| 4959 IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii) = 0; | |
| 428 | 4960 } |
| 4961 } | |
| 4962 | |
| 442 | 4963 /* This is just a backup in case no-one has assigned a suitable geometry. |
| 4964 #### It should really query the enclose window for geometry. */ | |
| 4965 static void | |
| 2286 | 4966 subwindow_query_geometry (Lisp_Object UNUSED (image_instance), |
| 4967 int* width, int* height, | |
| 4968 enum image_instance_geometry UNUSED (disp), | |
| 4969 Lisp_Object UNUSED (domain)) | |
| 442 | 4970 { |
| 4971 if (width) *width = 20; | |
| 4972 if (height) *height = 20; | |
| 4973 } | |
| 4974 | |
| 428 | 4975 DEFUN ("subwindowp", Fsubwindowp, 1, 1, 0, /* |
| 4976 Return non-nil if OBJECT is a subwindow. | |
| 4977 */ | |
| 4978 (object)) | |
| 4979 { | |
| 4980 CHECK_IMAGE_INSTANCE (object); | |
| 4981 return (XIMAGE_INSTANCE_TYPE (object) == IMAGE_SUBWINDOW) ? Qt : Qnil; | |
| 4982 } | |
| 4983 | |
| 4984 DEFUN ("image-instance-subwindow-id", Fimage_instance_subwindow_id, 1, 1, 0, /* | |
| 4985 Return the window id of SUBWINDOW as a number. | |
| 4986 */ | |
| 4987 (subwindow)) | |
| 4988 { | |
| 4989 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow); | |
| 442 | 4990 return make_int ((EMACS_INT) XIMAGE_INSTANCE_SUBWINDOW_ID (subwindow)); |
| 428 | 4991 } |
| 4992 | |
| 4993 DEFUN ("resize-subwindow", Fresize_subwindow, 1, 3, 0, /* | |
| 4994 Resize SUBWINDOW to WIDTH x HEIGHT. | |
| 4995 If a value is nil that parameter is not changed. | |
| 4996 */ | |
| 4997 (subwindow, width, height)) | |
| 4998 { | |
| 4999 int neww, newh; | |
| 442 | 5000 Lisp_Image_Instance* ii; |
| 428 | 5001 |
| 5002 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow); | |
| 442 | 5003 ii = XIMAGE_INSTANCE (subwindow); |
| 428 | 5004 |
| 5005 if (NILP (width)) | |
| 442 | 5006 neww = IMAGE_INSTANCE_WIDTH (ii); |
| 428 | 5007 else |
| 5008 neww = XINT (width); | |
| 5009 | |
| 5010 if (NILP (height)) | |
| 442 | 5011 newh = IMAGE_INSTANCE_HEIGHT (ii); |
| 428 | 5012 else |
| 5013 newh = XINT (height); | |
| 5014 | |
| 442 | 5015 /* The actual resizing gets done asynchronously by |
| 438 | 5016 update_subwindow. */ |
| 442 | 5017 IMAGE_INSTANCE_HEIGHT (ii) = newh; |
| 5018 IMAGE_INSTANCE_WIDTH (ii) = neww; | |
| 5019 IMAGE_INSTANCE_SIZE_CHANGED (ii) = 1; | |
| 428 | 5020 |
| 5021 return subwindow; | |
| 5022 } | |
| 5023 | |
| 5024 DEFUN ("force-subwindow-map", Fforce_subwindow_map, 1, 1, 0, /* | |
| 5025 Generate a Map event for SUBWINDOW. | |
| 5026 */ | |
| 5027 (subwindow)) | |
| 5028 { | |
| 5029 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow); | |
| 5030 #if 0 | |
| 5031 map_subwindow (subwindow, 0, 0); | |
| 5032 #endif | |
| 5033 return subwindow; | |
| 5034 } | |
| 5035 | |
| 5036 | |
| 5037 /***************************************************************************** | |
| 5038 * display tables * | |
| 5039 *****************************************************************************/ | |
| 5040 | |
| 5041 /* Get the display tables for use currently on window W with face | |
| 5042 FACE. #### This will have to be redone. */ | |
| 5043 | |
| 5044 void | |
| 5045 get_display_tables (struct window *w, face_index findex, | |
| 5046 Lisp_Object *face_table, Lisp_Object *window_table) | |
| 5047 { | |
| 5048 Lisp_Object tem; | |
| 5049 tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex); | |
| 5050 if (UNBOUNDP (tem)) | |
| 5051 tem = Qnil; | |
| 5052 if (!LISTP (tem)) | |
| 5053 tem = noseeum_cons (tem, Qnil); | |
| 5054 *face_table = tem; | |
| 5055 tem = w->display_table; | |
| 5056 if (UNBOUNDP (tem)) | |
| 5057 tem = Qnil; | |
| 5058 if (!LISTP (tem)) | |
| 5059 tem = noseeum_cons (tem, Qnil); | |
| 5060 *window_table = tem; | |
| 5061 } | |
| 5062 | |
| 5063 Lisp_Object | |
| 867 | 5064 display_table_entry (Ichar ch, Lisp_Object face_table, |
| 428 | 5065 Lisp_Object window_table) |
| 5066 { | |
| 5067 Lisp_Object tail; | |
| 5068 | |
| 5069 /* Loop over FACE_TABLE, and then over WINDOW_TABLE. */ | |
| 5070 for (tail = face_table; 1; tail = XCDR (tail)) | |
| 5071 { | |
| 5072 Lisp_Object table; | |
| 5073 if (NILP (tail)) | |
| 5074 { | |
| 5075 if (!NILP (window_table)) | |
| 5076 { | |
| 5077 tail = window_table; | |
| 5078 window_table = Qnil; | |
| 5079 } | |
| 5080 else | |
| 5081 return Qnil; | |
| 5082 } | |
| 5083 table = XCAR (tail); | |
| 5084 | |
| 5085 if (VECTORP (table)) | |
| 5086 { | |
| 5087 if (ch < XVECTOR_LENGTH (table) && !NILP (XVECTOR_DATA (table)[ch])) | |
| 5088 return XVECTOR_DATA (table)[ch]; | |
| 5089 else | |
| 5090 continue; | |
| 5091 } | |
| 5092 else if (CHAR_TABLEP (table) | |
| 5093 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR) | |
| 5094 { | |
| 826 | 5095 return get_char_table (ch, table); |
| 428 | 5096 } |
| 5097 else if (CHAR_TABLEP (table) | |
| 5098 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC) | |
| 5099 { | |
| 826 | 5100 Lisp_Object gotit = get_char_table (ch, table); |
| 428 | 5101 if (!NILP (gotit)) |
| 5102 return gotit; | |
| 5103 else | |
| 5104 continue; | |
| 5105 } | |
| 5106 else if (RANGE_TABLEP (table)) | |
| 5107 { | |
| 5108 Lisp_Object gotit = Fget_range_table (make_char (ch), table, Qnil); | |
| 5109 if (!NILP (gotit)) | |
| 5110 return gotit; | |
| 5111 else | |
| 5112 continue; | |
| 5113 } | |
| 5114 else | |
| 2500 | 5115 ABORT (); |
| 428 | 5116 } |
| 5117 } | |
| 5118 | |
| 793 | 5119 /**************************************************************************** |
| 5120 * timeouts for animated glyphs * | |
| 5121 ****************************************************************************/ | |
| 428 | 5122 static Lisp_Object Qglyph_animated_timeout_handler; |
| 5123 | |
| 5124 DEFUN ("glyph-animated-timeout-handler", Fglyph_animated_timeout_handler, 1, 1, 0, /* | |
| 5125 Callback function for updating animated images. | |
| 5126 Don't use this. | |
| 5127 */ | |
| 5128 (arg)) | |
| 5129 { | |
| 5130 CHECK_WEAK_LIST (arg); | |
| 5131 | |
| 5132 if (!NILP (XWEAK_LIST_LIST (arg)) && !NILP (XCAR (XWEAK_LIST_LIST (arg)))) | |
| 5133 { | |
| 5134 Lisp_Object value = XCAR (XWEAK_LIST_LIST (arg)); | |
| 440 | 5135 |
| 428 | 5136 if (IMAGE_INSTANCEP (value)) |
| 5137 { | |
| 440 | 5138 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (value); |
| 428 | 5139 |
| 5140 if (COLOR_PIXMAP_IMAGE_INSTANCEP (value) | |
| 5141 && | |
| 5142 IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii) > 1 | |
| 5143 && | |
| 5144 !disable_animated_pixmaps) | |
| 5145 { | |
| 5146 /* Increment the index of the image slice we are currently | |
| 5147 viewing. */ | |
| 4252 | 5148 IMAGE_INSTANCE_PIXMAP_SLICE (ii) = |
| 428 | 5149 (IMAGE_INSTANCE_PIXMAP_SLICE (ii) + 1) |
| 5150 % IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii); | |
| 5151 /* We might need to kick redisplay at this point - but we | |
| 5152 also might not. */ | |
| 440 | 5153 MARK_DEVICE_FRAMES_GLYPHS_CHANGED |
| 442 | 5154 (XDEVICE (image_instance_device (value))); |
| 5155 /* Cascade dirtiness so that we can have an animated glyph in a layout | |
| 5156 for instance. */ | |
| 5157 set_image_instance_dirty_p (value, 1); | |
| 428 | 5158 } |
| 5159 } | |
| 5160 } | |
| 5161 return Qnil; | |
| 5162 } | |
| 5163 | |
| 793 | 5164 Lisp_Object |
| 5165 add_glyph_animated_timeout (EMACS_INT tickms, Lisp_Object image) | |
| 428 | 5166 { |
| 5167 Lisp_Object ret = Qnil; | |
| 5168 | |
| 5169 if (tickms > 0 && IMAGE_INSTANCEP (image)) | |
| 5170 { | |
| 5171 double ms = ((double)tickms) / 1000.0; | |
| 5172 struct gcpro gcpro1; | |
| 5173 Lisp_Object holder = make_weak_list (WEAK_LIST_SIMPLE); | |
| 5174 | |
| 5175 GCPRO1 (holder); | |
| 5176 XWEAK_LIST_LIST (holder) = Fcons (image, Qnil); | |
| 5177 | |
| 5178 ret = Fadd_timeout (make_float (ms), | |
| 5179 Qglyph_animated_timeout_handler, | |
| 5180 holder, make_float (ms)); | |
| 5181 | |
| 5182 UNGCPRO; | |
| 5183 } | |
| 5184 return ret; | |
| 5185 } | |
| 5186 | |
| 793 | 5187 void |
| 5188 disable_glyph_animated_timeout (int i) | |
| 5189 { | |
| 5190 Fdisable_timeout (make_int (i)); | |
| 428 | 5191 } |
| 5192 | |
| 5193 | |
| 5194 /***************************************************************************** | |
| 5195 * initialization * | |
| 5196 *****************************************************************************/ | |
| 5197 | |
| 5198 void | |
|
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
5199 glyph_objects_create (void) |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
5200 { |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
5201 OBJECT_HAS_METHOD (glyph, getprop); |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
5202 OBJECT_HAS_METHOD (glyph, putprop); |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
5203 OBJECT_HAS_METHOD (glyph, remprop); |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
5204 OBJECT_HAS_METHOD (glyph, plist); |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
5205 } |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
5206 |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
5207 void |
| 428 | 5208 syms_of_glyphs (void) |
| 5209 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
5210 INIT_LISP_OBJECT (glyph); |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
5211 INIT_LISP_OBJECT (image_instance); |
| 442 | 5212 |
| 428 | 5213 /* image instantiators */ |
| 5214 | |
| 5215 DEFSUBR (Fimage_instantiator_format_list); | |
| 5216 DEFSUBR (Fvalid_image_instantiator_format_p); | |
| 5217 DEFSUBR (Fset_console_type_image_conversion_list); | |
| 5218 DEFSUBR (Fconsole_type_image_conversion_list); | |
| 5219 | |
| 442 | 5220 DEFKEYWORD (Q_file); |
| 5221 DEFKEYWORD (Q_face); | |
| 5222 DEFKEYWORD (Q_pixel_height); | |
| 5223 DEFKEYWORD (Q_pixel_width); | |
| 428 | 5224 |
| 5225 #ifdef HAVE_XPM | |
| 442 | 5226 DEFKEYWORD (Q_color_symbols); |
| 428 | 5227 #endif |
| 5228 #ifdef HAVE_WINDOW_SYSTEM | |
| 442 | 5229 DEFKEYWORD (Q_mask_file); |
| 5230 DEFKEYWORD (Q_mask_data); | |
| 5231 DEFKEYWORD (Q_hotspot_x); | |
| 5232 DEFKEYWORD (Q_hotspot_y); | |
| 5233 DEFKEYWORD (Q_foreground); | |
| 5234 DEFKEYWORD (Q_background); | |
| 428 | 5235 #endif |
| 5236 /* image specifiers */ | |
| 5237 | |
| 5238 DEFSUBR (Fimage_specifier_p); | |
| 5239 /* Qimage in general.c */ | |
| 5240 | |
| 5241 /* image instances */ | |
| 5242 | |
| 563 | 5243 DEFSYMBOL_MULTIWORD_PREDICATE (Qimage_instancep); |
| 428 | 5244 |
| 442 | 5245 DEFSYMBOL (Qnothing_image_instance_p); |
| 5246 DEFSYMBOL (Qtext_image_instance_p); | |
| 5247 DEFSYMBOL (Qmono_pixmap_image_instance_p); | |
| 5248 DEFSYMBOL (Qcolor_pixmap_image_instance_p); | |
| 5249 DEFSYMBOL (Qpointer_image_instance_p); | |
| 5250 DEFSYMBOL (Qwidget_image_instance_p); | |
| 5251 DEFSYMBOL (Qsubwindow_image_instance_p); | |
| 428 | 5252 |
| 5253 DEFSUBR (Fmake_image_instance); | |
| 5254 DEFSUBR (Fimage_instance_p); | |
| 5255 DEFSUBR (Fimage_instance_type); | |
| 5256 DEFSUBR (Fvalid_image_instance_type_p); | |
| 5257 DEFSUBR (Fimage_instance_type_list); | |
| 5258 DEFSUBR (Fimage_instance_name); | |
| 442 | 5259 DEFSUBR (Fimage_instance_domain); |
| 872 | 5260 DEFSUBR (Fimage_instance_instantiator); |
| 428 | 5261 DEFSUBR (Fimage_instance_string); |
| 5262 DEFSUBR (Fimage_instance_file_name); | |
| 5263 DEFSUBR (Fimage_instance_mask_file_name); | |
| 5264 DEFSUBR (Fimage_instance_depth); | |
| 5265 DEFSUBR (Fimage_instance_height); | |
| 5266 DEFSUBR (Fimage_instance_width); | |
| 5267 DEFSUBR (Fimage_instance_hotspot_x); | |
| 5268 DEFSUBR (Fimage_instance_hotspot_y); | |
| 5269 DEFSUBR (Fimage_instance_foreground); | |
| 5270 DEFSUBR (Fimage_instance_background); | |
| 5271 DEFSUBR (Fimage_instance_property); | |
| 5272 DEFSUBR (Fcolorize_image_instance); | |
| 5273 /* subwindows */ | |
| 5274 DEFSUBR (Fsubwindowp); | |
| 5275 DEFSUBR (Fimage_instance_subwindow_id); | |
| 5276 DEFSUBR (Fresize_subwindow); | |
| 5277 DEFSUBR (Fforce_subwindow_map); | |
| 5278 | |
| 5279 /* Qnothing defined as part of the "nothing" image-instantiator | |
| 5280 type. */ | |
| 5281 /* Qtext defined in general.c */ | |
| 442 | 5282 DEFSYMBOL (Qmono_pixmap); |
| 5283 DEFSYMBOL (Qcolor_pixmap); | |
| 428 | 5284 /* Qpointer defined in general.c */ |
| 5285 | |
| 5286 /* glyphs */ | |
| 5287 | |
| 442 | 5288 DEFSYMBOL (Qglyphp); |
| 5289 DEFSYMBOL (Qcontrib_p); | |
| 5290 DEFSYMBOL (Qbaseline); | |
| 5291 | |
| 5292 DEFSYMBOL (Qbuffer_glyph_p); | |
| 5293 DEFSYMBOL (Qpointer_glyph_p); | |
| 5294 DEFSYMBOL (Qicon_glyph_p); | |
| 5295 | |
| 5296 DEFSYMBOL (Qconst_glyph_variable); | |
| 428 | 5297 |
| 5298 DEFSUBR (Fglyph_type); | |
| 5299 DEFSUBR (Fvalid_glyph_type_p); | |
| 5300 DEFSUBR (Fglyph_type_list); | |
| 5301 DEFSUBR (Fglyphp); | |
| 5302 DEFSUBR (Fmake_glyph_internal); | |
| 5303 DEFSUBR (Fglyph_width); | |
| 5304 DEFSUBR (Fglyph_ascent); | |
| 5305 DEFSUBR (Fglyph_descent); | |
| 5306 DEFSUBR (Fglyph_height); | |
| 442 | 5307 DEFSUBR (Fset_instantiator_property); |
| 428 | 5308 |
| 5309 /* Qbuffer defined in general.c. */ | |
| 5310 /* Qpointer defined above */ | |
| 5311 | |
| 1204 | 5312 /* Unfortunately, timeout handlers must be lisp functions. This is |
| 428 | 5313 for animated glyphs. */ |
| 442 | 5314 DEFSYMBOL (Qglyph_animated_timeout_handler); |
| 428 | 5315 DEFSUBR (Fglyph_animated_timeout_handler); |
| 5316 | |
| 5317 /* Errors */ | |
| 563 | 5318 DEFERROR_STANDARD (Qimage_conversion_error, Qconversion_error); |
| 428 | 5319 } |
| 5320 | |
| 5321 void | |
| 5322 specifier_type_create_image (void) | |
| 5323 { | |
| 5324 /* image specifiers */ | |
| 5325 | |
| 5326 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (image, "image", "imagep"); | |
| 5327 | |
| 5328 SPECIFIER_HAS_METHOD (image, create); | |
| 5329 SPECIFIER_HAS_METHOD (image, mark); | |
| 5330 SPECIFIER_HAS_METHOD (image, instantiate); | |
| 5331 SPECIFIER_HAS_METHOD (image, validate); | |
| 5332 SPECIFIER_HAS_METHOD (image, after_change); | |
| 5333 SPECIFIER_HAS_METHOD (image, going_to_add); | |
| 434 | 5334 SPECIFIER_HAS_METHOD (image, copy_instantiator); |
| 428 | 5335 } |
| 5336 | |
| 5337 void | |
| 5338 reinit_specifier_type_create_image (void) | |
| 5339 { | |
| 5340 REINITIALIZE_SPECIFIER_TYPE (image); | |
| 5341 } | |
| 5342 | |
| 5343 | |
| 1204 | 5344 static const struct memory_description iike_description_1[] = { |
| 440 | 5345 { XD_LISP_OBJECT, offsetof (ii_keyword_entry, keyword) }, |
| 428 | 5346 { XD_END } |
| 5347 }; | |
| 5348 | |
| 1204 | 5349 static const struct sized_memory_description iike_description = { |
| 440 | 5350 sizeof (ii_keyword_entry), |
| 428 | 5351 iike_description_1 |
| 5352 }; | |
| 5353 | |
| 1204 | 5354 static const struct memory_description iiked_description_1[] = { |
| 440 | 5355 XD_DYNARR_DESC (ii_keyword_entry_dynarr, &iike_description), |
| 428 | 5356 { XD_END } |
| 5357 }; | |
| 5358 | |
| 1204 | 5359 static const struct sized_memory_description iiked_description = { |
| 440 | 5360 sizeof (ii_keyword_entry_dynarr), |
| 428 | 5361 iiked_description_1 |
| 5362 }; | |
| 5363 | |
| 1204 | 5364 static const struct memory_description iife_description_1[] = { |
| 440 | 5365 { XD_LISP_OBJECT, offsetof (image_instantiator_format_entry, symbol) }, |
| 5366 { XD_LISP_OBJECT, offsetof (image_instantiator_format_entry, device) }, | |
| 2551 | 5367 { XD_BLOCK_PTR, offsetof (image_instantiator_format_entry, meths), 1, |
| 5368 { &iim_description } }, | |
| 428 | 5369 { XD_END } |
| 5370 }; | |
| 5371 | |
| 1204 | 5372 static const struct sized_memory_description iife_description = { |
| 440 | 5373 sizeof (image_instantiator_format_entry), |
| 428 | 5374 iife_description_1 |
| 5375 }; | |
| 5376 | |
| 1204 | 5377 static const struct memory_description iifed_description_1[] = { |
| 440 | 5378 XD_DYNARR_DESC (image_instantiator_format_entry_dynarr, &iife_description), |
| 428 | 5379 { XD_END } |
| 5380 }; | |
| 5381 | |
| 1204 | 5382 static const struct sized_memory_description iifed_description = { |
| 440 | 5383 sizeof (image_instantiator_format_entry_dynarr), |
| 428 | 5384 iifed_description_1 |
| 5385 }; | |
| 5386 | |
| 1204 | 5387 static const struct memory_description iim_description_1[] = { |
| 440 | 5388 { XD_LISP_OBJECT, offsetof (struct image_instantiator_methods, symbol) }, |
| 5389 { XD_LISP_OBJECT, offsetof (struct image_instantiator_methods, device) }, | |
| 2551 | 5390 { XD_BLOCK_PTR, offsetof (struct image_instantiator_methods, keywords), 1, |
| 5391 { &iiked_description } }, | |
| 5392 { XD_BLOCK_PTR, offsetof (struct image_instantiator_methods, consoles), 1, | |
| 5393 { &cted_description } }, | |
| 428 | 5394 { XD_END } |
| 5395 }; | |
| 5396 | |
| 1204 | 5397 const struct sized_memory_description iim_description = { |
| 442 | 5398 sizeof (struct image_instantiator_methods), |
| 428 | 5399 iim_description_1 |
| 5400 }; | |
| 5401 | |
| 5402 void | |
| 5403 image_instantiator_format_create (void) | |
| 5404 { | |
| 5405 /* image instantiators */ | |
| 5406 | |
| 5407 the_image_instantiator_format_entry_dynarr = | |
| 5408 Dynarr_new (image_instantiator_format_entry); | |
| 5409 | |
| 5410 Vimage_instantiator_format_list = Qnil; | |
| 5411 staticpro (&Vimage_instantiator_format_list); | |
| 5412 | |
| 2367 | 5413 dump_add_root_block_ptr (&the_image_instantiator_format_entry_dynarr, &iifed_description); |
| 428 | 5414 |
| 5415 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (nothing, "nothing"); | |
| 5416 | |
| 5417 IIFORMAT_HAS_METHOD (nothing, possible_dest_types); | |
| 5418 IIFORMAT_HAS_METHOD (nothing, instantiate); | |
| 5419 | |
| 5420 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (inherit, "inherit"); | |
| 5421 | |
| 5422 IIFORMAT_HAS_METHOD (inherit, validate); | |
| 5423 IIFORMAT_HAS_METHOD (inherit, normalize); | |
| 5424 IIFORMAT_HAS_METHOD (inherit, possible_dest_types); | |
| 5425 IIFORMAT_HAS_METHOD (inherit, instantiate); | |
| 5426 | |
| 5427 IIFORMAT_VALID_KEYWORD (inherit, Q_face, check_valid_face); | |
| 5428 | |
| 5429 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (string, "string"); | |
| 5430 | |
| 5431 IIFORMAT_HAS_METHOD (string, validate); | |
| 442 | 5432 IIFORMAT_HAS_SHARED_METHOD (string, governing_domain, subwindow); |
| 428 | 5433 IIFORMAT_HAS_METHOD (string, possible_dest_types); |
| 5434 IIFORMAT_HAS_METHOD (string, instantiate); | |
| 5435 | |
| 5436 IIFORMAT_VALID_KEYWORD (string, Q_data, check_valid_string); | |
| 5437 /* Do this so we can set strings. */ | |
| 442 | 5438 /* #### Andy, what is this? This is a bogus format and should not be |
| 5439 visible to the user. */ | |
| 428 | 5440 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (text, "text"); |
| 442 | 5441 IIFORMAT_HAS_METHOD (text, update); |
| 438 | 5442 IIFORMAT_HAS_METHOD (text, query_geometry); |
| 428 | 5443 |
| 5444 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (formatted_string, "formatted-string"); | |
| 5445 | |
| 5446 IIFORMAT_HAS_METHOD (formatted_string, validate); | |
| 5447 IIFORMAT_HAS_METHOD (formatted_string, possible_dest_types); | |
| 5448 IIFORMAT_HAS_METHOD (formatted_string, instantiate); | |
| 5449 IIFORMAT_VALID_KEYWORD (formatted_string, Q_data, check_valid_string); | |
| 5450 | |
| 442 | 5451 /* Do this so pointers have geometry. */ |
| 5452 /* #### Andy, what is this? This is a bogus format and should not be | |
| 5453 visible to the user. */ | |
| 5454 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (pointer, "pointer"); | |
| 5455 IIFORMAT_HAS_SHARED_METHOD (pointer, query_geometry, subwindow); | |
| 5456 | |
| 428 | 5457 /* subwindows */ |
| 5458 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (subwindow, "subwindow"); | |
| 5459 IIFORMAT_HAS_METHOD (subwindow, possible_dest_types); | |
| 442 | 5460 IIFORMAT_HAS_METHOD (subwindow, governing_domain); |
| 428 | 5461 IIFORMAT_HAS_METHOD (subwindow, instantiate); |
| 442 | 5462 IIFORMAT_HAS_METHOD (subwindow, query_geometry); |
| 428 | 5463 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_width, check_valid_int); |
| 5464 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_height, check_valid_int); | |
| 5465 | |
| 5466 #ifdef HAVE_WINDOW_SYSTEM | |
| 5467 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xbm, "xbm"); | |
| 5468 | |
| 5469 IIFORMAT_HAS_METHOD (xbm, validate); | |
| 5470 IIFORMAT_HAS_METHOD (xbm, normalize); | |
| 5471 IIFORMAT_HAS_METHOD (xbm, possible_dest_types); | |
| 5472 | |
| 5473 IIFORMAT_VALID_KEYWORD (xbm, Q_data, check_valid_xbm_inline); | |
| 5474 IIFORMAT_VALID_KEYWORD (xbm, Q_file, check_valid_string); | |
| 5475 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_data, check_valid_xbm_inline); | |
| 5476 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_file, check_valid_string); | |
| 5477 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_x, check_valid_int); | |
| 5478 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_y, check_valid_int); | |
| 5479 IIFORMAT_VALID_KEYWORD (xbm, Q_foreground, check_valid_string); | |
| 5480 IIFORMAT_VALID_KEYWORD (xbm, Q_background, check_valid_string); | |
| 5481 #endif /* HAVE_WINDOW_SYSTEM */ | |
| 5482 | |
| 5483 #ifdef HAVE_XFACE | |
| 5484 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xface, "xface"); | |
| 5485 | |
| 5486 IIFORMAT_HAS_METHOD (xface, validate); | |
| 5487 IIFORMAT_HAS_METHOD (xface, normalize); | |
| 5488 IIFORMAT_HAS_METHOD (xface, possible_dest_types); | |
| 5489 | |
| 5490 IIFORMAT_VALID_KEYWORD (xface, Q_data, check_valid_string); | |
| 5491 IIFORMAT_VALID_KEYWORD (xface, Q_file, check_valid_string); | |
| 2959 | 5492 IIFORMAT_VALID_KEYWORD (xface, Q_mask_data, check_valid_xbm_inline); |
| 5493 IIFORMAT_VALID_KEYWORD (xface, Q_mask_file, check_valid_string); | |
| 428 | 5494 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_x, check_valid_int); |
| 5495 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_y, check_valid_int); | |
| 5496 IIFORMAT_VALID_KEYWORD (xface, Q_foreground, check_valid_string); | |
| 5497 IIFORMAT_VALID_KEYWORD (xface, Q_background, check_valid_string); | |
| 5498 #endif | |
| 5499 | |
| 5500 #ifdef HAVE_XPM | |
| 5501 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xpm, "xpm"); | |
| 5502 | |
| 5503 IIFORMAT_HAS_METHOD (xpm, validate); | |
| 5504 IIFORMAT_HAS_METHOD (xpm, normalize); | |
| 5505 IIFORMAT_HAS_METHOD (xpm, possible_dest_types); | |
| 5506 | |
| 5507 IIFORMAT_VALID_KEYWORD (xpm, Q_data, check_valid_string); | |
| 5508 IIFORMAT_VALID_KEYWORD (xpm, Q_file, check_valid_string); | |
| 5509 IIFORMAT_VALID_KEYWORD (xpm, Q_color_symbols, check_valid_xpm_color_symbols); | |
| 5510 #endif /* HAVE_XPM */ | |
| 5511 } | |
| 5512 | |
| 5513 void | |
| 5514 reinit_vars_of_glyphs (void) | |
| 5515 { | |
| 3092 | 5516 #ifndef NEW_GC |
| 428 | 5517 the_expose_ignore_blocktype = |
| 5518 Blocktype_new (struct expose_ignore_blocktype); | |
| 3092 | 5519 #endif /* not NEW_GC */ |
| 428 | 5520 |
| 5521 hold_ignored_expose_registration = 0; | |
| 5522 } | |
| 5523 | |
| 5524 | |
| 5525 void | |
| 5526 vars_of_glyphs (void) | |
| 5527 { | |
| 5528 Vthe_nothing_vector = vector1 (Qnothing); | |
| 5529 staticpro (&Vthe_nothing_vector); | |
| 5530 | |
| 5531 /* image instances */ | |
| 5532 | |
| 440 | 5533 Vimage_instance_type_list = Fcons (Qnothing, |
| 5534 list6 (Qtext, Qmono_pixmap, Qcolor_pixmap, | |
| 428 | 5535 Qpointer, Qsubwindow, Qwidget)); |
| 5536 staticpro (&Vimage_instance_type_list); | |
| 5537 | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
5538 /* The Qunbound name means this test is not available from Lisp. */ |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
5539 Vimage_instance_hash_table_test |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
5540 = define_hash_table_test (Qunbound, instantiator_eq_equal, |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
5541 instantiator_eq_hash, Qunbound, Qunbound); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
5542 staticpro (&Vimage_instance_hash_table_test); |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5178
diff
changeset
|
5543 |
| 428 | 5544 /* glyphs */ |
| 5545 | |
| 5546 Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon); | |
| 5547 staticpro (&Vglyph_type_list); | |
| 5548 | |
| 5549 #ifdef HAVE_WINDOW_SYSTEM | |
| 5550 Fprovide (Qxbm); | |
| 5551 #endif | |
| 5552 #ifdef HAVE_XPM | |
| 5553 Fprovide (Qxpm); | |
| 5554 | |
| 5555 DEFVAR_LISP ("xpm-color-symbols", &Vxpm_color_symbols /* | |
| 5556 Definitions of logical color-names used when reading XPM files. | |
| 5557 Elements of this list should be of the form (COLOR-NAME FORM-TO-EVALUATE). | |
| 5558 The COLOR-NAME should be a string, which is the name of the color to define; | |
| 5559 the FORM should evaluate to a `color' specifier object, or a string to be | |
| 5560 passed to `make-color-instance'. If a loaded XPM file references a symbolic | |
| 5561 color called COLOR-NAME, it will display as the computed color instead. | |
| 5562 | |
| 5563 The default value of this variable defines the logical color names | |
| 5564 \"foreground\" and \"background\" to be the colors of the `default' face. | |
| 5565 */ ); | |
| 5566 Vxpm_color_symbols = Qnil; /* initialized in x-faces.el */ | |
| 5567 #endif /* HAVE_XPM */ | |
| 5568 #ifdef HAVE_XFACE | |
| 5569 Fprovide (Qxface); | |
| 5570 #endif | |
| 5571 | |
| 5572 DEFVAR_BOOL ("disable-animated-pixmaps", &disable_animated_pixmaps /* | |
| 5573 Whether animated pixmaps should be animated. | |
| 5574 Default is t. | |
| 5575 */); | |
| 5576 disable_animated_pixmaps = 0; | |
| 5577 } | |
| 5578 | |
| 5579 void | |
| 5580 specifier_vars_of_glyphs (void) | |
| 5581 { | |
| 5582 /* #### Can we GC here? The set_specifier_* calls definitely need */ | |
| 5583 /* protection. */ | |
| 5584 /* display tables */ | |
| 5585 | |
| 5586 DEFVAR_SPECIFIER ("current-display-table", &Vcurrent_display_table /* | |
| 5587 *The display table currently in use. | |
| 5588 This is a specifier; use `set-specifier' to change it. | |
| 442 | 5589 |
| 5590 Display tables are used to control how characters are displayed. Each | |
| 5591 time that redisplay processes a character, it is looked up in all the | |
| 5592 display tables that apply (obtained by calling `specifier-instance' on | |
| 5593 `current-display-table' and any overriding display tables specified in | |
| 5594 currently active faces). The first entry found that matches the | |
| 5595 character determines how the character is displayed. If there is no | |
| 5596 matching entry, the default display method is used. (Non-control | |
| 5597 characters are displayed as themselves and control characters are | |
| 5598 displayed according to the buffer-local variable `ctl-arrow'. Control | |
| 5599 characters are further affected by `control-arrow-glyph' and | |
| 5600 `octal-escape-glyph'.) | |
| 5601 | |
| 5602 Each instantiator in this specifier and the display-table specifiers | |
| 5603 in faces is a display table or a list of such tables. If a list, each | |
| 5604 table will be searched in turn for an entry matching a particular | |
| 5605 character. Each display table is one of | |
| 5606 | |
| 5607 -- a vector, specifying values for characters starting at 0 | |
| 5608 -- a char table, either of type `char' or `generic' | |
| 5609 -- a range table | |
| 5610 | |
| 5611 Each entry in a display table should be one of | |
| 5612 | |
| 5613 -- nil (this entry is ignored and the search continues) | |
| 5614 -- a character (use this character; if it happens to be the same as | |
| 5615 the original character, default processing happens, otherwise | |
| 5616 redisplay attempts to display this character directly; | |
| 5617 #### At some point recursive display-table lookup will be | |
| 5618 implemented.) | |
| 5619 -- a string (display each character in the string directly; | |
| 5620 #### At some point recursive display-table lookup will be | |
| 5621 implemented.) | |
| 5622 -- a glyph (display the glyph; | |
| 5623 #### At some point recursive display-table lookup will be | |
| 5624 implemented when a string glyph is being processed.) | |
| 5625 -- a cons of the form (format "STRING") where STRING is a printf-like | |
| 5626 spec used to process the character. #### Unfortunately no | |
| 5627 formatting directives other than %% are implemented. | |
| 5628 -- a vector (each element of the vector is processed recursively; | |
| 5629 in such a case, nil elements in the vector are simply ignored) | |
| 5630 | |
| 5631 #### At some point in the near future, display tables are likely to | |
| 5632 be expanded to include other features, such as referencing characters | |
| 5633 in particular fonts and allowing the character search to continue | |
| 5634 all the way up the chain of specifier instantiators. These features | |
| 5635 are necessary to properly display Unicode characters. | |
| 428 | 5636 */ ); |
| 5637 Vcurrent_display_table = Fmake_specifier (Qdisplay_table); | |
| 5638 set_specifier_fallback (Vcurrent_display_table, | |
| 5639 list1 (Fcons (Qnil, Qnil))); | |
| 5640 set_specifier_caching (Vcurrent_display_table, | |
| 438 | 5641 offsetof (struct window, display_table), |
| 428 | 5642 some_window_value_changed, |
| 444 | 5643 0, 0, 0); |
| 428 | 5644 } |
| 5645 | |
| 5646 void | |
| 5647 complex_vars_of_glyphs (void) | |
| 5648 { | |
| 5649 /* Partially initialized in glyphs-x.c, glyphs.el */ | |
| 5650 DEFVAR_LISP ("truncation-glyph", &Vtruncation_glyph /* | |
| 5651 What to display at the end of truncated lines. | |
| 5652 */ ); | |
| 5653 Vtruncation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); | |
| 5654 | |
| 5655 /* Partially initialized in glyphs-x.c, glyphs.el */ | |
| 5656 DEFVAR_LISP ("continuation-glyph", &Vcontinuation_glyph /* | |
| 5657 What to display at the end of wrapped lines. | |
| 5658 */ ); | |
| 5659 Vcontinuation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); | |
| 5660 | |
| 2367 | 5661 /* The octal-escape glyph, control-arrow-glyph and |
| 5662 invisible-text-glyph are completely initialized in glyphs.el */ | |
| 5663 | |
| 5664 DEFVAR_LISP ("octal-escape-glyph", &Voctal_escape_glyph /* | |
| 5665 What to prefix character codes displayed in octal with. | |
| 5666 */); | |
| 5667 Voctal_escape_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); | |
| 5668 | |
| 5669 DEFVAR_LISP ("control-arrow-glyph", &Vcontrol_arrow_glyph /* | |
| 5670 What to use as an arrow for control characters. | |
| 5671 */); | |
| 5672 Vcontrol_arrow_glyph = allocate_glyph (GLYPH_BUFFER, | |
| 5673 redisplay_glyph_changed); | |
| 5674 | |
| 5675 DEFVAR_LISP ("invisible-text-glyph", &Vinvisible_text_glyph /* | |
| 5676 What to use to indicate the presence of invisible text. | |
| 5677 This is the glyph that is displayed when an ellipsis is called for | |
| 5678 \(see `selective-display-ellipses' and `buffer-invisibility-spec'). | |
| 5679 Normally this is three dots ("..."). | |
| 5680 */); | |
| 5681 Vinvisible_text_glyph = allocate_glyph (GLYPH_BUFFER, | |
| 5682 redisplay_glyph_changed); | |
| 5683 | |
| 5684 /* Partially initialized in glyphs.el */ | |
| 5685 DEFVAR_LISP ("hscroll-glyph", &Vhscroll_glyph /* | |
| 5686 What to display at the beginning of horizontally scrolled lines. | |
| 5687 */); | |
| 5688 Vhscroll_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); | |
| 5689 | |
| 428 | 5690 /* Partially initialized in glyphs-x.c, glyphs.el */ |
| 5691 DEFVAR_LISP ("xemacs-logo", &Vxemacs_logo /* | |
| 5692 The glyph used to display the XEmacs logo at startup. | |
| 5693 */ ); | |
| 5694 Vxemacs_logo = allocate_glyph (GLYPH_BUFFER, 0); | |
| 5695 } |