–Keynote 5.1.1で変更されたexportコマンドのパラメータ実験
tell application “Keynote”
　　tell slideshow 1
　　　　export to outFile as HTML
　　end tell
end tell

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

–Keynoteの各slideのタイトルを取得する
set aList to {}

tell application “Keynote”
　　tell slideshow 1
　　　　set aList to title of every slide
　　end tell
end tell

–各タイトルにすでに「（1/2）」のようなナンバリングが行われていたらナンバリング部分を削除する
set newList to {}

repeat with i in aList
　　set j to contents of i
　　
　　set aPos to offset of separatorC in j
　　if aPos is not equal to 0 then
　　　　set j to text 1 thru (aPos - 1) of j
　　end if
　　
　　set the end of newList to j
end repeat

–目次を作成する
set sPage to 3 –ページ数カウンタ
set curItem to second item of newList
set newList2 to items 3 thru -1 of newList

set outList to {{2, curItem}} –出力用データ

repeat with i in newList2
　　set j to contents of i
　　
　　if j = curItem then
　　　　–何もしない
　　else
　　　　set curItem to j
　　　　set the end of outList to {sPage, j}
　　end if
　　
　　set sPage to sPage + 1
　　
end repeat

set aText to retItemDelimedAndParagraphDelimedText(outList, tab, return) of me

–入れ子のリストを、アイテム間のデリミタとパラグラフ間のデリミタを指定してテキスト化
–というか、入れ子のリストをタブ区切りテキストにするのが目的
on retItemDelimedAndParagraphDelimedText(aList, itemDelim, paragraphDelim)
　　set aText to “”
　　
　　repeat with i in aList
　　　　set aStr to retDelimedText(i, itemDelim) of me
　　　　set aText to aText & aStr & paragraphDelim
　　end repeat
　　
　　return aText
end retItemDelimedAndParagraphDelimedText

on retDelimedText(aList, aDelim)
　　set aText to “”
　　set curDelim to AppleScript’s text item delimiters
　　set AppleScript’s text item delimiters to aDelim
　　set aText to aList as text
　　set AppleScript’s text item delimiters to curDelim
　　return aText
end retDelimedText

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

–Keynoteの各slideのタイトルを取得する
set aList to {}

tell application "Keynote"
　　tell slideshow 1
　　　　set aList to title of every slide
　　end tell
end tell

–各タイトルにすでに「（1/2）」のようなナンバリングが行われていたらナンバリング部分を削除する
set newList to {}

repeat with i in aList
　　set j to contents of i
　　
　　set aPos to offset of separatorC in j
　　if aPos is not equal to 0 then
　　　　set j to text 1 thru (aPos - 1) of j
　　end if
　　
　　set the end of newList to j
end repeat

–重複箇所の情報を取得する
set sList to detectRepetition(newList) of me
if sList = {} then
　　tell application "Keynote"
　　　　display dialog "とくに、連番を振り直す必要のある箇所はないようです" buttons {"OK"} default button 1 with icon 1
　　end tell
　　return
end if

–重複箇所情報をもとに連番を振り直す
set tList to {}

repeat with i in sList
　　set {fromNum, endNum} to i
　　set totalNum to endNum - fromNum + 1
　　
　　set preStr to contents of item fromNum of newList
　　
　　set ttList to {}
　　repeat with ii from 1 to totalNum
　　　　set aStr to ((preStr & "（" & ii as string) & "/" & totalNum as string) & "）"
　　　　set item (ii + fromNum - 1) of newList to aStr –newListの内容を書き換えている
　　end repeat
　　
end repeat

–連番を振り直したリストを元に、Keynoteの各slideのtitleを変更する
tell application "Keynote"
　　tell slideshow 1
　　　　set sCount to count every slide
　　　　repeat with i from 1 to sCount
　　　　　　tell slide i
　　　　　　　　set title to contents of item i of newList
　　　　　　end tell
　　　　end repeat
　　end tell
end tell

–リスト中の値が連続する箇所をアイテム番号のリストで返す
on detectRepetition(aList)
　　
　　set curItem to first item of aList
　　set aList to rest of aList
　　
　　set aCount to 1
　　set sucF to false
　　
　　set sList to {}
　　set curList to {}
　　
　　repeat with i in aList
　　　　set j to contents of i
　　　　if curItem is equal to j then
　　　　　　if sucF = true then
　　　　　　　　–何もしない。データの連続部分の中をスキャン中　　
　　　　　　else
　　　　　　　　set curItem to j
　　　　　　　　set curList to {aCount}
　　　　　　　　set sucF to true
　　　　　　end if
　　　　else
　　　　　　if sucF = true then
　　　　　　　　–連続部分の末尾を見つけた
　　　　　　　　set the end of curList to aCount
　　　　　　　　set the end of sList to curList
　　　　　　　　set curList to {}
　　　　　　　　set curItem to j –ここを修正した
　　　　　　　　set sucF to false
　　　　　　else
　　　　　　　　–なにもしない
　　　　　　　　set curItem to j
　　　　　　end if
　　　　end if
　　　　
　　　　set aCount to aCount + 1
　　end repeat
　　
　　if sucF = true then
　　　　set the end of curList to aCount
　　　　set the end of sList to curList
　　end if
　　
　　return sList
　　
end detectRepetition

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

–指定フォルダ中のファイル（たぶん画像）を一括でaliasとして取得
tell application “Finder”
　　tell folder a
　　　　set fList to every file as alias list
　　end tell
end tell

–Keynoteが各ファイルのパスをtextで要求しているので、aliasからtextにcastする
set fnList to {}
repeat with i in fList
　　set the end of fnList to (POSIX path of (contents of i))
end repeat

–Keynoteに１ページに１枚の画像を配置したスライドを一括作成する
tell application “Keynote”
　　tell slideshow 1
　　　　make image slides paths fnList
　　end tell
end tell

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

–Text Editで新規ドキュメントを作成してコピーされていたデータをコピー
tell application “TextEdit“
　　set aDoc to make new document
　　activate
end tell

tell application “System Events“
　　tell process “TextEdit“
　　　　keystroke “v“ using {command down}
　　end tell
end tell

–TextEditの書類上から各種情報を取得する
tell application “TextEdit“
　　tell text of aDoc
　　　　set colorList to color of every attribute run
　　　　set fontList to font of every attribute run
　　　　set sizeList to size of every attribute run
　　　　set textList to characters of every attribute run
　　　　
　　　　set itemCount to length of colorList
　　　　
　　　　set contList to {}
　　　　repeat with i from 1 to itemCount
　　　　　　set aRec to {textData:(item i of textList) as string, colorData:item i of colorList, fontData:item i of fontList, sizeData:item i of sizeList}
　　　　　　set the end of contList to aRec
　　　　end repeat
　　end tell
end tell

tell application “TextEdit“
　　tell document 1
　　　　close without saving
　　end tell
end tell

set aDirection to detectTextDirection(textList) of me
–> “vertical” / “horizontal”

set aFontName to contents of item 1 of fontList
set aSize to contents of item 1 of sizeList
set aLineWidth to aSize / 8
set aLineWidth to round aLineWidth rounding up

set aCon to textList as string
set aCon to repChar(aCon, ASCII character 10, “”) of me
set aColor to item 1 of colorList
set rColor to (item 1 of aColor) / 256
set rColor to round rColor rounding down
set gColor to (item 2 of aColor) / 256
set gColor to round gColor rounding down
set bColor to (item 3 of aColor) / 256
set bColor to round bColor rounding down
set colorList to {rColor, gColor, bColor}

makeTextGraphicWithEdgeLine(aCon, aSize, aLineWidth, aDirection, aFontName, colorList) of me

tell application “Keynote“
　　activate
end tell

tell application “System Events“
　　tell process “Keynote“
　　　　keystroke “v“ using {command down}
　　end tell
end tell

–以下、サブルーチン

–Attribute runsのテキストデータの並びから、Keynote上で縦書き/横書きだったかの判定を行う
on detectTextDirection(aList)
　　set normCount to 0
　　set retCount to 0
　　log aList
　　repeat with i in aList
　　　　set jj to contents of (item 1 of i)
　　　　set j to id of (contents of jj)
　　　　–display dialog (string id of j)
　　　　if (j = 10) or (j = 13) then
　　　　　　set retCount to retCount + 1
　　　　else
　　　　　　set normCount to normCount + 1
　　　　end if
　　end repeat
　　
　　set vhCalc to (retCount / normCount)
　　
　　if vhCalc > 0.5 then
　　　　return “vertical“
　　else
　　　　return “horizontal“
　　end if
　　
end detectTextDirection

on makeTextGraphicWithEdgeLine(aCon, aSize, aLineWidth, aDirection, aFontName, colorList)
　　copy colorList to {rColor, gColor, bColor}
　　
　　using terms from application “Adobe Illustrator“
　　　　tell application “Adobe Illustrator“
　　　　　　set aDoc to make new document with properties {color space:RGB}
　　　　　　
　　　　　　tell aDoc
　　　　　　　　setOriginToLeftCorner() of me
　　　　　　　　
　　　　　　　　set aGroup to make new group item
　　　　　　　　
　　　　　　　　set aFrame1 to make new text frame at the end of aGroup
　　　　　　　　tell aFrame1
　　　　　　　　　　set position to {0, 0}
　　　　　　　　　　set contents to aCon
　　　　　　　　　　if aDirection = “vertical“ then
　　　　　　　　　　　　set text orientation to vertical
　　　　　　　　　　else if aDirection = “horizontal“ then
　　　　　　　　　　　　set text orientation to horizontal
　　　　　　　　　　end if
　　　　　　　　　　tell every character
　　　　　　　　　　　　set size to aSize
　　　　　　　　　　　　–set font to aFontName
　　　　　　　　　　　　set stroke weight to aLineWidth –ふちどり線の太さ
　　　　　　　　　　　　set stroke color to {red:255, green:255, blue:255} –白
　　　　　　　　　　end tell
　　　　　　　　end tell
　　　　　　　　
　　　　　　　　set aFrame2 to make new text frame at the beginning of aGroup
　　　　　　　　tell aFrame2
　　　　　　　　　　set contents to aCon
　　　　　　　　　　set position to {0, 0}
　　　　　　　　　　if aDirection = “vertical“ then
　　　　　　　　　　　　set text orientation to vertical
　　　　　　　　　　else if aDirection = “horizontal“ then
　　　　　　　　　　　　set text orientation to horizontal
　　　　　　　　　　end if
　　　　　　　　　　tell every character
　　　　　　　　　　　　set size to aSize
　　　　　　　　　　　　–set font to aFontName
　　　　　　　　　　　　set stroke weight to 0.0
　　　　　　　　　　　　set fill color to {red:rColor, green:gColor, blue:bColor}
　　　　　　　　　　end tell
　　　　　　　　end tell
　　　　　　　　
　　　　　　　　
　　　　　　　　set selection to aGroup
　　　　　　　　copy –ふちどり文字をクリップボードにコピー
　　　　　　　　
　　　　　　　　close saving no –Illustratorの書類を破棄する
　　　　　　end tell
　　　　end tell
　　end using terms from
end makeTextGraphicWithEdgeLine

–Illustratorの原点座標を変更する
on setOriginToLeftCorner()
　　using terms from application “Adobe Illustrator“
　　　　tell application “Adobe Illustrator“
　　　　　　tell document 1
　　　　　　　　set aHeight to height
　　　　　　　　set ruler origin to {0, aHeight}
　　　　　　end tell
　　　　end tell
　　end using terms from
end setOriginToLeftCorner

–Written By Philip Aker
–文字置換ルーチン
on repChar(origText, targStr, repStr)
　　set {txdl, AppleScript’s text item delimiters} to {AppleScript’s text item delimiters, targStr}
　　set temp to text items of origText
　　set AppleScript’s text item delimiters to repStr
　　set res to temp as text
　　set AppleScript’s text item delimiters to txdl
　　return res
end repChar

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に

–> {modified:false, current slide:slide “0″ of document “test” of application “Keynote”, class:document, path:”/Users/maro/Desktop/test.key”, playing:false, name:”test”}

▼新規書類に　▼カーソル位置に　▼ドキュメント末尾に