;;; -*- Mode: Lisp; Package: EDITOR -*-
;;;
;;; This file is part of xyzzy.
;;; modification // crayonzen [2023-04-12]09:21:49(+0900)

(provide "app-menu")

(in-package "editor")

(export '(*app-menu* *app-popup-menu* *menu-history-max*
	  *app-rectangle-popup-menu* *clipboard-char-encoding-popup-menu*
	  *dictionary-popup-menu* *paste-rectangle-popup-menu*
	  *command-bar-popup-menu* *mode-popup-menu* *mode-popup-else-menu*
	  make-char-encoding-popup-menu
	  add-file-history-to-menu
	  ;add-buffer-bar-context-menu-name
	  *menu-display-length*
	  *init-app-menus-hook*))

(defvar *app-menu* nil)
(defvar *app-popup-menu* nil)
(defvar *app-rectangle-popup-menu* nil)
(defvar *clipboard-char-encoding-popup-menu* nil)
(defvar *dictionary-popup-menu* nil)
(defvar *paste-rectangle-popup-menu* nil)
(defvar *command-bar-popup-menu* nil)
(defvar *mode-popup-menu* nil)
(defvar *mode-popup-else-menu* nil)

(defvar *recent-file-popup-menu* nil)
(defvar *recent-session-popup-menu* nil)

(defvar *menu-history-max* 9)

;(defvar *mend-encoding-popup-menu* nil)
;(defvar *mend-encoding-menu* nil)


(defvar *init-app-menus-hook* nil)

(defun init-app-menus ()

  (setq *clipboard-char-encoding-popup-menu*
	(make-char-encoding-popup-menu
	 #'(lambda (encoding)
	     (interactive)
	     (continue-pre-selection)
	     (setq *clipboard-char-encoding* encoding))
	 #'(lambda (encoding)
	     (and (eq *clipboard-char-encoding* encoding) :check))
	 *clipboard-char-encoding-list*))

  (setq *dictionary-popup-menu*
	(define-popup-menu ':dictionary-popup
	  (:item :tag-command "和英(&J)"
	   'lookup-j2e-dictionary-selection)
	  (:item :tag-command "読み(&R)"
	   'lookup-reading-dictionary-selection)
	  (:item :tag-command "英和(&E)"
	   'lookup-e2j-dictionary-selection)
	  (:item :tag-command "熟語(&I)"
	   'lookup-idiom-dictionary-selection)
	  (:sep :above-edict-mode)
	  (:item :tag-command "辞書引きモード(&D)"
	   'edict-mode
	   #'(lambda () (if edict-mode :check)))))

  (setq *paste-rectangle-popup-menu*
	(define-popup-menu ':paste-rectangle-popup
	  (:item :tag-command "挿入(&I)"
	   'yank-rectangle
	   #'(lambda () (unless *rectangle-kill-buffer* :disable)))
	  (:item :tag-command "上書き(&O)"
	   'overwrite-rectangle
	   #'(lambda () (unless *rectangle-kill-buffer* :disable)))
	  (:item :tag-command "行末へ追加(&A)"
	   'append-rectangle
	   #'(lambda () (unless *rectangle-kill-buffer* :disable)))
	  (:item :tag-command "文字列にして挿入(&R)"
	   'yank-rectangle-as-region
	   #'(lambda () (unless *rectangle-kill-buffer* :disable)))))

  (setq *app-popup-menu*
	(define-popup-menu
	  (:item :tag-command "切り取り(&T)"
	   'kill-selection-to-clipboard :modify-any-selection)
	  (:item :tag-command "コピー(&C)"
	   'copy-selection-to-clipboard :any-selection)
	  (:item :tag-command "貼り付け(&P)"
	   'paste-from-clipboard :clipboard)
	  (:item :tag-command "貼り付け - 矩形(&G)"
	   'paste-rectangle-from-clipboard :clipboard)
	  (:menu nil "クリップボードエンコーディング(&E)"
	   *clipboard-char-encoding-popup-menu*)
	  (:item :tag-command "削除(&D)"
	   'delete-selection :modify-any-selection)
	  (:item :tag-command "全てを選択(&A)"
	   'selection-whole-buffer)

	  ;;crayonzen
	  ;(:popup :selection-leave-popup "再選択(&L)"
	  (:item :tag-command "再選択・戻る(&L)"
	   'goto-selection-leave-or-back
	   #'(lambda () (unless markermp :disable)))
	  ;;	  (:item :tag-command "再選択から戻る(&B)"
	  ;;	   'back-selection-leave
	  ;;	   #'(lambda () (unless currentp :disable)))
	  (:item :tag-command "選択の残像[色：背景15](&V)"
	   'selection-leave-exchange
	   #'(lambda () (when *selection-leave* :check)))
	  ;)

	  (:sep :above-dictionary-popup-menu)
	  (:menu nil "辞書(&I)"
	   *dictionary-popup-menu*)
	  (:menu nil "矩形貼り付け(&R)"
	   *paste-rectangle-popup-menu*)
	  (:sep :above-window)
	  (:item :tag-command "横に分割(&S)"
	   'split-window 'split-window-menu-update)
	  (:item :tag-command "縦に分割(&V)"
	   'split-window-vertically 'split-window-menu-update)
	  (:item :tag-command "他のウィンドウを閉じる(&O)"
	   'delete-other-windows 'close-window-menu-update)
	  (:item :tag-command "現在のｳｨﾝﾄﾞｳを閉じる(&C)"
	   'delete-window 'close-window-menu-update)
	  ))

  (setq *app-rectangle-popup-menu*
	(define-popup-menu
	  (:item :tag-command "切り取り(&T)"
	   'kill-rectangle-selection :modify-rectangle)
	  (:item :tag-command "コピー(&C)"
	   'copy-rectangle-selection :rectangle)
	  (:menu nil "貼り付け(&P)"
	   *paste-rectangle-popup-menu*)
	  (:item :tag-command "削除(&D)"
	   'delete-rectangle-selection :modify-rectangle)
	  (:item :tag-command "クリア(&R)"
	   'clear-rectangle-selection :modify-rectangle)
	  (:item :tag-command "空白を挿入(&O)"
	   'open-rectangle-selection :modify-rectangle)
	  (:item :tag-command "文字列で置き換え(&S)"
	   'string-rectangle-selection :modify-rectangle)))

  (or *command-bar-popup-menu*
      (setq *command-bar-popup-menu* (create-popup-menu ':command-bar-popup)))

  (or *mode-popup-menu*
      (setq *mode-popup-menu* (create-popup-menu 'mode-popup)))
  (or *mode-popup-else-menu*
      (setq *mode-popup-else-menu* (create-popup-menu 'mode-popup-else)))

  (or *recent-file-popup-menu*
      (setq *recent-file-popup-menu* (create-popup-menu ':recent-file-popup)))
  (or *recent-session-popup-menu*
      (setq *recent-session-popup-menu* (create-popup-menu ':recent-session-popup)))

  (setq *app-menu*
	(define-menu
	  (:popup 'file "ファイル(&F)"
	   (:item :tag-command "新規作成(&N)"
	    'new-file)
	   (:item :tag-command "開く(&O)..."
	    'open-file-dialog)

	   (:item :tag-command "閉じる(&C)"
	    'close-selected-buffer
	    #'(lambda ()
		(if (= (count-buffers) 1) :disable)))
	   ;;crayonzen
	   (:item :tag-command "選択ファイルより下[右]を全て閉じる(&K)"
	    'close-all-buffer-next)
	   (:item :tag-command "選択ファイル以外を全て閉じる(&E)"
	    'close-all-buffer-except-current)
	   (:item :tag-command "〜を全て閉じるを戻す(&J)"
	    'restore-close-all-buffer
	    #'(lambda () (or *delete-buffer-list* :disable)))

	   (:sep :delete-current-file)
	   (:item :tag-command "選択ファイルをゴミ箱へ削除(&G)"
	    'delete-current-file)
	   (:sep :above-save)

	   (:item :tag-command "上書き保存(&S)"
	    'save-buffer-dialog :modified)
	   (:item :tag-command "名前を付けて保存(&A)..."
	    'save-as-dialog)
	   (:item :tag-command "ファイルの挿入(&I)..."
	    'insert-file-dialog)
	   (:item :tag-command "名前の変更(&R)..."
	    'rename-dialog)
	   (:item :tag-command "全て保存(&V)"
	    'save-all-buffers)
	   (:item :tag-command "復帰(&B)"
	    'revert-buffer)
	   (:sep :above-session)
	   (:item :tag-command "セッションを開く(&D)..."
	    'open-session-dialog)
	   (:item :tag-command "セッションの保存(&W)..."
	    'save-session-dialog)
	   (:item :tag-command "セッションの自動保存(&T)"
	    'toggle-session-auto-save
	    'update-session-auto-save-ui)
	   (:item :tag-command "セッションを閉じる(&Y)"
	    'close-session-dialog)
	   (:sep :above-print)
	   (:item :tag-command "印刷(&P)..."
	    'print-selected-buffer-dialog)
	   (:sep :above-recent)
	   ;;crayonzen
	   (:item 'delete-file-list-dialog-box1 "最近使ったファイル(&F)..."
	    #'(lambda () (interactive) (delete-file-list-dialog-box 1)))
	   (:item 'delete-file-list-dialog-box2 "最近閉じたファイル(&H)..."
	    #'(lambda () (interactive) (delete-file-list-dialog-box 2)))
	   ;;	   (:menu nil "最近使ったファイル(&F)"
	   ;;	    *recent-file-popup-menu*)

	   (:menu nil "最近使ったセッション(&L)"
	    *recent-session-popup-menu*)
	   (:sep :above-kill-xyzzy)
	   (:item :tag-command "保存して終了(&Q)"
	    'save-all-buffers-kill-xyzzy)
	   (:item :tag-command "終了(&X)"
	    'kill-xyzzy))

	  (:popup 'edit "編集(&E)"
	   (:item :tag-command "元に戻す(&U)"
	    'un_do :undo)
	   (:item :tag-command "やっぱり元に戻さない(&R)"
	    're_do :redo)
	   (:item :tag-command "全て元に戻す"
	    'undo-all :undo)
	   (:item :tag-command "全てやっぱり元に戻さない"
	    'redo-all :redo)
	   (:sep :above-selection)
	   (:item :tag-command "切り取り(&T)"
	    'kill-selection-to-clipboard :modify-any-selection)
	   (:item :tag-command "コピー(&C)"
	    'copy-selection-to-clipboard :any-selection)
	   (:item :tag-command "貼り付け(&P)"
	    'paste-from-clipboard :clipboard)
	   (:item :tag-command "貼り付け - 矩形(&G)"
	    'paste-rectangle-from-clipboard :clipboard)
	   (:menu nil "クリップボードエンコーディング(&E)"
	    *clipboard-char-encoding-popup-menu*)
	   (:item :tag-command "削除(&D)"
	    'delete-selection :modify-any-selection)
	   (:item :tag-command "全てを選択(&A)"
	    'selection-whole-buffer)
	   ;;crayonzen
	   ;(:popup :selection-leave-popup "再選択(&L)"
	   (:item :tag-command "再選択・戻る(&L)"
	    'goto-selection-leave-or-back
	    #'(lambda () (unless markermp :disable)))
	   ;;	    (:item :tag-command "再選択から戻る(&B)"
	   ;;	     'back-selection-leave
	   ;;	    #'(lambda () (unless currentp :disable)))
	   (:item :tag-command "選択の残像[色：背景15](&I)"
	    'selection-leave-exchange
	    #'(lambda () (when *selection-leave* :check)))
	   ;)

	   (:sep :above-rectangle)
	   (:menu nil "矩形(&N)"
	    *app-rectangle-popup-menu*)
	   (:popup :convert-popup "変換(&V)"
	    (:item :tag-command "大文字(&U)"
	     'upcase-selection :selection)
	    (:item :tag-command "小文字(&L)"
	     'downcase-selection :selection)
	    (:item :tag-command "単語の先頭を大文字(&C)"
	     'capitalize-selection :selection)
	    (:sep :above-space-tab)
	    (:item :tag-command "スペース -> タブ(&T)"
	     'tabify-selection :selection)
	    (:item :tag-command "タブ -> スペース(&S)"
	     'untabify-selection :selection)
	    (:sep :above-full->half)
	    (:popup :full->half-popup "全角 -> 半角(&H)"
	     (:item :tag-command "すべて(&A)"
	      'map-all-to-half-width-selection :selection)
	     (:item :tag-command "英数・ひらがな・カタカナ(&S)"
	      'map-to-half-width-selection :selection)
	     (:item :tag-command "英数・ひらがな(&R)"
	      'map-ascii-and-hiragana-to-half-width-selection :selection)
	     (:item :tag-command "英数・カタカナ(&T)"
	      'map-ascii-and-katakana-to-half-width-selection :selection)
	     (:item :tag-command "英数(&N)"
	      'map-ascii-to-half-width-selection :selection)
	     (:item :tag-command "ひらがな(&H)"
	      'map-hiragana-to-half-width-selection :selection)
	     (:item :tag-command "カタカナ(&K)"
	      'map-katakana-to-half-width-selection :selection)
	     (:item :tag-command "ギリシア文字(&G)"
	      'map-greek-to-half-width-selection :selection)
	     (:item :tag-command "キリル文字(&C)"
	      'map-cyrillic-to-half-width-selection :selection))
	    (:popup :half->full-popup "半角 -> 全角(&Z)"
	     (:item :tag-command "すべて(ｶﾅ -> ひらがな)(&A)"
	      'map-all-to-full-width-hiragana-selection :selection)
	     (:item :tag-command "すべて(ｶﾅ -> カタカナ)(&L)"
	      'map-all-to-full-width-katakana-selection :selection)
	     (:item :tag-command "英数・ｶﾅ(ｶﾅ -> ひらがな)(&R)"
	      'map-to-full-width-hiragana-selection :selection)
	     (:item :tag-command "英数・ｶﾅ(ｶﾅ -> カタカナ)(&T)"
	      'map-to-full-width-katakana-selection :selection)
	     (:item :tag-command "英数(&N)"
	      'map-ascii-to-full-width-selection :selection)
	     (:item :tag-command "ｶﾅ -> ひらがな(&H)"
	      'map-kana-to-full-width-hiragana-selection :selection)
	     (:item :tag-command "ｶﾅ -> カタカナ(&K)"
	      'map-kana-to-full-width-katakana-selection :selection)
	     (:item :tag-command "ギリシア文字(&G)"
	      'map-greek-to-full-width-selection :selection)
	     (:item :tag-command "キリル文字(&C)"
	      'map-cyrillic-to-full-width-selection :selection))
	    (:popup :char-encoding-popup "漢字コード(&K)"
	     (:item :tag-command "自動判定(&A)"
	      'map-char-encoding-selection :selection)
	     (:item :tag-command "JISから(&J)"
	      'map-jis-selection :selection)
	     (:item :tag-command "EUCから(&E)"
	      'map-euc-selection :selection)))
	   (:popup :paragraph-popup "段落(&H)"
	    (:item :tag-command "前の段落(&B)"
	     'backward-paragraph)
	    (:item :tag-command "次の段落(&F)"
	     'forward-paragraph)
	    (:item :tag-command "選択(&S)"
	     'selection-paragraph)
	    (:item :tag-command "削除(&L)"
	     'kill-paragraph)
	    (:item :tag-command "入れ替え(&T)"
	     'transpose-paragraphs)
	    (:item :tag-command "詰め込み(&I)"
	     'fill-paragraph))
	   (:sep :above-not-modified)
	   (:item :tag-command "変更マークを消す(&X)"
	    'not-modified :modified)
	   (:sep :above-mode)
	   (:menu nil "モード(&M)"
	    *mode-popup-menu*)
	   (:sep :above-sort)
	   (:item :tag-command "ソート(&Q)"
	    'sort-lines-buffer)
	   (:item :tag-command "ソート逆順(&Z)"
	    'sort-lines-buffer-reverse)
	   (:sep :above-count-char)
	   (:item :tag-command "文字数(&W)"
	    'count-char))

	  (:popup 'search "検索(&S)"
	   (:item :tag-command "検索(&F)..."
	    'search-dialog)
	   (:item :tag-command "次を検索(&N)"
	    'repeat-forward-search
	    #'(lambda () (or *last-search-p* :disable)))
	   (:item :tag-command "前を検索(&P)"
	    'repeat-backward-search
	    #'(lambda () (or *last-search-p* :disable)))
	   (:item :tag-command "置換(&R)..."
	    'replace-dialog)
	   (:item :tag-command "一致する文字列を数える(&C)..."
	    'count-matches-dialog)
	   (:item :tag-command "色つけ削除(&A)"
	    'clear-search-text-attribute)
	   (:sep :above-first-error)
	   (:item :tag-command "最初のタグ(&I)"
	    'first-error)
	   (:item :tag-command "次のタグ(&E)"
	    'next-error)
	   (:item :tag-command "前のタグ(&R)"
	    'previous-error)
	   (:sep :above-goto-line)
	   (:item :tag-command "指定行(&J)..."
	    'goto-line-dialog)
	   (:item :tag-command "ファイルの先頭(&T)"
	    'beginning-of-buffer)
	   (:item :tag-command "ファイルの最後(&B)"
	    'end-of-buffer)
	   ;;	   (:item :tag-command "マーク(&M)..."
	   ;;	    'mark-dialog-box)
	   (:item :tag-command "関数の先頭(&D)"
	    'beginning-of-defun)
	   (:item :tag-command "関数の最後(&U)"
	    'end-of-defun)
	   (:sep :above-gresreg)
	   (:item :tag-command "Gresreg(&S)..."
	    'gresreg-dialog)
	   (:item :tag-command "
Grep(&G)..."
	    'grep-dialog)
	   ;;crayonzen
	   (:sep :above-grep-search)
	   (:item :tag-command "GrepBuffer(&X)..."
	    'grep-search-dialog))

	  ;;crayonzen
	  (:popup 'hmark "マーク(&M)"
	   ;;	   (:item :tag-command "マーク <Ctrl+@>or<Ctrl+Space>(&C)"
	   ;;	    'set-mark-command)
	   ;;	   (:item :tag-command "■マーク位置へ・戻る(&G)"
	   ;;	    'cmark-goto-mark-and-return
	   ;;	    #'(lambda() (unless (mark t) :disable)))
	   (:item :tag-command "■マーク位置へ(&G)"
	    'cmark-goto-mark
	    #'(lambda () (unless (mark t) :disable)))
	   (:item :tag-command "□戻る(&R)"
	    'cmark-goto-return
	    #'(lambda () (unless *save-current-point* :disable)))
	   (:item :tag-command "〓マーク(&V)..."
	    'cmark-dialog-box
	    #'(lambda () (when *cmark-history-save* :check)))
	   (:sep :above-hmark)
	   ;;	   (:item :tag-command "ﾏｰｸ追加 <Shift+Ctrl+Space>(&P)"
	   ;;	    'set-hmark-add)
	   (:item :tag-command "マーク記録(&M)..."
	    'hmark-dialog-box)
	   ;;	   (:sep :above-save-hmark)
	   ;;	   (:popup 'save-read-mark-file "ﾏｰｸファイル：保存：読み込み(&F)"
	   ;;	    (:item :tag-command "ﾏｰｸファイル：保存(&S)"
	   ;;	     'save-mark-history-file)
	   ;;	    (:item :tag-command "ﾏｰｸファイル：読み込み(&R)"
	   ;;	     'read-mark-history-file-dialog)
	   ;;	    (:item :tag-command "ﾏｰｸファイル：読み込み追加(&A)"
	   ;;	     'read-mark-history-file-add-dialog))
	   (:sep :above-about-hmark)
	   (:item :tag-command "〜マーク記録について(&Z)..."
	    'about-hmark))

	  (:popup 'view "表示(&V)"
	   (:item :tag-command "折り返さない(&N)"
	    'set-buffer-fold-type-none
	    'set-buffer-fold-type-none-update)
	   (:item :tag-command "指定位置で折り返す(&C)"
	    'set-buffer-fold-type-column
	    'set-buffer-fold-type-column-update)
	   (:item :tag-command "ウィンドウ幅で折り返す(&W)"
	    'set-buffer-fold-type-window
	    'set-buffer-fold-type-window-update)
	   (:sep :above-command-bar)
	   (:menu nil "ツールバー(&Q)" *command-bar-popup-menu*)
	   (:sep :above-frame)
	   (:item :tag-command "新しいフレーム(&F)"
	    'new-pseudo-frame 'new-pseudo-frame-menu-update)
	   (:item :tag-command "現在のフレームを閉じる(&D)"
	    'delete-pseudo-frame 'pseudo-frame-menu-update)
	   (:item :tag-command "次のフレーム(&T)"
	    'other-pseudo-frame 'pseudo-frame-menu-update)
	   (:item :tag-command "前のフレーム(&R)"
	    'previous-pseudo-frame 'pseudo-frame-menu-update)
	   ;;crayonzen
	   (:sep :above-control-character-view)
	   (:item :tag-command "制御文字表示(&V)"
	    'control-character-view
	    #'(lambda () (if *control-character-view* :check)))
	   (:item :tag-command "制御文字表示デフォルト(&X)"
	    'control-character-view-default)
	   )
	  ;;	   (:sep :above-lisp-tool-view)
	  ;;	   (:item :tag-command "LispTool(&L)"
	  ;;	    'lisp-tool-view
	  ;;	    #'(lambda () (when *lisp-tool-view-menu* :check)))

	  (:popup 'window "ウィンドウ(&W)"
	   (:item :tag-command "横に分割(&S)"
	    'split-window 'split-window-menu-update)
	   (:item :tag-command "縦に分割(&V)"
	    'split-window-vertically 'split-window-menu-update)
	   (:item :tag-command "他のウィンドウを閉じる(&O)"
	    'delete-other-windows 'close-window-menu-update)
	   (:item :tag-command "現在のウィンドウを閉じる(&C)"
	    'delete-window 'close-window-menu-update)
	   (:item :tag-command "次のウィンドウ(&N)"
	    'other-window 'move-window-menu-update)
	   (:item :tag-command "前のウィンドウ(&P)"
	    'move-previous-window 'move-window-menu-update)
	   (:sep :above-next-xyzzy)
	   (:item :tag-command "次のxyzzy(&X)"
	    'next-xyzzy-window
	    #'(lambda () (if (< (count-xyzzy-instance) 2) :disable)))
	   (:item :tag-command "前のxyzzy(&Y)"
	    'previous-xyzzy-window
	    #'(lambda () (if (< (count-xyzzy-instance) 2) :disable)))
	   (:item :tag-command "xyzzy選択(&Z)..."
	    'select-xyzzy
	    #'(lambda () (if (< (count-xyzzy-instance) 2) :disable)))
	   (:sep :above-select-buffer)
	   (:item :tag-command "バッファ選択(&B)..."
	    'select-buffer)
	   ;;crayonzen
	   (:item :tag-command "BufferMenu <Ctrl+x Ctrl+b>(&M)"
	    'buffer-menu)
	   (:sep :close-all-buffer-next)
	   (:item :tag-command "現在のファイルより下側[右側]を全て閉じる(&K)"
	    'close-all-buffer-next-tab)
	   (:item :tag-command "現在のファイル以外を全て閉じる(&E)"
	    'close-all-buffer-except-current-tab)
	   (:item :tag-command "一時バッファを残す[*xxxx*](&L)"
	    'leave-temp-buffer-toggle
	    #'(lambda () (when *leave-temp-buffer* :check)))
	   (:item :tag-command "〜を全て閉じるを戻す(&J)"
	    'restore-close-all-buffer
	    #'(lambda () (or *delete-buffer-list* :disable)))
	   (:sep :above-current-copy-current-file)
	   (:item :tag-command "現在のファイル名をコピー(&F)"
	    'copy-current-file-name)
	   (:item :tag-command "現在のファイルの場所を開く(&O)"
	    'open-file-directory)
	   (:item :tag-command "現在のファイルを関連付けのアプリケーションで開く(&H)"
	    'shell-execut-current-file)
	   (:sep :above-delete-current-file)
	   (:item :tag-command "現在のファイルをゴミ箱へ削除(&G)"
	    'delete-current-file))

	  (:popup 'tools "ツール(&T)"
	   (:item :tag-command "コンソールプログラムを非同期で実行(&A)..."
	    'execute-subprocess-dialog)
	   (:item :tag-command "非同期プログラムを死なす(&K)"
	    'kill-subprocess
	    #'(lambda ()
		(let ((proc (buffer-process (selected-buffer))))
		  (unless (and proc
			       (eq (process-status proc) :run))
		    :disable))))
	   (:item :tag-command "コンソールプログラムの実行(&P)..."
	    'pipe-command-dialog)
	   (:item :tag-command "Windowsプログラムの実行(&W)..."
	    'launch-application-dialog)
	   (:item :tag-command (if (featurep :windows-nt)
				   "NTプロンプト(&D)"
				 "DOSプロンプト(&D)")
	    'run-console)
	   (:sep :above-kbd-macro)
	   (:item :tag-command "キーボードマクロ記録開始(&S)"
	    'start-kbd-macro)
	   (:item :tag-command "キーボードマクロ記録終了(&E)"
	    'end-kbd-macro
	    :end-macro)
	   (:item :tag-command "キーボードマクロ実行(&X)"
	    'call-last-kbd-macro
	    #'(lambda () (if (null *last-kbd-macro*) :disable)))
	   (:item :tag-command "キーボードマクロ実行〜指定回数分(&X)..."
	    'call-last-kbd-macro-dotimes
	    #'(lambda () (if (null *last-kbd-macro*) :disable)))
	   (:popup :kbd-macro-popup "キーボードマクロおまけ(&O)"
	    (:item :tag-command "保存(&V)..."
	     'save-last-kbd-macro
	     #'(lambda () (if (null *last-kbd-macro*) :disable)))
	    (:item :tag-command "読み込み(&L)..."
	     'load-kbd-macro)
	    (:item :tag-command "ファイルへ保存(&S)..."
	     'save-kbd-macro-to-file))
	   (:sep :above-property-sheet)
	   (:item :tag-command "共通設定(&C)..."
	    'option-property-sheet)
	   (:item :tag-command "ローカル設定(&L)..."
	    'local-option-property-sheet)
	   (:sep :above-box-drawings)
	   (:item :tag-command "罫線モード(&R)"
	    'box-drawings-mode
	    #'(lambda () (if *box-drawings-mode* :check)))
	   (:item :tag-command "太い罫線(&T)"
	    'box-drawings-toggle-line-type
	    #'(lambda ()
		(values (unless *box-drawings-mode*
			  :disable)
			(if (eq *box-drawings-line-type* '*box-drawings-thick-line*)
			    :check))))
	   (:sep :above-insert-date)
	   (:item :tag-command "日付と時刻の挿入(&M)..."
	    'insert-date-string)
	   (:item :tag-command "ファイラ(&F)..."
	    'open-filer)
	   (:menu nil "辞書(&I)"
	    *dictionary-popup-menu*)
	   (:sep :above-make-tags)
	   (:item :tag-command "TAGSファイルの作成(&G)..."
	    'make-tags-file-dialog)
	   (:item :tag-command "タグジャンプ(&J)"
	    'jump-tag
	    #'(lambda () (unless (and tags-find-target tags-find-point) :disable)))
	   (:item :tag-command "ダイレクトタグジャンプ(&U)"
	    'direct-tag-jump
	    #'(lambda () (unless (and tags-find-target tags-find-point) :disable)))
	   (:item :tag-command "バックタグジャンプ(&B)"
	    'back-tag-jump
	    #'(lambda () (if (null *global-mark-list*) :disable)))
	   (:sep :|above-(>_<)|)
	   (:popup :|(>_<)-popup| "(>&_<)"
	    (:item :tag-command "ニフティのログを読む(&N)"
	     'view-nifty-log)
	    (:item :tag-command "電卓(&T)"
	     'calc)
	    (:item :tag-command "カレンダー(&A)"
	     'calendar)
	    (:item :tag-command "ハノイの塔(&H)"
	     'hanoi)
	    (:item :tag-command "五目(&G)"
	     'gomoku)
	    (:item :tag-command "ライフ(&L)"
	     'life)
	    (:item :tag-command "C曲線(&C)"
	     'c-curve)
	    (:item :tag-command "ドラゴン曲線(&R)"
	     'dragon-curve)))

	  (:popup 'help "ヘルプ(&?)"
	   (:item :tag-command "キー割り当て一覧(&K)"
	    'describe-bindings)
	   (:item :tag-command "最近入力したキー(&L)"
	    'view-lossage)
	   (:item :tag-command "PC起動経過時間(&N)"
	    'insert-pc-internal-time)
	   (:sep :above-about)
	   (:item :tag-command "について(&A)..."
	    'about-dialog))))

  (setq *buffer-bar-context-menu*
	(define-popup-menu
	  (:item 'close "閉じる(&C)"
	   #'(lambda ()
	       (interactive)
	       (setq name (buffer-name *buffer-bar-context-menu-buffer*))
	       (if (kill-buffer *buffer-bar-context-menu-buffer*)
		   (message "Closed: ~S" name))))
	  ;;crayonzen
	  (:sep :close-all-buffer-next)
	  (:item :tag-command "下側[右側]を全て閉じる(&K)"
	   'close-all-buffer-next-tab)
	  (:item :tag-command "他を全て閉じる(&E)"
	   'close-all-buffer-except-current-tab)
	  (:item :tag-command "〜を全て閉じるを戻す(&J)"
	   'restore-close-all-buffer
	   #'(lambda () (or *delete-buffer-list* :disable)))
	  (:sep :above-current-copy-current-file)
	  (:item :tag-command "ファイル名をコピー(&F)"
	   #'(lambda ()
	       (interactive)
	       (copy-current-file-name *buffer-bar-context-menu-buffer*)))
	  (:item :tag-command "ファイルの場所を開く&O)"
	   #'(lambda ()
	       (interactive)
	       (open-file-directory *buffer-bar-context-menu-buffer*)))
	  (:item :tag-command "ファイルを関連付けのアプリケーションで開く(&H)"
	   #'(lambda ()
	       (interactive)
	       (shell-execut-current-file *buffer-bar-context-menu-buffer*)))
	  (:sep :above-delete-current-file)
	  (:item :tag-command "ファイルをゴミ箱へ削除(&G)"
	   #'(lambda ()
	       (interactive)
	       (delete-current-file *buffer-bar-context-menu-buffer*)))
	  ))

  (run-hooks '*init-app-menus-hook*)
  (set-menu *app-menu*)
  (add-file-history-to-menu)
  (add-session-history-to-menu)
  (add-mode-menu)
  ;(add-buffer-bar-context-menu-name)
  )

(defun make-char-encoding-popup-menu (command &optional init (list *char-encoding-list*))
  (labels ((define-menu (list)
	     (let ((menu (create-popup-menu)))
	       (mapc #'(lambda (encoding)
			 (if (consp encoding)
			     (add-popup-menu menu
					     (define-menu (cdr encoding))
					     (car encoding))
			   (add-menu-item menu nil
					  (char-encoding-display-name encoding)
					  #'(lambda ()
					      (interactive)
					      (funcall command encoding))
					  (and init #'(lambda ()
							(funcall init encoding))))))
		     list)
	       menu)))
    (define-menu
      (if (eq list *char-encoding-list*)
	  *char-encoding-tree*
	(labels ((make-tree (tree list)
		   (mapcan #'(lambda (encoding)
			       (if (consp encoding)
				   (let ((l (make-tree (cdr encoding) list)))
				     (and l (list (cons (car encoding) l))))
				 (and (find encoding list :test #'eq)
				      (list encoding))))
			   tree)))
	  (make-tree
	   *char-encoding-tree*
	   (mapcar #'(lambda (encoding)
		       (if (symbolp encoding) (symbol-value encoding) encoding))
		   list)))))))
#|
(defun menu-display-name (path maxlen)
  (when (<= (length path) maxlen)
    (return-from menu-display-name path))
  (let* ((unc )
	 (paths (split-string path #\/))
	 (dev (cond ((eql (string/= path "//") 2)
		     (prog1
			 (concat "//" (car paths) "/" (cadr paths))
		       (setq paths (cddr paths))))
		    (t
		     (pop paths))))
	 (name (progn
		 (setq paths (nreverse paths))
		 (pop paths)))
	 (len (+ (length dev) (length name) 5)))
    (unless name
      (return-from menu-display-name path))
    (when (> len maxlen)
      (return-from menu-display-name name))
    (do* ((npaths nil)
	  (l (length (car paths)) (length (car paths))))
	((> (setq len (+ len l 1)) maxlen)
	 (format nil "~A/.../~{~A/~}~A" dev npaths name))
      (push (pop paths) npaths))))
|#

(defvar *menu-display-length* 40)

(defun add-lru-menu (menu files fn)
  (when (menup menu)
    (while (delete-menu menu 0 t))
    (do ((file files (cdr file))
	 (count 1))
	((or (null file)
	     (> count *menu-history-max*))
	 t)
      (unless (wild-pathname-p (car file))
	(let ((filename (namestring (car file))))
	  (insert-menu-item menu (1- count) nil
			    (format nil "&~:(~35r~): ~a"
				    (rem count 36)
				    (quote-string
				     (abbreviate-display-string
				      filename *menu-display-length* t)
				     #\& #\&))
			    (funcall fn filename)))
	(incf count)))))

(defun add-file-history-to-menu ()
  (when (menup *app-menu*)
    (add-lru-menu *recent-file-popup-menu*
		  *minibuffer-file-name-history*
		  #'(lambda (filename)
		      #'(lambda ()
			  (interactive)
			  (find-file filename)
			  (add-history filename '*minibuffer-file-name-history*))))))

#|
;;crayonzen
(defun add-buffer-bar-context-menu-name ()
  (when (and (menup *app-menu*)
	     (menup *buffer-bar-context-menu*))
    (flet ((add-buffer-bar-name (menu buffername)
	     (let ((menu menu)
		   (buffername buffername))
	       (while (delete-menu menu 0 t))
	       (insert-menu-item menu 0 nil
				 "閉じる(&C)"
				 #'(lambda ()
				     (interactive)
				     (kill-buffer *buffer-bar-context-menu-buffer*)))
	       (insert-menu-item menu 1 nil
				 (format nil "~a" buffername)
				 #'(lambda ()
				     (interactive)
				     (copy-current-file-name *buffer-bar-context-menu-buffer*))
				 ))))
      (add-buffer-bar-name *buffer-bar-context-menu*
			   (buffer-name *buffer-bar-context-menu-buffer*))
      )
    )
  )
|#
