(setq rolodex-extras '("extra1" "extra2" "extra3" "extra4" "extra5"))

(setq rolodex-fields
      '(name work-phone home-phone company work-address home-address remarks
	     date (birthday . string-or-nil) (anniversary . string-or-nil)))

(let ((extras rolodex-extras))
  (while extras
    (setq rolodex-fields
	  (append rolodex-fields (list (cons (intern
					      (concat (car extras) "-name"))
					     'string-or-nil)
				       (cons (intern 
					      (concat (car extras) "-value"))
					     'string-or-nil))))
    (setq extras (cdr extras))))

(database-set-fieldnames-to-list database rolodex-fields)

(database-set-print-name database "Jik's Rolodex")

(sepinfo-set-sep-function (database-record-sepinfo database) 
			  'rolodex-sep-function)

(defun rolodex-sep-function (last-end)
  (let (this-end)
    (if last-end
	(goto-char (+ last-end 1)))
    (if (re-search-forward ".*\n.*\n.*\n.*\n.*\n.*\n.*\n.*\n\\(.+\n\\)*" nil t)
	(setq this-end (match-end 0))
      (error "Error separating rolodex record."))
    (cons this-end
	  (if (>= (+ this-end 1) (point-max))
	      nil
	    (+ this-end 1)))))

(database-set-read-record-from-region database 'rolodex-rrfr)	

(defun newlines->semis (string)
  (and string (string-replace-regexp-2 string "\n" "; ")))

(defun semis->newlines (string)
  (and string (string-replace-regexp-2 string ";[ \t]*" "\n")))

(defun match-string (n &optional source)
  "Return the string matched by parentheses number N.  If there is a
SOURCE string, return the substring of that string; else, return
substring of the current buffer."
  (cond
   ((stringp source)
    (substring source (match-beginning n) (match-end n)))
   (t (buffer-substring (match-beginning n) (match-end n)))))

(defun rolodex-rrfr ()
  (goto-char (point-min))
  (let ((result-record (make-record database))
	(extras rolodex-extras))
    (if (re-search-forward
	 "\\(.*\\)\n\\(.*\\)\n\\(.*\\)\n\\(.*\\)\n\\(.*\\)\n\\(.*\\)
\\(.*\\)\n\\(.*\\)\n" nil t)
	(let ((name (match-string 1))
	      (work-phone (match-string 2))
	      (home-phone (match-string 3))
	      (company (match-string 4))
	      (work-address (match-string 5))
	      (home-address (match-string 6))
	      (remarks (match-string 7))
	      (date (match-string 8)))
	  (record-set-field result-record 'name database
			    (semis->newlines name))
	  (record-set-field result-record 'work-phone database
			    (semis->newlines work-phone))
	  (record-set-field result-record 'home-phone database
			    (semis->newlines home-phone))
	  (record-set-field result-record 'company database
			    (semis->newlines company))
	  (record-set-field result-record 'work-address database
			    (semis->newlines work-address))
	  (record-set-field result-record 'home-address database
			    (semis->newlines home-address))
	  (record-set-field result-record 'remarks database
			    (semis->newlines remarks))
	  (record-set-field result-record 'date database
			    (semis->newlines date))
	  (while (and extras (re-search-forward "\\(.+\\)\n" nil t))
	    (let ((extra (match-string 1)))
	      (cond ((string-match "^Birthday:[ \t]*\\(.*\\)" extra)
		     (record-set-field 
		      result-record 'birthday database
		      (semis->newlines (match-string 1 extra))))
		    ((string-match "^Anniversary:[ \t]*\\(.*\\)" extra)
		     (record-set-field
		      result-record 'anniversary database
		      (semis->newlines (match-string 1 extra))))
		    ((string-match "^\\([^:]+\\):[ \t]*\\(.*\\)" extra)
		     (let ((field-name (match-string 1 extra))
			   (field-value (match-string 2 extra)))
		       (record-set-field result-record 
					 (intern (concat (car extras) "-name"))
					 database field-name)
		       (record-set-field result-record
					 (intern (concat (car extras)
							 "-value"))
					 database 
					 (semis->newlines field-value))
		       (setq extras (cdr extras))))
		    (t
		     (error "Invalid extra field parsing rolodex record."))))))
      (error "Error parsing rolodex record."))
    result-record))

(database-set-write-region-from-record database 'rolodex-wrfr)
(sepinfo-set-post-last-string (database-record-sepinfo database) "\n")

(defun empty-string-or-nil-p (string-or-nil)
  "Return t if its argument is nil or a zero-length string, nil otherwise."
  (or (not string-or-nil)
      (string-equal "" string-or-nil)))

(defun rolodex-wrfr (record)
  (insert (newlines->semis (record-field record 'name database)) "\n"
	  (newlines->semis (record-field record 'work-phone database)) "\n"
	  (newlines->semis (record-field record 'home-phone database)) "\n"
	  (newlines->semis (record-field record 'company database)) "\n"
	  (newlines->semis (record-field record 'work-address database)) "\n"
	  (newlines->semis (record-field record 'home-address database)) "\n"
	  (newlines->semis (record-field record 'remarks database)) "\n"
	  (newlines->semis (record-field record 'date database)) "\n")
  (let ((extras rolodex-extras)
	(birthday (record-field record 'birthday database))
	(anniversary (record-field record 'anniversary database)))
    (if (not (empty-string-or-nil-p birthday)) (insert "Birthday: "
			 (newlines->semis birthday) "\n"))
    (if (not (empty-string-or-nil-p anniversary)) (insert "Anniversary: " 
			    (newlines->semis anniversary) "\n"))
    (while extras
      (let ((extra-name (record-field record (intern (concat (car extras)
							     "-name"))
				      database))
	    (extra-value (record-field record (intern (concat (car extras)
							      "-value"))
				       database)))
	(if (not (and (empty-string-or-nil-p extra-name)
		      (empty-string-or-nil-p extra-value)))
	    (insert extra-name ": " (newlines->semis extra-value) "\n")))
      (setq extras (cdr extras)))))

(defun rolodex-before-display (record)
  (let ((width rolodex-min-field-width)
	(extras rolodex-extras))
    (while extras
      (let ((name (record-field record (intern (concat (car extras) "-name"))
				dbc-database)))
	(if (and (not (empty-string-or-nil-p name))
		 (> (length name) width))
	    (setq width (length name))))
      (setq extras (cdr extras)))
    (setq tab-width (+ width 2))))

(setq dbf-before-display-record-function 'rolodex-before-display)

; I could cache some state in the record so that I only have to
; redisplay it if the tab width actually changes, or only if the field
; being changed is one of the extra fields' names, but it isn't worth
; the effort.

(defun rolodex-change-function (field old new)
  (rolodex-before-display dbf-this-record)
  t)

(setq dbf-every-change-function 'rolodex-change-function)

(defun rolodex-change-date (field old new)
  (dbf-this-record-set-field 'date (current-time-string)))

(setq dbf-first-change-function 'rolodex-change-date)