[Gd-chatter] r10902 - trunk/fundev/sources/environment/win32
hannes at gwydiondylan.org
hannes at gwydiondylan.org
Tue Sep 5 19:11:54 CEST 2006
Author: hannes
Date: Tue Sep 5 19:11:52 2006
New Revision: 10902
Modified:
trunk/fundev/sources/environment/win32/environment-frames.dylan
trunk/fundev/sources/environment/win32/initialization.dylan
trunk/fundev/sources/environment/win32/start.dylan
Log:
Job: fd
*untabify
Modified: trunk/fundev/sources/environment/win32/environment-frames.dylan
==============================================================================
--- trunk/fundev/sources/environment/win32/environment-frames.dylan (original)
+++ trunk/fundev/sources/environment/win32/environment-frames.dylan Tue Sep 5 19:11:52 2006
@@ -20,22 +20,22 @@
(_port :: <win32-port>,
sheet :: <sheet>, mirror :: <window-mirror>, where :: <mirror-order>) => ()
local method dbg-msg (where-to :: <string>) => ()
- debug-message("reorder-mirror: placing mirror for frame \"%s\" %s",
- mirror.mirror-sheet.sheet-frame.frame-title, where-to);
- end method;
+ debug-message("reorder-mirror: placing mirror for frame \"%s\" %s",
+ mirror.mirror-sheet.sheet-frame.frame-title, where-to);
+ end method;
let where-handle
= case
- instance?(where, <window-mirror>) =>
- dbg-msg(concatenate("behind frame \"",
- where.mirror-sheet.sheet-frame.frame-title,
- "\""));
- window-handle(where);
- where = #"top" =>
- dbg-msg("at top using $HWND-TOP");
- $HWND-TOP; // $HWND-NOTOPMOST;
- where = #"bottom" =>
- dbg-msg("at bottom using $HWND-BOTTOM");
- $HWND-BOTTOM;
+ instance?(where, <window-mirror>) =>
+ dbg-msg(concatenate("behind frame \"",
+ where.mirror-sheet.sheet-frame.frame-title,
+ "\""));
+ window-handle(where);
+ where = #"top" =>
+ dbg-msg("at top using $HWND-TOP");
+ $HWND-TOP; // $HWND-NOTOPMOST;
+ where = #"bottom" =>
+ dbg-msg("at bottom using $HWND-BOTTOM");
+ $HWND-BOTTOM;
end;
let handle :: <HWND> = window-handle(mirror);
//---*** cpage: 1998.07.07 Experiment with this flag.
@@ -52,8 +52,8 @@
// check-result("SetActiveWindow", SetActiveWindow(handle));
else
check-result("SetWindowPos",
- SetWindowPos(handle, where-handle, 0, 0, 0, 0,
- %logior($SWP-NOMOVE, $SWP-NOSIZE, activate-flag)))
+ SetWindowPos(handle, where-handle, 0, 0, 0, 0,
+ %logior($SWP-NOMOVE, $SWP-NOSIZE, activate-flag)))
end
end method reorder-mirror;
@@ -66,10 +66,10 @@
when (mirror)
let mirror-where
= if (instance?(where, <sheet>))
- sheet-direct-mirror(where)
- else
- where
- end;
+ sheet-direct-mirror(where)
+ else
+ where
+ end;
when (mirror-where)
reorder-mirror(port(sheet), sheet, mirror, mirror-where)
end
@@ -85,13 +85,13 @@
frame);
let sheet-where
= if (instance?(where, <frame>))
- let where-top-sheet = top-level-sheet(where);
- assert(where-top-sheet & sheet-mapped?(where-top-sheet),
- "Attempted to reorder below %=, which isn't mapped",
- where);
- where-top-sheet
+ let where-top-sheet = top-level-sheet(where);
+ assert(where-top-sheet & sheet-mapped?(where-top-sheet),
+ "Attempted to reorder below %=, which isn't mapped",
+ where);
+ where-top-sheet
else
- where
+ where
end;
reorder-sheet(top-sheet, sheet-where);
frame
@@ -103,10 +103,10 @@
// Be lenient when getting window handles. Because of multithreading,
// a frame's mirror may be gone before we operate on it.
local method frame-window-handle (frame :: <frame>) => (handle :: false-or(<HWND>))
- let sheet = top-level-sheet(frame);
- let mirror = sheet & sheet-direct-mirror(sheet);
- mirror & window-handle(mirror)
- end method;
+ let sheet = top-level-sheet(frame);
+ let mirror = sheet & sheet-direct-mirror(sheet);
+ mirror & window-handle(mirror)
+ end method;
let handles = remove(map(frame-window-handle, frames), #f);
let defer-handle :: <HDWP> = BeginDeferWindowPos(size(frames));
check-result("BeginDeferWindowPos", defer-handle);
@@ -114,17 +114,17 @@
i :: <integer> from 0)
let (where :: <HWND>, activate-flag)
= if (i = 0)
- values($HWND-TOP, 0)
- else
- values(handles[i - 1], $SWP-NOACTIVATE)
- end;
+ values($HWND-TOP, 0)
+ else
+ values(handles[i - 1], $SWP-NOACTIVATE)
+ end;
defer-handle := DeferWindowPos(defer-handle, handle, where,
- 0, 0, 0, 0,
- %logior($SWP-NOMOVE, $SWP-NOSIZE, activate-flag));
+ 0, 0, 0, 0,
+ %logior($SWP-NOMOVE, $SWP-NOSIZE, activate-flag));
check-result("DeferWindowPos", defer-handle);
end;
check-result("EndDeferWindowPos",
- EndDeferWindowPos(defer-handle));
+ EndDeferWindowPos(defer-handle));
end method order-frames;
// Restore a frame from minimized/maximized state without bringing
Modified: trunk/fundev/sources/environment/win32/initialization.dylan
==============================================================================
--- trunk/fundev/sources/environment/win32/initialization.dylan (original)
+++ trunk/fundev/sources/environment/win32/initialization.dylan Tue Sep 5 19:11:52 2006
@@ -14,27 +14,27 @@
define macro initialize-bitmap
{ initialize-bitmap(?bitmap:name, ?resource-id:expression) }
=> { let _id = as(<byte-string>, ?resource-id);
- let _bitmap = read-image-as(<win32-bitmap>, _id, #"bitmap");
- when (_bitmap)
- ?bitmap := _bitmap
- end }
+ let _bitmap = read-image-as(<win32-bitmap>, _id, #"bitmap");
+ when (_bitmap)
+ ?bitmap := _bitmap
+ end }
end macro initialize-bitmap;
define macro initialize-icon
{ initialize-icon(?size:expression, ?icon:name, ?resource-id:expression) }
=> { let _id = as(<byte-string>, ?resource-id);
- let _icon
- = select (?size)
- #"small" => read-image-as(<win32-icon>, _id, #"small-icon");
- #"large" => read-image-as(<win32-icon>, _id, #"large-icon");
- #"16x16" => read-image-as(<win32-icon>, _id, #"icon",
- width: 16, height: 16);
- #"32x32" => read-image-as(<win32-icon>, _id, #"icon",
- width: 32, height: 32);
- end;
- when (_icon)
- ?icon := _icon
- end }
+ let _icon
+ = select (?size)
+ #"small" => read-image-as(<win32-icon>, _id, #"small-icon");
+ #"large" => read-image-as(<win32-icon>, _id, #"large-icon");
+ #"16x16" => read-image-as(<win32-icon>, _id, #"icon",
+ width: 16, height: 16);
+ #"32x32" => read-image-as(<win32-icon>, _id, #"icon",
+ width: 32, height: 32);
+ end;
+ when (_icon)
+ ?icon := _icon
+ end }
end macro initialize-icon;
define function initialize-bitmaps ()
@@ -43,7 +43,7 @@
//---*** hughg, 1998/11/02: This one really belongs in DUIM, but andrewa
//---*** agrees this'll do for now (for the playground dialog).
$check-bitmap := read-image-as(<win32-bitmap>, $OBM-CHECK, #"bitmap",
- resource-context: #"system");
+ resource-context: #"system");
// Initialize the splash screen
initialize-bitmap($splash-screen-bitmap, "SPLASHSCREEN");
@@ -182,9 +182,9 @@
define function initialize-deuce ()
local method make-deuce-color (color) => (deuce-color)
- let (r, g, b) = color-rgb(color);
- deuce/make-color(floor(r * 255.0), floor(g * 255.0), floor(b * 255.0))
- end method;
+ let (r, g, b) = color-rgb(color);
+ deuce/make-color(floor(r * 255.0), floor(g * 255.0), floor(b * 255.0))
+ end method;
$region-marking-color := make-deuce-color($default-face-color);
$dylan-definition-line-color := make-deuce-color($default-shadow-color)
end function initialize-deuce;
@@ -218,10 +218,10 @@
with-stack-structure (file-info :: <LPSHFILEINFOA>)
let options
= %logior($SHGFI-ICON,
- select (icon-size)
- #"small" => $SHGFI-SMALLICON;
- #"large" => $SHGFI-LARGEICON;
- end);
+ select (icon-size)
+ #"small" => $SHGFI-SMALLICON;
+ #"large" => $SHGFI-LARGEICON;
+ end);
with-c-string (c-string = filename)
SHGetFileInfo(c-string, 0, file-info, size-of(<SHFILEINFO>), options);
end;
@@ -233,9 +233,9 @@
let handle = file-info.hIcon-value;
unless (null-pointer?(handle))
make(<win32-icon>,
- resource-id: "none",
- handle: file-info.hIcon-value,
- width: width, height: height)
+ resource-id: "none",
+ handle: file-info.hIcon-value,
+ width: width, height: height)
end
end
end function icon-for-file;
@@ -261,8 +261,8 @@
=> ()
let action-name
= select (action)
- #"open" => $open-action;
- #"print" => $print-action;
+ #"open" => $open-action;
+ #"print" => $print-action;
end;
debug-message("Action: %sing %s", action-name, locator);
let sheet = top-level-sheet(frame);
@@ -271,12 +271,12 @@
let handle = window-handle(sheet);
with-c-string (action-name = action-name)
with-c-string (filename = as(<string>, locator))
- with-c-string (path = "")
- check-result
- ("ShellExecute",
- ShellExecute(handle, action-name, filename,
- $NULL-string, path, show-command))
- end
+ with-c-string (path = "")
+ check-result
+ ("ShellExecute",
+ ShellExecute(handle, action-name, filename,
+ $NULL-string, path, show-command))
+ end
end
end
end
@@ -305,9 +305,9 @@
let resizable? = frame-resizable?(frame);
let (extra-width, extra-height)
= values(GetSystemMetrics
- (if (resizable?) $SM-CXSIZEFRAME else $SM-CXFIXEDFRAME end),
- GetSystemMetrics
- (if (resizable?) $SM-CYSIZEFRAME else $SM-CYFIXEDFRAME end));
+ (if (resizable?) $SM-CXSIZEFRAME else $SM-CXFIXEDFRAME end),
+ GetSystemMetrics
+ (if (resizable?) $SM-CYSIZEFRAME else $SM-CYFIXEDFRAME end));
*/
let (extra-width, extra-height) = values(1, 1);
values(title-bar-height + extra-width, title-bar-height + extra-height)
Modified: trunk/fundev/sources/environment/win32/start.dylan
==============================================================================
--- trunk/fundev/sources/environment/win32/start.dylan (original)
+++ trunk/fundev/sources/environment/win32/start.dylan Tue Sep 5 19:11:52 2006
@@ -28,11 +28,11 @@
system-root :: false-or(<directory-locator>))
=> ()
local method set-variable
- (variable :: <string>, directory :: <directory-locator>,
- subdirectories :: <sequence>)
- let subdirectory = apply(subdirectory-locator, directory, subdirectories);
- environment-variable(variable) := as(<string>, subdirectory)
- end method set-variable;
+ (variable :: <string>, directory :: <directory-locator>,
+ subdirectories :: <sequence>)
+ let subdirectory = apply(subdirectory-locator, directory, subdirectories);
+ environment-variable(variable) := as(<string>, subdirectory)
+ end method set-variable;
if (personal-root)
for (directory-info :: <list> in $personal-directories)
let variable = directory-info.head;
@@ -60,24 +60,24 @@
let argument = pop(arguments);
if (argument[0] == '/')
select (copy-sequence(argument, start: 1) by \=)
- "personal" => personal-root := as(<directory-locator>, pop(arguments));
- "system" => system-root := as(<directory-locator>, pop(arguments));
- otherwise => #f;
+ "personal" => personal-root := as(<directory-locator>, pop(arguments));
+ "system" => system-root := as(<directory-locator>, pop(arguments));
+ otherwise => #f;
end
else
block ()
- filename := as(<file-locator>, argument)
+ filename := as(<file-locator>, argument)
exception (error :: <locator-error>)
- environment-startup-error
- ("Invalid filename '%s' passed to %s",
- argument,
- release-product-name());
+ environment-startup-error
+ ("Invalid filename '%s' passed to %s",
+ argument,
+ release-product-name());
end
end
end;
if (release-internal?())
maybe-set-roots(personal-root: personal-root,
- system-root: system-root)
+ system-root: system-root)
end;
filename
end method process-arguments;
@@ -96,7 +96,7 @@
define method main
(name :: <string>, arguments :: <sequence>) => ()
debug-message("Starting environment: %s with arguments '%='...\n",
- name, arguments);
+ name, arguments);
initialize-bitmaps();
initialize-deuce();
initialize-editors();
More information about the chatter
mailing list