Mercurial > hg > xemacs-beta

comparison lisp/cus-edit.el @ 2544:b4a8cd0dd8df

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2005-02-03 04:29:32 by ben] behavior ws #1: custom updates cus-dep.el: If a directory has no custom dependencies, write a blank custom-load file rather than deleting the file, so that time-based rebuild checking will work. cus-edit.el: Split out code in custom-load-symbol. Support loading of the new custom-defines file. cus-edit.el: Split long menus. custom.el: Sync with FSF 21.3.
author ben
date Thu, 03 Feb 2005 04:29:33 +0000
parents 3c70cbcc7ae8
children cef5f57bb9e2
comparison
equal deleted inserted replaced
2543:5e6de1feeafc 2544:b4a8cd0dd8df
1 ;;; cus-edit.el --- Tools for customizating Emacs and Lisp packages. 1 ;;; cus-edit.el --- Tools for customizating Emacs and Lisp packages.
2 ;; 2 ;;
3 ;; Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc. 3 ;; Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc.
4 ;; Copyright (C) 2003 Ben Wing.
4 ;; 5 ;;
5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> 6 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
6 ;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org> 7 ;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org>
7 ;; Keywords: help, faces 8 ;; Keywords: help, faces
8 ;; Version: 1.9960-x 9 ;; Version: 1.9960-x
1654 (loads (get symbol 'custom-loads)) 1655 (loads (get symbol 'custom-loads))
1655 load) 1656 load)
1656 (while loads 1657 (while loads
1657 (setq load (car loads) 1658 (setq load (car loads)
1658 loads (cdr loads)) 1659 loads (cdr loads))
1659 (cond ((symbolp load) 1660 (custom-load-symbol-1 load)))))
1660 (condition-case nil 1661
1661 (require load) 1662 (defun custom-load-symbol-1 (load)
1662 (error nil))) 1663 (cond ((symbolp load)
1663 ;; Don't reload a file already loaded. 1664 (condition-case nil
1664 ((and (boundp 'preloaded-file-list) 1665 (require load)
1665 (member load preloaded-file-list))) 1666 (error nil)))
1666 ((assoc load load-history)) 1667 ;; Don't reload a file already loaded.
1667 ((assoc (locate-library load) load-history)) 1668 ((and (boundp 'preloaded-file-list)
1668 (t 1669 (member load preloaded-file-list)))
1669 (condition-case nil 1670 ((assoc load load-history))
1670 ;; Without this, we would load cus-edit recursively. 1671 ((assoc (locate-library load) load-history))
1671 ;; We are still loading it when we call this, 1672 (t
1672 ;; and it is not in load-history yet. 1673 (condition-case nil
1673 (or (equal load "cus-edit") 1674 ;; Without this, we would load cus-edit recursively.
1674 (load-library load)) 1675 ;; We are still loading it when we call this,
1675 (error nil)))))))) 1676 ;; and it is not in load-history yet.
1677 (or (equal load "cus-edit")
1678 (load-library load))
1679 (error nil)))))
1680
1681 (defvar custom-already-loaded-custom-defines nil
1682 "List of already-loaded `custom-defines' files.")
1683 (defvar custom-define-current-source-file nil)
1684 (defvar custom-warn-when-reloading-necessary nil
1685 "For package-debugging purposes: Warn when an error hit in custom-defines.el.
1686 When this happens, the file from which the defcustom or defgroup was taken
1687 is loaded, and custom-defines.el is then reloaded. This works in most
1688 cases, but may not be completely safe. It's better if the package itself
1689 arranges for the necessary functions and variables to be available, using
1690 \;;;###autoload declarations. When this variable is non-nil, warnings are
1691 issued (with backtrace), to aid in tracking down the problems.")
1692
1693 (defun custom-load-custom-defines (symbol)
1694 "Load custom-defines for SYMBOL."
1695 (unless custom-load-recursion
1696 (let ((custom-load-recursion t)
1697 (loads (get symbol 'custom-loads))
1698 load)
1699 (while loads
1700 (setq load (car loads)
1701 loads (cdr loads))
1702 (let* ((found (locate-library
1703 (if (symbolp load) (symbol-name load) load)))
1704 (dir (and found (file-name-directory found))))
1705 ;; If we find a custom-defines file, assume the package is smart
1706 ;; enough to have put all its defcustoms and defgroups here, and
1707 ;; load it instead of the file itself. Otherwise, do it the
1708 ;; hard way.
1709 (if (and found (or (file-exists-p
1710 (expand-file-name "custom-defines.elc" dir))
1711 (file-exists-p
1712 (expand-file-name "custom-defines.el" dir))))
1713 (when (not (member dir custom-already-loaded-custom-defines))
1714 (push dir custom-already-loaded-custom-defines)
1715 (custom-load-custom-defines-1 dir))))))))
1716
1717 (defun custom-load-custom-defines-1 (dir)
1718 ;; Actually load the custom-defines.el file in DIR.
1719
1720 ;; If we get an error loading the custom-defines, it may be because of a
1721 ;; reference to something (e.g. a constant) that hasn't yet been defined
1722 ;; yet. Properly, these should have been marked, so they either go into
1723 ;; the custom-defines.el file or are autoloaded. But not everyone is so
1724 ;; careful, so for the moment we try to load the file that the
1725 ;; error-generating defcustom came from, and then reload the
1726 ;; custom-defines.el file. We might loop a number of times if we have
1727 ;; various files that need loading. If at any point we get an error that
1728 ;; can't be solved just by loading the appropriate file (e.g. we hit the
1729 ;; same error as before, the file is already loaded, etc.) then we signal
1730 ;; it as a real error.
1731 (let (source)
1732 ;; here's how this works: if we get an error loading custom-defines,
1733 ;; the condition handler is called; if we need to reload, we
1734 ;; `return-from', which throws out of the handler and returns nil from
1735 ;; the `block', which continues the while statement, executing the
1736 ;; `load' at the bottom of this function and then entering the block
1737 ;; again. if the condition handler doesn't throw, but instead returns
1738 ;; normally, `signal' will continue as if nothing happened, and end up
1739 ;; signalling the error normally.
1740 (while
1741 (not
1742 (block custom-load
1743 ;; Use call-with-condition-handler so the error can be seen
1744 ;; with the stack intact.
1745 (call-with-condition-handler
1746 #'(lambda (__custom_load_cd1__)
1747 (when (and
1748 custom-define-current-source-file
1749 (progn
1750 (setq source (expand-file-name
1751 custom-define-current-source-file
1752 dir))
1753 (let ((nondir (file-name-nondirectory source)))
1754 (and (file-exists-p source)
1755 (not (assoc source load-history))
1756 (not (assoc nondir load-history))
1757 (not (and (boundp 'preloaded-file-list)
1758 (member nondir
1759 preloaded-file-list)))))))
1760 (if custom-warn-when-reloading-necessary
1761 (lwarn 'custom-defines 'warning
1762 "Error while loading custom-defines, fetching source and reloading ...\n
1763 Error: %s\n
1764 Source file: %s\n\n
1765 Backtrace follows:\n\n%s"
1766 (error-message-string __custom_load_cd1__)
1767 source
1768 (backtrace-in-condition-handler-eliminating-handler
1769 '__custom_load_cd1__)))
1770 (return-from custom-load nil)))
1771 #'(lambda ()
1772 (load (expand-file-name "custom-defines" dir))))))
1773 ;; we get here only from the `return-from'; see above
1774 (load source))))
1676 1775
1677 (defun custom-load-widget (widget) 1776 (defun custom-load-widget (widget)
1678 "Load all dependencies for WIDGET." 1777 "Load all dependencies for WIDGET."
1679 (custom-load-symbol (widget-value widget))) 1778 (custom-load-symbol (widget-value widget)))
1680 1779
3707 3806
3708 ;;;###autoload 3807 ;;;###autoload
3709 (defun custom-menu-create (symbol) 3808 (defun custom-menu-create (symbol)
3710 "Create menu for customization group SYMBOL. 3809 "Create menu for customization group SYMBOL.
3711 The menu is in a format applicable to `easy-menu-define'." 3810 The menu is in a format applicable to `easy-menu-define'."
3712 (let* ((item (vector (custom-unlispify-menu-entry symbol) 3811 (menu-split-long-menu
3713 `(customize-group ',symbol) 3812 (let* ((item (vector (custom-unlispify-menu-entry symbol)
3714 t))) 3813 `(customize-group ',symbol)
3715 ;; Item is the entry for creating a menu buffer for SYMBOL. 3814 t)))
3716 ;; We may nest, if the menu is not too big. 3815 ;; Item is the entry for creating a menu buffer for SYMBOL.
3717 (custom-load-symbol symbol) 3816 ;; We may nest, if the menu is not too big.
3718 (if (< (length (get symbol 'custom-group)) widget-menu-max-size) 3817 (custom-load-custom-defines symbol)
3719 ;; The menu is not too big. 3818 (if t ;(< (length (get symbol 'custom-group)) widget-menu-max-size)
3720 (let ((custom-prefix-list (custom-prefix-add symbol 3819 ;; The menu is not too big.
3721 custom-prefix-list)) 3820 (let ((custom-prefix-list (custom-prefix-add symbol
3722 (members (custom-sort-items (get symbol 'custom-group) 3821 custom-prefix-list))
3723 custom-menu-sort-alphabetically 3822 (members (custom-sort-items (get symbol 'custom-group)
3724 custom-menu-order-groups))) 3823 custom-menu-sort-alphabetically
3725 ;; Create the menu. 3824 custom-menu-order-groups)))
3726 `(,(custom-unlispify-menu-entry symbol t) 3825 ;; Create the menu.
3727 ,item 3826 `(,(custom-unlispify-menu-entry symbol t)
3728 "--" 3827 ,item
3729 ,@(mapcar (lambda (entry) 3828 "--"
3730 (widget-apply (if (listp (nth 1 entry)) 3829 ,@(mapcar (lambda (entry)
3731 (nth 1 entry) 3830 (widget-apply (if (listp (nth 1 entry))
3732 (list (nth 1 entry))) 3831 (nth 1 entry)
3733 :custom-menu (nth 0 entry))) 3832 (list (nth 1 entry)))
3734 members))) 3833 :custom-menu (nth 0 entry)))
3735 ;; The menu was too big. 3834 members)))
3736 item))) 3835 ; else ;; The menu was too big.
3836 item
3837 ))))
3737 3838
3738 ;;;###autoload 3839 ;;;###autoload
3739 (defun customize-menu-create (symbol &optional name) 3840 (defun customize-menu-create (symbol &optional name)
3740 "Return a customize menu for customization group SYMBOL. 3841 "Return a customize menu for customization group SYMBOL.
3741 If optional NAME is given, use that as the name of the menu. 3842 If optional NAME is given, use that as the name of the menu.