(provide "my-buffer-bar-context-menu")

(defun replace-buffer-bar-context-menu ()
  (flet ((buf  () *buffer-bar-context-menu-buffer*)
         (bn   () (buffer-name *buffer-bar-context-menu-buffer*))
         (bfn  () (get-buffer-file-name *buffer-bar-context-menu-buffer*))
         (cbfn () (get-buffer-file-name))
         (sb   () (set-buffer (buffer-name *buffer-bar-context-menu-buffer*)))
         (check-init (&optional prog)
           (unless (and (get-buffer-file-name *buffer-bar-context-menu-buffer*)
                        (if prog (file-exist-p prog) t))
             :disable)))
    (setq *buffer-bar-context-menu*
          (define-popup-menu
            ;------------------------------
            (:item nil "送る(&T)..."
             #'(lambda () (interactive) (sb) (buffer-sendto-dialog))
             #'(lambda () (check-init)))
            (:item nil "www-mode で開く(&W)"
             #'(lambda () (interactive) (sb) (www-open-local-file (cbfn)))
             #'(lambda () (check-init)))
            (:item nil "ファイルを実行(&X)"
             #'(lambda () (interactive) (sb) (shell-execute (bn)))
             #'(lambda () (check-init)))
            ;------------------------------
            :sep
            (:item nil "バッファ名をコピー(&B)"
             #'(lambda () (interactive) (copy-to-clipboard (bn))))
            (:item nil "ファイル名(\\)をコピー(&F)"
             #'(lambda () (interactive)
                 (copy-to-clipboard (map-slash-to-backslash (bfn))))
             #'(lambda () (check-init)))
            (:item nil "ファイル名(/)をコピー(&S)"
             #'(lambda () (interactive) (copy-to-clipboard (bfn)))
             #'(lambda () (check-init)))
            ;------------------------------
            :sep
            (:item nil "ファイル名を変更(&R)"
             #'(lambda () (interactive) (sb) (my-rename))
             #'(lambda () (check-init)))
            (:item nil "ファイルを別名コピー(&O)"
             #'(lambda () (interactive) (sb) (my-file-copy))
             #'(lambda () (check-init)))
            ;------------------------------
            :sep
            (:item nil "ファイルを削除(&D)"
             #'(lambda () (interactive) (sb)
                 (and (no-or-yes-p (concat (cbfn) " を削除します。"))
                      (let ((deletefile (cbfn)))
                        (if (delete-file deletefile)
                            (message (concat deletefile " を削除した。"))))))
             #'(lambda () (check-init)))
            ;------------------------------
            :sep
            (:item nil "バイトコンパイル(&C)"
             #'(lambda () (interactive) (sb) (byte-compile-file (cbfn)))
             #'(lambda () (check-init)))
            ;------------------------------
            :sep
            (:item nil "すべて閉じる(&*)"
             #'(lambda () (interactive)
                 (and (yes-or-no-p "バッファを全部閉じますよ。")
                      (kill-all-buffers))))
            (:item nil "閉じる(&C)"
             #'(lambda ()
                 (interactive)
                 (kill-buffer *buffer-bar-context-menu-buffer*)))
            ))))

(add-hook '*init-app-menus-hook* #'replace-buffer-bar-context-menu)


;; カレントバッファのファイルをリネーム（元ファイルも削除）
(defun my-rename ()
  (interactive)
  (let ((oldfile (file-namestring (get-buffer-file-name))))
    (let ((oldpathfile (get-buffer-file-name))
          (newfile
           (read-string "変更後のファイル名: " :default oldfile)))
      (let ((newpathfile
             (merge-pathnames
              newfile
              (directory-namestring (get-buffer-file-name)))))
        (when (rename newpathfile)
          (save-buffer)
          (delete-file oldpathfile)
          (message
           (concat oldfile " を " newfile " にリネームした。")))))))

;; カレントバッファのファイルを別名コピー
(defun my-file-copy ()
  (interactive)
  (let ((oldfile (file-namestring (get-buffer-file-name))))
    (let ((oldpathfile (get-buffer-file-name))
          (newfile
           (read-string "コピー先のファイル名: " :default oldfile)))
      (let ((newpathfile
             (merge-pathnames
              newfile
              (directory-namestring (get-buffer-file-name)))))
        (if (file-exist-p newpathfile)
            (message-box
             (concat newpathfile " はもうあるのでコピーできない。"))
          (progn
            (copy-file oldpathfile newpathfile)
            (find-file newpathfile)
            (message (concat oldfile " を " newfile " にコピーした。"))))))))

[2003/05/21]

・*buffer-bar-context-menu* を書き換えてしまうことにした。

[2002/10/23]

・「ファイル名を変更」、「ファイルを別名コピー」の処理がマズかったのを修正した。

[2002/10/18]

・「ファイル名をコピー」とかで、 visit しているファイルのチェックをしなくてもよいとこでしていたのをやめた。
・「各種ブラウザで表示」は、buffer-sendto-dialog をつくって、 dialog box で選ぶようにした。
・「ファイル名を変更」をもうすこしだけまともにした（つもり）。