From: Andreas Gerler Date: Thu, 11 Sep 2014 11:04:50 +0000 (+0200) Subject: added guide-key. X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=25afdb7cf35ecbe9bf419382d8dd53c80d0e7c5a;p=emacsconfig.git added guide-key. Signed-off-by: Andreas Gerler --- diff --git a/bba.org b/bba.org index 0ccbe357..89cfd7d5 100644 --- a/bba.org +++ b/bba.org @@ -91,6 +91,14 @@ See [[https://github.com/toctan/smartparens][Smartparens on github]]. (require 'smartparens) (smartparens-global-mode 1) #+END_SRC +*** guide-key +#+BEGIN_SRC emacs-lisp + (add-to-list 'load-path "~/.xemacs/elpa/popwin-20140902.1727") + (add-to-list 'load-path "~/.xemacs/elpa/guide-key-20140828.807") + (require 'guide-key) + (setq guide-key/guide-key-sequence '("C-x r" "C-x 4" "C-c")) + (guide-key-mode 1) +#+END_SRC *** latex #+BEGIN_SRC emacs-lisp diff --git a/elpa/guide-key-20140828.807/guide-key-autoloads.el b/elpa/guide-key-20140828.807/guide-key-autoloads.el new file mode 100644 index 00000000..ddbc13d9 --- /dev/null +++ b/elpa/guide-key-20140828.807/guide-key-autoloads.el @@ -0,0 +1,43 @@ +;;; guide-key-autoloads.el --- automatically extracted autoloads +;; +;;; Code: + + +;;;### (autoloads (guide-key-mode) "guide-key" "guide-key.el" (21520 +;;;;;; 11977 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) + +;;;*** + +;;;### (autoloads nil nil ("guide-key-pkg.el") (21520 11977 525636 +;;;;;; 0)) + +;;;*** + +(provide 'guide-key-autoloads) +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; guide-key-autoloads.el ends here diff --git a/elpa/guide-key-20140828.807/guide-key-pkg.el b/elpa/guide-key-20140828.807/guide-key-pkg.el new file mode 100644 index 00000000..d2659e23 --- /dev/null +++ b/elpa/guide-key-20140828.807/guide-key-pkg.el @@ -0,0 +1 @@ +(define-package "guide-key" "20140828.807" "Guide the following key bindings automatically and dynamically" (quote ((popwin "0.3.0")))) diff --git a/elpa/guide-key-20140828.807/guide-key.el b/elpa/guide-key-20140828.807/guide-key.el new file mode 100644 index 00000000..ae0f40ba --- /dev/null +++ b/elpa/guide-key-20140828.807/guide-key.el @@ -0,0 +1,620 @@ +;;; guide-key.el --- Guide the following key bindings automatically and dynamically + +;; Copyright (C) 2012, 2013 Tsunenobu Kai + +;; Author: Tsunenobu Kai +;; URL: https://github.com/kai2nenobu/guide-key +;; Version: 20140828.807 +;; X-Original-Version: 1.2.3 +;; Package-Requires: ((popwin "0.3.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 . + +;;; 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). +;; +;; guide-key can highlight commands which match a specified regular expression. +;; Key bindings following "C-x r" are rectangle family and register 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 both rectangle family and register family, set an +;; adequate regular expression like this. +;; +;; (setq guide-key/highlight-command-regexp "rectangle\\|register") +;; +;; 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 '(" @ 4" " 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 '("")) +;; +;; 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 'popwin) +(require 'face-remap) + +;;; 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." + :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 a face. 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." + :type '(choice (regexp :tag "Regexp to highlight") + (repeat (choice (regexp :tag "Regexp to highlight") + (cons (regexp :tag "Regexp to highlight") + (face :tag "Face on command"))))) + :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-command-keys-vector))) + (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-command-keys-vector))) + (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 (member key-seq (guide-key/buffer-key-seqences)) + (and guide-key/recursive-key-sequence-flag + (guide-key/popup-guide-buffer-p (guide-key/vbutlast key-seq)))))) + +(defun guide-key/buffer-key-seqences () + "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) + (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 lie:%S uce:%S" + last-command-event + (this-command-keys) + (this-command-keys-vector) + 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 diff --git a/elpa/popwin-20140902.1727/popwin-autoloads.el b/elpa/popwin-20140902.1727/popwin-autoloads.el new file mode 100644 index 00000000..ef2294f8 --- /dev/null +++ b/elpa/popwin-20140902.1727/popwin-autoloads.el @@ -0,0 +1,85 @@ +;;; popwin-autoloads.el --- automatically extracted autoloads +;; +;;; Code: + + +;;;### (autoloads (popwin:messages popwin:find-file-tail popwin:find-file +;;;;;; popwin:popup-buffer-tail popwin:one-window popwin:universal-display +;;;;;; popwin:pop-to-buffer popwin:display-buffer popwin:popup-buffer) +;;;;;; "popwin" "popwin.el" (21520 11976 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 wil 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) + +;;;*** + +;;;### (autoloads nil nil ("popwin-pkg.el") (21520 11976 628600 0)) + +;;;*** + +(provide 'popwin-autoloads) +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; popwin-autoloads.el ends here diff --git a/elpa/popwin-20140902.1727/popwin-pkg.el b/elpa/popwin-20140902.1727/popwin-pkg.el new file mode 100644 index 00000000..c6644f3e --- /dev/null +++ b/elpa/popwin-20140902.1727/popwin-pkg.el @@ -0,0 +1 @@ +(define-package "popwin" "20140902.1727" "Popup Window Manager." (quote nil)) diff --git a/elpa/popwin-20140902.1727/popwin.el b/elpa/popwin-20140902.1727/popwin.el new file mode 100644 index 00000000..98a74137 --- /dev/null +++ b/elpa/popwin-20140902.1727/popwin.el @@ -0,0 +1,1106 @@ +;;; popwin.el --- Popup Window Manager. + +;; Copyright (C) 2011, 2012, 2013, 2014 Tomohiro Matsuyama + +;; Author: Tomohiro Matsuyama +;; Keywords: convenience +;; Version: 20140902.1727 +;; X-Original-Version: 0.7.0alpha + +;; 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 . + +;;; 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 "0.7.0alpha") + + + +;;; 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: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))) + + + +;;; 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) + (mapcar 'popwin:window-config-tree-1 windows))))) + +(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 + (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)))))) + + + +;;; 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"))) + + + +;;; 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)) + + + +;;; 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 wil 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))) + + + +;;; 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*")) + + + +;;; 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))))) + + + +;;; 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