Permalink
Fetching contributors…
Cannot retrieve contributors at this time
189 lines (165 sloc) 6.15 KB
;;; w3m-tabmenu.el --- Functions for TAB menu browsing -*- coding: iso-2022-7bit; -*-
;; Copyright (C) 2001-2007, 2009, 2011-2012
;; TSUCHIYA Masatoshi <tsuchiya@namazu.org>
;; Authors: Hideyuki SHIRAI <shirai@meadowy.org>,
;; TSUCHIYA Masatoshi <tsuchiya@namazu.org>
;; Keywords: w3m, WWW, hypermedia
;; This file is a part of emacs-w3m.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; This file contains the functions for TAB browsing. For more detail
;; about emacs-w3m, see:
;;
;; http://emacs-w3m.namazu.org/
;;; Code:
(eval-when-compile
(require 'cl))
(require 'w3m-util)
(require 'w3m)
(require 'easymenu)
(defun w3m-setup-tab-menu ()
"Setup w3m tab menubar."
(when w3m-use-tab-menubar
(w3m-static-if (featurep 'xemacs)
(unless (car (find-menu-item current-menubar '("Tab")))
(easy-menu-define w3m-tab-menu w3m-mode-map
"" '("Tab" ["dummy" w3m-switch-buffer t]))
(easy-menu-add w3m-tab-menu)
(add-hook 'activate-menubar-hook 'w3m-tab-menubar-update))
(unless (lookup-key w3m-mode-map [menu-bar Tab])
(easy-menu-define w3m-tab-menu w3m-mode-map "" '("Tab"))
(easy-menu-add w3m-tab-menu)
(add-hook 'menu-bar-update-hook 'w3m-tab-menubar-update)))))
(defun w3m-switch-buffer ()
"Switch `w3m-mode' buffer in the current window."
(interactive)
(let ((items (w3m-tab-menubar-make-items 'nomenu))
(minibuffer-setup-hook
(append minibuffer-setup-hook '(beginning-of-line)))
(count 1)
(form "%s [%s]")
(completion-ignore-case t)
comp hist histlen default buf)
(dolist (item items)
(when (nth 2 item) ;; current-buffer
(setq default count))
(setq comp (cons
(cons
(format form (nth 1 item) (nth 0 item)) (nth 0 item))
comp))
(setq hist (cons (format form (nth 1 item) (nth 0 item)) hist))
(setq count (1+ count)))
(setq comp (nreverse comp))
(setq histlen (length hist))
(setq hist (append hist hist hist hist hist)) ;; STARTPOS at 3rd hist
(setq buf
(completing-read
"Switch to w3m buffer: "
comp nil t (car (nth (1- default) comp))
(cons 'hist (+ (* 3 histlen) (- histlen default -1)))
(car (nth (1- default) comp))))
(setq buf (cdr (assoc buf comp)))
(when (get-buffer buf)
(switch-to-buffer buf))))
(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-update ()
"Update w3m tab menubar."
(when (and (eq major-mode 'w3m-mode)
(w3m-static-if (featurep 'xemacs)
(frame-property (selected-frame) 'menubar-visible-p)
menu-bar-mode))
(easy-menu-define w3m-tab-menu w3m-mode-map
"The menu kepmap for the emacs-w3m tab."
(cons "Tab" (w3m-tab-menubar-make-items)))
(w3m-static-when (featurep 'xemacs)
(let ((items (car (find-menu-item current-menubar '("Tab")))))
(when items
(setcdr items (cdr w3m-tab-menu))
(set-buffer-menubar current-menubar))))))
(defvar w3m-tab-menubar-items-sub-coeff 30) ;; 30?
(defvar w3m-tab-menubar-items-width 50) ;; 50?
(defun w3m-tab-menubar-make-items-1 (buffers &optional nomenu)
(let ((i 0)
(current (current-buffer))
(width w3m-tab-menubar-items-width)
title unseen)
(mapcar
(lambda (buffer)
(if nomenu
(list (buffer-name buffer)
(format "%s%s"
(if (w3m-unseen-buffer-p buffer) "(u)" "")
(w3m-buffer-title buffer))
(eq buffer current))
(setq title (w3m-buffer-title buffer))
(setq unseen (w3m-unseen-buffer-p buffer))
(when (>= (string-width title) width)
(setq title
(concat (w3m-truncate-string title
(- width 3))
"...")))
(vector (format "%d:%s%s"
(incf i)
(cond ((eq buffer current) "* ")
(unseen "u ")
(t " "))
title)
`(w3m-tab-menubar-open-item ,(buffer-name buffer))
buffer)))
buffers)))
(defvar w3m-tab-menubar-make-items-precbuf nil)
(defvar w3m-tab-menubar-make-items-prebuflst nil)
(defvar w3m-tab-menubar-make-items-preurl nil)
(defvar w3m-tab-menubar-make-items-preitems nil)
(defun w3m-tab-menubar-force-update (&rest args)
(setq w3m-tab-menubar-make-items-preitems nil)
(w3m-tab-menubar-update))
(add-hook 'w3m-display-functions 'w3m-tab-menubar-force-update)
(defun w3m-tab-menubar-make-items (&optional nomenu)
"Create w3m tab menu items."
(let (menu buflst total max)
(if nomenu
(w3m-tab-menubar-make-items-1 (w3m-list-buffers) t)
(setq w3m-tab-button-menu-current-buffer (current-buffer))
(setq buflst (w3m-list-buffers))
(if (and w3m-tab-menubar-make-items-preitems
(eq w3m-tab-button-menu-current-buffer
w3m-tab-menubar-make-items-precbuf)
(equal w3m-tab-menubar-make-items-prebuflst buflst)
(equal w3m-tab-menubar-make-items-preurl w3m-current-url))
w3m-tab-menubar-make-items-preitems
(setq w3m-tab-menubar-make-items-precbuf
w3m-tab-button-menu-current-buffer)
(setq w3m-tab-menubar-make-items-prebuflst buflst)
(setq w3m-tab-menubar-make-items-preurl w3m-current-url)
(setq total (length buflst))
(setq max (- (frame-height (selected-frame))
w3m-tab-menubar-items-sub-coeff))
(if (< total max)
(setq menu (w3m-tab-menubar-make-items-1 buflst))
(setq menu (list `(,(w3m-make-menu-item "$B%?%V$NA*Br(B"
"Select TAB")
,@(w3m-tab-menubar-make-items-1 buflst)))))
(setq w3m-tab-menubar-make-items-preitems
(append menu
'("-")
'("-")
(w3m-make-menu-commands
w3m-tab-button-menu-commands)))))))
(provide 'w3m-tabmenu)
;;; w3m-tabmenu.el ends here