Remove company-quickhelp and helm-spotify
I didn’t really use them, and they introduced some strange problems.
This commit is contained in:
Gergely Polonkai
parent
0ab774889a
commit
e2f9416bde
|
|
@ -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
|
|
||||||
|
|
@ -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"))
|
|
||||||
|
|
@ -1,204 +0,0 @@
|
||||||
;;; company-quickhelp.el --- Popup documentation for completion candidates
|
|
||||||
|
|
||||||
;; Copyright (C) 2016, Lars Andersen
|
|
||||||
|
|
||||||
;; Author: Lars Andersen <expez@expez.com>
|
|
||||||
;; 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 <http://www.gnu.org/licenses/>.
|
|
||||||
|
|
||||||
;;; 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
|
|
||||||
|
|
@ -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
|
|
||||||
|
|
@ -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"))
|
|
||||||
|
|
@ -1,132 +0,0 @@
|
||||||
;;; helm-spotify.el --- Control Spotify with Helm.
|
|
||||||
;; Copyright 2013 Kris Jenkins
|
|
||||||
;;
|
|
||||||
;; Author: Kris Jenkins <krisajenkins@gmail.com>
|
|
||||||
;; Maintainer: Kris Jenkins <krisajenkins@gmail.com>
|
|
||||||
;; 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
|
|
||||||
|
|
@ -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
|
|
||||||
|
|
@ -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"))
|
|
||||||
|
|
@ -1,134 +0,0 @@
|
||||||
;;; multi.el --- Clojure-style multi-methods for emacs lisp -*- lexical-binding: t -*-
|
|
||||||
|
|
||||||
;; Copyright (c) 2013 Christina Whyte <kurisu.whyte@gmail.com>
|
|
||||||
|
|
||||||
;; Version: 2.0.1
|
|
||||||
;; Package-Version: 20131013.844
|
|
||||||
;; Package-Requires: ((emacs "24"))
|
|
||||||
;; Keywords: multimethod generic predicate dispatch
|
|
||||||
;; Author: Christina Whyte <kurisu.whyte@gmail.com>
|
|
||||||
;; 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
|
|
||||||
|
|
@ -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
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
(define-package "pos-tip" "20150318.813" "Show tooltip at point" 'nil :keywords '("tooltip"))
|
|
||||||
|
|
@ -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
|
|
||||||
8
init.el
8
init.el
|
|
@ -57,7 +57,6 @@
|
||||||
command-log-mode
|
command-log-mode
|
||||||
company
|
company
|
||||||
company-c-headers
|
company-c-headers
|
||||||
company-quickhelp
|
|
||||||
company-shell
|
company-shell
|
||||||
diminish
|
diminish
|
||||||
drag-stuff
|
drag-stuff
|
||||||
|
|
@ -87,7 +86,6 @@
|
||||||
helm-google
|
helm-google
|
||||||
helm-gtags
|
helm-gtags
|
||||||
helm-projectile
|
helm-projectile
|
||||||
helm-spotify
|
|
||||||
helm-swoop
|
helm-swoop
|
||||||
helm-unicode
|
helm-unicode
|
||||||
hyde
|
hyde
|
||||||
|
|
@ -407,10 +405,6 @@
|
||||||
|
|
||||||
(use-package company-c-headers)
|
(use-package company-c-headers)
|
||||||
|
|
||||||
(use-package company-quickhelp
|
|
||||||
:config
|
|
||||||
(add-hook 'company-mode-hook 'company-quickhelp-mode))
|
|
||||||
|
|
||||||
(use-package company-shell)
|
(use-package company-shell)
|
||||||
|
|
||||||
(use-package electric-case
|
(use-package electric-case
|
||||||
|
|
@ -455,8 +449,6 @@
|
||||||
|
|
||||||
(use-package helm-google)
|
(use-package helm-google)
|
||||||
|
|
||||||
(use-package helm-spotify)
|
|
||||||
|
|
||||||
(use-package hyde)
|
(use-package hyde)
|
||||||
|
|
||||||
(use-package id-manager)
|
(use-package id-manager)
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue