' ****************************************************************************
' *                                                                          *
' *                 プレーンテキストで目次を作成できるように、               *
' *              見出し行を検出して目次登録(見出し設定)するマクロ            *
' *            'Mark Table of Contents Entriese' Macro  Version 1.00         *
' *                                                                          *
' *                  マクロ名            : MarkTCE100                        *
' *                                                                          *
' *                  配布時のファイル名  : MTCE100.LZH                       *
' *                  公開日              : 1995/10/29                        *
' *                                                                          *
' *                   Copyright (C) 1995 Fumio Kawamata                      *
' *                        GDH01254@niftyserve.or.jp                         *
' *                                                                          *
' ****************************************************************************
'
' ########## このマクロについて ##########
' (1)このマクロは、Microsoft Word Version6.0で読込んだプレーンテキストで目次を
'    生成出来るように、テキスト中の見出し行を検出して目次登録するマクロです。
'    目次登録は、
'        [目次登録(TC)]フィールドの設定による方法
'        [見出し *]スタイルの設定による方法
'    のいずれかの方法を選択できます。また、設定内容を元に戻すこともできます。
' (2)このマクロはフリーソフトウェアです。著作権表示を改変しない限り
'    非営利の再利用、再配布などは許可なく勝手にやって下さい。印刷物にして
'    配布するなどしても構いません。
' (3)改造したものの再配布や、圧縮を解除した状態での再配布（会議室やネット
'    ニュースなどへの登録）もして構いません。ただし、オリジナルを入手したい
'    人のためにオリジナルの登録先を明記しておいて下さい。
' (4)ユーザーサポートは必要ないと思いますが、やるとすれば、NIFTY-Serve
'    SMSAPP（マイクロソフトステーション）の WORD会議室で行います。
'    個人メールでの連絡はご遠慮下さい。
'
' ########## このマクロの登録の仕方 ##########
' 他に方法があるかもしれませんが、私の方法は以下のとおりです。
' (1)まず、このマクロをクリップボードにコピーしておきます。
' (2)Microsoft Word Ver6 の[ツール(O)]-[マクロ(M)...]メニューを選択すると、
'    [マクロ]ダイヤログボックスがオープンします。
' (3)[マクロ名(M)]テキストボックスに、このマクロ冒頭のマクロ名を入力します。
'    （実際は、マクロ名は自由です。一部改造したものを共存させるために
'      ヴァージョンがわかるような名前にしておくといいでしょう。）
' (4)[マクロ作成(E)]ボタンを押すと、マクロ編集用のエディタがオープンします。
'      Sub MAIN
'      
'      End Sub
'   というテキストが表示されますが、これをキーボードを使って削除します。
' (5)つづいて、クリップボードにコピーしておいたこのマクロを貼り付けます。
' (6)[ファイル(F)]-[テンプレートの保存(S)]メニューを選択して、マクロを保存
'    します。
'
' ########## 使い方 ##########
' (1)まず、変換したい文書をオープンします。文書は、アクティブな状態
'   （タイトルバーが青い状態）にしておきます。
' (2)このマクロによって設定された内容が完全に元に戻る保証はないので、
'    必要ならバックアップコピーを作成して下さい。
' (3)既にこのマクロを実行して目次が存在する場合は、一旦目次を削除して
'    おいて下さい。
' (4)[ツール(O)]-[マクロ(M)...]メニューを選択します。
'    [マクロ]ダイヤログボックスがオープンします。
' (5)[マクロ名(M)]リストボックスから、登録したマクロ名を選択し、
'    <実行(R)>ボタンをクリックします。
' (6)メニューダイヤログがポップアップしますので、いずれかを処理を選択して、
'    <OK>ボタンを押します。
' (7)処理終了後、目次を挿入したい場所にカーソルを移動して、
'    [挿入(I)][索引/目次(X)]メニューを選択します。
'    [索引/目次]ダイヤログボックスがオープンしますので、[目次]タブをクリック
'    して目次項目を設定します。
' (8)『[目次登録(TC)]フィールドの設定による方法』により目次登録処理をした
'    場合は、<オプション(O)...>ボタンをクリックします。[目次オプション]
'    ダイヤログボックスがオープンしますので、[目次登録フィールドを使用(E)]
'    チェックボックスをチェックして下さい。これを忘れると、『目次に載せる
'    見出しスタイルの段落が何も見つかりません。』というメッセージが現れます。
' (9)処理中は[ESC]キーを押せばその時点で処理を終了します。
'    再実行すると最初からやり直します。
'
' ########## ヒント ##########
' 見出し行は、
'    例1)							例2)
'    1 はじめに						1. はじめに
'    1-1 このプログラムについて	1.1. このプログラムについて
'    1-1-1 著作権					1.1.1. 著作権
' のように、『見出し番号（数字と"."や"-"の組合せ）、１文字以上の空白、
' 任意の文字列』の順で構成されているものとしています。
' 行頭から開始していないものは見出し行とはみなしません。
' 半角でも全角でも構いません。
'
' [目次登録(TC)]フィールドの設定による方法では、プレーンテキストの書式を
' 変更せずに目次を作成できます。一方、[見出し *]スタイルの設定による方法
' では、[見出し *]スタイルの書式によって、検出された見出し行の書式を変更
' します。（フォントが変わったり、サイズが大きくなったり、アンダーライン
' がついたり、あなたのWordの設定によって書式変更が行われます）。後者の方
' が可読性が高くなりますが、プレーンテキストの著作者の権利を侵害すること
' になるだろうと思います。（専門家ではないので断定はできません。印刷した
' ものを自分だけで使う場合には問題が表面化することはないでしょうが、配布
' する場合には事前に著作者の許可を得た方がいいでしょう。ただし、私があな
' たならそうするということで、あなたの行動を拘束するものではありません。）
'
' ****************************************************************************
' *                      以下はマクロプログラム                              *
' ****************************************************************************
'
Dim Shared Numerics$		' 見出しレベル文字列内に許容する数字文字列
Dim Shared Symboles$		' 見出しレベル文字列内に許容するシンボル文字列
Dim Shared ProgName$		' プログラム名
'
Sub MAIN' ##### メインルーチン #####
	Dim MyMenuDialog As UserDialog
	Numerics$ = "0123456789"	' 見出しレベル文字列内に許容する数字文字列
	Symboles$ = ".-"			' 見出しレベル文字列内に許容するシンボル字列
	ProgName$ = "目次登録  Version 1.00"
	Copyright$ = Chr$(13) + Chr$(13) + Chr$(9) + "            " + ProgName$ + Chr$(13) + "        Copyright (C) 1995 Fumio Kawamata"
'
' ダイヤログボックスの定義
'vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
Begin Dialog UserDialog 440, 160, ProgName$, .MenuDialog
	GroupBox 8, 14, 421, 99, "処理区分", .DocType
	OptionGroup  .OptionGroup1
		OptionButton 26, 36, 390, 18, "[目次登録(TC)]フィールドの設定 による目次登録", .OptionButton1
		OptionButton 26, 59, 390, 18, "[見出し*]スタイルの設定 による目次登録       ", .OptionButton2
		OptionButton 26, 83, 390, 18, "目次登録の解除                               ", .OptionButton3
	OKButton 37, 127, 88, 21, .OkButton
	CancelButton 174, 127, 88, 21, .CancelButton
	PushButton 312, 126, 88, 21, "About", .About
End Dialog
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	'
	Button = 1
	While Button = 1
		MsgBox ProgName$ + " : Menu", - 1
		Button = Dialog(MyMenuDialog)
		If Button = 1 Then
			MsgBox "プレーンテキストで目次を作成できるように、見出し行を検出して目次登録（見出しスタイル設定）します。" + Chr$(13) + Chr$(13) + "必要に応じ、バックアップを作成して下さい。" + Copyright$, ProgName$, 64
		EndIf
	Wend
	If Button = - 1 Then
		Select Case MyMenuDialog.OptionGroup1
			Case 0
				Call MarkHeading(1)' [目次登録(TC)]フィールドの設定
			Case 1
				Call MarkHeading(2)' [見出し*]スタイルの設定
			Case 2
				Call EraseTC_Field' ' [目次登録(TC)]フィールドの削除
				For Level = 9 To 1 Step - 1
					Call SetStandardStyle(Level)' [標準]スタイルの設定
				Next Level
		End Select
		MsgBox "処理を終了しました", ProgName$, 64
		MsgBox ProgName$ + " : Finished!", - 2
	Else
		MsgBox "キャンセルしました", ProgName$, 64
		MsgBox ProgName$ + " : Canceled", - 2
	End If
End Sub
'
Function MenuDialog(identifier$, action, suppvalue)
End Function
'
'
'
Sub MarkHeading(Method)' ##### 目次登録 #####
	' Method  1: [目次登録(TC)]フィールドの設定
	'         2: [見出し*]スタイルの設定
	MsgBox ProgName$ + "  Searching...", - 1
	SelType 1			' 選択解除
	StartOfDocument		' カーソルを文書の先頭に移動
	EndOfDoc = 0
	While EndOfDoc = 0
		'SelType 1' 選択解除
		'SelectCurSentence
		Call Select_Sentence
		Level = GetHeadingLevel(Selection$())
		If Level > 0 Then' 目次登録対象
			MsgBox "Last Heading:  " + Selection$(), - 1
			'MsgBox "Level: " + Str$(Level), - 1
			If Method = 1 Then' [目次登録(TC)]フィールドの設定
				EntryStr$ = Selection$()
				CharRight(1, 0)
				MarkTableOfContentsEntry .Entry = EntryStr$, .Level = Str$(Level)
			EndIf
			If Method = 2 Then' [見出し *]スタイルの設定
				Style_Name$ = "見出し" + Str$(Level)
				Style Style_Name$
				CharRight(1, 0)
			EndIf
		EndIf
		If CharRight(1) = 0 Then
			EndOfDoc = - 1
		EndIf
		If AtEndOfDocument() = - 1 Then
			EndOfDoc = - 1
		EndIf
	Wend
	StartOfDocument' カーソルを文書の先頭に移動
	MsgBox ProgName$ + "  Finished!", - 1
End Sub
'
'
'
Sub Select_Sentence' ##### 文章選択 #####
	' 『1.2.3. 注意』のような見出しの場合、SelectCurSentence
	' コマンドでは"1.2.3. "を選択してしまい、"注意"と分断
	' されてしまう。これを防ぐために、選択文字列の最後が空白
	' 文字の場合は、改行コードの直前まで選択範囲を広げる処理
	' を行う。（見出し行でない場合は無駄な処理であるが、
	' SelectCurParagraph のようなコマンドがないから仕方ない。
	' スマートな方法教えてちょんまげ〜！）
	SelType 1
	''MsgBox "Checking...", - 1
	SelectCurSentence
	GotText$ = Selection$()
	If GotText$ <> "" Then
		GotText$ = StrConv$(GotText$, 8)
		If Right$(GotText$, 1) = " " Then
			''MsgBox "Searching CR Code...", - 1
			ExitFlag = 0
			While ExitFlag = 0
				GotChar$ = GetText$(GetSelEndPos() - 1, GetSelEndPos())
				''MsgBox "RightChar=" + Str$(Asc(GotChar$)), 48
				If (GotChar$ = Chr$(10)) Or (GotChar$ = Chr$(13)) Then
					ExitFlag = - 1
				Else
					CharRight(1, 1)
				End If
			Wend
			CharLeft(1, 1)' 改行が含まれるので１文字戻す
		End If
	EndIf
End Sub
'
'
'
Sub EraseTC_Field' ##### [目次登録(TC)]フィールドの削除 #####
	MsgBox "Erasing [TC] Field...", - 1
	StartOfDocument
	SelType 1
	EditBookmark "Temp", .Add
	EditGoTo .Destination = "d'TC'"
	While CmpBookmarks("\Sel", "Temp") <> 0
		CharRight(1, 1)' [目次登録(TC)]フィールドの選択
		EditClear' 選択範囲の消去
		EditBookmark "Temp", .Add
		EditGoTo .Destination = "d'TC'"
	Wend
	EditBookmark "Temp", .Delete
	StartOfDocument
End Sub
'
'
'
Sub SetStandardStyle(Level)' ##### [標準]スタイルの設定 #####
	MsgBox "Changing [見出し" + Str$(Level) + "]Style to [標準]Style...", - 1
	StartOfDocument
	EditFindClearFormatting
	EditFindStyle .Style = "見出し" + Str$(Level)
	EditFind .Find = "", .Direction = 0, .Format = 1, .Wrap = 0
	While EditFindFound() = - 1
		FormatStyle .Name = "標準", .Apply
		SelType 1
		EditFindClearFormatting
		EditFindStyle .Style = "見出し" + Str$(Level)
		EditFind .Find = "", .Direction = 0, .Format = 1, .Wrap = 0
	Wend
	StartOfDocument
End Sub
'
'
'
Function GetHeadingLevel(TestStr$)' ##### 見出しレベルの取得 #####
	HankakuStr$ = StrConv$(TestStr$, 8)
	HeadBlock$ = GetHeadingLevelStr$(HankakuStr$)
	If HeadBlock$ <> "" Then
		GetHeadingLevel = GetHeadingLevel2(HeadBlock$)
	Else
		GetHeadingLevel = 0
	EndIf
End Function
'
'
'
Function GetHeadingLevel2(TestStr$)' ##### 見出しレベルの取得２(コア) #####
	Ans = 0
	L = Len(TestStr$)
	LastCharType = 0' 0/1/2: Undefined/数字/シンボル
	For I = 1 To L
		CharType = GetCharType(Mid$(TestStr$, I, 1))' 0/1/2: Undefined/数字/デリミタ
		If CharType = 1 Then
			If LastCharType <> 1 Then
				Ans = Ans + 1
			End If
		End If
		LastCharType = CharType
	Next I
	GetHeadingLevel2 = Ans
End Function
'
'
'
Function GetCharType(TestChar$)' ##### 文字タイプの取得 #####
	' 戻り値   1/2/0: 数字("0".."9") / シンボル(".","-") / その他
	Ans = 0
	If InStr(Numerics$, TestChar$) > 0 Then
		Ans = 1
	EndIf
	If InStr(Symboles$, TestChar$) > 0 Then
		Ans = 2
	End If
	GetCharType = Ans
End Function
'
'
'
Function GetHeadingLevelStr$(TestStr$)' ##### 見出しレベル文字列の取得 #####
	' 戻り値  TestStr$が見出し行の場合は見出しレベル文字列
	'         TestStr$が見出し行でない場合はヌル文字列
	'         例) TestStr$="1.2.3. 注意事項"のとき、戻り値は"1.2.3"
	Ans$ = ""
	SpacePos = InStr(TestStr$, " ")
	If SpacePos > 1 Then
		Ans$ = Left$(TestStr$, SpacePos - 1)
		If IsHeadingLevelStr(Ans$) = 0 Then
			Ans$ = ""
		End If
	End If
	GetHeadingLevelStr$ = Ans$
End Function
'
'
'
Function IsHeadingLevelStr(TestStr$)' ##### 見出しレベル文字列かどうかのチェック #####
	' TestStr$が見出しレベル文字列（数字とシンボルで構成）かどうかのチェック
	' 戻り値  -1/0: 見出しレベル文字列/非見出しレベル文字列
	L = Len(TestStr$)
	Ans = - 1
	For I = 1 To L
		TestChar$ = Mid$(TestStr$, I, 1)
		If InStr(Numerics$, TestChar$) = 0 And InStr(Symboles$, TestChar$) = 0 Then
			Ans = 0
		EndIf
	Next I
	IsHeadingLevelStr = Ans
End Function
'
'
' EndOfMacro