#+BEGIN_SRC emacs-lisp :tangle yes
(if (>= emacs-major-version 24)
(progn
- (add-to-list 'load-path "~/.emacs.d/elpa/popwin-20150315.600")
- (add-to-list 'load-path "~/.emacs.d/elpa/guide-key-20150107.2235")
+ (add-to-list 'load-path "~/.emacs.d/elpa/popwin-20150315.1300")
+ (add-to-list 'load-path "~/.emacs.d/elpa/guide-key-20150108.635")
(require 'guide-key)
(setq guide-key/guide-key-sequence '("C-x" "C-x C-k" "C-x 4" "C-c" "C-h" "C-x l" "<ESC>" "<f9>"))
(setq guide-key/recursive-key-sequence-flag t)
+++ /dev/null
-;;; guide-key-autoloads.el --- automatically extracted autoloads
-;;
-;;; Code:
-(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
-\f
-;;;### (autoloads nil "guide-key" "guide-key.el" (21908 14266 0 0))
-;;; Generated autoloads from guide-key.el
-
-(defvar guide-key-mode nil "\
-Non-nil if Guide-Key mode is enabled.
-See the command `guide-key-mode' for a description of this minor mode.
-Setting this variable directly does not take effect;
-either customize it (see the info node `Easy Customization')
-or call the function `guide-key-mode'.")
-
-(custom-autoload 'guide-key-mode "guide-key" nil)
-
-(autoload 'guide-key-mode "guide-key" "\
-Toggle guide key mode.
-
-In guide key mode, Guide following keys to an input key sequence
-automatically and dynamically.
-With a prefix argument ARG, enable guide key mode if ARG is
-positive, otherwise disable.
-
-\(fn &optional ARG)" t nil)
-
-;;;***
-\f
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; End:
-;;; guide-key-autoloads.el ends here
+++ /dev/null
-(define-package "guide-key" "20150107.2235" "Guide the following key bindings automatically and dynamically" '((dash "2.10.0") (popwin "0.3.0") (s "1.9.0")) :url "https://github.com/kai2nenobu/guide-key" :keywords '("help" "convenience"))
+++ /dev/null
-;;; guide-key.el --- Guide the following key bindings automatically and dynamically
-
-;; Copyright (C) 2012, 2013 Tsunenobu Kai
-
-;; Author: Tsunenobu Kai <kai2nenobuNOSPAMgmail.com>
-;; URL: https://github.com/kai2nenobu/guide-key
-;; Package-Version: 20150107.2235
-;; Version: 1.2.5
-;; Package-Requires: ((dash "2.10.0") (popwin "0.3.0") (s "1.9.0"))
-;; Keywords: help convenience
-
-;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Overview:
-;;
-;; guide-key.el displays the available key bindings automatically and dynamically.
-;; guide-key aims to be an alternative of one-key.el.
-;;
-;; Here are some features of this library.
-;; - guide-key automatically pops up the keys following your favorite
-;; prefixes. Moreover, even if you change key bindings, guide-key follows the
-;; change dynamically.
-;; - guide-key can highlight particular commands. This makes it easy to find a
-;; command you are looking for, and to learn its key binding.
-;; - guide-key doesn't overwrite existing commands and key bindings, so there
-;; is no interference with `describe-key' and `describe-bindings'.
-;;
-;;
-;; Installation:
-;;
-;; I added guide-key to MELPA. You can install guide-key with package.el.
-;; Because guide-key depends on popwin.el, popwin.el is also installed.
-;;
-;; If you don't have package.el, please download popwin.el and guide-key.el
-;; directly from https://github.com/m2ym/popwin-el and
-;; https://github.com/kai2nenobu/guide-key, and then put them in your
-;; `load-path'.
-;;
-;;
-;; Basic usage:
-;;
-;; You just add your favorite prefix keys to `guide-key/guide-key-sequence'
-;; as below.
-;;
-;; (require 'guide-key)
-;; (setq guide-key/guide-key-sequence '("C-x r" "C-x 4"))
-;; (guide-key-mode 1) ; Enable guide-key-mode
-;;
-;; When you press these prefix keys, key bindings are automatically
-;; popped up after a short delay (1 second by default).
-;;
-;; To activate guide-key for any key sequence instead of just the ones
-;; listed above then use:
-;;
-;; (setq guide-key/guide-key-sequence t)
-;;
-;; guide-key can highlight commands which match a specified regular expression.
-;; Key bindings following "C-x r" are rectangle family, register family and
-;; bookmark family. If you want to highlight only rectangle family
-;; commands, put this setting in your init.el.
-;;
-;; (setq guide-key/highlight-command-regexp "rectangle")
-;;
-;; This feature makes it easy to find commands and learn their key bindings.
-;; If you want to highlight all families, you can specify multiple regular
-;; expressions and faces as below.
-;;
-;; (setq guide-key/highlight-command-regexp
-;; '("rectangle"
-;; ("register" . font-lock-type-face)
-;; ("bookmark" . font-lock-warning-face)))
-;;
-;; If an element of `guide-key/highlight-command-regexp' is cons, its car
-;; means a regular expression to highlight, and its cdr means a face put on
-;; command names.
-;;
-;; Moreover, prefix commands are automatically highlighted.
-;;
-;; Depending on your level of emacs experience, you may want a shorter or
-;; longer delay between pressing a key and the appearance of the guide
-;; buffer. This can be controlled by setting `guide-key/idle-delay':
-;;
-;; (setq guide-key/idle-delay 0.1)
-;;
-;; The guide buffer is displayed only when you pause between keystrokes
-;; for longer than this delay, so it will keep out of your way when you
-;; are typing key sequences that you already know well.
-;;
-;; I've confirmed that guide-key works well in these environments.
-;; - Emacs 24.2, Ubuntu 12.04 or Windows 7 64bit
-;; - Emacs 23.3, Ubuntu 12.04 or Windows 7 64bit
-;; - Emacs 22.3, Windows 7 64bit
-;; - Emacs 24.3.1, OS X 10.9
-;; If popwin works, I think guide-key will work as well. You can use
-;; guide-key with Emacs working in terminal.
-;;
-;;
-;; Advanced usage:
-;;
-;; It is bothering to add many prefixes to `guide-key/guide-key-sequence'.
-;; `guide-key/recursive-key-sequence-flag' releases you from this problem.
-;; If `guide-key/recursive-key-sequence-flag' is non-nil, guide-key checks a
-;; input key sequence recursively. That is, if "C-x 8 ^" is an input key
-;; sequence, guide-key checks whether `guide-key/guide-key-sequence' includes
-;; "C-x 8" and "C-x".
-;;
-;; For example, if you configure as below,
-;;
-;; (setq guide-key/guide-key-sequence '("C-x"))
-;; (setq guide-key/recursive-key-sequence-flag t)
-;;
-;; the guide buffer is popped up when you input "C-x r", "C-x 8" and
-;; any other prefixes following "C-x".
-;;
-;;
-;; You can add extra settings in a particular mode. Please use
-;; `guide-key/add-local-guide-key-sequence',
-;; `guide-key/add-local-highlight-command-regexp' and the hook of
-;; that mode.
-;;
-;;
-;; This code is a example of org-mode.
-;;
-;; (defun guide-key/my-hook-function-for-org-mode ()
-;; (guide-key/add-local-guide-key-sequence "C-c")
-;; (guide-key/add-local-guide-key-sequence "C-c C-x")
-;; (guide-key/add-local-highlight-command-regexp "org-"))
-;; (add-hook 'org-mode-hook 'guide-key/my-hook-function-for-org-mode)
-;;
-;; In respect of `guide-key/guide-key-sequence', you can add mode specific key
-;; sequences without `guide-key/add-local-guide-key-sequence'. For example,
-;; configure as below.
-;;
-;; (setq guide-key/guide-key-sequence
-;; '("C-x r" "C-x 4"
-;; (org-mode "C-c C-x")
-;; (outline-minor-mode "C-c @")))
-;;
-;; In this case, if the current major mode is `org-mode', guide key bindings
-;; following "C-c C-x". If `outline-minor-mode' is enabled, guide key bindings
-;; following "C-c @".
-;;
-;;
-;; `guide-key' can work with key-chord.el. If you want to guide key bindings
-;; following key chord, you need to execute
-;; `guide-key/key-chord-hack-on'. Then, add your favorite key chord to
-;; `guide-key/guide-key-sequence' as below.
-;;
-;; (key-chord-define global-map "@4" 'ctl-x-4-prefix)
-;;
-;; (guide-key/key-chord-hack-on)
-;; (setq guide-key/guide-key-sequence '("<key-chord> @ 4" "<key-chord> 4 @"))
-;;
-;; If =guide-key/recursive-key-sequence-flag= is non-nil, more simple.
-;;
-;; (guide-key/key-chord-hack-on)
-;; (setq guide-key/recursive-key-sequence-flag t)
-;; (setq guide-key/guide-key-sequence '("<key-chord>"))
-;;
-;; In this case, key bindings are popped up when you type any of key chords.
-;;
-;; This hack *may be dangerous* because it advices primitive functions;
-;; `this-command-keys' and `this-command-keys-vector'.
-;;
-;;
-;; Here are some functions and variables which control guide-key.
-;; - `guide-key-mode':
-;; guide-key-mode is implemented as a minor mode.
-;; Excuting M-x guide-key-mode toggles whether guide-key is enabled or
-;; not. Because guide-key-mode is a global minor mode, guide-key-mode is
-;; enabled in all buffers or disabled in all buffers.
-;; - `guide-key/popup-window-position':
-;; This variable controls where a guide-key buffer is popped up. A value of
-;; this variable is one of `right', `bottom', `left', `top'. The default
-;; value is `right'.
-;; - `guide-key/polling-time':
-;; This variable controls a polling time. The default value is 0.1 (in seconds).
-;; - `guide-key/idle-delay':
-;; This variable controls the delay between starting a key sequence and
-;; popping up the guide buffer. The default value is 1.0 (in seconds),
-;; which means that guide-key will keep out of your way unless you hesitate
-;; in the middle of a key sequence . Set this to 0.0 to revert to the old
-;; default behavior.
-;; - `guide-key/text-scale-amount':
-;; This variable controls the size of text in guide buffer. The default
-;; value is 0 (it means default size in Emacs). If you want to enlarge
-;; text, set positive number. Otherwise, set negative number.
-;;
-;; Enjoy!
-
-;;; Code:
-
-(eval-when-compile
- (require 'cl)
- (require 'face-remap))
-
-(require 'dash)
-(require 'popwin)
-(require 's)
-
-;;; variables
-(defgroup guide-key nil
- "Guide key bidings."
- :group 'help
- :prefix "guide-key/")
-
-(defcustom guide-key/guide-key-sequence nil
- "*Key sequences to guide in `guide-key-mode'.
-This variable is a list of string representation.
-Both representations, like \"C-x r\" and \"\\C-xr\",
-are allowed.
-
-In addition, an element of this list can be a list whose car is
-the symbol for a certain mode, and whose cdr is a list of key
-sequences to consider only if that mode is active.
-
-Set this variable to `t' to enable for any key sequence."
- :type '(repeat (choice (string :tag "Prefix key sequence")
- (cons :tag "Mode specific sequence"
- (symbol :tag "Symbol for mode")
- (repeat (string :tag "Prefix key sequence")))))
- :group 'guide-key)
-
-(defcustom guide-key/polling-time 0.1
- "*Polling time to check an input key sequence."
- :type 'float
- :group 'guide-key)
-
-(defcustom guide-key/idle-delay 1.0
- "*Delay in seconds before guide buffer is displayed."
- :type 'float
- :group 'guide-key)
-
-(defcustom guide-key/highlight-prefix-regexp "prefix"
- "*Regexp for prefix commands."
- :type 'regexp
- :group 'guide-key)
-
-(defcustom guide-key/highlight-command-regexp nil
- "*Regexp for commands to highlight.
-If a command name matches this regexp, it is highlighted with
-`guide-key/highlight-command-face'.
-
-This variable can be a list and its element is either a regexp or
-a cons cell, its car is a regexp and its cdr is face symbol or
-color name string. If regexp, commands which match the regexp
-are highlighted with `guide-key/highlight-command-face'. If cons
-cell, commands which match the car regexp are highlighted with
-the cdr face or color."
- :type '(choice (regexp :tag "Regexp to highlight")
- (repeat (choice (regexp :tag "Regexp to highlight")
- (cons (regexp :tag "Regexp to highlight")
- (choice (face :tag "Face on command")
- (string :tag "Color name string"))))))
- :group 'guide-key)
-
-(defcustom guide-key/align-command-by-space-flag nil
- "*If non-nil, align guide buffer by space."
- :type 'boolean
- :group 'guide-key)
-
-(defcustom guide-key/popup-window-position 'right
- "*Position where guide buffer is popped up.
-This variable must be one of `right', `bottom', `left' and `top'."
- :type '(radio (const right) (const bottom) (const left) (const top))
- :group 'guide-key)
-
-(defcustom guide-key/text-scale-amount 0
- "*Amount of scaling text in guide buffer.
-
-If positive number, the text becomes larger. If negative number,
-the text becomes smaller. Scale of the text is detemined by the
-value of variable `text-scale-mode-step'."
- :type 'float
- :group 'guide-key)
-
-(defcustom guide-key/recursive-key-sequence-flag nil
- "*If non-nil, check an input key sequence recursively.
-For example, if `guide-key/guide-key-sequence' includes \"C-x\",
-guide buffer is popped up when you input \"C-x r\", \"C-x 4\" and
-any other prefixes following \"C-x\"."
- :type 'boolean
- :group 'guide-key)
-
-(defface guide-key/prefix-command-face
- '((((class color) (background dark))
- (:foreground "cyan"))
- (((class color) (background light))
- (:foreground "blue")))
- "Face for prefix commands to highlight"
- :group 'guide-key)
-
-(defface guide-key/highlight-command-face
- '((((class color) (background dark))
- (:foreground "yellow"))
- (((class color) (background light))
- (:foreground "orange red")))
- "Face for commands to highlight"
- :group 'guide-key)
-
-(defface guide-key/key-face
- '((((class color) (background dark))
- (:foreground "red"))
- (((class color) (background light))
- (:foreground "dark green")))
- "Face for keys following to a key sequence"
- :group 'guide-key)
-
-;;; internal variables
-(defvar guide-key/polling-timer nil
- "Polling timer to check an input key sequence.")
-
-(defvar guide-key/idle-timer nil
- "Idle timer to wait before popping up guide buffer.")
-
-(defvar guide-key/guide-buffer-name " *guide-key*"
- "Buffer name of guide buffer.")
-
-(defvar guide-key/last-key-sequence-vector nil
- "Key sequence input at the last polling operation.")
-
-;; or hook
-;; (add-hook 'pre-command-hook 'guide-key/hook-command)
-;; (setq pre-command-hook nil)
-;; (add-hook 'post-command-hook 'guide-key/key-event)
-;; (add-hook 'pre-command-hook 'show-this-command)
-
-;;; functions
-;;;###autoload
-(define-minor-mode guide-key-mode
- "Toggle guide key mode.
-
-In guide key mode, Guide following keys to an input key sequence
-automatically and dynamically.
-With a prefix argument ARG, enable guide key mode if ARG is
-positive, otherwise disable."
- :global t
- :lighter " Guide"
- (funcall (if guide-key-mode
- 'guide-key/turn-on-timer
- 'guide-key/turn-off-timer)))
-
-(defun guide-key/popup-function (&optional input)
- "Popup function called after delay of `guide-key/idle-delay' second."
- (let ((key-seq (or input (this-single-command-keys)))
- (regexp guide-key/highlight-command-regexp))
- (let ((dsc-buf (current-buffer))
- (max-width 0))
- (with-current-buffer (get-buffer-create guide-key/guide-buffer-name)
- (unless truncate-lines (setq truncate-lines t)) ; don't fold line
- (when indent-tabs-mode (setq indent-tabs-mode nil)) ; don't use tab as white space
- (setq mode-line-format nil)
- (text-scale-set guide-key/text-scale-amount)
- (erase-buffer)
- (describe-buffer-bindings dsc-buf key-seq)
- (when (> (guide-key/format-guide-buffer key-seq regexp) 0)
- (guide-key/close-guide-buffer)
- (guide-key/popup-guide-buffer))))))
-
-
-;;; internal functions
-(defun guide-key/polling-function ()
- "Polling function executed every `guide-key/polling-time' second."
- (let ((key-seq (this-single-command-keys)))
- (if (guide-key/popup-guide-buffer-p key-seq)
- (when (guide-key/update-guide-buffer-p key-seq)
- (guide-key/turn-on-idle-timer))
- (guide-key/close-guide-buffer))
- (setq guide-key/last-key-sequence-vector key-seq)))
-
-(defun guide-key/popup-guide-buffer ()
- "Pop up guide buffer at `guide-key/popup-window-position'."
- (let ((last-config popwin:popup-last-config))
- (apply 'popwin:popup-buffer (get-buffer guide-key/guide-buffer-name)
- :position guide-key/popup-window-position
- :noselect t
- (cond ((popwin:position-horizontal-p guide-key/popup-window-position)
- `(:width ,(guide-key/popup-window-size 'horizontal)))
- ((popwin:position-vertical-p guide-key/popup-window-position)
- `(:height ,(guide-key/popup-window-size)))))
- (setq popwin:popup-last-config last-config)))
-
-(defun guide-key/popup-window-size (&optional horizontal)
- "Return an enough height or width of popup window to display
-all key bindings in guide buffer.
-
-If HORIZONTAL is omitted or nil, return the height of popup
-window. Otherwise, return the width of popup window"
- (with-current-buffer (get-buffer guide-key/guide-buffer-name)
- (let ((margin (if horizontal 5 1))
- (scale (expt text-scale-mode-step text-scale-mode-amount)))
- (if horizontal
- (ceiling (* scale (+ (guide-key/buffer-max-width) margin)))
- (ceiling (* scale (+ (count-lines (point-min) (point-max)) margin))))
- )))
-
-(defun guide-key/close-guide-buffer ()
- "Close guide buffer."
- (when (eq popwin:popup-buffer (get-buffer guide-key/guide-buffer-name))
- (popwin:close-popup-window))
- (guide-key/turn-off-idle-timer)
- )
-
-(add-hook 'pre-command-hook 'guide-key/close-guide-buffer)
-
-(defun guide-key/update-guide-buffer-p (key-seq)
- "Return t if guide buffer should be updated."
- (not (equal guide-key/last-key-sequence-vector key-seq)))
-
-(defun guide-key/popup-guide-buffer-p (key-seq)
- "Return t if guide buffer should be popped up."
- (and (> (length key-seq) 0)
- (or (eq guide-key/guide-key-sequence t)
- (member key-seq (guide-key/buffer-key-sequences))
- (and guide-key/recursive-key-sequence-flag
- (guide-key/popup-guide-buffer-p (guide-key/vbutlast key-seq))))))
-
-(defun guide-key/buffer-key-sequences ()
- "Return a list of key sequences (vector representation) in current buffer."
- (let (lst)
- ;; global key sequences
- (dolist (ks guide-key/guide-key-sequence)
- (when (stringp ks)
- (setq lst (cons ks lst))))
- ;; major-mode specific key sequences
- (setq lst (append (assoc-default major-mode guide-key/guide-key-sequence) lst))
- ;; minor-mode specific key sequences
- (dolist (mmode minor-mode-list)
- (when (and (boundp mmode) (symbol-value mmode))
- (setq lst (append (assoc-default mmode guide-key/guide-key-sequence) lst))))
- ;; convert key sequences to vector representation
- (mapcar 'guide-key/convert-key-sequence-to-vector lst)))
-
-(defun guide-key/vbutlast (vec &optional n)
- "Return a copy of vector VEC with the last N elements removed."
- (vconcat (butlast (append vec nil) n)))
-
-(defun guide-key/convert-key-sequence-to-vector (key-seq)
- "Convert key sequence KEY-SEQ to vector representation.
-For example, both \"C-x r\" and \"\\C-xr\" are converted to [24 114]"
- (vconcat (read-kbd-macro key-seq)))
-
-(defun guide-key/turn-on-idle-timer ()
- "Turn on an idle timer for popping up guide buffer."
- (when (null guide-key/idle-timer)
- (setq guide-key/idle-timer
- (run-with-idle-timer guide-key/idle-delay t 'guide-key/popup-function))
- ))
-
-(defun guide-key/turn-off-idle-timer ()
- "Turn off the idle timer."
- (when guide-key/idle-timer
- (cancel-timer guide-key/idle-timer))
- (setq guide-key/idle-timer nil))
-
-
-(defun guide-key/turn-on-timer ()
- "Turn on a polling timer."
- (when (null guide-key/polling-timer)
- (setq guide-key/polling-timer
- (run-at-time t guide-key/polling-time 'guide-key/polling-function))))
-
-(defun guide-key/turn-off-timer ()
- "Turn off a polling timer."
- (cancel-timer guide-key/polling-timer)
- (setq guide-key/polling-timer nil))
-
-(defun guide-key/format-guide-buffer (key-seq &optional regexp)
- "Format guide buffer. This function returns the number of following keys."
- (let ((fkey-list nil) ; list of (following-key space command)
- (fkey-str-list nil) ; fontified string of `fkey-list'
- (fkey-list-len 0) ; length of above lists
- (key-dsc (key-description key-seq)))
- (untabify (point-min) (point-max)) ; replace tab to space
- (goto-char (point-min))
- ;; extract following keys from buffer bindings
- (while (re-search-forward
- (format "^%s \\([^ \t]+\\)\\([ \t]+\\)\\(\\(?:[^ \t\n]+ ?\\)+\\)$" (regexp-quote key-dsc)) nil t)
- (add-to-list 'fkey-list
- (list (match-string 1) (match-string 2) (match-string 3)) t))
- (erase-buffer)
- (when (> (setq fkey-list-len (length fkey-list)) 0)
- ;; fontify following keys as string
- (setq fkey-str-list
- (loop for (key space command) in fkey-list
- collect (guide-key/fontified-string key space command regexp)))
- ;; insert a few following keys per line
- (guide-key/insert-following-key fkey-str-list
- (popwin:position-horizontal-p guide-key/popup-window-position))
- (goto-char (point-min)))
- fkey-list-len))
-
-(defun guide-key/insert-following-key (fkey-str-list horizontal)
- "Insert a few following keys per line.
-
-If HORIZONTAL is omitted or nil, assume that guide buffer is
-popped up at top or bottom. Otherwise, assume that guide buffer
-is popped up at left or right."
- (let* ((scale (expt text-scale-mode-step text-scale-mode-amount))
- ;; Calculate the number of items per line
- (columns
- (if horizontal
- (ceiling (/ (* (length fkey-str-list) scale)
- (- (frame-height) (if tool-bar-mode 2 0) (if menu-bar-mode 1 0))))
- (floor (/ (frame-width)
- (* (apply 'max (mapcar 'length fkey-str-list)) scale))))))
- ;; Insert following keys by columns per line.
- (loop for fkey-str in fkey-str-list
- for column from 1
- do (insert fkey-str (if (= (mod column columns) 0) "\n" " ")))
- (align-regexp (point-min) (point-max) "\\(\\s-*\\) \\[" 1 1 t)))
-
-(defun guide-key/fontified-string (key space command &optional regexp)
- "Return fontified string of following key"
- (let ((highlight-face (guide-key/get-highlight-face command regexp)))
- (concat (propertize "[" 'face 'guide-key/key-face)
- (if highlight-face (propertize key 'face highlight-face) key)
- (propertize "]" 'face 'guide-key/key-face)
- (if guide-key/align-command-by-space-flag space " ") ; white space
- (if highlight-face (propertize command 'face highlight-face) command))))
-
-(defun guide-key/get-highlight-face (string &optional regexp)
- "Return an appropriate face for highlighting STRING according
-to `guide-key/highlight-prefix-regexp' and
-`guide-key/highlight-command-regexp'. Return nil if an
-appropriate face is not found."
- (let ((regexp (or regexp guide-key/highlight-command-regexp)))
- ;; `guide-key/highlight-prefix-regexp' has the highest priority
- (if (string-match guide-key/highlight-prefix-regexp string)
- 'guide-key/prefix-command-face
- ;; Else look up the first match in `guide-key/highlight-command-regexp'
- (cond ((stringp regexp)
- (when (string-match regexp string)
- 'guide-key/highlight-command-face))
- ((listp regexp)
- (loop for elm in regexp
- if (cond ((stringp elm)
- (when (string-match elm string)
- 'guide-key/highlight-command-face))
- ((consp elm)
- (when (string-match (car elm) string)
- (if (stringp (cdr elm))
- ;; anonymous face, see (info "(elisp)Faces")
- (list :foreground (cdr elm))
- (cdr elm)))))
- return it)))
- )))
-
-(defun guide-key/buffer-max-width ()
- "Return max width in current buffer."
- (let ((buf-str (buffer-substring-no-properties (point-min) (point-max))))
- (apply 'max (mapcar 'length (split-string buf-str "\n")))))
-
-(defun guide-key/add-local-guide-key-sequence (key)
- (add-to-list (make-local-variable 'guide-key/guide-key-sequence) key))
-
-(defun guide-key/add-local-highlight-command-regexp (regexp)
- (make-local-variable 'guide-key/highlight-command-regexp)
- (cond ((stringp guide-key/highlight-command-regexp)
- (setq guide-key/highlight-command-regexp
- (list regexp guide-key/highlight-command-regexp)))
- ((listp guide-key/highlight-command-regexp)
- (add-to-list 'guide-key/highlight-command-regexp regexp))))
-
-;;; key-chord hack
-(defadvice this-command-keys (after key-chord-hack disable)
- "Add key chord to the key sequence returned by `this-command-keys'.
-
-Original `this-command-keys' returns \"[key-chord]\" when you
-type any of key chords, so it is difficult to know which key
-chord is pressed. This advice enables to distinguish pressed key
-chord."
- (condition-case nil
- (if (equal ad-return-value [key-chord])
- (let ((rkeys (recent-keys)))
- (setq ad-return-value
- (vector 'key-chord (aref rkeys (- (length rkeys) 2))
- (aref rkeys (- (length rkeys) 1))))))
- (error "")))
-
-(defadvice this-command-keys-vector (after key-chord-hack disable)
- "Add key chord to the key sequence returned by `this-command-keys-vector'.
-
-Original `this-command-keys-vector' returns \"[key-chord]\" when you
-type any of key chords, so it is difficult to know which key
-chord is pressed. This advice enables to distinguish pressed key
-chord."
- (condition-case nil
- (if (equal ad-return-value [key-chord])
- (let ((rkeys (recent-keys)))
- (setq ad-return-value
- (vector 'key-chord (aref rkeys (- (length rkeys) 2))
- (aref rkeys (- (length rkeys) 1))))))
- (error [])))
-
-(defun guide-key/key-chord-hack-on ()
- "Turn on key-chord hack of guide-key.
-
-This hack *may be dangerous* because it advices primitive
-functions; this-command-keys and this-command-keys-vector."
- (interactive)
- (dolist (fn '(this-command-keys this-command-keys-vector))
- (ad-enable-advice fn 'after 'key-chord-hack)
- (ad-activate fn))
- (message "Turn on key-chord hack of guide-key"))
-
-(defun guide-key/key-chord-hack-off ()
- "Turn off key-chord hack of guide-key."
- (interactive)
- (dolist (fn '(this-command-keys this-command-keys-vector))
- (ad-disable-advice fn 'after 'key-chord-hack)
- (ad-activate fn))
- (message "Turn off key-chord hack of guide-key"))
-
-;;; debug
-(defun guide-key/message-events ()
- ""
- (message (format "lce:%S tck:%S tckv:%S tsck:%S lie:%S uce:%S"
- last-command-event
- (this-command-keys)
- (this-command-keys-vector)
- (this-single-command-keys)
- last-input-event
- unread-command-events
- )))
-;; (setq ttt (run-at-time t 1 'guide-key/message-events))
-;; (cancel-timer ttt)
-
-(provide 'guide-key)
-;;; guide-key.el ends here
--- /dev/null
+;;; guide-key-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+
+(add-to-list 'load-path (directory-file-name
+ (or (file-name-directory #$) (car load-path))))
+
+\f
+;;;### (autoloads nil "guide-key" "guide-key.el" (0 0 0 0))
+;;; Generated autoloads from guide-key.el
+
+(defvar guide-key-mode nil "\
+Non-nil if Guide-Key mode is enabled.
+See the `guide-key-mode' command
+for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `guide-key-mode'.")
+
+(custom-autoload 'guide-key-mode "guide-key" nil)
+
+(autoload 'guide-key-mode "guide-key" "\
+Toggle guide key mode.
+
+In guide key mode, Guide following keys to an input key sequence
+automatically and dynamically.
+With a prefix argument ARG, enable guide key mode if ARG is
+positive, otherwise disable.
+
+\(fn &optional ARG)" t nil)
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "guide-key" '("guide-key/")))
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; guide-key-autoloads.el ends here
--- /dev/null
+;;; -*- no-byte-compile: t -*-
+(define-package "guide-key" "20150108.635" "Guide the following key bindings automatically and dynamically" '((dash "2.10.0") (popwin "0.3.0") (s "1.9.0")) :commit "9236d287a7272e307fb941237390a96037c8c0a2" :keywords '("help" "convenience") :authors '(("Tsunenobu Kai" . "kai2nenobuNOSPAMgmail.com")) :maintainer '("Tsunenobu Kai" . "kai2nenobuNOSPAMgmail.com") :url "https://github.com/kai2nenobu/guide-key")
--- /dev/null
+;;; guide-key.el --- Guide the following key bindings automatically and dynamically
+
+;; Copyright (C) 2012, 2013 Tsunenobu Kai
+
+;; Author: Tsunenobu Kai <kai2nenobuNOSPAMgmail.com>
+;; URL: https://github.com/kai2nenobu/guide-key
+;; Package-Version: 20150108.635
+;; Version: 1.2.5
+;; Package-Requires: ((dash "2.10.0") (popwin "0.3.0") (s "1.9.0"))
+;; Keywords: help convenience
+
+;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Overview:
+;;
+;; guide-key.el displays the available key bindings automatically and dynamically.
+;; guide-key aims to be an alternative of one-key.el.
+;;
+;; Here are some features of this library.
+;; - guide-key automatically pops up the keys following your favorite
+;; prefixes. Moreover, even if you change key bindings, guide-key follows the
+;; change dynamically.
+;; - guide-key can highlight particular commands. This makes it easy to find a
+;; command you are looking for, and to learn its key binding.
+;; - guide-key doesn't overwrite existing commands and key bindings, so there
+;; is no interference with `describe-key' and `describe-bindings'.
+;;
+;;
+;; Installation:
+;;
+;; I added guide-key to MELPA. You can install guide-key with package.el.
+;; Because guide-key depends on popwin.el, popwin.el is also installed.
+;;
+;; If you don't have package.el, please download popwin.el and guide-key.el
+;; directly from https://github.com/m2ym/popwin-el and
+;; https://github.com/kai2nenobu/guide-key, and then put them in your
+;; `load-path'.
+;;
+;;
+;; Basic usage:
+;;
+;; You just add your favorite prefix keys to `guide-key/guide-key-sequence'
+;; as below.
+;;
+;; (require 'guide-key)
+;; (setq guide-key/guide-key-sequence '("C-x r" "C-x 4"))
+;; (guide-key-mode 1) ; Enable guide-key-mode
+;;
+;; When you press these prefix keys, key bindings are automatically
+;; popped up after a short delay (1 second by default).
+;;
+;; To activate guide-key for any key sequence instead of just the ones
+;; listed above then use:
+;;
+;; (setq guide-key/guide-key-sequence t)
+;;
+;; guide-key can highlight commands which match a specified regular expression.
+;; Key bindings following "C-x r" are rectangle family, register family and
+;; bookmark family. If you want to highlight only rectangle family
+;; commands, put this setting in your init.el.
+;;
+;; (setq guide-key/highlight-command-regexp "rectangle")
+;;
+;; This feature makes it easy to find commands and learn their key bindings.
+;; If you want to highlight all families, you can specify multiple regular
+;; expressions and faces as below.
+;;
+;; (setq guide-key/highlight-command-regexp
+;; '("rectangle"
+;; ("register" . font-lock-type-face)
+;; ("bookmark" . font-lock-warning-face)))
+;;
+;; If an element of `guide-key/highlight-command-regexp' is cons, its car
+;; means a regular expression to highlight, and its cdr means a face put on
+;; command names.
+;;
+;; Moreover, prefix commands are automatically highlighted.
+;;
+;; Depending on your level of emacs experience, you may want a shorter or
+;; longer delay between pressing a key and the appearance of the guide
+;; buffer. This can be controlled by setting `guide-key/idle-delay':
+;;
+;; (setq guide-key/idle-delay 0.1)
+;;
+;; The guide buffer is displayed only when you pause between keystrokes
+;; for longer than this delay, so it will keep out of your way when you
+;; are typing key sequences that you already know well.
+;;
+;; I've confirmed that guide-key works well in these environments.
+;; - Emacs 24.2, Ubuntu 12.04 or Windows 7 64bit
+;; - Emacs 23.3, Ubuntu 12.04 or Windows 7 64bit
+;; - Emacs 22.3, Windows 7 64bit
+;; - Emacs 24.3.1, OS X 10.9
+;; If popwin works, I think guide-key will work as well. You can use
+;; guide-key with Emacs working in terminal.
+;;
+;;
+;; Advanced usage:
+;;
+;; It is bothering to add many prefixes to `guide-key/guide-key-sequence'.
+;; `guide-key/recursive-key-sequence-flag' releases you from this problem.
+;; If `guide-key/recursive-key-sequence-flag' is non-nil, guide-key checks a
+;; input key sequence recursively. That is, if "C-x 8 ^" is an input key
+;; sequence, guide-key checks whether `guide-key/guide-key-sequence' includes
+;; "C-x 8" and "C-x".
+;;
+;; For example, if you configure as below,
+;;
+;; (setq guide-key/guide-key-sequence '("C-x"))
+;; (setq guide-key/recursive-key-sequence-flag t)
+;;
+;; the guide buffer is popped up when you input "C-x r", "C-x 8" and
+;; any other prefixes following "C-x".
+;;
+;;
+;; You can add extra settings in a particular mode. Please use
+;; `guide-key/add-local-guide-key-sequence',
+;; `guide-key/add-local-highlight-command-regexp' and the hook of
+;; that mode.
+;;
+;;
+;; This code is a example of org-mode.
+;;
+;; (defun guide-key/my-hook-function-for-org-mode ()
+;; (guide-key/add-local-guide-key-sequence "C-c")
+;; (guide-key/add-local-guide-key-sequence "C-c C-x")
+;; (guide-key/add-local-highlight-command-regexp "org-"))
+;; (add-hook 'org-mode-hook 'guide-key/my-hook-function-for-org-mode)
+;;
+;; In respect of `guide-key/guide-key-sequence', you can add mode specific key
+;; sequences without `guide-key/add-local-guide-key-sequence'. For example,
+;; configure as below.
+;;
+;; (setq guide-key/guide-key-sequence
+;; '("C-x r" "C-x 4"
+;; (org-mode "C-c C-x")
+;; (outline-minor-mode "C-c @")))
+;;
+;; In this case, if the current major mode is `org-mode', guide key bindings
+;; following "C-c C-x". If `outline-minor-mode' is enabled, guide key bindings
+;; following "C-c @".
+;;
+;;
+;; `guide-key' can work with key-chord.el. If you want to guide key bindings
+;; following key chord, you need to execute
+;; `guide-key/key-chord-hack-on'. Then, add your favorite key chord to
+;; `guide-key/guide-key-sequence' as below.
+;;
+;; (key-chord-define global-map "@4" 'ctl-x-4-prefix)
+;;
+;; (guide-key/key-chord-hack-on)
+;; (setq guide-key/guide-key-sequence '("<key-chord> @ 4" "<key-chord> 4 @"))
+;;
+;; If =guide-key/recursive-key-sequence-flag= is non-nil, more simple.
+;;
+;; (guide-key/key-chord-hack-on)
+;; (setq guide-key/recursive-key-sequence-flag t)
+;; (setq guide-key/guide-key-sequence '("<key-chord>"))
+;;
+;; In this case, key bindings are popped up when you type any of key chords.
+;;
+;; This hack *may be dangerous* because it advices primitive functions;
+;; `this-command-keys' and `this-command-keys-vector'.
+;;
+;;
+;; Here are some functions and variables which control guide-key.
+;; - `guide-key-mode':
+;; guide-key-mode is implemented as a minor mode.
+;; Excuting M-x guide-key-mode toggles whether guide-key is enabled or
+;; not. Because guide-key-mode is a global minor mode, guide-key-mode is
+;; enabled in all buffers or disabled in all buffers.
+;; - `guide-key/popup-window-position':
+;; This variable controls where a guide-key buffer is popped up. A value of
+;; this variable is one of `right', `bottom', `left', `top'. The default
+;; value is `right'.
+;; - `guide-key/polling-time':
+;; This variable controls a polling time. The default value is 0.1 (in seconds).
+;; - `guide-key/idle-delay':
+;; This variable controls the delay between starting a key sequence and
+;; popping up the guide buffer. The default value is 1.0 (in seconds),
+;; which means that guide-key will keep out of your way unless you hesitate
+;; in the middle of a key sequence . Set this to 0.0 to revert to the old
+;; default behavior.
+;; - `guide-key/text-scale-amount':
+;; This variable controls the size of text in guide buffer. The default
+;; value is 0 (it means default size in Emacs). If you want to enlarge
+;; text, set positive number. Otherwise, set negative number.
+;;
+;; Enjoy!
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl)
+ (require 'face-remap))
+
+(require 'dash)
+(require 'popwin)
+(require 's)
+
+;;; variables
+(defgroup guide-key nil
+ "Guide key bidings."
+ :group 'help
+ :prefix "guide-key/")
+
+(defcustom guide-key/guide-key-sequence nil
+ "*Key sequences to guide in `guide-key-mode'.
+This variable is a list of string representation.
+Both representations, like \"C-x r\" and \"\\C-xr\",
+are allowed.
+
+In addition, an element of this list can be a list whose car is
+the symbol for a certain mode, and whose cdr is a list of key
+sequences to consider only if that mode is active.
+
+Set this variable to `t' to enable for any key sequence."
+ :type '(repeat (choice (string :tag "Prefix key sequence")
+ (cons :tag "Mode specific sequence"
+ (symbol :tag "Symbol for mode")
+ (repeat (string :tag "Prefix key sequence")))))
+ :group 'guide-key)
+
+(defcustom guide-key/polling-time 0.1
+ "*Polling time to check an input key sequence."
+ :type 'float
+ :group 'guide-key)
+
+(defcustom guide-key/idle-delay 1.0
+ "*Delay in seconds before guide buffer is displayed."
+ :type 'float
+ :group 'guide-key)
+
+(defcustom guide-key/highlight-prefix-regexp "prefix"
+ "*Regexp for prefix commands."
+ :type 'regexp
+ :group 'guide-key)
+
+(defcustom guide-key/highlight-command-regexp nil
+ "*Regexp for commands to highlight.
+If a command name matches this regexp, it is highlighted with
+`guide-key/highlight-command-face'.
+
+This variable can be a list and its element is either a regexp or
+a cons cell, its car is a regexp and its cdr is face symbol or
+color name string. If regexp, commands which match the regexp
+are highlighted with `guide-key/highlight-command-face'. If cons
+cell, commands which match the car regexp are highlighted with
+the cdr face or color."
+ :type '(choice (regexp :tag "Regexp to highlight")
+ (repeat (choice (regexp :tag "Regexp to highlight")
+ (cons (regexp :tag "Regexp to highlight")
+ (choice (face :tag "Face on command")
+ (string :tag "Color name string"))))))
+ :group 'guide-key)
+
+(defcustom guide-key/align-command-by-space-flag nil
+ "*If non-nil, align guide buffer by space."
+ :type 'boolean
+ :group 'guide-key)
+
+(defcustom guide-key/popup-window-position 'right
+ "*Position where guide buffer is popped up.
+This variable must be one of `right', `bottom', `left' and `top'."
+ :type '(radio (const right) (const bottom) (const left) (const top))
+ :group 'guide-key)
+
+(defcustom guide-key/text-scale-amount 0
+ "*Amount of scaling text in guide buffer.
+
+If positive number, the text becomes larger. If negative number,
+the text becomes smaller. Scale of the text is detemined by the
+value of variable `text-scale-mode-step'."
+ :type 'float
+ :group 'guide-key)
+
+(defcustom guide-key/recursive-key-sequence-flag nil
+ "*If non-nil, check an input key sequence recursively.
+For example, if `guide-key/guide-key-sequence' includes \"C-x\",
+guide buffer is popped up when you input \"C-x r\", \"C-x 4\" and
+any other prefixes following \"C-x\"."
+ :type 'boolean
+ :group 'guide-key)
+
+(defface guide-key/prefix-command-face
+ '((((class color) (background dark))
+ (:foreground "cyan"))
+ (((class color) (background light))
+ (:foreground "blue")))
+ "Face for prefix commands to highlight"
+ :group 'guide-key)
+
+(defface guide-key/highlight-command-face
+ '((((class color) (background dark))
+ (:foreground "yellow"))
+ (((class color) (background light))
+ (:foreground "orange red")))
+ "Face for commands to highlight"
+ :group 'guide-key)
+
+(defface guide-key/key-face
+ '((((class color) (background dark))
+ (:foreground "red"))
+ (((class color) (background light))
+ (:foreground "dark green")))
+ "Face for keys following to a key sequence"
+ :group 'guide-key)
+
+;;; internal variables
+(defvar guide-key/polling-timer nil
+ "Polling timer to check an input key sequence.")
+
+(defvar guide-key/idle-timer nil
+ "Idle timer to wait before popping up guide buffer.")
+
+(defvar guide-key/guide-buffer-name " *guide-key*"
+ "Buffer name of guide buffer.")
+
+(defvar guide-key/last-key-sequence-vector nil
+ "Key sequence input at the last polling operation.")
+
+;; or hook
+;; (add-hook 'pre-command-hook 'guide-key/hook-command)
+;; (setq pre-command-hook nil)
+;; (add-hook 'post-command-hook 'guide-key/key-event)
+;; (add-hook 'pre-command-hook 'show-this-command)
+
+;;; functions
+;;;###autoload
+(define-minor-mode guide-key-mode
+ "Toggle guide key mode.
+
+In guide key mode, Guide following keys to an input key sequence
+automatically and dynamically.
+With a prefix argument ARG, enable guide key mode if ARG is
+positive, otherwise disable."
+ :global t
+ :lighter " Guide"
+ (funcall (if guide-key-mode
+ 'guide-key/turn-on-timer
+ 'guide-key/turn-off-timer)))
+
+(defun guide-key/popup-function (&optional input)
+ "Popup function called after delay of `guide-key/idle-delay' second."
+ (let ((key-seq (or input (this-single-command-keys)))
+ (regexp guide-key/highlight-command-regexp))
+ (let ((dsc-buf (current-buffer))
+ (max-width 0))
+ (with-current-buffer (get-buffer-create guide-key/guide-buffer-name)
+ (unless truncate-lines (setq truncate-lines t)) ; don't fold line
+ (when indent-tabs-mode (setq indent-tabs-mode nil)) ; don't use tab as white space
+ (setq mode-line-format nil)
+ (text-scale-set guide-key/text-scale-amount)
+ (erase-buffer)
+ (describe-buffer-bindings dsc-buf key-seq)
+ (when (> (guide-key/format-guide-buffer key-seq regexp) 0)
+ (guide-key/close-guide-buffer)
+ (guide-key/popup-guide-buffer))))))
+
+
+;;; internal functions
+(defun guide-key/polling-function ()
+ "Polling function executed every `guide-key/polling-time' second."
+ (let ((key-seq (this-single-command-keys)))
+ (if (guide-key/popup-guide-buffer-p key-seq)
+ (when (guide-key/update-guide-buffer-p key-seq)
+ (guide-key/turn-on-idle-timer))
+ (guide-key/close-guide-buffer))
+ (setq guide-key/last-key-sequence-vector key-seq)))
+
+(defun guide-key/popup-guide-buffer ()
+ "Pop up guide buffer at `guide-key/popup-window-position'."
+ (let ((last-config popwin:popup-last-config))
+ (apply 'popwin:popup-buffer (get-buffer guide-key/guide-buffer-name)
+ :position guide-key/popup-window-position
+ :noselect t
+ (cond ((popwin:position-horizontal-p guide-key/popup-window-position)
+ `(:width ,(guide-key/popup-window-size 'horizontal)))
+ ((popwin:position-vertical-p guide-key/popup-window-position)
+ `(:height ,(guide-key/popup-window-size)))))
+ (setq popwin:popup-last-config last-config)))
+
+(defun guide-key/popup-window-size (&optional horizontal)
+ "Return an enough height or width of popup window to display
+all key bindings in guide buffer.
+
+If HORIZONTAL is omitted or nil, return the height of popup
+window. Otherwise, return the width of popup window"
+ (with-current-buffer (get-buffer guide-key/guide-buffer-name)
+ (let ((margin (if horizontal 5 1))
+ (scale (expt text-scale-mode-step text-scale-mode-amount)))
+ (if horizontal
+ (ceiling (* scale (+ (guide-key/buffer-max-width) margin)))
+ (ceiling (* scale (+ (count-lines (point-min) (point-max)) margin))))
+ )))
+
+(defun guide-key/close-guide-buffer ()
+ "Close guide buffer."
+ (when (eq popwin:popup-buffer (get-buffer guide-key/guide-buffer-name))
+ (popwin:close-popup-window))
+ (guide-key/turn-off-idle-timer)
+ )
+
+(add-hook 'pre-command-hook 'guide-key/close-guide-buffer)
+
+(defun guide-key/update-guide-buffer-p (key-seq)
+ "Return t if guide buffer should be updated."
+ (not (equal guide-key/last-key-sequence-vector key-seq)))
+
+(defun guide-key/popup-guide-buffer-p (key-seq)
+ "Return t if guide buffer should be popped up."
+ (and (> (length key-seq) 0)
+ (or (eq guide-key/guide-key-sequence t)
+ (member key-seq (guide-key/buffer-key-sequences))
+ (and guide-key/recursive-key-sequence-flag
+ (guide-key/popup-guide-buffer-p (guide-key/vbutlast key-seq))))))
+
+(defun guide-key/buffer-key-sequences ()
+ "Return a list of key sequences (vector representation) in current buffer."
+ (let (lst)
+ ;; global key sequences
+ (dolist (ks guide-key/guide-key-sequence)
+ (when (stringp ks)
+ (setq lst (cons ks lst))))
+ ;; major-mode specific key sequences
+ (setq lst (append (assoc-default major-mode guide-key/guide-key-sequence) lst))
+ ;; minor-mode specific key sequences
+ (dolist (mmode minor-mode-list)
+ (when (and (boundp mmode) (symbol-value mmode))
+ (setq lst (append (assoc-default mmode guide-key/guide-key-sequence) lst))))
+ ;; convert key sequences to vector representation
+ (mapcar 'guide-key/convert-key-sequence-to-vector lst)))
+
+(defun guide-key/vbutlast (vec &optional n)
+ "Return a copy of vector VEC with the last N elements removed."
+ (vconcat (butlast (append vec nil) n)))
+
+(defun guide-key/convert-key-sequence-to-vector (key-seq)
+ "Convert key sequence KEY-SEQ to vector representation.
+For example, both \"C-x r\" and \"\\C-xr\" are converted to [24 114]"
+ (vconcat (read-kbd-macro key-seq)))
+
+(defun guide-key/turn-on-idle-timer ()
+ "Turn on an idle timer for popping up guide buffer."
+ (when (null guide-key/idle-timer)
+ (setq guide-key/idle-timer
+ (run-with-idle-timer guide-key/idle-delay t 'guide-key/popup-function))
+ ))
+
+(defun guide-key/turn-off-idle-timer ()
+ "Turn off the idle timer."
+ (when guide-key/idle-timer
+ (cancel-timer guide-key/idle-timer))
+ (setq guide-key/idle-timer nil))
+
+
+(defun guide-key/turn-on-timer ()
+ "Turn on a polling timer."
+ (when (null guide-key/polling-timer)
+ (setq guide-key/polling-timer
+ (run-at-time t guide-key/polling-time 'guide-key/polling-function))))
+
+(defun guide-key/turn-off-timer ()
+ "Turn off a polling timer."
+ (cancel-timer guide-key/polling-timer)
+ (setq guide-key/polling-timer nil))
+
+(defun guide-key/format-guide-buffer (key-seq &optional regexp)
+ "Format guide buffer. This function returns the number of following keys."
+ (let ((fkey-list nil) ; list of (following-key space command)
+ (fkey-str-list nil) ; fontified string of `fkey-list'
+ (fkey-list-len 0) ; length of above lists
+ (key-dsc (key-description key-seq)))
+ (untabify (point-min) (point-max)) ; replace tab to space
+ (goto-char (point-min))
+ ;; extract following keys from buffer bindings
+ (while (re-search-forward
+ (format "^%s \\([^ \t]+\\)\\([ \t]+\\)\\(\\(?:[^ \t\n]+ ?\\)+\\)$" (regexp-quote key-dsc)) nil t)
+ (add-to-list 'fkey-list
+ (list (match-string 1) (match-string 2) (match-string 3)) t))
+ (erase-buffer)
+ (when (> (setq fkey-list-len (length fkey-list)) 0)
+ ;; fontify following keys as string
+ (setq fkey-str-list
+ (loop for (key space command) in fkey-list
+ collect (guide-key/fontified-string key space command regexp)))
+ ;; insert a few following keys per line
+ (guide-key/insert-following-key fkey-str-list
+ (popwin:position-horizontal-p guide-key/popup-window-position))
+ (goto-char (point-min)))
+ fkey-list-len))
+
+(defun guide-key/insert-following-key (fkey-str-list horizontal)
+ "Insert a few following keys per line.
+
+If HORIZONTAL is omitted or nil, assume that guide buffer is
+popped up at top or bottom. Otherwise, assume that guide buffer
+is popped up at left or right."
+ (let* ((scale (expt text-scale-mode-step text-scale-mode-amount))
+ ;; Calculate the number of items per line
+ (columns
+ (if horizontal
+ (ceiling (/ (* (length fkey-str-list) scale)
+ (- (frame-height) (if tool-bar-mode 2 0) (if menu-bar-mode 1 0))))
+ (floor (/ (frame-width)
+ (* (apply 'max (mapcar 'length fkey-str-list)) scale))))))
+ ;; Insert following keys by columns per line.
+ (loop for fkey-str in fkey-str-list
+ for column from 1
+ do (insert fkey-str (if (= (mod column columns) 0) "\n" " ")))
+ (align-regexp (point-min) (point-max) "\\(\\s-*\\) \\[" 1 1 t)))
+
+(defun guide-key/fontified-string (key space command &optional regexp)
+ "Return fontified string of following key"
+ (let ((highlight-face (guide-key/get-highlight-face command regexp)))
+ (concat (propertize "[" 'face 'guide-key/key-face)
+ (if highlight-face (propertize key 'face highlight-face) key)
+ (propertize "]" 'face 'guide-key/key-face)
+ (if guide-key/align-command-by-space-flag space " ") ; white space
+ (if highlight-face (propertize command 'face highlight-face) command))))
+
+(defun guide-key/get-highlight-face (string &optional regexp)
+ "Return an appropriate face for highlighting STRING according
+to `guide-key/highlight-prefix-regexp' and
+`guide-key/highlight-command-regexp'. Return nil if an
+appropriate face is not found."
+ (let ((regexp (or regexp guide-key/highlight-command-regexp)))
+ ;; `guide-key/highlight-prefix-regexp' has the highest priority
+ (if (string-match guide-key/highlight-prefix-regexp string)
+ 'guide-key/prefix-command-face
+ ;; Else look up the first match in `guide-key/highlight-command-regexp'
+ (cond ((stringp regexp)
+ (when (string-match regexp string)
+ 'guide-key/highlight-command-face))
+ ((listp regexp)
+ (loop for elm in regexp
+ if (cond ((stringp elm)
+ (when (string-match elm string)
+ 'guide-key/highlight-command-face))
+ ((consp elm)
+ (when (string-match (car elm) string)
+ (if (stringp (cdr elm))
+ ;; anonymous face, see (info "(elisp)Faces")
+ (list :foreground (cdr elm))
+ (cdr elm)))))
+ return it)))
+ )))
+
+(defun guide-key/buffer-max-width ()
+ "Return max width in current buffer."
+ (let ((buf-str (buffer-substring-no-properties (point-min) (point-max))))
+ (apply 'max (mapcar 'length (split-string buf-str "\n")))))
+
+(defun guide-key/add-local-guide-key-sequence (key)
+ (add-to-list (make-local-variable 'guide-key/guide-key-sequence) key))
+
+(defun guide-key/add-local-highlight-command-regexp (regexp)
+ (make-local-variable 'guide-key/highlight-command-regexp)
+ (cond ((stringp guide-key/highlight-command-regexp)
+ (setq guide-key/highlight-command-regexp
+ (list regexp guide-key/highlight-command-regexp)))
+ ((listp guide-key/highlight-command-regexp)
+ (add-to-list 'guide-key/highlight-command-regexp regexp))))
+
+;;; key-chord hack
+(defadvice this-command-keys (after key-chord-hack disable)
+ "Add key chord to the key sequence returned by `this-command-keys'.
+
+Original `this-command-keys' returns \"[key-chord]\" when you
+type any of key chords, so it is difficult to know which key
+chord is pressed. This advice enables to distinguish pressed key
+chord."
+ (condition-case nil
+ (if (equal ad-return-value [key-chord])
+ (let ((rkeys (recent-keys)))
+ (setq ad-return-value
+ (vector 'key-chord (aref rkeys (- (length rkeys) 2))
+ (aref rkeys (- (length rkeys) 1))))))
+ (error "")))
+
+(defadvice this-command-keys-vector (after key-chord-hack disable)
+ "Add key chord to the key sequence returned by `this-command-keys-vector'.
+
+Original `this-command-keys-vector' returns \"[key-chord]\" when you
+type any of key chords, so it is difficult to know which key
+chord is pressed. This advice enables to distinguish pressed key
+chord."
+ (condition-case nil
+ (if (equal ad-return-value [key-chord])
+ (let ((rkeys (recent-keys)))
+ (setq ad-return-value
+ (vector 'key-chord (aref rkeys (- (length rkeys) 2))
+ (aref rkeys (- (length rkeys) 1))))))
+ (error [])))
+
+(defun guide-key/key-chord-hack-on ()
+ "Turn on key-chord hack of guide-key.
+
+This hack *may be dangerous* because it advices primitive
+functions; this-command-keys and this-command-keys-vector."
+ (interactive)
+ (dolist (fn '(this-command-keys this-command-keys-vector))
+ (ad-enable-advice fn 'after 'key-chord-hack)
+ (ad-activate fn))
+ (message "Turn on key-chord hack of guide-key"))
+
+(defun guide-key/key-chord-hack-off ()
+ "Turn off key-chord hack of guide-key."
+ (interactive)
+ (dolist (fn '(this-command-keys this-command-keys-vector))
+ (ad-disable-advice fn 'after 'key-chord-hack)
+ (ad-activate fn))
+ (message "Turn off key-chord hack of guide-key"))
+
+;;; debug
+(defun guide-key/message-events ()
+ ""
+ (message (format "lce:%S tck:%S tckv:%S tsck:%S lie:%S uce:%S"
+ last-command-event
+ (this-command-keys)
+ (this-command-keys-vector)
+ (this-single-command-keys)
+ last-input-event
+ unread-command-events
+ )))
+;; (setq ttt (run-at-time t 1 'guide-key/message-events))
+;; (cancel-timer ttt)
+
+(provide 'guide-key)
+;;; guide-key.el ends here
--- /dev/null
+;;; popwin-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+
+(add-to-list 'load-path (directory-file-name
+ (or (file-name-directory #$) (car load-path))))
+
+\f
+;;;### (autoloads nil "popwin" "popwin.el" (0 0 0 0))
+;;; Generated autoloads from popwin.el
+
+(autoload 'popwin:popup-buffer "popwin" "\
+Show BUFFER in a popup window and return the popup window. If
+NOSELECT is non-nil, the popup window will not be selected. If
+STICK is non-nil, the popup window will be stuck. If TAIL is
+non-nil, the popup window will show the last contents. Calling
+`popwin:popup-buffer' during `popwin:popup-buffer' is allowed. In
+that case, the buffer of the popup window will be replaced with
+BUFFER.
+
+\(fn BUFFER &key (width popwin:popup-window-width) (height popwin:popup-window-height) (position popwin:popup-window-position) NOSELECT DEDICATED STICK TAIL)" t nil)
+
+(autoload 'popwin:display-buffer "popwin" "\
+Display BUFFER-OR-NAME, if possible, in a popup window, or as
+usual. This function can be used as a value of
+`display-buffer-function'.
+
+\(fn BUFFER-OR-NAME &optional NOT-THIS-WINDOW)" t nil)
+
+(autoload 'popwin:pop-to-buffer "popwin" "\
+Same as `pop-to-buffer' except that this function will use
+`popwin:display-buffer-1' instead of `display-buffer'.
+
+\(fn BUFFER &optional OTHER-WINDOW NORECORD)" t nil)
+
+(autoload 'popwin:universal-display "popwin" "\
+Call the following command interactively with letting
+`popwin:special-display-config' be
+`popwin:universal-display-config'. This will be useful when
+displaying buffers in popup windows temporarily.
+
+\(fn)" t nil)
+
+(autoload 'popwin:one-window "popwin" "\
+Delete other window than the popup window. C-g restores the
+original window configuration.
+
+\(fn)" t nil)
+
+(autoload 'popwin:popup-buffer-tail "popwin" "\
+Same as `popwin:popup-buffer' except that the buffer will be
+`recenter'ed at the bottom.
+
+\(fn &rest SAME-AS-POPWIN:POPUP-BUFFER)" t nil)
+
+(autoload 'popwin:find-file "popwin" "\
+Edit file FILENAME with popup window by `popwin:popup-buffer'.
+
+\(fn FILENAME &optional WILDCARDS)" t nil)
+
+(autoload 'popwin:find-file-tail "popwin" "\
+Edit file FILENAME with popup window by
+`popwin:popup-buffer-tail'.
+
+\(fn FILE &optional WILDCARD)" t nil)
+
+(autoload 'popwin:messages "popwin" "\
+Display *Messages* buffer in a popup window.
+
+\(fn)" t nil)
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "popwin" '("popwin")))
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; popwin-autoloads.el ends here
--- /dev/null
+;;; -*- no-byte-compile: t -*-
+(define-package "popwin" "20150315.1300" "Popup Window Manager." 'nil :commit "95dea14c60019d6cccf9a3b33e0dec4e1f22c304" :keywords '("convenience") :authors '(("Tomohiro Matsuyama" . "m2ym.pubNOSPAMgmail.com")) :maintainer '("Tomohiro Matsuyama" . "m2ym.pubNOSPAMgmail.com"))
--- /dev/null
+;;; popwin.el --- Popup Window Manager.
+
+;; Copyright (C) 2011-2015 Tomohiro Matsuyama
+
+;; Author: Tomohiro Matsuyama <m2ym.pubNOSPAMgmail.com>
+;; Keywords: convenience
+;; Package-Version: 20150315.1300
+;; Version: 1.0.0
+
+;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Popwin makes you free from the hell of annoying buffers such like
+;; *Help*, *Completions*, *compilation*, and etc.
+;;
+;; To use popwin, just add the following code into your .emacs:
+;;
+;; (require 'popwin)
+;; (popwin-mode 1)
+;;
+;; Then try to show some buffer, for example *Help* or
+;; *Completeions*. Unlike standard behavior, their buffers may be
+;; shown in a popup window at the bottom of the frame. And you can
+;; close the popup window seamlessly by typing C-g or selecting other
+;; windows.
+;;
+;; `popwin:display-buffer' displays special buffers in a popup window
+;; and displays normal buffers as unsual. Special buffers are
+;; specified in `popwin:special-display-config', which tells popwin
+;; how to display such buffers. See docstring of
+;; `popwin:special-display-config' for more information.
+;;
+;; The default width/height/position of popup window can be changed by
+;; setting `popwin:popup-window-width', `popwin:popup-window-height',
+;; and `popwin:popup-window-position'. You can also change the
+;; behavior for a specific buffer. See docstring of
+;; `popwin:special-display-config'.
+;;
+;; If you want to use some useful commands such like
+;; `popwin:popup-buffer' and `popwin:find-file' easily. you may bind
+;; `popwin:keymap' to `C-z', for example, like:
+;;
+;; (global-set-key (kbd "C-z") popwin:keymap)
+;;
+;; See also `popwin:keymap' documentation.
+;;
+;; Enjoy!
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(defconst popwin:version "1.0.0")
+
+\f
+
+;;; Utility
+
+(defun popwin:listify (object)
+ "Return a singleton list of OBJECT if OBJECT is an atom,
+otherwise OBJECT itself."
+ (if (atom object) (list object) object))
+
+(defun popwin:subsitute-in-tree (map tree)
+ (if (consp tree)
+ (cons (popwin:subsitute-in-tree map (car tree))
+ (popwin:subsitute-in-tree map (cdr tree)))
+ (or (cdr (assq tree map)) tree)))
+
+(defun popwin:get-buffer (buffer-or-name &optional if-not-found)
+ "Return a buffer named BUFFER-OR-NAME or BUFFER-OR-NAME itself
+if BUFFER-OR-NAME is a buffer. If BUFFER-OR-NAME is a string and
+such a buffer named BUFFER-OR-NAME not found, a new buffer will
+be returned when IF-NOT-FOUND is :create, or an error reported
+when IF-NOT-FOUND is :error. The default of value of IF-NOT-FOUND
+is :error."
+ (ecase (or if-not-found :error)
+ (:create
+ (get-buffer-create buffer-or-name))
+ (:error
+ (or (get-buffer buffer-or-name)
+ (error "No buffer named %s" buffer-or-name)))))
+
+(defun popwin:switch-to-buffer (buffer-or-name &optional norecord)
+ "Call `switch-to-buffer' forcing BUFFER-OF-NAME be displayed in
+the selected window."
+ (with-no-warnings
+ (if (>= emacs-major-version 24)
+ (switch-to-buffer buffer-or-name norecord t)
+ (switch-to-buffer buffer-or-name norecord))))
+
+(defun popwin:select-window (window &optional norecord)
+ "Call `select-window' with saving the current buffer."
+ (save-current-buffer
+ (select-window window norecord)))
+
+(defun popwin:buried-buffer-p (buffer)
+ "Return t if BUFFER might be thought of as a buried buffer."
+ (eq (car (last (buffer-list))) buffer))
+
+(defun popwin:window-point (window)
+ "Return window-point of WINDOW. If WINDOW is currently
+selected, then return buffer-point instead."
+ (if (eq (selected-window) window)
+ (with-current-buffer (window-buffer window)
+ (point))
+ (window-point window)))
+
+(defun popwin:window-deletable-p (window)
+ "Return t if WINDOW is deletable, meaning that WINDOW is alive
+and not a minibuffer's window, plus there is two or more windows."
+ (and (window-live-p window)
+ (not (window-minibuffer-p window))
+ (not (one-window-p))))
+
+(defmacro popwin:save-selected-window (&rest body)
+ "Evaluate BODY saving the selected window."
+ `(with-selected-window (selected-window) ,@body))
+
+(defun popwin:minibuffer-window-selected-p ()
+ "Return t if minibuffer window is selected."
+ (minibuffer-window-active-p (selected-window)))
+
+(defun popwin:last-selected-window ()
+ "Return currently selected window or lastly selected window if
+minibuffer window is selected."
+ (if (popwin:minibuffer-window-selected-p)
+ (minibuffer-selected-window)
+ (selected-window)))
+
+\f
+
+;;; Common
+
+(defvar popwin:debug nil)
+
+(defvar popwin:dummy-buffer nil)
+
+(defun popwin:dummy-buffer ()
+ (if (buffer-live-p popwin:dummy-buffer)
+ popwin:dummy-buffer
+ (setq popwin:dummy-buffer (get-buffer-create " *popwin-dummy*"))))
+
+(defun popwin:kill-dummy-buffer ()
+ (when (buffer-live-p popwin:dummy-buffer)
+ (kill-buffer popwin:dummy-buffer))
+ (setq popwin:dummy-buffer nil))
+
+(defun popwin:window-trailing-edge-adjustable-p (window)
+ "Return t if a trailing edge of WINDOW is adjustable."
+ (let ((next-window (next-window window)))
+ (and (not (eq next-window (frame-first-window)))
+ (not (eq (window-buffer next-window)
+ (popwin:dummy-buffer))))))
+
+(defun* popwin:adjust-window-edges (window
+ edges
+ &optional
+ (hfactor 1)
+ (vfactor 1))
+ "Adjust edges of WINDOW to EDGES accoring to horizontal factor
+HFACTOR, and vertical factor VFACTOR."
+ (when (popwin:window-trailing-edge-adjustable-p window)
+ (destructuring-bind ((left top right bottom)
+ (cur-left cur-top cur-right cur-bottom))
+ (list edges (window-edges window))
+ (let ((hdelta (floor (- (* (- right left) hfactor) (- cur-right cur-left))))
+ (vdelta (floor (- (* (- bottom top) vfactor) (- cur-bottom cur-top)))))
+ (ignore-errors
+ (adjust-window-trailing-edge window hdelta t))
+ (ignore-errors
+ (adjust-window-trailing-edge window vdelta nil))))))
+
+(defun popwin:window-config-tree-1 (node)
+ (if (windowp node)
+ (list 'window
+ node
+ (window-buffer node)
+ (popwin:window-point node)
+ (window-start node)
+ (window-edges node)
+ (eq (selected-window) node)
+ (window-dedicated-p node))
+ (destructuring-bind (dir edges . windows) node
+ (append (list dir edges)
+ (loop for window in windows
+ unless (and (windowp window)
+ (window-parameter window 'window-side))
+ collect (popwin:window-config-tree-1 window))))))
+
+(defun popwin:window-config-tree ()
+ "Return `window-tree' with replacing window values in the tree
+with persistent representations."
+ (destructuring-bind (root mini)
+ (window-tree)
+ (list (popwin:window-config-tree-1 root) mini)))
+
+(defun popwin:replicate-window-config (window node hfactor vfactor)
+ "Replicate NODE of window configuration on WINDOW with
+horizontal factor HFACTOR, and vertical factor VFACTOR. The
+return value is a association list of mapping from old-window to
+new-window."
+ (if (eq (car node) 'window)
+ (destructuring-bind (old-win buffer point start edges selected dedicated)
+ (cdr node)
+ (set-window-dedicated-p window nil)
+ (popwin:adjust-window-edges window edges hfactor vfactor)
+ (with-selected-window window
+ (popwin:switch-to-buffer buffer t))
+ (when selected
+ (popwin:select-window window))
+ (set-window-point window point)
+ (set-window-start window start t)
+ (when dedicated
+ (set-window-dedicated-p window t))
+ `((,old-win . ,window)))
+ (destructuring-bind (dir edges . windows) node
+ (loop while windows
+ for sub-node = (pop windows)
+ for win = window then next-win
+ for next-win = (and windows (split-window win nil (not dir)))
+ append (popwin:replicate-window-config win sub-node hfactor vfactor)))))
+
+(defun popwin:restore-window-outline (node outline)
+ "Restore window outline accoding to the structures of NODE
+which is a node of `window-tree' and OUTLINE which is a node of
+`popwin:window-config-tree'."
+ (cond
+ ((and (windowp node)
+ (eq (car outline) 'window))
+ ;; same window
+ (destructuring-bind (old-win buffer point start edges selected dedicated)
+ (cdr outline)
+ (popwin:adjust-window-edges node edges)
+ (when (and (eq (window-buffer node) buffer)
+ (eq (popwin:window-point node) point))
+ (set-window-start node start))))
+ ((or (windowp node)
+ (not (eq (car node) (car outline))))
+ ;; different structure
+ ;; nothing to do
+ )
+ (t
+ (let ((child-nodes (cddr node))
+ (child-outlines (cddr outline)))
+ (when (eq (length child-nodes) (length child-outlines))
+ ;; same structure
+ (loop for child-node in child-nodes
+ for child-outline in child-outlines
+ do (popwin:restore-window-outline child-node child-outline)))))))
+
+(defun popwin:position-horizontal-p (position)
+ "Return t if POSITION is hozirontal."
+ (and (memq position '(left :left right :right)) t))
+
+(defun popwin:position-vertical-p (position)
+ "Return t if POSITION is vertical."
+ (and (memq position '(top :top bottom :bottom)) t))
+
+(defun popwin:create-popup-window-1 (window size position)
+ "Create a new window with SIZE at POSITION of WINDOW. The
+return value is a list of a master window and the popup window."
+ (let ((width (window-width window))
+ (height (window-height window)))
+ (ecase position
+ ((left :left)
+ (list (split-window window size t)
+ window))
+ ((top :top)
+ (list (split-window window size nil)
+ window))
+ ((right :right)
+ (list window
+ (split-window window (- width size) t)))
+ ((bottom :bottom)
+ (list window
+ (split-window window (- height size) nil))))))
+
+(defun* popwin:create-popup-window (&optional (size 15) (position 'bottom) (adjust t))
+ "Create a popup window with SIZE on the frame. If SIZE
+is integer, the size of the popup window will be SIZE. If SIZE is
+float, the size of popup window will be a multiplier of SIZE and
+frame-size. can be an integer and a float. If ADJUST is t, all of
+windows will be adjusted to fit the frame. POSITION must be one
+of (left top right bottom). The return value is a pair of a
+master window and the popup window. To close the popup window
+properly, get `current-window-configuration' before calling this
+function, and call `set-window-configuration' with the
+window-configuration."
+ (let* ((root (car (popwin:window-config-tree)))
+ (root-win (popwin:last-selected-window))
+ (hfactor 1)
+ (vfactor 1))
+ (popwin:save-selected-window
+ (delete-other-windows root-win))
+ (let ((root-width (window-width root-win))
+ (root-height (window-height root-win)))
+ (when adjust
+ (if (floatp size)
+ (if (popwin:position-horizontal-p position)
+ (setq hfactor (- 1.0 size)
+ size (round (* root-width size)))
+ (setq vfactor (- 1.0 size)
+ size (round (* root-height size))))
+ (if (popwin:position-horizontal-p position)
+ (setq hfactor (/ (float (- root-width size)) root-width))
+ (setq vfactor (/ (float (- root-height size)) root-height)))))
+ (destructuring-bind (master-win popup-win)
+ (popwin:create-popup-window-1 root-win size position)
+ ;; Mark popup-win being a popup window.
+ (with-selected-window popup-win
+ (popwin:switch-to-buffer (popwin:dummy-buffer) t))
+ (let ((win-map (popwin:replicate-window-config master-win root hfactor vfactor)))
+ (list master-win popup-win win-map))))))
+
+\f
+
+;;; Common User Interface
+
+(defgroup popwin nil
+ "Popup Window Manager."
+ :group 'convenience
+ :prefix "popwin:")
+
+(defcustom popwin:popup-window-position 'bottom
+ "Default popup window position. This must be one of (left top right
+bottom)."
+ :type 'symbol
+ :group 'popwin)
+
+(defcustom popwin:popup-window-width 30
+ "Default popup window width. If `popwin:popup-window-position'
+is top or bottom, this configuration will be ignored. If this
+variable is float, the popup window width will be a multiplier of
+the value and frame-size."
+ :type 'number
+ :group 'popwin)
+
+(defcustom popwin:popup-window-height 15
+ "Default popup window height. If `popwin:popup-window-position'
+is left or right, this configuration will be ignored. If this
+variable is float, the popup window height will be a multiplier
+of the value and frame-size."
+ :type 'number
+ :group 'popwin)
+
+(defcustom popwin:reuse-window 'current
+ "Non-nil means `popwin:display-buffer' will not popup the
+visible buffer. The value is same as a second argument of
+`get-buffer-window', except `current' means the selected frame."
+ :group 'popwin)
+
+(defcustom popwin:adjust-other-windows t
+ "Non-nil means all of other windows will be adjusted to fit the
+frame when a popup window is shown."
+ :type 'boolean
+ :group 'popwin)
+
+(defvar popwin:context-stack nil)
+
+(defvar popwin:popup-window nil
+ "Main popup window instance.")
+
+(defvar popwin:popup-buffer nil
+ "Buffer of currently shown in the popup window.")
+
+(defvar popwin:popup-last-config nil
+ "Arguments to `popwin:popup-buffer' of last call.")
+
+;; Deprecated
+(defvar popwin:master-window nil
+ "Master window of a popup window.")
+
+(defvar popwin:focus-window nil
+ "Focused window which is used to check whether or not to close
+the popup window.")
+
+(defvar popwin:selected-window nil
+ "Last selected window when the popup window is shown.")
+
+(defvar popwin:popup-window-dedicated-p nil
+ "Non-nil means the popup window is dedicated to the original
+popup buffer.")
+
+(defvar popwin:popup-window-stuck-p nil
+ "Non-nil means the popup window has been stuck.")
+
+(defvar popwin:window-outline nil
+ "Original window outline which is obtained by
+`popwin:window-config-tree'.")
+
+(defvar popwin:window-map nil
+ "Mapping from old windows to new windows.")
+
+(defvar popwin:window-config nil
+ "An original window configuration for restoreing.")
+
+(defvar popwin:close-popup-window-timer nil
+ "Timer of closing the popup window.")
+
+(defvar popwin:close-popup-window-timer-interval 0.05
+ "Interval of `popwin:close-popup-window-timer'.")
+
+(defvar popwin:before-popup-hook nil)
+
+(defvar popwin:after-popup-hook nil)
+
+(symbol-macrolet ((context-vars '(popwin:popup-window
+ popwin:popup-buffer
+ popwin:master-window
+ popwin:focus-window
+ popwin:selected-window
+ popwin:popup-window-dedicated-p
+ popwin:popup-window-stuck-p
+ popwin:window-outline
+ popwin:window-map)))
+ (defun popwin:valid-context-p (context)
+ (window-live-p (plist-get context 'popwin:popup-window)))
+
+ (defun popwin:current-context ()
+ (loop for var in context-vars
+ collect var
+ collect (symbol-value var)))
+
+ (defun popwin:use-context (context)
+ (loop for var = (pop context)
+ for val = (pop context)
+ while var
+ do (set var val)))
+
+ (defun popwin:push-context ()
+ (push (popwin:current-context) popwin:context-stack))
+
+ (defun popwin:pop-context ()
+ (popwin:use-context (pop popwin:context-stack)))
+
+ (defun* popwin:find-context-for-buffer (buffer &key valid-only)
+ (loop with stack = popwin:context-stack
+ for context = (pop stack)
+ while context
+ if (and (eq buffer (plist-get context 'popwin:popup-buffer))
+ (or (not valid-only)
+ (popwin:valid-context-p context)))
+ return (list context stack))))
+
+(defun popwin:popup-window-live-p ()
+ "Return t if `popwin:popup-window' is alive."
+ (window-live-p popwin:popup-window))
+
+(defun* popwin:update-window-reference (symbol
+ &key
+ (map popwin:window-map)
+ safe
+ recursive)
+ (unless (and safe (not (boundp symbol)))
+ (let ((value (symbol-value symbol)))
+ (set symbol
+ (if recursive
+ (popwin:subsitute-in-tree map value)
+ (or (cdr (assq value map)) value))))))
+
+(defun popwin:start-close-popup-window-timer ()
+ (or popwin:close-popup-window-timer
+ (setq popwin:close-popup-window-timer
+ (run-with-idle-timer popwin:close-popup-window-timer-interval
+ popwin:close-popup-window-timer-interval
+ 'popwin:close-popup-window-timer))))
+
+(defun popwin:stop-close-popup-window-timer ()
+ (when popwin:close-popup-window-timer
+ (cancel-timer popwin:close-popup-window-timer)
+ (setq popwin:close-popup-window-timer nil)))
+
+(defun popwin:close-popup-window-timer ()
+ (condition-case var
+ (popwin:close-popup-window-if-necessary)
+ (error
+ (message "popwin:close-popup-window-timer: error: %s" var)
+ (when popwin:debug (backtrace)))))
+
+(defun popwin:close-popup-window (&optional keep-selected)
+ "Close the popup window and restore to the previous window
+configuration. If KEEP-SELECTED is non-nil, the lastly selected
+window will not be selected."
+ (interactive)
+ (when popwin:popup-window
+ (unwind-protect
+ (progn
+ (when (popwin:window-deletable-p popwin:popup-window)
+ (delete-window popwin:popup-window))
+ (popwin:restore-window-outline (car (window-tree)) popwin:window-outline)
+ ;; Call `redisplay' here so `window-start' could be set
+ ;; prior to the point change of the master buffer.
+ (redisplay)
+ (when (and (not keep-selected)
+ (window-live-p popwin:selected-window))
+ (select-window popwin:selected-window)))
+ (popwin:pop-context)
+ ;; Cleanup if no context left.
+ (when (null popwin:context-stack)
+ (popwin:kill-dummy-buffer)
+ (popwin:stop-close-popup-window-timer)))))
+
+(defun popwin:close-popup-window-if-necessary ()
+ "Close the popup window if necessary. The all situations where
+the popup window will be closed are followings:
+
+* `C-g' has been pressed.
+* The popup buffer has been killed.
+* The popup buffer has been buried.
+* The popup buffer has been changed if the popup window is
+ dedicated to the buffer.
+* Another window has been selected."
+ (when popwin:popup-window
+ (let* ((window (selected-window))
+ (window-point (popwin:window-point window))
+ (window-buffer (window-buffer window))
+ (minibuf-window-p (window-minibuffer-p window))
+ (reading-from-minibuf
+ (and minibuf-window-p
+ (minibuffer-prompt)
+ t))
+ (quit-requested
+ (and (eq last-command 'keyboard-quit)
+ (eq last-command-event ?\C-g)))
+ (other-window-selected
+ (and (not (eq window popwin:focus-window))
+ (not (eq window popwin:popup-window))))
+ (orig-this-command this-command)
+ (popup-buffer-alive
+ (buffer-live-p popwin:popup-buffer))
+ (popup-buffer-buried
+ (popwin:buried-buffer-p popwin:popup-buffer))
+ (popup-buffer-changed-despite-of-dedicated
+ (and popwin:popup-window-dedicated-p
+ (not popwin:popup-window-stuck-p)
+ (or (not other-window-selected)
+ (not reading-from-minibuf))
+ (buffer-live-p window-buffer)
+ (not (eq popwin:popup-buffer window-buffer))))
+ (popup-window-alive (popwin:popup-window-live-p)))
+ (when (or quit-requested
+ (not popup-buffer-alive)
+ popup-buffer-buried
+ popup-buffer-changed-despite-of-dedicated
+ (not popup-window-alive)
+ (and other-window-selected
+ (not minibuf-window-p)
+ (not popwin:popup-window-stuck-p)))
+ (when popwin:debug
+ (message (concat "popwin: CLOSE:\n"
+ " quit-requested = %s\n"
+ " popup-buffer-alive = %s\n"
+ " popup-buffer-buried = %s\n"
+ " popup-buffer-changed-despite-of-dedicated = %s\n"
+ " popup-window-alive = %s\n"
+ " (selected-window) = %s\n"
+ " popwin:focus-window = %s\n"
+ " popwin:popup-window = %s\n"
+ " other-window-selected = %s\n"
+ " minibuf-window-p = %s\n"
+ " popwin:popup-window-stuck-p = %s")
+ quit-requested
+ popup-buffer-alive
+ popup-buffer-buried
+ popup-buffer-changed-despite-of-dedicated
+ popup-window-alive
+ window
+ popwin:focus-window
+ popwin:popup-window
+ other-window-selected
+ minibuf-window-p
+ popwin:popup-window-stuck-p))
+ (when (and quit-requested
+ (null orig-this-command))
+ (setq this-command 'popwin:close-popup-window)
+ (run-hooks 'pre-command-hook))
+ (cond
+ ((and quit-requested
+ (null orig-this-command)
+ popwin:window-config)
+ (set-window-configuration popwin:window-config)
+ (setq popwin:window-config nil))
+ (reading-from-minibuf
+ (popwin:close-popup-window)
+ (select-window (minibuffer-window)))
+ (t
+ (popwin:close-popup-window
+ (and other-window-selected
+ (and popup-buffer-alive
+ (not popup-buffer-buried))))
+ (when popup-buffer-changed-despite-of-dedicated
+ (popwin:switch-to-buffer window-buffer)
+ (goto-char window-point))))
+ (when (and quit-requested
+ (null orig-this-command))
+ (run-hooks 'post-command-hook)
+ (setq last-command 'popwin:close-popup-window))))))
+
+;;;###autoload
+(defun* popwin:popup-buffer (buffer
+ &key
+ (width popwin:popup-window-width)
+ (height popwin:popup-window-height)
+ (position popwin:popup-window-position)
+ noselect
+ dedicated
+ stick
+ tail)
+ "Show BUFFER in a popup window and return the popup window. If
+NOSELECT is non-nil, the popup window will not be selected. If
+STICK is non-nil, the popup window will be stuck. If TAIL is
+non-nil, the popup window will show the last contents. Calling
+`popwin:popup-buffer' during `popwin:popup-buffer' is allowed. In
+that case, the buffer of the popup window will be replaced with
+BUFFER."
+ (interactive "BPopup buffer:\n")
+ (setq buffer (get-buffer buffer))
+ (popwin:push-context)
+ (run-hooks 'popwin:before-popup-hook)
+ (multiple-value-bind (context context-stack)
+ (popwin:find-context-for-buffer buffer :valid-only t)
+ (if context
+ (progn
+ (popwin:use-context context)
+ (setq popwin:context-stack context-stack))
+ (let ((win-outline (car (popwin:window-config-tree))))
+ (destructuring-bind (master-win popup-win win-map)
+ (let ((size (if (popwin:position-horizontal-p position) width height))
+ (adjust popwin:adjust-other-windows))
+ (popwin:create-popup-window size position adjust))
+ (setq popwin:popup-window popup-win
+ popwin:master-window master-win
+ popwin:window-outline win-outline
+ popwin:window-map win-map
+ popwin:window-config nil
+ popwin:selected-window (selected-window)))
+ (popwin:update-window-reference 'popwin:context-stack :recursive t)
+ (popwin:start-close-popup-window-timer))
+ (with-selected-window popwin:popup-window
+ (popwin:switch-to-buffer buffer)
+ (when tail
+ (set-window-point popwin:popup-window (point-max))
+ (recenter -2)))
+ (setq popwin:popup-buffer buffer
+ popwin:popup-last-config (list buffer
+ :width width :height height :position position
+ :noselect noselect :dedicated dedicated
+ :stick stick :tail tail)
+ popwin:popup-window-dedicated-p dedicated
+ popwin:popup-window-stuck-p stick)))
+ (if noselect
+ (setq popwin:focus-window popwin:selected-window)
+ (setq popwin:focus-window popwin:popup-window)
+ (select-window popwin:popup-window))
+ (run-hooks 'popwin:after-popup-hook)
+ popwin:popup-window)
+
+(defun popwin:popup-last-buffer (&optional noselect)
+ "Show the last popup buffer with the same configuration. If
+NOSELECT is non-nil, the popup window will not be selected."
+ (interactive "P")
+ (if popwin:popup-last-config
+ (if noselect
+ (destructuring-bind (buffer . keyargs) popwin:popup-last-config
+ (apply 'popwin:popup-buffer buffer :noselect t keyargs))
+ (apply 'popwin:popup-buffer popwin:popup-last-config))
+ (error "No popup buffer ever")))
+(defalias 'popwin:display-last-buffer 'popwin:popup-last-buffer)
+
+(defun popwin:select-popup-window ()
+ "Select the currently shown popup window."
+ (interactive)
+ (if (popwin:popup-window-live-p)
+ (select-window popwin:popup-window)
+ (error "No popup window displayed")))
+
+(defun popwin:stick-popup-window ()
+ "Stick the currently shown popup window. The popup window can
+be closed by `popwin:close-popup-window'."
+ (interactive)
+ (if (popwin:popup-window-live-p)
+ (progn
+ (setq popwin:popup-window-stuck-p t)
+ (message "Popup window stuck"))
+ (error "No popup window displayed")))
+
+\f
+
+;;; Special Display
+
+(defmacro popwin:without-special-displaying (&rest body)
+ "Evaluate BODY without special displaying."
+ (if (boundp 'display-buffer-alist)
+ `(with-no-warnings
+ (let ((display-buffer-function nil)
+ (display-buffer-alist
+ (remove '(popwin:display-buffer-condition
+ popwin:display-buffer-action)
+ display-buffer-alist)))
+ ,@body))
+ `(with-no-warnings (let ((display-buffer-function nil)) ,@body))))
+
+(defcustom popwin:special-display-config
+ '(;; Emacs
+ ("*Miniedit Help*" :noselect t)
+ help-mode
+ (completion-list-mode :noselect t)
+ (compilation-mode :noselect t)
+ (grep-mode :noselect t)
+ (occur-mode :noselect t)
+ ("*Pp Macroexpand Output*" :noselect t)
+ "*Shell Command Output*"
+ ;; VC
+ "*vc-diff*"
+ "*vc-change-log*"
+ ;; Undo-Tree
+ (" *undo-tree*" :width 60 :position right)
+ ;; Anything
+ ("^\\*anything.*\\*$" :regexp t)
+ ;; SLIME
+ "*slime-apropos*"
+ "*slime-macroexpansion*"
+ "*slime-description*"
+ ("*slime-compilation*" :noselect t)
+ "*slime-xref*"
+ (sldb-mode :stick t)
+ slime-repl-mode
+ slime-connection-list-mode)
+ "Configuration of special displaying buffer for
+`popwin:display-buffer' and
+`popwin:special-display-popup-window'. The value is a list of
+CONFIG as a form of (PATTERN . KEYWORDS) where PATTERN is a
+pattern of specifying buffer and KEYWORDS is a list of a pair of
+key and value. PATTERN is in general a buffer name, a symbol
+specifying major-mode of buffer, or a predicate function which
+takes one argument: the buffer. If CONFIG is a string or a
+symbol, PATTERN will be CONFIG and KEYWORDS will be
+empty. Available keywords are following:
+
+ regexp: If the value is non-nil, PATTERN will be used as regexp
+ to matching buffer.
+
+ width, height: Specify width or height of the popup window. If
+ no size specified, `popwin:popup-window-width' or
+ `popwin:popup-window-height' will be used. See also position
+ keyword.
+
+ position: The value must be one of (left top right bottom). The
+ popup window will shown at the position of the frame. If no
+ position specified, `popwin:popup-window-position' will be
+ used.
+
+ noselect: If the value is non-nil, the popup window will not be
+ selected when it is shown.
+
+ dedicated: If the value is non-nil, the popup window will be
+ dedicated to the original popup buffer. In this case, when
+ another buffer is selected in the popup window, the popup
+ window will be closed immedicately and the selected buffer
+ will be shown on the previously selected window.
+
+ stick: If the value is non-nil, the popup window will be stuck
+ when it is shown.
+
+ tail: If the value is non-nil, the popup window will show the
+ last contents.
+
+Examples: With '(\"*scratch*\" :height 30 :position top),
+*scratch* buffer will be shown at the top of the frame with
+height 30. With '(dired-mode :width 80 :position left), dired
+buffers will be shown at the left of the frame with width 80."
+ :type '(repeat
+ (cons :tag "Config"
+ (choice :tag "Pattern"
+ (string :tag "Buffer Name")
+ (symbol :tag "Major Mode"))
+ (plist :tag "Keywords"
+ :value (:regexp nil) ; BUG? need default value
+ :options
+ ((:regexp (boolean :tag "On/Off"))
+ (:width (choice :tag "Width"
+ (integer :tag "Width")
+ (float :tag "Width (%)")))
+ (:height (choice :tag "Height"
+ (integer :tag "Height")
+ (float :tag "Height (%)")))
+ (:position (choice :tag "Position"
+ (const :tag "Bottom" bottom)
+ (const :tag "Top" top)
+ (const :tag "Left" left)
+ (const :tag "Right" right)))
+ (:noselect (boolean :tag "On/Off"))
+ (:dedicated (boolean :tag "On/Off"))
+ (:stick (boolean :tag "On/Off"))
+ (:tail (boolean :tag "On/Off"))))))
+ :get (lambda (symbol)
+ (mapcar (lambda (element)
+ (if (consp element)
+ element
+ (list element)))
+ (default-value symbol)))
+ :group 'popwin)
+
+(defun popwin:apply-display-buffer (function buffer &optional not-this-window)
+ "Call FUNCTION on BUFFER without special displaying."
+ (popwin:without-special-displaying
+ (let ((same-window
+ (or (same-window-p (buffer-name buffer))
+ (and (>= emacs-major-version 24)
+ (boundp 'action)
+ (consp action)
+ (eq (car action) 'display-buffer-same-window)))))
+ ;; Close the popup window here so that the popup window won't to
+ ;; be splitted.
+ (when (and (eq (selected-window) popwin:popup-window)
+ (not same-window))
+ (popwin:close-popup-window)))
+ (if (and (>= emacs-major-version 24)
+ (boundp 'action)
+ (boundp 'frame))
+ ;; Use variables ACTION and FRAME which are formal parameters
+ ;; of DISPLAY-BUFFER.
+ ;;
+ ;; TODO use display-buffer-alist instead of
+ ;; display-buffer-function.
+ (funcall function buffer action frame)
+ (funcall function buffer not-this-window))))
+
+(defun popwin:original-display-buffer (buffer &optional not-this-window)
+ "Call `display-buffer' on BUFFER without special displaying."
+ (popwin:apply-display-buffer 'display-buffer buffer not-this-window))
+
+(defun popwin:original-pop-to-buffer (buffer &optional not-this-window)
+ "Call `pop-to-buffer' on BUFFER without special displaying."
+ (popwin:apply-display-buffer 'pop-to-buffer buffer not-this-window))
+
+(defun popwin:original-display-last-buffer ()
+ "Call `display-buffer' for the last popup buffer without
+special displaying."
+ (interactive)
+ (if popwin:popup-last-config
+ (popwin:original-display-buffer (car popwin:popup-last-config))
+ (error "No popup buffer ever")))
+
+(defun popwin:switch-to-last-buffer ()
+ "Switch to the last popup buffer."
+ (interactive)
+ (if popwin:popup-last-config
+ (popwin:apply-display-buffer
+ (lambda (buffer &rest ignore) (switch-to-buffer buffer))
+ (car popwin:popup-last-config))
+ (error "No popup buffer ever")))
+
+(defun popwin:original-pop-to-last-buffer ()
+ "Call `pop-to-buffer' for the last popup buffer without
+special displaying."
+ (interactive)
+ (if popwin:popup-last-config
+ (popwin:original-pop-to-buffer (car popwin:popup-last-config))
+ (error "No popup buffer ever")))
+
+(defun popwin:reuse-window-p (buffer-or-name not-this-window)
+ "Return t if a window showing BUFFER-OR-NAME exists and should
+be used displaying the buffer."
+ (and popwin:reuse-window
+ (let ((window (get-buffer-window buffer-or-name
+ (if (eq popwin:reuse-window 'current)
+ nil
+ popwin:reuse-window))))
+ (and (not (null window))
+ (not (eq window (if not-this-window (selected-window))))))))
+
+(defun* popwin:match-config (buffer)
+ (when (stringp buffer) (setq buffer (get-buffer buffer)))
+ (loop with name = (buffer-name buffer)
+ with mode = (buffer-local-value 'major-mode buffer)
+ for config in popwin:special-display-config
+ for (pattern . keywords) = (popwin:listify config)
+ if (cond ((eq pattern t) t)
+ ((and (stringp pattern) (plist-get keywords :regexp))
+ (string-match pattern name))
+ ((stringp pattern)
+ (string= pattern name))
+ ((symbolp pattern)
+ (eq pattern mode))
+ ((functionp pattern)
+ (funcall pattern buffer))
+ (t (error "Invalid pattern: %s" pattern)))
+ return (cons pattern keywords)))
+
+(defun* popwin:display-buffer-1 (buffer-or-name
+ &key
+ default-config-keywords
+ (if-buffer-not-found :create)
+ if-config-not-found)
+ "Display BUFFER-OR-NAME, if possible, in a popup
+window. Otherwise call IF-CONFIG-NOT-FOUND with BUFFER-OR-NAME if
+the value is a function. If IF-CONFIG-NOT-FOUND is nil,
+`popwin:popup-buffer' will be called. IF-BUFFER-NOT-FOUND
+indicates what happens when there is no such buffers. If the
+value is :create, create a new buffer named BUFFER-OR-NAME. If
+the value is :error, report an error. The default value
+is :create. DEFAULT-CONFIG-KEYWORDS is a property list which
+specifies default values of the config."
+ (let* ((buffer (popwin:get-buffer buffer-or-name if-buffer-not-found))
+ (pattern-and-keywords (popwin:match-config buffer)))
+ (unless pattern-and-keywords
+ (if if-config-not-found
+ (return-from popwin:display-buffer-1
+ (funcall if-config-not-found buffer))
+ (setq pattern-and-keywords '(t))))
+ (destructuring-bind (&key regexp width height position noselect dedicated stick tail)
+ (append (cdr pattern-and-keywords) default-config-keywords)
+ (popwin:popup-buffer buffer
+ :width (or width popwin:popup-window-width)
+ :height (or height popwin:popup-window-height)
+ :position (or position popwin:popup-window-position)
+ :noselect (or (popwin:minibuffer-window-selected-p) noselect)
+ :dedicated dedicated
+ :stick stick
+ :tail tail))))
+
+;;;###autoload
+(defun popwin:display-buffer (buffer-or-name &optional not-this-window)
+ "Display BUFFER-OR-NAME, if possible, in a popup window, or as
+usual. This function can be used as a value of
+`display-buffer-function'."
+ (interactive "BDisplay buffer:\n")
+ (if (popwin:reuse-window-p buffer-or-name not-this-window)
+ ;; Call `display-buffer' for reuse.
+ (popwin:original-display-buffer buffer-or-name not-this-window)
+ (popwin:display-buffer-1
+ buffer-or-name
+ :if-config-not-found
+ (unless (with-no-warnings
+ ;; FIXME: emacs bug?
+ (called-interactively-p))
+ (lambda (buffer)
+ (popwin:original-display-buffer buffer not-this-window))))))
+
+(defun popwin:special-display-popup-window (buffer &rest ignore)
+ "Obsolete."
+ (popwin:display-buffer-1 buffer))
+
+(defun* popwin:pop-to-buffer-1 (buffer
+ &key
+ default-config-keywords
+ other-window
+ norecord)
+ (popwin:display-buffer-1 buffer
+ :default-config-keywords default-config-keywords
+ :if-config-not-found
+ (lambda (buffer)
+ (pop-to-buffer buffer other-window norecord))))
+
+;;;###autoload
+(defun popwin:pop-to-buffer (buffer &optional other-window norecord)
+ "Same as `pop-to-buffer' except that this function will use
+`popwin:display-buffer-1' instead of `display-buffer'."
+ (interactive (list (read-buffer "Pop to buffer: " (other-buffer))
+ (if current-prefix-arg t)))
+ (popwin:pop-to-buffer-1 buffer
+ :other-window other-window
+ :norecord norecord))
+
+\f
+
+;;; Universal Display
+
+(defcustom popwin:universal-display-config '(t)
+ "Same as `popwin:special-display-config' except that this will
+be used for `popwin:universal-display'."
+ :group 'popwin)
+
+;;;###autoload
+(defun popwin:universal-display ()
+ "Call the following command interactively with letting
+`popwin:special-display-config' be
+`popwin:universal-display-config'. This will be useful when
+displaying buffers in popup windows temporarily."
+ (interactive)
+ (let ((command (key-binding (read-key-sequence "" t)))
+ (popwin:special-display-config popwin:universal-display-config))
+ (call-interactively command)))
+
+\f
+
+;;; Extensions
+
+;;;###autoload
+(defun popwin:one-window ()
+ "Delete other window than the popup window. C-g restores the
+original window configuration."
+ (interactive)
+ (setq popwin:window-config (current-window-configuration))
+ (delete-other-windows))
+
+;;;###autoload
+(defun popwin:popup-buffer-tail (&rest same-as-popwin:popup-buffer)
+ "Same as `popwin:popup-buffer' except that the buffer will be
+`recenter'ed at the bottom."
+ (interactive "bPopup buffer:\n")
+ (destructuring-bind (buffer . keyargs) same-as-popwin:popup-buffer
+ (apply 'popwin:popup-buffer buffer :tail t keyargs)))
+
+;;;###autoload
+(defun popwin:find-file (filename &optional wildcards)
+ "Edit file FILENAME with popup window by `popwin:popup-buffer'."
+ (interactive
+ (find-file-read-args "Find file in popup window: "
+ (when (fboundp 'confirm-nonexistent-file-or-buffer)
+ (confirm-nonexistent-file-or-buffer))))
+ (popwin:popup-buffer (find-file-noselect filename wildcards)))
+
+;;;###autoload
+(defun popwin:find-file-tail (file &optional wildcard)
+ "Edit file FILENAME with popup window by
+`popwin:popup-buffer-tail'."
+ (interactive
+ (find-file-read-args "Find file in popup window: "
+ (when (fboundp 'confirm-nonexistent-file-or-buffer)
+ (confirm-nonexistent-file-or-buffer))))
+ (popwin:popup-buffer-tail (find-file-noselect file wildcard)))
+
+;;;###autoload
+(defun popwin:messages ()
+ "Display *Messages* buffer in a popup window."
+ (interactive)
+ (popwin:popup-buffer-tail "*Messages*"))
+
+\f
+
+;;; Minor Mode
+
+(defun popwin:display-buffer-condition (buffer action)
+ (and (popwin:match-config buffer) t))
+
+(defun popwin:display-buffer-action (buffer alist)
+ (let ((not-this-window (plist-get 'inhibit-same-window alist)))
+ (popwin:display-buffer buffer not-this-window)))
+
+(define-minor-mode popwin-mode
+ ""
+ :init-value nil
+ :global t
+ (if (boundp 'display-buffer-alist)
+ (let ((pair '(popwin:display-buffer-condition popwin:display-buffer-action)))
+ (if popwin-mode
+ (push pair display-buffer-alist)
+ (setq display-buffer-alist (delete pair display-buffer-alist))))
+ (with-no-warnings
+ (unless (or (null display-buffer-function)
+ (eq display-buffer-function 'popwin:display-buffer))
+ (warn "Overwriting display-buffer-function variable to enable/disable popwin-mode"))
+ (setq display-buffer-function (if popwin-mode 'popwin:display-buffer nil)))))
+
+\f
+
+;;; Keymaps
+
+(defvar popwin:keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map "b" 'popwin:popup-buffer)
+ (define-key map "l" 'popwin:popup-last-buffer)
+ (define-key map "o" 'popwin:display-buffer)
+ (define-key map "\C-b" 'popwin:switch-to-last-buffer)
+ (define-key map "\C-p" 'popwin:original-pop-to-last-buffer)
+ (define-key map "\C-o" 'popwin:original-display-last-buffer)
+ (define-key map " " 'popwin:select-popup-window)
+ (define-key map "s" 'popwin:stick-popup-window)
+ (define-key map "0" 'popwin:close-popup-window)
+ (define-key map "f" 'popwin:find-file)
+ (define-key map "\C-f" 'popwin:find-file)
+ (define-key map "e" 'popwin:messages)
+ (define-key map "\C-u" 'popwin:universal-display)
+ (define-key map "1" 'popwin:one-window)
+
+ map)
+ "Default keymap for popwin commands. Use like:
+\(global-set-key (kbd \"C-z\") popwin:keymap\)
+
+Keymap:
+
+| Key | Command |
+|--------+---------------------------------------|
+| b | popwin:popup-buffer |
+| l | popwin:popup-last-buffer |
+| o | popwin:display-buffer |
+| C-b | popwin:switch-to-last-buffer |
+| C-p | popwin:original-pop-to-last-buffer |
+| C-o | popwin:original-display-last-buffer |
+| SPC | popwin:select-popup-window |
+| s | popwin:stick-popup-window |
+| 0 | popwin:close-popup-window |
+| f, C-f | popwin:find-file |
+| e | popwin:messages |
+| C-u | popwin:universal-display |
+| 1 | popwin:one-window |")
+
+(provide 'popwin)
+;;; popwin.el ends here
+++ /dev/null
-;;; popwin-autoloads.el --- automatically extracted autoloads
-;;
-;;; Code:
-(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
-\f
-;;;### (autoloads nil "popwin" "popwin.el" (21908 14200 0 0))
-;;; Generated autoloads from popwin.el
-
-(autoload 'popwin:popup-buffer "popwin" "\
-Show BUFFER in a popup window and return the popup window. If
-NOSELECT is non-nil, the popup window will not be selected. If
-STICK is non-nil, the popup window will be stuck. If TAIL is
-non-nil, the popup window will show the last contents. Calling
-`popwin:popup-buffer' during `popwin:popup-buffer' is allowed. In
-that case, the buffer of the popup window will be replaced with
-BUFFER.
-
-\(fn BUFFER &key (width popwin:popup-window-width) (height popwin:popup-window-height) (position popwin:popup-window-position) NOSELECT DEDICATED STICK TAIL)" t nil)
-
-(autoload 'popwin:display-buffer "popwin" "\
-Display BUFFER-OR-NAME, if possible, in a popup window, or as
-usual. This function can be used as a value of
-`display-buffer-function'.
-
-\(fn BUFFER-OR-NAME &optional NOT-THIS-WINDOW)" t nil)
-
-(autoload 'popwin:pop-to-buffer "popwin" "\
-Same as `pop-to-buffer' except that this function will use
-`popwin:display-buffer-1' instead of `display-buffer'.
-
-\(fn BUFFER &optional OTHER-WINDOW NORECORD)" t nil)
-
-(autoload 'popwin:universal-display "popwin" "\
-Call the following command interactively with letting
-`popwin:special-display-config' be
-`popwin:universal-display-config'. This will be useful when
-displaying buffers in popup windows temporarily.
-
-\(fn)" t nil)
-
-(autoload 'popwin:one-window "popwin" "\
-Delete other window than the popup window. C-g restores the
-original window configuration.
-
-\(fn)" t nil)
-
-(autoload 'popwin:popup-buffer-tail "popwin" "\
-Same as `popwin:popup-buffer' except that the buffer will be
-`recenter'ed at the bottom.
-
-\(fn &rest SAME-AS-POPWIN:POPUP-BUFFER)" t nil)
-
-(autoload 'popwin:find-file "popwin" "\
-Edit file FILENAME with popup window by `popwin:popup-buffer'.
-
-\(fn FILENAME &optional WILDCARDS)" t nil)
-
-(autoload 'popwin:find-file-tail "popwin" "\
-Edit file FILENAME with popup window by
-`popwin:popup-buffer-tail'.
-
-\(fn FILE &optional WILDCARD)" t nil)
-
-(autoload 'popwin:messages "popwin" "\
-Display *Messages* buffer in a popup window.
-
-\(fn)" t nil)
-
-;;;***
-\f
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; End:
-;;; popwin-autoloads.el ends here
+++ /dev/null
-(define-package "popwin" "20150315.600" "Popup Window Manager." 'nil :keywords '("convenience"))
+++ /dev/null
-;;; popwin.el --- Popup Window Manager.
-
-;; Copyright (C) 2011-2015 Tomohiro Matsuyama
-
-;; Author: Tomohiro Matsuyama <m2ym.pubNOSPAMgmail.com>
-;; Keywords: convenience
-;; Package-Version: 20150315.600
-;; Version: 1.0.0
-
-;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Popwin makes you free from the hell of annoying buffers such like
-;; *Help*, *Completions*, *compilation*, and etc.
-;;
-;; To use popwin, just add the following code into your .emacs:
-;;
-;; (require 'popwin)
-;; (popwin-mode 1)
-;;
-;; Then try to show some buffer, for example *Help* or
-;; *Completeions*. Unlike standard behavior, their buffers may be
-;; shown in a popup window at the bottom of the frame. And you can
-;; close the popup window seamlessly by typing C-g or selecting other
-;; windows.
-;;
-;; `popwin:display-buffer' displays special buffers in a popup window
-;; and displays normal buffers as unsual. Special buffers are
-;; specified in `popwin:special-display-config', which tells popwin
-;; how to display such buffers. See docstring of
-;; `popwin:special-display-config' for more information.
-;;
-;; The default width/height/position of popup window can be changed by
-;; setting `popwin:popup-window-width', `popwin:popup-window-height',
-;; and `popwin:popup-window-position'. You can also change the
-;; behavior for a specific buffer. See docstring of
-;; `popwin:special-display-config'.
-;;
-;; If you want to use some useful commands such like
-;; `popwin:popup-buffer' and `popwin:find-file' easily. you may bind
-;; `popwin:keymap' to `C-z', for example, like:
-;;
-;; (global-set-key (kbd "C-z") popwin:keymap)
-;;
-;; See also `popwin:keymap' documentation.
-;;
-;; Enjoy!
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(defconst popwin:version "1.0.0")
-
-\f
-
-;;; Utility
-
-(defun popwin:listify (object)
- "Return a singleton list of OBJECT if OBJECT is an atom,
-otherwise OBJECT itself."
- (if (atom object) (list object) object))
-
-(defun popwin:subsitute-in-tree (map tree)
- (if (consp tree)
- (cons (popwin:subsitute-in-tree map (car tree))
- (popwin:subsitute-in-tree map (cdr tree)))
- (or (cdr (assq tree map)) tree)))
-
-(defun popwin:get-buffer (buffer-or-name &optional if-not-found)
- "Return a buffer named BUFFER-OR-NAME or BUFFER-OR-NAME itself
-if BUFFER-OR-NAME is a buffer. If BUFFER-OR-NAME is a string and
-such a buffer named BUFFER-OR-NAME not found, a new buffer will
-be returned when IF-NOT-FOUND is :create, or an error reported
-when IF-NOT-FOUND is :error. The default of value of IF-NOT-FOUND
-is :error."
- (ecase (or if-not-found :error)
- (:create
- (get-buffer-create buffer-or-name))
- (:error
- (or (get-buffer buffer-or-name)
- (error "No buffer named %s" buffer-or-name)))))
-
-(defun popwin:switch-to-buffer (buffer-or-name &optional norecord)
- "Call `switch-to-buffer' forcing BUFFER-OF-NAME be displayed in
-the selected window."
- (with-no-warnings
- (if (>= emacs-major-version 24)
- (switch-to-buffer buffer-or-name norecord t)
- (switch-to-buffer buffer-or-name norecord))))
-
-(defun popwin:select-window (window &optional norecord)
- "Call `select-window' with saving the current buffer."
- (save-current-buffer
- (select-window window norecord)))
-
-(defun popwin:buried-buffer-p (buffer)
- "Return t if BUFFER might be thought of as a buried buffer."
- (eq (car (last (buffer-list))) buffer))
-
-(defun popwin:window-point (window)
- "Return window-point of WINDOW. If WINDOW is currently
-selected, then return buffer-point instead."
- (if (eq (selected-window) window)
- (with-current-buffer (window-buffer window)
- (point))
- (window-point window)))
-
-(defun popwin:window-deletable-p (window)
- "Return t if WINDOW is deletable, meaning that WINDOW is alive
-and not a minibuffer's window, plus there is two or more windows."
- (and (window-live-p window)
- (not (window-minibuffer-p window))
- (not (one-window-p))))
-
-(defmacro popwin:save-selected-window (&rest body)
- "Evaluate BODY saving the selected window."
- `(with-selected-window (selected-window) ,@body))
-
-(defun popwin:minibuffer-window-selected-p ()
- "Return t if minibuffer window is selected."
- (minibuffer-window-active-p (selected-window)))
-
-(defun popwin:last-selected-window ()
- "Return currently selected window or lastly selected window if
-minibuffer window is selected."
- (if (popwin:minibuffer-window-selected-p)
- (minibuffer-selected-window)
- (selected-window)))
-
-\f
-
-;;; Common
-
-(defvar popwin:debug nil)
-
-(defvar popwin:dummy-buffer nil)
-
-(defun popwin:dummy-buffer ()
- (if (buffer-live-p popwin:dummy-buffer)
- popwin:dummy-buffer
- (setq popwin:dummy-buffer (get-buffer-create " *popwin-dummy*"))))
-
-(defun popwin:kill-dummy-buffer ()
- (when (buffer-live-p popwin:dummy-buffer)
- (kill-buffer popwin:dummy-buffer))
- (setq popwin:dummy-buffer nil))
-
-(defun popwin:window-trailing-edge-adjustable-p (window)
- "Return t if a trailing edge of WINDOW is adjustable."
- (let ((next-window (next-window window)))
- (and (not (eq next-window (frame-first-window)))
- (not (eq (window-buffer next-window)
- (popwin:dummy-buffer))))))
-
-(defun* popwin:adjust-window-edges (window
- edges
- &optional
- (hfactor 1)
- (vfactor 1))
- "Adjust edges of WINDOW to EDGES accoring to horizontal factor
-HFACTOR, and vertical factor VFACTOR."
- (when (popwin:window-trailing-edge-adjustable-p window)
- (destructuring-bind ((left top right bottom)
- (cur-left cur-top cur-right cur-bottom))
- (list edges (window-edges window))
- (let ((hdelta (floor (- (* (- right left) hfactor) (- cur-right cur-left))))
- (vdelta (floor (- (* (- bottom top) vfactor) (- cur-bottom cur-top)))))
- (ignore-errors
- (adjust-window-trailing-edge window hdelta t))
- (ignore-errors
- (adjust-window-trailing-edge window vdelta nil))))))
-
-(defun popwin:window-config-tree-1 (node)
- (if (windowp node)
- (list 'window
- node
- (window-buffer node)
- (popwin:window-point node)
- (window-start node)
- (window-edges node)
- (eq (selected-window) node)
- (window-dedicated-p node))
- (destructuring-bind (dir edges . windows) node
- (append (list dir edges)
- (loop for window in windows
- unless (and (windowp window)
- (window-parameter window 'window-side))
- collect (popwin:window-config-tree-1 window))))))
-
-(defun popwin:window-config-tree ()
- "Return `window-tree' with replacing window values in the tree
-with persistent representations."
- (destructuring-bind (root mini)
- (window-tree)
- (list (popwin:window-config-tree-1 root) mini)))
-
-(defun popwin:replicate-window-config (window node hfactor vfactor)
- "Replicate NODE of window configuration on WINDOW with
-horizontal factor HFACTOR, and vertical factor VFACTOR. The
-return value is a association list of mapping from old-window to
-new-window."
- (if (eq (car node) 'window)
- (destructuring-bind (old-win buffer point start edges selected dedicated)
- (cdr node)
- (set-window-dedicated-p window nil)
- (popwin:adjust-window-edges window edges hfactor vfactor)
- (with-selected-window window
- (popwin:switch-to-buffer buffer t))
- (when selected
- (popwin:select-window window))
- (set-window-point window point)
- (set-window-start window start t)
- (when dedicated
- (set-window-dedicated-p window t))
- `((,old-win . ,window)))
- (destructuring-bind (dir edges . windows) node
- (loop while windows
- for sub-node = (pop windows)
- for win = window then next-win
- for next-win = (and windows (split-window win nil (not dir)))
- append (popwin:replicate-window-config win sub-node hfactor vfactor)))))
-
-(defun popwin:restore-window-outline (node outline)
- "Restore window outline accoding to the structures of NODE
-which is a node of `window-tree' and OUTLINE which is a node of
-`popwin:window-config-tree'."
- (cond
- ((and (windowp node)
- (eq (car outline) 'window))
- ;; same window
- (destructuring-bind (old-win buffer point start edges selected dedicated)
- (cdr outline)
- (popwin:adjust-window-edges node edges)
- (when (and (eq (window-buffer node) buffer)
- (eq (popwin:window-point node) point))
- (set-window-start node start))))
- ((or (windowp node)
- (not (eq (car node) (car outline))))
- ;; different structure
- ;; nothing to do
- )
- (t
- (let ((child-nodes (cddr node))
- (child-outlines (cddr outline)))
- (when (eq (length child-nodes) (length child-outlines))
- ;; same structure
- (loop for child-node in child-nodes
- for child-outline in child-outlines
- do (popwin:restore-window-outline child-node child-outline)))))))
-
-(defun popwin:position-horizontal-p (position)
- "Return t if POSITION is hozirontal."
- (and (memq position '(left :left right :right)) t))
-
-(defun popwin:position-vertical-p (position)
- "Return t if POSITION is vertical."
- (and (memq position '(top :top bottom :bottom)) t))
-
-(defun popwin:create-popup-window-1 (window size position)
- "Create a new window with SIZE at POSITION of WINDOW. The
-return value is a list of a master window and the popup window."
- (let ((width (window-width window))
- (height (window-height window)))
- (ecase position
- ((left :left)
- (list (split-window window size t)
- window))
- ((top :top)
- (list (split-window window size nil)
- window))
- ((right :right)
- (list window
- (split-window window (- width size) t)))
- ((bottom :bottom)
- (list window
- (split-window window (- height size) nil))))))
-
-(defun* popwin:create-popup-window (&optional (size 15) (position 'bottom) (adjust t))
- "Create a popup window with SIZE on the frame. If SIZE
-is integer, the size of the popup window will be SIZE. If SIZE is
-float, the size of popup window will be a multiplier of SIZE and
-frame-size. can be an integer and a float. If ADJUST is t, all of
-windows will be adjusted to fit the frame. POSITION must be one
-of (left top right bottom). The return value is a pair of a
-master window and the popup window. To close the popup window
-properly, get `current-window-configuration' before calling this
-function, and call `set-window-configuration' with the
-window-configuration."
- (let* ((root (car (popwin:window-config-tree)))
- (root-win (popwin:last-selected-window))
- (hfactor 1)
- (vfactor 1))
- (popwin:save-selected-window
- (delete-other-windows root-win))
- (let ((root-width (window-width root-win))
- (root-height (window-height root-win)))
- (when adjust
- (if (floatp size)
- (if (popwin:position-horizontal-p position)
- (setq hfactor (- 1.0 size)
- size (round (* root-width size)))
- (setq vfactor (- 1.0 size)
- size (round (* root-height size))))
- (if (popwin:position-horizontal-p position)
- (setq hfactor (/ (float (- root-width size)) root-width))
- (setq vfactor (/ (float (- root-height size)) root-height)))))
- (destructuring-bind (master-win popup-win)
- (popwin:create-popup-window-1 root-win size position)
- ;; Mark popup-win being a popup window.
- (with-selected-window popup-win
- (popwin:switch-to-buffer (popwin:dummy-buffer) t))
- (let ((win-map (popwin:replicate-window-config master-win root hfactor vfactor)))
- (list master-win popup-win win-map))))))
-
-\f
-
-;;; Common User Interface
-
-(defgroup popwin nil
- "Popup Window Manager."
- :group 'convenience
- :prefix "popwin:")
-
-(defcustom popwin:popup-window-position 'bottom
- "Default popup window position. This must be one of (left top right
-bottom)."
- :type 'symbol
- :group 'popwin)
-
-(defcustom popwin:popup-window-width 30
- "Default popup window width. If `popwin:popup-window-position'
-is top or bottom, this configuration will be ignored. If this
-variable is float, the popup window width will be a multiplier of
-the value and frame-size."
- :type 'number
- :group 'popwin)
-
-(defcustom popwin:popup-window-height 15
- "Default popup window height. If `popwin:popup-window-position'
-is left or right, this configuration will be ignored. If this
-variable is float, the popup window height will be a multiplier
-of the value and frame-size."
- :type 'number
- :group 'popwin)
-
-(defcustom popwin:reuse-window 'current
- "Non-nil means `popwin:display-buffer' will not popup the
-visible buffer. The value is same as a second argument of
-`get-buffer-window', except `current' means the selected frame."
- :group 'popwin)
-
-(defcustom popwin:adjust-other-windows t
- "Non-nil means all of other windows will be adjusted to fit the
-frame when a popup window is shown."
- :type 'boolean
- :group 'popwin)
-
-(defvar popwin:context-stack nil)
-
-(defvar popwin:popup-window nil
- "Main popup window instance.")
-
-(defvar popwin:popup-buffer nil
- "Buffer of currently shown in the popup window.")
-
-(defvar popwin:popup-last-config nil
- "Arguments to `popwin:popup-buffer' of last call.")
-
-;; Deprecated
-(defvar popwin:master-window nil
- "Master window of a popup window.")
-
-(defvar popwin:focus-window nil
- "Focused window which is used to check whether or not to close
-the popup window.")
-
-(defvar popwin:selected-window nil
- "Last selected window when the popup window is shown.")
-
-(defvar popwin:popup-window-dedicated-p nil
- "Non-nil means the popup window is dedicated to the original
-popup buffer.")
-
-(defvar popwin:popup-window-stuck-p nil
- "Non-nil means the popup window has been stuck.")
-
-(defvar popwin:window-outline nil
- "Original window outline which is obtained by
-`popwin:window-config-tree'.")
-
-(defvar popwin:window-map nil
- "Mapping from old windows to new windows.")
-
-(defvar popwin:window-config nil
- "An original window configuration for restoreing.")
-
-(defvar popwin:close-popup-window-timer nil
- "Timer of closing the popup window.")
-
-(defvar popwin:close-popup-window-timer-interval 0.05
- "Interval of `popwin:close-popup-window-timer'.")
-
-(defvar popwin:before-popup-hook nil)
-
-(defvar popwin:after-popup-hook nil)
-
-(symbol-macrolet ((context-vars '(popwin:popup-window
- popwin:popup-buffer
- popwin:master-window
- popwin:focus-window
- popwin:selected-window
- popwin:popup-window-dedicated-p
- popwin:popup-window-stuck-p
- popwin:window-outline
- popwin:window-map)))
- (defun popwin:valid-context-p (context)
- (window-live-p (plist-get context 'popwin:popup-window)))
-
- (defun popwin:current-context ()
- (loop for var in context-vars
- collect var
- collect (symbol-value var)))
-
- (defun popwin:use-context (context)
- (loop for var = (pop context)
- for val = (pop context)
- while var
- do (set var val)))
-
- (defun popwin:push-context ()
- (push (popwin:current-context) popwin:context-stack))
-
- (defun popwin:pop-context ()
- (popwin:use-context (pop popwin:context-stack)))
-
- (defun* popwin:find-context-for-buffer (buffer &key valid-only)
- (loop with stack = popwin:context-stack
- for context = (pop stack)
- while context
- if (and (eq buffer (plist-get context 'popwin:popup-buffer))
- (or (not valid-only)
- (popwin:valid-context-p context)))
- return (list context stack))))
-
-(defun popwin:popup-window-live-p ()
- "Return t if `popwin:popup-window' is alive."
- (window-live-p popwin:popup-window))
-
-(defun* popwin:update-window-reference (symbol
- &key
- (map popwin:window-map)
- safe
- recursive)
- (unless (and safe (not (boundp symbol)))
- (let ((value (symbol-value symbol)))
- (set symbol
- (if recursive
- (popwin:subsitute-in-tree map value)
- (or (cdr (assq value map)) value))))))
-
-(defun popwin:start-close-popup-window-timer ()
- (or popwin:close-popup-window-timer
- (setq popwin:close-popup-window-timer
- (run-with-idle-timer popwin:close-popup-window-timer-interval
- popwin:close-popup-window-timer-interval
- 'popwin:close-popup-window-timer))))
-
-(defun popwin:stop-close-popup-window-timer ()
- (when popwin:close-popup-window-timer
- (cancel-timer popwin:close-popup-window-timer)
- (setq popwin:close-popup-window-timer nil)))
-
-(defun popwin:close-popup-window-timer ()
- (condition-case var
- (popwin:close-popup-window-if-necessary)
- (error
- (message "popwin:close-popup-window-timer: error: %s" var)
- (when popwin:debug (backtrace)))))
-
-(defun popwin:close-popup-window (&optional keep-selected)
- "Close the popup window and restore to the previous window
-configuration. If KEEP-SELECTED is non-nil, the lastly selected
-window will not be selected."
- (interactive)
- (when popwin:popup-window
- (unwind-protect
- (progn
- (when (popwin:window-deletable-p popwin:popup-window)
- (delete-window popwin:popup-window))
- (popwin:restore-window-outline (car (window-tree)) popwin:window-outline)
- ;; Call `redisplay' here so `window-start' could be set
- ;; prior to the point change of the master buffer.
- (redisplay)
- (when (and (not keep-selected)
- (window-live-p popwin:selected-window))
- (select-window popwin:selected-window)))
- (popwin:pop-context)
- ;; Cleanup if no context left.
- (when (null popwin:context-stack)
- (popwin:kill-dummy-buffer)
- (popwin:stop-close-popup-window-timer)))))
-
-(defun popwin:close-popup-window-if-necessary ()
- "Close the popup window if necessary. The all situations where
-the popup window will be closed are followings:
-
-* `C-g' has been pressed.
-* The popup buffer has been killed.
-* The popup buffer has been buried.
-* The popup buffer has been changed if the popup window is
- dedicated to the buffer.
-* Another window has been selected."
- (when popwin:popup-window
- (let* ((window (selected-window))
- (window-point (popwin:window-point window))
- (window-buffer (window-buffer window))
- (minibuf-window-p (window-minibuffer-p window))
- (reading-from-minibuf
- (and minibuf-window-p
- (minibuffer-prompt)
- t))
- (quit-requested
- (and (eq last-command 'keyboard-quit)
- (eq last-command-event ?\C-g)))
- (other-window-selected
- (and (not (eq window popwin:focus-window))
- (not (eq window popwin:popup-window))))
- (orig-this-command this-command)
- (popup-buffer-alive
- (buffer-live-p popwin:popup-buffer))
- (popup-buffer-buried
- (popwin:buried-buffer-p popwin:popup-buffer))
- (popup-buffer-changed-despite-of-dedicated
- (and popwin:popup-window-dedicated-p
- (not popwin:popup-window-stuck-p)
- (or (not other-window-selected)
- (not reading-from-minibuf))
- (buffer-live-p window-buffer)
- (not (eq popwin:popup-buffer window-buffer))))
- (popup-window-alive (popwin:popup-window-live-p)))
- (when (or quit-requested
- (not popup-buffer-alive)
- popup-buffer-buried
- popup-buffer-changed-despite-of-dedicated
- (not popup-window-alive)
- (and other-window-selected
- (not minibuf-window-p)
- (not popwin:popup-window-stuck-p)))
- (when popwin:debug
- (message (concat "popwin: CLOSE:\n"
- " quit-requested = %s\n"
- " popup-buffer-alive = %s\n"
- " popup-buffer-buried = %s\n"
- " popup-buffer-changed-despite-of-dedicated = %s\n"
- " popup-window-alive = %s\n"
- " (selected-window) = %s\n"
- " popwin:focus-window = %s\n"
- " popwin:popup-window = %s\n"
- " other-window-selected = %s\n"
- " minibuf-window-p = %s\n"
- " popwin:popup-window-stuck-p = %s")
- quit-requested
- popup-buffer-alive
- popup-buffer-buried
- popup-buffer-changed-despite-of-dedicated
- popup-window-alive
- window
- popwin:focus-window
- popwin:popup-window
- other-window-selected
- minibuf-window-p
- popwin:popup-window-stuck-p))
- (when (and quit-requested
- (null orig-this-command))
- (setq this-command 'popwin:close-popup-window)
- (run-hooks 'pre-command-hook))
- (cond
- ((and quit-requested
- (null orig-this-command)
- popwin:window-config)
- (set-window-configuration popwin:window-config)
- (setq popwin:window-config nil))
- (reading-from-minibuf
- (popwin:close-popup-window)
- (select-window (minibuffer-window)))
- (t
- (popwin:close-popup-window
- (and other-window-selected
- (and popup-buffer-alive
- (not popup-buffer-buried))))
- (when popup-buffer-changed-despite-of-dedicated
- (popwin:switch-to-buffer window-buffer)
- (goto-char window-point))))
- (when (and quit-requested
- (null orig-this-command))
- (run-hooks 'post-command-hook)
- (setq last-command 'popwin:close-popup-window))))))
-
-;;;###autoload
-(defun* popwin:popup-buffer (buffer
- &key
- (width popwin:popup-window-width)
- (height popwin:popup-window-height)
- (position popwin:popup-window-position)
- noselect
- dedicated
- stick
- tail)
- "Show BUFFER in a popup window and return the popup window. If
-NOSELECT is non-nil, the popup window will not be selected. If
-STICK is non-nil, the popup window will be stuck. If TAIL is
-non-nil, the popup window will show the last contents. Calling
-`popwin:popup-buffer' during `popwin:popup-buffer' is allowed. In
-that case, the buffer of the popup window will be replaced with
-BUFFER."
- (interactive "BPopup buffer:\n")
- (setq buffer (get-buffer buffer))
- (popwin:push-context)
- (run-hooks 'popwin:before-popup-hook)
- (multiple-value-bind (context context-stack)
- (popwin:find-context-for-buffer buffer :valid-only t)
- (if context
- (progn
- (popwin:use-context context)
- (setq popwin:context-stack context-stack))
- (let ((win-outline (car (popwin:window-config-tree))))
- (destructuring-bind (master-win popup-win win-map)
- (let ((size (if (popwin:position-horizontal-p position) width height))
- (adjust popwin:adjust-other-windows))
- (popwin:create-popup-window size position adjust))
- (setq popwin:popup-window popup-win
- popwin:master-window master-win
- popwin:window-outline win-outline
- popwin:window-map win-map
- popwin:window-config nil
- popwin:selected-window (selected-window)))
- (popwin:update-window-reference 'popwin:context-stack :recursive t)
- (popwin:start-close-popup-window-timer))
- (with-selected-window popwin:popup-window
- (popwin:switch-to-buffer buffer)
- (when tail
- (set-window-point popwin:popup-window (point-max))
- (recenter -2)))
- (setq popwin:popup-buffer buffer
- popwin:popup-last-config (list buffer
- :width width :height height :position position
- :noselect noselect :dedicated dedicated
- :stick stick :tail tail)
- popwin:popup-window-dedicated-p dedicated
- popwin:popup-window-stuck-p stick)))
- (if noselect
- (setq popwin:focus-window popwin:selected-window)
- (setq popwin:focus-window popwin:popup-window)
- (select-window popwin:popup-window))
- (run-hooks 'popwin:after-popup-hook)
- popwin:popup-window)
-
-(defun popwin:popup-last-buffer (&optional noselect)
- "Show the last popup buffer with the same configuration. If
-NOSELECT is non-nil, the popup window will not be selected."
- (interactive "P")
- (if popwin:popup-last-config
- (if noselect
- (destructuring-bind (buffer . keyargs) popwin:popup-last-config
- (apply 'popwin:popup-buffer buffer :noselect t keyargs))
- (apply 'popwin:popup-buffer popwin:popup-last-config))
- (error "No popup buffer ever")))
-(defalias 'popwin:display-last-buffer 'popwin:popup-last-buffer)
-
-(defun popwin:select-popup-window ()
- "Select the currently shown popup window."
- (interactive)
- (if (popwin:popup-window-live-p)
- (select-window popwin:popup-window)
- (error "No popup window displayed")))
-
-(defun popwin:stick-popup-window ()
- "Stick the currently shown popup window. The popup window can
-be closed by `popwin:close-popup-window'."
- (interactive)
- (if (popwin:popup-window-live-p)
- (progn
- (setq popwin:popup-window-stuck-p t)
- (message "Popup window stuck"))
- (error "No popup window displayed")))
-
-\f
-
-;;; Special Display
-
-(defmacro popwin:without-special-displaying (&rest body)
- "Evaluate BODY without special displaying."
- (if (boundp 'display-buffer-alist)
- `(with-no-warnings
- (let ((display-buffer-function nil)
- (display-buffer-alist
- (remove '(popwin:display-buffer-condition
- popwin:display-buffer-action)
- display-buffer-alist)))
- ,@body))
- `(with-no-warnings (let ((display-buffer-function nil)) ,@body))))
-
-(defcustom popwin:special-display-config
- '(;; Emacs
- ("*Miniedit Help*" :noselect t)
- help-mode
- (completion-list-mode :noselect t)
- (compilation-mode :noselect t)
- (grep-mode :noselect t)
- (occur-mode :noselect t)
- ("*Pp Macroexpand Output*" :noselect t)
- "*Shell Command Output*"
- ;; VC
- "*vc-diff*"
- "*vc-change-log*"
- ;; Undo-Tree
- (" *undo-tree*" :width 60 :position right)
- ;; Anything
- ("^\\*anything.*\\*$" :regexp t)
- ;; SLIME
- "*slime-apropos*"
- "*slime-macroexpansion*"
- "*slime-description*"
- ("*slime-compilation*" :noselect t)
- "*slime-xref*"
- (sldb-mode :stick t)
- slime-repl-mode
- slime-connection-list-mode)
- "Configuration of special displaying buffer for
-`popwin:display-buffer' and
-`popwin:special-display-popup-window'. The value is a list of
-CONFIG as a form of (PATTERN . KEYWORDS) where PATTERN is a
-pattern of specifying buffer and KEYWORDS is a list of a pair of
-key and value. PATTERN is in general a buffer name, a symbol
-specifying major-mode of buffer, or a predicate function which
-takes one argument: the buffer. If CONFIG is a string or a
-symbol, PATTERN will be CONFIG and KEYWORDS will be
-empty. Available keywords are following:
-
- regexp: If the value is non-nil, PATTERN will be used as regexp
- to matching buffer.
-
- width, height: Specify width or height of the popup window. If
- no size specified, `popwin:popup-window-width' or
- `popwin:popup-window-height' will be used. See also position
- keyword.
-
- position: The value must be one of (left top right bottom). The
- popup window will shown at the position of the frame. If no
- position specified, `popwin:popup-window-position' will be
- used.
-
- noselect: If the value is non-nil, the popup window will not be
- selected when it is shown.
-
- dedicated: If the value is non-nil, the popup window will be
- dedicated to the original popup buffer. In this case, when
- another buffer is selected in the popup window, the popup
- window will be closed immedicately and the selected buffer
- will be shown on the previously selected window.
-
- stick: If the value is non-nil, the popup window will be stuck
- when it is shown.
-
- tail: If the value is non-nil, the popup window will show the
- last contents.
-
-Examples: With '(\"*scratch*\" :height 30 :position top),
-*scratch* buffer will be shown at the top of the frame with
-height 30. With '(dired-mode :width 80 :position left), dired
-buffers will be shown at the left of the frame with width 80."
- :type '(repeat
- (cons :tag "Config"
- (choice :tag "Pattern"
- (string :tag "Buffer Name")
- (symbol :tag "Major Mode"))
- (plist :tag "Keywords"
- :value (:regexp nil) ; BUG? need default value
- :options
- ((:regexp (boolean :tag "On/Off"))
- (:width (choice :tag "Width"
- (integer :tag "Width")
- (float :tag "Width (%)")))
- (:height (choice :tag "Height"
- (integer :tag "Height")
- (float :tag "Height (%)")))
- (:position (choice :tag "Position"
- (const :tag "Bottom" bottom)
- (const :tag "Top" top)
- (const :tag "Left" left)
- (const :tag "Right" right)))
- (:noselect (boolean :tag "On/Off"))
- (:dedicated (boolean :tag "On/Off"))
- (:stick (boolean :tag "On/Off"))
- (:tail (boolean :tag "On/Off"))))))
- :get (lambda (symbol)
- (mapcar (lambda (element)
- (if (consp element)
- element
- (list element)))
- (default-value symbol)))
- :group 'popwin)
-
-(defun popwin:apply-display-buffer (function buffer &optional not-this-window)
- "Call FUNCTION on BUFFER without special displaying."
- (popwin:without-special-displaying
- (let ((same-window
- (or (same-window-p (buffer-name buffer))
- (and (>= emacs-major-version 24)
- (boundp 'action)
- (consp action)
- (eq (car action) 'display-buffer-same-window)))))
- ;; Close the popup window here so that the popup window won't to
- ;; be splitted.
- (when (and (eq (selected-window) popwin:popup-window)
- (not same-window))
- (popwin:close-popup-window)))
- (if (and (>= emacs-major-version 24)
- (boundp 'action)
- (boundp 'frame))
- ;; Use variables ACTION and FRAME which are formal parameters
- ;; of DISPLAY-BUFFER.
- ;;
- ;; TODO use display-buffer-alist instead of
- ;; display-buffer-function.
- (funcall function buffer action frame)
- (funcall function buffer not-this-window))))
-
-(defun popwin:original-display-buffer (buffer &optional not-this-window)
- "Call `display-buffer' on BUFFER without special displaying."
- (popwin:apply-display-buffer 'display-buffer buffer not-this-window))
-
-(defun popwin:original-pop-to-buffer (buffer &optional not-this-window)
- "Call `pop-to-buffer' on BUFFER without special displaying."
- (popwin:apply-display-buffer 'pop-to-buffer buffer not-this-window))
-
-(defun popwin:original-display-last-buffer ()
- "Call `display-buffer' for the last popup buffer without
-special displaying."
- (interactive)
- (if popwin:popup-last-config
- (popwin:original-display-buffer (car popwin:popup-last-config))
- (error "No popup buffer ever")))
-
-(defun popwin:switch-to-last-buffer ()
- "Switch to the last popup buffer."
- (interactive)
- (if popwin:popup-last-config
- (popwin:apply-display-buffer
- (lambda (buffer &rest ignore) (switch-to-buffer buffer))
- (car popwin:popup-last-config))
- (error "No popup buffer ever")))
-
-(defun popwin:original-pop-to-last-buffer ()
- "Call `pop-to-buffer' for the last popup buffer without
-special displaying."
- (interactive)
- (if popwin:popup-last-config
- (popwin:original-pop-to-buffer (car popwin:popup-last-config))
- (error "No popup buffer ever")))
-
-(defun popwin:reuse-window-p (buffer-or-name not-this-window)
- "Return t if a window showing BUFFER-OR-NAME exists and should
-be used displaying the buffer."
- (and popwin:reuse-window
- (let ((window (get-buffer-window buffer-or-name
- (if (eq popwin:reuse-window 'current)
- nil
- popwin:reuse-window))))
- (and (not (null window))
- (not (eq window (if not-this-window (selected-window))))))))
-
-(defun* popwin:match-config (buffer)
- (when (stringp buffer) (setq buffer (get-buffer buffer)))
- (loop with name = (buffer-name buffer)
- with mode = (buffer-local-value 'major-mode buffer)
- for config in popwin:special-display-config
- for (pattern . keywords) = (popwin:listify config)
- if (cond ((eq pattern t) t)
- ((and (stringp pattern) (plist-get keywords :regexp))
- (string-match pattern name))
- ((stringp pattern)
- (string= pattern name))
- ((symbolp pattern)
- (eq pattern mode))
- ((functionp pattern)
- (funcall pattern buffer))
- (t (error "Invalid pattern: %s" pattern)))
- return (cons pattern keywords)))
-
-(defun* popwin:display-buffer-1 (buffer-or-name
- &key
- default-config-keywords
- (if-buffer-not-found :create)
- if-config-not-found)
- "Display BUFFER-OR-NAME, if possible, in a popup
-window. Otherwise call IF-CONFIG-NOT-FOUND with BUFFER-OR-NAME if
-the value is a function. If IF-CONFIG-NOT-FOUND is nil,
-`popwin:popup-buffer' will be called. IF-BUFFER-NOT-FOUND
-indicates what happens when there is no such buffers. If the
-value is :create, create a new buffer named BUFFER-OR-NAME. If
-the value is :error, report an error. The default value
-is :create. DEFAULT-CONFIG-KEYWORDS is a property list which
-specifies default values of the config."
- (let* ((buffer (popwin:get-buffer buffer-or-name if-buffer-not-found))
- (pattern-and-keywords (popwin:match-config buffer)))
- (unless pattern-and-keywords
- (if if-config-not-found
- (return-from popwin:display-buffer-1
- (funcall if-config-not-found buffer))
- (setq pattern-and-keywords '(t))))
- (destructuring-bind (&key regexp width height position noselect dedicated stick tail)
- (append (cdr pattern-and-keywords) default-config-keywords)
- (popwin:popup-buffer buffer
- :width (or width popwin:popup-window-width)
- :height (or height popwin:popup-window-height)
- :position (or position popwin:popup-window-position)
- :noselect (or (popwin:minibuffer-window-selected-p) noselect)
- :dedicated dedicated
- :stick stick
- :tail tail))))
-
-;;;###autoload
-(defun popwin:display-buffer (buffer-or-name &optional not-this-window)
- "Display BUFFER-OR-NAME, if possible, in a popup window, or as
-usual. This function can be used as a value of
-`display-buffer-function'."
- (interactive "BDisplay buffer:\n")
- (if (popwin:reuse-window-p buffer-or-name not-this-window)
- ;; Call `display-buffer' for reuse.
- (popwin:original-display-buffer buffer-or-name not-this-window)
- (popwin:display-buffer-1
- buffer-or-name
- :if-config-not-found
- (unless (with-no-warnings
- ;; FIXME: emacs bug?
- (called-interactively-p))
- (lambda (buffer)
- (popwin:original-display-buffer buffer not-this-window))))))
-
-(defun popwin:special-display-popup-window (buffer &rest ignore)
- "Obsolete."
- (popwin:display-buffer-1 buffer))
-
-(defun* popwin:pop-to-buffer-1 (buffer
- &key
- default-config-keywords
- other-window
- norecord)
- (popwin:display-buffer-1 buffer
- :default-config-keywords default-config-keywords
- :if-config-not-found
- (lambda (buffer)
- (pop-to-buffer buffer other-window norecord))))
-
-;;;###autoload
-(defun popwin:pop-to-buffer (buffer &optional other-window norecord)
- "Same as `pop-to-buffer' except that this function will use
-`popwin:display-buffer-1' instead of `display-buffer'."
- (interactive (list (read-buffer "Pop to buffer: " (other-buffer))
- (if current-prefix-arg t)))
- (popwin:pop-to-buffer-1 buffer
- :other-window other-window
- :norecord norecord))
-
-\f
-
-;;; Universal Display
-
-(defcustom popwin:universal-display-config '(t)
- "Same as `popwin:special-display-config' except that this will
-be used for `popwin:universal-display'."
- :group 'popwin)
-
-;;;###autoload
-(defun popwin:universal-display ()
- "Call the following command interactively with letting
-`popwin:special-display-config' be
-`popwin:universal-display-config'. This will be useful when
-displaying buffers in popup windows temporarily."
- (interactive)
- (let ((command (key-binding (read-key-sequence "" t)))
- (popwin:special-display-config popwin:universal-display-config))
- (call-interactively command)))
-
-\f
-
-;;; Extensions
-
-;;;###autoload
-(defun popwin:one-window ()
- "Delete other window than the popup window. C-g restores the
-original window configuration."
- (interactive)
- (setq popwin:window-config (current-window-configuration))
- (delete-other-windows))
-
-;;;###autoload
-(defun popwin:popup-buffer-tail (&rest same-as-popwin:popup-buffer)
- "Same as `popwin:popup-buffer' except that the buffer will be
-`recenter'ed at the bottom."
- (interactive "bPopup buffer:\n")
- (destructuring-bind (buffer . keyargs) same-as-popwin:popup-buffer
- (apply 'popwin:popup-buffer buffer :tail t keyargs)))
-
-;;;###autoload
-(defun popwin:find-file (filename &optional wildcards)
- "Edit file FILENAME with popup window by `popwin:popup-buffer'."
- (interactive
- (find-file-read-args "Find file in popup window: "
- (when (fboundp 'confirm-nonexistent-file-or-buffer)
- (confirm-nonexistent-file-or-buffer))))
- (popwin:popup-buffer (find-file-noselect filename wildcards)))
-
-;;;###autoload
-(defun popwin:find-file-tail (file &optional wildcard)
- "Edit file FILENAME with popup window by
-`popwin:popup-buffer-tail'."
- (interactive
- (find-file-read-args "Find file in popup window: "
- (when (fboundp 'confirm-nonexistent-file-or-buffer)
- (confirm-nonexistent-file-or-buffer))))
- (popwin:popup-buffer-tail (find-file-noselect file wildcard)))
-
-;;;###autoload
-(defun popwin:messages ()
- "Display *Messages* buffer in a popup window."
- (interactive)
- (popwin:popup-buffer-tail "*Messages*"))
-
-\f
-
-;;; Minor Mode
-
-(defun popwin:display-buffer-condition (buffer action)
- (and (popwin:match-config buffer) t))
-
-(defun popwin:display-buffer-action (buffer alist)
- (let ((not-this-window (plist-get 'inhibit-same-window alist)))
- (popwin:display-buffer buffer not-this-window)))
-
-(define-minor-mode popwin-mode
- ""
- :init-value nil
- :global t
- (if (boundp 'display-buffer-alist)
- (let ((pair '(popwin:display-buffer-condition popwin:display-buffer-action)))
- (if popwin-mode
- (push pair display-buffer-alist)
- (setq display-buffer-alist (delete pair display-buffer-alist))))
- (with-no-warnings
- (unless (or (null display-buffer-function)
- (eq display-buffer-function 'popwin:display-buffer))
- (warn "Overwriting display-buffer-function variable to enable/disable popwin-mode"))
- (setq display-buffer-function (if popwin-mode 'popwin:display-buffer nil)))))
-
-\f
-
-;;; Keymaps
-
-(defvar popwin:keymap
- (let ((map (make-sparse-keymap)))
- (define-key map "b" 'popwin:popup-buffer)
- (define-key map "l" 'popwin:popup-last-buffer)
- (define-key map "o" 'popwin:display-buffer)
- (define-key map "\C-b" 'popwin:switch-to-last-buffer)
- (define-key map "\C-p" 'popwin:original-pop-to-last-buffer)
- (define-key map "\C-o" 'popwin:original-display-last-buffer)
- (define-key map " " 'popwin:select-popup-window)
- (define-key map "s" 'popwin:stick-popup-window)
- (define-key map "0" 'popwin:close-popup-window)
- (define-key map "f" 'popwin:find-file)
- (define-key map "\C-f" 'popwin:find-file)
- (define-key map "e" 'popwin:messages)
- (define-key map "\C-u" 'popwin:universal-display)
- (define-key map "1" 'popwin:one-window)
-
- map)
- "Default keymap for popwin commands. Use like:
-\(global-set-key (kbd \"C-z\") popwin:keymap\)
-
-Keymap:
-
-| Key | Command |
-|--------+---------------------------------------|
-| b | popwin:popup-buffer |
-| l | popwin:popup-last-buffer |
-| o | popwin:display-buffer |
-| C-b | popwin:switch-to-last-buffer |
-| C-p | popwin:original-pop-to-last-buffer |
-| C-o | popwin:original-display-last-buffer |
-| SPC | popwin:select-popup-window |
-| s | popwin:stick-popup-window |
-| 0 | popwin:close-popup-window |
-| f, C-f | popwin:find-file |
-| e | popwin:messages |
-| C-u | popwin:universal-display |
-| 1 | popwin:one-window |")
-
-(provide 'popwin)
-;;; popwin.el ends here
projects / emacsconfig.git / commitdiff