Mercurial > hg > xemacs-beta
view lisp/msw-glyphs.el @ 4678:b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
lisp/ChangeLog addition:
2009-08-11 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (ceiling*, floor*, round*, truncate*):
Implement these in terms of the C functions; mark them as
obsolete.
(mod*, rem*): Use #'nth-value with the C functions, not #'nth with
the CL emulation functions.
man/ChangeLog addition:
2009-08-11 Aidan Kehoe <kehoea@parhasard.net>
* lispref/numbers.texi (Bigfloat Basics):
Correct this documentation (ignoring for the moment that it breaks
off in mid-sentence).
tests/ChangeLog addition:
2009-08-11 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
Test the new Common Lisp-compatible rounding functions available in
C.
(generate-rounding-output): Provide a function useful for
generating the data for the rounding functions tests.
src/ChangeLog addition:
2009-08-11 Aidan Kehoe <kehoea@parhasard.net>
* floatfns.c (ROUNDING_CONVERT, CONVERT_WITH_NUMBER_TYPES)
(CONVERT_WITHOUT_NUMBER_TYPES, MAYBE_TWO_ARGS_BIGNUM)
(MAYBE_ONE_ARG_BIGNUM, MAYBE_TWO_ARGS_RATIO)
(MAYBE_ONE_ARG_RATIO, MAYBE_TWO_ARGS_BIGFLOAT)
(MAYBE_ONE_ARG_BIGFLOAT, MAYBE_EFF, MAYBE_CHAR_OR_MARKER):
New macros, used in the implementation of the rounding functions.
(ceiling_two_fixnum, ceiling_two_bignum, ceiling_two_ratio)
(ceiling_two_bigfloat, ceiling_one_ratio, ceiling_one_bigfloat)
(ceiling_two_float, ceiling_one_float, ceiling_one_mundane_arg)
(floor_two_fixnum, floor_two_bignum, floor_two_ratio)
(floor_two_bigfloat, floor_one_ratio, floor_one_bigfloat)
(floor_two_float, floor_one_mundane_arg, round_two_fixnum)
(round_two_bignum_1, round_two_bignum, round_two_ratio)
(round_one_bigfloat_1, round_two_bigfloat, round_one_ratio)
(round_one_bigfloat, round_two_float, round_one_float)
(round_one_mundane_arg, truncate_two_fixnum)
(truncate_two_bignum, truncate_two_ratio, truncate_two_bigfloat)
(truncate_one_ratio, truncate_one_bigfloat, truncate_two_float)
(truncate_one_float, truncate_one_mundane_arg):
New functions, used in the implementation of the rounding
functions.
(Fceiling, Ffloor, Fround, Ftruncate, Ffceiling, Fffloor)
(Ffround, Fftruncate):
Revise to fully support Common Lisp conventions. This means:
-- All functions have optional DIVISOR arguments
-- All functions return multiple values; see #'values
-- All functions do their arithmetic with the correct number types
according to the contamination rules.
-- #'round and #'fround always round towards the even number
in ambiguous cases.
* doprnt.c (emacs_doprnt_1):
* number.c (internal_coerce_number):
Call Ftruncate with two arguments, not one.
* floatfns.c (Ffloat):
Correct this, if NUMBER is a bignum.
* lisp.h:
Declare Ftruncate as taking two arguments.
* number.c:
Provide scratch_ratio2, init it appropriately.
* number.h:
Make scratch_ratio2 available.
* number.h (BIGFLOAT_ARITH_RETURN):
* number.h (BIGFLOAT_ARITH_RETURN1):
Correct these functions.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Tue, 11 Aug 2009 17:59:23 +0100 |
parents | 70921960b980 |
children | 308d34e9f07d |
line wrap: on
line source
;;; msw-glyphs.el --- Support for glyphs in ms windows ;; Copyright (C) 1994, 1997 Free Software Foundation, Inc. ;; Copyright (C) 2002 Ben Wing. ;; Author: Kirill M. Katsnelson <kkm@kis.ru> ;; Maintainer: XEmacs Development Team ;; Keywords: extensions, internal, dumped ;; This file is part of XEmacs. ;; XEmacs is free software; you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; XEmacs is distributed in the hope that it will be useful, but ;; WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with XEmacs; see the file COPYING. If not, write to the ;; Free Software Foundation, 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Synched up with: Not in FSF. ;;; Commentary: ;; Initialization code for MS Windows glyphs. ;; This file is dumped with XEmacs (when MS Windows display support is ;; compiled in). Make sure this is the first of msw-*.el files ;; dumped. ;;; Code: (defun msgdi-device-p (&optional device) "Return non-nil if DEVICE is a GDI device, that is 'mswindows or 'msprinter. MS GDI devices are mutuially WYSIWIG-compatible, so that many common glyph, color and font properties apply to them equally. This function is also a predicate for 'msgdi device tag, matching this device class." (memq (device-type device) '(mswindows msprinter))) (progn (define-specifier-tag 'msgdi (function msgdi-device-p)) (set-console-type-image-conversion-list 'mswindows `(("\\.bmp\\'" [bmp :file nil] 2) ("\\`BM" [bmp :data nil] 2) ,@(if (featurep 'xpm) '(("\\.xpm\\'" [xpm :file nil] 2))) ("\\.xbm\\'" [xbm :file nil] 2) ,@(if (featurep 'xpm) '(("\\`/\\* XPM \\*/" [xpm :data nil] 2))) ,@(if (featurep 'gif) '(("\\.gif\\'" [gif :file nil] 2) ("\\`GIF8[79]" [gif :data nil] 2))) ,@(if (featurep 'jpeg) '(("\\.jpe?g\\'" [jpeg :file nil] 2))) ;; all of the JFIF-format JPEG's that I've seen begin with ;; the following. I have no idea if this is standard. ,@(if (featurep 'jpeg) '(("\\`\377\330\377\340\000\020JFIF" [jpeg :data nil] 2))) ,@(if (featurep 'png) '(("\\.png\\'" [png :file nil] 2))) ,@(if (featurep 'png) '(("\\`\211PNG" [png :data nil] 2))) ,@(if (featurep 'tiff) '(("\\.tif?f\\'" [tiff :file nil] 2))) ("\\`X-Face:" [string :data "[xface]"]) ("\\`/\\* XPM \\*/" [string :data "[xpm]"]) ("" [string :data nil] 2) ;; this last one is here for pointers and icons and such -- ;; strings are not allowed so they will be ignored. ("" [nothing]))) (set-console-type-image-conversion-list 'msprinter (console-type-image-conversion-list 'mswindows)) (set-face-font 'border-glyph "WingDings:Regular:11::Symbol" 'global 'msgdi) (set-glyph-image continuation-glyph "\xC3" 'global 'msgdi) (set-glyph-image truncation-glyph "\xF0" 'global 'msgdi) (set-glyph-image hscroll-glyph "\xEF" 'global 'msgdi) (set-glyph-contrib-p continuation-glyph nil) (set-glyph-contrib-p truncation-glyph nil) (set-glyph-contrib-p hscroll-glyph nil) (set-glyph-image octal-escape-glyph "\\") (set-glyph-image control-arrow-glyph "^") (set-glyph-image invisible-text-glyph " ...") (cond ((featurep 'xpm) (set-glyph-image frame-icon-glyph (concat "../etc/" "xemacs-icon3.xpm") 'global 'mswindows) (set-glyph-image xemacs-logo (concat "../etc/" (if emacs-beta-version "xemacs-beta.xpm" "xemacs.xpm")) 'global 'msgdi)) (t (set-glyph-image xemacs-logo "XEmacs <insert spiffy graphic logo here>" 'global 'msgdi))) ) ;;; msw-glyphs.el ends here