Mercurial > hg > xemacs-beta
diff lisp/packages/balloon-help.el @ 26:441bb1e64a06 r19-15b96
Import from CVS: tag r19-15b96
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:51:32 +0200 |
parents | 8fc7fe29b841 |
children | c53a95d3c46d |
line wrap: on
line diff
--- a/lisp/packages/balloon-help.el Mon Aug 13 08:51:05 2007 +0200 +++ b/lisp/packages/balloon-help.el Mon Aug 13 08:51:32 2007 +0200 @@ -57,7 +57,7 @@ (provide 'balloon-help) -(defvar balloon-help-version "1.03" +(defvar balloon-help-version "1.04" "Version string for Balloon Help.") (defvar balloon-help-mode t @@ -81,6 +81,9 @@ (defvar balloon-help-border-color "black" "*The color for displaying balloon help frame's border.") +(defvar balloon-help-border-width 2 + "*The width of the balloon help frame's border.") + (defvar balloon-help-use-sound nil "*Non-nil value means play a sound to herald the appearance and disappearance of the help frame. @@ -206,14 +209,20 @@ (top (cdr (assq 'top params))) (left (cdr (assq 'left params))) (xtop-toolbar-height - (if (specifier-instance top-toolbar) - (specifier-instance top-toolbar-height) + (if (and (specifier-instance top-toolbar-visible-p frame) + (specifier-instance top-toolbar frame)) + (specifier-instance top-toolbar-height frame) 0)) (xleft-toolbar-width - (if (specifier-instance left-toolbar) - (specifier-instance left-toolbar-width) + (if (and (specifier-instance left-toolbar-visible-p frame) + (specifier-instance left-toolbar frame)) + (specifier-instance left-toolbar-width frame) 0)) - (menubar-height (if current-menubar 22 0))) + (menubar-height + (if (and buffer + (specifier-instance menubar-visible-p) + (save-excursion (set-buffer buffer) current-menubar)) + 22 0))) (setq balloon-help-help-object-x (+ left xleft-toolbar-width (event-x-pixel event)) balloon-help-help-object-y @@ -335,6 +344,11 @@ (and (not done) (setq lines (1+ lines)))) (set-frame-size balloon-help-frame (+ 1 longest) lines)))) +(defun balloon-help-make-junk-frame () + (let ((window-min-height 1) + (window-min-width 1)) + (make-frame '(minibuffer t initially-unmapped t width 1 height 1)))) + (defun balloon-help-make-help-frame () (save-excursion (setq balloon-help-bar-cursor bar-cursor) @@ -349,11 +363,11 @@ ;; try to evade frame decorations (cons 'name (or balloon-help-frame-name "xclock")) - '(border-width . 2) + (cons 'border-width balloon-help-border-width) (cons 'border-color balloon-help-border-color) (cons 'top y) (cons 'left x) - (cons 'popup (selected-frame)) + (cons 'popup (balloon-help-make-junk-frame)) '(width . 3) '(height . 1))))) (set-face-font 'default balloon-help-font frame) @@ -373,6 +387,9 @@ (set-specifier bottom-toolbar (cons frame nil)) (set-specifier scrollbar-width (cons frame 0)) (set-specifier scrollbar-height (cons frame 0)) + (and (boundp 'text-cursor-visible-p) + (specifierp text-cursor-visible-p) + (set-specifier text-cursor-visible-p (cons frame nil))) (set-specifier modeline-shadow-thickness (cons frame 0)) (set-face-background 'modeline balloon-help-background frame) frame ))) @@ -392,4 +409,5 @@ (add-hook 'pre-command-hook 'balloon-help-pre-command-hook) (add-hook 'post-command-hook 'balloon-help-post-command-hook) (add-hook 'mouse-leave-frame-hook 'balloon-help-mouse-leave-frame-hook) -(add-hook 'deselect-frame-hook 'balloon-help-deselect-frame-hook) +;; loses with ClickToFocus under fvwm +;;(add-hook 'deselect-frame-hook 'balloon-help-deselect-frame-hook)