Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
clean-and-itasks
clm
Commits
65bdcad1
Commit
65bdcad1
authored
Oct 21, 2003
by
John van Groningen
Browse files
add file selectors for the Macintosh
parent
dc132219
Changes
4
Hide whitespace changes
Inline
Side-by-side
htoclean/htoclean source code/mac_file_selector_carbon.dcl
0 → 100644
View file @
65bdcad1
definition
module
mac_file_selector_carbon
;
SelectInputFile
::
!*
World
->
(!
Bool
,!
String
,*
World
);
SelectOutputFile
::
!
String
!
String
!*
World
->
(!
Bool
,
!
String
,!*
World
);
htoclean/htoclean source code/mac_file_selector_carbon.icl
0 → 100644
View file @
65bdcad1
implementation
module
mac_file_selector_carbon
;
import
StdClass
,
StdBool
,
StdChar
,
StdInt
,
StdMisc
,
StdString
,
StdFile
,
StdArray
;
import
standard_file
,
files
,
pointer
,
quickdraw
,
memory
,
appleevents
,
navigation
;
String64
::
String
;
String64
=
createArray
64
'@'
;
Error_i
::
!
String
!
Int
->
.
x
;
Error_i
string
i
=
abort
(
string
+++
toString
i
);
Get_name_and_parent_id_of_directory
::
!
Int
!
Int
!*
Toolbox
->
(!
String
,!
Int
,!*
Toolbox
);
Get_name_and_parent_id_of_directory
volumeNumber
directoryId
tb
|
osError
==
0
=
(
folderName
,
parentId
,
tb1
);
=
Error_i
"Error code returned by BPGetCatInfo: "
osError
;
where
{
(
osError
,
folderName
,
parentId
,
tb1
)
=
GetCatInfo2
volumeNumber
directoryId
String64
tb
;
};
Get_directory_path
::
!
Int
!
Int
!
String
!*
Toolbox
->
(!
String
,
!*
Toolbox
);
Get_directory_path
volumeNumber
directoryId
path
tb
|
directoryId
==
2
=
(
folderName
+++
":"
+++
path
,
tb1
);
=
Get_directory_path
volumeNumber
parentId
(
folderName
+++
":"
+++
path
)
tb1
;
where
{
(
folderName
,
parentId
,
tb1
)
=
Get_name_and_parent_id_of_directory
volumeNumber
directoryId
tb
;
};
Find_colon
::
!
String
!
Int
->
(!
Bool
,!
Int
);
Find_colon
s
p
=
Find_colon2
s
p
(
dec
(
size
s
));
Find_colon2
::
String
!
Int
!
Int
->
(!
Bool
,!
Int
);
Find_colon2
s
p
l
|
p
>=
l
=
(
False
,
p
);
|
s
.[
p
]
==
':'
=
(
True
,
p
);
=
Find_colon2
s
(
inc
p
)
l
;
Get_directory_and_file_name
::
!
String
!*
Toolbox
->
(!
Int
,!
Int
,!
String
,!*
Toolbox
);
Get_directory_and_file_name
pathName
tb
|
not
colon
=
(
sfSaveDisk
,
curDirStore
,
pathName
,
tb1
);
|
pathName
.[
0
]
==
':'
=
Get_directory_and_file_name2
pathName
0
sfSaveDisk
curDirStore
tb1
;
|
0
==
result
=
Get_directory_and_file_name2
pathName
colonPosition
volumeNumber
2
tb`
;
=
(
sfSaveDisk`
,
curDirStore`
,
pathName
,
tb``
);
where
{
(
colon
,
colonPosition
)
=
Find_colon
pathName
0
;
(
sfSaveDisk
,
curDirStore
,
tb1
)
=
Get_stored_dir_and_file
tb
;
(
result
,
volumeNumber
,
tb`
)
=
GetVInfo
(
pathName
%
(
0
,
colonPosition
))
tb
;
(
sfSaveDisk`
,
curDirStore`
,
tb``
)
=
Get_stored_dir_and_file
tb`
;
};
Get_stored_dir_and_file
::
!*
Toolbox
->
(!
Int
,!
Int
,!*
Toolbox
);
Get_stored_dir_and_file
tb
=
(
sfSaveDisk
,
curDirStore
,
tb2
);
where
{
(
saveDisk
,
tb1
)
=
LoadWord
532
tb
;
sfSaveDisk
=
0
-
saveDisk
;
(
curDirStore
,
tb2
)
=
LoadLong
920
tb1
;
};
Get_directory_and_file_name2
::
!
String
!
Int
!
Int
!
Int
!*
Toolbox
->
(!
Int
,!
Int
,!
String
,!*
Toolbox
);
Get_directory_and_file_name2
pathName
p
v
d
tb
|
(
p
>=
l
)
||
(
pathName
.[
p
]
<>
':'
)
=
(
v
,
d
,
pathName
%
(
p
,
l_sub_1
),
tb
);
|
colon
&&
(
0
==
result
)
&&
(
0
<>
(
16
bitand
attrib
))
=
Get_directory_and_file_name2
pathName
p2
v
d2
tb1
;
=
(
v
,
d
,
pathName
%
(
inc
p
,
l_sub_1
),
tb1
);
where
{
l_sub_1
=
dec
l
;
(
colon
,
p2
)
=
Find_colon
pathName
(
inc
p
);
(
result
,
attrib
,
d2
,
tb1
)
=
GetCatInfo3
v
d
(
pathName
%
(
inc
p
,
dec
p2
))
tb
;
l
=
size
pathName
;
};
do_tb_io
::
!*
Toolbox
!*
World
->
*
World
;
do_tb_io
_
w
=
w
;
SelectInputFile
::
!*
World
->
(!
Bool
,!
String
,*
World
);
SelectInputFile
w
#
tb
=
0
;
#
(
nav_reply_record
,_,
tb
)
=
NewPtr
NavReplyRecordSize
tb
;
#
(
err
,
tb
)
=
NavGetFile
0
nav_reply_record
0
0
0
0
0
0
tb
;
#
(
ok
,
file_name
,
tb
)=
get_or_put_file_selector_result
err
nav_reply_record
tb
;
=
(
ok
,
file_name
,
do_tb_io
tb
w
);
SelectOutputFile
::
!
String
!
String
!*
World
->
(!
Bool
,
!
String
,!*
World
);
SelectOutputFile
prompt
originalName
w
#
tb
=
0
;
#
(
err
,
nav_dialog_options
,
tb
)
=
NavGetDefaultDialogOptions
tb
;
|
err
<>
0
#
tb
=
DisposePtr
nav_dialog_options
tb
;
=
(
False
,
""
,
do_tb_io
tb
w
);
#
(
nav_reply_record
,_,
tb
)
=
NewPtr
NavReplyRecordSize
tb
;
#
(
flags
,
tb
)
=
LoadLong
(
nav_dialog_options
+
NavDialogOptionFlagsOffset
)
tb
;
#
flags
=
flags
bitor
kNavNoTypePopup
;
#
tb
=
StoreLong
(
nav_dialog_options
+
NavDialogOptionFlagsOffset
)
flags
tb
;
#
tb
=
copy_string_to_memory
originalName
(
nav_dialog_options
+
NavDialogOptionSavedFileNameOffset
)
tb
#
(
err
,
tb
)
=
NavPutFile
0
nav_reply_record
nav_dialog_options
0
0
0
/*0x2a2a2a2a **** */
0
tb
;
// # (err,tb) = NavPutFile 0 nav_reply_record 0 0 0 0 0 tb;
#
(
ok
,
file_name
,
tb
)=
get_or_put_file_selector_result
err
nav_reply_record
tb
;
#
tb
=
DisposePtr
nav_dialog_options
tb
;
=
(
ok
,
file_name
,
do_tb_io
tb
w
);
copy_string_to_memory
s
p
tb
#
tb
=
StoreByte
p
(
size
s
)
tb
;
=
copy_chars
0
(
p
+1
)
tb
;
{
copy_chars
i
p
tb
|
i
>=
size
s
=
tb
;
#
tb
=
StoreByte
(
p
+
i
)
(
toInt
s
.[
i
])
tb
;
=
copy_chars
(
i
+1
)
p
tb
;
}
get_or_put_file_selector_result
err
nav_reply_record
tb
|
err
<>
0
#
tb
=
DisposePtr
nav_reply_record
tb
;
=
(
False
,
""
,
tb
);
#
(
valid_record
,
tb
)
=
LoadByte
(
nav_reply_record
+
NavReplyValidRecordOffset
)
tb
;
|
valid_record
==
0
#
(_,
tb
)=
NavDisposeReply
nav_reply_record
tb
;
#
tb
=
DisposePtr
nav_reply_record
tb
;
=
(
False
,
""
,
tb
);
#
fs_spec
=
createArray
70
'\0'
;
#
(
r
,
theAEKeyword
,
typeCode
,
actualSize
,
tb
)
=
AEGetNthPtr
(
nav_reply_record
+
NavReplySelectionOffset
)
1
KeyFssString
fs_spec
tb
;
|
r
<>
0
||
actualSize
<>
70
#
(_,
tb
)=
NavDisposeReply
nav_reply_record
tb
;
#
tb
=
DisposePtr
nav_reply_record
tb
;
=
(
False
,
""
,
tb
);
#
file_name_size
=
toInt
fs_spec
.[
6
]
#
vRefNum
=((
toInt
fs_spec
.[
0
]<<
8
bitor
toInt
fs_spec
.[
1
])<<
16
)>>
16
;
#
directoryId
=((
toInt
fs_spec
.[
2
]<<
8
bitor
toInt
fs_spec
.[
3
])<<
8
bitor
toInt
fs_spec
.[
4
])<<
8
bitor
toInt
fs_spec
.[
5
];
#
file_name
=
fs_spec
%
(
7
,
6
+
file_name_size
);
#
(
path_name
,
tb
)=
Get_directory_path
vRefNum
directoryId
file_name
tb
;
#
(_,
tb
)=
NavDisposeReply
nav_reply_record
tb
;
#
tb
=
DisposePtr
nav_reply_record
tb
;
=
(
True
,
path_name
,
tb
);
htoclean/htoclean source code/mac_file_selector_classic.dcl
0 → 100644
View file @
65bdcad1
definition
module
mac_file_selector_classic
;
SelectInputFile
::
!*
World
->
(!
Bool
,!
String
,!*
World
);
SelectOutputFile
::
!
String
!
String
!*
World
->
(!
Bool
,!
String
,!*
World
);
htoclean/htoclean source code/mac_file_selector_classic.icl
0 → 100644
View file @
65bdcad1
implementation
module
mac_file_selector_classic
;
import
StdClass
,
StdBool
,
StdChar
,
StdInt
,
StdMisc
,
StdString
,
StdFile
,
StdArray
;
import
standard_file
,
files
,
pointer
,
quickdraw
;
SelectorWidth
:==
350
;
SelectorHeight
:==
250
;
Error_i
::
!
String
!
Int
->
.
x
;
Error_i
string
i
=
abort
(
string
+++
toString
i
);
Get_parent_id_of_file
::
!
Int
!
String
!*
Toolbox
->
(!
Int
,
!*
Toolbox
);
Get_parent_id_of_file
volumeNumber
fileName
tb
|
0
==
osError
=
(
parentId
,
tb1
);
=
Error_i
"Error code returned by GetCatInfo: "
osError
;
where
{
(
osError
,
parentId
,
tb1
)
=
GetCatInfo1
volumeNumber
fileName
tb
;
};
Get_working_directory_info
::
!
Int
!*
Toolbox
->
(!
Int
,!
Int
,!*
Toolbox
);
Get_working_directory_info
workingDirectoryId
tb
|
osError
==
0
=
(
volumeNumber
,
directoryId
,
tb1
);
=
Error_i
"Error code returned by GetWDInfo: "
osError
;
where
{
(
osError
,
volumeNumber
,
directoryId
,
tb1
)
=
GetWDInfo
workingDirectoryId
tb
;
};
Get_name_and_parent_id_of_directory
::
!
Int
!
Int
!*
Toolbox
->
(!
String
,!
Int
,!*
Toolbox
);
Get_name_and_parent_id_of_directory
volumeNumber
directoryId
tb
|
osError
==
0
=
(
folderName
,
parentId
,
tb1
);
=
Error_i
"Error code returned by BPGetCatInfo: "
osError
;
where
{
(
osError
,
folderName
,
parentId
,
tb1
)
=
GetCatInfo2
volumeNumber
directoryId
(
createArray
64
'\0'
)
tb
;
};
Get_directory_path
::
!
Int
!
Int
!
String
!*
Toolbox
->
(!
String
,
!*
Toolbox
);
Get_directory_path
volumeNumber
directoryId
path
tb
|
directoryId
==
2
=
(
folderName
+++
":"
+++
path
,
tb1
);
=
Get_directory_path
volumeNumber
parentId
(
folderName
+++
":"
+++
path
)
tb1
;
where
{
(
folderName
,
parentId
,
tb1
)
=
Get_name_and_parent_id_of_directory
volumeNumber
directoryId
tb
;
};
do_tb_io
::
!*
Toolbox
!*
World
->
*
World
;
do_tb_io
_
w
=
w
;
SelectInputFile
::
!*
World
->
(!
Bool
,!
String
,!*
World
);
SelectInputFile
w
#
tb
=
0
;
(
selectorPos
,
tb1
)
=
SelectorPosition
tb
;
(
good
,
copy
,
fType
,
vRefNum
,
version
,
fName
,
tb2
)
=
SFGetFile
selectorPos
""
0
(
-1
)
""
0
(
createArray
64
'\0'
)
tb1
;
|
good
#
(
directoryId
,
tb3
)
=
Get_parent_id_of_file
vRefNum
fName
tb2
;
(
pathName
,
tb4
)
=
Get_directory_path
vRefNum
directoryId
fName
tb3
;
=
(
True
,
pathName
,
do_tb_io
tb4
w
);
=
(
False
,
""
,
do_tb_io
tb2
w
);
Find_last_colon
::
!
String
!
Int
->
(!
Bool
,!
Int
);
Find_last_colon
s
p
=
Find_last_colon2
s
p
(
dec
(
size
s
));
Find_last_colon2
::
String
!
Int
!
Int
->
(!
Bool
,!
Int
);
Find_last_colon2
s
p
l
|
p
>=
l
=
(
False
,
p
);
|
s
.[
p
]
==
':'
=
(
True
,
p
);
=
Find_last_colon2
s
(
inc
p
)
l
;
Get_directory_and_file_name
::
!
String
!*
Toolbox
->
(!
Int
,!
Int
,!
String
,!*
Toolbox
);
Get_directory_and_file_name
pathName
tb
|
not
colon
=
(
sfSaveDisk
,
curDirStore
,
pathName
,
tb1
);
|
pathName
.[
0
]
==
':'
=
Get_directory_and_file_name2
pathName
0
sfSaveDisk
curDirStore
tb1
;
|
0
==
result
=
Get_directory_and_file_name2
pathName
colonPosition
volumeNumber
2
tb`
;
=
(
sfSaveDisk`
,
curDirStore`
,
pathName
,
tb``
);
where
{
(
colon
,
colonPosition
)
=
Find_last_colon
pathName
0
;
(
sfSaveDisk
,
curDirStore
,
tb1
)
=
Get_stored_dir_and_file
tb
;
(
result
,
volumeNumber
,
tb`
)
=
GetVInfo
(
pathName
%
(
0
,
colonPosition
))
tb
;
(
sfSaveDisk`
,
curDirStore`
,
tb``
)
=
Get_stored_dir_and_file
tb`
;
};
Get_stored_dir_and_file
::
!*
Toolbox
->
(!
Int
,!
Int
,!*
Toolbox
);
Get_stored_dir_and_file
tb
=
(
sfSaveDisk
,
curDirStore
,
tb2
);
where
{
(
saveDisk
,
tb1
)
=
LoadWord
532
tb
;
sfSaveDisk
=
0
-
saveDisk
;
(
curDirStore
,
tb2
)
=
LoadLong
920
tb1
;
};
Get_directory_and_file_name2
::
!
String
!
Int
!
Int
!
Int
!*
Toolbox
->
(!
Int
,!
Int
,!
String
,!*
Toolbox
);
Get_directory_and_file_name2
pathName
p
v
d
tb
|
(
p
>=
l
)
||
(
pathName
.[
p
]
<>
':'
)
=
(
v
,
d
,
pathName
%
(
p
,
l_sub_1
),
tb
);
|
colon
&&
(
0
==
result
)
&&
(
0
<>
(
16
bitand
attrib
))
=
Get_directory_and_file_name2
pathName
p2
v
d2
tb1
;
=
(
v
,
d
,
pathName
%
(
inc
p
,
l_sub_1
),
tb1
);
where
{
l_sub_1
=
dec
l
;
(
colon
,
p2
)
=
Find_last_colon
pathName
(
inc
p
);
(
result
,
attrib
,
d2
,
tb1
)
=
GetCatInfo3
v
d
(
pathName
%
(
inc
p
,
dec
p2
))
tb
;
l
=
size
pathName
;
};
Set_directory
::
!
Int
!
Int
!*
Toolbox
->
*
Toolbox
;
Set_directory
v
d
tb
=
tb2
;
where
{
tb1
=
StoreWord
532
(
0
-
v
)
tb
;
tb2
=
StoreLong
920
d
tb1
;
};
SelectOutputFile
::
!
String
!
String
!*
World
->
(!
Bool
,!
String
,!*
World
);
SelectOutputFile
prompt
originalName
w
#
tb
=
0
;
(
selectorPos
,
tb1
)
=
SelectorPosition
tb
;
(
v
,
d
,
fileName
,
tb2
)
=
Get_directory_and_file_name
originalName
tb1
;
tb3
=
Set_directory
v
d
tb2
;
(
good
,
copy
,
fType
,
vRefNum
,
version
,
fName
,
tb4
)
=
SFPutFile
selectorPos
prompt
fileName
0
(
createArray
64
'\0'
)
tb3
;
|
good
#
(
volumeNumber
,
directoryId
,
tb5
)
=
Get_working_directory_info
vRefNum
tb4
;
(
pathName
,
tb6
)
=
Get_directory_path
vRefNum
directoryId
fName
tb5
;
=
(
True
,
pathName
,
do_tb_io
tb6
w
);
=
(
False
,
""
,
do_tb_io
tb4
w
);
SelectorPosition
::
!*
Toolbox
->
(!(!
Int
,!
Int
),!*
Toolbox
);
SelectorPosition
tb
=
((
hPos
,
vPos
),
tb1
);
where
{
hPos
=
(
sr
-
sl
-
SelectorWidth
)
/
2
;
vPos
=
(
sb
-
st
-
SelectorHeight
)
/
3
;
(
sl
,
st
,
sr
,
sb
,
tb1
)
=
QScreenRect
tb
;
};
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment