(install): Synchronize rules for compiling with Unix version.

[bpt/emacs.git] / lisp / custom.el

diff --git a/lisp/custom.el b/lisp/custom.el
index 821e0f3..de757f8 100644 (file)
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -3,6 +3,7 @@
 ;; Copyright (C) 1996, 1997, 1999 Free Software Foundation, Inc.
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
+;; Maintainer: FSF
 ;; Keywords: help, faces
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ (probably obsolete)
 
@@ -134,7 +135,7 @@ not the default value itself."
                ((eq keyword :require)
                 (setq requests (cons value requests)))
                ((eq keyword :type)
-                (put symbol 'custom-type value))
+                (put symbol 'custom-type (purecopy value)))
                ((eq keyword :options)
                 (if (get symbol 'custom-options)
                     ;; Slow safe code to avoid duplicates.
@@ -264,7 +265,8 @@ information."
     (setq members (cdr members)))
   (put symbol 'custom-group (nconc members (get symbol 'custom-group)))
   (when doc
-    (put symbol 'group-documentation doc))
+    ;; This text doesn't get into DOC.
+    (put symbol 'group-documentation (purecopy doc)))
   (while args
     (let ((arg (car args)))
       (setq args (cdr args))
@@ -339,6 +341,8 @@ Third argument TYPE is the custom option type."
 (defun custom-handle-keyword (symbol keyword value type)
   "For customization option SYMBOL, handle KEYWORD with VALUE.
 Fourth argument TYPE is the custom option type."
+  (if purify-flag
+      (setq value (purecopy value)))
   (cond ((eq keyword :group)
         (custom-add-to-group value symbol type))
        ((eq keyword :version)
@@ -349,9 +353,30 @@ Fourth argument TYPE is the custom option type."
         (custom-add-load symbol value))
        ((eq keyword :tag)
         (put symbol 'custom-tag value))
+       ((eq keyword :set-after)
+        (custom-add-dependencies symbol value))
        (t
         (error "Unknown keyword %s" keyword))))
 
+(defun custom-add-dependencies (symbol value)
+  "To the custom option SYMBOL, add dependencies specified by VALUE.
+VALUE should be a list of symbols.  For each symbol in that list,
+this specifies that SYMBOL should be set after the specified symbol, if
+both appear in constructs like `custom-set-variables'."
+  (unless (listp value)
+    (error "Invalid custom dependency `%s'" value))
+  (let* ((deps (get symbol 'custom-dependencies))
+        (new-deps deps))
+    (while value
+      (let ((dep (car value)))
+       (unless (symbolp dep)
+         (error "Invalid custom dependency `%s'" dep))
+       (unless (memq dep new-deps)
+         (setq new-deps (cons dep new-deps)))
+       (setq value (cdr value))))
+    (unless (eq deps new-deps)
+      (put symbol 'custom-dependencies new-deps))))
+  
 (defun custom-add-option (symbol option)
   "To the variable SYMBOL add OPTION.
 
@@ -365,18 +390,18 @@ For other types variables, the effect is undefined."
   "To the custom option SYMBOL add the link WIDGET."
   (let ((links (get symbol 'custom-links)))
     (unless (member widget links)
-      (put symbol 'custom-links (cons widget links)))))
+      (put symbol 'custom-links (cons (purecopy widget) links)))))
 
 (defun custom-add-version (symbol version)
   "To the custom option SYMBOL add the version VERSION."
-  (put symbol 'custom-version version))
+  (put symbol 'custom-version (purecopy version)))
 
 (defun custom-add-load (symbol load)
   "To the custom option SYMBOL add the dependency LOAD.
 LOAD should be either a library file name, or a feature name."
   (let ((loads (get symbol 'custom-loads)))
     (unless (member load loads)
-      (put symbol 'custom-loads (cons load loads)))))
+      (put symbol 'custom-loads (cons (purecopy load) loads)))))
 
 ;;; Initializing.
 
@@ -400,6 +425,18 @@ If NOW is present and non-nil, VALUE is also evaluated and bound as
 the default value for the SYMBOL.
 REQUEST is a list of features we must require for SYMBOL.
 COMMENT is a comment string about SYMBOL."
+  (setq args
+       (sort args
+             (lambda (a1 a2)
+               (let* ((sym1 (car a1))
+                      (sym2 (car a2))
+                      (1-then-2 (memq sym1 (get sym2 'custom-dependencies)))
+                      (2-then-1 (memq sym2 (get sym1 'custom-dependencies))))
+                 (cond ((and 1-then-2 2-then-1)
+                        (error "Circular custom dependency between `%s' and `%s'"
+                               sym1 sym2))
+                       (2-then-1 nil)
+                       (t t))))))
   (while args
     (let ((entry (car args)))
       (if (listp entry)