Mercurial > hg > xemacs-beta

comparison lisp/packages/balloon-help.el @ 36:c53a95d3c46d r19-15b101

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b101
author cvs
date Mon, 13 Aug 2007 08:53:38 +0200
parents 441bb1e64a06
children 131b0175ea99
comparison
equal deleted inserted replaced
35:279432d5c479 36:c53a95d3c46d
55 ;; managers. So the window manager directives should not be 55 ;; managers. So the window manager directives should not be
56 ;; needed for XEmacs 19.13 and beyond. 56 ;; needed for XEmacs 19.13 and beyond.
57 57
58 (provide 'balloon-help) 58 (provide 'balloon-help)
59 59
60 (defvar balloon-help-version "1.04" 60 (defvar balloon-help-version "1.05"
61 "Version string for Balloon Help.") 61 "Version string for Balloon Help.")
62 62
63 (defvar balloon-help-mode t 63 (defvar balloon-help-mode t
64 "*Non-nil means Balloon help mode is enabled.") 64 "*Non-nil means Balloon help mode is enabled.")
65 65
135 135
136 (defvar balloon-help-display-pending nil 136 (defvar balloon-help-display-pending nil
137 "Non-nil value means the help frame will be visible as soon 137 "Non-nil value means the help frame will be visible as soon
138 as the X server gets around to displaying it. Nil means it 138 as the X server gets around to displaying it. Nil means it
139 will be invisible as soon as the X server decides to hide it.") 139 will be invisible as soon as the X server decides to hide it.")
140
141 (defvar balloon-help-bar-cursor nil)
142 140
143 (defun balloon-help-mode (&optional arg) 141 (defun balloon-help-mode (&optional arg)
144 "Toggle Balloon Help mode. 142 "Toggle Balloon Help mode.
145 With arg, turn Balloon Help mode on iff arg is positive. 143 With arg, turn Balloon Help mode on iff arg is positive.
146 144
181 (balloon-help-undisplay-help))) 179 (balloon-help-undisplay-help)))
182 (t 180 (t
183 (let* ((buffer (event-buffer event)) 181 (let* ((buffer (event-buffer event))
184 (frame (event-frame event)) 182 (frame (event-frame event))
185 (point (and buffer (event-point event))) 183 (point (and buffer (event-point event)))
184 (modeline-point (and buffer (event-modeline-position event)))
185 (modeline-extent (and modeline-point
186 (map-extents
187 (function (lambda (e ignored) e))
188 (symbol-value-in-buffer
189 'generated-modeline-string
190 buffer)
191 modeline-point modeline-point
192 nil nil
193 'balloon-help)))
186 (glyph-extent (event-glyph-extent event)) 194 (glyph-extent (event-glyph-extent event))
187 (glyph-extent (if (and glyph-extent 195 (glyph-extent (if (and glyph-extent
188 (extent-property glyph-extent 196 (extent-property glyph-extent
189 'balloon-help)) 197 'balloon-help))
190 glyph-extent)) 198 glyph-extent))
192 (extent-at point buffer 'balloon-help))) 200 (extent-at point buffer 'balloon-help)))
193 (button (event-toolbar-button event)) 201 (button (event-toolbar-button event))
194 (button (if (and button (toolbar-button-help-string button)) 202 (button (if (and button (toolbar-button-help-string button))
195 button 203 button
196 nil)) 204 nil))
197 (object (or glyph-extent extent button)) 205 (object (or modeline-extent glyph-extent extent button))
198 (id balloon-help-timeout-id)) 206 (id balloon-help-timeout-id))
199 (if (null object) 207 (if (null object)
200 (if (and balloon-help-frame 208 (if (and balloon-help-frame
201 (not (eq frame balloon-help-frame))) 209 (not (eq frame balloon-help-frame)))
202 (progn 210 (progn
276 (if (not (bufferp balloon-help-buffer)) 284 (if (not (bufferp balloon-help-buffer))
277 (setq balloon-help-buffer 285 (setq balloon-help-buffer
278 (get-buffer-create " *balloon-help*"))) 286 (get-buffer-create " *balloon-help*")))
279 (if (not (frame-live-p balloon-help-frame)) 287 (if (not (frame-live-p balloon-help-frame))
280 (setq balloon-help-frame (balloon-help-make-help-frame))) 288 (setq balloon-help-frame (balloon-help-make-help-frame)))
281 (setq bar-cursor t)
282 (set-buffer balloon-help-buffer) 289 (set-buffer balloon-help-buffer)
283 (erase-buffer) 290 (erase-buffer)
284 (insert help) 291 (insert help)
285 (if (not (bolp)) 292 (if (not (bolp))
286 (insert ?\n)) 293 (insert ?\n))
307 (balloon-help-move-help-frame) 314 (balloon-help-move-help-frame)
308 (balloon-help-resize-help-frame) 315 (balloon-help-resize-help-frame)
309 (balloon-help-expose-help-frame)))))) 316 (balloon-help-expose-help-frame))))))
310 317
311 (defun balloon-help-undisplay-help () 318 (defun balloon-help-undisplay-help ()
312 (setq bar-cursor balloon-help-bar-cursor)
313 (balloon-help-hide-help-frame)) 319 (balloon-help-hide-help-frame))
314 320
315 (defun balloon-help-hide-help-frame () 321 (defun balloon-help-hide-help-frame ()
316 (if (balloon-help-displayed) 322 (if (balloon-help-displayed)
317 (progn 323 (progn
345 (set-frame-size balloon-help-frame (+ 1 longest) lines)))) 351 (set-frame-size balloon-help-frame (+ 1 longest) lines))))
346 352
347 (defun balloon-help-make-junk-frame () 353 (defun balloon-help-make-junk-frame ()
348 (let ((window-min-height 1) 354 (let ((window-min-height 1)
349 (window-min-width 1)) 355 (window-min-width 1))
350 (make-frame '(minibuffer t initially-unmapped t width 1 height 1)))) 356 (save-excursion
357 (set-buffer (generate-new-buffer "*junk-frame-buffer*"))
358 (prog1
359 (make-frame '(minibuffer t initially-unmapped t width 1 height 1))
360 (rename-buffer " *junk-frame-buffer*" t)))))
351 361
352 (defun balloon-help-make-help-frame () 362 (defun balloon-help-make-help-frame ()
353 (save-excursion 363 (save-excursion
354 (setq balloon-help-bar-cursor bar-cursor)
355 (set-buffer balloon-help-buffer) 364 (set-buffer balloon-help-buffer)
356 (set-buffer-menubar nil) 365 (set-buffer-menubar nil)
357 (let* ((x (balloon-help-compute-help-frame-x-location)) 366 (let* ((x (balloon-help-compute-help-frame-x-location))
358 (y (balloon-help-compute-help-frame-y-location)) 367 (y (balloon-help-compute-help-frame-y-location))
359 (window-min-height 1) 368 (window-min-height 1)