Archive for the '再帰(recursive call)' Category

2014/04/01 なんでもデータを文字列化 v3

AppleScriptがネイティブでもっているデータ型(integer, number, real, string, text, Unicode text, list, record、boolean、missing value)を文字列化するAppleScriptです。

# 本来、AppleScriptにはlistやrecordをそのままテキストにcastする機能はありません

掲載したプログラム(v2)で、リストに入れたboolean(true/false)への対応が抜けていたので追加したものです。

本Scriptはいろいろ便利に使っていますが、一番有用だったのは……データの内容をテキストファイルにログ書き出しする際に、レコードからいちいち属性ごとにラベルを指定して取り出してテキスト化するのではなく、まるごとテキスト化することで大幅に処理の記述を省略できた、というケースです。

全国規模のネットワーク上に構築されたファイルサーバー群に対して各種PDF出力をMacクライアント側からの指定どおりに行う、というけっこう規模の大きいクライアント/サーバーのシステムをすべてAppleScript(当時はAppleScript Studio)で開発したことがあり、サーバー側でワークログだったりエラーログをテキスト保存する際に、このような処理を用いました。

スクリプト名:なんでもデータを文字列化 v3

set a to {true, false, “test string”} –listed boolean
–set a to {{true, false}, {true, true}, {false, false}} –nested listed boolean
–set a to {{aName:”PiyoPiyo”, anAge:10}, {aName:”Piyoko”, anAge:9}} –record in list
–set a to {aName:”PiyoPiyo”, anAge:10}–record
–set a to {{1, 2, 3}, {4, 5, 6}}–list
–set a to 1.0 as real–real
–set a to 1 as integer–integer
–set a to “1.0″ as string–string
–set a to true–boolean
–set a to front window of application “Finder”–ERROR
–set a to missing value

set aRes to convToStr(a) of somethingToStrKit
–> “{true, false}”

–リストでもレコードでもなんでも文字列化して返すキット
script somethingToStrKit
  
  
on convToStr(aRec)
    
    
set aClass to (class of aRec) as string
    
    
if (aClass = “integer”) or (aClass = “number”) or (aClass = “real”) or (aClass = “string”) or (aClass = “text”) or (aClass = “Unicode text”) or (aClass = “boolean”) then
      set aRes to aRec as string
    else if aClass is “list” then
      set aRes to listToString(aRec)
    else if aClass is “record” then
      set aRes to recToString(aRec)
    else
      try
        set aRes to aRec as string
      on error
        –アプリケーションのオブジェクトとかはエラーで返す
        
return false
      end try
    end if
    
    
return aRes
    
  end convToStr
  
  
  
–レコードをStringに変換
  
  
–エラートラップを使って、わざとエラーを発生させ、エラーメッセージからレコードをstringに変換する
  
on recToString(aRec)
    
    
–レコードを無理矢理stringにcastして、エラーメッセージを取得する
    
try
      set a to aRec as string –ここでエラー発生
    on error aMes
      set a to aMes
    end try
    
    
–エラーメッセージ文字列から、元のレコードの情報を組み立てる
    
set b to trimStrFromTo(a, “{”, “}”)
    
set b to “{” & b & “}”
    
    
return b
    
  end recToString
  
  
  
on trimStrFromTo(aStr, fromStr, toStr)
    –fromStrは前から探す
    
if fromStr is not equal to “” then
      set sPos to (offset of fromStr in aStr) + 1
    else
      set sPos to 1
    end if
    
    
–toStrは後ろから探す
    
if toStr is not equal to “” then
      set b to (reverse of characters of aStr) as string
      
set ePos to (offset of toStr in b)
      
set ePos to ((length of aStr) - ePos)
    else
      set ePos to length of aStr
    end if
    
set aRes to text sPos thru ePos of aStr
    
    
return aRes
    
  end trimStrFromTo
  
  
  
–リストおよびリストに入ったレコードをStringに変換
  
  
on listToString(aList)
    set listText to {“{”}
    
set quotChar to ASCII character 34
    
set firstFlag to true
    
    
repeat with i in aList
      set j to contents of i
      
set aClass to (class of i) as string
      
if (aClass = “integer”) or (aClass = “number”) or (aClass = “real”) or (aClass = “boolean”) then
        set the end of listText to (getFirst(firstFlag) of me & j as text)
        
set firstFlag to false
      else if (aClass = “string”) or (aClass = “text”) or (aClass = “Unicode text”) then
        set the end of listText to ((getFirst(firstFlag) of me & quotChar & j as text) & quotChar)
        
set firstFlag to false
      else if aClass is “list” then
        set the end of listText to (getFirst(firstFlag) & listToString(j)) –ちょっと再帰処理
        
set firstFlag to false
      else if aClass is “record” then
        set the end of listText to (getFirst(firstFlag) & recToString(j))
        
set firstFlag to false
      end if
    end repeat
    
    
set the end of listText to “}”
    
set listText to listText as text
    
    
return listText
  end listToString
  
  
on getFirst(aFlag)
    if aFlag = true then return “”
    
if aFlag = false then return “, “
  end getFirst
  
end script

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

2014/03/08 なんでもデータを文字列化 v2

AppleScriptがネイティブでもっているデータ型(integer, number, real, string, text, Unicode text, list, record、boolean、missing value)を文字列化するAppleScriptです。

# 本来、AppleScriptにはlistやrecordをそのままテキストにcastする機能はありません

掲載したプログラムで、boolean(true/false)とmissing valueが抜けていたので対応したものです。

リストに入ったレコードも文字列化しますし、リストを含んだレコードも文字列化します。

データのログ書き出しやら、AppleScriptの実行結果をテキストエディタやらMacJournalやらに文字で返す場合に利用します。

各アプリケーションのオブジェクトについても、AppleScriptエディタをAppleScriptからコントロールすれば、なんとか文字列として取得できるのですが……「そこまでやるの?」という点が疑問だったのでやっていません。

スクリプト名:なんでもデータを文字列化 v2
set a to {{aName:“PiyoPiyo”, anAge:10}, {aName:“Piyoko”, anAge:9}} –record in list
–set a to {aName:”PiyoPiyo”, anAge:10}–record
–set a to {{1, 2, 3}, {4, 5, 6}}–list
–set a to 1.0 as real–real
–set a to 1 as integer–integer
–set a to “1.0″ as string–string
–set a to true–boolean
–set a to front window of application “Finder”–アプリケーションのオブジェクトはエラーになるよ!
–set a to missing value

set aRes to convToStr(a) of somethingToStrKit
–> “{{aName:\”PiyoPiyo\”, anAge:10}, {aName:\”Piyoko\”, anAge:9}}”

–リストでもレコードでもなんでも文字列化して返すキット
script somethingToStrKit
  
  
on convToStr(aRec)
    
    
set aClass to (class of aRec) as string
    
    
if (aClass = “integer”) or (aClass = “number”) or (aClass = “real”) or (aClass = “string”) or (aClass = “text”) or (aClass = “Unicode text”) or (aClass = “boolean”) then
      set aRes to aRec as string
    else if aClass is “list” then
      set aRes to listToString(aRec)
    else if aClass is “record” then
      set aRes to recToString(aRec)
    else
      try
        set aRes to aRec as string
      on error
        –アプリケーションのオブジェクトとかはエラーで返す
        
return false
      end try
    end if
    
    
return aRes
    
  end convToStr
  
  
  
–レコードをStringに変換
  
  
–エラートラップを使って、わざとエラーを発生させ、エラーメッセージからレコードをstringに変換する
  
on recToString(aRec)
    
    
–レコードを無理矢理stringにcastして、エラーメッセージを取得する
    
try
      set a to aRec as string –ここでエラー発生
    on error aMes
      set a to aMes
    end try
    
    
–エラーメッセージ文字列から、元のレコードの情報を組み立てる
    
set b to trimStrFromTo(a, “{”, “}”)
    
set b to “{” & b & “}”
    
    
return b
    
  end recToString
  
  
  
on trimStrFromTo(aStr, fromStr, toStr)
    –fromStrは前から探す
    
if fromStr is not equal to “” then
      set sPos to (offset of fromStr in aStr) + 1
    else
      set sPos to 1
    end if
    
    
–toStrは後ろから探す
    
if toStr is not equal to “” then
      set b to (reverse of characters of aStr) as string
      
set ePos to (offset of toStr in b)
      
set ePos to ((length of aStr) - ePos)
    else
      set ePos to length of aStr
    end if
    
set aRes to text sPos thru ePos of aStr
    
    
return aRes
    
  end trimStrFromTo
  
  
  
–リストおよびリストに入ったレコードをStringに変換
  
  
on listToString(aList)
    set listText to {“{”}
    
set quotChar to ASCII character 34
    
set firstFlag to true
    
    
repeat with i in aList
      set j to contents of i
      
set aClass to (class of i) as string
      
if (aClass = “integer”) or (aClass = “number”) or (aClass = “real”) then
        set the end of listText to (getFirst(firstFlag) of me & j as text)
        
set firstFlag to false
      else if (aClass = “string”) or (aClass = “text”) or (aClass = “Unicode text”) then
        set the end of listText to ((getFirst(firstFlag) of me & quotChar & j as text) & quotChar)
        
set firstFlag to false
      else if aClass is “list” then
        set the end of listText to (getFirst(firstFlag) & listToString(j)) –ちょっと再帰処理
        
set firstFlag to false
      else if aClass is “record” then
        set the end of listText to (getFirst(firstFlag) & recToString(j))
        
set firstFlag to false
      end if
    end repeat
    
    
set the end of listText to “}”
    
set listText to listText as text
    
    
return listText
  end listToString
  
  
on getFirst(aFlag)
    if aFlag = true then return “”
    
if aFlag = false then return “, “
  end getFirst
  
end script

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

2014/03/07 なんでもデータを文字列化

AppleScriptがネイティブでもっているデータ型(integer, number, real, string, text, Unicode text, list, record)を文字列化するAppleScriptです。

「なんでも」と書いておいてナニですが、アプリケーションのオブジェクト(window 1 of application “Finder”など)を入れて渡しても文字列化はしてくれません。

リストに入ったレコードも文字列化しますし、リストを含んだレコードも文字列化します。

データのログ書き出しやら、AppleScriptの実行結果をテキストエディタやらMacJournalやらに文字で返す場合に利用するものです。

スクリプト名:なんでもデータを文字列化
set a to {{aName:“PiyoPiyo”, anAge:10}, {aName:“Piyoko”, anAge:9}} –record in list
–set a to {aName:”PiyoPiyo”, anAge:10}–record
–set a to {{1, 2, 3}, {4, 5, 6}}–list
–set a to 1.0 as real–real
–set a to 1 as integer–integer
–set a to “1.0″ as string–string
–set a to front window of application “Finder”–アプリケーションのオブジェクトはエラーになるよ!

set aRes to convToStr(a) of somethingToStrKit
–> “{{aName:\”PiyoPiyo\”, anAge:10}, {aName:\”Piyoko\”, anAge:9}}”

–リストでもレコードでもなんでも文字列化して返すキット
script somethingToStrKit
  
  
on convToStr(aRec)
    
    
set aClass to (class of aRec) as string
    
    
if (aClass = “integer”) or (aClass = “number”) or (aClass = “real”) or (aClass = “string”) or (aClass = “text”) or (aClass = “Unicode text”) then
      set aRes to aRec as string
    else if aClass is “list” then
      set aRes to listToString(aRec)
    else if aClass is “record” then
      set aRes to recToString(aRec)
    else
      –アプリケーションのオブジェクトとかはエラーで返す
      
return false
    end if
    
    
return aRes
    
  end convToStr
  
  
  
–レコードをStringに変換
  
  
–エラートラップを使って、わざとエラーを発生させ、エラーメッセージからレコードをstringに変換する
  
on recToString(aRec)
    
    
–レコードを無理矢理stringにcastして、エラーメッセージを取得する
    
try
      set a to aRec as string –ここでエラー発生
    on error aMes
      set a to aMes
    end try
    
    
–エラーメッセージ文字列から、元のレコードの情報を組み立てる
    
set b to trimStrFromTo(a, “{”, “}”)
    
set b to “{” & b & “}”
    
    
return b
    
  end recToString
  
  
  
on trimStrFromTo(aStr, fromStr, toStr)
    –fromStrは前から探す
    
if fromStr is not equal to “” then
      set sPos to (offset of fromStr in aStr) + 1
    else
      set sPos to 1
    end if
    
    
–toStrは後ろから探す
    
if toStr is not equal to “” then
      set b to (reverse of characters of aStr) as string
      
set ePos to (offset of toStr in b)
      
set ePos to ((length of aStr) - ePos)
    else
      set ePos to length of aStr
    end if
    
set aRes to text sPos thru ePos of aStr
    
    
return aRes
    
  end trimStrFromTo
  
  
  
–リストおよびリストに入ったレコードをStringに変換
  
  
on listToString(aList)
    set listText to {“{”}
    
set quotChar to ASCII character 34
    
set firstFlag to true
    
    
repeat with i in aList
      set j to contents of i
      
set aClass to (class of i) as string
      
if (aClass = “integer”) or (aClass = “number”) or (aClass = “real”) then
        set the end of listText to (getFirst(firstFlag) of me & j as text)
        
set firstFlag to false
      else if (aClass = “string”) or (aClass = “text”) or (aClass = “Unicode text”) then
        set the end of listText to ((getFirst(firstFlag) of me & quotChar & j as text) & quotChar)
        
set firstFlag to false
      else if aClass is “list” then
        set the end of listText to (getFirst(firstFlag) & listToString(j)) –ちょっと再帰処理
        
set firstFlag to false
      else if aClass is “record” then
        set the end of listText to (getFirst(firstFlag) & recToString(j))
        
set firstFlag to false
      end if
    end repeat
    
    
set the end of listText to “}”
    
set listText to listText as text
    
    
return listText
  end listToString
  
  
on getFirst(aFlag)
    if aFlag = true then return “”
    
if aFlag = false then return “, “
  end getFirst
  
end script

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

2014/03/06 MacJournalで選択中のテキストにASが存在すれば実行して結果を返す

選択範囲(selected text)の読み書きができるようになったMacJournal 6.10で、作者のDan Schimpfいわく「そんなことしてどーすんだ?」と疑問を呈していたとのこと。

テキストエディタ的なソフトウェアで、selectionの書き換えができないと逆に不便で仕方ないのですが……ここは、選択範囲の書き換えができるから「こそ」の用途を提示してみる必要があります。

書いておいた日本語の文章をparseして簡易コマンドを受け付けるようにするとか(すべてAppleScriptで記述した人工知能風インタフェース「Newt On」的に)、いろいろありますが……空いた時間にちょっと作ってみたのがコレです。

MacJournalのEntry本文中に<AppleScript>〜</AppleScript>のタグでくくったAppleScriptを書いておいて、本Scriptを(Script Menuなどから)実行すると、選択範囲中のテキストをAppleScriptとみなして、実行し、結果をMacJournalの選択範囲のうしろに返します。

実行すると危険なScriptでも強引に実行してしまうので、事前に実行しても安全なものだけを実行してください。

プログラムとドキュメントと実行結果やスクリーンショットなどをMacJournal上で一括管理して、Script単体で転がしておくと、操作手順や実行結果の履歴などをほったらかしにしがちなところを「なんでも取り込める」MacJournal上でまとめておくことができるのでは? というアイデアを手っ取り早くAppleScriptとして書いてみたものです。

mj10.png
▲MacJournalのエントリに、タグでくくったAppleScriptを書いて、選択する

mj11.png
▲Script Menuから本Scriptを呼び出す

mj12.png
▲MacJournalに書かれていたAppleScriptを実行

mj13.png
▲結果をMacJournalに返す。RecordやListでもテキストに(強引に)変換して返す

mj14.png
▲用意しておいた別のScriptを選択して実行

mj15.png
▲実行結果である100個の乱数をMacJournalに返した

スクリプト名:MacJournalで選択中のテキストにASが存在すれば実行して結果を返す
property asBeginTag :
property asEndTag : “”

tell application “MacJournal”
  tell document 1
    set aSel to selected text
  end tell
end tell

set aSel to aSel as string

if ( is in aSel) and (“” is in aSel) then
  
  
–replace double quote characters
  
set bSel to repChar(aSel, ““”, “\”") of me
  
set bSel to repChar(bSel, “””, “\”") of me
  
  
set aPos to offset of asBeginTag in bSel
  
set bPos to offset of asEndTag in bSel
  
  
if bPos > aPos then
    set scriptStr to text (aPos + (length of asBeginTag) + 1) thru (bPos - 1) of bSel
    
    
try
      set aRes to run script scriptStr
    on error erM
      set aRes to erM
    end try
  else
    
    
tell application “MacJournal”
      display dialog “AS Fetch Error” buttons {“OK”} default button 1 with icon 1
    end tell
    
    
return
    
  end if
  
  
set aClass to (class of aRes) as string
  
if aClass = “record” then
    set aRes to recToString(aRes) of recToStrKit
  else if aClass = “list” then
    set aRes to listToText(aRes) of me
  else
    set aRes to aRes as string
  end if
else
  tell application “MacJournal”
    display dialog “AS Fetch Error” buttons {“OK”} default button 1 with icon 1
  end tell
  
  
return
  
end if

tell application “MacJournal”
  tell document 1
    set selected text to aSel & return & “–> “ & aRes
  end tell
end tell

–文字置換ルーチン
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

–リストを任意のデリミタ付きでテキストに
on retArrowText(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 retArrowText

script recToStrKit
  
  
–エラートラップを使って、わざとエラーを発生させ、エラーメッセージからレコードをstringに変換する
  
on recToString(aRec)
    
    
–レコードを無理矢理stringにcastして、エラーメッセージを取得する
    
try
      set a to aRec as string –ここでエラー発生
    on error aMes
      set a to aMes
    end try
    
    
–エラーメッセージ文字列から、元のレコードの情報を組み立てる
    
set b to trimStrFromTo(a, “{”, “}”)
    
set b to “{” & b & “}”
    
    
return b
    
  end recToString
  
  
  
on trimStrFromTo(aStr, fromStr, toStr)
    –fromStrは前から探す
    
if fromStr is not equal to “” then
      set sPos to (offset of fromStr in aStr) + 1
    else
      set sPos to 1
    end if
    
    
–toStrは後ろから探す
    
if toStr is not equal to “” then
      set b to (reverse of characters of aStr) as string
      
set ePos to (offset of toStr in b)
      
set ePos to ((length of aStr) - ePos)
    else
      set ePos to length of aStr
    end if
    
set aRes to text sPos thru ePos of aStr
    
    
return aRes
    
  end trimStrFromTo
  
end script

on listToText(aList)
  set listText to {“{”}
  
set quotChar to ASCII character 34
  
set firstFlag to true
  
repeat with i in aList
    set j to contents of i
    
set aClass to class of i
    
if (aClass = integer) or (aClass = number) or (aClass = real) then
      set the end of listText to (getFirst(firstFlag) of me & j as text)
      
set firstFlag to false
    else if (aClass = string) or (aClass = text) or (aClass = Unicode text) then
      set the end of listText to ((getFirst(firstFlag) of me & quotChar & j as text) & quotChar)
      
set firstFlag to false
    else if aClass is list then
      set the end of listText to (getFirst(firstFlag) of me & listToText(j)) –ちょっと再帰処理
      
set firstFlag to false
    end if
  end repeat
  
set the end of listText to “}”
  
set listText to listText as text
  
return listText
end listToText

on getFirst(aFlag)
  if aFlag = true then return “”
  
if aFlag = false then return “,”
end getFirst

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

2013/05/10 数値の2D Listから最大値を求める v4

入れ子のリスト(2次元配列)から最大値を求めるAppleScriptです。

これまで利用していた「入れ子リストのフラット化(FlattenList)」のサブルーチンが、高速なのはいいものの、リスト中の要素がすべて文字列になってしまうので、再帰で処理するルーチンをみつけてきて使ってみました。

また、不要な(マヌケな)処理がややあったので、そこのあたりはバッサリ切っています。高速化のための努力はしていないので、要素数が数千(4000以上?)に上るような処理の場合には高速化対策を考えたほうがよいでしょう。

2DのList(2次元配列)と書いていましたが、動作原理上とくに2Dである必要はなく、3Dでも4Dでも大丈夫です。

スクリプト名:数値の2D Listから最大値を求める v4
–入れ子の数値リストの最大値を求める
set rlist to {{0, 0, 0, 0, 0, 0}, {0, 1, 1, 0, 0, 0}, {1, 0, 0, 0, 1, 0}, {1, 0, 0, 1, 1, 0}, {1, 1, 1, 1, 5, 0}, {0, 0, 1, 1, 0, 0}, {0, 0, 0, 0, 0, 0}}

set aRes to getMaxFrom2DList(rlist) of me
–> 5

–2D Listから最大値を求める
on getMaxFrom2DList(rlist)
  set r2List to FlattenList(rlist) of me –2Dリストを1Dに変換
  
set maxItem to contents of first item of shellSortDescending(r2List)
  
return maxItem
end getMaxFrom2DList

–再帰タイプのリストのフラット化
–http://rosettacode.org/wiki/Flatten_a_list#AppleScript
on FlattenList(aList)
  if class of aList is not list then
    return {aList}
  else if length of aList is 0 then
    return aList
  else
    return FlattenList(first item of aList) & (FlattenList(rest of aList))
  end if
end FlattenList

–入れ子ではないリストの降順ソート
on shellSortDescending(aSortList)
  script oBj
    property list : aSortList
  end script
  
set len to count oBj’s list’s items
  
set gap to 1
  
repeat while (gap len)
    set gap to ((gap * 3) + 1)
  end repeat
  
repeat while (gap > 0)
    set gap to (gap div 3)
    
if (gap < len) then
      repeat with i from gap to (len - 1)
        set temp to oBj’s list’s item (i + 1)
        
set j to i
        
repeat while ((j gap) and (oBj’s list’s item (j - gap + 1) < temp))
          set oBj’s list’s item (j + 1) to oBj’s list’s item (j - gap + 1)
          
set j to j - gap
        end repeat
        
set oBj’s list’s item (j + 1) to temp
      end repeat
    end if
  end repeat
  
return oBj’s list
end shellSortDescending

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

2013/02/27 指定のコード体系の全パターンのコードを生成 v5

ルールにのっとったコード全生成サブルーチン v4の改良版です。このv5でひとまずの完成を見ています。

本バージョンでは、コードルールから「初期値」を求める機能を追加し、これでルールのリストだけ与えれば、該当するすべてのパターンのコードを生成できるようになりました。

こうして、最初のv1から見直してみると……ずいぶんとコンパクトになりました。当初は持っていなかった汎用性を獲得し、だいたいこんな感じではないか、という自己満足に到達することはできました。

もっと難しいかと思っていたのですが、段階的に進化させていくことで「あっけなくできた」感じがします。最初から高機能なものを作ろうとせずに、動作が確認できる程度の簡単なものを作って、徐々に機能を向上させていくというやりかたは、実に強力です。

スクリプト名:指定のコード体系の全パターンのコードを生成 v5
–v5 外部からプロパティで与えられたルールから、初期値となる「最小値」を自前で計算するように変更
–v4 桁ごとにサブルーチンを設けるのではなく、再帰処理で1つのルーチンを多重呼び出しするように変更
–v3 コードのルールを外部供給する構成にした(処理ロジックとルールの分離が完了)
–v2 各桁の最大値と最小値をプロパティで持たせるテスト
–v1 各桁のインクリメント用のサブルーチンを作成し、ルールを各サブルーチン側でハードコーディングする(正しく動く)

script spd
  property aList : {}
  
property aRuleList : {{1, 2}, {1, 3}, {0, 1}, {1, 4}, {1, 8}} –各桁の{最小値, 最大値}ペアのリスト
  
property aRuleLen : length of aRuleList
end script

set aList of spd to {} –initilaize

set initNum to getMinNum() of me –本ルール下における最小値

set the end of aList of spd to initNum

copy initNum to aNum

repeat
  set aRes to incDigit(aNum, 1) of me
  
  
if aRes = false then
    exit repeat
  end if
  
  
set the end of aList of spd to aRes
  
  
copy aRes to aNum
  
end repeat

return (aList of spd)

–与えられたルール下における最小値をルールリストから求める
on getMinNum()
  –桁数が合っているだけのダミー数字を、適切な桁数作成する(例:11111)
  
set tmpNumStr to “”
  
repeat (aRuleLen of spd) times
    set tmpNumStr to tmpNumStr & “1″
  end repeat
  
  
set tmpNum to tmpNumStr as integer
  
  
–ルールから各桁の最小値を取り出して、各桁に設定する
  
repeat with i from 1 to (aRuleLen of spd)
    set aDigNum to item 1 of item i of (aRuleList of spd)
    
set tmpNum to setDigit(tmpNum, i, aDigNum) of me
  end repeat
  
  
return tmpNum
  
end getMinNum

–繰り上がり処理(再帰呼び出しで使用)
on incDigit(aNum, aDigit)
  
  
set {thisMin, thisMax} to item ((aRuleLen of spd) - aDigit + 1) of (aRuleList of spd)
  
  
set aTarget to getDigit(aNum, aDigit) of me
  
  
if aTarget = thisMax then
    
    
if aDigit = (aRuleLen of spd) then
      –オーバーフロー(桁あふれ)エラーを返す
      
return false
    end if
    
    
set bNum to incDigit(aNum, aDigit + 1) of me
    
    
if bNum = false then return false
    
    
set bNum to setDigit(bNum, aDigit, thisMin) of me
    
  else
    
    
set aTarget to aTarget + 1
    
set bNum to setDigit(aNum, aDigit, aTarget) of me
    
  end if
  
  
return bNum
  
end incDigit

–指定数値のうち指定桁の数字を返す
on getDigit(aNum, aDigit)
  
  
set aStr to aNum as string
  
set aLen to length of aStr
  
if aLen < aDigit then
    return false –エラー
  end if
  
  
set tStr to character (aLen - aDigit + 1) of aStr
  
return tStr as integer
  
end getDigit

–指定数値のうち指定桁の数字を返す
on setDigit(aNum, aDigit, newNum)
  
  
set aStr to aNum as string
  
set aLen to length of aStr
  
if aLen < aDigit then
    return false –エラー
  end if
  
  
set aList to characters of aStr
  
  
set item (aLen - aDigit + 1) of aList to (newNum as string)
  
set aaStr to aList as string
  
  
return aaStr as integer
  
end setDigit

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

2013/02/27 指定のコード体系の全パターンのコードを生成 v4

ルールにのっとったコード全生成サブルーチン v3の改良版です。このバージョンでは、これまで各桁ごとに専用のサブルーチンを設けて使っていたところを、全桁共通サブルーチンとして、コードの桁数を変更可能にしました。

いちおう、目指していた機能はすべて実現できた「完成版」といえます。

ただ……実際に作ってみないと気付かない点はあるもので、このプログラム……ルールで与えたコード体系の「最小値」を初期値として与えてあげないとダメなのですが、これを人間がパラメータとして書いてあげる必要があります。これはいただけません。

この初期値をルールから自動で生成するようにして、はじめてルールとロジックの分離が完了するといえるでしょう。

スクリプト名:指定のコード体系の全パターンのコードを生成 v4
–v4 桁ごとにサブルーチンを設けるのではなく、再帰処理で1つのルーチンを多重呼び出しするように変更
–v3 コードのルールを外部供給する構成にした(処理ロジックとルールの分離が完了)
–v2 各桁の最大値と最小値をプロパティで持たせるテスト
–v1 各桁のインクリメント用のサブルーチンを作成し、ルールを各サブルーチン側でハードコーディングする(正しく動く)

script spd
  property aList : {}
  
property aRuleList : {{1, 2}, {1, 3}, {0, 1}, {1, 4}, {1, 8}} –各桁の{最小値, 最大値}ペアのリスト
  
property aRuleLen : length of aRuleList
end script

set aList of spd to {}
set initNum to 11011 –本ルール下における最小値。この値も本来は計算から求めるべき
set the end of aList of spd to initNum

copy initNum to aNum

repeat
  set aRes to incDigit(aNum, 1) of me
  
  
if aRes = false then
    exit repeat
  end if
  
  
set the end of aList of spd to aRes
  
  
copy aRes to aNum
  
end repeat

return (aList of spd)

–繰り上がり処理(再帰呼び出しで使用)
on incDigit(aNum, aDigit)
  
  
set {thisMin, thisMax} to item ((aRuleLen of spd) - aDigit + 1) of (aRuleList of spd)
  
  
set aTarget to getDigit(aNum, aDigit) of me
  
  
if aTarget = thisMax then
    
    
if aDigit = (aRuleLen of spd) then
      –オーバーフロー(桁あふれ)エラーを返す
      
return false
    end if
    
    
set bNum to incDigit(aNum, aDigit + 1) of me
    
    
if bNum = false then return false
    
    
set bNum to setDigit(bNum, aDigit, thisMin) of me
    
  else
    
    
set aTarget to aTarget + 1
    
set bNum to setDigit(aNum, aDigit, aTarget) of me
    
  end if
  
  
return bNum
  
end incDigit

–指定数値のうち指定桁の数字を返す
on getDigit(aNum, aDigit)
  
  
set aStr to aNum as string
  
set aLen to length of aStr
  
if aLen < aDigit then
    return false –エラー
  end if
  
  
set tStr to character (aLen - aDigit + 1) of aStr
  
return tStr as integer
  
end getDigit

–指定数値のうち指定桁の数字を返す
on setDigit(aNum, aDigit, newNum)
  
  
set aStr to aNum as string
  
set aLen to length of aStr
  
if aLen < aDigit then
    return false –エラー
  end if
  
  
set aList to characters of aStr
  
  
set item (aLen - aDigit + 1) of aList to (newNum as string)
  
set aaStr to aList as string
  
  
return aaStr as integer
  
end setDigit

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

2010/08/10 Script Objectのparseのじっけん v4

AppleScriptのプログラムリストを解析して、Script Objectのリストアップを行うAppleScriptです。

AppleScriptのプログラムを解析する、自己解析系のAppleScriptを作りかけて……複数のAppleScript書類に存在しているハンドラ同士のdiffを取ろうとしていました。同じ名称のハンドラで、処理内容が異なる場合には困るので、比較しようと考えたわけです。

ハンドラ同士のDiffを取ろうと考えたときに、普通のハンドラなら簡単でよいのですが……

スクリプト名:script1
on test()
  display dialog “Test”
end test

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

ここに、Script Objectの宣言が加わってくると面倒です。さまざまな大きめのプログラムをつなげるときに、お互いにハンドラの重複があったりして統合が面倒という時があって、そういう時にはscript objectで論理分割して、同じハンドラ名称があっても別物扱いするようなことが……よくあります。

スクリプト名:script2
script scriptObj1
  on test()
    display dialog “Test”
  end test
end script

script scriptObj2
  on test()
    display dialog “Test”
  end test
end script

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

このぐらいならまだかわいげがあるのですが、Script文は入れ子にできるので、これに対処する必要があります。

スクリプト名:script21
script scriptObj1
  on test()
    display dialog “Test@scriptObj1″
  end test
end script

script scriptObj2
  on test()
    display dialog “Test@scriptObj2″
    
    
script scriptObj21
      on test()
        display dialog “Test@scriptObj21″
      end test
      
script scriptObj211
        on testr()
          display dialog “Test@ scriptObj211″
        end testr
      end script
    end script
    
  end test
end script

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

下のScriptをscript 21に対して実行すると、

–> {{”scriptObj1″, 1, 5}, {”scriptObj2″, 7, 23}, {”scriptObj21″, 11, 20}, {”scriptObj211″, 15, 19}}

といった結果が返ってきます。

このScript文を考慮してハンドラのリストアップを行うようにするといい感じでしょうか。

スクリプト名:Script Objectのparseのじっけん v4
–v4では、ネスティングしたScript文から再帰でオブジェクト名をピックアップ。一応の完全体
–v3では、Script文のネスティングに対応(ピックアップまで対応)
–v2では、Script文のネスティングに対応(対応しただけ)

global scObjList –このへん、必須(結果を値渡しではなく、グローバル変数へアクセスで行うため)
global aScriptList, a_r –ここも必須(再帰時にアクセスするのと、高速化のため)

–サンプルのAppleScript書類の内容をピックアップ
tell application “AppleScript Editor”
  set nameList to name of every document
  
set selDoc to choose from list nameList
  
tell document (contents of first item of selDoc)
    set a to contents
  end tell
end tell

set aScriptList to paragraphs of a
set a_r to a reference to aScriptList –間接アクセスで処理の高速化を行う

set allLen to length of a_r
set scObjList to {}

pickUpScriptObjectFromList(1, allLen) of me
set objList to shellSortListAscending(scObjList, 2) of me

objList

on pickUpScriptObjectFromList(startLineNum, endLineNum)
  
  
set curScriptObj to {} –name, startLine, endLiine
  
set nestingCounter to 0
  
set nestedF to false
  
set lineCounter to startLineNum
  
set findF to false –script object末尾検索フラグ。trueで末尾の”end script”の検索中
  
  
repeat with i from startLineNum to endLineNum
    
    
set ii to contents of (item i of a_r)
    
    
ignoring hyphens, punctuation and white space
      –Script文の開始位置を走査中
      
if findF = false then
        –Script文をみつけた場合
        
if ii begins with “script” then
          set aRes to parseScriptObjectName(ii) of me
          
set curScriptObj to {aRes, lineCounter, 0}
          
set findF to true
        end if
        
        
      else if findF = true then
        –Script文の末尾を走査中モード
        
if ii begins with “script” then
          set nestingCounter to nestingCounter + 1
          
set nestedF to true
          
        else if ii begins with “end script” then
          if nestingCounter = 0 then
            set item 3 of curScriptObj to lineCounter
            
set the end of scObjList to curScriptObj
            
            
if nestedF = true then
              –このへんで、Script Objectのネスティングに対して再帰でアプローチする
              
pickUpScriptObjectFromList((item 2 of curScriptObj) + 1, (item 3 of curScriptObj) - 1) of me –再帰時に捜索範囲を前後ともに1行ずつ狭める
            end if
            
            
set findF to false
            
set nestingCounter to 0
            
set nestedF to false
            
          else
            set nestingCounter to nestingCounter - 1
            
          end if
        end if
      end if
    end ignoring
    
    
set lineCounter to lineCounter + 1
    
  end repeat
end pickUpScriptObjectFromList

–与えられた1行分のテキスト(おそらく、script文の宣言部分)から、Script Object名称をparseする
on parseScriptObjectName(aText)
  set aOffst to offset of “script “ in aText
  
if aOffst = 0 then return “”
  
set aRes to text (aOffst + (length of “script “)) thru -1 of aText
  
return aRes
end parseScriptObjectName

–文字置換ルーチン
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

–シェルソートで入れ子のリストを昇順ソート
on shellSortListAscending(a, keyItem)
  set n to length of a
  
set cols to {1391376, 463792, 198768, 86961, 33936, 13776, 4592, 1968, 861, 336, 112, 48, 21, 7, 3, 1}
  
repeat with h in cols
    if (h (n - 1)) then
      repeat with i from h to (n - 1)
        set v to item (i + 1) of a
        
set j to i
        
repeat while (j h) and ((contents of item keyItem of item (j - h + 1) of a) > (item keyItem of v))
          set (item (j + 1) of a) to (item (j - h + 1) of a)
          
set j to j - h
        end repeat
        
set item (j + 1) of a to v
      end repeat
    end if
  end repeat
  
return a
end shellSortListAscending

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

2010/08/06 近似色を求めるサンプル

RGBベースで近似色を求めるAppleScriptのサンプルです。

choose colorでカラーピッカーダイアログから指定した任意の色と、あらかじめ用意しておいた色データリストとの間でRGBそれぞれのチャンネルの数値の差の絶対値を求めてポイント化し(ただ、R-difference, G-difference, B-differenceを足しているだけ)、ポイントが少ない(=距離が近い=近似色)順にソートして求めています。

choose colorコマンドに関しては……RGBの値を求めるときにでも、0〜255ではなく0〜65535までの値が返ってくるので、256で割って使っています。

本サンプルでは数個の色リストしか記述していませんが、実戦では数百とか1,000以上のカラーリストから近似色を求めることになります。そのために、近似色の計算ループをa reference toによる間接アクセスで高速化してあります。

「近似色を求める」……と、漠然と考えると一体何のことやら分かりませんが、3つの数値がペアになったデータの最も近い値、と考えると簡単です。

スクリプト名:近似色を求めるサンプル
–近似色検索(RGBベース)
set colList to {{“トウガラシ”, “COL-1″, 128.5, 0.0, 0.0}, {“アスパラガス”, “COL-2″, 128.5, 128.5, 0.0}, {“クローバー”, “COL-3″, 0.0, 128.5, 0.0}, {“ティール”, “COL-4″, 0.0, 128.5, 128.5}, {“ミッドナイト”, “COL-5″, 0.0, 0.0, 128.5}}

set colL_r to a reference to colList

set {aR, aG, aB} to choose color
set aaR to aR div 256
set aaG to aG div 256
set aaB to aB div 256

set aRes to {}
repeat with i in colL_r
  set {iColName, iColCode, iR, iG, iB} to i
  
  
set calR to absNum(aaR - iR)
  
set calG to absNum(aaG - iG)
  
set calB to absNum(aaB - iB)
  
  
set the end of aRes to {contents of i, calR + calG + calB}
end repeat

set bRes to shellSortListAscending(aRes, 2) of me

set cRes to items 1 thru 3 of bRes

–ここから結果表示のための処理
set tList to {}
set the end of tList to listToText({aaR, aaG, aaB}) of me

repeat with i in cRes
  set the end of tList to listToText(contents of i) of me
end repeat

–結果表示。何かを選択することを目的としているわけではない
choose from list tList with prompt “選択した色の近似色です”

–絶対値を求める
on absNum(q)
  if q is less than 0 then set q to -q
  
return q
end absNum

–シェルソートで入れ子のリストを昇順ソート
on shellSortListAscending(a, keyItem)
  set n to length of a
  
set cols to {1391376, 463792, 198768, 86961, 33936, 13776, 4592, 1968, 861, 336, 112, 48, 21, 7, 3, 1}
  
repeat with h in cols
    if (h (n - 1)) then
      repeat with i from h to (n - 1)
        set v to item (i + 1) of a
        
set j to i
        
repeat while (j h) and ((contents of item keyItem of item (j - h + 1) of a) > (item keyItem of v))
          set (item (j + 1) of a) to (item (j - h + 1) of a)
          
set j to j - h
        end repeat
        
set item (j + 1) of a to v
      end repeat
    end if
  end repeat
  
return a
end shellSortListAscending

–choose from listで表示するためのサブルーチン

–リストをテキストに
on listToText(aList)
  set listText to {“{”}
  
set quotChar to ASCII character 34
  
set firstFlag to true
  
repeat with i in aList
    set j to contents of i
    
set aClass to class of i
    
if (aClass = integer) or (aClass = number) or (aClass = real) then
      set the end of listText to (getFirst(firstFlag) of me & j as text)
      
set firstFlag to false
    else if (aClass = string) or (aClass = text) or (aClass = Unicode text) then
      set the end of listText to ((getFirst(firstFlag) of me & quotChar & j as text) & quotChar)
      
set firstFlag to false
    else if aClass is list then
      set the end of listText to (getFirst(firstFlag) of me & listToText(j)) –ちょっと再帰処理
      
set firstFlag to false
    end if
  end repeat
  
set the end of listText to “}”
  
set listText to listText as text
  
return listText
end listToText
on getFirst(aFlag)
  if aFlag = true then return “”
  
if aFlag = false then return “,”
end getFirst

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

2010/06/15 iChatの文字チャット経由で遠隔地のMacを操作

iChatの文字チャット経由で遠隔地のMacを操作するAppleScriptです。

ic4.jpg

メッセージの先頭に「sh:」と書けば、その後の文字をシェルコマンドとして、「as:」と書けばその後の文字列をAppleScriptとして実行します。イタズラしようと思えば際限なくイタズラできてしまうので、たいへん危険なAppleScriptであり、取扱いに最大限の注意を必要とします。動作原理を理解できなかったり、シェルコマンドの実行に習熟していないユーザーには使用をすすめません。

Mac OS X 10.5以降、iChatごしに画面共有して遠隔地のMacをコントロールできるようになり、大変便利に活用しています。ただ、そうしたビデオチャットの環境がネットワーク的にできなかったりするケースもあり、それでもリモートコントロールしなければならない、といった事態も考えられます。

そこで、だいたいどこでもつながる文字チャットを使って、shellやAppleScriptのコマンドを送り、文字チャット経由で結果を確認することができるプログラムを(ちょろっと)書いてみました。とりあえず、2台のMacを並べてiChat経由でリモート操作できています。

まずは、動作原理の説明から。

ic1.jpg

iChatは、幾多のバージョンアップを経て、さまざまなアプリケーション内部のイベント(ビデオチャットを仕掛けられたとか、テキストチャットを受信したとか)に応じて、音を鳴らしたり、Dockのアイコンをジャンプさせたり、Text To Speechを利用して文字を読み上げることができるようになっています。この設定は、iChatの「環境設定」の、「警告」で行うことができます。

ic0.jpg

それらの一環としてAppleScriptを呼び出すことができるようになっています。OS標準では、各種チャットを自動受付するAppleScriptなどが用意されており、これらは/Library/Scripts/iChat/に入っています。プログラムの書き方は、それらのサンプルを読めばだいたい分るようになっています。

問題は、iChat内で実行を指定するAppleScriptは、普通のスクリプトとして保存すると実行できないという点です。明示的にAppleScriptエディタ上で「テキスト」として保存して使用しなければなりません。

本Scriptでは、テキストチャットで話しかけられたときのイベント「メッセージを受信」と、テキストチャット中にメッセージを受信したときのイベント「チャットルームで受信したメッセージ」で、このAppleScript(テキスト形式で保存)を指定する必要があります。

本AppleScriptを仕掛けたマシンに、インターネット経由でiChatの文字チャットを開始し、冒頭で紹介したとおり、「sh:」とか「as:」といった文字で始まるメッセージを送信すると、それぞれシェルコマンドやAppleScriptとして評価・実行が行われます。asコマンドを送る際に、「application」を「app」などと略すことも可能です。

もう少し改良して、チャット経由でAppleScriptファイルを送りつけると、実行結果を文字チャットで返してくるとかいったところまでやってみたいです。また、シェルの実行に関してもdo shell scriptコマンドではなくTerminal.appで実行するようにすれば、ワンショットの一発コマンドやり逃げではなく、もう少し実用性が出てくるのではないかと考えます。

ic3.jpg
▲shellコマンドでコントロール

ic2.jpg
▲AppleScriptでコントロール

プログラム的には、ぜんぜん大したことをやっていないのですが、iChatで実行するAppleScriptの注意点がひとつ。プログラムを修正したら再度iChatの環境設定でScriptを指定し直す必要があります。元のプログラムを直しても、指定し直さないとiChat側に変更が通知されないようになっています。

つまり、これをやらないと、修正前のScriptが実行され続けてしまうことになります。そのため、不具合修正がちょっとやりづらい、といったところでしょうか。iChatからのイベントを受信する部分は最低限の記述にしておき、処理本体は外部のアプレット(AppleScriptアプリケーション。常時起動タイプ)で行うとよいかもしれません。

実際に使ってみて……シェルコマンドの実行結果が複数行にわたってしまうと(psコマンドの実行結果とか)、1行目以外は結果が返ってきませんね。やはり、複数行になってしまう場合には結果をテキストファイルに書き出して、iChatのファイル転送機能を使って送ってくるようにしたいところです。ただ……こんな特殊用途のどーーでもいい使い捨てプログラムに、そんなに入れ込んでもしょうがないような、、、、

スクリプト名:iChat_mes_test.applescript
using terms from application “iChat”
  
  
– 最初にテキストチャットで話しかけられた場合の対応(「メッセージを受信」で指定)
  
on received text invitation theMessage from theBuddy for theChat
    accept theChat
    
send “Welcome to shell/AppleScript Remote Control. “
  end received text invitation
  
  
– チャットが成立した後のメッセージ受信(「チャットルームで受信したメッセージ」で指定)
  
on message received theMessage from theBuddy for theChat
    
    
set aRes to “”
    
    
–set theResponse to “ぴよ〜” & theMessage
    
if (theMessage begins with “as:”) or (theMessage begins with “sh:”) then
      set aRes to execCommand(theMessage) of me
    end if
    
    
if aRes is not equal to “” then
      send aRes to theChat
    end if
    
  end message received
  
  
on execCommand(aText)
    if aText begins with “as:” then
      set bText to text 4 thru -1 of aText
      
try
        set aRes to run script bText
        
set aClass to class of aRes
        
if aClass = list then
          set aRes to listToText(aRes) of me
        else if aClass = record then
          set aRes to recordToText(aRes) of me
        else
          set aRes to aRes as string
        end if
        
return aRes
      on error aMes
        return aMes
      end try
      
    else if aText begins with “sh:” then
      set bText to text 4 thru -1 of aText
      
try
        return (do shell script bText)
      on error aMes
        return aMes
      end try
    end if
  end execCommand
  
  
  
  
  
on listToText(aList)
    set listText to {“{”}
    
set quotChar to ASCII character 34
    
set firstFlag to true
    
repeat with i in aList
      set j to contents of i
      
set aClass to class of i
      
if (aClass = integer) or (aClass = number) or (aClass = real) then
        set the end of listText to (getFirst(firstFlag) of me & j as text)
        
set firstFlag to false
      else if (aClass = string) or (aClass = text) or (aClass = Unicode text) then
        set the end of listText to ((getFirst(firstFlag) of me & quotChar & j as text) & quotChar)
        
set firstFlag to false
      else if aClass is list then
        set the end of listText to (getFirst(firstFlag) of me & listToText(j)) –ちょっと再帰処理
        
set firstFlag to false
      else if aClass is record then
        set the end of listText to (getFirst(firstFlag) of me & recordToText(j))
        
set firstFlag to false
        
      end if
    end repeat
    
set the end of listText to “}”
    
set listText to listText as text
    
return listText
  end listToText
  
  
on getFirst(aFlag)
    if aFlag = true then return “”
    
if aFlag = false then return “,”
  end getFirst
  
  
on recordToText(aRec)
    try
      set a to aRec as string
    on error aMsg
      set a to aMsg
    end try
    
    
set b to repChar(a, “のタイプを string に変換できません。”, “”)
    
return b
  end recordToText
  
  
–文字置換ルーチン
  
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
  
  
end using terms from

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

2010/01/17 OniOutlinerで選択中の行の内容のうち指定列のデータをすべて取得

OmniOutliner Professional v3.9.5で(通常のOmni Outlinerもtellブロックのアプリ名称を変更すればそのまま動作)、選択中の行のデータの中から指定列(カラム)のデータをすべて取得するAppleScriptです。

つまり、選択行の中の指定カラムのデータを取得するものです。こうした機能が標準搭載されていないほうがおかしいような気がします。そのままGUI上でExcelに選択データをペーストすると、1つの列の中にすべてのデータが入ってしまうなど、動作内容がいまいちです。

そこで、AppleScriptの登場となるわけで……旅行からの帰りの電車の中で勢いだけで作ってしまいました。

まずは、Onni Outliner上で行を選択。

omni1.jpg

スクリプトを実行すると、どの列のデータを取得するか聞いてきます。Command-クリックを行うことで、複数の列のデータを指定できます。

omni2.jpg

ためしに、「トピック」列と「Column2」列を選択すると……

{{”line2″, “”}, {”line3″, “●”}, {”line4″, “●”}, {”line5″, “”}}

といった結果が得られます。これは、Excelに貼付けることを前提としてデータを作成しているものであり、あとはExcelへのデータ貼り付けルーチンを作って用意すれば、便利に使えそうです。

excel1.jpg

……結局、Excelのワークシートを新規作成して、データ転送するところまで作り込んでしまいました。ここまでやると、たしかに便利。

スクリプト名:OniOutlinerで選択中の行の内容のうち指定列のデータをすべて取得
global tList, numRes
set tList to {}

tell application “OmniOutliner Professional”
  tell document 1
    set aSel to every row whose selected is true
    
if aSel = {} then
      display dialog “OmniOutliner上で選択されている行はありませんでした。” buttons {“OK”} default button 1
      
return
    end if
  end tell
end tell

–どの列を書き出すかを選択
tell application “OmniOutliner Professional”
  tell document 1
    set nList to name of every column
    
set aMes to “項目を選択してください(Command-クリックで複数選択可能)”
    
set numRes to retMultipleItemFromListByItemNo(nList, aMes) of me
  end tell
end tell

–選択部分を検出
tell application “OmniOutliner Professional”
  tell document 1
    set aaSel to first item of aSel
    
tell aaSel
      set aCell to text of every cell
      
set aCell to retSpecifiedItemFromList(numRes, aCell) of me
      
set the end of tList to aCell
      
set cList to every child
      
repeat with i in cList
        getChildText(i) of me
      end repeat
    end tell
  end tell
end tell

tList
–> {{”line2″, “”}, {”line3″, “●”}, {”line4″, “●”}, {”line5″, “”}}

–再帰で指定child以下のテキストをすべて取得する
on getChildText(aRoot)
  tell application “OmniOutliner Professional”
    tell document 1
      tell aRoot
        set aCell to text of every cell
        
set aCell to retSpecifiedItemFromList(numRes, aCell) of me
        
set the end of tList to aCell
        
        
set cList to every child
        
repeat with i in cList
          getChildText(i) of me –再帰処理
        end repeat
      end tell
    end tell
  end tell
end getChildText

–リストから選択してアイテム番号を返す(複数項目選択対応)
on retMultipleItemFromListByItemNo(aList, aMes)
  set aRes to choose from list aList with prompt aMes with multiple selections allowed
  
if aRes = false then return 0
  
  
set hitList to {}
  
repeat with i1 in aRes
    set aRes to contents of i1
    
set hitNum to 1
    
repeat with i in aList
      set j to contents of i
      
if j is equal to aRes then
        exit repeat
      end if
      
set hitNum to hitNum + 1
    end repeat
    
set the end of hitList to hitNum
  end repeat
  
return hitList
end retMultipleItemFromListByItemNo

–指定リストから、指定アイテム目を抽出して返す
on retSpecifiedItemFromList(itemNumList, dataList)
  set newList to {}
  
repeat with i in itemNumList
    set j to contents of i
    
set a to contents of (item j of dataList)
    
set the end of newList to a
  end repeat
  
return newList
end retSpecifiedItemFromList

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

2009/12/16 Folder構造をMindMapに v1

選択したフォルダ以下のディレクトリ構造をMindjet MindManager上にプロットするAppleScriptです。

フォルダのみに着目し、ファイルは無視します。かーーなり適当ですが、再帰で処理しています。

Finder上でFolderにつけたラベルの色をMindMap上に再現します。

Betaが登場したMindjet MindManager 8 for Mac上でも動作確認しています。MindManagerのAppleScriptの情報源は、Googleで検索してこのBlogが最初に出てくる程度で、あまりまとまったものが存在していないといった印象がありますが、AppleScript系の機能が足りないといったことはなく、(私は)不満なく使えています。

Finder上でつけたラベルが……

mmap2.jpg

MindMap上に反映されます。

mmap1.jpg

2010年初頭にリリースされるというMindjet MindManager 8では、MindMapをFlash形式で書き出すことができるようになっており、「AppleScriptでMindMapを作成してFlashとして書き出してサイトにアップロードしてURLをメールでお知らせする」といったフローも簡単に作れそうで楽しみです。

→ マインドマップのFlash書き出し例

スクリプト名:Folder構造をMindMapに v1
–Finder上のラベルの色をMindjet MindManager上で再現するためのリスト
property labelColor : {“”, {65535, 32896, 0}, {65535, 40756, 42034}, {65535, 65535, 0}, {26214, 65535, 65535}, {48464, 44388, 65535}, {0, 65535, 0}, {50489, 50489, 50489}}
global curTopicID

set origFol to choose folder
tell application “Finder”
  set folName to name of origFol
end tell

–新規ドキュメントを作成
tell application “Mindjet MindManager”
  set aDoc to make new document
  
set rootTopicID to the id of central topic of document 1
  
tell document 1
    tell topic id rootTopicID
      set title to folName
    end tell
  end tell
  
  
set curTopicID to rootTopicID
end tell

–指定フォルダ内の第1階層を処理
tell application “Finder”
  tell folder origFol
    set folList to every folder
    
if folList is not equal to {} then
      execFolder(folList, rootTopicID) of me
    end if
    
    
(*
    set fileList to every file
    if fileList is not equal to {} then
      execFile(fileList) of me
    end if
    *)

  end tell
end tell

–指定フォルダ内のフォルダを処理
on execFolder(aFol, aTopicID)
  repeat with i in aFol
    tell application “Finder”
      set j to i as alias
      
      
tell folder j
        set aName to name
        
set aLabel to label index
        
set aLabel to item (aLabel + 1) of labelColor
        
        
set retID to addResultMainNode(aTopicID, aName as string, “”, aLabel, false) of me
        
        
set folList to every folder
        
execFolder(folList, retID) of me
      end tell
    end tell
  end repeat
end execFolder

(*
–指定フォルダ内のファイルを処理
on execFile(aFol)
  
end execFile
*)

–IDで指定したノードの下に子ノードを作成する
on addResultMainNode(topicID, aTitle, aBody, aColor, aBoundaryF)
  tell application “Mindjet MindManager”
    – 指定のトピック名称で新規トピックを作成
    
tell document 1
      set resTopic to make new subtopic for topic id topicID with properties {title:aTitle}
      
set notes of resTopic to aBody
      
      
–囲みをつけるかどうか
      
if aBoundaryF = true then
        make new boundary for resTopic
      end if
      
      
–指定がある場合にはfill colorを変更
      
if aColor is not equal to “” then
        set fill color of resTopic to aColor
      end if
    end tell
    
    
return id of resTopic –作成したトピックのIDを返す
  end tell
end addResultMainNode

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

2009/12/08 Mindjet MindManager上のデータをリストに展開してCSV書き出し

Mindjet MindManager上に展開したマインドマップを、選択中のトピック以下を対象に、いい感じにトピックのレベルを反映してCSV書き出しするAppleScriptです。

mj1.jpg

リスト上でトピックの配置を行い、Excelのワークシート上に……そのまま持って行くのは、不可能ではないにせよかったるい(r1c1形式とA1形式の変換サブルーチン(しかも巨大)を投入する必要がある)ため、以前にリストをCSV書き出しするサブルーチンを作ってあったので、CSV書き出ししておくことにしました。

mj2.jpg

書き出したCSVのファイルをExcelでオープンすれば、めんどくさい処理なしにExcelにマインドマップの内容を渡せます。

いい感じでマインドマップ上にアイデアを書き込んでいたところに「そのままだと分りづらいからExcelの表にして」などと言われ、一気にテンションが落ち……ないよう作ってみたものです。

風呂上がりにテレビを見ながら、いいかげんに作ったので……a reference toによる高速化を試みているものの、ろくに高速化されていなかったりしますが、目くじらを立てるほど遅くないため放っておきました。

スクリプト名:Mindjet MindManager上のデータをリストに展開してCSV書き出し
global gList, gList_r, levelList

set gList to {}
set gList_r to a reference to gList
set levelList to {}

tell application “Mindjet MindManager”
  tell document 1
    set aSel to selection
  end tell
  
set aaSel to first item of aSel
  
addMMSubtreeToGlobalVal(aaSel) of me
end tell

–行(row)の最大値、列の最大値(levelList)を取得する
set rowNum to length of gList_r
set colMax to maximumFromList(levelList) of me

–カラのリストを作成する
set blankList to makeBlankList(rowNum, colMax, “”) of me

–リストを作成する
set tmpCol to 1
set tmpRow to 1

set prevCol to 0
set prevRow to 0

set prevLevel to 0

repeat with i in gList_r
  set {aTitle, aLevel} to i
  
  
if aLevel < prevCol then
    set tmpRow to tmpRow + 1
  else if aLevel = prevCol then
    set tmpRow to tmpRow + 1
  else
    
  end if
  
  
–set item tmpRow of item aLevel of blankList to aTitle
  
set item aLevel of item tmpRow of blankList to aTitle
  
  
set prevCol to aLevel
  
set prevRow to tmpRow
  
end repeat

set aNewFile to choose file name
saveAsCSV(blankList, aNewFile) of me

–指定の大きさでカラのリストを作成する
on makeBlankList(rowMax, colMax, anItem)
  set allData to {}
  
  
repeat rowMax times
    set aRow to {}
    
repeat colMax times
      set the end of aRow to anItem
    end repeat
    
set the end of allData to aRow
  end repeat
  
  
return allData
end makeBlankList

–Mindjet MindManager上のトピックを渡すと、その子トピックの情報を収集して、サブトピックを再帰で取得
–結果はGlobal変数(gList)に追記する
–別のサブルーチンを書き換えてそのままの名前で使ってしまった
on addMMSubtreeToGlobalVal(mmTopic)
  tell application “Mindjet MindManager”
    repeat with childTopic in subtopics of mmTopic –指定トピック下の子トピックを取得するのに、この書き方しかMindjet MMが受け付けてくれない
      set topicTitle to (a reference to the title of childTopic)
      
set aLevel to level of childTopic
      
set aTitle to title of childTopic
      
set the end of gList_r to {aTitle, aLevel}
      
set the end of levelList to aLevel
      
addMMSubtreeToGlobalVal(childTopic) of me
    end repeat
  end tell
end addMMSubtreeToGlobalVal

–最大値を取得する
on maximumFromList(nList)
  script o
    property NL : nList
  end script
  
  
set max to item 1 of o’s NL
  
repeat with i from 2 to (count nList)
    set n to item i of o’s NL
    
if n > max then set max to n
  end repeat
  
return max
  
end maximumFromList

–CSV書き出し
–ただし、データ内にダブルクォートが入っていた場合に備えてのサニタイズ処理は行っていない
on saveAsCSV(aList, aPath)
  set crlfChar to (ASCII character 13) & (ASCII character 10)
  
set LF to (ASCII character 10)
  
set wholeText to “”
  
repeat with i in aList
    set aLineText to “”
    
set curDelim to AppleScript’s text item delimiters
    
set AppleScript’s text item delimiters to “\”,\”"
    
set aLineList to i as text
    
set AppleScript’s text item delimiters to curDelim
    
    
set aLineText to repChar(aLineList, return, “”) of me –データの途中に改行が入っていた場合には削除する
    
set aLineText to repChar(aLineText, LF, “”) of me –データの途中に改行が入っていた場合には削除する
    
    
set wholeText to wholeText & “\”" & aLineText & “\”" & crlfChar –行ターミネータはCR+LF
  end repeat
  
  
if (aPath as string) does not end with “.csv” then
    set bPath to aPath & “.csv” as Unicode text
  else
    set bPath to aPath as Unicode text
  end if
  
  
write_to_file(wholeText, bPath, false) of me
  
end saveAsCSV

–ファイルの追記ルーチン「write_to_file」
–追記データ、追記対象ファイル、boolean(trueで追記)
on write_to_file(this_data, target_file, append_data)
  try
    set the target_file to the target_file as text
    
set the open_target_file to open for access file target_file with write permission
    
if append_data is false then set eof of the open_target_file to 0
    
write this_data to the open_target_file starting at eof
    
close access the open_target_file
    
return true
  on error error_message
    try
      close access file target_file
    end try
    
return error_message
  end try
end write_to_file

–文字置換
on repChar(origText, targChar, repChar)
  set origText to origText as string
  
set targChar to targChar as string
  
set repChar to repChar as string
  
  
set curDelim to AppleScript’s text item delimiters
  
set AppleScript’s text item delimiters to targChar
  
set tmpList to text items of origText
  
set AppleScript’s text item delimiters to repChar
  
set retText to tmpList as string
  
set AppleScript’s text item delimiters to curDelim
  
return retText
end repChar

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

2009/10/01 Mail.appの指定メールボックス内に任意のメールボックスを新規作成 v2

Mail.appの指定メールボックス内に任意のメールボックスを新規作成するAppleScriptです。

Mail.appのメールボックス・フォルダは階層構造にすることができ、かなり自由にAppleScriptから制御できます。目下、各メーリングリストのメールはMail.appのルールで各フォルダに仕分けるようにしており……そのルール設定をAppleScriptから読み出して、US Appleの主催しているメーリングリストの各仕分けフォルダに、一括で「10.6,Snow Leopard」というフォルダを作成指示するAppleScriptを作りたいと思っていました(このScriptはすでに完成し、一括で全MLに同一名称のメールボックスを作成できるようになりました。いや、便利便利)。

まずはMail.appのメールボックス・オブジェクトからメールボックスのフルパスを取得するAppleScriptを作成し、その次の段階として本AppleScriptを作成した次第です。

スクリプト名:Mail.appの指定メールボックス内に任意のメールボックスを新規作成 v2
global aFullPath

set aFullPath to “”

set aNewFolName to “10.6,Snow Leopard”
tell
application “Mail”
  –mailboxオブジェクトを渡すのは、全メール振り分けルールからML用のもの(名称に「_ML」が入っている)
  
–を抽出して、それに対してすべて処理を行うことを考えているため。その際に入手できるのは
  
–該当するメールボックスのオブジェクト(のリスト)
  set
aMB to mailbox “ML/Apple US/ASに関係のあるもの/SyncService” –mailboxオブジェクトを作ってみた
end tell
makeAFolderIfNotExist(aNewFolName, aMB) of me


on
makeAFolderIfNotExist(aNewFolName, aFolder)
  –パラメータとして渡されたメールボックスオブジェクトからフルパスの階層を取得する
  
–make mailbox full-path text from Mail.app’s mailbox object
  set
aFullPath to “”
  
extraxctTextFullPathOfMBObject(aFolder) of me
  set
aNewFolFullPath to aFullPath & “/” & aNewFolName
  set
aFullPath to “”
  
  tell
application “Mail”
    –指定名称を「含む」フォルダが存在するかどうかチェック
    tell
aFolder
      set tmpFolList to name of every mailbox whose name contains aNewFolName
    end tell
    
    if
tmpFolList is equal to {} then
      try
        make new mailbox at beginning with properties {name:aNewFolFullPath}
      on error erM
        display dialog erM & return & “Error in making new mail folder by name: ” & aNewFolName
      end try
    end if
  end tell
end makeAFolderIfNotExist

–Mail.appのメールボックスオブジェクトを渡すと、テキストのフルパスに変換
on
extraxctTextFullPathOfMBObject(aPath)
  tell application “Mail”
    try
      set parentPath to container of aPath
    on error
      return
    end try
    
    set
meName to name of aPath
    if
aFullPath = “” then –1回目のみスラッシュを入れないで処理
      set aFullPath to meName
    else
      –通常処理はこちら
      set
aFullPath to meName & “/” & aFullPath
    end if
    
    
extraxctTextFullPathOfMBObject(parentPath) of me –再帰呼び出し
  end tell
end extraxctTextFullPathOfMBObject

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

2009/09/26 Mail.appのメールボックスオブジェクトを渡すと、テキストのフルパスに変換 v1

Mail.appのmailboxオブジェクトを与えると、そのフォルダ階層のパスを「/」で区切ったテキストにして返すサブルーチンです。

mailfol.jpg

Mail.appのmailboxオブジェクトのプロパティには、名称や上位階層のmailboxオブジェクトの情報は入っているものの、現在の階層を示すフルパスの情報が入っていません。mailboxオブジェクトを生成する際に、フォルダ階層のテキストで指定することになるので、mailboxオブジェクトを相手にするのではなく、その元となるテキスト情報を相手にすれば「楽」に処理はできます。ただ、それだとあまり柔軟性に富んだ処理が行えません。

そこで、mailboxオブジェクトを渡すと、フルパスをテキスト化するAppleScriptを書いてみました。

そもそも、こんなルーチンが欲しいと思ったのは……Mac OS X 10.6が登場して、Appleの各MLフォルダ内に「10.6, Snow Leopard」(カンマで区切って名前を付けておくと、それらのどれかでヒットしたメールをフォルダに振り分けるAppleScriptを運用中)といったフォルダを一括で作成する必要が出てきたためで……ほぼすべてのUS Appleのデベロッパー系MLを購読しているため、それをすべて手作業で行うのは骨が折れます。また、すでに手でフォルダを作ってあるところに対しては作成しない、という処理も行わなくてはなりません。

スクリプト名:Mail.appのメールボックスオブジェクトを渡すと、テキストのフルパスに変換 v1
(*

Mail.appのmailboxオブジェクトはフルパスのプロパティを持っていないため、オブジェクトで渡されると、それがどのパスに存在
しているものなのか、処理するのが非常に面倒。

そこで、mailboxオブジェクトを渡すと、再帰でパスを求めるルーチンを作ってみた。
処理前にグローバル変数aFullPathをクリアしておく必要がある
ルート階層に達したときにエラートラップで判定を行うが、ここはもう少しスマートな書き方に変えたほうがいい

*)

global aFullPath

set aFullPath to “”
tell application “Mail”
  set aMB to properties of mailbox “ML/Apple US/ASに関係のあるもの/SyncService” –mailboxオブジェクトを作ってみた
end tell

extraxctTextFullPathOfMBObject(aMB) of me
aFullPath
–> “ML/Apple US/ASに関係のあるもの/SyncService”

–Mail.appのメールボックスオブジェクトを渡すと、テキストのフルパスに変換
on extraxctTextFullPathOfMBObject(aPath)
  tell application “Mail”
    try
      set parentPath to container of aPath
    on error
      return
    end try
    
    
set meName to name of aPath
    
if aFullPath = “” then –1回目のみスラッシュを入れないで処理
      set aFullPath to meName
    else
      –通常処理はこちら
      
set aFullPath to meName & “/” & aFullPath
    end if
    
    
extraxctTextFullPathOfMBObject(parentPath) of me –再帰呼び出し
  end tell
end extraxctTextFullPathOfMBObject

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

2008/12/11 iCal上で指定月の重複イベントを削除する

iCalデータが、さまざまなデバイスとのシンクロを繰り返した末に重複しまくってしまった、という友人から頼まれて作ったScriptです。

ical.jpeg

Script Menuなどに入れておいて実行し、実行対象月を入力すると(期間指定も可能)重複しているスケジュールを削除します。このあたり、iCalのAppleScript仕様がいまひとつ実用的でなく、「iCalで表示中の月」というのがAppleScript側から取得できないため、やむなくダイアログから入力してもらっています。

ical2.jpeg

対象月を入力すると重複イベントが削除されます。

ical3.jpeg

普通の環境であれば、「あっ!」という間に実行されてしまう程度のAppleScriptですが、残念なことに友人の環境ではデータ内容がすでにこわれかけていて、イベントの件数を求めたり1件削除するだけでも1日以上かかる状態に。

結局、このAppleScriptでは役に立たず、さらにiCalendarファイルを解析して重複イベントを削除するという、超強力で手の込んだものを作る羽目に。世界中探しまわっても、そこまで作り込んだAppleScriptにお目にかからなかったので、ちょっとした達成感はあったものの……友人にそのScriptを渡したところ、またスケジュールが重複したとか(汗) それはきっと、何か壊れているか、そうでなければたたられているに違いありません。

スクリプト名:iCal上で指定月の重複イベントを削除する v4
global g_tmpList, g_tmpList_ref

指定期間のイベントを取得
set todayDat to current date
set targYear to (year of todayDat) as string
set targMonth to (month of todayDat as number) as string
set aTarg to text returned of (display dialog 重複イベントの削除対象月は?(YYYY/MM) default answer (targYear & / & targMonth))
set {sDate, eDate} to getRangeFromDateText(aTarg) of me

with timeout of 3600 seconds
  tell application iCal
    set theEvents to properties of every event of every calendar whose start date is greater than sDate and end date is less than eDate and summary is not equal to “”
  end tell
end timeout

入り組んだリストをフラットなリストに
set g_tmpList to {} 初期化
set g_tmpList_ref to a reference to g_tmpList
makeFlatList(theEvents) of me

set dIDList to {}

with timeout of 3600 seconds
  tell application iCal
    repeat with i from 1 to (length of g_tmpList_ref)
      set anItem to first item of g_tmpList_ref
      
set anRec to {start date of anItem, end date of anItem, summary of anItem}
      
set g_tmpList to rest of g_tmpList
      
      
repeat with ii in g_tmpList_ref
        set bRec to {start date of ii, end date of ii, summary of ii}
        
if anRec = bRec then
          set anID to uid of ii
          
if anID is not in dIDList then
            display dialog ((”重複イベント” & return & (item 1 of anRec) as string) & return & (item 2 of anRec) as string) & return & item 3 of anRec
            
set the end of dIDList to anID
          end if
        end if
      end repeat
    end repeat
    
    
    
set delSucCount to 0
    
set delFailCount to 0
    
    
repeat with i in dIDList
      set delEvents to (every event of every calendar whose uid is equal to i)
      
makeFlatList(delEvents) of me
      
      
repeat with ii in g_tmpList_ref
        set aDelEv to contents of ii
        
if aDelEv is not equal to {} then
          try
            delete (contents of aDelEv)
            
set delSucCount to delSucCount + 1
          on error
            set delFailCount to delFailCount + 1
          end try
        end if
      end repeat
    end repeat
    
    
if delSucCount = 0 then
      display dialog 重複スケジュールは存在しませんでした。 buttons {”OK“} default button 1 with icon 1
    else
      set aMes to (delSucCount as string) & 件のスケジュールを削除。
      
(*
    if delFailCount is not equal to 0 then
      set aMes to aMes & “うち、” & (delFailCount as string) & “件の削除に失敗しました。”
    end if
    
*)
      display dialog aMes buttons {”OK“} default button 1 with icon 1
    end if
  end tell
end timeout

再帰でフラットなリストを作成する
on makeFlatList(aList)
  repeat with i in aList
    set aClass to (class of i) as string 2行に分けたり、ここでstringにcastしなかったりすると……AppleScript Studio環境に持っていったときに動かなくなる!!
    
if aClass = list then
      makeFlatList(i) of me
    else
      set the end of g_tmpList to (contents of i)
    end if
  end repeat
end makeFlatList

on getRangeFromDateText(aText)
  if aText does not contain then
    普通にYYYY/MM指定のみ行った場合
    
set sDate to (aText & /1“)
    
set eDate to (date sDate) + (getMlen(year of (date sDate), month of (date sDate)) of me) * days
    
set sDate to date sDate
    
  else
    期間を「YYYY/MM…YYYY/MM」  で指定した場合
    
set curDelim to AppleScript’s text item delimiters
    
set AppleScript’s text item delimiters to
    
set tList to text items of aText
    
set AppleScript’s text item delimiters to curDelim
    
    
set item1T to contents of item 1 of tList
    
set item2T to contents of item 2 of tList
    
    
set sDate to date retYYYYMDD(item1T) of me
    
set eDate1 to date retYYYYMDD(item2T) of me
    
set eDate to eDate1 + (getMlen(year of sDate, month of eDate1) of me) * days
  end if
  
  
return {sDate, eDate}
end getRangeFromDateText

on retYYYYMDD(aText)
  if aText contains / then
    set bText to aText & /1
  else
    set thisYear to (year of (current date)) as string
    
set bText to thisYear & / & aText & /1
  end if
  
return bText
end retYYYYMDD

指定月の長さを得る(日数)
on getMlen(aYear, aMonth)
  
  
set aYear to aYear as number
  
set aMonth to aMonth as number
  
  
set aDat to (aYear as text) & / & (aMonth as text) & /1
  
if aMonth is not equal to 12 then
    set eDat to ((aYear as text) & / & (aMonth + 1) as text) & /1
  else
    set eDat to ((aYear + 1) as text) & / & (1 as text) & /1
  end if
  
  
set sDat to date aDat
  
set eDat to date eDat
  
set eDat to eDat - 1
  
  
set mLen to day of eDat
  
return mLen
  
end getMlen

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

2008/05/02 入り組んだリストの中に指定要素が存在するかどうかをチェック

{{1, 2, 3}, {4, 5, 6}, {7, 8, 9, {-1, -2, -3}}} ……のような入り組んだリスト型変数の中に、指定の要素が含まれていないかどうかをチェックするサブルーチンです。
(more…)

2008/05/02 再帰でリストのアイテム数をカウント

リストに入っているアイテムの総数をカウントします。リストから取り出したアイテムのクラスを取得して、クラスがリストだった場合に再帰処理。これで、いくら入り組んだリスト構造でも追いかけられるはずです。
(more…)

2008/04/06 再帰でファイルをカウント

AppleScriptで再帰処理を行う(よくある)サンプルです。指定フォルダ下のファイルをすべてカウントします。ファイルを検索するといった処理はMac OS X 10.4以降であればSpotlight(mdfind)で行いますが、Mac OS X 10.3.9まで対象にしなければならないケースではこのような地道な処理が必要になります。

スクリプト名:再帰でファイルをカウント

global countFiles

on run
  set theList to choose folder
  
  
set countFiles to 0
  –
set theList to contents of item 1 of theList
  
tell applicationFinder
    set folderList to every folder of theList
    
set fileList to every file of theList
    
processfiles(fileList) of me
    
repeat with eachFolder in folderList
      processFolders(eachFolder) of me
    end repeat
  end tell
  
display dialog countFiles as text
end run

on processfiles(thisList)
  delLabel(thisList) of me
end processfiles

on processFolders(thisfolder)
  tell applicationFinder
    set thesefiles to files of thisfolder
    
processfiles(thesefiles) of me
    
set thesefolders to folders of thisfolder
    
repeat with thatfolder in thesefolders
      processFolders(thatfolder) of me
    end repeat
  end tell
end processFolders

on delLabel(thisList)
  tell applicationFinder
    repeat with aFile in thisList
      set countFiles to countFiles + 1
    end repeat
  end tell
end delLabel

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

2008/03/09 リストをテキストに

リストをそのままstring等にcastしても、ただ要素が連結された文字列になるだけで、リストの表記がそのまま文字列になったりはしません。スクリプトエディタを操作してAppleScriptを自動記述するAppleScriptの作成時に使用したものです。スクリプトエディタをAppleScriptからコントロールし、Excel上で選択したデータをAppleScriptのプログラム中に展開するといった用途に使用しました。

スクリプト名:リストをテキストに
set aList to {1, {1.1, -2, “3“}, 3}
set aText to listToText(aList)
aText

on listToText(aList)
  set listText to {”{“}
  
set quotChar to ASCII character 34
  
set firstFlag to true
  
repeat with i in aList
    set j to contents of i
    
set aClass to class of i
    
if (aClass = integer) or (aClass = number) or (aClass = real) then
      set the end of listText to (getFirst(firstFlag) of me & j as text)
      
set firstFlag to false
    else if (aClass = string) or (aClass = text) or (aClass = Unicode text) then
      set the end of listText to ((getFirst(firstFlag) of me & quotChar & j as text) & quotChar)
      
set firstFlag to false
    else if aClass is list then
      set the end of listText to (getFirst(firstFlag) of me & listToText(j)) –ちょっと再帰処理
      
set firstFlag to false
    end if
  end repeat
  
set the end of listText to}
  
set listText to listText as text
  
return listText
end listToText

on getFirst(aFlag)
  if aFlag = true then return “”
  
if aFlag = false then return,
end getFirst

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