From e2f9416bde88333cd1d0b793dbd018756cd5fa1b Mon Sep 17 00:00:00 2001 From: Gergely Polonkai Date: Fri, 14 Oct 2016 18:54:39 +0200 Subject: [PATCH] Remove company-quickhelp and helm-spotify MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit I didn’t really use them, and they introduced some strange problems. --- .../company-quickhelp-autoloads.el | 31 - .../company-quickhelp-pkg.el | 1 - .../company-quickhelp.el | 204 ---- .../helm-spotify-autoloads.el | 24 - .../helm-spotify-pkg.el | 1 - .../helm-spotify.el | 132 --- elpa/multi-20131013.844/multi-autoloads.el | 15 - elpa/multi-20131013.844/multi-pkg.el | 1 - elpa/multi-20131013.844/multi.el | 134 --- .../pos-tip-20150318.813/pos-tip-autoloads.el | 15 - elpa/pos-tip-20150318.813/pos-tip-pkg.el | 1 - elpa/pos-tip-20150318.813/pos-tip.el | 980 ------------------ init.el | 8 - 13 files changed, 1547 deletions(-) delete mode 100644 elpa/company-quickhelp-20160826.806/company-quickhelp-autoloads.el delete mode 100644 elpa/company-quickhelp-20160826.806/company-quickhelp-pkg.el delete mode 100644 elpa/company-quickhelp-20160826.806/company-quickhelp.el delete mode 100644 elpa/helm-spotify-20160905.1447/helm-spotify-autoloads.el delete mode 100644 elpa/helm-spotify-20160905.1447/helm-spotify-pkg.el delete mode 100644 elpa/helm-spotify-20160905.1447/helm-spotify.el delete mode 100644 elpa/multi-20131013.844/multi-autoloads.el delete mode 100644 elpa/multi-20131013.844/multi-pkg.el delete mode 100644 elpa/multi-20131013.844/multi.el delete mode 100644 elpa/pos-tip-20150318.813/pos-tip-autoloads.el delete mode 100644 elpa/pos-tip-20150318.813/pos-tip-pkg.el delete mode 100644 elpa/pos-tip-20150318.813/pos-tip.el diff --git a/elpa/company-quickhelp-20160826.806/company-quickhelp-autoloads.el b/elpa/company-quickhelp-20160826.806/company-quickhelp-autoloads.el deleted file mode 100644 index 449ad5b..0000000 --- a/elpa/company-quickhelp-20160826.806/company-quickhelp-autoloads.el +++ /dev/null @@ -1,31 +0,0 @@ -;;; company-quickhelp-autoloads.el --- automatically extracted autoloads -;; -;;; Code: -(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) - -;;;### (autoloads nil "company-quickhelp" "company-quickhelp.el" -;;;;;; (22490 24939 611396 515000)) -;;; Generated autoloads from company-quickhelp.el - -(defvar company-quickhelp-mode nil "\ -Non-nil if Company-Quickhelp mode is enabled. -See the command `company-quickhelp-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 `company-quickhelp-mode'.") - -(custom-autoload 'company-quickhelp-mode "company-quickhelp" nil) - -(autoload 'company-quickhelp-mode "company-quickhelp" "\ -Provides documentation popups for `company-mode' using `pos-tip'. - -\(fn &optional ARG)" t nil) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; End: -;;; company-quickhelp-autoloads.el ends here diff --git a/elpa/company-quickhelp-20160826.806/company-quickhelp-pkg.el b/elpa/company-quickhelp-20160826.806/company-quickhelp-pkg.el deleted file mode 100644 index 023b924..0000000 --- a/elpa/company-quickhelp-20160826.806/company-quickhelp-pkg.el +++ /dev/null @@ -1 +0,0 @@ -(define-package "company-quickhelp" "20160826.806" "Popup documentation for completion candidates" '((emacs "24.4") (company "0.8.9") (pos-tip "0.4.6")) :url "https://www.github.com/expez/company-quickhelp" :keywords '("company" "popup" "documentation" "quickhelp")) diff --git a/elpa/company-quickhelp-20160826.806/company-quickhelp.el b/elpa/company-quickhelp-20160826.806/company-quickhelp.el deleted file mode 100644 index a0a00a5..0000000 --- a/elpa/company-quickhelp-20160826.806/company-quickhelp.el +++ /dev/null @@ -1,204 +0,0 @@ -;;; company-quickhelp.el --- Popup documentation for completion candidates - -;; Copyright (C) 2016, Lars Andersen - -;; Author: Lars Andersen -;; URL: https://www.github.com/expez/company-quickhelp -;; Package-Version: 20160826.806 -;; Keywords: company popup documentation quickhelp -;; Version: 1.4.0 -;; Package-Requires: ((emacs "24.4") (company "0.8.9") (pos-tip "0.4.6")) - -;; This file is not part of GNU Emacs. - -;; 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: - -;; When idling on a completion candidate the documentation for the -;; candidate will pop up after `company-quickhelp-idle-delay' seconds. - -;;; Usage: -;; put (company-quickhelp-mode 1) in you init.el to activate -;; `company-quickhelp-mode'. - -;; You can adjust the time it takes for the documentation to pop up by -;; changing `company-quickhelp-delay' - -;;; Code: -(require 'company) -(require 'pos-tip) -(require 'cl-lib) - -(defgroup company-quickhelp nil - "Documentation popups for `company-mode'" - :group 'company) - -(defcustom company-quickhelp-delay 0.5 - "Delay, in seconds, before the quickhelp popup appears. - -If set to nil the popup won't automatically appear, but can still -be triggered manually using `company-quickhelp-show'." - :type '(choice (number :tag "Delay in seconds") - (const :tag "Don't popup help automatically" nil)) - :group 'company-quickhelp) - -(defcustom company-quickhelp-max-lines nil - "When not NIL, limits the number of lines in the popup." - :type '(choice (integer :tag "Max lines to show in popup") - (const :tag "Don't limit the number of lines shown" nil)) - :group 'company-quickhelp) - -(defvar company-quickhelp--timer nil - "Quickhelp idle timer.") - -(defvar company-quickhelp--original-tooltip-width company-tooltip-minimum-width - "The documentation popup breaks inexplicably when we transition - from a large pseudo-tooltip to a small one. We solve this by - overriding `company-tooltip-minimum-width' and save the - original value here so we can restore it.") - -(defun company-quickhelp-frontend (command) - "`company-mode' front-end showing documentation in a `pos-tip' popup." - (pcase command - (`post-command (when company-quickhelp-delay - (company-quickhelp--set-timer))) - (`hide - (when company-quickhelp-delay - (company-quickhelp--cancel-timer)) - (pos-tip-hide)))) - -(defun company-quickhelp--doc-and-meta (doc) - ;; The company backend can either return a buffer with the doc or a - ;; cons containing the doc buffer and a position at which to start - ;; reading. - (let ((doc-buffer (if (consp doc) (car doc) doc)) - (doc-begin (when (consp doc) (cdr doc)))) - (with-current-buffer doc-buffer - (let ((truncated t)) - (goto-char (or doc-begin (point-min))) - (if company-quickhelp-max-lines - (forward-line company-quickhelp-max-lines) - (goto-char (point-max))) - (beginning-of-line) - (when (= (line-number-at-pos) - (save-excursion (goto-char (point-max)) (line-number-at-pos))) - (setq truncated nil)) - (while (and (not (= (line-number-at-pos) 1)) - (or - ;; [back] appears at the end of the help elisp help buffer - (looking-at-p "\\[back\\]") - ;; [source] cider's help buffer contains a link to source - (looking-at-p "\\[source\\]") - (looking-at-p "^\\s-*$"))) - (forward-line -1)) - (list :doc (buffer-substring-no-properties (point-min) (point-at-eol)) - :truncated truncated))))) - -(defun company-quickhelp--completing-read (prompt candidates &rest rest) - "`cider', and probably other libraries, prompt the user to -resolve ambiguous documentation requests. Instead of failing we -just grab the first candidate and press forward." - (car candidates)) - -(defun company-quickhelp--doc (selected) - (cl-letf (((symbol-function 'completing-read) - #'company-quickhelp--completing-read)) - (let* ((doc (company-call-backend 'doc-buffer selected)) - (doc-and-meta (when doc - (company-quickhelp--doc-and-meta doc))) - (truncated (plist-get doc-and-meta :truncated)) - (doc (plist-get doc-and-meta :doc))) - (unless (string= doc "") - (if truncated - (concat doc "\n\n[...]") - doc))))) - -(defun company-quickhelp-manual-begin () - "Manually trigger the `company-quickhelp' popup for the -currently active `company' completion candidate." - (interactive) - ;; This might seem a bit roundabout, but when I attempted to call - ;; `company-quickhelp--show' in a more direct manner it triggered a - ;; redisplay of company's list of completion candidates which looked - ;; quite weird. - (let ((company-quickhelp-delay 0.01)) - (company-quickhelp--set-timer))) - -(defun company-quickhelp--show () - (company-quickhelp--ensure-compatibility) - (company-quickhelp--cancel-timer) - (let* ((selected (nth company-selection company-candidates)) - (doc (company-quickhelp--doc selected)) - (ovl company-pseudo-tooltip-overlay) - (overlay-width (* (frame-char-width) - (if ovl (overlay-get ovl 'company-width) 0))) - (overlay-position (* (frame-char-width) - (- (if ovl (overlay-get ovl 'company-column) 1) 1))) - (x-gtk-use-system-tooltips nil)) - (when (and ovl doc) - (with-no-warnings - (pos-tip-show doc nil (overlay-start ovl) nil 300 80 nil - (+ overlay-width overlay-position) 1))))) - -(defun company-quickhelp--set-timer () - (when (null company-quickhelp--timer) - (setq company-quickhelp--timer - (run-with-idle-timer company-quickhelp-delay nil - 'company-quickhelp--show)))) - -(defun company-quickhelp--cancel-timer () - (when (timerp company-quickhelp--timer) - (cancel-timer company-quickhelp--timer) - (setq company-quickhelp--timer nil))) - -(defun company-quickhelp-hide () - (company-cancel)) - -(defun company-quickhelp--ensure-compatibility () - ;; Originally this code was in `company-quickhelp-enable' but that - ;; caused trouble for --daemon users reported in #16. - (cond - ((or (not (fboundp 'x-hide-tip)) - (not (fboundp 'x-show-tip))) - (user-error "Company-quickhelp doesn't work on your system. -Most likely this means you're on a mac with an Emacs build using Cocoa instead of X")) - ((or (null window-system) - (eq window-system 'pc)) - (user-error "Company-quickhelp doesn't work in the terminal")))) - -(defun company-quickhelp--enable () - (add-hook 'focus-out-hook #'company-quickhelp-hide) - (setq company-quickhelp--original-tooltip-width company-tooltip-minimum-width - company-tooltip-minimum-width (max company-tooltip-minimum-width 40)) - (add-to-list 'company-frontends 'company-quickhelp-frontend :append)) - -(defun company-quickhelp--disable () - (remove-hook 'focus-out-hook #'company-quickhelp-hide) - (company-quickhelp--cancel-timer) - (setq company-tooltip-minimum-width company-quickhelp--original-tooltip-width - company-frontends - (delq 'company-quickhelp-frontend company-frontends))) - -;;;###autoload -(define-minor-mode company-quickhelp-mode - "Provides documentation popups for `company-mode' using `pos-tip'." - :global t - (if company-quickhelp-mode - (company-quickhelp--enable) - (company-quickhelp--disable))) - -(provide 'company-quickhelp) - -;;; company-quickhelp.el ends here diff --git a/elpa/helm-spotify-20160905.1447/helm-spotify-autoloads.el b/elpa/helm-spotify-20160905.1447/helm-spotify-autoloads.el deleted file mode 100644 index 7af5ef4..0000000 --- a/elpa/helm-spotify-20160905.1447/helm-spotify-autoloads.el +++ /dev/null @@ -1,24 +0,0 @@ -;;; helm-spotify-autoloads.el --- automatically extracted autoloads -;; -;;; Code: -(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) - -;;;### (autoloads nil "helm-spotify" "helm-spotify.el" (22490 28015 -;;;;;; 820716 223000)) -;;; Generated autoloads from helm-spotify.el - -(defvar helm-source-spotify-track-search '((name . "Spotify") (volatile) (delayed) (multiline) (requires-pattern . 2) (candidates-process . helm-spotify-search) (action-transformer . helm-spotify-actions-for-track))) - -(autoload 'helm-spotify "helm-spotify" "\ -Bring up a Spotify search interface in helm. - -\(fn)" t nil) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; End: -;;; helm-spotify-autoloads.el ends here diff --git a/elpa/helm-spotify-20160905.1447/helm-spotify-pkg.el b/elpa/helm-spotify-20160905.1447/helm-spotify-pkg.el deleted file mode 100644 index aac0eb1..0000000 --- a/elpa/helm-spotify-20160905.1447/helm-spotify-pkg.el +++ /dev/null @@ -1 +0,0 @@ -(define-package "helm-spotify" "20160905.1447" "Control Spotify with Helm." '((helm "0.0.0") (multi "2.0.0")) :url "https://github.com/krisajenkins/helm-spotify" :keywords '("helm" "spotify")) diff --git a/elpa/helm-spotify-20160905.1447/helm-spotify.el b/elpa/helm-spotify-20160905.1447/helm-spotify.el deleted file mode 100644 index 7f57a0f..0000000 --- a/elpa/helm-spotify-20160905.1447/helm-spotify.el +++ /dev/null @@ -1,132 +0,0 @@ -;;; helm-spotify.el --- Control Spotify with Helm. -;; Copyright 2013 Kris Jenkins -;; -;; Author: Kris Jenkins -;; Maintainer: Kris Jenkins -;; Keywords: helm spotify -;; Package-Version: 20160905.1447 -;; URL: https://github.com/krisajenkins/helm-spotify -;; Created: 14th October 2013 -;; Version: 0.1.1 -;; Package-Requires: ((helm "0.0.0") (multi "2.0.0")) - -;;; Commentary: -;; -;; A search & play interface for Spotify. -;; -;; Currently supports OSX, Linux & Windows. -;; -;; (Want support for another platform? There's a guide in the github README.) - -;;; Code: - -;;; API Reference: https://developer.spotify.com/technologies/web-api/ -(require 'url) -(require 'json) -(require 'helm) -(require 'multi) - -(defun alist-get (symbols alist) - "Look up the value for the chain of SYMBOLS in ALIST." - (if symbols - (alist-get (cdr symbols) - (assoc (car symbols) alist)) - (cdr alist))) - -(defmulti spotify-play-href (href) - "Get the Spotify app to play the object with the given HREF." - system-type) - -(defmulti-method spotify-play-href 'darwin - (href) - (shell-command (format "osascript -e 'tell application %S to play track %S'" - "Spotify" - href))) - -(defmulti-method spotify-play-href 'gnu/linux - (href) - (shell-command "dbus-send --print-reply --session --type=method_call --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.mpris.MediaPlayer2.Player.Pause") - (shell-command (format "dbus-send --session --type=method_call --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.mpris.MediaPlayer2.Player.OpenUri \"string:%s\"" - href))) - -(defmulti-method spotify-play-href 'windows-nt - (href) - (shell-command (format "explorer %S" href))) - -(defmulti-method-fallback spotify-play-href - (href) - (message "Sorry, helm-spotify does not support playing tracks on %S." system-type)) - -(defun spotify-play-track (track) - "Get the Spotify app to play the TRACK." - (spotify-play-href (alist-get '(uri) track))) - -(defun spotify-get-track (album-href) - (let ((response (with-current-buffer - (url-retrieve-synchronously album-href) - (goto-char url-http-end-of-headers) - (json-read)))) - (aref (alist-get '(tracks items) response) 0))) - -(defun spotify-play-album (track) - "Get the Spotify app to play the album for this TRACK." - (let ((first-track (spotify-get-track (alist-get '(album href) track)))) - (spotify-play-href (alist-get '(uri) first-track)))) - - -(defun spotify-search (search-term) - "Search spotify for SEARCH-TERM, returning the results as a Lisp structure." - (let ((a-url (format "https://api.spotify.com/v1/search?q=%s&type=track" search-term))) - (with-current-buffer - (url-retrieve-synchronously a-url) - (goto-char url-http-end-of-headers) - (json-read)))) - -(defun spotify-format-track (track) - "Given a TRACK, return a a formatted string suitable for display." - (let ((track-name (alist-get '(name) track)) - (track-length (/ (alist-get '(duration_ms) track) 1000)) - (album-name (alist-get '(album name) track)) - (artist-names (mapcar (lambda (artist) - (alist-get '(name) artist)) - (alist-get '(artists) track)))) - (format "%s (%dm%0.2ds)\n%s - %s" - track-name - (/ track-length 60) (mod track-length 60) - (mapconcat 'identity artist-names "/") - album-name))) - -(defun spotify-search-formatted (search-term) - (mapcar (lambda (track) - (cons (spotify-format-track track) track)) - (alist-get '(tracks items) (spotify-search search-term)))) - - -(defun helm-spotify-search () - (spotify-search-formatted helm-pattern)) - -(defun helm-spotify-actions-for-track (actions track) - "Return a list of helm ACTIONS available for this TRACK." - `((,(format "Play Track - %s" (alist-get '(name) track)) . spotify-play-track) - (,(format "Play Album - %s" (alist-get '(album name) track)) . spotify-play-album) - ("Show Track Metadata" . pp))) - -;;;###autoload -(defvar helm-source-spotify-track-search - '((name . "Spotify") - (volatile) - (delayed) - (multiline) - (requires-pattern . 2) - (candidates-process . helm-spotify-search) - (action-transformer . helm-spotify-actions-for-track))) - -;;;###autoload -(defun helm-spotify () - "Bring up a Spotify search interface in helm." - (interactive) - (helm :sources '(helm-source-spotify-track-search) - :buffer "*helm-spotify*")) - -(provide 'helm-spotify) -;;; helm-spotify.el ends here diff --git a/elpa/multi-20131013.844/multi-autoloads.el b/elpa/multi-20131013.844/multi-autoloads.el deleted file mode 100644 index 2ef3101..0000000 --- a/elpa/multi-20131013.844/multi-autoloads.el +++ /dev/null @@ -1,15 +0,0 @@ -;;; multi-autoloads.el --- automatically extracted autoloads -;; -;;; Code: -(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) - -;;;### (autoloads nil nil ("multi.el") (22490 28015 535100 796000)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; End: -;;; multi-autoloads.el ends here diff --git a/elpa/multi-20131013.844/multi-pkg.el b/elpa/multi-20131013.844/multi-pkg.el deleted file mode 100644 index 4a063cf..0000000 --- a/elpa/multi-20131013.844/multi-pkg.el +++ /dev/null @@ -1 +0,0 @@ -(define-package "multi" "20131013.844" "Clojure-style multi-methods for emacs lisp" '((emacs "24")) :url "http://github.com/kurisuwhyte/emacs-multi" :keywords '("multimethod" "generic" "predicate" "dispatch")) diff --git a/elpa/multi-20131013.844/multi.el b/elpa/multi-20131013.844/multi.el deleted file mode 100644 index 9c8877e..0000000 --- a/elpa/multi-20131013.844/multi.el +++ /dev/null @@ -1,134 +0,0 @@ -;;; multi.el --- Clojure-style multi-methods for emacs lisp -*- lexical-binding: t -*- - -;; Copyright (c) 2013 Christina Whyte - -;; Version: 2.0.1 -;; Package-Version: 20131013.844 -;; Package-Requires: ((emacs "24")) -;; Keywords: multimethod generic predicate dispatch -;; Author: Christina Whyte -;; URL: http://github.com/kurisuwhyte/emacs-multi - -;; This file is not part of GNU Emacs. - -;; Permission is hereby granted, free of charge, to any person obtaining -;; a copy of this software and associated documentation files (the -;; "Software"), to deal in the Software without restriction, including -;; without limitation the rights to use, copy, modify, merge, publish, -;; distribute, sublicense, and/or sell copies of the Software, and to -;; permit persons to whom the Software is furnished to do so, subject to -;; the following conditions: -;; -;; The above copyright notice and this permission notice shall be -;; included in all copies or substantial portions of the Software. -;; -;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, -;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND -;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS -;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN -;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN -;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -;; SOFTWARE. - - -;;; Commentary - -;; See README.md (or http://github.com/kurisuwhyte/emacs-multi#readme) - -;;; Code: - -;;;; State ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar multi/-method-branches (make-hash-table) - "A dictionary of dictionaries of branches. - -Type: { Symbol → { A → (A... → B) }} - -This holds the mappings of names to a mappings of premises to lambdas, -which allows a relatively efficient dispatching O(2) when applying the -multi-method.") - - -(defvar multi/-method-fallbacks (make-hash-table) - "A dictionary of fallbacks for each multi-method. - -Type: { Symbold → (A... → B) } - -This holds mappings of names to fallback method branches, which are -invoked in case none of the premises for the defined branches match.") - - -;;;; API ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defmacro defmulti (name arguments &optional docstring &rest forms) - "Defines a new multi-method and a dispatch function." - (declare (doc-string 3) - (debug (&define name (&rest arg) [&optional stringp] def-body)) - (indent defun)) - `(progn - (defun ,name (&rest args) - ,(if (stringp docstring) docstring (prog1 nil (push docstring forms))) - (apply (multi/-dispatch-with ',name (lambda ,arguments ,@forms)) - args)) - (multi/-make-multi-method ',name))) - - -(defmacro defmulti-method (name premise arguments &rest forms) - "Adds a branch to a previously-defined multi-method." - (declare (debug (&define name sexp (&rest arg) def-body)) - (indent defun)) - `(multi/-make-multi-method-branch ',name ,premise - (lambda ,arguments ,@forms))) - - -(defmacro defmulti-method-fallback (name arguments &rest forms) - "Adds a fallback branch to a previously-defined multi-method. - -The fallback branch will be applied if none of the premises defined -for the branches in a multi-method match the dispatch value." - `(multi/-make-multi-method-fallback ',name (lambda ,arguments ,@forms))) - - -(defun multi-remove-method (name premise) - "Removes the branch with the given premise from the multi-method." - (remhash premise (gethash name multi/-method-branches))) - - -(defun multi-remove-method-fallback (name) - "Removes the defined fallback branch for the multi-method." - (remhash name multi/-method-fallbacks)) - - -;;;; Helper functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun multi/-make-multi-method (name) - (puthash name (make-hash-table :test 'equal) - multi/-method-branches)) - - -(defun multi/-make-multi-method-branch (name premise lambda) - (puthash premise lambda - (gethash name multi/-method-branches))) - - -(defun multi/-make-multi-method-fallback (name lambda) - (puthash name lambda multi/-method-fallbacks)) - - -(defun multi/-dispatch-with (name f) - (lambda (&rest args) - (let* ((premise (apply f args)) - (method (gethash premise (gethash name multi/-method-branches)))) - (if method (apply method args) - (apply (gethash name multi/-method-fallbacks) args))))) - - -;;;; Emacs stuff ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(eval-after-load "lisp-mode" - '(progn - (font-lock-add-keywords 'emacs-lisp-mode - '(("(\\(defmulti\\|defmulti-method\\|defmulti-method-fallback\\)\\(?:\\s-\\)+\\(\\_<.*?\\_>\\)" - (1 font-lock-keyword-face) - (2 font-lock-function-name-face)))))) - - -(provide 'multi) -;;; multi.el ends here diff --git a/elpa/pos-tip-20150318.813/pos-tip-autoloads.el b/elpa/pos-tip-20150318.813/pos-tip-autoloads.el deleted file mode 100644 index fecedac..0000000 --- a/elpa/pos-tip-20150318.813/pos-tip-autoloads.el +++ /dev/null @@ -1,15 +0,0 @@ -;;; pos-tip-autoloads.el --- automatically extracted autoloads -;; -;;; Code: -(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) - -;;;### (autoloads nil nil ("pos-tip.el") (22297 53347 971569 117000)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; End: -;;; pos-tip-autoloads.el ends here diff --git a/elpa/pos-tip-20150318.813/pos-tip-pkg.el b/elpa/pos-tip-20150318.813/pos-tip-pkg.el deleted file mode 100644 index d3536ea..0000000 --- a/elpa/pos-tip-20150318.813/pos-tip-pkg.el +++ /dev/null @@ -1 +0,0 @@ -(define-package "pos-tip" "20150318.813" "Show tooltip at point" 'nil :keywords '("tooltip")) diff --git a/elpa/pos-tip-20150318.813/pos-tip.el b/elpa/pos-tip-20150318.813/pos-tip.el deleted file mode 100644 index 62d8c70..0000000 --- a/elpa/pos-tip-20150318.813/pos-tip.el +++ /dev/null @@ -1,980 +0,0 @@ -;;; pos-tip.el --- Show tooltip at point -*- coding: utf-8 -*- - -;; Copyright (C) 2010 S. Irie - -;; Author: S. Irie -;; Maintainer: S. Irie -;; Keywords: Tooltip -;; Package-Version: 20150318.813 - -(defconst pos-tip-version "0.4.6") - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or -;; (at your option) any later version. - -;; It 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, write to the Free -;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, -;; MA 02110-1301 USA - -;;; Commentary: - -;; The standard library tooltip.el provides the function for displaying -;; a tooltip at mouse position which allows users to easily show it. -;; However, locating tooltip at arbitrary buffer position in window -;; is not easy. This program provides such function to be used by other -;; frontend programs. - -;; This program is tested on GNU Emacs 22, 23 under X window system and -;; Emacs 23 for MS-Windows. - -;; -;; Installation: -;; -;; First, save this file as pos-tip.el and byte-compile in -;; a directory that is listed in load-path. -;; -;; Put the following in your .emacs file: -;; -;; (require 'pos-tip) -;; -;; To use the full features of this program on MS-Windows, -;; put the additional setting in .emacs file: -;; -;; (pos-tip-w32-max-width-height) ; Maximize frame temporarily -;; -;; or -;; -;; (pos-tip-w32-max-width-height t) ; Keep frame maximized - -;; -;; Examples: -;; -;; We can display a tooltip at the current position by the following: -;; -;; (pos-tip-show "foo bar") -;; -;; If you'd like to specify the tooltip color, use an expression as: -;; -;; (pos-tip-show "foo bar" '("white" . "red")) -;; -;; Here, "white" and "red" are the foreground color and background -;; color, respectively. - - -;;; History: -;; 2013-07-16 P. Kalinowski -;; * Adjusted `pos-tip-show' to correctly set tooltip text foreground -;; color when using custom color themes. -;; * Version 0.4.6 -;; -;; 2010-09-27 S. Irie -;; * Simplified implementation of `pos-tip-window-system' -;; * Version 0.4.5 -;; -;; 2010-08-20 S. Irie -;; * Changed to use `window-line-height' to calculate tooltip position -;; * Changed `pos-tip-string-width-height' to ignore last empty line -;; * Version 0.4.4 -;; -;; 2010-07-25 S. Irie -;; * Bug fix -;; * Version 0.4.3 -;; -;; 2010-06-09 S. Irie -;; * Bug fix -;; * Version 0.4.2 -;; -;; 2010-06-04 S. Irie -;; * Added support for text-scale-mode -;; * Version 0.4.1 -;; -;; 2010-05-04 S. Irie -;; * Added functions: -;; `pos-tip-x-display-width', `pos-tip-x-display-height' -;; `pos-tip-normalize-natnum', `pos-tip-frame-relative-position' -;; * Fixed the supports for multi-displays and multi-frames -;; * Version 0.4.0 -;; -;; 2010-04-29 S. Irie -;; * Modified to avoid byte-compile warning -;; * Bug fix -;; * Version 0.3.6 -;; -;; 2010-04-29 S. Irie -;; * Renamed argument MAX-HEIGHT of `pos-tip-fill-string' to MAX-ROWS -;; * Modified old FSF address -;; * Version 0.3.5 -;; -;; 2010-04-29 S. Irie -;; * Modified `pos-tip-show' to truncate string exceeding display size -;; * Added function `pos-tip-truncate-string' -;; * Added optional argument MAX-ROWS to `pos-tip-split-string' -;; * Added optional argument MAX-HEIGHT to `pos-tip-fill-string' -;; * Version 0.3.4 -;; -;; 2010-04-16 S. Irie -;; * Changed `pos-tip-show' not to fill paragraph unless exceeding WIDTH -;; * Version 0.3.3 -;; -;; 2010-04-08 S. Irie -;; * Bug fix -;; * Version 0.3.2 -;; -;; 2010-03-31 S. Irie -;; * Bug fix -;; * Version 0.3.1 -;; -;; 2010-03-30 S. Irie -;; * Added support for MS-Windows -;; * Added option `pos-tip-use-relative-coordinates' -;; * Bug fixes -;; * Version 0.3.0 -;; -;; 2010-03-23 S. Irie -;; * Changed argument WORD-WRAP to JUSTIFY -;; * Added optional argument SQUEEZE -;; * Added function `pos-tip-fill-string' -;; * Added option `pos-tip-tab-width' used to expand tab characters -;; * Bug fixes -;; * Version 0.2.0 -;; -;; 2010-03-22 S. Irie -;; * Added optional argument WORD-WRAP to `pos-tip-split-string' -;; * Changed `pos-tip-show' to perform word wrap or kinsoku shori -;; * Version 0.1.8 -;; -;; 2010-03-20 S. Irie -;; * Added optional argument DY -;; * Bug fix -;; * Modified docstrings -;; * Version 0.1.7 -;; -;; 2010-03-18 S. Irie -;; * Added/modifed docstrings -;; * Changed working buffer name to " *xwininfo*" -;; * Version 0.1.6 -;; -;; 2010-03-17 S. Irie -;; * Fixed typos in docstrings -;; * Version 0.1.5 -;; -;; 2010-03-16 S. Irie -;; * Added support for multi-display environment -;; * Bug fix -;; * Version 0.1.4 -;; -;; 2010-03-16 S. Irie -;; * Bug fix -;; * Changed calculation for `x-max-tooltip-size' -;; * Modified docstring -;; * Version 0.1.3 -;; -;; 2010-03-11 S. Irie -;; * Modified commentary -;; * Version 0.1.2 -;; -;; 2010-03-11 S. Irie -;; * Re-implemented `pos-tip-string-width-height' -;; * Added indicator variable `pos-tip-upperside-p' -;; * Version 0.1.1 -;; -;; 2010-03-09 S. Irie -;; * Re-implemented `pos-tip-show' (*incompatibly changed*) -;; - Use frame default font -;; - Automatically calculate tooltip pixel size -;; - Added optional arguments: TIP-COLOR, MAX-WIDTH -;; * Added utility functions: -;; `pos-tip-split-string', `pos-tip-string-width-height' -;; * Bug fixes -;; * Version 0.1.0 -;; -;; 2010-03-08 S. Irie -;; * Added optional argument DX -;; * Version 0.0.4 -;; -;; 2010-03-08 S. Irie -;; * Bug fix -;; * Version 0.0.3 -;; -;; 2010-03-08 S. Irie -;; * Modified to move out mouse pointer -;; * Version 0.0.2 -;; -;; 2010-03-07 S. Irie -;; * First release -;; * Version 0.0.1 - -;; ToDo: - -;;; Code: -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Settings -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defgroup pos-tip nil - "Show tooltip at point" - :group 'faces - :prefix "pos-tip-") - -(defcustom pos-tip-border-width 1 - "Outer border width of pos-tip's tooltip." - :type 'integer - :group 'pos-tip) - -(defcustom pos-tip-internal-border-width 2 - "Text margin of pos-tip's tooltip." - :type 'integer - :group 'pos-tip) - -(defcustom pos-tip-foreground-color nil - "Default foreground color of pos-tip's tooltip. -When `nil', look up the foreground color of the `tooltip' face." - :type '(choice (const :tag "Default" nil) - string) - :group 'pos-tip) - -(defcustom pos-tip-background-color nil - "Default background color of pos-tip's tooltip. -When `nil', look up the background color of the `tooltip' face." - :type '(choice (const :tag "Default" nil) - string) - :group 'pos-tip) - -(defcustom pos-tip-tab-width nil - "Tab width used for `pos-tip-split-string' and `pos-tip-fill-string' -to expand tab characters. nil means use default value of `tab-width'." - :type '(choice (const :tag "Default" nil) - integer) - :group 'pos-tip) - -(defcustom pos-tip-use-relative-coordinates nil - "Non-nil means tooltip location is calculated as a coordinates -relative to the top left corner of frame. In this case the tooltip -will always be displayed within the frame. - -Note that this variable is automatically set to non-nil if absolute -coordinates can't be obtained by `pos-tip-compute-pixel-position'." - :type 'boolean - :group 'pos-tip) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun pos-tip-window-system (&optional frame) - "The name of the window system that FRAME is displaying through. -The value is a symbol---for instance, 'x' for X windows. -The value is nil if Emacs is using a text-only terminal. - -FRAME defaults to the currently selected frame." - (let ((type (framep (or frame (selected-frame))))) - (if type - (and (not (eq type t)) - type) - (signal 'wrong-type-argument (list 'framep frame))))) - -(defun pos-tip-normalize-natnum (object &optional n) - "Return a Nth power of 2 if OBJECT is a positive integer. -Otherwise return 0. Omitting N means return 1 for a positive integer." - (ash (if (and (natnump object) (> object 0)) 1 0) - (or n 0))) - -(defvar pos-tip-saved-frame-coordinates '(0 . 0) - "The latest result of `pos-tip-frame-top-left-coordinates'.") - -(defvar pos-tip-frame-offset nil - "The latest result of `pos-tip-calibrate-frame-offset'. This value -is used for non-X graphical environment.") - -(defvar pos-tip-frame-offset-array [nil nil nil nil] - "Array of the results of `pos-tip-calibrate-frame-offset'. They are -recorded only when `pos-tip-frame-top-left-coordinates' is called for a -non-X but graphical frame. - -The 2nd and 4th elements are the values for frames having a menu bar. -The 3rd and 4th elements are the values for frames having a tool bar.") - -(defun pos-tip-frame-top-left-coordinates (&optional frame) - "Return the pixel coordinates of FRAME as a cons cell (LEFT . TOP), -which are relative to top left corner of screen. - -Return nil if failing to acquire the coordinates. - -If FRAME is omitted, use selected-frame. - -Users can also get the frame coordinates by referring the variable -`pos-tip-saved-frame-coordinates' just after calling this function." - (let ((winsys (pos-tip-window-system frame))) - (cond - ((null winsys) - (error "text-only frame: %S" frame)) - ((eq winsys 'x) - (condition-case nil - (with-current-buffer (get-buffer-create " *xwininfo*") - (let ((case-fold-search nil)) - (buffer-disable-undo) - (erase-buffer) - (call-process shell-file-name nil t nil shell-command-switch - (format "xwininfo -display %s -id %s" - (frame-parameter frame 'display) - (frame-parameter frame 'window-id))) - (goto-char (point-min)) - (search-forward "\n Absolute") - (setq pos-tip-saved-frame-coordinates - (cons (string-to-number (buffer-substring-no-properties - (search-forward "X: ") - (line-end-position))) - (string-to-number (buffer-substring-no-properties - (search-forward "Y: ") - (line-end-position))))))) - (error nil))) - (t - (let* ((index (+ (pos-tip-normalize-natnum - (frame-parameter frame 'menu-bar-lines) 0) - (pos-tip-normalize-natnum - (frame-parameter frame 'tool-bar-lines) 1))) - (offset (or (aref pos-tip-frame-offset-array index) - (aset pos-tip-frame-offset-array index - (pos-tip-calibrate-frame-offset frame))))) - (if offset - (setq pos-tip-saved-frame-coordinates - (cons (+ (eval (frame-parameter frame 'left)) - (car offset)) - (+ (eval (frame-parameter frame 'top)) - (cdr offset)))))))))) - -(defun pos-tip-frame-relative-position - (frame1 frame2 &optional w32-frame frame-coord1 frame-coord2) - "Return the pixel coordinates of FRAME1 relative to FRAME2 -as a cons cell (LEFT . TOP). - -W32-FRAME non-nil means both of frames are under `w32' window system. - -FRAME-COORD1 and FRAME-COORD2, if given, specify the absolute -coordinates of FRAME1 and FRAME2, respectively, which make the -calculations faster if the frames have different heights of menu bars -and tool bars." - (if (and (eq (pos-tip-normalize-natnum - (frame-parameter frame1 'menu-bar-lines)) - (pos-tip-normalize-natnum - (frame-parameter frame2 'menu-bar-lines))) - (or w32-frame - (eq (pos-tip-normalize-natnum - (frame-parameter frame1 'tool-bar-lines)) - (pos-tip-normalize-natnum - (frame-parameter frame2 'tool-bar-lines))))) - (cons (- (eval (frame-parameter frame1 'left)) - (eval (frame-parameter frame2 'left))) - (- (eval (frame-parameter frame1 'top)) - (eval (frame-parameter frame2 'top)))) - (unless frame-coord1 - (setq frame-coord1 (let (pos-tip-saved-frame-coordinates) - (pos-tip-frame-top-left-coordinates frame1)))) - (unless frame-coord2 - (setq frame-coord2 (let (pos-tip-saved-frame-coordinates) - (pos-tip-frame-top-left-coordinates frame2)))) - (cons (- (car frame-coord1) (car frame-coord2)) - (- (cdr frame-coord1) (cdr frame-coord2))))) - -(defvar pos-tip-upperside-p nil - "Non-nil indicates the latest result of `pos-tip-compute-pixel-position' -was upper than the location specified by the arguments.") - -(defvar pos-tip-w32-saved-max-width-height nil - "Display pixel size effective for showing tooltip in MS-Windows desktop. -This doesn't include the taskbar area, so isn't same as actual display size.") - -(defun pos-tip-compute-pixel-position - (&optional pos window pixel-width pixel-height frame-coordinates dx dy) - "Return pixel position of POS in WINDOW like (X . Y), which indicates -the absolute or relative coordinates of bottom left corner of the object. - -Omitting POS and WINDOW means use current position and selected window, -respectively. - -If PIXEL-WIDTH and PIXEL-HEIGHT are given, this function assumes these -values as the size of small window like tooltip which is located around the -object at POS. These values are used to adjust the location in order that -the tooltip won't disappear by sticking out of the display. By referring -the variable `pos-tip-upperside-p' after calling this function, user can -examine whether the tooltip will be located above the specified position. - -If FRAME-COORDINATES is omitted or nil, automatically obtain the absolute -coordinates of the top left corner of frame which WINDOW is on. Here, -`top left corner of frame' represents the origin of `window-pixel-edges' -and its coordinates are essential for calculating the return value as -absolute coordinates. If a cons cell like (LEFT . TOP), specifies the -frame absolute location and makes the calculation slightly faster, but can -be used only when it's clear that frame is in the specified position. Users -can get the latest values of frame coordinates for using in the next call -by referring the variable `pos-tip-saved-frame-coordinates' just after -calling this function. Otherwise, FRAME-COORDINATES `relative' means return -pixel coordinates of the object relative to the top left corner of the frame. -This is the same effect as `pos-tip-use-relative-coordinates' is non-nil. - -DX specifies horizontal offset in pixel. - -DY specifies vertical offset in pixel. This makes the calculations done -without considering the height of object at POS, so the object might be -hidden by the tooltip." - (let* ((frame (window-frame (or window (selected-window)))) - (w32-frame (eq (pos-tip-window-system frame) 'w32)) - (relative (or pos-tip-use-relative-coordinates - (eq frame-coordinates 'relative) - (and w32-frame - (null pos-tip-w32-saved-max-width-height)))) - (frame-coord (or (and relative '(0 . 0)) - frame-coordinates - (pos-tip-frame-top-left-coordinates frame) - (progn - (setq relative t - pos-tip-use-relative-coordinates t) - '(0 . 0)))) - (posn (posn-at-point (or pos (window-point window)) window)) - (line (cdr (posn-actual-col-row posn))) - (line-height (and line - (or (window-line-height line window) - (and (redisplay t) - (window-line-height line window))))) - (x-y (or (posn-x-y posn) - (let ((geom (pos-visible-in-window-p - (or pos (window-point window)) window t))) - (and geom (cons (car geom) (cadr geom)))) - '(0 . 0))) - (x (+ (car frame-coord) - (car (window-inside-pixel-edges window)) - (car x-y) - (or dx 0))) - (y0 (+ (cdr frame-coord) - (cadr (window-pixel-edges window)) - (or (nth 2 line-height) (cdr x-y)))) - (y (+ y0 - (or dy - (car line-height) - (with-current-buffer (window-buffer window) - (cond - ;; `posn-object-width-height' returns an incorrect value - ;; when the header line is displayed (Emacs bug #4426). - ((and posn - (null header-line-format)) - (cdr (posn-object-width-height posn))) - ((and (bound-and-true-p text-scale-mode) - (not (zerop (with-no-warnings - text-scale-mode-amount)))) - (round (* (frame-char-height frame) - (with-no-warnings - (expt text-scale-mode-step - text-scale-mode-amount))))) - (t - (frame-char-height frame))))))) - xmax ymax) - (cond - (relative - (setq xmax (frame-pixel-width frame) - ymax (frame-pixel-height frame))) - (w32-frame - (setq xmax (car pos-tip-w32-saved-max-width-height) - ymax (cdr pos-tip-w32-saved-max-width-height))) - (t - (setq xmax (x-display-pixel-width frame) - ymax (x-display-pixel-height frame)))) - (setq pos-tip-upperside-p (> (+ y (or pixel-height 0)) - ymax)) - (cons (max 0 (min x (- xmax (or pixel-width 0)))) - (max 0 (if pos-tip-upperside-p - (- (if dy ymax y0) (or pixel-height 0)) - y))))) - -(defun pos-tip-cancel-timer () - "Cancel timeout of tooltip." - (mapc (lambda (timer) - (if (eq (aref timer 5) 'x-hide-tip) - (cancel-timer timer))) - timer-list)) - -(defun pos-tip-avoid-mouse (left right top bottom &optional frame) - "Move out mouse pointer if it is inside region (LEFT RIGHT TOP BOTTOM) -in FRAME. Return new mouse position like (FRAME . (X . Y))." - (unless frame - (setq frame (selected-frame))) - (let* ((mpos (with-selected-window (frame-selected-window frame) - (mouse-pixel-position))) - (mframe (pop mpos)) - (mx (car mpos)) - (my (cdr mpos))) - (when (and (eq mframe frame) - (numberp mx)) - (let* ((large-number (+ (frame-pixel-width frame) (frame-pixel-height frame))) - (dl (if (> left 2) - (1+ (- mx left)) - large-number)) - (dr (if (< (1+ right) (frame-pixel-width frame)) - (- right mx) - large-number)) - (dt (if (> top 2) - (1+ (- my top)) - large-number)) - (db (if (< (1+ bottom) (frame-pixel-height frame)) - (- bottom my) - large-number)) - (d (min dl dr dt db))) - (when (> d -2) - (cond - ((= d dl) - (setq mx (- left 2))) - ((= d dr) - (setq mx (1+ right))) - ((= d dt) - (setq my (- top 2))) - (t - (setq my (1+ bottom)))) - (set-mouse-pixel-position frame mx my) - (sit-for 0.0001)))) - (cons mframe (and mpos (cons mx my))))) - -(defun pos-tip-compute-foreground-color (tip-color) - "Compute the foreground color to use for tooltip. - -TIP-COLOR is a face or a cons cell like (FOREGROUND-COLOR . BACKGROUND-COLOR). -If it is nil, use `pos-tip-foreground-color' or the foreground color of the -`tooltip' face." - (or (and (facep tip-color) - (face-attribute tip-color :foreground)) - (car-safe tip-color) - pos-tip-foreground-color - (face-foreground 'tooltip))) - -(defun pos-tip-compute-background-color (tip-color) - "Compute the background color to use for tooltip. - -TIP-COLOR is a face or a cons cell like (FOREGROUND-COLOR . BACKGROUND-COLOR). -If it is nil, use `pos-tip-background-color' or the background color of the -`tooltip' face." - (or (and (facep tip-color) - (face-attribute tip-color :background)) - (cdr-safe tip-color) - pos-tip-background-color - (face-background 'tooltip))) - -(defun pos-tip-show-no-propertize - (string &optional tip-color pos window timeout pixel-width pixel-height frame-coordinates dx dy) - "Show STRING in a tooltip at POS in WINDOW. -Analogous to `pos-tip-show' except don't propertize STRING by `pos-tip' face. - -PIXEL-WIDTH and PIXEL-HEIGHT specify the size of tooltip, if given. These -are used to adjust the tooltip position in order that it doesn't disappear by -sticking out of the display, and also used to prevent it from vanishing by -overlapping with mouse pointer. - -Note that this function itself doesn't calculate tooltip size because the -character width and height specified by faces are unknown. So users should -calculate PIXEL-WIDTH and PIXEL-HEIGHT by using `pos-tip-tooltip-width' and -`pos-tip-tooltip-height', or use `pos-tip-show' instead, which can -automatically calculate tooltip size. - -See `pos-tip-show' for details. - -Example: - -\(defface my-tooltip - '((t - :background \"gray85\" - :foreground \"black\" - :inherit variable-pitch)) - \"Face for my tooltip.\") - -\(defface my-tooltip-highlight - '((t - :background \"blue\" - :foreground \"white\" - :inherit my-tooltip)) - \"Face for my tooltip highlighted.\") - -\(let ((str (propertize \" foo \\n bar \\n baz \" 'face 'my-tooltip))) - (put-text-property 6 11 'face 'my-tooltip-highlight str) - (pos-tip-show-no-propertize str 'my-tooltip))" - (unless window - (setq window (selected-window))) - (let* ((frame (window-frame window)) - (winsys (pos-tip-window-system frame)) - (x-frame (eq winsys 'x)) - (w32-frame (eq winsys 'w32)) - (relative (or pos-tip-use-relative-coordinates - (eq frame-coordinates 'relative) - (and w32-frame - (null pos-tip-w32-saved-max-width-height)))) - (x-y (prog1 - (pos-tip-compute-pixel-position pos window - pixel-width pixel-height - frame-coordinates dx dy) - (if pos-tip-use-relative-coordinates - (setq relative t)))) - (ax (car x-y)) - (ay (cdr x-y)) - (rx (if relative ax (- ax (car pos-tip-saved-frame-coordinates)))) - (ry (if relative ay (- ay (cdr pos-tip-saved-frame-coordinates)))) - (retval (cons rx ry)) - (fg (pos-tip-compute-foreground-color tip-color)) - (bg (pos-tip-compute-background-color tip-color)) - (use-dxdy (or relative - (not x-frame))) - (spacing (frame-parameter frame 'line-spacing)) - (border (ash (+ pos-tip-border-width - pos-tip-internal-border-width) - 1)) - (x-max-tooltip-size - (cons (+ (if x-frame 1 0) - (/ (- (or pixel-width - (cond - (relative - (frame-pixel-width frame)) - (w32-frame - (car pos-tip-w32-saved-max-width-height)) - (t - (x-display-pixel-width frame)))) - border) - (frame-char-width frame))) - (/ (- (or pixel-height - (x-display-pixel-height frame)) - border) - (frame-char-height frame)))) - (mpos (with-selected-window window (mouse-pixel-position))) - (mframe (car mpos)) - default-frame-alist) - (if (or relative - (and use-dxdy - (null (cadr mpos)))) - (unless (and (cadr mpos) - (eq mframe frame)) - (let* ((edges (window-inside-pixel-edges (cadr (window-list frame)))) - (mx (ash (+ (pop edges) (cadr edges)) -1)) - (my (ash (+ (pop edges) (cadr edges)) -1))) - (setq mframe frame) - (set-mouse-pixel-position mframe mx my) - (sit-for 0.0001))) - (when (and (cadr mpos) - (not (eq mframe frame))) - (let ((rel-coord (pos-tip-frame-relative-position frame mframe w32-frame - frame-coordinates))) - (setq rx (+ rx (car rel-coord)) - ry (+ ry (cdr rel-coord)))))) - (and pixel-width pixel-height - (setq mpos (pos-tip-avoid-mouse rx (+ rx pixel-width - (if w32-frame 3 0)) - ry (+ ry pixel-height) - mframe))) - (x-show-tip string mframe - `((border-width . ,pos-tip-border-width) - (internal-border-width . ,pos-tip-internal-border-width) - ,@(and (not use-dxdy) `((left . ,ax) - (top . ,ay))) - (font . ,(frame-parameter frame 'font)) - ,@(and spacing `((line-spacing . ,spacing))) - ,@(and (stringp fg) `((foreground-color . ,fg))) - ,@(and (stringp bg) `((background-color . ,bg)))) - (and timeout (> timeout 0) timeout) - (and use-dxdy (- rx (cadr mpos))) - (and use-dxdy (- ry (cddr mpos)))) - (if (and timeout (<= timeout 0)) - (pos-tip-cancel-timer)) - retval)) - -(defun pos-tip-split-string (string &optional width margin justify squeeze max-rows) - "Split STRING into fixed width strings. Return a list of these strings. - -WIDTH specifies the width of filling each paragraph. WIDTH nil means use -the width of currently selected frame. Note that this function doesn't add any -padding characters at the end of each row. - -MARGIN, if non-nil, specifies left margin width which is the number of spece -characters to add at the beginning of each row. - -The optional fourth argument JUSTIFY specifies which kind of justification -to do: `full', `left', `right', `center', or `none'. A value of t means handle -each paragraph as specified by its text properties. Omitting JUSTIFY means -don't perform justification, word wrap and kinsoku shori (禁則処理). - -SQUEEZE nil means leave whitespaces other than line breaks untouched. - -MAX-ROWS, if given, specifies maximum number of elements of return value. -The elements exceeding this number are discarded." - (with-temp-buffer - (let* ((tab-width (or pos-tip-tab-width tab-width)) - (fill-column (or width (frame-width))) - (left-margin (or margin 0)) - (kinsoku-limit 1) - indent-tabs-mode - row rows) - (insert string) - (untabify (point-min) (point-max)) - (if justify - (fill-region (point-min) (point-max) justify (not squeeze)) - (setq margin (make-string left-margin ?\s))) - (goto-char (point-min)) - (while (prog2 - (let ((line (buffer-substring - (point) (progn (end-of-line) (point))))) - (if justify - (push line rows) - (while (progn - (setq line (concat margin line) - row (truncate-string-to-width line fill-column)) - (push row rows) - (if (not (= (length row) (length line))) - (setq line (substring line (length row)))))))) - (< (point) (point-max)) - (beginning-of-line 2))) - (nreverse (if max-rows - (last rows max-rows) - rows))))) - -(defun pos-tip-fill-string (string &optional width margin justify squeeze max-rows) - "Fill each of the paragraphs in STRING. - -WIDTH specifies the width of filling each paragraph. WIDTH nil means use -the width of currently selected frame. Note that this function doesn't add any -padding characters at the end of each row. - -MARGIN, if non-nil, specifies left margin width which is the number of spece -characters to add at the beginning of each row. - -The optional fourth argument JUSTIFY specifies which kind of justification -to do: `full', `left', `right', `center', or `none'. A value of t means handle -each paragraph as specified by its text properties. Omitting JUSTIFY means -don't perform justification, word wrap and kinsoku shori (禁則処理). - -SQUEEZE nil means leave whitespaces other than line breaks untouched. - -MAX-ROWS, if given, specifies maximum number of rows. The rows exceeding -this number are discarded." - (if justify - (with-temp-buffer - (let* ((tab-width (or pos-tip-tab-width tab-width)) - (fill-column (or width (frame-width))) - (left-margin (or margin 0)) - (kinsoku-limit 1) - indent-tabs-mode) - (insert string) - (untabify (point-min) (point-max)) - (fill-region (point-min) (point-max) justify (not squeeze)) - (if max-rows - (buffer-substring (goto-char (point-min)) - (line-end-position max-rows)) - (buffer-string)))) - (mapconcat 'identity - (pos-tip-split-string string width margin nil nil max-rows) - "\n"))) - -(defun pos-tip-truncate-string (string width height) - "Truncate each line of STRING to WIDTH and discard lines exceeding HEIGHT." - (with-temp-buffer - (insert string) - (goto-char (point-min)) - (let ((nrow 0) - rows) - (while (and (< nrow height) - (prog2 - (push (truncate-string-to-width - (buffer-substring (point) (progn (end-of-line) (point))) - width) - rows) - (< (point) (point-max)) - (beginning-of-line 2) - (setq nrow (1+ nrow))))) - (mapconcat 'identity (nreverse rows) "\n")))) - -(defun pos-tip-string-width-height (string) - "Count columns and rows of STRING. Return a cons cell like (WIDTH . HEIGHT). -The last empty line of STRING is ignored. - -Example: - -\(pos-tip-string-width-height \"abc\\nあいう\\n123\") -;; => (6 . 3)" - (with-temp-buffer - (insert string) - (goto-char (point-min)) - (end-of-line) - (let ((width (current-column)) - (height (if (eq (char-before (point-max)) ?\n) 0 1))) - (while (< (point) (point-max)) - (end-of-line 2) - (setq width (max (current-column) width) - height (1+ height))) - (cons width height)))) - -(defun pos-tip-x-display-width (&optional frame) - "Return maximum column number in tooltip which occupies the full width -of display. Omitting FRAME means use display that selected frame is in." - (1+ (/ (x-display-pixel-width frame) (frame-char-width frame)))) - -(defun pos-tip-x-display-height (&optional frame) - "Return maximum row number in tooltip which occupies the full height -of display. Omitting FRAME means use display that selected frame is in." - (1+ (/ (x-display-pixel-height frame) (frame-char-height frame)))) - -(defun pos-tip-tooltip-width (width char-width) - "Calculate tooltip pixel width." - (+ (* width char-width) - (ash (+ pos-tip-border-width - pos-tip-internal-border-width) - 1))) - -(defun pos-tip-tooltip-height (height char-height &optional frame) - "Calculate tooltip pixel height." - (let ((spacing (or (default-value 'line-spacing) - (frame-parameter frame 'line-spacing)))) - (+ (* height (+ char-height - (cond - ((integerp spacing) - spacing) - ((floatp spacing) - (truncate (* (frame-char-height frame) - spacing))) - (t 0)))) - (ash (+ pos-tip-border-width - pos-tip-internal-border-width) - 1)))) - -(defun pos-tip-show - (string &optional tip-color pos window timeout width frame-coordinates dx dy) - "Show STRING in a tooltip, which is a small X window, at POS in WINDOW -using frame's default font with TIP-COLOR. - -Return pixel position of tooltip relative to top left corner of frame as -a cons cell like (X . Y). - -TIP-COLOR is a face or a cons cell like (FOREGROUND-COLOR . BACKGROUND-COLOR) -used to specify *only* foreground-color and background-color of tooltip. If -omitted, use `pos-tip-foreground-color' and `pos-tip-background-color' or the -foreground and background color of the `tooltip' face instead. - -Omitting POS and WINDOW means use current position and selected window, -respectively. - -Automatically hide the tooltip after TIMEOUT seconds. Omitting TIMEOUT means -use the default timeout of 5 seconds. Non-positive TIMEOUT means don't hide -tooltip automatically. - -WIDTH, if non-nil, specifies the width of filling each paragraph. - -If FRAME-COORDINATES is omitted or nil, automatically obtain the absolute -coordinates of the top left corner of frame which WINDOW is on. Here, -`top left corner of frame' represents the origin of `window-pixel-edges' -and its coordinates are essential for calculating the absolute coordinates -of the tooltip. If a cons cell like (LEFT . TOP), specifies the frame -absolute location and makes the calculation slightly faster, but can be -used only when it's clear that frame is in the specified position. Users -can get the latest values of frame coordinates for using in the next call -by referring the variable `pos-tip-saved-frame-coordinates' just after -calling this function. Otherwise, FRAME-COORDINATES `relative' means use -the pixel coordinates relative to the top left corner of the frame for -displaying the tooltip. This is the same effect as -`pos-tip-use-relative-coordinates' is non-nil. - -DX specifies horizontal offset in pixel. - -DY specifies vertical offset in pixel. This makes the calculations done -without considering the height of object at POS, so the object might be -hidden by the tooltip. - -See also `pos-tip-show-no-propertize'." - (unless window - (setq window (selected-window))) - (let* ((frame (window-frame window)) - (max-width (pos-tip-x-display-width frame)) - (max-height (pos-tip-x-display-height frame)) - (w-h (pos-tip-string-width-height string)) - (fg (pos-tip-compute-foreground-color tip-color)) - (bg (pos-tip-compute-background-color tip-color)) - (frame-font (find-font (font-spec :name (frame-parameter frame 'font)))) - (tip-face-attrs (list :font frame-font :foreground fg :background bg))) - (cond - ((and width - (> (car w-h) width)) - (setq string (pos-tip-fill-string string width nil 'none nil max-height) - w-h (pos-tip-string-width-height string))) - ((or (> (car w-h) max-width) - (> (cdr w-h) max-height)) - (setq string (pos-tip-truncate-string string max-width max-height) - w-h (pos-tip-string-width-height string)))) - (pos-tip-show-no-propertize - (propertize string 'face tip-face-attrs) - tip-color pos window timeout - (pos-tip-tooltip-width (car w-h) (frame-char-width frame)) - (pos-tip-tooltip-height (cdr w-h) (frame-char-height frame) frame) - frame-coordinates dx dy))) - -(defalias 'pos-tip-hide 'x-hide-tip - "Hide pos-tip's tooltip.") - -(defun pos-tip-calibrate-frame-offset (&optional frame) - "Return coordinates of FRAME orign relative to the top left corner of -the FRAME extent, like (LEFT . TOP). The return value is recorded to -`pos-tip-frame-offset'. - -Note that this function does't correctly work for X frame and Emacs 22." - (setq pos-tip-frame-offset nil) - (let* ((window (frame-first-window frame)) - (delete-frame-functions - '((lambda (frame) - (if (equal (frame-parameter frame 'name) "tooltip") - (setq pos-tip-frame-offset - (cons (eval (frame-parameter frame 'left)) - (eval (frame-parameter frame 'top)))))))) - (pos-tip-border-width 0) - (pos-tip-internal-border-width 1) - (rpos (pos-tip-show "" - `(nil . ,(frame-parameter frame 'background-color)) - (window-start window) window - nil nil 'relative nil 0))) - (sit-for 0) - (pos-tip-hide) - (and pos-tip-frame-offset - (setq pos-tip-frame-offset - (cons (- (car pos-tip-frame-offset) - (car rpos) - (eval (frame-parameter frame 'left))) - (- (cdr pos-tip-frame-offset) - (cdr rpos) - (eval (frame-parameter frame 'top)))))))) - -(defun pos-tip-w32-max-width-height (&optional keep-maximize) - "Maximize the currently selected frame temporarily and set -`pos-tip-w32-saved-max-width-height' the effective display size in order -to become possible to calculate the absolute location of tooltip. - -KEEP-MAXIMIZE non-nil means leave the frame maximized. - -Note that this function is usable only in Emacs 23 for MS-Windows." - (interactive) - (unless (eq window-system 'w32) - (error "`pos-tip-w32-max-width-height' can be used only in w32 frame.")) - ;; Maximize frame - (with-no-warnings (w32-send-sys-command 61488)) - (sit-for 0) - (let ((offset (pos-tip-calibrate-frame-offset))) - (prog1 - (setq pos-tip-w32-saved-max-width-height - (cons (frame-pixel-width) - (+ (frame-pixel-height) - (- (cdr offset) (car offset))))) - (if (called-interactively-p 'interactive) - (message "%S" pos-tip-w32-saved-max-width-height)) - (unless keep-maximize - ;; Restore frame - (with-no-warnings (w32-send-sys-command 61728)))))) - - -(provide 'pos-tip) - -;;; -;;; pos-tip.el ends here diff --git a/init.el b/init.el index d66b2f9..3e0d281 100644 --- a/init.el +++ b/init.el @@ -57,7 +57,6 @@ command-log-mode company company-c-headers - company-quickhelp company-shell diminish drag-stuff @@ -87,7 +86,6 @@ helm-google helm-gtags helm-projectile - helm-spotify helm-swoop helm-unicode hyde @@ -407,10 +405,6 @@ (use-package company-c-headers) -(use-package company-quickhelp - :config - (add-hook 'company-mode-hook 'company-quickhelp-mode)) - (use-package company-shell) (use-package electric-case @@ -455,8 +449,6 @@ (use-package helm-google) -(use-package helm-spotify) - (use-package hyde) (use-package id-manager)