;;; w3m-tabmenu.el --- Functions for TAB menu browsing -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 2001-2007, 2009, 2011-2012 ;; TSUCHIYA Masatoshi ;; Authors: Hideyuki SHIRAI , ;; TSUCHIYA Masatoshi ;; 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 "タブの選択" "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