suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Mirrored Matthew's commit to CVS:

Browse Source 
Moving the implementation of `save-file' in text% and pasteboard% from C++ to Scheme.

svn: r10
This commit is contained in:
Eli Barzilay 2005-05-29 07:24:50 +00:00
parent ed0515ef8a
commit 761562eeb7
24 changed files with 425 additions and 283 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/mred/private/check.ss
View File

@ -43,6 +43,10 @@
(unless (or (not str) (string? str))
(raise-type-error (who->name who) "string or #f" str)))
(define (check-path who str)
(unless (path-string? str)
(raise-type-error (who->name who) "path or string" str)))
(define (check-path/false who str)
(unless (or (not str) (path-string? str))
(raise-type-error (who->name who) "path, string, or #f" str)))

129
collects/mred/private/editor.ss
View File

@ -36,15 +36,24 @@
get-active-canvas set-active-canvas
get-canvas
add-canvas remove-canvas
auto-wrap get-max-view-size))
auto-wrap get-max-view-size
save-file))
(define-local-member-name
-format-filter
-format-filter/save
-get-current-format
-get-file-format
-set-file-format
-set-position
-set-format)
(define (check-format who format)
(unless (memq format '(guess standard text text-force-cr same copy))
(raise-type-error (who->name who)
"'guess, 'standard, 'text, 'text-force-cr, 'same, or 'copy"
format)))
(define-syntax (augmentize stx)
(syntax-case stx ()
[(_ (result id arg ...) ...)
@ -62,13 +71,15 @@
[super-begin-edit-sequence begin-edit-sequence]
[super-end-edit-sequence end-edit-sequence]
[super-insert-port insert-port]
[super-save-port save-port]
[super-erase erase]
[super-clear-undos clear-undos]
[super-get-load-overwrites-styles get-load-overwrites-styles]
[super-get-filename get-filename])
(inherit get-max-width set-max-width get-admin
get-keymap get-style-list
set-modified set-filename)
set-modified set-filename
get-file put-file)
(define canvases null)
(define active-canvas #f)
(define auto-set-wrap? #f)
@ -92,19 +103,30 @@
(values (unbox wb) (unbox hb))))])
(public*
[-format-filter (lambda (f) f)]
[-format-filter/save (lambda (f) f)]
[-set-file-format (lambda (f) (void))]
[-set-position (lambda () (void))]
[-get-file-format (lambda () 'standard)])
(override*
[insert-file
(opt-lambda ([file #f] [format 'guess] [show-errors? #t])
(dynamic-wind
(lambda () (super-begin-edit-sequence))
(lambda () (super-insert-port file format #f))
(lambda () (super-end-edit-sequence))))]
(opt-lambda (file [format 'guess] [show-errors? #t])
(let ([who '(method editor<%> insert-file)])
(check-path who file)
(check-format who format))
(do-load-file file format #f))]
[load-file
(opt-lambda ([file #f] [format 'guess] [show-errors? #t])
(do-load-file file format #t))])
(private*
[do-load-file
(lambda (file format load?)
(let ([who '(method editor<%> load-file)])
(unless (equal? file "")
(check-path/false who file))
(check-format who format))
(let* ([temp-filename?-box (box #f)]
[old-filename (super-get-filename temp-filename?-box)])
(let* ([file (cond
@ -114,15 +136,17 @@
(let ([path (if old-filename
(path-only old-filename)
#f)])
((get-get-file) path))
(get-file path))
old-filename)]
[(path? file) file]
[else (string->path file)])])
(and
file
(can-load-file? file (-format-filter format))
(or (not load?)
(can-load-file? file (-format-filter format)))
(begin
(on-load-file file (-format-filter format))
(or (not load?)
(on-load-file file (-format-filter format)))
(let ([port (open-input-file file)]
[finished? #f])
(dynamic-wind
@ -133,10 +157,11 @@
(dynamic-wind
void
(lambda ()
(when load?
(super-erase)
(unless (and (not (unbox temp-filename?-box))
(equal? file old-filename))
(set-filename file #f))
(set-filename file #f)))
(let ([format (if (eq? format 'same)
(-get-file-format)
format)])
@ -146,20 +171,84 @@
(raise x))])
(super-insert-port port
(-format-filter format)
(super-get-load-overwrites-styles)))])
(and load?
(super-get-load-overwrites-styles))))])
(close-input-port port) ; close as soon as possible
(-set-file-format new-format)))) ; text% only
(when load?
(-set-file-format new-format)
(-set-position))))) ; text% only
(lambda ()
(super-end-edit-sequence)
(wx:end-busy-cursor)))
(when load?
(super-clear-undos)
(set-modified #f)
(set-modified #f))
(set! finished? #t)
#t)
(lambda ()
(after-load-file finished?)
;; In case it wasn't closed before:
(close-input-port port)))))))))])
(close-input-port port)
(when load?
(after-load-file finished?))))))))))])
(public*
[save-file
(opt-lambda ([file #f] [format 'same] [show-errors? #t])
(let ([who '(method editor<%> save-file)])
(unless (equal? file "")
(check-path/false who file))
(check-format who format))
(let* ([temp-filename?-box (box #f)]
[old-filename (super-get-filename temp-filename?-box)])
(let* ([file (cond
[(or (not (path-string? file))
(equal? file ""))
(if (or (equal? file "") (not old-filename) (unbox temp-filename?-box))
(let ([path (if old-filename
(path-only old-filename)
#f)])
(put-file path (and old-filename
(file-name-from-path old-filename))))
old-filename)]
[(path? file) file]
[else (string->path file)])]
[f-format (-format-filter/save format)]
[actual-format (if (memq f-format '(copy same))
(-get-file-format)
f-format)]
[text? (not (memq actual-format '(text text-force-cr)))])
(and
file
(can-save-file? file f-format)
(begin
(on-save-file file f-format)
(let ([port (open-output-file file (if text? 'text 'binary) 'truncate/replace)]
[finished? #f])
(dynamic-wind
void
(lambda ()
(wx:file-creator-and-type file #"mReD" (if text? #"TEXT" #"WXME"))
(wx:begin-busy-cursor)
(dynamic-wind
void
(lambda ()
(super-save-port port format #t)
(close-output-port port) ; close as soon as possible
(unless (or (eq? format 'copy)
(and (not (unbox temp-filename?-box))
(equal? file old-filename)))
(set-filename file #f))
(unless (eq? format 'copy)
(-set-file-format actual-format))) ; text% only
(lambda ()
(wx:end-busy-cursor)))
(unless (eq? format 'copy)
(set-modified #f))
(set! finished? #t)
#t)
(lambda ()
;; In case it wasn't closed before:
(close-output-port port)
(after-save-file finished?)))))))))])
(public*
[get-canvases (entry-point (lambda () (map wx->mred canvases)))]
@ -290,7 +379,8 @@
[-get-file-format (lambda ()
(super-get-file-format))]
[-set-file-format (lambda (format)
(super-set-file-format format)
(super-set-file-format format))]
[-set-position (lambda ()
(super-set-position 0 0))])
(augmentize (#t can-insert? s e)
@ -316,7 +406,10 @@
(define pasteboard%
(class (es-contract-mixin (make-editor-buffer% wx:pasteboard% #f (lambda () pasteboard%))) ()
(override*
[-format-filter (lambda (f) 'standard)])
[-format-filter (lambda (f) 'standard)]
[-format-filter/save (lambda (f) (if (eq? f 'copy)
f
'standard))])
(augmentize (#t can-insert? s s2 x y)
((void) on-insert s s2 x y)
((void) after-insert s s2 x y)

2
collects/mred/private/kernel.ss
View File

@ -225,7 +225,7 @@
insert-file
load-file
insert-port
save-file
save-port
get-flattened-text
put-file
get-file

37
collects/mred/private/moredialogs.ss
View File

@ -49,6 +49,21 @@
(check-instance 'get-ps-setup-from-user wx:ps-setup% 'ps-setup% #t pss-in)
(check-style 'get-ps-setup-from-user #f null style)))
(define bad-fields null)
(define number-callback
(lambda (f ev)
(let ([e (send f get-editor)]
[ok? (real? (string->number (send f get-value)))])
(send e change-style
(send (make-object wx:style-delta%)
set-delta-background
(if ok? "white" "yellow"))
0 (send e last-position))
(set! bad-fields (remq f bad-fields))
(unless ok?
(set! bad-fields (cons f bad-fields)))
(send ok enable (null? bad-fields)))))
(define pss (or pss-in (wx:current-ps-setup)))
(define f (make-object dialog% "PostScript Setup" parent))
(define papers
@ -67,11 +82,14 @@
(define sp (make-object vertical-pane% ssp))
(define def-scale "0100.000")
(define def-offset "0000.000")
(define xscale (make-object text-field% "Horizontal Scale:" sp void def-scale))
(define xoffset (make-object text-field% "Horizontal Translation:" sp void def-offset))
(define def-margin "0016.000")
(define xscale (make-object text-field% "Horizontal Scale:" sp number-callback def-scale))
(define xoffset (make-object text-field% "Horizontal Translation:" sp number-callback def-offset))
(define xmargin (make-object text-field% "Horizontal Margin:" sp number-callback def-margin))
(define sp2 (make-object vertical-pane% ssp))
(define yscale (make-object text-field% "Vertical Scale:" sp2 void def-scale))
(define yoffset (make-object text-field% "Vertical Translation:" sp2 void def-offset))
(define yscale (make-object text-field% "Vertical Scale:" sp2 number-callback def-scale))
(define yoffset (make-object text-field% "Vertical Translation:" sp2 number-callback def-offset))
(define ymargin (make-object text-field% "Vertical Margin:" sp2 number-callback def-margin))
(define l2 (make-object check-box% "PostScript Level 2" f void))
@ -84,7 +102,8 @@
(send f show #f)
(set! ok? ?))
(define-values (xsb ysb xtb ytb) (values (box 0) (box 0) (box 0) (box 0)))
(define-values (xsb ysb xtb ytb xmb ymb)
(values (box 0) (box 0) (box 0) (box 0) (box 0) (box 0)))
(send paper set-selection (or (find-pos papers (send pss get-paper-name) equal?) 0))
(send orientation set-selection (if (eq? (send pss get-orientation) 'landscape) 1 0))
@ -102,16 +121,21 @@
(send pss get-translation xtb ytb)
(send xoffset set-value (number->string* (unbox xtb)))
(send yoffset set-value (number->string* (unbox ytb)))
(send pss get-margin xmb ymb)
(send xmargin set-value (number->string* (unbox xmb)))
(send ymargin set-value (number->string* (unbox ymb)))
(send xscale stretchable-width #f)
(send yscale stretchable-width #f)
(send xoffset stretchable-width #f)
(send yoffset stretchable-width #f)
(send xmargin stretchable-width #f)
(send ymargin stretchable-width #f)
(send l2 set-value (send pss get-level-2))
(send f set-alignment 'center 'top)
(map no-stretch (list f xscale yscale xoffset yoffset dp))
(map no-stretch (list f xscale yscale xoffset yoffset xmargin ymargin dp))
(send f center)
@ -132,6 +156,7 @@
[(2) 'file])))
(send s set-scaling (gv xscale xsb) (gv yscale ysb))
(send s set-translation (gv xoffset xtb) (gv yoffset ytb))
(send s set-margin (gv xmargin xmb) (gv ymargin ymb))
(send s set-level-2 (send l2 get-value))
(when (eq? (system-type) 'unix)

16
collects/slideshow/doc.txt
View File

@ -279,6 +279,22 @@ runs the slides.
The "Slideshow" executable accepts a number of command-line flags.
Use the --help flag to obtain a list of other flags.
Printing
========
The -p or --print command-line flag causes slideshow to print slides
instead of showing them on the screen. Under Unix, the result is
always PostScript. For all platforms, -P or --ps generates PostScript.
PS-to-PDF converters vary on how well they handle landscape
mode. Here's a Ghostscript command that converts slides reliably
(replace "src.ps" and "dest.pdf" with your file names, and put the
command all on one line):
gs -q -dAutoRotatePages=/None -dSAFER -dNOPAUSE -dBATCH
-sOutputFile=dest.pdf -sDEVICE=pdfwrite -c .setpdfwrite
-c "<</Orientation 3>> setpagedevice" -f src.ps
Procedure Reference
===================

5
collects/slideshow/viewer.ss
View File

@ -672,6 +672,7 @@
(redraw)))
(define/public (redraw)
(unless printing?
(reset-display-inset! (sliderec-inset (talk-list-ref current-page)))
(send commentary lock #f)
(send commentary begin-edit-sequence)
@ -714,7 +715,7 @@
[else
(let ([dc (get-dc)])
(send dc clear)
(paint-slide dc))]))
(paint-slide dc))])))
(super-new [style '(no-autoclear)])))
(define two-c%
@ -773,7 +774,7 @@
[(send e button-up?)
(send (get-top-level-window) next)]))
(define/public (redraw) (on-paint))
(define/public (redraw) (unless printing? (on-paint)))
(super-new)))
(define (paint-letterbox dc cw ch usw ush)

123
collects/tests/mred/editor.ss
View File

@ -5,6 +5,129 @@
;; Editor Tests ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;; File and port save/load tests
(define (run-save/load-tests editor% insert reset?)
(when reset?
(map (lambda (f)
(when (file-exists? f) (delete-file f)))
'("tmp99" "tmp98" "tmp97" "tmp96" "tmp95")))
(let* ([mode #f]
[editor+% (class editor%
(define/augment (on-load-file path -mode)
(set! mode -mode))
(define/augment (on-save-file path -mode)
(set! mode -mode))
(super-new))]
[e (make-object editor+%)]
[ck-text (lambda (path)
(when (eq? editor% text%)
(st 'text e get-file-format)
(when path
(test "Hello" 'content (with-input-from-file path
(lambda ()
(read-string 100)))))))]
[ck-binary (lambda (path)
(when (eq? editor% text%)
(st 'standard e get-file-format))
(when path
(test #"WXME" 'content (with-input-from-file path
(lambda ()
(read-bytes 4))))))]
[ck-mode (lambda (-mode)
(test (if (eq? editor% pasteboard%)
(if (eq? -mode 'copy)
'copy
'standard)
-mode)
'mode mode))])
(insert e "Hello")
(st #t e is-modified?)
(st #f e get-filename)
(when (eq? editor% text%)
(st 'standard e get-file-format))
(st #t e save-file "tmp99" 'text)
(ck-mode 'text)
(st (string->path "tmp99") e get-filename)
(st #f e is-modified?)
(ck-text "tmp99")
(insert e "Ack")
(st #t e is-modified?)
(st #t e load-file "tmp99" 'guess)
(ck-mode 'guess)
(ck-text #f)
(st #f e is-modified?)
(st "Hello" e get-flattened-text)
(let ([now (file-or-directory-modify-seconds "tmp99")])
(st #t e save-file "tmp99" 'same)
(ck-text "tmp99")
(st (string->path "tmp99") e get-filename)
(let ([later (file-or-directory-modify-seconds "tmp99")])
(test #t 'file-date (now . <= . later))
(st #t e save-file "tmp98" 'standard)
(test #f 'file-date (later . < . (file-or-directory-modify-seconds "tmp99")))
(ck-binary "tmp98")
(st #t e load-file "tmp98" 'guess)
(ck-mode 'guess)
(ck-binary #f)
(st #t e load-file "tmp98" 'text)
(ck-mode 'text)
(ck-text #f)
(when (eq? editor% text%)
(st "WXME" e get-text 0 4))
(st #t e load-file "tmp98" 'same)
(ck-mode 'same)
(ck-text #f)
(when (eq? editor% text%)
(st "WXME" e get-text 0 4))
(st #t e load-file "tmp98" 'guess)
(ck-mode 'guess)
(ck-binary #f)
(st "Hello" e get-flattened-text)))
(let ([target "tmp97"])
;; Check [non-]temporary file names
(set! e (make-object (class editor+%
(define/override (put-file file dir)
(string->path target))
(super-new))))
(insert e "Howdy")
(st #t e is-modified?)
(set! mode #f)
(st #t e save-file #f 'copy)
(ck-mode 'copy)
(set! target "tmp95")
(st #t e is-modified?)
(ck-binary "tmp97")
(stv e set-filename "tmp96")
(st #t e save-file #f)
(st #f e is-modified?)
(st (string->path "tmp96") e get-filename)
(ck-binary "tmp96")
(stv e set-filename "tmp96" #t)
(st #t e save-file #f)
(ck-mode 'same)
(st (string->path "tmp95") e get-filename)
(stv e set-filename "tmp96" #t)
(st #t e save-file "")
(st (string->path "tmp95") e get-filename)
(ck-binary "tmp95")
(st "Howdy" e get-flattened-text)
(when (eq? editor% text%)
(stv e set-position 100))
(st #t e insert-file "tmp98")
(st "HowdyHello" e get-flattened-text)
(st #t e insert-file "tmp99")
(st "HowdyHelloHello" e get-flattened-text)
(st (string->path "tmp95") e get-filename))))
(map (lambda (reset?)
(run-save/load-tests text% (lambda (e t) (send e insert t)) reset?)
(run-save/load-tests pasteboard% (lambda (e t) (send e insert (make-object string-snip% t))) reset?))
'(#t #f))
(report-errs)
done
;;;;;; Undo tests
(define e (make-object text%))

6
collects/texpict/doc.txt
View File

@ -286,9 +286,9 @@ Basic Constructors:
extend slightly beyond the box.)
[MrEd only, in utils.ss]
> (pt-line dx dy size) -> pict
> (pt-arrow-line dx dy size) -> pict
> (pt-arrows-line dx dy size) -> pict
> (pip-line dx dy size) -> pict
> (pip-arrow-line dx dy size) -> pict
> (pip-arrows-line dx dy size) -> pict
Creates a line [with arrowhead(s)] as a 0-sized picture suitable
for use with `pin-over'. The 0-sized picture contains the starting

14
collects/texpict/utils.ss
View File

@ -20,9 +20,9 @@
arrowhead/offset
arrow-line
arrows-line
pt-line
pt-arrow-line
pt-arrows-line
pip-line
pip-arrow-line
pip-arrows-line
ellipse
filled-ellipse
@ -185,7 +185,7 @@
(+ x (/ size 2)) (+ y (/ size 2)))
(send dc set-brush b)
(send dc set-pen p)))
size size 0 0)
size size)
(- (- 0 (* 1/2 size (cos angle))) (/ size 2))
(- (+ (* 1/2 size) (- (* 1/2 size (sin angle)))) size)))
@ -203,7 +203,7 @@
(define (arrowhead/offset size angle)
(arrowhead/delta 0 size angle))
(define (pt-line dx dy size)
(define (pip-line dx dy size)
(picture
0 0
`((connect 0 0 ,dx ,(- dy)))))
@ -215,7 +215,7 @@
`((connect 0 0 ,dx ,dy)
(place ,(+ dx adx) ,(+ ady dy) ,a)))))
(define (pt-arrow-line dx dy size)
(define (pip-arrow-line dx dy size)
(arrow-line dx (- dy) size))
(define (arrows-line dx dy size)
@ -224,7 +224,7 @@
`((place 0 0 ,(arrow-line dx dy size))
(place ,dx ,dy ,(arrow-line (- dx) (- dy) size)))))
(define (pt-arrows-line dx dy size)
(define (pip-arrows-line dx dy size)
(arrows-line dx (- dy) size))
(define (filled-rectangle w h)

2
src/mred/mred.cxx
View File

@ -1022,6 +1022,8 @@ int mred_in_restricted_context()
#ifdef NEED_HET_PARAM
/* see wxHiEventTrampoline for info on mred_het_param: */
Scheme_Object *v;
if (!scheme_current_thread)
return 1;
v = scheme_get_param(scheme_current_thread->init_config, mred_het_param);
if (SCHEME_TRUEP(v))
return 1;

2
src/mred/wxme/wx_medad.h
View File

@ -281,7 +281,7 @@ class wxMediaBuffer : public wxObject
virtual void PrintToDC(wxDC *dc, int page = -1) = 0;
virtual Bool HasPrintPage(wxDC *dc, int page) = 0;
virtual Bool SaveFile(char *filename = NULL, int format = wxMEDIA_FF_SAME, Bool showErrors = TRUE) = 0;
virtual Bool SavePort(Scheme_Object *port, int format = wxMEDIA_FF_SAME, Bool showErrors = TRUE) = 0;
virtual int InsertPort(Scheme_Object *port, int format = wxMEDIA_FF_GUESS, Bool replaceStyles = TRUE) = 0;
char *GetFilename(Bool *temp = NULL);

71
src/mred/wxme/wx_media.cxx
View File

@ -3256,74 +3256,28 @@ Bool wxMediaEdit::InsertFile(const char *who, Scheme_Object *f, char *WXUNUSED(f
return !fileerr;
}
Bool wxMediaEdit::SaveFile(char *file, int format, Bool showErrors)
Bool wxMediaEdit::SavePort(Scheme_Object *f, int format, Bool showErrors)
{
Bool no_set_filename, fileerr;
Scheme_Object *f;
int is_binary;
if (readLocked)
return FALSE;
Bool fileerr;
showErrors = TRUE;
if (!file || !*file) {
if ((file && !*file) || !filename || tempFilename) {
char *path, *pfile;
if (filename) {
path = PathOnly(filename);
if (path && *path)
path = copystring(path);
else
path = NULL;
pfile = copystring(FileNameFromPath(filename));
} else
path = pfile = NULL;
file = PutFile(path, pfile);
} else
file = filename;
if (readLocked) {
if (showErrors)
wxmeError("save-file in text%: editor locked for reading");
return FALSE;
}
if (!file)
return FALSE;
if (!CanSaveFile(file, format))
return FALSE;
OnSaveFile(file, format);
no_set_filename = (format == wxMEDIA_FF_COPY);
if ((format == wxMEDIA_FF_SAME) || (format == wxMEDIA_FF_GUESS)
|| (format == wxMEDIA_FF_COPY))
format = fileFormat;
is_binary = !((format == wxMEDIA_FF_TEXT)
|| (format == wxMEDIA_FF_TEXT_FORCE_CR));
f = scheme_open_output_file_with_mode(file, "save-file in text%", !is_binary);
if (!f) {
if (showErrors)
wxmeError("save-file in text%: couldn't write the file");
AfterSaveFile(FALSE);
return FALSE;
}
wxBeginBusyCursor();
#ifdef wx_mac
wxMediaSetFileCreatorType(file, is_binary);
#endif
fileerr = FALSE;
if (format == wxMEDIA_FF_TEXT || format == wxMEDIA_FF_TEXT_FORCE_CR) {
wxchar *us;
us = GetText(-1, -1, TRUE, format == wxMEDIA_FF_TEXT_FORCE_CR);
scheme_put_char_string("save-file", f, us, 0, wxstrlen(us));
scheme_close_output_port(f);
} else {
wxMediaStreamOutFileBase *b;
wxMediaStreamOut *mf;
@ -3339,24 +3293,11 @@ Bool wxMediaEdit::SaveFile(char *file, int format, Bool showErrors)
wxWriteMediaGlobalFooter(mf);
fileerr = fileerr || !mf->Ok();
scheme_close_output_port(f);
}
if (fileerr && showErrors)
wxmeError("save-file in text%: error writing the file");
if (!no_set_filename && PTRNE(file, filename))
SetFilename(file, FALSE);
fileFormat = format;
wxEndBusyCursor();
if (!no_set_filename)
SetModified(fileerr);
AfterSaveFile(!fileerr);
return !fileerr;
}

2
src/mred/wxme/wx_media.h
View File

@ -348,7 +348,7 @@ class wxMediaEdit : public wxMediaBuffer
wxchar GetCharacter(long start);
char GetTruncatedCharacter(long start);
Bool SaveFile(char *filename = NULL, int format = wxMEDIA_FF_SAME, Bool showErrors = TRUE);
Bool SavePort(Scheme_Object *port, int format = wxMEDIA_FF_SAME, Bool showErrors = TRUE);
int InsertPort(Scheme_Object *port, int format = wxMEDIA_FF_GUESS, Bool replaceStyles = TRUE);
Bool ReadFromFile(wxMediaStreamIn *, long start, Bool overwritestyle = FALSE);

2
src/mred/wxme/wx_medpb.h
View File

@ -91,7 +91,7 @@ class wxMediaPasteboard : public wxMediaBuffer
Bool WriteToFile(wxMediaStreamOut *);
Bool ReadFromFile(wxMediaStreamIn *, Bool overwritestyle = FALSE);
Bool SaveFile(char *filename = NULL, int format = wxMEDIA_FF_STD, Bool showErrors = TRUE);
Bool SavePort(Scheme_Object *port, int format = wxMEDIA_FF_SAME, Bool showErrors = TRUE);
int InsertPort(Scheme_Object *port, int format = wxMEDIA_FF_GUESS, Bool replaceStyles = TRUE);
void StyleHasChanged(wxStyle *style);

89
src/mred/wxme/wx_mpbrd.cxx
View File

@ -1656,7 +1656,7 @@ void wxMediaPasteboard::Draw(wxDC *dc, double dx, double dy,
void wxMediaPasteboard::Refresh(double localx, double localy, double w, double h,
int show_caret, wxColour *bgColor)
{
double dx, dy, ddx, ddy;
double dx, dy, right, bottom;
wxDC *dc;
if (!admin)
@ -1677,21 +1677,20 @@ void wxMediaPasteboard::Refresh(double localx, double localy, double w, double h
dc = admin->GetDC(&dx, &dy);
/* Make sure all location information is integral,
so we can shift the coordinate system and generally
update on pixel boundaries. */
dx = floor(dx);
dy = floor(dy);
bottom = ceil(localy + h);
right = ceil(localx + w);
localy = floor(localy);
localx = floor(localx);
w = right - localx;
h = bottom - localy;
if (!offscreenInUse && bitmap && bitmap->Ok() && offscreen->Ok()
&& bgColor) {
/* Need to make sure that difference between coordinates is
integral; otherwise, roundoff error could affect drawing */
ddx = (localx - dx) - (long)(localx - dx);
if (ddx < 0)
ddx = 1 + ddx;
localx -= ddx;
w += ddx;
ddy = (localy - dy) - (long)(localy - dy);
if (ddy < 0)
ddy = 1 + ddy;
localy -= ddy;
h += ddy;
#ifndef EACH_BUFFER_OWN_OFFSCREEN
offscreenInUse = TRUE;
#endif
@ -2610,62 +2609,14 @@ Bool wxMediaPasteboard::InsertFile(const char *who, Scheme_Object *f, const char
return !fileerr;
}
Bool wxMediaPasteboard::SaveFile(char *file, int format, Bool showErrors)
Bool wxMediaPasteboard::SavePort(Scheme_Object *f, int format, Bool showErrors)
{
Scheme_Object *f;
Bool fileerr;
Bool no_set_filename;
wxMediaStreamOutFileBase *b;
wxMediaStreamOut *mf;
showErrors = TRUE;
if (!file || !*file) {
if ((file && !*file) || !filename || tempFilename) {
char *path, *pfile;
if (filename) {
path = PathOnly(filename);
if (path && *path)
path = copystring(path);
else
path = NULL;
pfile = copystring(FileNameFromPath(filename));
} else
path = pfile = NULL;
file = PutFile(path, pfile);
} else
file = filename;
}
if (!file)
return FALSE;
if (format != wxMEDIA_FF_COPY)
format = wxMEDIA_FF_STD;
no_set_filename = (format == wxMEDIA_FF_COPY);
if (!CanSaveFile(file, wxMEDIA_FF_STD))
return FALSE;
OnSaveFile(file, wxMEDIA_FF_STD);
f = scheme_open_output_file(file, "save-file in pasteboard%");
if (!f) {
if (showErrors)
wxmeError("save-file in pasteboard%: could not write the file");
AfterSaveFile(FALSE);
return FALSE;
}
wxBeginBusyCursor();
#ifdef wx_mac
wxMediaSetFileCreatorType(file, TRUE);
#endif
b = new wxMediaStreamOutFileBase(f);
mf = new wxMediaStreamOut(b);
@ -2680,21 +2631,9 @@ Bool wxMediaPasteboard::SaveFile(char *file, int format, Bool showErrors)
fileerr = fileerr || !mf->Ok();
scheme_close_output_port(f);
if (fileerr && showErrors)
wxmeError("save-file in pasteboard%: error writing the file");
if (!no_set_filename)
SetFilename(file, FALSE);
wxEndBusyCursor();
if (!no_set_filename)
SetModified(fileerr);
AfterSaveFile(!fileerr);
return !fileerr;
}

27
src/mred/wxme/wx_mpriv.cxx
View File

@ -2531,7 +2531,7 @@ void wxMediaEdit::Redraw()
void wxMediaEdit::Refresh(double left, double top, double width, double height,
int show_caret, wxColour *bgColor)
{
double x, y, bottom, right, ddx, ddy;
double x, y, bottom, right;
Bool ps;
wxDC *dc;
int show_xsel = 0;
@ -2565,8 +2565,17 @@ void wxMediaEdit::Refresh(double left, double top, double width, double height,
if (ReadyOffscreen(width, height))
drawCachedInBitmap = FALSE;
bottom = top + height;
right = left + width;
/* Make sure all location information is integral,
so we can shift the coordinate system and generally
update on pixel boundaries. */
x = floor(x);
y = floor(y);
bottom = ceil(top + height);
right = ceil(left + width);
top = floor(top);
left = floor(left);
width = right - left;
height = bottom - top;
ps = (wxSubType(dc->__type, wxTYPE_DC_POSTSCRIPT)
|| wxSubType(dc->__type, wxTYPE_DC_PRINTER));
@ -2580,24 +2589,12 @@ void wxMediaEdit::Refresh(double left, double top, double width, double height,
#endif
if (bgColor && !offscreenInUse && bitmap && bitmap->Ok() && offscreen->Ok() && !ps) {
/* Need to make sure that difference between coordinates is
integral; otherwise, roundoff error could affect drawing */
unsigned char red, green, blue;
red = (unsigned char)bgColor->Red();
green = (unsigned char)bgColor->Green();
blue = (unsigned char)bgColor->Blue();
ddx = (left - x) - (long)(left - x);
if (ddx < 0)
ddx = 1 + ddx;
left -= ddx;
width += ddx;
ddy = (top - y) - (long)(top - y);
if (ddy < 0)
ddy = 1 + ddy;
top -= ddy;
height += ddy;
#ifndef EACH_BUFFER_OWN_OFFSCREEN
offscreenInUse = TRUE;
#endif

4
src/mred/wxs/wxs_mbuf.xci
View File

@ -85,8 +85,8 @@
@ Z "on-edit-sequence" : void OnEditSequence();
@ Z "after-edit-sequence" : void AfterEditSequence();
@ Z "get-file" : npathname GetFile(epathname);
@ Z "put-file" : npathname PutFile(epathname, epathname);
@ Z "get-file" : npathname GetFile(nepathname);
@ Z "put-file" : npathname PutFile(nepathname, nepathname);
@MACRO makeNoCopyFlatString[len] = WITH_VAR_STACK(scheme_make_sized_char_string(r, <len>, 0))

20
src/mred/wxs/wxs_mede.cxx
View File

@ -996,8 +996,8 @@ class os_wxMediaEdit : public wxMediaEdit {
void DoPaste(nnlong x0, ExactLong x1);
void DoCopy(nnlong x0, nnlong x1, ExactLong x2, Bool x3);
void SetAnchor(Bool x0);
npathname PutFile(epathname x0, epathname x1);
npathname GetFile(epathname x0);
npathname PutFile(nepathname x0, nepathname x1);
npathname GetFile(nepathname x0);
void AfterEditSequence();
void OnEditSequence();
void AfterLoadFile(Bool x0);
@ -1926,7 +1926,7 @@ void os_wxMediaEdit::SetAnchor(Bool x0)
static Scheme_Object *os_wxMediaEditPutFile(int n, Scheme_Object *p[]);
npathname os_wxMediaEdit::PutFile(epathname x0, epathname x1)
npathname os_wxMediaEdit::PutFile(nepathname x0, nepathname x1)
{
Scheme_Object *p[POFFSET+2] INIT_NULLED_ARRAY({ NULLED_OUT INA_comma NULLED_OUT INA_comma NULLED_OUT });
Scheme_Object *v;
@ -1969,7 +1969,7 @@ npathname os_wxMediaEdit::PutFile(epathname x0, epathname x1)
static Scheme_Object *os_wxMediaEditGetFile(int n, Scheme_Object *p[]);
npathname os_wxMediaEdit::GetFile(epathname x0)
npathname os_wxMediaEdit::GetFile(nepathname x0)
{
Scheme_Object *p[POFFSET+1] INIT_NULLED_ARRAY({ NULLED_OUT INA_comma NULLED_OUT });
Scheme_Object *v;
@ -7115,8 +7115,8 @@ static Scheme_Object *os_wxMediaEditPutFile(int n, Scheme_Object *p[])
REMEMBER_VAR_STACK();
npathname r;
objscheme_check_valid(os_wxMediaEdit_class, "put-file in text%", n, p);
epathname x0 INIT_NULLED_OUT;
epathname x1 INIT_NULLED_OUT;
nepathname x0 INIT_NULLED_OUT;
nepathname x1 INIT_NULLED_OUT;
SETUP_VAR_STACK_REMEMBERED(3);
VAR_STACK_PUSH(0, p);
@ -7124,8 +7124,8 @@ static Scheme_Object *os_wxMediaEditPutFile(int n, Scheme_Object *p[])
VAR_STACK_PUSH(2, x1);
x0 = (epathname)WITH_VAR_STACK(objscheme_unbundle_epathname(p[POFFSET+0], "put-file in text%"));
x1 = (epathname)WITH_VAR_STACK(objscheme_unbundle_epathname(p[POFFSET+1], "put-file in text%"));
x0 = (nepathname)WITH_VAR_STACK(objscheme_unbundle_nullable_epathname(p[POFFSET+0], "put-file in text%"));
x1 = (nepathname)WITH_VAR_STACK(objscheme_unbundle_nullable_epathname(p[POFFSET+1], "put-file in text%"));
if (((Scheme_Class_Object *)p[0])->primflag)
@ -7145,14 +7145,14 @@ static Scheme_Object *os_wxMediaEditGetFile(int n, Scheme_Object *p[])
REMEMBER_VAR_STACK();
npathname r;
objscheme_check_valid(os_wxMediaEdit_class, "get-file in text%", n, p);
epathname x0 INIT_NULLED_OUT;
nepathname x0 INIT_NULLED_OUT;
SETUP_VAR_STACK_REMEMBERED(2);
VAR_STACK_PUSH(0, p);
VAR_STACK_PUSH(1, x0);
x0 = (epathname)WITH_VAR_STACK(objscheme_unbundle_epathname(p[POFFSET+0], "get-file in text%"));
x0 = (nepathname)WITH_VAR_STACK(objscheme_unbundle_nullable_epathname(p[POFFSET+0], "get-file in text%"));
if (((Scheme_Class_Object *)p[0])->primflag)

21
src/mred/wxs/wxs_medi.cxx
View File

@ -2142,7 +2142,7 @@ static Scheme_Object *os_wxMediaBufferInsertPort(int n, Scheme_Object *p[])
VAR_STACK_PUSH(1, x0);
x0 = (SCHEME_INPORTP(p[POFFSET+0]) ? p[POFFSET+0] : (scheme_wrong_type(METHODNAME("editor<%>","insert-file"), "input port", -1, 1, &p[POFFSET+0]), (Scheme_Object *)NULL));
x0 = (SCHEME_INPORTP(p[POFFSET+0]) ? p[POFFSET+0] : (scheme_wrong_type(METHODNAME("editor<%>","insert-port"), "input port", -1, 1, &p[POFFSET+0]), (Scheme_Object *)NULL));
if (n > (POFFSET+1)) {
x1 = WITH_VAR_STACK(unbundle_symset_fileType(p[POFFSET+1], "insert-port in editor<%>"));
} else
@ -2161,13 +2161,13 @@ static Scheme_Object *os_wxMediaBufferInsertPort(int n, Scheme_Object *p[])
return WITH_REMEMBERED_STACK(bundle_symset_fileType(r));
}
static Scheme_Object *os_wxMediaBufferSaveFile(int n, Scheme_Object *p[])
static Scheme_Object *os_wxMediaBufferSavePort(int n, Scheme_Object *p[])
{
WXS_USE_ARGUMENT(n) WXS_USE_ARGUMENT(p)
REMEMBER_VAR_STACK();
Bool r;
objscheme_check_valid(os_wxMediaBuffer_class, "save-file in editor<%>", n, p);
nxpathname x0 INIT_NULLED_OUT;
objscheme_check_valid(os_wxMediaBuffer_class, "save-port in editor<%>", n, p);
Scheme_Object* x0 INIT_NULLED_OUT;
int x1;
Bool x2;
@ -2176,21 +2176,18 @@ static Scheme_Object *os_wxMediaBufferSaveFile(int n, Scheme_Object *p[])
VAR_STACK_PUSH(1, x0);
if (n > (POFFSET+0)) {
x0 = (nxpathname)WITH_VAR_STACK(objscheme_unbundle_nullable_xpathname(p[POFFSET+0], "save-file in editor<%>"));
} else
x0 = NULL;
x0 = (SCHEME_OUTPORTP(p[POFFSET+0]) ? p[POFFSET+0] : (scheme_wrong_type(METHODNAME("editor<%>","save-port"), "output port", -1, 1, &p[POFFSET+0]), (Scheme_Object *)NULL));
if (n > (POFFSET+1)) {
x1 = WITH_VAR_STACK(unbundle_symset_fileType(p[POFFSET+1], "save-file in editor<%>"));
x1 = WITH_VAR_STACK(unbundle_symset_fileType(p[POFFSET+1], "save-port in editor<%>"));
} else
x1 = wxMEDIA_FF_SAME;
if (n > (POFFSET+2)) {
x2 = WITH_VAR_STACK(objscheme_unbundle_bool(p[POFFSET+2], "save-file in editor<%>"));
x2 = WITH_VAR_STACK(objscheme_unbundle_bool(p[POFFSET+2], "save-port in editor<%>"));
} else
x2 = TRUE;
r = WITH_VAR_STACK(((wxMediaBuffer *)((Scheme_Class_Object *)p[0])->primdata)->SaveFile(x0, x1, x2));
r = WITH_VAR_STACK(((wxMediaBuffer *)((Scheme_Class_Object *)p[0])->primdata)->SavePort(x0, x1, x2));
@ -2272,7 +2269,7 @@ void objscheme_setup_wxMediaBuffer(Scheme_Env *env)
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaBuffer_class, "insert-file" " method", (Scheme_Method_Prim *)os_wxMediaBufferNoInsertFile, 0, 0));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaBuffer_class, "load-file" " method", (Scheme_Method_Prim *)os_wxMediaBufferNoLoadFile, 0, 0));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaBuffer_class, "insert-port" " method", (Scheme_Method_Prim *)os_wxMediaBufferInsertPort, 1, 3));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaBuffer_class, "save-file" " method", (Scheme_Method_Prim *)os_wxMediaBufferSaveFile, 0, 3));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaBuffer_class, "save-port" " method", (Scheme_Method_Prim *)os_wxMediaBufferSavePort, 1, 3));
WITH_VAR_STACK(scheme_made_class(os_wxMediaBuffer_class));

10
src/mred/wxs/wxs_medi.xc
View File

@ -49,8 +49,10 @@ static void *wxbDCToBuffer(wxMediaBuffer *b, double x, double y)
@MACRO rFALSE = return FALSE;
@MACRO rZERO = return 0;
@MACRO ubPort = (SCHEME_INPORTP({x}) ? {x} : (scheme_wrong_type(METHODNAME("editor<%>","insert-file"), "input port", -1, 1, &{x}), (Scheme_Object *)NULL))
@MACRO cPort = SCHEME_INPORTP({x})
@MACRO ubiPort[who] = (SCHEME_INPORTP({x}) ? {x} : (scheme_wrong_type(METHODNAME("editor<%>",<who>), "input port", -1, 1, &{x}), (Scheme_Object *)NULL))
@MACRO ciPort = SCHEME_INPORTP({x})
@MACRO uboPort[who] = (SCHEME_OUTPORTP({x}) ? {x} : (scheme_wrong_type(METHODNAME("editor<%>",<who>), "output port", -1, 1, &{x}), (Scheme_Object *)NULL))
@MACRO coPort = SCHEME_OUTPORTP({x})
@INCLUDE wxs_eds.xci
@ -85,8 +87,8 @@ static void NoInsertFile(wxMediaBuffer *)
// but acutally are implemented with virtual
@SETMARK W = D
@ W "save-file" : bool SaveFile(nxpathname=NULL,SYM[fileType]=wxMEDIA_FF_SAME,bool=TRUE);
@ W "insert-port" : SYM[fileType] InsertPort(Scheme_Object[]//ubPort/cPort///push,SYM[fileType]=wxMEDIA_FF_GUESS,bool=TRUE); <> port
@ W "save-port" : bool SavePort(Scheme_Object[]//uboPort["save-port"]/coPort///push,SYM[fileType]=wxMEDIA_FF_SAME,bool=TRUE);
@ W "insert-port" : SYM[fileType] InsertPort(Scheme_Object[]//ubiPort["insert-port"]/ciPort///push,SYM[fileType]=wxMEDIA_FF_GUESS,bool=TRUE); <> port
// No longer actually in C, but we want them in the editor<%> interface:
@ m "load-file" : void NoLoadFile()

20
src/mred/wxs/wxs_mpb.cxx
View File

@ -419,8 +419,8 @@ class os_wxMediaPasteboard : public wxMediaPasteboard {
void DoPasteSelection(ExactLong x0);
void DoPaste(ExactLong x0);
void DoCopy(ExactLong x0, Bool x1);
npathname PutFile(epathname x0, epathname x1);
npathname GetFile(epathname x0);
npathname PutFile(nepathname x0, nepathname x1);
npathname GetFile(nepathname x0);
void AfterEditSequence();
void OnEditSequence();
void AfterLoadFile(Bool x0);
@ -1710,7 +1710,7 @@ void os_wxMediaPasteboard::DoCopy(ExactLong x0, Bool x1)
static Scheme_Object *os_wxMediaPasteboardPutFile(int n, Scheme_Object *p[]);
npathname os_wxMediaPasteboard::PutFile(epathname x0, epathname x1)
npathname os_wxMediaPasteboard::PutFile(nepathname x0, nepathname x1)
{
Scheme_Object *p[POFFSET+2] INIT_NULLED_ARRAY({ NULLED_OUT INA_comma NULLED_OUT INA_comma NULLED_OUT });
Scheme_Object *v;
@ -1753,7 +1753,7 @@ npathname os_wxMediaPasteboard::PutFile(epathname x0, epathname x1)
static Scheme_Object *os_wxMediaPasteboardGetFile(int n, Scheme_Object *p[]);
npathname os_wxMediaPasteboard::GetFile(epathname x0)
npathname os_wxMediaPasteboard::GetFile(nepathname x0)
{
Scheme_Object *p[POFFSET+1] INIT_NULLED_ARRAY({ NULLED_OUT INA_comma NULLED_OUT });
Scheme_Object *v;
@ -5284,8 +5284,8 @@ static Scheme_Object *os_wxMediaPasteboardPutFile(int n, Scheme_Object *p[])
REMEMBER_VAR_STACK();
npathname r;
objscheme_check_valid(os_wxMediaPasteboard_class, "put-file in pasteboard%", n, p);
epathname x0 INIT_NULLED_OUT;
epathname x1 INIT_NULLED_OUT;
nepathname x0 INIT_NULLED_OUT;
nepathname x1 INIT_NULLED_OUT;
SETUP_VAR_STACK_REMEMBERED(3);
VAR_STACK_PUSH(0, p);
@ -5293,8 +5293,8 @@ static Scheme_Object *os_wxMediaPasteboardPutFile(int n, Scheme_Object *p[])
VAR_STACK_PUSH(2, x1);
x0 = (epathname)WITH_VAR_STACK(objscheme_unbundle_epathname(p[POFFSET+0], "put-file in pasteboard%"));
x1 = (epathname)WITH_VAR_STACK(objscheme_unbundle_epathname(p[POFFSET+1], "put-file in pasteboard%"));
x0 = (nepathname)WITH_VAR_STACK(objscheme_unbundle_nullable_epathname(p[POFFSET+0], "put-file in pasteboard%"));
x1 = (nepathname)WITH_VAR_STACK(objscheme_unbundle_nullable_epathname(p[POFFSET+1], "put-file in pasteboard%"));
if (((Scheme_Class_Object *)p[0])->primflag)
@ -5314,14 +5314,14 @@ static Scheme_Object *os_wxMediaPasteboardGetFile(int n, Scheme_Object *p[])
REMEMBER_VAR_STACK();
npathname r;
objscheme_check_valid(os_wxMediaPasteboard_class, "get-file in pasteboard%", n, p);
epathname x0 INIT_NULLED_OUT;
nepathname x0 INIT_NULLED_OUT;
SETUP_VAR_STACK_REMEMBERED(2);
VAR_STACK_PUSH(0, p);
VAR_STACK_PUSH(1, x0);
x0 = (epathname)WITH_VAR_STACK(objscheme_unbundle_epathname(p[POFFSET+0], "get-file in pasteboard%"));
x0 = (nepathname)WITH_VAR_STACK(objscheme_unbundle_nullable_epathname(p[POFFSET+0], "get-file in pasteboard%"));
if (((Scheme_Class_Object *)p[0])->primflag)

5
src/wxcommon/PSDC.cxx
View File

@ -2233,6 +2233,7 @@ void wxPrintSetupData::SetAFMPath(char *f)
void wxPrintSetupData::copy(wxPrintSetupData* data)
{
double x, y;
long lx, ly;
char *s;
int i;
@ -2257,6 +2258,10 @@ void wxPrintSetupData::copy(wxPrintSetupData* data)
SetPrinterTranslation(x, y);
data->GetPrinterScaling(&x, &y);
SetPrinterScaling(x, y);
data->GetMargin(&x, &y);
SetMargin(x, y);
data->GetEditorMargin(&lx, &ly);
SetEditorMargin(lx, ly);
#ifdef wx_mac
if (data->native) {

3
src/wxcommon/Region.cxx
View File

@ -1480,8 +1480,7 @@ wxPathPathRgn::wxPathPathRgn(wxDC *dc_for_scale,
{
p = new wxPath();
p->AddPath(_p);
xoffset = _xoffset;
yoffset = _yoffset;
p->Translate(_xoffset, _yoffset);
fillStyle = _fillStyle;
}

2
src/wxcommon/Region.h
View File

@ -170,8 +170,6 @@ class wxPathPathRgn : public wxPathRgn
{
public:
wxPath *p;
double xoffset;
double yoffset;
int fillStyle;
wxPathPathRgn(wxDC *dc_for_scale, wxPath *p, double xoffset, double yoffset, int fillStyle);
virtual Bool Install(long target, Bool reverse, Bool align);