comparison lisp/cus-edit.el @ 19040:c0dc58ad2d47

Synched with 1.9954.

19039:193352043c50

;;
;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <[e-mail]>
;; Keywords: help, faces
;; Version: 1.9951
;; 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

	 (face (nth 2 entry))
	 (category (widget-get parent :custom-category))
	 (text (or (and (eq category 'group)
			(nth 4 entry))
		   (nth 3 entry)))
	 (lisp (eq (widget-get parent :custom-form) 'lisp))
	 children)
    (while (string-match "\\`\\(.*\\)%c\\(.*\\)\\'" text)
      (setq text (concat (match-string 1 text) 
			 (symbol-name category)
			 (match-string 2 text))))

      (insert ": ")
      (let ((start (point)))
	(if (eq custom-magic-show 'long)
	    (insert text)
	  (insert (symbol-name state)))
	(when lisp 
	  (insert " (lisp)"))
	(put-text-property start (point) 'face 'custom-state-face))
      (insert "\n"))
    (when (and (eq category 'group)
	       (not (and (eq custom-buffer-style 'links)
			 (> (widget-get parent :custom-level) 1))))

	     :button-face face
	     :button-prefix ""
	     :button-suffix ""
	     :help-echo "Change the state."
	     :format (if hidden "%t" "%[%t%]")
	     :tag (if lisp 
		      (concat "(" magic ")")
		    (concat "[" magic "]")))
	    children)
      (insert " "))
    (widget-put widget :children children)))

	(cond ((symbolp load)
	       (condition-case nil
		   (require load)
		 (error nil)))
	      ;; Don't reload a file already loaded.
	      ((member load preloaded-file-list))
	      ((assoc load load-history))
	      ((assoc (locate-library load) load-history))
	      (t
	       (condition-case nil
		   ;; Without this, we would load cus-edit recursively.

	   (setq state 'hidden)))
    ;; If we don't know the state, see if we need to edit it in lisp form.
    (when (eq state 'unknown)
      (unless (widget-apply conv :match value)
	;; (widget-apply (widget-convert type) :match value)
	(setq form 'lisp)))
    ;; Now we can create the child widget.
    (cond ((eq custom-buffer-style 'tree)
	   (insert prefix (if last " `--- " " |--- "))
	   (push (widget-create-child-and-convert
		  widget 'custom-browse-variable-tag)

		  widget 'visibility
		  :help-echo "Show the value of this option."
		  :action 'custom-toggle-parent
		  nil)
		 buttons))
	  ((eq form 'lisp)
	   ;; In lisp mode edit the saved value when possible.
	   (let* ((value (cond ((get symbol 'saved-value)
				(car (get symbol 'saved-value)))
			       ((get symbol 'standard-value)
				(car (get symbol 'standard-value)))

	    (memq (widget-get widget :custom-state)
		  '(modified set changed saved rogue)))))
    ("---" ignore ignore)
    ("Don't show as Lisp expression" custom-variable-edit 
     (lambda (widget)
       (not (eq (widget-get widget :custom-form) 'edit))))
    ("Show as Lisp expression" custom-variable-edit-lisp
     (lambda (widget)
       (not (eq (widget-get widget :custom-form) 'lisp)))))
  "Alist of actions for the `custom-variable' widget.
Each entry has the form (NAME ACTION FILTER) where NAME is the name of
the menu entry, ACTION is the function to call on the widget when the
menu is selected, and FILTER is a predicate which takes a `custom-variable'
widget as an argument, and returns non-nil if ACTION is valid on that

    (cond ((eq state 'hidden)
	   (error "Cannot set hidden variable."))
	  ((setq val (widget-apply child :validate))
	   (goto-char (widget-get val :from))
	   (error "%s" (widget-get val :error)))
	  ((eq form 'lisp)
	   (funcall set symbol (eval (setq val (widget-value child))))
	   (put symbol 'customized-value (list val)))
	  (t
	   (funcall set symbol (setq val (widget-value child)))
	   (put symbol 'customized-value (list (custom-quote val)))))

    (cond ((eq state 'hidden)
	   (error "Cannot set hidden variable."))
	  ((setq val (widget-apply child :validate))
	   (goto-char (widget-get val :from))
	   (error "%s" (widget-get val :error)))
	  ((eq form 'lisp)
	   (put symbol 'saved-value (list (widget-value child)))
	   (funcall set symbol (eval (widget-value child))))
	  (t
	   (put symbol
		'saved-value (list (custom-quote (widget-value

;;; The `hook' Widget.

(define-widget 'hook 'list
  "A emacs lisp hook"
  :convert-widget 'custom-hook-convert-widget
  :tag "Hook")

(defun custom-hook-convert-widget (widget)
  ;; Handle `:custom-options'.

(defun custom-group-value-create (widget)
  "Insert a customize group for WIDGET in the current buffer."
  (let* ((state (widget-get widget :custom-state))
	 (level (widget-get widget :custom-level))
	 (indent (widget-get widget :indent))
	 (prefix (widget-get widget :custom-prefix))
	 (buttons (widget-get widget :buttons))
	 (tag (widget-get widget :tag))
	 (symbol (widget-value widget))
	 (members (custom-group-members symbol

19040:c0dc58ad2d47

;;
;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <[e-mail]>
;; Keywords: help, faces
;; Version: 1.9954
;; 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

	 (face (nth 2 entry))
	 (category (widget-get parent :custom-category))
	 (text (or (and (eq category 'group)
			(nth 4 entry))
		   (nth 3 entry)))
	 (form (widget-get parent :custom-form))
	 children)
    (while (string-match "\\`\\(.*\\)%c\\(.*\\)\\'" text)
      (setq text (concat (match-string 1 text) 
			 (symbol-name category)
			 (match-string 2 text))))

      (insert ": ")
      (let ((start (point)))
	(if (eq custom-magic-show 'long)
	    (insert text)
	  (insert (symbol-name state)))
	(cond ((eq form 'lisp)
	       (insert " (lisp)"))
	      ((eq form 'mismatch)
	       (insert " (mismatch)")))
	(put-text-property start (point) 'face 'custom-state-face))
      (insert "\n"))
    (when (and (eq category 'group)
	       (not (and (eq custom-buffer-style 'links)
			 (> (widget-get parent :custom-level) 1))))

	     :button-face face
	     :button-prefix ""
	     :button-suffix ""
	     :help-echo "Change the state."
	     :format (if hidden "%t" "%[%t%]")
	     :tag (if (memq form '(lisp mismatch))
		      (concat "(" magic ")")
		    (concat "[" magic "]")))
	    children)
      (insert " "))
    (widget-put widget :children children)))

	(cond ((symbolp load)
	       (condition-case nil
		   (require load)
		 (error nil)))
	      ;; Don't reload a file already loaded.
	      ((and (boundp 'preloaded-file-list)
		    (member load preloaded-file-list)))
	      ((assoc load load-history))
	      ((assoc (locate-library load) load-history))
	      (t
	       (condition-case nil
		   ;; Without this, we would load cus-edit recursively.

	   (setq state 'hidden)))
    ;; If we don't know the state, see if we need to edit it in lisp form.
    (when (eq state 'unknown)
      (unless (widget-apply conv :match value)
	;; (widget-apply (widget-convert type) :match value)
	(setq form 'mismatch)))
    ;; Now we can create the child widget.
    (cond ((eq custom-buffer-style 'tree)
	   (insert prefix (if last " `--- " " |--- "))
	   (push (widget-create-child-and-convert
		  widget 'custom-browse-variable-tag)

		  widget 'visibility
		  :help-echo "Show the value of this option."
		  :action 'custom-toggle-parent
		  nil)
		 buttons))
	  ((memq form '(lisp mismatch))
	   ;; In lisp mode edit the saved value when possible.
	   (let* ((value (cond ((get symbol 'saved-value)
				(car (get symbol 'saved-value)))
			       ((get symbol 'standard-value)
				(car (get symbol 'standard-value)))

	    (memq (widget-get widget :custom-state)
		  '(modified set changed saved rogue)))))
    ("---" ignore ignore)
    ("Don't show as Lisp expression" custom-variable-edit 
     (lambda (widget)
       (eq (widget-get widget :custom-form) 'lisp)))
    ("Show as Lisp expression" custom-variable-edit-lisp
     (lambda (widget)
       (eq (widget-get widget :custom-form) 'edit))))
  "Alist of actions for the `custom-variable' widget.
Each entry has the form (NAME ACTION FILTER) where NAME is the name of
the menu entry, ACTION is the function to call on the widget when the
menu is selected, and FILTER is a predicate which takes a `custom-variable'
widget as an argument, and returns non-nil if ACTION is valid on that

    (cond ((eq state 'hidden)
	   (error "Cannot set hidden variable."))
	  ((setq val (widget-apply child :validate))
	   (goto-char (widget-get val :from))
	   (error "%s" (widget-get val :error)))
	  ((memq form '(lisp mismatch))
	   (funcall set symbol (eval (setq val (widget-value child))))
	   (put symbol 'customized-value (list val)))
	  (t
	   (funcall set symbol (setq val (widget-value child)))
	   (put symbol 'customized-value (list (custom-quote val)))))

    (cond ((eq state 'hidden)
	   (error "Cannot set hidden variable."))
	  ((setq val (widget-apply child :validate))
	   (goto-char (widget-get val :from))
	   (error "%s" (widget-get val :error)))
	  ((memq form '(lisp mismatch))
	   (put symbol 'saved-value (list (widget-value child)))
	   (funcall set symbol (eval (widget-value child))))
	  (t
	   (put symbol
		'saved-value (list (custom-quote (widget-value

;;; The `hook' Widget.

(define-widget 'hook 'list
  "A emacs lisp hook"
  :value-to-internal (lambda (widget value)
		       (if (symbolp value)
			   (list value)
			 value))
  :match (lambda (widget value)
	   (or (symbolp value)
	       (widget-editable-list-match widget value)))
  :convert-widget 'custom-hook-convert-widget
  :tag "Hook")

(defun custom-hook-convert-widget (widget)
  ;; Handle `:custom-options'.

(defun custom-group-value-create (widget)
  "Insert a customize group for WIDGET in the current buffer."
  (let* ((state (widget-get widget :custom-state))
	 (level (widget-get widget :custom-level))
	 ;; (indent (widget-get widget :indent))
	 (prefix (widget-get widget :custom-prefix))
	 (buttons (widget-get widget :buttons))
	 (tag (widget-get widget :tag))
	 (symbol (widget-value widget))
	 (members (custom-group-members symbol