mirror of https://github.com/Chizi123/.emacs.d.git

Chizi123
2018-11-21 e75a20334813452c6912c090d70a0de2c805f94d
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
;;; 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.1513
 
(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