extensions/anything-show-completion.el

   1 ;;; anything-show-completion.el --- Show selection in buffer for anything completion
   2 ;; $Id: anything-show-completion.el,v 1.19 2009-11-19 20:16:51 rubikitch Exp $
   3
   4 ;; Copyright (C) 2009  hchbaw
   5 ;; Copyright (C) 2009  rubikitch
   6
   7 ;; Original Author: hchbaw
   8 ;; Author: rubikitch <rubikitch@ruby-lang.org>
   9 ;; Keywords: anything, convenience, complete
  10 ;; URL: http://www.emacswiki.org/cgi-bin/wiki/download/anything-show-completion.el
  11
  12 ;; This file is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; This file is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  24 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28 ;;
  29 ;; `anything' is also useful for in-buffer completion such as
  30 ;; `anything-lisp-complete-symbol'. But users must see *anything*
  31 ;; buffer when completing. It forces us to move our eyes away from
  32 ;; code temporarily and we feel stressful.
  33 ;;
  34 ;; With this plug-in, current selection (`anything-get-selection') is
  35 ;; displayed at point. This plug-in is automatically detected by user
  36 ;; program such as anything-complete.el .
  37 ;;
  38 ;; This program is based on an idea by hchbaw.
  39 ;;   http://d.hatena.ne.jp/hchbaw/20090416/1239878984
  40
  41 ;;; Commands:
  42 ;;
  43 ;; Below are complete command list:
  44 ;;
  45 ;;
  46 ;;; Customizable Options:
  47 ;;
  48 ;; Below are customizable option list:
  49 ;;
  50 ;;  `anything-show-completion-face'
  51 ;;    *Face of anything-show-completion.
  52 ;;    default = anything-selection-face
  53 ;;  `anything-show-completion-activate'
  54 ;;    *Set nil to turn off anything-show-completion.
  55 ;;    default = t
  56 ;;  `anything-show-completion-minimum-window-height'
  57 ;;    *Minimum completion window height.
  58 ;;    default = 7
  59
  60 ;;; For developers:
  61 ;;
  62 ;; To enable anything-show-completion for user-defined function, use
  63 ;; `use-anything-show-completion'. It accepts function and length of
  64 ;; prefix (= current completing target) as a sexp. It must be used
  65 ;; with soft-require.
  66 ;;
  67 ;; Example:
  68 ;;   (when (require 'anything-show-completion nil t)
  69 ;;     (use-anything-show-completion 'rct-complete-symbol--anything
  70 ;;                                   '(length pattern)))
  71 ;;
  72 ;; Example in souce code:
  73 ;;   http://www.emacswiki.org/cgi-bin/wiki/download/anything-complete.el
  74 ;;   http://www.emacswiki.org/cgi-bin/wiki/download/anything-rcodetools.el
  75
  76 ;;; Installation:
  77 ;;
  78 ;; Put anything-show-completion.el to your load-path.
  79 ;; The load-path is usually ~/elisp/.
  80 ;; It's set in your ~/.emacs like this:
  81 ;; (add-to-list 'load-path (expand-file-name "~/elisp"))
  82 ;;
  83 ;; And the following to your ~/.emacs startup file.
  84 ;;
  85 ;; (require 'anything-show-completion)
  86 ;;
  87 ;; No need more.
  88
  89 ;;; Customize:
  90 ;;
  91 ;;
  92 ;; All of the above can customize by:
  93 ;;      M-x customize-group RET anything-show-completion RET
  94 ;;
  95
  96
  97 ;;; History:
  98
  99 ;; $Log: anything-show-completion.el,v $
 100 ;; Revision 1.19  2009-11-19 20:16:51  rubikitch
 101 ;; asc-display-function: Fix an error "Window height XX too small (after splitting)"
 102 ;;
 103 ;; Revision 1.18  2009/11/19 17:27:59  rubikitch
 104 ;; asc-display-function: Take into account the beginning of line
 105 ;;
 106 ;; Revision 1.17  2009/11/11 17:43:34  rubikitch
 107 ;; Display bug fix. thanks to hchbaw
 108 ;;
 109 ;; http://d.hatena.ne.jp/hchbaw/20091111/1257960247
 110 ;;
 111 ;; Revision 1.16  2009/10/09 17:05:41  rubikitch
 112 ;; asc-display-function: Fix an error when opening from minibuffer
 113 ;;
 114 ;; Revision 1.15  2009/10/08 17:04:04  rubikitch
 115 ;; Fix an error when window height is too small.
 116 ;;
 117 ;; Revision 1.14  2009/10/08 16:57:57  rubikitch
 118 ;; added comments
 119 ;;
 120 ;; Revision 1.13  2009/10/08 10:56:03  rubikitch
 121 ;; Fix an error when completion window is too small.
 122 ;;
 123 ;; Revision 1.12  2009/10/08 10:24:37  rubikitch
 124 ;; Show candidates under the point.
 125 ;;
 126 ;; Revision 1.11  2009/10/08 05:12:56  rubikitch
 127 ;; Candidates are shown near the point.
 128 ;;
 129 ;; Revision 1.10  2009/10/06 22:46:23  rubikitch
 130 ;; `asc-display-function': Emacs23 fix
 131 ;;
 132 ;; Revision 1.9  2009/05/03 22:01:32  rubikitch
 133 ;; asc-display-function: split-window hack is effective only if one window is displayed.
 134 ;;
 135 ;; Revision 1.8  2009/05/03 21:47:41  rubikitch
 136 ;; set `anything-display-function'
 137 ;;
 138 ;; Revision 1.7  2009/04/20 12:21:28  rubikitch
 139 ;; Fixed an error when `anything' is invoked for the first time.
 140 ;;
 141 ;; Revision 1.6  2009/04/18 16:11:33  rubikitch
 142 ;; Removed a mess
 143 ;;
 144 ;; Revision 1.5  2009/04/18 16:11:01  rubikitch
 145 ;; * Fixed a typo.
 146 ;; * New function: `anything-show-completion-install'
 147 ;;
 148 ;; Revision 1.4  2009/04/18 10:05:15  rubikitch
 149 ;; copyright
 150 ;;
 151 ;; Revision 1.3  2009/04/18 10:02:10  rubikitch
 152 ;; doc
 153 ;;
 154 ;; Revision 1.2  2009/04/18 09:21:14  rubikitch
 155 ;; `use-anything-show-completion' as a function.
 156 ;; It enables us to affect multiple commands with `dolist'.
 157 ;;
 158 ;; Revision 1.1  2009/04/17 17:07:35  rubikitch
 159 ;; Initial revision
 160 ;;
 161
 162 ;;; Code:
 163
 164 (defvar anything-show-completion-version "$Id: anything-show-completion.el,v 1.19 2009-11-19 20:16:51 rubikitch Exp $")
 165 (require 'anything)
 166 (defgroup anything-show-completion nil
 167   "anything-show-completion"
 168   :group 'anything)
 169
 170 (defvar asc-overlay nil)
 171 (defcustom anything-show-completion-face anything-selection-face
 172   "*Face of anything-show-completion."
 173   :type 'face
 174   :group 'anything-show-completion)
 175 (defcustom anything-show-completion-activate t
 176   "*Set nil to turn off anything-show-completion."
 177   :type 'boolean
 178   :group 'anything-show-completion)
 179 (defcustom anything-show-completion-minimum-window-height 7
 180   "*Minimum completion window height."
 181   :type 'integer
 182   :group 'anything-show-completion)
 183
 184
 185 (defun asc-initialize-maybe ()
 186   (unless asc-overlay
 187     (setq asc-overlay (make-overlay (point-min) (point-min)))
 188     (overlay-put asc-overlay 'face anything-show-completion-face)
 189     (asc-cleanup)))
 190
 191 (defun asc-cleanup ()
 192   (delete-overlay asc-overlay))
 193 (add-hook 'anything-cleanup-hook 'asc-cleanup)
 194
 195 (asc-initialize-maybe)
 196
 197 (defun asc-overlay-activate-p ()
 198   "Return non-nil if `anything' is being used for any completionic purposes."
 199   (and anything-show-completion-activate (overlay-buffer asc-overlay)))
 200
 201 (defadvice anything-mark-current-line (after anything-show-completion activate)
 202   "Display the `anything-get-selection' contents as an overlay at the
 203 current (point)."
 204   (anything-aif (and (asc-overlay-activate-p)
 205                      (with-anything-window
 206                        (not (equal (anything-buffer-get) anything-action-buffer)))
 207                      (anything-get-selection))
 208       (with-current-buffer anything-current-buffer
 209         (asc-display-overlay it))))
 210
 211 (defun asc-display-overlay (selection)
 212   (overlay-put asc-overlay 'display selection)
 213   (move-overlay asc-overlay
 214                 (- (point) (eval (overlay-get asc-overlay 'prefix-length-sexp)))
 215                 (point)
 216                 anything-current-buffer))
 217
 218 ;;; Entry point
 219 (defun use-anything-show-completion (function prefix-length-sexp)
 220   "Setup a before advice of FUNCTION to show the `anything-get-selection' contents as an overlay at point.
 221
 222 PREFIX-LENGTH-SEXP is an expression to denote the length of prefix (completing target).
 223 It is evaluated in `asc-display-overlay'."
 224   (eval `(defadvice ,function (around anything-show-completion activate)
 225            (anything-show-completion-install ',prefix-length-sexp)
 226            (let ((anything-display-function 'asc-display-function)) ad-do-it))))
 227
 228 (defun anything-show-completion-install (prefix-length-sexp)
 229   (asc-initialize-maybe)
 230   (move-overlay asc-overlay (point) (point) (current-buffer))
 231   (overlay-put asc-overlay 'prefix-length-sexp prefix-length-sexp))
 232
 233
 234
 235 (defun asc-point-at-upper-half-of-window-p (pt)
 236   (<= (+ (count-screen-lines (window-start) pt)
 237         (if header-line-format 1 0)
 238         (if (zerop (current-column)) 0 0))
 239       (- (/ (window-height) 2)
 240          (if header-line-format 1 0))))
 241
 242 ;; (global-set-key "\C-x\C-z" (lambda () (interactive) (message "%s" (asc-point-at-upper-half-of-window-p (point)))))
 243 (defun asc-display-function (buf)
 244   (let* ((cursor-upper-p (asc-point-at-upper-half-of-window-p (point)))
 245          (half (/ (window-height) 2))
 246          (win (selected-window))
 247          (upper-height (max window-min-height
 248                             (min (+ 1                     ; mode-line
 249                                     (if header-line-format 1 0) ;header-line
 250                                     ;; window screen lines
 251                                     (count-screen-lines (window-start) (point))
 252                                     ;; adjustment of count-screen-lines and BOL
 253                                     (if (bolp) 1 0))
 254                                  (- (window-height) anything-show-completion-minimum-window-height))))
 255          (new-w (let ((split-window-keep-point))
 256                   (if (active-minibuffer-window)
 257                       (minibuffer-selected-window)
 258                     (enlarge-window (if (<= (window-height) (+ anything-show-completion-minimum-window-height window-min-height))
 259                                         (+ 4 anything-show-completion-minimum-window-height)
 260                                       0))
 261                     (split-window (selected-window) upper-height)))))
 262     (with-selected-window win
 263       (recenter -1))
 264     (set-window-buffer new-w buf)))
 265
 266 (provide 'anything-show-completion)
 267 ;; (asc-display-function anything-buffer)
 268 ;; How to save (DO NOT REMOVE!!)
 269 ;; (progn (magit-push) (emacswiki-post "anything-show-completion.el"))
 270 ;;; anything-show-completion.el ends here