From: Andreas Gerler Date: Wed, 15 Jul 2015 06:12:15 +0000 (+0200) Subject: new versions of guide-key and popwin. X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=7ee339506ac528a7a4b091c36e350b971ad5d28f;p=emacsconfig.git new versions of guide-key and popwin. --- diff --git a/bba.org b/bba.org index a9033a9b..62639da9 100644 --- a/bba.org +++ b/bba.org @@ -278,8 +278,8 @@ snippets. Some help for Perl and even for org-mode. Probably the best help to keep track of the not every day used keybindings. #+BEGIN_SRC emacs-lisp - (add-to-list 'load-path "~/.emacs.d/elpa/popwin-20140902.1727") - (add-to-list 'load-path "~/.emacs.d/elpa/guide-key-20140828.807") + (add-to-list 'load-path "~/.emacs.d/elpa/popwin-20150315.600") + (add-to-list 'load-path "~/.emacs.d/elpa/guide-key-20150107.2235") (require 'guide-key) (setq guide-key/guide-key-sequence '("C-x" "C-x 4" "C-c" "C-x l" "")) (setq guide-key/recursive-key-sequence-flag t) diff --git a/elpa/guide-key-20140828.807/guide-key-autoloads.el b/elpa/guide-key-20140828.807/guide-key-autoloads.el deleted file mode 100644 index ddbc13d9..00000000 --- a/elpa/guide-key-20140828.807/guide-key-autoloads.el +++ /dev/null @@ -1,43 +0,0 @@ -;;; 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 deleted file mode 100644 index d2659e23..00000000 --- a/elpa/guide-key-20140828.807/guide-key-pkg.el +++ /dev/null @@ -1 +0,0 @@ -(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 deleted file mode 100644 index ae0f40ba..00000000 --- a/elpa/guide-key-20140828.807/guide-key.el +++ /dev/null @@ -1,620 +0,0 @@ -;;; 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/guide-key-20150107.2235/guide-key-autoloads.el b/elpa/guide-key-20150107.2235/guide-key-autoloads.el new file mode 100644 index 00000000..57b593e8 --- /dev/null +++ b/elpa/guide-key-20150107.2235/guide-key-autoloads.el @@ -0,0 +1,35 @@ +;;; guide-key-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (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) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; guide-key-autoloads.el ends here diff --git a/elpa/guide-key-20150107.2235/guide-key-pkg.el b/elpa/guide-key-20150107.2235/guide-key-pkg.el new file mode 100644 index 00000000..cb609081 --- /dev/null +++ b/elpa/guide-key-20150107.2235/guide-key-pkg.el @@ -0,0 +1 @@ +(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")) diff --git a/elpa/guide-key-20150107.2235/guide-key.el b/elpa/guide-key-20150107.2235/guide-key.el new file mode 100644 index 00000000..7f318a61 --- /dev/null +++ b/elpa/guide-key-20150107.2235/guide-key.el @@ -0,0 +1,643 @@ +;;; 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 +;; 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 . + +;;; 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 '(" @ 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 '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 diff --git a/elpa/popwin-20140902.1727/popwin-autoloads.el b/elpa/popwin-20140902.1727/popwin-autoloads.el deleted file mode 100644 index ef2294f8..00000000 --- a/elpa/popwin-20140902.1727/popwin-autoloads.el +++ /dev/null @@ -1,85 +0,0 @@ -;;; 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 deleted file mode 100644 index c6644f3e..00000000 --- a/elpa/popwin-20140902.1727/popwin-pkg.el +++ /dev/null @@ -1 +0,0 @@ -(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 deleted file mode 100644 index 98a74137..00000000 --- a/elpa/popwin-20140902.1727/popwin.el +++ /dev/null @@ -1,1106 +0,0 @@ -;;; 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 diff --git a/elpa/popwin-20150315.600/popwin-autoloads.el b/elpa/popwin-20150315.600/popwin-autoloads.el new file mode 100644 index 00000000..e6feec0d --- /dev/null +++ b/elpa/popwin-20150315.600/popwin-autoloads.el @@ -0,0 +1,76 @@ +;;; popwin-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (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) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; popwin-autoloads.el ends here diff --git a/elpa/popwin-20150315.600/popwin-pkg.el b/elpa/popwin-20150315.600/popwin-pkg.el new file mode 100644 index 00000000..c20df1b6 --- /dev/null +++ b/elpa/popwin-20150315.600/popwin-pkg.el @@ -0,0 +1 @@ +(define-package "popwin" "20150315.600" "Popup Window Manager." 'nil :keywords '("convenience")) diff --git a/elpa/popwin-20150315.600/popwin.el b/elpa/popwin-20150315.600/popwin.el new file mode 100644 index 00000000..6bb6c536 --- /dev/null +++ b/elpa/popwin-20150315.600/popwin.el @@ -0,0 +1,1114 @@ +;;; popwin.el --- Popup Window Manager. + +;; Copyright (C) 2011-2015 Tomohiro Matsuyama + +;; Author: Tomohiro Matsuyama +;; 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 . + +;;; 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") + + + +;;; 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))) + + + +;;; 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)))))) + + + +;;; 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 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))) + + + +;;; 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