Mercurial > hg > xemacs-beta
annotate lwlib/xlwgcs.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 | 5460287a3327 |
| children | 308d34e9f07d |
| rev | line source |
|---|---|
| 398 | 1 /* Tabs Widget for XEmacs. |
| 2 Copyright (C) 1999 Edward A. Falk | |
| 442 | 3 |
| 398 | 4 This file is part of XEmacs. |
| 442 | 5 |
| 398 | 6 XEmacs is free software; you can redistribute it and/or modify it |
| 7 under the terms of the GNU General Public License as published by the | |
| 8 Free Software Foundation; either version 2, or (at your option) any | |
| 9 later version. | |
| 442 | 10 |
| 398 | 11 XEmacs is distributed in the hope that it will be useful, but WITHOUT |
| 12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 14 for more details. | |
| 442 | 15 |
| 398 | 16 You should have received a copy of the GNU General Public License |
| 17 along with XEmacs; see the file COPYING. If not, write to | |
| 18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 19 Boston, MA 02111-1307, USA. */ | |
| 442 | 20 |
| 398 | 21 /* Synched up with: Gcs.c 1.7 */ |
| 442 | 22 |
| 398 | 23 /* #### This code is duplicated many times within lwlib and XEmacs. It |
| 24 should be modularised. */ | |
| 25 | |
| 26 /* | |
| 27 * Gcs.c - Utility functions to allocate GCs. | |
| 28 * | |
| 29 * Author: Edward A. Falk | |
| 30 * falk@falconer.vip.best.com | |
| 31 * | |
| 32 * Date: Sept 29, 1998 | |
| 33 */ | |
| 34 | |
| 35 /* Functions: | |
| 36 * | |
| 37 * GC AllocFgGC(w, fg, font) | |
| 38 * Return a GC with foreground set as specified. | |
| 39 * If font is None, then the returned GC is allocated with font specified | |
| 40 * as a "don't care" value. | |
| 41 * | |
| 42 * GC | |
| 43 * AllocBackgroundGC(w, font) | |
| 44 * Return a GC with the foreground set to the widget's background color. | |
| 45 * | |
| 46 * GC | |
| 47 * AllocGreyGC(w, fg, font, contrast, be_nice_to_cmap) | |
| 48 * Widget w ; | |
| 49 * Pixel fg ; | |
| 50 * Font font ; | |
| 51 * int contrast ; | |
| 52 * int be_nice_to_cmap ; | |
| 53 * | |
| 54 * Return a GC suitable for rendering a widget in its "inactive" color. | |
| 55 * Normally returns a GC with a color somewhere between the widget's | |
| 56 * background color and the specified foreground. If font is None, then | |
| 57 * the returned GC is allocated with font specified as "don't care". | |
| 58 * If be_nice_to_cmap is True, the returned GC is created using a 50% | |
| 59 * dither instead of a new color. | |
| 60 * | |
| 61 * | |
| 62 * GC | |
| 63 * AllocShadeGC(w, fg, bg, font, contrast, be_nice_to_cmap) | |
| 64 * Widget w ; | |
| 65 * Pixel fg, bg ; | |
| 66 * Font font ; | |
| 67 * int contrast ; | |
| 68 * int be_nice_to_cmap ; | |
| 69 * | |
| 70 * Return a GC suitable for rendering in a shade somewhere between | |
| 71 * bg and fg, as determined by contrast (0 = bg, 100 = fg) | |
| 72 * If font is None, then the returned GC is allocated with | |
| 73 * font specified as "don't care". If be_nice_to_cmap | |
| 74 * is True, the returned GC is created using a 50% dither | |
| 75 * instead of a new color. | |
| 76 * | |
| 77 * | |
| 78 * GC | |
| 79 * AllocTopShadowGC(w, contrast, be_nice_to_cmap) | |
| 80 * Return a GC suitable for rendering the "top shadow" decorations of | |
| 81 * a widget. Returns a GC with foreground computed from widget's | |
| 82 * background color and contrast. If be_nice_to_cmap is True, the | |
| 83 * returned GC will use a foreground color of white. If widget depth | |
| 84 * is 1, this function will use a foreground color of black. | |
| 85 * | |
| 86 * GC | |
| 87 * AllocBotShadowGC(w, contrast, be_nice_to_cmap) | |
| 88 * Return a GC suitable for rendering the "bottom shadow" decorations | |
| 89 * of a widget. Returns a GC with foreground computed from widget's | |
| 90 * background color and contrast. If be_nice_to_cmap is True, the | |
| 91 * returned GC will use a foreground color of black. | |
| 92 * | |
| 93 * GC | |
| 94 * AllocArmGC(w, contrast, be_nice_to_cmap) | |
| 95 * Return a GC suitable for rendering the "armed" decorations of a | |
| 96 * widget. This GC would typically be used to fill in the widget's | |
| 97 * background. Returns a GC with foreground computed from widget's | |
| 98 * background color and contrast. If be_nice_to_cmap is True, the | |
| 99 * returned GC will use a foreground color of black and a 50% dither. | |
| 100 * | |
| 101 * | |
| 102 * void | |
| 103 * Draw3dBox(w, x,y,wid,hgt,s, topgc, botgc) | |
| 104 * Utility function. Draws a raised shadow box with outside dimensions | |
| 105 * as specified by x,y,wid,hgt and shadow width specified by s. | |
| 106 * A lowered shadow box may be generated by swapping topgc and botgc. | |
| 107 * | |
| 108 */ | |
| 109 | |
| 110 #include <config.h> | |
| 111 #include <stdio.h> | |
| 112 | |
| 113 #include <X11/Xlib.h> | |
| 114 #include <X11/IntrinsicP.h> | |
| 115 #include <X11/StringDefs.h> | |
|
4769
5460287a3327
Remove support for pre-X11R5 systems, including systems without Xmu. See
Jerry James <james@xemacs.org>
parents:
2286
diff
changeset
|
116 #include <X11/Xmu/Drawing.h> |
|
5460287a3327
Remove support for pre-X11R5 systems, including systems without Xmu. See
Jerry James <james@xemacs.org>
parents:
2286
diff
changeset
|
117 #include <X11/Xmu/Misc.h> |
| 398 | 118 #include "xlwgcs.h" |
| 119 | |
| 120 /* Color & GC allocation. | |
| 121 * | |
| 122 * Frame widgets use the following graphics contexts: | |
| 123 * | |
| 124 * Foreground tab label text drawn this way | |
| 125 * Insensitive Fg foreground color greyed out. | |
| 126 * Background frame background color | |
| 127 * Top shadow upper-left highlight around widget | |
| 128 * Bottom shadow lower-right highlight around widget | |
| 129 * Arm shadow button pressed and ready to be released | |
| 130 * | |
| 131 * | |
| 132 * GC's are defined as follows, depending on attributes and | |
| 133 * window depth: | |
| 134 * | |
| 135 * Monochrome: | |
| 136 * Foreground = foreground color attribute or BlackPixel() | |
| 137 * Grey = Foreground color + 50% dither | |
| 138 * Background = background color attribute or WhitePixel() | |
| 139 * top shadow = foreground | |
| 140 * bottom shadow = foreground | |
| 141 * arm shadow = (what?) | |
| 142 * | |
| 143 * Color, beNiceToColormap=true: | |
| 144 * Foreground = foreground color attribute or BlackPixel() | |
| 145 * Grey = Foreground color + 50% dither | |
| 146 * Background = background color attribute or WhitePixel() | |
| 147 * top shadow = white | |
| 148 * bottom shadow = black | |
| 149 * arm shadow = (what?) | |
| 150 * | |
| 151 * Color, beNiceToColormap=false: | |
| 152 * Foreground = foreground color attribute or BlackPixel() | |
| 153 * Grey = (foreground color + background color)/2 | |
| 154 * Background = background color attribute or WhitePixel() | |
| 155 * top shadow = background * 1.2 | |
| 156 * bottom shadow = background * .6 | |
| 157 * arm shadow = background * .8 | |
| 158 * | |
| 159 * Special cases: | |
| 160 * If background is white, ?? | |
| 161 * if background is black, ?? | |
| 162 * | |
| 163 * | |
| 164 * If the widget's background is solid white or solid black, | |
| 165 * this code just picks some numbers. (The choice is designed | |
| 442 | 166 * to be compatible with ThreeD interface.) |
| 398 | 167 */ |
| 168 | |
| 169 | |
| 170 | |
| 171 #if NeedFunctionPrototypes | |
| 172 static Pixmap getDitherPixmap(Widget, int contrast) ; | |
| 173 #else | |
| 174 static Pixmap getDitherPixmap() ; | |
| 175 #endif | |
| 176 | |
| 177 /* return a GC with the specified foreground and optional font */ | |
| 178 | |
| 179 GC | |
| 180 AllocFgGC(Widget w, Pixel fg, Font font) | |
| 181 { | |
| 182 XGCValues values ; | |
| 458 | 183 unsigned long vmask, dcmask ; |
| 398 | 184 |
| 185 values.foreground = fg ; | |
| 186 values.font = font ; | |
| 187 | |
| 188 if( font != None ) { | |
| 189 vmask = GCForeground|GCFont ; | |
| 190 dcmask = GCSubwindowMode|GCDashOffset| | |
| 191 GCDashList|GCArcMode|GCBackground|GCGraphicsExposures ; | |
| 192 } else { | |
| 193 vmask = GCForeground ; | |
| 194 dcmask = GCFont|GCSubwindowMode|GCDashOffset| | |
| 195 GCDashList|GCArcMode|GCBackground|GCGraphicsExposures ; | |
| 196 } | |
| 197 | |
| 198 return XtAllocateGC(w, w->core.depth, vmask, &values, 0L, dcmask) ; | |
| 199 } | |
| 200 | |
| 201 | |
| 202 /* return gc with widget background color as the foreground */ | |
| 203 | |
| 204 GC | |
| 205 AllocBackgroundGC(Widget w, Font font) | |
| 206 { | |
| 207 return AllocFgGC(w, w->core.background_pixel, font) ; | |
| 208 } | |
| 209 | |
| 210 | |
| 211 /* Allocate an "inactive" GC. Color is grey (possibly via | |
| 212 * dither pattern). | |
| 213 */ | |
| 214 | |
| 215 GC | |
| 216 AllocGreyGC(Widget w, Pixel fg, Font font, int contrast, Bool be_nice_to_cmap) | |
| 217 { | |
| 218 return AllocShadeGC(w, fg, w->core.background_pixel, | |
| 219 font, contrast, be_nice_to_cmap) ; | |
| 220 } | |
| 221 | |
| 222 | |
| 223 /* Allocate a GC somewhere between two colors. */ | |
| 224 | |
| 225 GC | |
| 226 AllocShadeGC(Widget w, Pixel fg, Pixel bg, Font font, | |
|
4769
5460287a3327
Remove support for pre-X11R5 systems, including systems without Xmu. See
Jerry James <james@xemacs.org>
parents:
2286
diff
changeset
|
227 int contrast, Bool be_nice_to_cmap) |
| 398 | 228 { |
| 229 XGCValues values ; | |
| 458 | 230 unsigned long vmask, dcmask ; |
| 398 | 231 |
| 232 values.foreground = fg ; | |
| 233 values.background = bg ; | |
| 234 values.font = font ; | |
| 235 | |
| 236 if( font != None ) { | |
| 237 vmask = GCForeground|GCFont ; | |
| 238 dcmask = GCSubwindowMode|GCDashOffset| | |
| 239 GCDashList|GCArcMode|GCGraphicsExposures ; | |
| 240 } else { | |
| 241 vmask = GCForeground; | |
| 242 dcmask = GCFont|GCSubwindowMode|GCDashOffset| | |
| 243 GCDashList|GCArcMode|GCGraphicsExposures ; | |
| 244 } | |
| 245 if( be_nice_to_cmap || w->core.depth == 1) | |
| 246 { | |
| 247 if( contrast <= 5 ) | |
| 248 values.foreground = bg ; | |
| 249 else if( contrast >= 95 ) | |
| 250 values.foreground = fg ; | |
| 251 else { | |
| 252 vmask |= GCBackground|GCStipple|GCFillStyle ; | |
| 253 values.fill_style = FillOpaqueStippled ; | |
| 254 values.stipple = getDitherPixmap(w, contrast) ; | |
| 255 } | |
| 256 | |
| 257 return XtAllocateGC(w, w->core.depth, vmask, &values, 0L, dcmask) ; | |
|
4769
5460287a3327
Remove support for pre-X11R5 systems, including systems without Xmu. See
Jerry James <james@xemacs.org>
parents:
2286
diff
changeset
|
258 } else { |
| 398 | 259 dcmask |= GCBackground ; |
| 260 values.foreground = AllocGreyPixel(w, fg, bg, contrast) ; | |
| 261 return XtAllocateGC(w, w->core.depth, vmask, &values, 0L, dcmask) ; | |
| 262 } | |
| 263 } | |
| 264 | |
| 265 /* return top-shadow gc. */ | |
| 266 | |
| 267 GC | |
| 268 AllocTopShadowGC(Widget w, int contrast, Bool be_nice_to_cmap) | |
| 269 { | |
| 270 Screen *scr = XtScreen (w); | |
| 271 XGCValues values ; | |
| 272 | |
| 273 if( w->core.depth == 1 ) | |
| 274 values.foreground = BlackPixelOfScreen(scr) ; | |
| 275 else if( be_nice_to_cmap ) | |
| 276 values.foreground = WhitePixelOfScreen(scr) ; | |
| 277 else | |
| 278 values.foreground = AllocShadowPixel(w, 100+contrast) ; | |
| 279 | |
| 280 return XtAllocateGC(w, w->core.depth, | |
| 281 GCForeground, &values, | |
| 282 0L, | |
| 283 GCBackground|GCFont|GCSubwindowMode|GCGraphicsExposures| | |
| 284 GCDashOffset|GCDashList|GCArcMode) ; | |
| 285 } | |
| 286 | |
| 287 /* return bottom-shadow gc. */ | |
| 288 | |
| 289 GC | |
| 290 AllocBotShadowGC(Widget w, int contrast, Bool be_nice_to_cmap) | |
| 291 { | |
| 292 Screen *scr = XtScreen (w); | |
| 293 XGCValues values ; | |
| 294 | |
| 295 if( w->core.depth == 1 || be_nice_to_cmap ) | |
| 296 values.foreground = BlackPixelOfScreen(scr) ; | |
| 297 else | |
| 298 values.foreground = AllocShadowPixel(w, 100-contrast) ; | |
| 299 | |
| 300 return XtAllocateGC(w, w->core.depth, | |
| 301 GCForeground, &values, | |
| 302 0L, | |
| 303 GCBackground|GCFont|GCSubwindowMode|GCGraphicsExposures| | |
| 304 GCDashOffset|GCDashList|GCArcMode) ; | |
| 305 } | |
| 306 | |
| 307 /* return arm-shadow gc. */ | |
| 308 | |
| 309 GC | |
|
4769
5460287a3327
Remove support for pre-X11R5 systems, including systems without Xmu. See
Jerry James <james@xemacs.org>
parents:
2286
diff
changeset
|
310 AllocArmGC(Widget w, int contrast, Bool be_nice_to_cmap) |
| 398 | 311 { |
| 312 Screen *scr = XtScreen (w); | |
| 313 XGCValues values ; | |
| 314 | |
| 315 /* Not clear exactly what we should do here. Take a look at | |
| 316 * Xaw3d to see what they do. | |
| 317 */ | |
| 318 if( w->core.depth == 1 || be_nice_to_cmap ) | |
| 319 { | |
| 320 values.background = w->core.background_pixel ; | |
| 321 if( values.background == BlackPixelOfScreen(scr) ) | |
| 322 values.foreground = WhitePixelOfScreen(scr) ; | |
| 323 else | |
| 324 values.foreground = BlackPixelOfScreen(scr) ; | |
| 325 values.fill_style = FillStippled ; | |
| 326 values.stipple = XmuCreateStippledPixmap(XtScreen(w), 1L, 0L, 1) ; | |
| 327 | |
| 328 return XtAllocateGC(w, w->core.depth, | |
| 329 GCForeground|GCBackground|GCStipple|GCFillStyle, | |
| 330 &values, 0L, | |
| 331 GCFont|GCSubwindowMode|GCGraphicsExposures| | |
| 332 GCDashOffset|GCDashList|GCArcMode) ; | |
|
4769
5460287a3327
Remove support for pre-X11R5 systems, including systems without Xmu. See
Jerry James <james@xemacs.org>
parents:
2286
diff
changeset
|
333 } else { |
| 398 | 334 values.foreground = AllocShadowPixel(w, 100-contrast) ; |
| 335 return XtAllocateGC(w, w->core.depth, | |
| 336 GCForeground, &values, | |
| 337 0L, | |
| 338 GCBackground|GCFont|GCSubwindowMode|GCGraphicsExposures| | |
| 339 GCDashOffset|GCDashList|GCArcMode) ; | |
| 340 } | |
| 341 } | |
| 342 | |
| 343 | |
| 344 Pixel | |
| 345 AllocShadowPixel(Widget w, int scale) | |
| 346 { | |
| 347 XColor get_c, set_c ; | |
| 348 Display *dpy = XtDisplay(w) ; | |
| 349 Screen *scr = XtScreen(w) ; | |
| 350 Colormap cmap ; | |
| 351 Pixel maxColor ; | |
| 352 | |
| 353 cmap = w->core.colormap ; | |
| 354 | |
| 355 get_c.pixel = w->core.background_pixel ; | |
| 356 if( get_c.pixel == WhitePixelOfScreen(scr) || | |
| 357 get_c.pixel == BlackPixelOfScreen(scr) ) | |
| 358 { | |
| 359 /* what we *ought* to do is choose gray75 as the base color, | |
| 360 * or perhaps gray83. Instead, we choose colors that are | |
| 361 * the same as ThreeD would choose. | |
| 362 */ | |
| 363 if( scale > 100 ) scale = 200 - scale ; | |
| 364 set_c.red = set_c.green = set_c.blue = 65535*scale/100 ; | |
| 365 } | |
| 366 else | |
| 367 { | |
| 368 XQueryColor(dpy, cmap, &get_c) ; | |
| 369 /* adjust scale so that brightest component does not | |
| 370 * exceed 65535; otherwise hue would change. | |
| 371 */ | |
| 372 if( scale > 100 ) { | |
| 373 maxColor = Max(get_c.red, Max(get_c.green, get_c.blue)) ; | |
| 374 if( scale*maxColor > 65535*100 ) | |
| 375 scale = 65535*100/maxColor ; | |
| 376 } | |
| 377 set_c.red = scale * get_c.red / 100 ; | |
| 378 set_c.green = scale * get_c.green / 100 ; | |
| 379 set_c.blue = scale * get_c.blue / 100 ; | |
| 380 } | |
| 381 set_c.flags = DoRed | DoGreen | DoBlue ; | |
| 382 if( XAllocColor(dpy, cmap, &set_c) ) | |
| 383 return set_c.pixel ; | |
| 384 else if( scale > 100 ) | |
| 385 return WhitePixelOfScreen(scr) ; | |
| 386 else | |
| 387 return BlackPixelOfScreen(scr) ; | |
| 388 } | |
| 389 | |
| 390 | |
| 391 /* Allocate a pixel partway between foreground and background */ | |
| 392 | |
| 393 | |
| 394 Pixel | |
| 395 AllocGreyPixel(Widget w, Pixel fg, Pixel bg, int scale) | |
| 396 { | |
| 397 XColor get_cf, get_cb ; | |
| 398 Display *dpy = XtDisplay(w) ; | |
| 399 Colormap cmap ; | |
| 400 | |
| 401 cmap = w->core.colormap ; | |
| 402 | |
| 403 get_cf.pixel = fg ; | |
| 404 get_cb.pixel = bg ; | |
| 405 | |
| 406 XQueryColor(dpy, cmap, &get_cf) ; | |
| 407 XQueryColor(dpy, cmap, &get_cb) ; | |
| 408 | |
| 409 return AllocGreyPixelC(w, &get_cf, &get_cb, scale) ; | |
| 410 } | |
| 411 | |
| 412 | |
| 413 | |
| 414 /* Allocate a pixel partway between foreground and background */ | |
| 415 | |
| 416 | |
| 417 Pixel | |
| 418 AllocGreyPixelC(Widget w, XColor *fg, XColor *bg, int scale) | |
| 419 { | |
| 420 XColor set_c ; | |
| 421 Display *dpy = XtDisplay(w) ; | |
| 422 int r,g,b ; | |
| 423 Colormap cmap = w->core.colormap ; | |
| 424 | |
| 425 r = (fg->red * scale + bg->red * (100-scale)) / 100 ; | |
| 426 g = (fg->green * scale + bg->green * (100-scale)) / 100 ; | |
| 427 b = (fg->blue * scale + bg->blue * (100-scale)) / 100 ; | |
| 428 | |
| 429 if( scale > 100 || scale < 0 ) /* look out for overflow */ | |
| 430 { | |
| 431 int minc, maxc ; | |
| 432 maxc = Max(r, Max(g,b)) ; | |
| 433 minc = Min(r, Min(g,b)) ; | |
| 434 if( maxc > 65535 ) | |
| 435 { | |
| 436 maxc /= 16 ; | |
| 437 r = r*(65535/16) / maxc ; | |
| 438 g = g*(65535/16) / maxc ; | |
| 439 b = b*(65535/16) / maxc ; | |
| 440 } | |
| 441 if( minc < 0 ) | |
| 442 { | |
| 443 r = Max(r,0) ; | |
| 444 g = Max(g,0) ; | |
| 445 b = Max(b,0) ; | |
| 446 } | |
| 447 } | |
| 448 | |
| 449 set_c.red = r ; set_c.green = g ; set_c.blue = b ; | |
| 450 set_c.flags = DoRed | DoGreen | DoBlue ; | |
| 451 (void)XAllocColor(dpy, cmap, &set_c) ; | |
| 452 return set_c.pixel ; | |
| 453 } | |
| 454 | |
| 455 | |
| 456 | |
| 457 | |
| 458 | |
| 459 /* draw a 3-d box */ | |
| 460 | |
| 461 void | |
| 462 Draw3dBox(Widget w, int x, int y, int wid, int hgt, int s, GC topgc, GC botgc) | |
| 463 { | |
| 464 Display *dpy = XtDisplay(w) ; | |
| 465 Window win = XtWindow(w) ; | |
| 466 | |
| 467 if( s == 0 ) return ; | |
| 468 | |
| 469 if( s == 1 ) { | |
| 470 XDrawLine(dpy,win,botgc, x,y+hgt-1, x+wid-1,y+hgt-1) ; | |
| 471 XDrawLine(dpy,win,botgc, x+wid-1,y, x+wid-1,y+hgt-1) ; | |
| 472 XDrawLine(dpy,win,topgc, x,y, x,y+hgt-1) ; | |
| 473 XDrawLine(dpy,win,topgc, x,y, x+wid-1,y) ; | |
| 474 } | |
| 475 else | |
| 476 { | |
| 477 XPoint pts[6] ; | |
| 478 | |
| 479 /* bottom-right shadow */ | |
| 480 pts[0].x = x ; pts[0].y = y + hgt ; | |
| 481 pts[1].x = s ; pts[1].y = -s ; | |
| 482 pts[2].x = wid-2*s ; pts[2].y = 0 ; | |
| 483 pts[3].x = 0 ; pts[3].y = -(hgt-2*s) ; | |
| 484 pts[4].x = s ; pts[4].y = -s ; | |
| 485 pts[5].x = 0 ; pts[5].y = hgt ; | |
| 486 XFillPolygon(dpy,win,botgc, pts,6, Nonconvex,CoordModePrevious) ; | |
| 487 | |
| 488 /* top-left shadow */ | |
| 489 pts[0].x = x ; pts[0].y = y ; | |
| 490 pts[1].x = wid ; pts[1].y = 0 ; | |
| 491 pts[2].x = -s ; pts[2].y = s ; | |
| 492 pts[3].x = -wid+2*s ; pts[3].y = 0 ; | |
| 493 pts[4].x = 0 ; pts[4].y = hgt-2*s ; | |
| 494 pts[5].x = -s ; pts[5].y = s ; | |
| 495 XFillPolygon(dpy,win,topgc, pts,6, Nonconvex,CoordModePrevious) ; | |
| 496 } | |
| 497 } | |
| 498 | |
| 458 | 499 static unsigned char screen0[2] = {0,0} ; |
| 500 static unsigned char screen25[2] = {0,0xaa} ; | |
| 501 static unsigned char screen75[2] = {0xaa,0xff} ; | |
| 502 static unsigned char screen100[2] = {0xff,0xff} ; | |
| 398 | 503 |
| 504 static Pixmap | |
| 505 getDitherPixmap(Widget w, int contrast) | |
| 506 { | |
| 507 Display *dpy = XtDisplay(w) ; | |
| 508 Window win = XtWindow(w) ; | |
| 509 | |
| 510 if( contrast <= 5 ) | |
| 511 return XCreateBitmapFromData(dpy,win, (char *)screen0, 2,2) ; | |
| 512 else if( contrast <= 37 ) | |
| 513 return XCreateBitmapFromData(dpy,win, (char *)screen25, 2,2) ; | |
| 514 else if( contrast <= 62 ) | |
| 515 return XmuCreateStippledPixmap(XtScreen(w), 1L, 0L, 1) ; | |
| 516 else if( contrast <= 95 ) | |
| 517 return XCreateBitmapFromData(dpy,win, (char *)screen75, 2,2) ; | |
| 518 else | |
| 519 return XCreateBitmapFromData(dpy,win, (char *)screen100, 2,2) ; | |
| 520 } |