comparison lisp/wid-edit.el @ 18364:01666331d10f

Synched with 1.9930.

18363:31e4a16368c9

;;
;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <[e-mail]>
;; Keywords: extensions
;; Version: 1.9924
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify

	    ((setq tmp (car widget))
	     (setq widget (get tmp 'widget-type)))
	    (t 
	     (setq missing nil))))
    value))

(defun widget-member (widget property)
  "Non-nil iff there is a definition in WIDGET for PROPERTY."
  (cond ((widget-plist-member (cdr widget) property)
	 t)

(defcustom widget-button-suffix ""
  "String used as suffix for buttons."
  :type 'string
  :group 'widget-button)

(defun widget-button-insert-indirect (widget key)
  "Insert value of WIDGET's KEY property."
  (let ((val (widget-get widget key)))
    (while (and val (symbolp val))
      (setq val (symbol-value val)))
    (when val 
      (insert val))))

;;; Creating Widgets.

;;;###autoload
(defun widget-create (type &rest args)

	  (when found
	    (debug "Overlapping fields"))
	  (setq found field))))
    found))

;; This is how, for example, a variable changes its state to "set"
;; when it is being edited.
(defun widget-before-change (from &rest ignore)
  (condition-case nil
      (let ((field (widget-field-find from)))
	(widget-apply field :notify field))
    (error (debug "After Change"))))

(defun widget-after-change (from to old)
  ;; Adjust field size and text properties.
  (condition-case nil
      (let ((field (widget-field-find from))

		(while (< begin end)
		  (let ((old (char-after begin)))
		    (unless (eq old secret)
		      (subst-char-in-region begin (1+ begin) old secret)
		      (put-text-property begin (1+ begin) 'secret old))
		    (setq begin (1+ begin)))))))))
    (error (debug "After Change"))))

;;; Widget Functions
;;
;; These functions are used in the definition of multiple widgets. 

	 (replace-match "" t t)
	 (cond ((eq escape ?%)
		(insert "%"))
	       ((eq escape ?\[)
		(setq button-begin (point))
		(widget-button-insert-indirect widget :button-prefix))
	       ((eq escape ?\])
		(widget-button-insert-indirect widget :button-suffix)
		(setq button-end (point)))
	       ((eq escape ?\{)
		(setq sample-begin (point)))
	       ((eq escape ?\})
		(setq sample-end (point)))

(defun widget-info-link-action (widget &optional event)
  "Open the info node specified by WIDGET."
  (Info-goto-node (widget-value widget)))

;;; The `group-link' Widget.

(define-widget 'group-link 'link
  "A link to a customization group."
  :create 'widget-group-link-create
  :action 'widget-group-link-action)

(defun widget-group-link-create (widget)
  (let ((state (widget-get (widget-get widget :parent) :custom-state)))
    (if (eq state 'hidden)
	(widget-default-create widget))))

(defun widget-group-link-action (widget &optional event)
  "Open the info node specified by WIDGET."
  (customize-group (widget-value widget)))

;;; The `url-link' Widget.

(define-widget 'url-link 'link
  "A link to an www page."
  :action 'widget-url-link-action)

      (setq off ""))
    (if (widget-value widget)
	(widget-glyph-insert widget on "down" "down-pushed")
      (widget-glyph-insert widget off "right" "right-pushed"))))

(define-widget 'group-visibility 'item
  "An indicator and manipulator for hidden group contents."
  :format "%[%v%]"
  :create 'widget-group-visibility-create
  :button-prefix ""
  :button-suffix ""
  :on "Hide"
  :off "Show"
  :value-create 'widget-visibility-value-create
  :action 'widget-toggle-action
  :match (lambda (widget value) t))

(defun widget-group-visibility-create (widget)
  (let ((visible (widget-value widget)))
    (if visible
	(insert "--------")))
  (widget-default-create widget))

;;; The `documentation-link' Widget.
;;
;; This is a helper widget for `documentation-string'.

(define-widget 'documentation-link 'link

18364:01666331d10f

;;
;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <[e-mail]>
;; Keywords: extensions
;; Version: 1.9929
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify

	    ((setq tmp (car widget))
	     (setq widget (get tmp 'widget-type)))
	    (t 
	     (setq missing nil))))
    value))

(defun widget-get-indirect (widget property)
  "In WIDGET, get the value of PROPERTY.
If the value is a symbol, return its binding.  
Otherwise, just return the value."
  (let ((value (widget-get widget property)))
    (if (symbolp value)
	(symbol-value value)
      value)))

(defun widget-member (widget property)
  "Non-nil iff there is a definition in WIDGET for PROPERTY."
  (cond ((widget-plist-member (cdr widget) property)
	 t)

(defcustom widget-button-suffix ""
  "String used as suffix for buttons."
  :type 'string
  :group 'widget-button)

;;; Creating Widgets.

;;;###autoload
(defun widget-create (type &rest args)

	  (when found
	    (debug "Overlapping fields"))
	  (setq found field))))
    found))

(defun widget-before-change (from &rest ignore)
  ;; This is how, for example, a variable changes its state to `modified'.
  ;; when it is being edited.
  (condition-case nil
      (let ((field (widget-field-find from)))
	(widget-apply field :notify field))
    (error (debug "Before Change"))))

(defun widget-after-change (from to old)
  ;; Adjust field size and text properties.
  (condition-case nil
      (let ((field (widget-field-find from))

		(while (< begin end)
		  (let ((old (char-after begin)))
		    (unless (eq old secret)
		      (subst-char-in-region begin (1+ begin) old secret)
		      (put-text-property begin (1+ begin) 'secret old))
		    (setq begin (1+ begin)))))))
	  (widget-apply field :notify field)))
    (error (debug "After Change"))))

;;; Widget Functions
;;
;; These functions are used in the definition of multiple widgets. 

	 (replace-match "" t t)
	 (cond ((eq escape ?%)
		(insert "%"))
	       ((eq escape ?\[)
		(setq button-begin (point))
		(insert (widget-get-indirect widget :button-prefix)))
	       ((eq escape ?\])
		(insert (widget-get-indirect widget :button-suffix))
		(setq button-end (point)))
	       ((eq escape ?\{)
		(setq sample-begin (point)))
	       ((eq escape ?\})
		(setq sample-end (point)))

(defun widget-info-link-action (widget &optional event)
  "Open the info node specified by WIDGET."
  (Info-goto-node (widget-value widget)))

;;; The `url-link' Widget.

(define-widget 'url-link 'link
  "A link to an www page."
  :action 'widget-url-link-action)

      (setq off ""))
    (if (widget-value widget)
	(widget-glyph-insert widget on "down" "down-pushed")
      (widget-glyph-insert widget off "right" "right-pushed"))))

;;; The `documentation-link' Widget.
;;
;; This is a helper widget for `documentation-string'.

(define-widget 'documentation-link 'link