.emacs.d.git - Gitblit

Chizi123

2018-11-17 5cb5f70b1872a757e93ea333b0e2dca50c6c8957

commit \| author \| age
5cb5f7	1	;;; pos-tip.el --- Show tooltip at point -- coding: utf-8 --
C	2
	3	;; Copyright (C) 2010 S. Irie
	4
	5	;; Author: S. Irie
	6	;; Maintainer: S. Irie
	7	;; Keywords: Tooltip
	8	;; Package-Version: 20150318.1513
	9
	10	(defconst pos-tip-version "0.4.6")
	11
	12	;; This program is free software; you can redistribute it and/or
	13	;; modify it under the terms of the GNU General Public License as
	14	;; published by the Free Software Foundation; either version 2, or
	15	;; (at your option) any later version.
	16
	17	;; It is distributed in the hope that it will be useful, but WITHOUT
	18	;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
	19	;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
	20	;; License for more details.
	21
	22	;; You should have received a copy of the GNU General Public
	23	;; License along with this program; if not, write to the Free
	24	;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
	25	;; MA 02110-1301 USA
	26
	27	;;; Commentary:
	28
	29	;; The standard library tooltip.el provides the function for displaying
	30	;; a tooltip at mouse position which allows users to easily show it.
	31	;; However, locating tooltip at arbitrary buffer position in window
	32	;; is not easy. This program provides such function to be used by other
	33	;; frontend programs.
	34
	35	;; This program is tested on GNU Emacs 22, 23 under X window system and
	36	;; Emacs 23 for MS-Windows.
	37
	38	;;
	39	;; Installation:
	40	;;
	41	;; First, save this file as pos-tip.el and byte-compile in
	42	;; a directory that is listed in load-path.
	43	;;
	44	;; Put the following in your .emacs file:
	45	;;
	46	;; (require 'pos-tip)
	47	;;
	48	;; To use the full features of this program on MS-Windows,
	49	;; put the additional setting in .emacs file:
	50	;;
	51	;; (pos-tip-w32-max-width-height) ; Maximize frame temporarily
	52	;;
	53	;; or
	54	;;
	55	;; (pos-tip-w32-max-width-height t) ; Keep frame maximized
	56
	57	;;
	58	;; Examples:
	59	;;
	60	;; We can display a tooltip at the current position by the following:
	61	;;
	62	;; (pos-tip-show "foo bar")
	63	;;
	64	;; If you'd like to specify the tooltip color, use an expression as:
	65	;;
	66	;; (pos-tip-show "foo bar" '("white" . "red"))
	67	;;
	68	;; Here, "white" and "red" are the foreground color and background
	69	;; color, respectively.
	70
	71
	72	;;; History:
	73	;; 2013-07-16 P. Kalinowski
	74	;; * Adjusted `pos-tip-show' to correctly set tooltip text foreground
	75	;; color when using custom color themes.
	76	;; * Version 0.4.6
	77	;;
	78	;; 2010-09-27 S. Irie
	79	;; * Simplified implementation of `pos-tip-window-system'
	80	;; * Version 0.4.5
	81	;;
	82	;; 2010-08-20 S. Irie
	83	;; * Changed to use `window-line-height' to calculate tooltip position
	84	;; * Changed `pos-tip-string-width-height' to ignore last empty line
	85	;; * Version 0.4.4
	86	;;
	87	;; 2010-07-25 S. Irie
	88	;; * Bug fix
	89	;; * Version 0.4.3
	90	;;
	91	;; 2010-06-09 S. Irie
	92	;; * Bug fix
	93	;; * Version 0.4.2
	94	;;
	95	;; 2010-06-04 S. Irie
	96	;; * Added support for text-scale-mode
	97	;; * Version 0.4.1
	98	;;
	99	;; 2010-05-04 S. Irie
	100	;; * Added functions:
	101	;; `pos-tip-x-display-width', `pos-tip-x-display-height'
	102	;; `pos-tip-normalize-natnum', `pos-tip-frame-relative-position'
	103	;; * Fixed the supports for multi-displays and multi-frames
	104	;; * Version 0.4.0
	105	;;
	106	;; 2010-04-29 S. Irie
	107	;; * Modified to avoid byte-compile warning
	108	;; * Bug fix
	109	;; * Version 0.3.6
	110	;;
	111	;; 2010-04-29 S. Irie
	112	;; * Renamed argument MAX-HEIGHT of `pos-tip-fill-string' to MAX-ROWS
	113	;; * Modified old FSF address
	114	;; * Version 0.3.5
	115	;;
	116	;; 2010-04-29 S. Irie
	117	;; * Modified `pos-tip-show' to truncate string exceeding display size
	118	;; * Added function `pos-tip-truncate-string'
	119	;; * Added optional argument MAX-ROWS to `pos-tip-split-string'
	120	;; * Added optional argument MAX-HEIGHT to `pos-tip-fill-string'
	121	;; * Version 0.3.4
	122	;;
	123	;; 2010-04-16 S. Irie
	124	;; * Changed `pos-tip-show' not to fill paragraph unless exceeding WIDTH
	125	;; * Version 0.3.3
	126	;;
	127	;; 2010-04-08 S. Irie
	128	;; * Bug fix
	129	;; * Version 0.3.2
	130	;;
	131	;; 2010-03-31 S. Irie
	132	;; * Bug fix
	133	;; * Version 0.3.1
	134	;;
	135	;; 2010-03-30 S. Irie
	136	;; * Added support for MS-Windows
	137	;; * Added option `pos-tip-use-relative-coordinates'
	138	;; * Bug fixes
	139	;; * Version 0.3.0
	140	;;
	141	;; 2010-03-23 S. Irie
	142	;; * Changed argument WORD-WRAP to JUSTIFY
	143	;; * Added optional argument SQUEEZE
	144	;; * Added function `pos-tip-fill-string'
	145	;; * Added option `pos-tip-tab-width' used to expand tab characters
	146	;; * Bug fixes
	147	;; * Version 0.2.0
	148	;;
	149	;; 2010-03-22 S. Irie
	150	;; * Added optional argument WORD-WRAP to `pos-tip-split-string'
	151	;; * Changed `pos-tip-show' to perform word wrap or kinsoku shori
	152	;; * Version 0.1.8
	153	;;
	154	;; 2010-03-20 S. Irie
	155	;; * Added optional argument DY
	156	;; * Bug fix
	157	;; * Modified docstrings
	158	;; * Version 0.1.7
	159	;;
	160	;; 2010-03-18 S. Irie
	161	;; * Added/modifed docstrings
	162	;; * Changed working buffer name to " xwininfo"
	163	;; * Version 0.1.6
	164	;;
	165	;; 2010-03-17 S. Irie
	166	;; * Fixed typos in docstrings
	167	;; * Version 0.1.5
	168	;;
	169	;; 2010-03-16 S. Irie
	170	;; * Added support for multi-display environment
	171	;; * Bug fix
	172	;; * Version 0.1.4
	173	;;
	174	;; 2010-03-16 S. Irie
	175	;; * Bug fix
	176	;; * Changed calculation for `x-max-tooltip-size'
	177	;; * Modified docstring
	178	;; * Version 0.1.3
	179	;;
	180	;; 2010-03-11 S. Irie
	181	;; * Modified commentary
	182	;; * Version 0.1.2
	183	;;
	184	;; 2010-03-11 S. Irie
	185	;; * Re-implemented `pos-tip-string-width-height'
	186	;; * Added indicator variable `pos-tip-upperside-p'
	187	;; * Version 0.1.1
	188	;;
	189	;; 2010-03-09 S. Irie
	190	;; * Re-implemented `pos-tip-show' (incompatibly changed)
	191	;; - Use frame default font
	192	;; - Automatically calculate tooltip pixel size
	193	;; - Added optional arguments: TIP-COLOR, MAX-WIDTH
	194	;; * Added utility functions:
	195	;; `pos-tip-split-string', `pos-tip-string-width-height'
	196	;; * Bug fixes
	197	;; * Version 0.1.0
	198	;;
	199	;; 2010-03-08 S. Irie
	200	;; * Added optional argument DX
	201	;; * Version 0.0.4
	202	;;
	203	;; 2010-03-08 S. Irie
	204	;; * Bug fix
	205	;; * Version 0.0.3
	206	;;
	207	;; 2010-03-08 S. Irie
	208	;; * Modified to move out mouse pointer
	209	;; * Version 0.0.2
	210	;;
	211	;; 2010-03-07 S. Irie
	212	;; * First release
	213	;; * Version 0.0.1
	214
	215	;; ToDo:
	216
	217	;;; Code:
	218	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	219	;; Settings
	220	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	221
	222	(defgroup pos-tip nil
	223	"Show tooltip at point"
	224	:group 'faces
	225	:prefix "pos-tip-")
	226
	227	(defcustom pos-tip-border-width 1
	228	"Outer border width of pos-tip's tooltip."
	229	:type 'integer
	230	:group 'pos-tip)
	231
	232	(defcustom pos-tip-internal-border-width 2
	233	"Text margin of pos-tip's tooltip."
	234	:type 'integer
	235	:group 'pos-tip)
	236
	237	(defcustom pos-tip-foreground-color nil
	238	"Default foreground color of pos-tip's tooltip.
	239	When `nil', look up the foreground color of the `tooltip' face."
	240	:type '(choice (const :tag "Default" nil)
	241	string)
	242	:group 'pos-tip)
	243
	244	(defcustom pos-tip-background-color nil
	245	"Default background color of pos-tip's tooltip.
	246	When `nil', look up the background color of the `tooltip' face."
	247	:type '(choice (const :tag "Default" nil)
	248	string)
	249	:group 'pos-tip)
	250
	251	(defcustom pos-tip-tab-width nil
	252	"Tab width used for `pos-tip-split-string' and `pos-tip-fill-string'
	253	to expand tab characters. nil means use default value of `tab-width'."
	254	:type '(choice (const :tag "Default" nil)
	255	integer)
	256	:group 'pos-tip)
	257
	258	(defcustom pos-tip-use-relative-coordinates nil
	259	"Non-nil means tooltip location is calculated as a coordinates
	260	relative to the top left corner of frame. In this case the tooltip
	261	will always be displayed within the frame.
	262
	263	Note that this variable is automatically set to non-nil if absolute
	264	coordinates can't be obtained by `pos-tip-compute-pixel-position'."
	265	:type 'boolean
	266	:group 'pos-tip)
	267
	268	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	269	;; Functions
	270	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	271
	272	(defun pos-tip-window-system (&optional frame)
	273	"The name of the window system that FRAME is displaying through.
	274	The value is a symbol---for instance, 'x' for X windows.
	275	The value is nil if Emacs is using a text-only terminal.
	276
	277	FRAME defaults to the currently selected frame."
	278	(let ((type (framep (or frame (selected-frame)))))
	279	(if type
	280	(and (not (eq type t))
	281	type)
	282	(signal 'wrong-type-argument (list 'framep frame)))))
	283
	284	(defun pos-tip-normalize-natnum (object &optional n)
	285	"Return a Nth power of 2 if OBJECT is a positive integer.
	286	Otherwise return 0. Omitting N means return 1 for a positive integer."
	287	(ash (if (and (natnump object) (> object 0)) 1 0)
	288	(or n 0)))
	289
	290	(defvar pos-tip-saved-frame-coordinates '(0 . 0)
	291	"The latest result of `pos-tip-frame-top-left-coordinates'.")
	292
	293	(defvar pos-tip-frame-offset nil
	294	"The latest result of `pos-tip-calibrate-frame-offset'. This value
	295	is used for non-X graphical environment.")
	296
	297	(defvar pos-tip-frame-offset-array [nil nil nil nil]
	298	"Array of the results of `pos-tip-calibrate-frame-offset'. They are
	299	recorded only when `pos-tip-frame-top-left-coordinates' is called for a
	300	non-X but graphical frame.
	301
	302	The 2nd and 4th elements are the values for frames having a menu bar.
	303	The 3rd and 4th elements are the values for frames having a tool bar.")
	304
	305	(defun pos-tip-frame-top-left-coordinates (&optional frame)
	306	"Return the pixel coordinates of FRAME as a cons cell (LEFT . TOP),
	307	which are relative to top left corner of screen.
	308
	309	Return nil if failing to acquire the coordinates.
	310
	311	If FRAME is omitted, use selected-frame.
	312
	313	Users can also get the frame coordinates by referring the variable
	314	`pos-tip-saved-frame-coordinates' just after calling this function."
	315	(let ((winsys (pos-tip-window-system frame)))
	316	(cond
	317	((null winsys)
	318	(error "text-only frame: %S" frame))
	319	((eq winsys 'x)
	320	(condition-case nil
	321	(with-current-buffer (get-buffer-create " xwininfo")
	322	(let ((case-fold-search nil))
	323	(buffer-disable-undo)
	324	(erase-buffer)
	325	(call-process shell-file-name nil t nil shell-command-switch
	326	(format "xwininfo -display %s -id %s"
	327	(frame-parameter frame 'display)
	328	(frame-parameter frame 'window-id)))
	329	(goto-char (point-min))
	330	(search-forward "\n Absolute")
	331	(setq pos-tip-saved-frame-coordinates
	332	(cons (string-to-number (buffer-substring-no-properties
	333	(search-forward "X: ")
	334	(line-end-position)))
	335	(string-to-number (buffer-substring-no-properties
	336	(search-forward "Y: ")
	337	(line-end-position)))))))
	338	(error nil)))
	339	(t
	340	(let* ((index (+ (pos-tip-normalize-natnum
	341	(frame-parameter frame 'menu-bar-lines) 0)
	342	(pos-tip-normalize-natnum
	343	(frame-parameter frame 'tool-bar-lines) 1)))
	344	(offset (or (aref pos-tip-frame-offset-array index)
	345	(aset pos-tip-frame-offset-array index
	346	(pos-tip-calibrate-frame-offset frame)))))
	347	(if offset
	348	(setq pos-tip-saved-frame-coordinates
	349	(cons (+ (eval (frame-parameter frame 'left))
	350	(car offset))
	351	(+ (eval (frame-parameter frame 'top))
	352	(cdr offset))))))))))
	353
	354	(defun pos-tip-frame-relative-position
	355	(frame1 frame2 &optional w32-frame frame-coord1 frame-coord2)
	356	"Return the pixel coordinates of FRAME1 relative to FRAME2
	357	as a cons cell (LEFT . TOP).
	358
	359	W32-FRAME non-nil means both of frames are under `w32' window system.
	360
	361	FRAME-COORD1 and FRAME-COORD2, if given, specify the absolute
	362	coordinates of FRAME1 and FRAME2, respectively, which make the
	363	calculations faster if the frames have different heights of menu bars
	364	and tool bars."
	365	(if (and (eq (pos-tip-normalize-natnum
	366	(frame-parameter frame1 'menu-bar-lines))
	367	(pos-tip-normalize-natnum
	368	(frame-parameter frame2 'menu-bar-lines)))
	369	(or w32-frame
	370	(eq (pos-tip-normalize-natnum
	371	(frame-parameter frame1 'tool-bar-lines))
	372	(pos-tip-normalize-natnum
	373	(frame-parameter frame2 'tool-bar-lines)))))
	374	(cons (- (eval (frame-parameter frame1 'left))
	375	(eval (frame-parameter frame2 'left)))
	376	(- (eval (frame-parameter frame1 'top))
	377	(eval (frame-parameter frame2 'top))))
	378	(unless frame-coord1
	379	(setq frame-coord1 (let (pos-tip-saved-frame-coordinates)
	380	(pos-tip-frame-top-left-coordinates frame1))))
	381	(unless frame-coord2
	382	(setq frame-coord2 (let (pos-tip-saved-frame-coordinates)
	383	(pos-tip-frame-top-left-coordinates frame2))))
	384	(cons (- (car frame-coord1) (car frame-coord2))
	385	(- (cdr frame-coord1) (cdr frame-coord2)))))
	386
	387	(defvar pos-tip-upperside-p nil
	388	"Non-nil indicates the latest result of `pos-tip-compute-pixel-position'
	389	was upper than the location specified by the arguments.")
	390
	391	(defvar pos-tip-w32-saved-max-width-height nil
	392	"Display pixel size effective for showing tooltip in MS-Windows desktop.
	393	This doesn't include the taskbar area, so isn't same as actual display size.")
	394
	395	(defun pos-tip-compute-pixel-position
	396	(&optional pos window pixel-width pixel-height frame-coordinates dx dy)
	397	"Return pixel position of POS in WINDOW like (X . Y), which indicates
	398	the absolute or relative coordinates of bottom left corner of the object.
	399
	400	Omitting POS and WINDOW means use current position and selected window,
	401	respectively.
	402
	403	If PIXEL-WIDTH and PIXEL-HEIGHT are given, this function assumes these
	404	values as the size of small window like tooltip which is located around the
	405	object at POS. These values are used to adjust the location in order that
	406	the tooltip won't disappear by sticking out of the display. By referring
	407	the variable `pos-tip-upperside-p' after calling this function, user can
	408	examine whether the tooltip will be located above the specified position.
	409
	410	If FRAME-COORDINATES is omitted or nil, automatically obtain the absolute
	411	coordinates of the top left corner of frame which WINDOW is on. Here,
	412	`top left corner of frame' represents the origin of `window-pixel-edges'
	413	and its coordinates are essential for calculating the return value as
	414	absolute coordinates. If a cons cell like (LEFT . TOP), specifies the
	415	frame absolute location and makes the calculation slightly faster, but can
	416	be used only when it's clear that frame is in the specified position. Users
	417	can get the latest values of frame coordinates for using in the next call
	418	by referring the variable `pos-tip-saved-frame-coordinates' just after
	419	calling this function. Otherwise, FRAME-COORDINATES `relative' means return
	420	pixel coordinates of the object relative to the top left corner of the frame.
	421	This is the same effect as `pos-tip-use-relative-coordinates' is non-nil.
	422
	423	DX specifies horizontal offset in pixel.
	424
	425	DY specifies vertical offset in pixel. This makes the calculations done
	426	without considering the height of object at POS, so the object might be
	427	hidden by the tooltip."
	428	(let* ((frame (window-frame (or window (selected-window))))
	429	(w32-frame (eq (pos-tip-window-system frame) 'w32))
	430	(relative (or pos-tip-use-relative-coordinates
	431	(eq frame-coordinates 'relative)
	432	(and w32-frame
	433	(null pos-tip-w32-saved-max-width-height))))
	434	(frame-coord (or (and relative '(0 . 0))
	435	frame-coordinates
	436	(pos-tip-frame-top-left-coordinates frame)
	437	(progn
	438	(setq relative t
	439	pos-tip-use-relative-coordinates t)
	440	'(0 . 0))))
	441	(posn (posn-at-point (or pos (window-point window)) window))
	442	(line (cdr (posn-actual-col-row posn)))
	443	(line-height (and line
	444	(or (window-line-height line window)
	445	(and (redisplay t)
	446	(window-line-height line window)))))
	447	(x-y (or (posn-x-y posn)
	448	(let ((geom (pos-visible-in-window-p
	449	(or pos (window-point window)) window t)))
	450	(and geom (cons (car geom) (cadr geom))))
	451	'(0 . 0)))
	452	(x (+ (car frame-coord)
	453	(car (window-inside-pixel-edges window))
	454	(car x-y)
	455	(or dx 0)))
	456	(y0 (+ (cdr frame-coord)
	457	(cadr (window-pixel-edges window))
	458	(or (nth 2 line-height) (cdr x-y))))
	459	(y (+ y0
	460	(or dy
	461	(car line-height)
	462	(with-current-buffer (window-buffer window)
	463	(cond
	464	;; `posn-object-width-height' returns an incorrect value
	465	;; when the header line is displayed (Emacs bug #4426).
	466	((and posn
	467	(null header-line-format))
	468	(cdr (posn-object-width-height posn)))
	469	((and (bound-and-true-p text-scale-mode)
	470	(not (zerop (with-no-warnings
	471	text-scale-mode-amount))))
	472	(round (* (frame-char-height frame)
	473	(with-no-warnings
	474	(expt text-scale-mode-step
	475	text-scale-mode-amount)))))
	476	(t
	477	(frame-char-height frame)))))))
	478	xmax ymax)
	479	(cond
	480	(relative
	481	(setq xmax (frame-pixel-width frame)
	482	ymax (frame-pixel-height frame)))
	483	(w32-frame
	484	(setq xmax (car pos-tip-w32-saved-max-width-height)
	485	ymax (cdr pos-tip-w32-saved-max-width-height)))
	486	(t
	487	(setq xmax (x-display-pixel-width frame)
	488	ymax (x-display-pixel-height frame))))
	489	(setq pos-tip-upperside-p (> (+ y (or pixel-height 0))
	490	ymax))
	491	(cons (max 0 (min x (- xmax (or pixel-width 0))))
	492	(max 0 (if pos-tip-upperside-p
	493	(- (if dy ymax y0) (or pixel-height 0))
	494	y)))))
	495
	496	(defun pos-tip-cancel-timer ()
	497	"Cancel timeout of tooltip."
	498	(mapc (lambda (timer)
	499	(if (eq (aref timer 5) 'x-hide-tip)
	500	(cancel-timer timer)))
	501	timer-list))
	502
	503	(defun pos-tip-avoid-mouse (left right top bottom &optional frame)
	504	"Move out mouse pointer if it is inside region (LEFT RIGHT TOP BOTTOM)
	505	in FRAME. Return new mouse position like (FRAME . (X . Y))."
	506	(unless frame
	507	(setq frame (selected-frame)))
	508	(let* ((mpos (with-selected-window (frame-selected-window frame)
	509	(mouse-pixel-position)))
	510	(mframe (pop mpos))
	511	(mx (car mpos))
	512	(my (cdr mpos)))
	513	(when (and (eq mframe frame)
	514	(numberp mx))
	515	(let* ((large-number (+ (frame-pixel-width frame) (frame-pixel-height frame)))
	516	(dl (if (> left 2)
	517	(1+ (- mx left))
	518	large-number))
	519	(dr (if (< (1+ right) (frame-pixel-width frame))
	520	(- right mx)
	521	large-number))
	522	(dt (if (> top 2)
	523	(1+ (- my top))
	524	large-number))
	525	(db (if (< (1+ bottom) (frame-pixel-height frame))
	526	(- bottom my)
	527	large-number))
	528	(d (min dl dr dt db)))
	529	(when (> d -2)
	530	(cond
	531	((= d dl)
	532	(setq mx (- left 2)))
	533	((= d dr)
	534	(setq mx (1+ right)))
	535	((= d dt)
	536	(setq my (- top 2)))
	537	(t
	538	(setq my (1+ bottom))))
	539	(set-mouse-pixel-position frame mx my)
	540	(sit-for 0.0001))))
	541	(cons mframe (and mpos (cons mx my)))))
	542
	543	(defun pos-tip-compute-foreground-color (tip-color)
	544	"Compute the foreground color to use for tooltip.
	545
	546	TIP-COLOR is a face or a cons cell like (FOREGROUND-COLOR . BACKGROUND-COLOR).
	547	If it is nil, use `pos-tip-foreground-color' or the foreground color of the
	548	`tooltip' face."
	549	(or (and (facep tip-color)
	550	(face-attribute tip-color :foreground))
	551	(car-safe tip-color)
	552	pos-tip-foreground-color
	553	(face-foreground 'tooltip)))
	554
	555	(defun pos-tip-compute-background-color (tip-color)
	556	"Compute the background color to use for tooltip.
	557
	558	TIP-COLOR is a face or a cons cell like (FOREGROUND-COLOR . BACKGROUND-COLOR).
	559	If it is nil, use `pos-tip-background-color' or the background color of the
	560	`tooltip' face."
	561	(or (and (facep tip-color)
	562	(face-attribute tip-color :background))
	563	(cdr-safe tip-color)
	564	pos-tip-background-color
	565	(face-background 'tooltip)))
	566
	567	(defun pos-tip-show-no-propertize
	568	(string &optional tip-color pos window timeout pixel-width pixel-height frame-coordinates dx dy)
	569	"Show STRING in a tooltip at POS in WINDOW.
	570	Analogous to `pos-tip-show' except don't propertize STRING by `pos-tip' face.
	571
	572	PIXEL-WIDTH and PIXEL-HEIGHT specify the size of tooltip, if given. These
	573	are used to adjust the tooltip position in order that it doesn't disappear by
	574	sticking out of the display, and also used to prevent it from vanishing by
	575	overlapping with mouse pointer.
	576
	577	Note that this function itself doesn't calculate tooltip size because the
	578	character width and height specified by faces are unknown. So users should
	579	calculate PIXEL-WIDTH and PIXEL-HEIGHT by using `pos-tip-tooltip-width' and
	580	`pos-tip-tooltip-height', or use `pos-tip-show' instead, which can
	581	automatically calculate tooltip size.
	582
	583	See `pos-tip-show' for details.
	584
	585	Example:
	586
	587	\(defface my-tooltip
	588	'((t
	589	:background \"gray85\"
	590	:foreground \"black\"
	591	:inherit variable-pitch))
	592	\"Face for my tooltip.\")
	593
	594	\(defface my-tooltip-highlight
	595	'((t
	596	:background \"blue\"
	597	:foreground \"white\"
	598	:inherit my-tooltip))
	599	\"Face for my tooltip highlighted.\")
	600
	601	\(let ((str (propertize \" foo \\n bar \\n baz \" 'face 'my-tooltip)))
	602	(put-text-property 6 11 'face 'my-tooltip-highlight str)
	603	(pos-tip-show-no-propertize str 'my-tooltip))"
	604	(unless window
	605	(setq window (selected-window)))
	606	(let* ((frame (window-frame window))
	607	(winsys (pos-tip-window-system frame))
	608	(x-frame (eq winsys 'x))
	609	(w32-frame (eq winsys 'w32))
	610	(relative (or pos-tip-use-relative-coordinates
	611	(eq frame-coordinates 'relative)
	612	(and w32-frame
	613	(null pos-tip-w32-saved-max-width-height))))
	614	(x-y (prog1
	615	(pos-tip-compute-pixel-position pos window
	616	pixel-width pixel-height
	617	frame-coordinates dx dy)
	618	(if pos-tip-use-relative-coordinates
	619	(setq relative t))))
	620	(ax (car x-y))
	621	(ay (cdr x-y))
	622	(rx (if relative ax (- ax (car pos-tip-saved-frame-coordinates))))
	623	(ry (if relative ay (- ay (cdr pos-tip-saved-frame-coordinates))))
	624	(retval (cons rx ry))
	625	(fg (pos-tip-compute-foreground-color tip-color))
	626	(bg (pos-tip-compute-background-color tip-color))
	627	(use-dxdy (or relative
	628	(not x-frame)))
	629	(spacing (frame-parameter frame 'line-spacing))
	630	(border (ash (+ pos-tip-border-width
	631	pos-tip-internal-border-width)
	632	1))
	633	(x-max-tooltip-size
	634	(cons (+ (if x-frame 1 0)
	635	(/ (- (or pixel-width
	636	(cond
	637	(relative
	638	(frame-pixel-width frame))
	639	(w32-frame
	640	(car pos-tip-w32-saved-max-width-height))
	641	(t
	642	(x-display-pixel-width frame))))
	643	border)
	644	(frame-char-width frame)))
	645	(/ (- (or pixel-height
	646	(x-display-pixel-height frame))
	647	border)
	648	(frame-char-height frame))))
	649	(mpos (with-selected-window window (mouse-pixel-position)))
	650	(mframe (car mpos))
	651	default-frame-alist)
	652	(if (or relative
	653	(and use-dxdy
	654	(null (cadr mpos))))
	655	(unless (and (cadr mpos)
	656	(eq mframe frame))
	657	(let* ((edges (window-inside-pixel-edges (cadr (window-list frame))))
	658	(mx (ash (+ (pop edges) (cadr edges)) -1))
	659	(my (ash (+ (pop edges) (cadr edges)) -1)))
	660	(setq mframe frame)
	661	(set-mouse-pixel-position mframe mx my)
	662	(sit-for 0.0001)))
	663	(when (and (cadr mpos)
	664	(not (eq mframe frame)))
	665	(let ((rel-coord (pos-tip-frame-relative-position frame mframe w32-frame
	666	frame-coordinates)))
	667	(setq rx (+ rx (car rel-coord))
	668	ry (+ ry (cdr rel-coord))))))
	669	(and pixel-width pixel-height
	670	(setq mpos (pos-tip-avoid-mouse rx (+ rx pixel-width
	671	(if w32-frame 3 0))
	672	ry (+ ry pixel-height)
	673	mframe)))
	674	(x-show-tip string mframe
	675	`((border-width . ,pos-tip-border-width)
	676	(internal-border-width . ,pos-tip-internal-border-width)
	677	,@(and (not use-dxdy) `((left . ,ax)
	678	(top . ,ay)))
	679	(font . ,(frame-parameter frame 'font))
	680	,@(and spacing `((line-spacing . ,spacing)))
	681	,@(and (stringp fg) `((foreground-color . ,fg)))
	682	,@(and (stringp bg) `((background-color . ,bg))))
	683	(and timeout (> timeout 0) timeout)
	684	(and use-dxdy (- rx (cadr mpos)))
	685	(and use-dxdy (- ry (cddr mpos))))
	686	(if (and timeout (<= timeout 0))
	687	(pos-tip-cancel-timer))
	688	retval))
	689
	690	(defun pos-tip-split-string (string &optional width margin justify squeeze max-rows)
	691	"Split STRING into fixed width strings. Return a list of these strings.
	692
	693	WIDTH specifies the width of filling each paragraph. WIDTH nil means use
	694	the width of currently selected frame. Note that this function doesn't add any
	695	padding characters at the end of each row.
	696
	697	MARGIN, if non-nil, specifies left margin width which is the number of spece
	698	characters to add at the beginning of each row.
	699
	700	The optional fourth argument JUSTIFY specifies which kind of justification
	701	to do: `full', `left', `right', `center', or `none'. A value of t means handle
	702	each paragraph as specified by its text properties. Omitting JUSTIFY means
	703	don't perform justification, word wrap and kinsoku shori (禁則処理).
	704
	705	SQUEEZE nil means leave whitespaces other than line breaks untouched.
	706
	707	MAX-ROWS, if given, specifies maximum number of elements of return value.
	708	The elements exceeding this number are discarded."
	709	(with-temp-buffer
	710	(let* ((tab-width (or pos-tip-tab-width tab-width))
	711	(fill-column (or width (frame-width)))
	712	(left-margin (or margin 0))
	713	(kinsoku-limit 1)
	714	indent-tabs-mode
	715	row rows)
	716	(insert string)
	717	(untabify (point-min) (point-max))
	718	(if justify
	719	(fill-region (point-min) (point-max) justify (not squeeze))
	720	(setq margin (make-string left-margin ?\s)))
	721	(goto-char (point-min))
	722	(while (prog2
	723	(let ((line (buffer-substring
	724	(point) (progn (end-of-line) (point)))))
	725	(if justify
	726	(push line rows)
	727	(while (progn
	728	(setq line (concat margin line)
	729	row (truncate-string-to-width line fill-column))
	730	(push row rows)
	731	(if (not (= (length row) (length line)))
	732	(setq line (substring line (length row))))))))
	733	(< (point) (point-max))
	734	(beginning-of-line 2)))
	735	(nreverse (if max-rows
	736	(last rows max-rows)
	737	rows)))))
	738
	739	(defun pos-tip-fill-string (string &optional width margin justify squeeze max-rows)
	740	"Fill each of the paragraphs in STRING.
	741
	742	WIDTH specifies the width of filling each paragraph. WIDTH nil means use
	743	the width of currently selected frame. Note that this function doesn't add any
	744	padding characters at the end of each row.
	745
	746	MARGIN, if non-nil, specifies left margin width which is the number of spece
	747	characters to add at the beginning of each row.
	748
	749	The optional fourth argument JUSTIFY specifies which kind of justification
	750	to do: `full', `left', `right', `center', or `none'. A value of t means handle
	751	each paragraph as specified by its text properties. Omitting JUSTIFY means
	752	don't perform justification, word wrap and kinsoku shori (禁則処理).
	753
	754	SQUEEZE nil means leave whitespaces other than line breaks untouched.
	755
	756	MAX-ROWS, if given, specifies maximum number of rows. The rows exceeding
	757	this number are discarded."
	758	(if justify
	759	(with-temp-buffer
	760	(let* ((tab-width (or pos-tip-tab-width tab-width))
	761	(fill-column (or width (frame-width)))
	762	(left-margin (or margin 0))
	763	(kinsoku-limit 1)
	764	indent-tabs-mode)
	765	(insert string)
	766	(untabify (point-min) (point-max))
	767	(fill-region (point-min) (point-max) justify (not squeeze))
	768	(if max-rows
	769	(buffer-substring (goto-char (point-min))
	770	(line-end-position max-rows))
	771	(buffer-string))))
	772	(mapconcat 'identity
	773	(pos-tip-split-string string width margin nil nil max-rows)
	774	"\n")))
	775
	776	(defun pos-tip-truncate-string (string width height)
	777	"Truncate each line of STRING to WIDTH and discard lines exceeding HEIGHT."
	778	(with-temp-buffer
	779	(insert string)
	780	(goto-char (point-min))
	781	(let ((nrow 0)
	782	rows)
	783	(while (and (< nrow height)
	784	(prog2
	785	(push (truncate-string-to-width
	786	(buffer-substring (point) (progn (end-of-line) (point)))
	787	width)
	788	rows)
	789	(< (point) (point-max))
	790	(beginning-of-line 2)
	791	(setq nrow (1+ nrow)))))
	792	(mapconcat 'identity (nreverse rows) "\n"))))
	793
	794	(defun pos-tip-string-width-height (string)
	795	"Count columns and rows of STRING. Return a cons cell like (WIDTH . HEIGHT).
	796	The last empty line of STRING is ignored.
	797
	798	Example:
	799
	800	\(pos-tip-string-width-height \"abc\\nあいう\\n123\")
	801	;; => (6 . 3)"
	802	(with-temp-buffer
	803	(insert string)
	804	(goto-char (point-min))
	805	(end-of-line)
	806	(let ((width (current-column))
	807	(height (if (eq (char-before (point-max)) ?\n) 0 1)))
	808	(while (< (point) (point-max))
	809	(end-of-line 2)
	810	(setq width (max (current-column) width)
	811	height (1+ height)))
	812	(cons width height))))
	813
	814	(defun pos-tip-x-display-width (&optional frame)
	815	"Return maximum column number in tooltip which occupies the full width
	816	of display. Omitting FRAME means use display that selected frame is in."
	817	(1+ (/ (x-display-pixel-width frame) (frame-char-width frame))))
	818
	819	(defun pos-tip-x-display-height (&optional frame)
	820	"Return maximum row number in tooltip which occupies the full height
	821	of display. Omitting FRAME means use display that selected frame is in."
	822	(1+ (/ (x-display-pixel-height frame) (frame-char-height frame))))
	823
	824	(defun pos-tip-tooltip-width (width char-width)
	825	"Calculate tooltip pixel width."
	826	(+ (* width char-width)
	827	(ash (+ pos-tip-border-width
	828	pos-tip-internal-border-width)
	829	1)))
	830
	831	(defun pos-tip-tooltip-height (height char-height &optional frame)
	832	"Calculate tooltip pixel height."
	833	(let ((spacing (or (default-value 'line-spacing)
	834	(frame-parameter frame 'line-spacing))))
	835	(+ (* height (+ char-height
	836	(cond
	837	((integerp spacing)
	838	spacing)
	839	((floatp spacing)
	840	(truncate (* (frame-char-height frame)
	841	spacing)))
	842	(t 0))))
	843	(ash (+ pos-tip-border-width
	844	pos-tip-internal-border-width)
	845	1))))
	846
	847	(defun pos-tip-show
	848	(string &optional tip-color pos window timeout width frame-coordinates dx dy)
	849	"Show STRING in a tooltip, which is a small X window, at POS in WINDOW
	850	using frame's default font with TIP-COLOR.
	851
	852	Return pixel position of tooltip relative to top left corner of frame as
	853	a cons cell like (X . Y).
	854
	855	TIP-COLOR is a face or a cons cell like (FOREGROUND-COLOR . BACKGROUND-COLOR)
	856	used to specify only foreground-color and background-color of tooltip. If
	857	omitted, use `pos-tip-foreground-color' and `pos-tip-background-color' or the
	858	foreground and background color of the `tooltip' face instead.
	859
	860	Omitting POS and WINDOW means use current position and selected window,
	861	respectively.
	862
	863	Automatically hide the tooltip after TIMEOUT seconds. Omitting TIMEOUT means
	864	use the default timeout of 5 seconds. Non-positive TIMEOUT means don't hide
	865	tooltip automatically.
	866
	867	WIDTH, if non-nil, specifies the width of filling each paragraph.
	868
	869	If FRAME-COORDINATES is omitted or nil, automatically obtain the absolute
	870	coordinates of the top left corner of frame which WINDOW is on. Here,
	871	`top left corner of frame' represents the origin of `window-pixel-edges'
	872	and its coordinates are essential for calculating the absolute coordinates
	873	of the tooltip. If a cons cell like (LEFT . TOP), specifies the frame
	874	absolute location and makes the calculation slightly faster, but can be
	875	used only when it's clear that frame is in the specified position. Users
	876	can get the latest values of frame coordinates for using in the next call
	877	by referring the variable `pos-tip-saved-frame-coordinates' just after
	878	calling this function. Otherwise, FRAME-COORDINATES `relative' means use
	879	the pixel coordinates relative to the top left corner of the frame for
	880	displaying the tooltip. This is the same effect as
	881	`pos-tip-use-relative-coordinates' is non-nil.
	882
	883	DX specifies horizontal offset in pixel.
	884
	885	DY specifies vertical offset in pixel. This makes the calculations done
	886	without considering the height of object at POS, so the object might be
	887	hidden by the tooltip.
	888
	889	See also `pos-tip-show-no-propertize'."
	890	(unless window
	891	(setq window (selected-window)))
	892	(let* ((frame (window-frame window))
	893	(max-width (pos-tip-x-display-width frame))
	894	(max-height (pos-tip-x-display-height frame))
	895	(w-h (pos-tip-string-width-height string))
	896	(fg (pos-tip-compute-foreground-color tip-color))
	897	(bg (pos-tip-compute-background-color tip-color))
	898	(frame-font (find-font (font-spec :name (frame-parameter frame 'font))))
	899	(tip-face-attrs (list :font frame-font :foreground fg :background bg)))
	900	(cond
	901	((and width
	902	(> (car w-h) width))
	903	(setq string (pos-tip-fill-string string width nil 'none nil max-height)
	904	w-h (pos-tip-string-width-height string)))
	905	((or (> (car w-h) max-width)
	906	(> (cdr w-h) max-height))
	907	(setq string (pos-tip-truncate-string string max-width max-height)
	908	w-h (pos-tip-string-width-height string))))
	909	(pos-tip-show-no-propertize
	910	(propertize string 'face tip-face-attrs)
	911	tip-color pos window timeout
	912	(pos-tip-tooltip-width (car w-h) (frame-char-width frame))
	913	(pos-tip-tooltip-height (cdr w-h) (frame-char-height frame) frame)
	914	frame-coordinates dx dy)))
	915
	916	(defalias 'pos-tip-hide 'x-hide-tip
	917	"Hide pos-tip's tooltip.")
	918
	919	(defun pos-tip-calibrate-frame-offset (&optional frame)
	920	"Return coordinates of FRAME orign relative to the top left corner of
	921	the FRAME extent, like (LEFT . TOP). The return value is recorded to
	922	`pos-tip-frame-offset'.
	923
	924	Note that this function does't correctly work for X frame and Emacs 22."
	925	(setq pos-tip-frame-offset nil)
	926	(let* ((window (frame-first-window frame))
	927	(delete-frame-functions
	928	'((lambda (frame)
	929	(if (equal (frame-parameter frame 'name) "tooltip")
	930	(setq pos-tip-frame-offset
	931	(cons (eval (frame-parameter frame 'left))
	932	(eval (frame-parameter frame 'top))))))))
	933	(pos-tip-border-width 0)
	934	(pos-tip-internal-border-width 1)
	935	(rpos (pos-tip-show ""
	936	`(nil . ,(frame-parameter frame 'background-color))
	937	(window-start window) window
	938	nil nil 'relative nil 0)))
	939	(sit-for 0)
	940	(pos-tip-hide)
	941	(and pos-tip-frame-offset
	942	(setq pos-tip-frame-offset
	943	(cons (- (car pos-tip-frame-offset)
	944	(car rpos)
	945	(eval (frame-parameter frame 'left)))
	946	(- (cdr pos-tip-frame-offset)
	947	(cdr rpos)
	948	(eval (frame-parameter frame 'top))))))))
	949
	950	(defun pos-tip-w32-max-width-height (&optional keep-maximize)
	951	"Maximize the currently selected frame temporarily and set
	952	`pos-tip-w32-saved-max-width-height' the effective display size in order
	953	to become possible to calculate the absolute location of tooltip.
	954
	955	KEEP-MAXIMIZE non-nil means leave the frame maximized.
	956
	957	Note that this function is usable only in Emacs 23 for MS-Windows."
	958	(interactive)
	959	(unless (eq window-system 'w32)
	960	(error "`pos-tip-w32-max-width-height' can be used only in w32 frame."))
	961	;; Maximize frame
	962	(with-no-warnings (w32-send-sys-command 61488))
	963	(sit-for 0)
	964	(let ((offset (pos-tip-calibrate-frame-offset)))
	965	(prog1
	966	(setq pos-tip-w32-saved-max-width-height
	967	(cons (frame-pixel-width)
	968	(+ (frame-pixel-height)
	969	(- (cdr offset) (car offset)))))
	970	(if (called-interactively-p 'interactive)
	971	(message "%S" pos-tip-w32-saved-max-width-height))
	972	(unless keep-maximize
	973	;; Restore frame
	974	(with-no-warnings (w32-send-sys-command 61728))))))
	975
	976
	977	(provide 'pos-tip)
	978
	979	;;;
	980	;;; pos-tip.el ends here