X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Fwid-edit.el;h=dfcdbe4a2dccdf2cd75f25a423658156a68fdaec;hp=c01d4573e28254f2faa1a73a337d6e5e37338620;hb=82f6d62ee211b1d36e8f45fed3ee3edde82b6916;hpb=976b002b16336930724ae22476014583ad022e7d diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index c01d457..dfcdbe4 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1,9 +1,9 @@ ;;; wid-edit.el --- Functions for creating and using widgets. ;; -;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen -;; Maintainer: Hrvoje Niksic +;; Maintainer: Hrvoje Niksic ;; Keywords: extensions ;; Version: 1.9960-x ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ @@ -49,7 +49,7 @@ :group 'hypermedia) (defgroup widget-documentation nil - "Options controling the display of documentation strings." + "Options controlling the display of documentation strings." :group 'widgets) (defgroup widget-faces nil @@ -512,14 +512,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 +568,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) @@ -601,7 +603,7 @@ ARGS are passed as extra arguments to the function." ;; In WIDGET, match the start of VALS. (cond ((widget-get widget :inline) (widget-apply widget :match-inline vals)) - ((and vals + ((and (listp vals) (widget-apply widget :match (car vals))) (cons (list (car vals)) (cdr vals))) (t nil))) @@ -1348,7 +1350,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") @@ -1898,9 +1900,6 @@ If END is omitted, it defaults to the length of LIST." :group 'widgets :type 'boolean) -;; Cache already created GUI objects. -(defvar widget-push-button-cache nil) - (defcustom widget-push-button-prefix "[" "String used as prefix for buttons." :type 'string @@ -1925,7 +1924,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-glyphs (lax-plist-get widget-push-button-cache tag))) + gui) (cond (tag-glyph (widget-glyph-insert widget text tag-glyph)) ;; We must check for console-on-window-system-p here, @@ -1933,18 +1932,10 @@ If END is omitted, it defaults to the length of LIST." ;; components for colors, and they are not known on TTYs). ((and widget-push-button-gui (console-on-window-system-p)) - (unless gui-glyphs - (let* ((gui-button-shadow-thickness 1) - (gui (make-gui-button tag 'widget-gui-action widget))) - (setq - gui-glyphs - (list - (make-glyph `(,(nth 0 (aref gui 1)) [string :data ,text])) - (make-glyph `(,(nth 1 (aref gui 1)) [string :data ,text])) - (make-glyph `(,(nth 2 (aref gui 1)) [string :data ,text])))) - (laxputf widget-push-button-cache tag gui-glyphs))) - (widget-glyph-insert-glyph - widget (nth 0 gui-glyphs) (nth 1 gui-glyphs) (nth 2 gui-glyphs))) + (let* ((gui-button-shadow-thickness 1)) + (setq gui (make-glyph + (make-gui-button tag 'widget-gui-action widget)))) + (widget-glyph-insert-glyph widget gui)) (t (insert text))))) @@ -1997,8 +1988,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. @@ -2532,7 +2523,7 @@ when he invoked the menu." found)) (defun widget-checklist-match-up (args vals) - ;; Rerturn the first type from ARGS that matches VALS. + ;; Return the first type from ARGS that matches VALS. (let (current found) (while (and args (null found)) (setq current (car args) @@ -2554,7 +2545,7 @@ when he invoked the menu." result)) (defun widget-checklist-validate (widget) - ;; Ticked chilren must be valid. + ;; Ticked children must be valid. (let ((children (widget-get widget :children)) child button found) (while (and children (not found))