Mercurial > hg > xemacs-beta
comparison lisp/utils/forms-d2.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 08:45:50 +0200 |
| parents | |
| children | ac2d302a0011 |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:376386a54a3c |
|---|---|
| 1 ;;; forms-d2.el --- demo forms-mode | |
| 2 ;; Keywords: extensions | |
| 3 | |
| 4 ;;; Synched up with: FSF 19.30. | |
| 5 | |
| 6 ;; This sample forms exploit most of the features of forms mode. | |
| 7 | |
| 8 ;; Set the name of the data file. | |
| 9 (setq forms-file "forms-d2.dat") | |
| 10 | |
| 11 ;; Use 'forms-enumerate' to set field names and number thereof. | |
| 12 (setq forms-number-of-fields | |
| 13 (forms-enumerate | |
| 14 '(arch-newsgroup ; 1 | |
| 15 arch-volume ; 2 | |
| 16 arch-issue ; and ... | |
| 17 arch-article ; ... so | |
| 18 arch-shortname ; ... ... on | |
| 19 arch-parts | |
| 20 arch-from | |
| 21 arch-longname | |
| 22 arch-keywords | |
| 23 arch-date | |
| 24 arch-remarks))) | |
| 25 | |
| 26 ;; The following functions are used by this form for layout purposes. | |
| 27 ;; | |
| 28 (defun arch-tocol (target &optional fill) | |
| 29 "Produces a string to skip to column TARGET. Prepends newline if needed. | |
| 30 The optional FILL should be a character, used to fill to the column." | |
| 31 (if (null fill) | |
| 32 (setq fill ? )) | |
| 33 (if (< target (current-column)) | |
| 34 (concat "\n" (make-string target fill)) | |
| 35 (make-string (- target (current-column)) fill))) | |
| 36 ;; | |
| 37 (defun arch-rj (target field &optional fill) | |
| 38 "Produces a string to skip to column TARGET minus the width of field FIELD. | |
| 39 Prepends newline if needed. The optional FILL should be a character, | |
| 40 used to fill to the column." | |
| 41 (arch-tocol (- target (length (nth field forms-fields))) fill)) | |
| 42 | |
| 43 ;; Record filters. | |
| 44 ;; This example uses the (defun ...) method of defining. | |
| 45 ;; | |
| 46 (defun forms-new-record-filter (the-record) | |
| 47 "Form a new record with some defaults." | |
| 48 (aset the-record arch-from (user-full-name)) | |
| 49 (aset the-record arch-date (current-time-string)) | |
| 50 the-record ; return it | |
| 51 ) | |
| 52 | |
| 53 ;; The format list. | |
| 54 (setq forms-format-list | |
| 55 (list | |
| 56 "====== Public Domain Software Archive ======\n\n" | |
| 57 arch-shortname | |
| 58 " - " arch-longname | |
| 59 "\n\n" | |
| 60 "Article: " arch-newsgroup | |
| 61 "/" arch-article | |
| 62 " " | |
| 63 '(arch-tocol 40) | |
| 64 "Issue: " arch-issue | |
| 65 " " | |
| 66 '(arch-rj 73 10) | |
| 67 "Date: " arch-date | |
| 68 "\n\n" | |
| 69 "Submitted by: " arch-from | |
| 70 "\n" | |
| 71 '(arch-tocol 79 ?-) | |
| 72 "\n" | |
| 73 "Keywords: " arch-keywords | |
| 74 "\n\n" | |
| 75 "Parts: " arch-parts | |
| 76 "\n\n====== Remarks ======\n\n" | |
| 77 arch-remarks | |
| 78 )) | |
| 79 | |
| 80 ;; That's all, folks! |