This commit is contained in:
parent
bc22096f25
commit
4d0c539b32
|
@ -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)]]
|
||||
]
|
||||
]
|
||||
|
||||
|
|
|
@ -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
|
||||
]
|
||||
]
|
||||
|
Reference in New Issue