smalltalk
/
osmo-st-all
Archived
1
0
Fork 0
This commit is contained in:
Nicolas Petton 2009-06-22 04:44:52 +00:00
parent bc22096f25
commit 4d0c539b32
2 changed files with 34 additions and 132 deletions

View File

@ -39,7 +39,7 @@
Widget subclass: CalendarWidget [
| month |
| month date |
<comment: nil>
<category: 'Iliad-Core-Widgets'>
@ -47,7 +47,8 @@ Widget subclass: CalendarWidget [
initialize [
<category: 'initialize-release'>
super initialize.
month := Date today month
date := Date today.
month := date month
]
date [
@ -77,12 +78,12 @@ Widget subclass: CalendarWidget [
months [
<category: 'accessing'>
^(1 to: 12) collect: [:i | Month month: i year: self year]
^(1 to: 12) collect: [:i | Date nameOfMonth: i]
]
year [
<category: 'accessing'>
^self month year
^self date year
]
year: anInteger [
@ -111,63 +112,50 @@ Widget subclass: CalendarWidget [
calendarTableContents [
<category: 'building'>
^
[:e |
| table |
table := e table.
table build: self daysOfWeekRowContents.
self month weeksDo: [:each | table build: (self rowContentsForWeek: each)]]
^[:e || table |
table := e table.
table build: self daysOfWeekRowContents.
self month weeksDo: [:each |
table build: (self rowContentsForWeek: each)]]
]
cellContentsForDate: aDate [
<category: 'building'>
^
[:e |
| data |
data := e tableData.
aDate month = self month
ifTrue:
[(data anchor)
^[:e || data |
data := e tableData.
aDate month = self month ifTrue: [
data anchor
action: [self selectDate: aDate];
text: aDate dayOfMonth asString]]
]
contents [
<category: 'building'>
^
[:e |
| div |
div := e div class: 'calendar'.
div build: self monthSelectionFormContents.
div build: self calendarTableContents]
^[:e || div |
div := e div class: 'calendar'.
div build: self monthSelectionFormContents.
div build: self calendarTableContents]
]
daysOfWeekRowContents [
<category: 'building'>
^
[:e |
| head |
head := e tableHead.
self daysOfWeek do: [:each | head tableData text: each]]
^[:e || head |
head := e tableHead.
self daysOfWeek do: [:each | head tableData text: each]]
]
monthSelectionFormContents [
<category: 'building'>
^
[:e |
| form select |
form := (e form)
class: 'month_selection';
yourself.
select := (form select)
action: [:val | self selectMonth: val];
yourself.
^[:e || form select |
form := e form class: 'month_selection'; yourself.
select := form select.
self months do:
[:each |
| option |
option := select option.
option text: each name.
each = self month ifTrue: [option selected]].
[:each || option |
option := select option.
option
text: each asString;
action: [self selectMonth: each asString].
each = self month ifTrue: [option selected]].
(form input)
maxLength: 4;
action: [:val | self selectYear: val];
@ -177,11 +165,10 @@ Widget subclass: CalendarWidget [
rowContentsForWeek: aWeek [
<category: 'building'>
^
[:e |
| row |
row := e tableRow.
aWeek datesDo: [:each | row build: (self cellContentsForDate: each)]]
^[:e | | row |
row := e tableRow.
aWeek datesDo: [:each |
row build: (self cellContentsForDate: each)]]
]
]

View File

@ -1,85 +0,0 @@
"======================================================================
|
| Iliad.Profiler class definition
|
======================================================================"
"======================================================================
|
| Copyright (c) 2008-2009
| Nicolas Petton <petton.nicolas@gmail.com>,
| Sébastien Audier <sebastien.audier@gmail.com>
|
| Adapted from the Seaside WAProfiler. Seaside is written
| by Avi Bryant, Julian Fitzell, Lukas Renggli, Michel Bany, Philippe
| Marschall and Seaside contributors http://www.seaside.st
|
| This file is part of the Iliad framework.
|
| Permission is hereby granted, free of charge, to any person obtaining
| a copy of this software and associated documentation files (the
| 'Software'), to deal in the Software without restriction, including
| without limitation the rights to use, copy, modify, merge, publish,
| distribute, sublicense, and/or sell copies of the Software, and to
| permit persons to whom the Software is furnished to do so, subject to
| the following conditions:
|
| The above copyright notice and this permission notice shall be
| included in all copies or substantial portions of the Software.
|
| THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
| EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
| MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
| IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
| CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
| TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
| SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
|
======================================================================"
Decorator subclass: Profiler [
<comment: nil>
<category: 'Iliad-More-Widgets'>
contents [
<category: 'building'>
^
[:e |
| profile |
profile := self profileSendsDuring: [e build: self decoratee contents].
Transcript
show: '-- Iliad Profiler on: ' , self widget printString , ' --';
cr;
cr.
Transcript
show: profile;
cr;
cr]
]
profileSendsDuring: aBlock [
<category: 'private'>
| newPage report |
newPage := Character value: 12.
Processor activeProcess priority: 20.
Smalltalk garbageCollectMost.
report := String streamContents:
[:stream |
(MessageTally new)
spyEvery: 1
on:
[aBlock value.
Smalltalk garbageCollectMost];
report: stream].
"the message tally report has an unprintable character (new page) before the leaves
we need to remove it"
report
withIndexDo: [:each :index | each = newPage ifTrue: [report at: index put: Character space]].
^report
]
]