Mercurial > hg > xemacs-beta

comparison lisp/custom/cus-edit.el @ 181:bfd6434d15b3 r20-3b17

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b17
author cvs
date Mon, 13 Aug 2007 09:53:19 +0200
parents 9ad43877534d
children 3d6bfa290dbd
comparison
equal deleted inserted replaced
180:add28d59e586 181:bfd6434d15b3
2 ;; 2 ;;
3 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
4 ;; 4 ;;
5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> 5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
6 ;; Keywords: help, faces 6 ;; Keywords: help, faces
7 ;; Version: 1.9953 7 ;; Version: 1.9954
8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ 8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
9 9
10 ;; This file is part of GNU Emacs. 10 ;; This file is part of GNU Emacs.
11 11
12 ;; GNU Emacs is free software; you can redistribute it and/or modify 12 ;; GNU Emacs is free software; you can redistribute it and/or modify
1426 (face (nth 2 entry)) 1426 (face (nth 2 entry))
1427 (category (widget-get parent :custom-category)) 1427 (category (widget-get parent :custom-category))
1428 (text (or (and (eq category 'group) 1428 (text (or (and (eq category 'group)
1429 (nth 4 entry)) 1429 (nth 4 entry))
1430 (nth 3 entry))) 1430 (nth 3 entry)))
1431 (lisp (eq (widget-get parent :custom-form) 'lisp)) 1431 (form (widget-get parent :custom-form))
1432 children) 1432 children)
1433 (while (string-match "\\`\\(.*\\)%c\\(.*\\)\\'" text) 1433 (while (string-match "\\`\\(.*\\)%c\\(.*\\)\\'" text)
1434 (setq text (concat (match-string 1 text) 1434 (setq text (concat (match-string 1 text)
1435 (symbol-name category) 1435 (symbol-name category)
1436 (match-string 2 text)))) 1436 (match-string 2 text))))
1455 (insert ": ") 1455 (insert ": ")
1456 (let ((start (point))) 1456 (let ((start (point)))
1457 (if (eq custom-magic-show 'long) 1457 (if (eq custom-magic-show 'long)
1458 (insert text) 1458 (insert text)
1459 (insert (symbol-name state))) 1459 (insert (symbol-name state)))
1460 (when lisp 1460 (cond ((eq form 'lisp)
1461 (insert " (lisp)")) 1461 (insert " (lisp)"))
1462 ((eq form 'mismatch)
1463 (insert " (mismatch)")))
1462 (put-text-property start (point) 'face 'custom-state-face)) 1464 (put-text-property start (point) 'face 'custom-state-face))
1463 (insert "\n")) 1465 (insert "\n"))
1464 (when (and (eq category 'group) 1466 (when (and (eq category 'group)
1465 (not (and (eq custom-buffer-style 'links) 1467 (not (and (eq custom-buffer-style 'links)
1466 (> (widget-get parent :custom-level) 1)))) 1468 (> (widget-get parent :custom-level) 1))))
1477 :button-face face 1479 :button-face face
1478 :button-prefix "" 1480 :button-prefix ""
1479 :button-suffix "" 1481 :button-suffix ""
1480 :help-echo "Change the state." 1482 :help-echo "Change the state."
1481 :format (if hidden "%t" "%[%t%]") 1483 :format (if hidden "%t" "%[%t%]")
1482 :tag (if lisp 1484 :tag (if (memq form '(lisp mismatch))
1483 (concat "(" magic ")") 1485 (concat "(" magic ")")
1484 (concat "[" magic "]"))) 1486 (concat "[" magic "]")))
1485 children) 1487 children)
1486 (insert " ")) 1488 (insert " "))
1487 (widget-put widget :children children))) 1489 (widget-put widget :children children)))
1788 (setq state 'hidden))) 1790 (setq state 'hidden)))
1789 ;; If we don't know the state, see if we need to edit it in lisp form. 1791 ;; If we don't know the state, see if we need to edit it in lisp form.
1790 (when (eq state 'unknown) 1792 (when (eq state 'unknown)
1791 (unless (widget-apply conv :match value) 1793 (unless (widget-apply conv :match value)
1792 ;; (widget-apply (widget-convert type) :match value) 1794 ;; (widget-apply (widget-convert type) :match value)
1793 (setq form 'lisp))) 1795 (setq form 'mismatch)))
1794 ;; Now we can create the child widget. 1796 ;; Now we can create the child widget.
1795 (cond ((eq custom-buffer-style 'tree) 1797 (cond ((eq custom-buffer-style 'tree)
1796 (insert prefix (if last " `--- " " |--- ")) 1798 (insert prefix (if last " `--- " " |--- "))
1797 (push (widget-create-child-and-convert 1799 (push (widget-create-child-and-convert
1798 widget 'custom-browse-variable-tag) 1800 widget 'custom-browse-variable-tag)
1812 widget 'visibility 1814 widget 'visibility
1813 :help-echo "Show the value of this option." 1815 :help-echo "Show the value of this option."
1814 :action 'custom-toggle-parent 1816 :action 'custom-toggle-parent
1815 nil) 1817 nil)
1816 buttons)) 1818 buttons))
1817 ((eq form 'lisp) 1819 ((memq form '(lisp mismatch))
1818 ;; In lisp mode edit the saved value when possible. 1820 ;; In lisp mode edit the saved value when possible.
1819 (let* ((value (cond ((get symbol 'saved-value) 1821 (let* ((value (cond ((get symbol 'saved-value)
1820 (car (get symbol 'saved-value))) 1822 (car (get symbol 'saved-value)))
1821 ((get symbol 'standard-value) 1823 ((get symbol 'standard-value)
1822 (car (get symbol 'standard-value))) 1824 (car (get symbol 'standard-value)))
1955 (memq (widget-get widget :custom-state) 1957 (memq (widget-get widget :custom-state)
1956 '(modified set changed saved rogue))))) 1958 '(modified set changed saved rogue)))))
1957 ("---" ignore ignore) 1959 ("---" ignore ignore)
1958 ("Don't show as Lisp expression" custom-variable-edit 1960 ("Don't show as Lisp expression" custom-variable-edit
1959 (lambda (widget) 1961 (lambda (widget)
1960 (not (eq (widget-get widget :custom-form) 'edit)))) 1962 (eq (widget-get widget :custom-form) 'lisp)))
1961 ("Show as Lisp expression" custom-variable-edit-lisp 1963 ("Show as Lisp expression" custom-variable-edit-lisp
1962 (lambda (widget) 1964 (lambda (widget)
1963 (not (eq (widget-get widget :custom-form) 'lisp))))) 1965 (eq (widget-get widget :custom-form) 'edit))))
1964 "Alist of actions for the `custom-variable' widget. 1966 "Alist of actions for the `custom-variable' widget.
1965 Each entry has the form (NAME ACTION FILTER) where NAME is the name of 1967 Each entry has the form (NAME ACTION FILTER) where NAME is the name of
1966 the menu entry, ACTION is the function to call on the widget when the 1968 the menu entry, ACTION is the function to call on the widget when the
1967 menu is selected, and FILTER is a predicate which takes a `custom-variable' 1969 menu is selected, and FILTER is a predicate which takes a `custom-variable'
1968 widget as an argument, and returns non-nil if ACTION is valid on that 1970 widget as an argument, and returns non-nil if ACTION is valid on that
2009 (cond ((eq state 'hidden) 2011 (cond ((eq state 'hidden)
2010 (error "Cannot set hidden variable.")) 2012 (error "Cannot set hidden variable."))
2011 ((setq val (widget-apply child :validate)) 2013 ((setq val (widget-apply child :validate))
2012 (goto-char (widget-get val :from)) 2014 (goto-char (widget-get val :from))
2013 (error "%s" (widget-get val :error))) 2015 (error "%s" (widget-get val :error)))
2014 ((eq form 'lisp) 2016 ((memq form '(lisp mismatch))
2015 (funcall set symbol (eval (setq val (widget-value child)))) 2017 (funcall set symbol (eval (setq val (widget-value child))))
2016 (put symbol 'customized-value (list val))) 2018 (put symbol 'customized-value (list val)))
2017 (t 2019 (t
2018 (funcall set symbol (setq val (widget-value child))) 2020 (funcall set symbol (setq val (widget-value child)))
2019 (put symbol 'customized-value (list (custom-quote val))))) 2021 (put symbol 'customized-value (list (custom-quote val)))))
2031 (cond ((eq state 'hidden) 2033 (cond ((eq state 'hidden)
2032 (error "Cannot set hidden variable.")) 2034 (error "Cannot set hidden variable."))
2033 ((setq val (widget-apply child :validate)) 2035 ((setq val (widget-apply child :validate))
2034 (goto-char (widget-get val :from)) 2036 (goto-char (widget-get val :from))
2035 (error "%s" (widget-get val :error))) 2037 (error "%s" (widget-get val :error)))
2036 ((eq form 'lisp) 2038 ((memq form '(lisp mismatch))
2037 (put symbol 'saved-value (list (widget-value child))) 2039 (put symbol 'saved-value (list (widget-value child)))
2038 (funcall set symbol (eval (widget-value child)))) 2040 (funcall set symbol (eval (widget-value child))))
2039 (t 2041 (t
2040 (put symbol 2042 (put symbol
2041 'saved-value (list (custom-quote (widget-value 2043 'saved-value (list (custom-quote (widget-value
2480 2482
2481 ;;; The `hook' Widget. 2483 ;;; The `hook' Widget.
2482 2484
2483 (define-widget 'hook 'list 2485 (define-widget 'hook 'list
2484 "A emacs lisp hook" 2486 "A emacs lisp hook"
2487 :value-to-internal (lambda (widget value)
2488 (if (symbolp value)
2489 (list value)
2490 value))
2491 :match (lambda (widget value)
2492 (or (symbolp value)
2493 (widget-editable-list-match widget value)))
2485 :convert-widget 'custom-hook-convert-widget 2494 :convert-widget 'custom-hook-convert-widget
2486 :tag "Hook") 2495 :tag "Hook")
2487 2496
2488 (defun custom-hook-convert-widget (widget) 2497 (defun custom-hook-convert-widget (widget)
2489 ;; Handle `:custom-options'. 2498 ;; Handle `:custom-options'.