X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fwid-edit.el;h=aaa80ca74efe1f2ec0751d0c215122e57c86b8a0;hb=cc1e3c3c27a6f62ba789819c871b2d8101835286;hp=450754250f3f26a8665b9cca738d3016ada5e3b7;hpb=716cfba952c1dc0d2cf5c968971f3780ba728a89;p=chise%2Fxemacs-chise.git.1 diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 4507542..aaa80ca 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -480,14 +480,22 @@ Suitable for use with `map-extents'." (let* ((glyph-widget (extent-property extent 'glyph-widget)) (up-glyph (widget-get glyph-widget :glyph-up)) (inactive-glyph (widget-get glyph-widget :glyph-inactive)) + (instantiator (widget-get glyph-widget :glyph-instantiator)) (new-glyph (if activate-p up-glyph inactive-glyph))) + (cond + ;; Assume that an instantiator means a native widget. + (instantiator + (setq instantiator + (set-instantiator-property instantiator :active activate-p)) + (widget-put glyph-widget :glyph-instantiator instantiator) + (set-glyph-image up-glyph instantiator)) ;; Check that the new glyph exists, and differs from the ;; default one. - (and up-glyph inactive-glyph (not (eq up-glyph inactive-glyph)) - ;; Check if the glyph is already installed. - (not (eq (extent-end-glyph extent) new-glyph)) - ;; Change it. - (set-extent-end-glyph extent new-glyph))))) + ((and up-glyph inactive-glyph (not (eq up-glyph inactive-glyph)) + ;; Check if the glyph is already installed. + (not (eq (extent-end-glyph extent) new-glyph))) + ;; Change it. + (set-extent-end-glyph extent new-glyph)))))) nil) (defun widget-specify-inactive (widget from to) @@ -512,14 +520,16 @@ Suitable for use with `map-extents'." (defun widget-specify-active (widget) "Make WIDGET active for user modifications." - (let ((inactive (widget-get widget :inactive))) + (let ((inactive (widget-get widget :inactive)) + (from (widget-get widget :from)) + (to (widget-get widget :to))) (when (and inactive (not (extent-detached-p inactive))) ;; Reactivate the buttons and fields covered by the extent. (map-extents 'widget-activation-widget-mapper - inactive nil nil :activate nil 'button-or-field) + nil from to :activate nil 'button-or-field) ;; Reactivate the glyphs. (map-extents 'widget-activation-glyph-mapper - inactive nil nil :activate nil 'end-glyph) + nil from to :activate nil 'end-glyph) (delete-extent inactive) (widget-put widget :inactive nil)))) @@ -566,7 +576,7 @@ Otherwise, just return the value." value))) (defun widget-member (widget property) - "Non-nil iff there is a definition in WIDGET for PROPERTY." + "Return t if there is a definition in WIDGET for PROPERTY." (cond ((widget-plist-member (cdr widget) property) t) ((car widget) @@ -783,10 +793,12 @@ only because of compatibility." (insert tag)) glyph)) -(defun widget-glyph-insert-glyph (widget glyph &optional down inactive) +(defun widget-glyph-insert-glyph (widget glyph &optional down inactive + instantiator) "In WIDGET, insert GLYPH. If optional arguments DOWN and INACTIVE are given, they should be -glyphs used when the widget is pushed and inactive, respectively." +glyphs used when the widget is pushed and inactive, respectively. +INSTANTIATOR is the vector used to create the glyph." (insert "*") (let ((extent (make-extent (point) (1- (point)))) (help-echo (and widget (widget-get widget :help-echo))) @@ -808,6 +820,7 @@ glyphs used when the widget is pushed and inactive, respectively." (when widget (widget-put widget :glyph-up glyph) (when down (widget-put widget :glyph-down down)) + (when instantiator (widget-put widget :glyph-instantiator instantiator)) (when inactive (widget-put widget :glyph-inactive inactive)))) @@ -1041,7 +1054,7 @@ Recommended as a parent keymap for modes using widgets.") (defun widget-field-activate (pos &optional event) - "Invoke the ediable field at point." + "Invoke the editable field at point." (interactive "@d") (let ((field (widget-field-find pos))) (if field @@ -1348,7 +1361,7 @@ With optional ARG, move across that many fields." (t (when (and (null arg) (= last-non-space (point))) - (forward-char -1)) + (backward-char 1)) (transpose-chars arg))))) (defcustom widget-complete-field (lookup-key global-map "\M-\t") @@ -1922,7 +1935,7 @@ If END is omitted, it defaults to the length of LIST." (tag-glyph (widget-get widget :tag-glyph)) (text (concat widget-push-button-prefix tag widget-push-button-suffix)) - gui) + gui inst) (cond (tag-glyph (widget-glyph-insert widget text tag-glyph)) ;; We must check for console-on-window-system-p here, @@ -1931,9 +1944,9 @@ If END is omitted, it defaults to the length of LIST." ((and widget-push-button-gui (console-on-window-system-p)) (let* ((gui-button-shadow-thickness 1)) - (setq gui (make-glyph - (make-gui-button tag 'widget-gui-action widget)))) - (widget-glyph-insert-glyph widget gui)) + (setq inst (make-gui-button tag 'widget-gui-action widget)) + (setq gui (make-glyph inst))) + (widget-glyph-insert-glyph widget gui nil nil inst)) (t (insert text))))) @@ -1986,8 +1999,8 @@ If END is omitted, it defaults to the length of LIST." (defun widget-url-link-action (widget &optional event) "Open the url specified by WIDGET." - (if (boundp 'browse-url-browser-function) - (funcall browse-url-browser-function (widget-value widget)) + (if (fboundp 'browse-url) + (browse-url (widget-value widget)) (error "Cannot follow URLs in this XEmacs"))) ;;; The `function-link' Widget.