/[cmucl]/src/hemlock/hacks.lisp
ViewVC logotype

Contents of /src/hemlock/hacks.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (show annotations)
Mon Jun 29 21:10:49 2009 UTC (4 years, 9 months ago) by rtoy
Branch: MAIN
CVS Tags: sparc-tramp-assem-base, post-merge-intl-branch, intl-branch-working-2010-02-19-1000, unicode-string-buffer-impl-base, release-20b-pre1, release-20b-pre2, unicode-string-buffer-base, sparc-tramp-assem-2010-07-19, amd64-dd-start, intl-2-branch-base, GIT-CONVERSION, cross-sol-x86-merged, intl-branch-working-2010-02-11-1000, RELEASE_20b, release-20a-base, cross-sol-x86-base, snapshot-2010-12, snapshot-2010-11, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, pre-merge-intl-branch, snapshot-2010-05, snapshot-2010-04, snapshot-2010-07, snapshot-2010-06, snapshot-2010-01, snapshot-2010-03, snapshot-2010-02, snapshot-2010-08, cross-sol-x86-2010-12-20, intl-branch-2010-03-18-1300, RELEASE_20a, release-20a-pre1, snapshot-2009-11, snapshot-2009-12, cross-sparc-branch-base, intl-branch-base, snapshot-2009-08, snapshot-2009-07, HEAD
Branch point for: cross-sparc-branch, RELEASE-20B-BRANCH, unicode-string-buffer-branch, sparc-tramp-assem-branch, RELEASE-20A-BRANCH, amd64-dd-branch, unicode-string-buffer-impl-branch, intl-branch, cross-sol-x86-branch, intl-2-branch
Changes since 1.4: +26 -4 lines
Make reading and writing from files work with unicode.  (Of course,
only 8-bit characters are supported.)

hacks.lisp:
o Update %SP-BYTE-BLT to be able to handle saps and strings for either
  the source or destination.

files.lisp:
o Use %SP-BYTE-BLT instead of %PRIMITIVE BYTE-BLT.
1 (in-package "HI")
2
3 (defun %sp-byte-blt (src start dest dstart end)
4 #-unicode
5 (%primitive byte-blt src start dest dstart end)
6 #+unicode
7 (etypecase src
8 (system:system-area-pointer
9 (etypecase dest
10 (system:system-area-pointer
11 (loop for di of-type fixnum from dstart below end
12 for si of-type fixnum from start
13 do
14 (setf (sys:sap-ref-8 dest di) (sys:sap-ref-8 src si))))
15 (string
16 (loop for di of-type fixnum from dstart below end
17 for si of-type fixnum from start
18 do
19 (setf (aref dest di) (code-char (sys:sap-ref-8 src si)))))))
20 (string
21 (etypecase dest
22 (system:system-area-pointer
23 (loop for di of-type fixnum from dstart below end
24 for si of-type fixnum from start
25 do
26 (setf (sys:sap-ref-8 dest di) (logand #xff (char-code (aref src si))))))
27 (string
28 (loop for di of-type fixnum from dstart below end
29 for si of-type fixnum from start
30 do
31 (setf (aref dest di) (aref src si))))))))
32
33
34 (defun lisp::sap-to-fixnum (x) (sap-int x))
35 (defun lisp::fixnum-to-sap (x) (int-sap x))
36 (defun lisp::%sp-make-fixnum (x) (%primitive make-fixnum x))
37 (defun lisp::fast-char-upcase (x) (char-upcase x))
38
39 ;;; prepare-window-for-redisplay -- Internal
40 ;;;
41 ;;; Called by make-window to do whatever redisplay wants to set up
42 ;;; a new window.
43 ;;;
44 (defun prepare-window-for-redisplay (window)
45 (setf (window-old-lines window) 0))
46
47 (defparameter hunk-width-limit 256)
48
49 (defun reverse-video-hook-fun (&rest foo)
50 (declare (ignore foo)))

  ViewVC Help
Powered by ViewVC 1.1.5