- (setq plist (cdr (cdr plist))))))))
-
-(or (fboundp 'match-string)
- ;; Introduced in Emacs 19.29.
- (defun match-string (num &optional string)
- "Return string of text matched by last search.
-NUM specifies which parenthesized expression in the last regexp.
- Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
-Zero means the entire text matched by the whole regexp or whole string.
-STRING should be given if the last search was by `string-match' on STRING."
- (if (match-beginning num)
- (if string
- (substring string (match-beginning num) (match-end num))
- (buffer-substring (match-beginning num) (match-end num))))))
-
-(or (fboundp 'facep)
- ;; Introduced in Emacs 19.29.
- (defun facep (x)
- "Return t if X is a face name or an internal face vector."
- (and (or (internal-facep x)
- (and (symbolp x) (assq x global-face-data)))
- t)))
-
-(or (fboundp 'modify-face)
- ;; Introduced in Emacs 19.29.
- (defun modify-face (face foreground background stipple
- bold-p italic-p underline-p)
- "Change the display attributes for face FACE.
-FOREGROUND and BACKGROUND should be color strings or nil.
-STIPPLE should be a stipple pattern name or nil.
-BOLD-P, ITALIC-P, and UNDERLINE-P specify whether the face should be set bold,
-in italic, and underlined, respectively. (Yes if non-nil.)
-If called interactively, prompts for a face and face attributes."
- (interactive
- (let* ((completion-ignore-case t)
- (face (symbol-name (read-face-name "Modify face: ")))
- (colors (mapcar 'list x-colors))
- (stipples (mapcar 'list
- (apply 'nconc
- (mapcar 'directory-files
- x-bitmap-file-path))))
- (foreground (modify-face-read-string
- face (face-foreground (intern face))
- "foreground" colors))
- (background (modify-face-read-string
- face (face-background (intern face))
- "background" colors))
- (stipple (modify-face-read-string
- face (face-stipple (intern face))
- "stipple" stipples))
- (bold-p (y-or-n-p (concat "Set face " face " bold ")))
- (italic-p (y-or-n-p (concat "Set face " face " italic ")))
- (underline-p (y-or-n-p (concat "Set face " face " underline "))))
- (message "Face %s: %s" face
- (mapconcat 'identity
- (delq nil
- (list (and foreground (concat (downcase foreground) " foreground"))
- (and background (concat (downcase background) " background"))
- (and stipple (concat (downcase stipple) " stipple"))
- (and bold-p "bold") (and italic-p "italic")
- (and underline-p "underline"))) ", "))
- (list (intern face) foreground background stipple
- bold-p italic-p underline-p)))
- (condition-case nil (set-face-foreground face foreground) (error nil))
- (condition-case nil (set-face-background face background) (error nil))
- (condition-case nil (set-face-stipple face stipple) (error nil))
- (if (string-match "XEmacs" emacs-version)
- (progn
- (funcall (if bold-p 'make-face-bold 'make-face-unbold) face)
- (funcall (if italic-p 'make-face-italic 'make-face-unitalic) face))
- (funcall (if bold-p 'make-face-bold 'make-face-unbold) face nil t)
- (funcall (if italic-p 'make-face-italic 'make-face-unitalic) face nil t))
- (set-face-underline-p face underline-p)
- (and (interactive-p) (redraw-display))))
-
-
-;; We can't easily check for a working intangible.
-(defvar intangible nil
- "The symbol making text intangible")
-
-(if (and (boundp 'emacs-minor-version)
- (or (> emacs-major-version 19)
- (and (> emacs-major-version 18)
- (> emacs-minor-version 28))))
- (setq intangible 'intangible)
- (setq intangible 'intangible-if-it-had-been-working))
-
-;; Put it in the Help menu, if possible.
-(condition-case nil
- ;; This will not work under XEmacs.
- (global-set-key [ menu-bar help customize ] '("Customize..." . customize))
- (error nil))
-
-;;; External Data:
-;;
-;; The following functions and variables defines the interface for
-;; connecting a CUSTOM with an external entity, by default an emacs
-;; lisp variable.
-
-(defvar custom-external 'default-value
- "Function returning the external value of NAME.")
-
-(defvar custom-external-set 'set-default
- "Function setting the external value of NAME to VALUE.")
-
-(defun custom-external (name)
- "Get the external value associated with NAME."
- (funcall custom-external name))
-
-(defun custom-external-set (name value)
- "Set the external value associated with NAME to VALUE."
- (funcall custom-external-set name value))
-
-(defvar custom-name-fields nil
- "Alist of custom names and their associated editing field.")
-(make-variable-buffer-local 'custom-name-fields)
-
-(defun custom-name-enter (name field)
- "Associate NAME with FIELD."
- (if (null name)
- ()
- (custom-assert 'field)
- (setq custom-name-fields (cons (cons name field) custom-name-fields))))
-
-(defun custom-name-field (name)
- "The editing field associated with NAME."
- (cdr (assq name custom-name-fields)))
-
-(defun custom-name-value (name)
- "The value currently displayed for NAME in the customization buffer."
- (let* ((field (custom-name-field name))
- (custom (custom-field-custom field)))
- (funcall (custom-property custom 'export)
- (car (custom-field-extract custom field)))))
-
-;;; Custom Functions:
-;;
-;; The following functions are part of the public interface to the
-;; CUSTOM datastructure. Each CUSTOM describes a group of variables,
-;; a single variable, or a component of a structured variable. The
-;; CUSTOM instances are part of two hiearachies, the first is the
-;; `part-of' hierarchy in which each CUSTOM is a component of another
-;; CUSTOM, except for the top level CUSTOM which is contained in
-;; `custom-data'. The second hiearachy is a `is-a' type hierarchy
-;; where each CUSTOM is a leaf in the hierarchy defined by the `type'
-;; property and `custom-type-properties'.
-
-(defvar custom-file "~/.custom.el"
- "Name of file with customization information.")
-
-(defconst custom-data
- '((tag . "Emacs")
- (doc . "The extensible self-documenting text editor.")
- (type . group)
- (data "\n"
- ((header . nil)
- (compact . t)
- (type . group)
- (doc . "\
-Press [Save] to save any changes permanently after you are done editing.
-You can load customization information from other files by editing the
-`File' field and pressing the [Load] button. When you press [Save] the
-customization information of all files you have loaded, plus any
-changes you might have made manually, will be stored in the file
-specified by the `File' field.")
- (data ((tag . "Load")
- (type . button)
- (query . custom-load))
- ((tag . "Save")
- (type . button)
- (query . custom-save))
- ((name . custom-file)
- (default . "~/.custom.el")
- (doc . "Name of file with customization information.\n")
- (tag . "File")
- (type . file))))))
- "The global customization information.
-A custom association list.")
-
-(defun custom-declare (path custom)
- "Declare variables for customization.
-PATH is a list of tags leading to the place in the customization
-hierarchy the new entry should be added. CUSTOM is the entry to add."
- (custom-initialize custom)
- (let ((current (custom-travel-path custom-data path)))
- (or (member custom (custom-data current))
- (nconc (custom-data current) (list custom)))))
-
-(put 'custom-declare 'lisp-indent-hook 1)
-
-(defconst custom-type-properties
- '((repeat (type . default)
- (accept . custom-repeat-accept)
- (extract . custom-repeat-extract)
- (validate . custom-repeat-validate)
- (insert . custom-repeat-insert)
- (match . custom-repeat-match)
- (query . custom-repeat-query)
- (prefix . "")
- (del-tag . "[DEL]")
- (add-tag . "[INS]"))
- (pair (type . group)
- (valid . (lambda (c d) (consp d)))
- (extract . custom-pair-extract))
- (list (type . group)
- (valid . (lambda (c d) (listp d)))
- (quote . custom-list-quote)
- (extract . custom-list-extract))
- (group (type . default)
- (face-tag . nil)
- (initialize . custom-group-initialize)
- (apply . custom-group-apply)
- (reset . custom-group-reset)
- (factory-reset . custom-group-factory-reset)
- (extract . nil)
- (validate . custom-group-validate)
- (query . custom-toggle-hide)
- (accept . custom-group-accept)
- (insert . custom-group-insert)
- (find . custom-group-find))
- (toggle (type . choice)
- (data ((type . const)
- (tag . "On ")
- (default . t))
- ((type . const)
- (tag . "Off")
- (default . nil))))
- (choice (type . default)
- (query . custom-choice-query)
- (accept . custom-choice-accept)
- (extract . custom-choice-extract)
- (validate . custom-choice-validate)
- (insert . custom-choice-insert)
- (none (tag . "Unknown")
- (default . __uninitialized__)
- (type . const)))
- (const (type . default)
- (extract . (lambda (c f) (list (custom-default c))))
- (validate . (lambda (c f) nil))
- (valid . custom-const-valid)
- (update . custom-const-update)
- (insert . custom-const-insert))
- (face-doc (type . doc)
- (doc . "\
-You can customize the look of Emacs by deciding which faces should be
-used when. If you push one of the face buttons below, you will be
-given a choice between a number of standard faces. The name of the
-selected face is shown right after the face button, and it is
-displayed its own face so you can see how it looks. If you know of
-another standard face not listed and want to use it, you can select
-`Other' and write the name in the editing field.
-
-If none of the standard faces suits you, you can select `Customize' to
-create your own face. This will make six fields appear under the face
-button. The `Fg' and `Bg' fields are the foreground and background
-colors for the face, respectively. You should type the name of the
-color in the field. You can use any X11 color name. A list of X11
-color names may be available in the file `/usr/lib/X11/rgb.txt' on
-your system. The special color name `default' means that the face
-will not change the color of the text. The `Stipple' field is weird,
-so just ignore it. The three remaining fields are toggles, which will
-make the text `bold', `italic', or `underline' respectively. For some
-fonts `bold' or `italic' will not make any visible change."))
- (face (type . choice)
- (quote . custom-face-quote)
- (export . custom-face-export)
- (import . custom-face-import)
- (data ((tag . "None")
- (default . nil)
- (type . const))
- ((tag . "Default")
- (default . default)
- (face . custom-const-face)
- (type . const))
- ((tag . "Bold")
- (default . bold)
- (face . custom-const-face)
- (type . const))
- ((tag . "Bold-italic")
- (default . bold-italic)
- (face . custom-const-face)
- (type . const))
- ((tag . "Italic")
- (default . italic)
- (face . custom-const-face)
- (type . const))
- ((tag . "Underline")
- (default . underline)
- (face . custom-const-face)
- (type . const))
- ((tag . "Highlight")
- (default . highlight)
- (face . custom-const-face)
- (type . const))
- ((tag . "Modeline")
- (default . modeline)
- (face . custom-const-face)
- (type . const))
- ((tag . "Region")
- (default . region)
- (face . custom-const-face)
- (type . const))
- ((tag . "Secondary Selection")
- (default . secondary-selection)
- (face . custom-const-face)
- (type . const))
- ((tag . "Customized")
- (compact . t)
- (face-tag . custom-face-hack)
- (export . custom-face-export)
- (data ((hidden . t)
- (tag . "")
- (doc . "\
-Select the properties you want this face to have.")
- (default . custom-face-lookup)
- (type . const))
- "\n"
- ((tag . "Fg")
- (hidden . t)
- (default . "default")
- (width . 20)
- (type . string))
- ((tag . "Bg")
- (default . "default")
- (width . 20)
- (type . string))
- ((tag . "Stipple")
- (default . "default")
- (width . 20)
- (type . string))
- "\n"
- ((tag . "Bold")
- (default . nil)
- (type . toggle))
- " "
- ((tag . "Italic")
- (default . nil)
- (type . toggle))
- " "
- ((tag . "Underline")
- (hidden . t)
- (default . nil)
- (type . toggle)))
- (default . (custom-face-lookup "default" "default" "default"
- nil nil nil))
- (type . list))
- ((prompt . "Other")
- (face . custom-field-value)
- (type . symbol))))
- (file (type . string)
- (directory . nil)
- (default-file . nil)
- (query . custom-file-query))
- (sexp (type . default)
- (width . 40)
- (default . (__uninitialized__ . "Uninitialized"))
- (valid . custom-sexp-valid)
- (quote . custom-sexp-quote)
- (read . custom-sexp-read)
- (write . custom-sexp-write))
- (symbol (type . default)
- (width . 40)
- (valid . (lambda (c d) (symbolp d)))
- (quote . custom-symbol-quote)
- (read . custom-symbol-read)
- (write . custom-symbol-write))
- (integer (type . default)
- (width . 10)
- (valid . (lambda (c d) (integerp d)))
- (allow-padding . nil)
- (read . custom-integer-read)
- (write . custom-integer-write))
- (string (type . default)
- (width . 40)
- (valid . (lambda (c d) (stringp d)))
- (read . custom-string-read)
- (write . custom-string-write))
- (button (type . default)
- (accept . ignore)
- (extract . nil)
- (validate . ignore)
- (insert . custom-button-insert))
- (doc (type . default)
- (header . nil)
- (reset . ignore)
- (extract . nil)
- (validate . ignore)
- (insert . custom-documentation-insert))
- (default (width . 20)
- (valid . (lambda (c v) t))
- (insert . custom-default-insert)
- (update . custom-default-update)
- (query . custom-default-query)
- (tag . nil)
- (prompt . nil)
- (doc . nil)
- (header . t)
- (padding . ? )
- (allow-padding . t)
- (quote . identity)
- (export . identity)
- (import . identity)
- (synchronize . ignore)
- (initialize . custom-default-initialize)
- (extract . custom-default-extract)
- (validate . custom-default-validate)
- (apply . custom-default-apply)
- (reset . custom-default-reset)
- (factory-reset . custom-default-factory-reset)
- (accept . custom-default-accept)
- (match . custom-default-match)
- (name . nil)
- (compact . nil)
- (hidden . nil)
- (face . custom-default-face)
- (data . nil)
- (default . __uninitialized__)))
- "Alist of default properties for type symbols.
-The format is `((SYMBOL (PROPERTY . VALUE)... )... )'.")
-
-(defconst custom-local-type-properties nil
- "Local type properties.")
-(make-variable-buffer-local 'custom-local-type-properties)
-
-(defconst custom-nil '__uninitialized__
- "Special value representing an uninitialized field.")
-
-(defun custom-property (custom property)
- "Extract from CUSTOM property PROPERTY."
- (let ((entry (assq property custom)))
- (while (null entry)
- ;; Look in superclass.
- (let ((type (custom-type custom)))
- (setq custom (cdr (or (assq type custom-local-type-properties)
- (assq type custom-type-properties)))
- entry (assq property custom))
- (custom-assert 'custom)))
- (cdr entry)))
-
-(defun custom-property-set (custom property value)
- "Set CUSTOM PROPERY to VALUE by side effect.
-CUSTOM must have at least one property already."
- (let ((entry (assq property custom)))
- (if entry
- (setcdr entry value)
- (setcdr custom (cons (cons property value) (cdr custom))))))
-
-(defun custom-type (custom)
- "Extract `type' from CUSTOM."
- (cdr (assq 'type custom)))
-
-(defun custom-name (custom)
- "Extract `name' from CUSTOM."
- (custom-property custom 'name))
-
-(defun custom-tag (custom)
- "Extract `tag' from CUSTOM."
- (custom-property custom 'tag))
-
-(defun custom-prompt (custom)
- "Extract `prompt' from CUSTOM.
-If none exist, default to `tag' or, failing that, `type'."
- (or (custom-property custom 'prompt)
- (custom-property custom 'tag)
- (capitalize (symbol-name (custom-type custom)))))
-
-(defun custom-default (custom)
- "Extract `default' from CUSTOM."
- (custom-property custom 'default))
-
-(defun custom-data (custom)
- "Extract the `data' from CUSTOM."
- (custom-property custom 'data))
-
-(defun custom-documentation (custom)
- "Extract `doc' from CUSTOM."
- (custom-property custom 'doc))
-
-(defun custom-width (custom)
- "Extract `width' from CUSTOM."
- (custom-property custom 'width))
-
-(defun custom-compact (custom)
- "Extract `compact' from CUSTOM."
- (custom-property custom 'compact))
-
-(defun custom-padding (custom)
- "Extract `padding' from CUSTOM."
- (custom-property custom 'padding))
-
-(defun custom-allow-padding (custom)
- "Extract `allow-padding' from CUSTOM."
- (custom-property custom 'allow-padding))
-
-(defun custom-valid (custom value)
- "Non-nil if CUSTOM may legally be set to VALUE."
- (funcall (custom-property custom 'valid) custom value))
-
-(defun custom-import (custom value)
- "Import CUSTOM VALUE from external variable."
- (funcall (custom-property custom 'import) value))
-
-(defun custom-quote (custom value)
- "Quote CUSTOM's VALUE if necessary."
- (funcall (custom-property custom 'quote) value))
-
-(defun custom-write (custom value)
- "Convert CUSTOM VALUE to a string."
- (if (eq value custom-nil)
- ""
- (funcall (custom-property custom 'write) custom value)))
-
-(defun custom-read (custom string)
- "Convert CUSTOM field content STRING into external form."
- (funcall (custom-property custom 'read) custom string))
-
-(defun custom-match (custom values)
- "Match CUSTOM with a list of VALUES.
-Return a cons-cell where the car is the sublist of VALUES matching CUSTOM,
-and the cdr is the remaining VALUES."
- (if (memq values (list custom-nil nil))
- (cons custom-nil nil)
- (funcall (custom-property custom 'match) custom values)))
-
-(defun custom-initialize (custom)
- "Initialize `doc' and `default' attributes of CUSTOM."
- (funcall (custom-property custom 'initialize) custom))
-
-(defun custom-find (custom tag)
- "Find child in CUSTOM with `tag' TAG."
- (funcall (custom-property custom 'find) custom tag))
-
-(defun custom-travel-path (custom path)
- "Find decedent of CUSTOM by looking through PATH."
- (if (null path)
- custom
- (custom-travel-path (custom-find custom (car path)) (cdr path))))
-
-(defun custom-field-extract (custom field)
- "Extract CUSTOM's value in FIELD."
- (if (stringp custom)
- nil
- (funcall (custom-property (custom-field-custom field) 'extract)
- custom field)))
-
-(defun custom-field-validate (custom field)
- "Validate CUSTOM's value in FIELD.
-Return nil if valid, otherwise return a cons-cell where the car is the
-position of the error, and the cdr is a text describing the error."
- (if (stringp custom)
- nil
- (funcall (custom-property custom 'validate) custom field)))
-
-;;; Field Functions:
-;;
-;; This section defines the public functions for manipulating the
-;; FIELD datatype. The FIELD instance hold information about a
-;; specific editing field in the customization buffer.
-;;
-;; Each FIELD can be seen as an instanciation of a CUSTOM.
-
-(defun custom-field-create (custom value)
- "Create a field structure of type CUSTOM containing VALUE.
-
-A field structure is an array [ CUSTOM VALUE ORIGINAL START END ], where
-CUSTOM defines the type of the field,
-VALUE is the current value of the field,
-ORIGINAL is the original value when created, and
-START and END are markers to the start and end of the field."
- (vector custom value custom-nil nil nil))
-
-(defun custom-field-custom (field)
- "Return the `custom' attribute of FIELD."
- (aref field 0))
-
-(defun custom-field-value (field)
- "Return the `value' attribute of FIELD."
- (aref field 1))
-
-(defun custom-field-original (field)
- "Return the `original' attribute of FIELD."
- (aref field 2))
-
-(defun custom-field-start (field)
- "Return the `start' attribute of FIELD."
- (aref field 3))
-
-(defun custom-field-end (field)
- "Return the `end' attribute of FIELD."
- (aref field 4))
-
-(defun custom-field-value-set (field value)
- "Set the `value' attribute of FIELD to VALUE."
- (aset field 1 value))
-
-(defun custom-field-original-set (field original)
- "Set the `original' attribute of FIELD to ORIGINAL."
- (aset field 2 original))
-
-(defun custom-field-move (field start end)
- "Set the `start'and `end' attributes of FIELD to START and END."
- (set-marker (or (aref field 3) (aset field 3 (make-marker))) start)
- (set-marker (or (aref field 4) (aset field 4 (make-marker))) end))
-
-(defun custom-field-query (field)
- "Query user for content of current field."
- (funcall (custom-property (custom-field-custom field) 'query) field))
-
-(defun custom-field-accept (field value &optional original)
- "Accept FIELD VALUE.
-If optional ORIGINAL is non-nil, concider VALUE for the original value."
- (funcall (custom-property (custom-field-custom field) 'accept)
- field value original))
-
-(defun custom-field-face (field)
- "The face used for highlighting FIELD."
- (let ((custom (custom-field-custom field)))
- (if (stringp custom)
- nil
- (funcall (custom-property custom 'face) field))))
-
-(defun custom-field-update (field)
- "Update content of FIELD."
- (let ((custom (custom-field-custom field)))
- (if (stringp custom)
- nil
- (funcall (custom-property custom 'update) field))))
-
-;;; Types:
-;;
-;; The following functions defines type specific actions.
-
-(defun custom-repeat-accept (field value &optional original)
- "Enter content of editing FIELD."
- (let ((values (copy-sequence (custom-field-value field)))
- (all (custom-field-value field))
- (start (custom-field-start field))
- current new)
- (if original
- (custom-field-original-set field value))
- (while (consp value)
- (setq new (car value)
- value (cdr value))
- (if values
- ;; Change existing field.
- (setq current (car values)
- values (cdr values))
- ;; Insert new field if series has grown.
- (goto-char start)
- (setq current (custom-repeat-insert-entry field))
- (setq all (custom-insert-before all nil current))
- (custom-field-value-set field all))
- (custom-field-accept current new original))
- (while (consp values)
- ;; Delete old field if series has scrunk.
- (setq current (car values)
- values (cdr values))
- (let ((pos (custom-field-start current))
- data)
- (while (not data)
- (setq pos (previous-single-property-change pos 'custom-data))
- (custom-assert 'pos)
- (setq data (get-text-property pos 'custom-data))
- (or (and (arrayp data)
- (> (length data) 1)
- (eq current (aref data 1)))
- (setq data nil)))
- (custom-repeat-delete data)))))
-
-(defun custom-repeat-insert (custom level)
- "Insert field for CUSTOM at nesting LEVEL in customization buffer."
- (let* ((field (custom-field-create custom nil))
- (add-tag (custom-property custom 'add-tag))
- (del-tag (custom-property custom 'del-tag))
- (start (make-marker))
- (data (vector field nil start nil)))
- (custom-text-insert "\n")
- (let ((pos (point)))
- (custom-text-insert (custom-property custom 'prefix))
- (custom-tag-insert add-tag 'custom-repeat-add data)
- (set-marker start pos))
- (custom-field-move field start (point))
- (custom-documentation-insert custom)
- field))
-
-(defun custom-repeat-insert-entry (repeat)
- "Insert entry at point in the REPEAT field."
- (let* ((inhibit-point-motion-hooks t)
- (inhibit-read-only t)
- (before-change-functions nil)
- (after-change-functions nil)
- (custom (custom-field-custom repeat))
- (add-tag (custom-property custom 'add-tag))
- (del-tag (custom-property custom 'del-tag))
- (start (make-marker))
- (end (make-marker))
- (data (vector repeat nil start end))
- field)
- (insert-before-markers "\n")
- (backward-char 1)
- (set-marker start (point))
- (custom-text-insert " ")
- (aset data 1 (setq field (custom-insert (custom-data custom) nil)))
- (custom-text-insert " ")
- (set-marker end (point))
- (goto-char start)
- (custom-text-insert (custom-property custom 'prefix))
- (custom-tag-insert add-tag 'custom-repeat-add data)
- (custom-text-insert " ")
- (custom-tag-insert del-tag 'custom-repeat-delete data)
- (forward-char 1)
- field))
-
-(defun custom-repeat-add (data)
- "Add list entry."
- (let ((parent (aref data 0))
- (field (aref data 1))
- (at (aref data 2))
- new)
- (goto-char at)
- (setq new (custom-repeat-insert-entry parent))
- (custom-field-value-set parent
- (custom-insert-before (custom-field-value parent)
- field new))))
-
-(defun custom-repeat-delete (data)
- "Delete list entry."
- (let ((inhibit-point-motion-hooks t)
- (inhibit-read-only t)
- (before-change-functions nil)
- (after-change-functions nil)
- (parent (aref data 0))
- (field (aref data 1)))
- (delete-region (aref data 2) (1+ (aref data 3)))
- (custom-field-untouch (aref data 1))
- (custom-field-value-set parent
- (delq field (custom-field-value parent)))))
-
-(defun custom-repeat-match (custom values)
- "Match CUSTOM with VALUES."
- (let* ((child (custom-data custom))
- (match (custom-match child values))
- matches)
- (while (not (eq (car match) custom-nil))
- (setq matches (cons (car match) matches)
- values (cdr match)
- match (custom-match child values)))
- (cons (nreverse matches) values)))
-
-(defun custom-repeat-extract (custom field)
- "Extract list of childrens values."
- (let ((values (custom-field-value field))
- (data (custom-data custom))
- result)
- (if (eq values custom-nil)
- ()
- (while values
- (setq result (append result (custom-field-extract data (car values)))
- values (cdr values))))
- result))
-
-(defun custom-repeat-validate (custom field)
- "Validate children."
- (let ((values (custom-field-value field))
- (data (custom-data custom))
- result)
- (if (eq values custom-nil)
- (setq result (cons (custom-field-start field) "Uninitialized list")))
- (while (and values (not result))
- (setq result (custom-field-validate data (car values))
- values (cdr values)))
- result))
-
-(defun custom-pair-extract (custom field)
- "Extract cons of childrens values."
- (let ((values (custom-field-value field))
- (data (custom-data custom))
- result)
- (custom-assert '(eq (length values) (length data)))
- (custom-assert '(eq (length values) 2))
- (while values
- (setq result (append result
- (custom-field-extract (car data) (car values)))
- data (cdr data)
- values (cdr values)))
- (custom-assert '(null data))
- (list (cons (nth 0 result) (nth 1 result)))))