tab browser *MODOKI* on Meadow

[Hideyuki SHIRAI ( 白井秀行 ) <shirai@xxxxxxxxxxxxxxxxxxx>]

XEmacs も Emacs21 もタブブラウザになったのに、Meadow がタブブラ
ウザじゃないのはつまらないので、menu を使って、*もどき* を作って
みました。

easymenu を使ったら結構あっさり出来たのですが、その後、easymenu
を使わないバージョンに挑戦したら玉砕してしまいました。^^;;;

わたし、過去 menu を出すのは easymenu つかっているんですよね。ま
だまだがんばりますが、もう一回玉砕したら easymenu に依存しちゃっ
て良いですか？ (どの Emacs にもついていますよね)

# FSF Emacs なら大抵動くと思うけど、(日本人は) menu に日本語が出
# ないとつまらないですね。(Emacs21 は有沢さんに大感謝)

-- 
白井秀行＠ menu を直接いじるのは(ぼくにはとっても)難しい。。。;_;

(defcustom w3m-use-tab-menubar t
  "*If non-nil, use 'W3M-TAB' menubar like a tab browser."
  :group 'w3m
  :type 'boolean)

(add-hook 'w3m-mode-hook 'w3m-tab-menubar-setup)

(defun w3m-tab-menubar-open-item (buf)
  "Open w3m buffer from tab menubar."
  (interactive)
  (when (get-buffer buf)
    (switch-to-buffer buf)))

(defun w3m-tab-menubar-setup ()
  "Setup w3m tab menubar."
  (when w3m-use-tab-menubar
    (unless (lookup-key w3m-mode-map [menu-bar W3M-TAB])
      (require 'easymenu)
      (easy-menu-define w3m-tab-menubar
			w3m-mode-map
			"w3m tab menubar"
			(list "TAB" (w3m-tab-menubar-make-items)))
      (add-hook 'menu-bar-update-hook 'w3m-tab-menubar-update))))

(defun w3m-tab-menubar-update ()
  "Update w3m tab menubar."
  (when (eq major-mode 'w3m-mode)
    (easy-menu-change nil
		      "TAB"
		      (w3m-tab-menubar-make-items))))

(defsubst w3m-tab-menubar-pull-bufnum (bufname)
  (cond
   ((string= "*w3m*" bufname) 1)
   ((string-match "\\*w3m\\*<\\([0-9]+\\)>" bufname)
    (string-to-number (match-string 1 bufname)))
   (t 100)))

(defun w3m-tab-menubar-make-items ()
  "Create w3m tab menu items."
  (let ((cbuf (current-buffer))
	bufs title menus)
    (dolist (buf (buffer-list))
      (with-current-buffer buf
	(when (eq major-mode 'w3m-mode)
	  (setq title (cond
		       ((and (stringp w3m-current-title)
			     (not (string= w3m-current-title "<no-title>")))
			w3m-current-title)
		       ((stringp w3m-current-url)
			(directory-file-name
			 (if (string-match "^[^/:]+:/+" w3m-current-url)
			     (substring w3m-current-url (match-end 0))
			   w3m-current-url)))
		       (t "No title")))
	  (setq bufs (cons (list (buffer-name) title (eq cbuf buf)) bufs)))))
    (setq bufs
	  (sort bufs (lambda (x y)
		       (< (w3m-tab-menubar-pull-bufnum (car x))
			  (w3m-tab-menubar-pull-bufnum (car y))))))
    (dolist (elem  bufs)
      (setq menus
	    (cons
	     (vector (concat (if (nth 2 elem) "* " "  ")
			     (nth 1 elem))
		     ;; " [" (nth 0 elem) "]")
		     (list 'w3m-tab-menubar-open-item (nth 0 elem))
		     (get-buffer (nth 0 elem)))
	     menus)))
    (nreverse menus)))