Mercurial > hg > xemacs-beta

comparison lisp/wid-edit.el @ 276:6330739388db r21-0b36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b36
author cvs
date Mon, 13 Aug 2007 10:30:37 +0200
parents 966663fcf606
children 90d73dddcdc4
comparison
equal deleted inserted replaced
275:a68ae4439f57 276:6330739388db
292 Using before hooks also means that the :notify function can't know the 292 Using before hooks also means that the :notify function can't know the
293 new value." 293 new value."
294 :type 'boolean 294 :type 'boolean
295 :group 'widgets) 295 :group 'widgets)
296 296
297 (defun widget-echo-this-extent (extent)
298 (let* ((widget (or (extent-property extent 'button)
299 (extent-property extent 'field)
300 (extent-property extent 'glyph-widget)))
301 (help-echo (and widget (widget-get widget :help-echo))))
302 (and (functionp help-echo)
303 (setq help-echo (funcall help-echo widget)))
304 (when (stringp help-echo)
305 (display-message 'help-echo help-echo))))
306
307 (defsubst widget-handle-help-echo (extent help-echo)
308 (set-extent-property extent 'balloon-help help-echo)
309 (set-extent-property extent 'help-echo help-echo)
310 (when (functionp help-echo)
311 (set-extent-property extent 'balloon-help 'widget-echo-this-extent)
312 (set-extent-property extent 'help-echo 'widget-echo-this-extent)))
313
297 (defun widget-specify-field (widget from to) 314 (defun widget-specify-field (widget from to)
298 "Specify editable button for WIDGET between FROM and TO." 315 "Specify editable button for WIDGET between FROM and TO."
299 (save-excursion 316 (save-excursion
300 (goto-char to) 317 (goto-char to)
301 (cond ((null (widget-get widget :size)) 318 (cond ((null (widget-get widget :size))
319 (set-extent-property extent 'detachable nil) 336 (set-extent-property extent 'detachable nil)
320 (set-extent-property extent 'field widget) 337 (set-extent-property extent 'field widget)
321 (set-extent-property extent 'button-or-field t) 338 (set-extent-property extent 'button-or-field t)
322 (set-extent-property extent 'keymap map) 339 (set-extent-property extent 'keymap map)
323 (set-extent-property extent 'face face) 340 (set-extent-property extent 'face face)
324 (set-extent-property extent 'balloon-help help-echo) 341 (widget-handle-help-echo extent help-echo)))
325 (set-extent-property extent 'help-echo help-echo)))
326 342
327 (defun widget-specify-button (widget from to) 343 (defun widget-specify-button (widget from to)
328 "Specify button for WIDGET between FROM and TO." 344 "Specify button for WIDGET between FROM and TO."
329 (let ((face (widget-apply widget :button-face-get)) 345 (let ((face (widget-apply widget :button-face-get))
330 (help-echo (widget-get widget :help-echo)) 346 (help-echo (widget-get widget :help-echo))
335 (setq help-echo 'widget-mouse-help)) 351 (setq help-echo 'widget-mouse-help))
336 (set-extent-property extent 'start-open t) 352 (set-extent-property extent 'start-open t)
337 (set-extent-property extent 'button widget) 353 (set-extent-property extent 'button widget)
338 (set-extent-property extent 'button-or-field t) 354 (set-extent-property extent 'button-or-field t)
339 (set-extent-property extent 'mouse-face widget-mouse-face) 355 (set-extent-property extent 'mouse-face widget-mouse-face)
340 (set-extent-property extent 'balloon-help help-echo) 356 (widget-handle-help-echo extent help-echo)
341 (set-extent-property extent 'help-echo help-echo)
342 (set-extent-property extent 'face face) 357 (set-extent-property extent 'face face)
343 (set-extent-property extent 'keymap map))) 358 (set-extent-property extent 'keymap map)))
344 359
345 (defun widget-mouse-help (extent) 360 (defun widget-mouse-help (extent)
346 "Find mouse help string for button in extent." 361 "Find mouse help string for button in extent."
410 ;; inactive-count reaches 0, the button/field/glyph is reactivated. 425 ;; inactive-count reaches 0, the button/field/glyph is reactivated.
411 426
412 (defun widget-activation-widget-mapper (extent action) 427 (defun widget-activation-widget-mapper (extent action)
413 "Activate or deactivate EXTENT's widget (button or field). 428 "Activate or deactivate EXTENT's widget (button or field).
414 Suitable for use with `map-extents'." 429 Suitable for use with `map-extents'."
430 (message "FUCK")
415 (ecase action 431 (ecase action
416 (:activate 432 (:activate
417 (decf (extent-property extent :inactive-count)) 433 (decf (extent-property extent :inactive-count))
418 (when (zerop (extent-property extent :inactive-count)) 434 (when (zerop (extent-property extent :inactive-count))
419 (set-extent-properties 435 (set-extent-properties
432 (set-extent-properties 448 (set-extent-properties
433 extent '(mouse-face nil help-echo nil keymap nil))))) 449 extent '(mouse-face nil help-echo nil keymap nil)))))
434 nil) 450 nil)
435 451
436 (defun widget-activation-glyph-mapper (extent action) 452 (defun widget-activation-glyph-mapper (extent action)
453 (message "FUCK")
437 (let ((activate-p (if (eq action :activate) t nil))) 454 (let ((activate-p (if (eq action :activate) t nil)))
438 (if activate-p 455 (if activate-p
439 (decf (extent-property extent :inactive-count)) 456 (decf (extent-property extent :inactive-count))
440 (incf (extent-property extent :inactive-count 0))) 457 (incf (extent-property extent :inactive-count 0)))
441 (when (or (and activate-p 458 (when (or (and activate-p
476 nil from to :deactivate nil 'glyph-widget))) 493 nil from to :deactivate nil 'glyph-widget)))
477 494
478 (defun widget-specify-active (widget) 495 (defun widget-specify-active (widget)
479 "Make WIDGET active for user modifications." 496 "Make WIDGET active for user modifications."
480 (let ((inactive (widget-get widget :inactive))) 497 (let ((inactive (widget-get widget :inactive)))
481 (when inactive 498 (when (and inactive (not (extent-detached-p inactive)))
482 ;; Reactivate the buttons and fields covered by the extent. 499 ;; Reactivate the buttons and fields covered by the extent.
483 (map-extents 'widget-activation-widget-mapper 500 (map-extents 'widget-activation-widget-mapper
484 inactive nil nil :activate nil 'button-or-field) 501 inactive nil nil :activate nil 'button-or-field)
485 ;; Reactivate the glyphs. 502 ;; Reactivate the glyphs.
486 (map-extents 'widget-activation-glyph-mapper 503 (map-extents 'widget-activation-glyph-mapper
762 ;;(set-extent-property extent 'pointer widget-glyph-pointer-glyph) 779 ;;(set-extent-property extent 'pointer widget-glyph-pointer-glyph)
763 (set-extent-end-glyph extent glyph) 780 (set-extent-end-glyph extent glyph)
764 (unless (or (stringp help-echo) (null help-echo)) 781 (unless (or (stringp help-echo) (null help-echo))
765 (setq help-echo 'widget-mouse-help)) 782 (setq help-echo 'widget-mouse-help))
766 (when help-echo 783 (when help-echo
767 (set-extent-property extent 'balloon-help help-echo) 784 (widget-handle-help-echo extent help-echo)))
768 (set-extent-property extent 'help-echo help-echo)))
769 (when widget 785 (when widget
770 (widget-put widget :glyph-up glyph) 786 (widget-put widget :glyph-up glyph)
771 (when down (widget-put widget :glyph-down down)) 787 (when down (widget-put widget :glyph-down down))
772 (when inactive (widget-put widget :glyph-inactive inactive)))) 788 (when inactive (widget-put widget :glyph-inactive inactive))))
773 789