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