;ELC ;;; compiled by ckclark@major.MIT.EDU on Tue Aug 3 03:11:11 1993 ;;; from file /afs/sipb.mit.edu/contrib/emacs/elisp19/edb/db-types.el ;;; emacs version 19.16.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "This file was compiled for Emacs 19")) (defvar db-use-completing-read t "\ *Non-nil if EDB should use `completing-read' when reading enumerated types. Otherwise, on erroneous enumeration input, EDB shows the possible completions but doesn't correct the input.") (defvar db-enum-ignore-case t "\ If non-nil, assume that any association lists created from enumeration types input names are to include both upper and lower case versions of the name, if distinct.") (defalias 'define-displaytype-from-optstring #[(typename optstring) "; ! #\")" [typename intern make-displayspec-from-type-and-options nil optstring t displayspec define-displaytype-from-displayspec] 4 "\ Define a displaytype named TYPENAME according to OPTSTRING. TYPENAME is a symbol or string and OPTSTRING is the optional parameters part of a display specification string."]) (defalias 'define-displaytype-from-displayspec #[(typename displayspec) " B\nB" [typename displayspec db-displaytypes] 2 "\ Define a displaytype named TYPENAME (a symbol) with the default DISPLAYSPEC. DISPLAYSPEC may also be a typename symbol itself."]) (put (quote define-displaytype-from-displayspec) (quote lisp-indent-hook) 1) (defalias 'define-recordfieldtype-from-recordfieldspec #[(typename recordfieldspec) " B\nB" [typename recordfieldspec db-recordfieldtypes] 2 "\ Define a recordfieldtype named TYPENAME (a symbol) with the default RECORDFIELDSPEC. DISPLAYSPEC may also be a typename symbol itself. After this call, `recordfieldtype->recordfieldspec' called with argument TYPENAME returns the proper record field specification."]) (byte-code "#M\"M\"" [put define-recordfieldtype-from-recordfieldspec lisp-indent-hook 1 define-displaytype-alias define-displaytype-from-displayspec make-obsolete define-recordfieldtype-alias] 4) (defalias 'define-type-alias #[(alias typename) " \n\" \n\"" [define-displaytype-from-displayspec alias typename define-recordfieldtype-from-recordfieldspec] 3 "\ Make symbol ALIAS refer to the same displaytype and recordfieldtype as TYPENAME."]) (defalias (quote define-one-char-enum-displaytype) #[(typename alternatives optstring) "!" [error "define-one-char-enum-displaytype isn't defined yet"] 2]) (defalias 'define-enum-type #[(typename alternatives &optional optstring) "; !‰ ! @ A@ AA@\n# I \"I \"I \") II\"I\"II\"I\"I\"I\"-" [typename intern nil db-enum-process-alternatives alternatives processed-alternatives a->s a->d d->a make-displayspec-from-type-and-options optstring t ds 2 12 db-enum-make-display->actual 11 db-enum-make-actual->display define-displaytype-from-displayspec make-recordfieldspec rs 1 "" 5 make-enum-member-orderer 6 make-enum-member-sorter 7 string-match-function 8 db-enum-make-help-info 9 db-enum-make-actual->stored 10 db-enum-make-stored->actual define-recordfieldtype-from-recordfieldspec] 6 "\ Make TYPENAME (a symbol or string) an enumerated type. Both a displaytype and a recordfieldtype are created. ALTERNATIVES is a list. Each alternative is a list of up to four components: the internal representation, any constant Lisp object, often a string; the input representation typed by the user to specify this alternative, a string or list of strings (for multiple input representations); the display representation, a string; and the file storage representation, a string. If the input representation is omitted and the internal representation is a string, that string is used. If the display representation is omitted, it defaults to the first input representation. The display representation is automatically also a valid input representation. If the file storage representation is omitted, it defaults to the display representation. If all the other components are omitted, the internal representation string may be used in place of a one-element list containing just it. Optional argument OPTSTRING is a displayspec option string."]) (byte-code "M\"\"\"\"\"\"\"\"\"\" III\") \"I\"I\"I\"I\"I\"I\"I\"I\"\") III\") \"I\"I\"I\"I\"I\"I\"I\"\")\"\" III\") \"I\"I\"I\"I\"I\"I\"I\"I\"\") III\") \"I\"I\"I\"I\"I\"I\"@I\"\")ڇ" [define-alternative-multi-char-displaytype define-enum-type defalias db-enum-process-alternatives #[(alternatives) " \n  @<+ - C@ A@8 s a->d dinput->a d->a alternatives 3 mapcar #[(irep) " B" [irep internal] 2]] 11] db-enum-make-help-info #[(type d->a) "!\nq  !\"! \"! \n!+" [get-buffer-create " *temp*" buf standard-output erase-buffer princ format "%s: an enumerated type. " symbol-name type display-completion-list all-completions "" d->a buffer-string kill-buffer] 6] db-enum-make-display->actual #[(type d->a) " DDFE" [lambda (input-rep) db-enum-do-completions input-rep quote type d->a] 7] db-enum-do-completions #[(input-rep type d->a) " \n\" A~  \n\")\n\") A}0!\nR\"\nF% \n\"A}b!!q֐l\n\"!{ڂ|!*)" [assoc input-rep d->a assoc-hit db-enum-ignore-case completion-ignore-case try-completion try-comp dbf-set-this-field-text "" db-use-completing-read completing-read format "Enter \"%s\" enum value (? for list): " type nil t use-electric-help-p require ehelp with-electric-help #[nil "\n \"!" [display-completion-list all-completions try-comp "" d->a] 4] "*Help*" display-completion-list all-completions error "Not unique." "No match."] 7] db-enum-make-actual->display #[(typename a->d) "DEDE" [lambda (enum-val) cdr assoc enum-val quote a->d] 7] db-enum-make-actual->stored #[(typename a->s) "DEDE" [a->s lambda (enum-val) cdr assoc enum-val quote] 7] db-enum-make-stored->actual #[(typename a->s) "DEDE" [a->s lambda (stored-val) car db-rassoc stored-val quote] 7] make-enum-member-orderer #[(type a->d) " \n%" [make-enum-member-orderer-internal type a->d -1 0 1] 6] make-enum-member-sorter #[(type a->d) " \nĉ%" [make-enum-member-orderer-internal type a->d t nil] 6] make-enum-member-orderer-internal #[(type a->d less-value equal-value greater-value) " DD DEѯDѯDFFFFE" [lambda (item1 item2) if (equal item1 item2) equal-value let alt-alist quote a->d result alt-item while (setq alt-item (car alt-alist)) cond (equal (car alt-item) item1) setq less-value nil (equal (car alt-item) item2) greater-value (t (setq alt-alist (cdr alt-alist)))] 18] make-displayspec ds 2 nil 11 int-to-string 12 string-to-int define-displaytype-from-displayspec integer make-recordfieldspec rs 1 0 9 10 5 number-order 6 < 7 = 8 "An integer." define-recordfieldtype-from-recordfieldspec number-or-nil->string string->integer-or-nil integer-or-nil number-or-nil-order-nil-greatest equal "An integer, or nil." string-or-nil->number-or-nil #[(string-or-nil) "!" [string-or-nil string->number-or-nil] 2] make-obsolete string-or-nil->integer-or-nil number-to-string string-to-number number "A number." string->number-or-nil number-or-nil "A number, or nil."] 4) (defalias 'number-order #[(a b) " U‡ WÇć" [a b 0 -1 1] 2 "\ Return -1, 0, or 1 depending on whether A < B, A = B, or A > B."]) (defalias 'number-or-nil-order-nil-greatest #[(a b) "  \"Ç ćŇ" [a b number-order -1 1 0] 3 "\ Like number-order, but nil is treated as greater than any integer. This puts nil after integers in an increasing list."]) (defalias 'number-or-nil-order-nil-least #[(a b) "  \"Ç ćŇ" [a b number-order 1 -1 0] 3 "\ Like number-order, but nil is treated as smaller than any integer. This puts nil after integers in a decreasing list."]) (byte-code " I ĉI I I I \")  I I I I I I I I \")\"\"\"\"\"\"\" I I I I \")  I I I I I \")!!I I \")!! I \")!!I \")!! I I I I \")!!I \")!! I \")!!I \")!! I I I I \")Ç" [make-displayspec ds 2 nil 3 4 11 boolean->yes-no-string 12 yes-no-string->boolean define-displaytype-from-displayspec yes-no make-recordfieldspec rs 1 boolean 9 boolean->yn-string 10 yn-string->boolean 5 boolean-order-function 6 boolean-lessp 7 eq 8 "A boolean value." define-recordfieldtype-from-recordfieldspec defalias #[(boolean) "‡" [boolean "Yes" "No"] 1] #[(yes-or-no) "˜  ʳ\")" [yes-or-no downcased-yes-or-no "yes" t "no" nil error "`%s' is not `Yes' or `No'."] 4] #[(boolean) "‡" [boolean "Y" "N"] 1] #[(y-or-n) "" [y-or-n "y"] 2] string-is-yn-p #[(string) "GU˜ØĘŘ" [string 1 "Y" "y" "N" "n"] 2] #[(bool1 bool2) "  ‡Çć" [bool1 bool2 0 -1 1] 1] #[(bool1 bool2) "? " [bool1 bool2] 1] t 13 string-match-actual->display 14 string-match-display->actual string "" string-order-ci string-lessp-ci string-match-function copy-sequence displaytype->displayspec one-line-string recordfieldtype->recordfieldspec string-or-nil->string string-or-nil string-or-nil-order-ci string-or-nil-lessp-ci string-or-nil-match-function string->nil-or-string nil-or-string one-line-string-or-nil] 4) (defalias 'string-lessp-ci #[(string1 string2) " " [string1 string2] 2 "\ Case-insensitive version of string-lessp."]) (defalias 'string-order-ci #[(string1 string2) " \nĂ \nł*" [string1 string2 s2 s1 0 -1 1] 3 "\ Return -1, 0, or 1 depending on whether STRING1 is lexicographically less than, equal to, or greater than STRING2. Case-insensitive."]) (byte-code "!!\"\"\"\"\"\"\"\"\"\"\"\"\"" [boundp dbm-string-regexp-prefix "^[ ]*\\(/\\|regexp[ ]+\\)" dbm-string-regexp-prefix-string "/" defalias make-regexp-pattern #[(regexp) "D" [regexp] 2] regexp-pattern-regexp #[(regexp-pattern) "A@" [regexp-pattern] 1] make-string-pattern #[(string &optional regexp) " !E" [string regexp regexp-quote] 3] string-pattern-regexp #[(string-pattern) "A@" [string-pattern] 1] string-pattern-string #[(string-pattern) "AA@" [string-pattern] 1] string-match-function #[(pattern string) " ;\n A@\n\"" [string-match pattern string] 3] string-match-display->actual #[(string) " \n\"\nĕO!\n!" [string-match dbm-string-regexp-prefix string make-regexp-pattern 0 nil make-string-pattern] 4] string-match-actual->display #[(pattern) "@= !@= !P\"" [pattern string string-pattern-string regexp dbm-string-regexp-prefix-string regexp-pattern-regexp error "string-match-actual->display: bad pattern %s"] 3] string-or-nil->string #[(s-o-n) "" [s-o-n ""] 1] string-or-nil-lessp-ci #[(s-o-n-1 s-o-n-2) "\n! !\"" [string-lessp-ci string-or-nil->string s-o-n-1 s-o-n-2] 4] string-or-nil-order-ci #[(s-o-n-1 s-o-n-2) "  \"" [string-order-ci s-o-n-1 "" s-o-n-2] 3] string-or-nil-match-function #[(pattern s-o-n) " ;\n   A@ \"" [string-match pattern "" s-o-n] 3] string->nil-or-string #[(string) "?" [string ""] 2]] 3) (defalias 'order-last-names #[(last-name-1 last-name-2) " ‡! !ćŇ" [last-name-1 last-name-2 0 canonicalize-name -1 1] 3 "\ Return -1, 0, or 1 depending on whether LAST-NAME-1 is lexographically less than, equal to, or greater than LAST-NAME-2."]) (byte-code "\"\"" [defalias canonicalize-name #[(last-name) " \" ʼnOP ŕO P)" ["" result string-match "[ ']+" last-name 0 nil] 4] make-obsolete make-name-comparable] 3) (defconst nicknames (quote (("Abraham" "Abe") ("Charles" "Charlie") ("David" "Dave") ("Elizabeth" "Beth" "Liz") ("Gerald" "Gerry") ("James" "Jamey" "Jamie") ("Leonard" "Lenny") ("Michael" "Mike") ("Richard" "Dick" "Dicky" "Rick" "Ricky" "Rico") ("Robert" "Bob") ("Theodore" "Ted"))) "\ List of nicknames which are not prefixes of the full name. It is by no means comprehensive.") (byte-code "\"\"\"\"!\n\"\"!0!9!KE#\"" [defalias same-first-name-p #[(fname1 fname2) " \n\" \n \"" [nicknamep fname1 fname2] 3] nicknamep #[(nickname fullname) " !P \" !@\"A" [string-match "^" regexp-quote nickname fullname assoc db-string-split-first-word nicknames] 4] order-first-names #[(first-name-1 first-name-2) " !\n! @ @\" \n\"Ƃ) @ @(ǂ)*" [db-string-split-first-word first-name-1 first-name-2 first-middle-2 first-middle-1 same-first-name-p 0 -1 1] 3] standardize-name #[(name) "P \" ĕO \"O \". ȔO ȔOQ " [string-match "^\\(\\(Dr\\|Mrs?\\|Prof\\|1?Lt\\)\\.?" "\\|Miss\\|Ensign\\|Doctor\\) " name 0 nil ",? \\(PhD\\|MD\\|Esq\\.?\\|Esquire\\)$" "\\(^\\| \\)[A-Z]\\([ ,]\\|$\\)" 2 "."] 5] boundp jr-assoc-list (("3d" . "3rd")) name->name-jr #[(name) "\n\"#\nÉO\nĔO\"A )D\nD" [string-match ",? +\\(jr\\.?\\|sr\\.?\\|3r?d\\|[45]th\\|I+\\)$" name 0 1 nil jr assoc jr-assoc-list ""] 4] name->first-last-jr #[(fullname) "\n!! @\" A\"*" [name->name-jr standardize-name fullname name-jr db-string-split-last-word "\\(La\\|de\\) [A-Z-]+" split-names append] 3] UK-postal-code-regexp "[A-Z][0-9][A-Z] ?[0-9][A-Z][0-9]" zip-code-regexp "[0-9][0-9][0-9][0-9][0-9]\\(-?[0-9][0-9][0-9][0-9]\\)?" postal-code-regexp mapconcat identity "[0-9][0-9A-Z]*" "\\|" postal-code-p #[(string) " \n\"" [string-match postal-code-regexp string] 3]] 5) (defvar state-alist (quote (("AK" . "Alaska") ("AL" . "Alabama") ("AR" . "Arkansas") ("AZ" . "Arizona") ("CA" . "California") ("CO" . "Colorado") ("CT" . "Conneticut") ("DC" . "District of Columbia") ("DE" . "Deleware") ("FL" . "Florida") ("GA" . "Georgia") ("GU" . "Guam") ("HI" . "Hawaii") ("ID" . "Idaho") ("IL" . "Illinois") ("IN" . "Indiana") ("IA" . "Iowa") ("KS" . "Kansas") ("KY" . "Kentucky") ("LA" . "Louisiana") ("MA" . "Massachusetts") ("MD" . "Maryland") ("ME" . "Maine") ("MI" . "Michigan") ("MN" . "Minnessota") ("MS" . "Mississippi") ("MO" . "Missouri") ("MT" . "Montana") ("NE" . "Nebraska") ("NH" . "New Hampshire") ("NC" . "North Carolina") ("ND" . "North Dakota") ("NJ" . "New Jersey") ("NM" . "New Mexico") ("NV" . "Nevada") ("NY" . "New York") ("OH" . "Ohio") ("OK" . "Oklahoma") ("OR" . "Oregon") ("PA" . "Pennsylvania") ("PR" . "Puerto Rico") ("RI" . "Rhode Island") ("SC" . "South Carolina") ("SD" . "South Dakota") ("TX" . "Texas") ("TN" . "Tennessee") ("UT" . "Utah") ("VA" . "Virginia") ("VT" . "Vermont") ("WA" . "Washington") ("WI" . "Wisconson") ("WV" . "West Virginia") ("WY" . "Wyoming"))) "\ An alist of ABBREV and FULLNAME of each of the United States, and its territories. Used by \"full-state-name\" and \"abbreviate-state\".") (defalias 'statep #[(string) " !" [full-state-name string] 2 "\ Return non-nil if STRING is a valid state abbreviation."]) (defalias 'full-state-name #[(abbrev) "GU  \"A" [abbrev 2 assoc state-alist] 3 "\ Return the full state name for ABBREV, or nil if not found."]) (defalias 'abbreviate-state #[(state) "\n! \"@" [db-rassoc capitalize state state-alist] 3 "\ Return the postal abbreviation for STATE, or nil if not found."]) (defvar country-list (quote ("Canada" "Israel" "Switzerland" "Japan" "West Germany" "United States" "Zambia")) "\ List of country names. Far from complete.") (defalias (quote countryp) #[(string) " !\n" [capitalize string country-list] 2])