/[emacs]/emacs/vms/make-mms-derivative.el
ViewVC logotype

Diff of /emacs/vms/make-mms-derivative.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.7 by ttn, Tue Mar 22 11:58:28 2005 UTC revision 1.8 by ttn, Wed Mar 23 14:33:57 2005 UTC
# Line 24  Line 24 
24    
25  ;;; Commentary:  ;;; Commentary:
26    
27  ;; Under OpenVMS the standard make-like program is called MMS, which  ;; Under VMS the standard make-like program is called MMS, which looks
28  ;; looks for an input file in the default directory named DESCRIP.MMS  ;; for an input file in the default directory named DESCRIP.MMS and runs
29  ;; and runs the DCL command rules therein.  As of 2005, the build  ;; the DCL command rules therein.  As of 2005, the build process
30  ;; process requires a hand translation of the Makefile.in and related  ;; requires a hand translation of the Makefile.in and Emacs-specific
31  ;; Emacs-specific methodology to DCL and TPU commands, so to alleviate  ;; methodology to DCL and TPU commands, so to alleviate this pain, we
32  ;; this pain, we provide `make-mms-derivative', which given a source  ;; provide `make-mms-derivative', which given a source FILENAME, inserts
33  ;; FILENAME (under `make-mms-derivative-root-dir'), inserts the file  ;; the file contents in a new buffer and loads FILENAME-2mms.  The lisp
34  ;; contents in a new buffer and loads FILENAME-2mms.  The elisp in the  ;; code in the -2mms file can (do whatever -- it's emacs -- and), as
35  ;; -2mms file can (do whatever -- it's emacs -- and) arrange to write  ;; long as it arranges to write out the modified buffer after loading by
36  ;; out the modified buffer after FILENAME-2mms loading by using:  ;; specifying, on a line of its own, the directive:
37  ;;  ;;
38  ;;  (make-mms-derivative-data 'write-under-root RELATIVE-FILENAME)  ;;  :output RELATIVE-OUTPUT
39  ;;  ;;
40  ;; where RELATIVE-FILENAME is something like "src/descrip.mms_in_in".  ;; where RELATIVE-OUTPUT is a filename (a string) relative to FILENAME's
41  ;; Over the long run, the convenience procedures provided (see source)  ;; directory, typically something simple like "descrip.mms_in_in".  Only
42    ;; the first :output directive is recognized.
43    ;;
44    ;; The only other special directive at this time has the form:
45    ;;
46    ;;  :gigo NAME
47    ;;  ;;blah blah blah
48    ;;  ;;(more text here)
49    ;;
50    ;; NAME is anything distinguishable w/ `eq' (number, symbol or keyword).
51    ;; This associates NAME with the block of text starting immediately below
52    ;; the :gigo directive and ending at the first line that does not begin
53    ;; with two semicolons (which are stripped from each line in the block).
54    ;; To insert this block of text, pass NAME to `make-mms-derivative-gigo'.
55    ;;
56    ;; Directives are scanned before normal evaluation, so their placement
57    ;; in the file is not important.  During loading, plain strings are
58    ;; displayed in the echo area, prefixed with the current line number.
59    ;;
60    ;; Over the long run, the convenience functions provided (see source)
61  ;; will be augmented by factoring maximally the -2mms files, squeezing  ;; will be augmented by factoring maximally the -2mms files, squeezing
62  ;; as much algorithm out of those nasty heuristics as possible.  What  ;; as much algorithm out of those nasty heuristics as possible.  What
63  ;; makes them nasty is not that they rely on the conventions of the  ;; makes them nasty is not that they rely on the conventions of the
64  ;; Emacs makefiles; that's no big deal.  What makes them nasty is that  ;; Emacs makefiles; that's no big deal.  What makes them nasty is that
65  ;; they rely on the conventions of separately maintained tools (namely  ;; they rely on the conventions of separately maintained tools (namely
66  ;; Autoconf 1.11 under OpenVMS and the rest of GNU), and the separation  ;; Autoconf for VMS and GNU Autoconf), and the separation of conventions
67  ;; of conventions is how people drift apart, dragging their software  ;; is how people drift apart, dragging their software behind
68  ;; behind mercilessly.  ;; mercilessly.
69  ;;  ;;
70  ;; In general, codified thought w/o self-synchronization is doomed.  ;; In general, codified thought w/o self-synchronization is doomed.
71  ;; That a generation would eat its young (most discriminatingly, even)  ;; That a generation would eat its young (most discriminatingly, even)
# Line 54  Line 73 
73    
74  ;;; Code:  ;;; Code:
75    
 (defvar make-mms-derivative-root-dir "AXPA:[TTN.EMACS.EMACS212_3]"  
   "Source tree root directory.")  
   
76  (defvar make-mms-derivative-data nil  (defvar make-mms-derivative-data nil
77    "Alist of data specific to `make-mms-derivative'.")    "Plist of data specific to `make-mms-derivative'.")
78    
79  (defun make-mms-derivative-data (key &optional newval)  (defun make-mms-derivative-data (key &optional newval)
80    (if newval    (if newval (setq make-mms-derivative-data
81        (setq make-mms-derivative-data                     (plist-put make-mms-derivative-data key newval))
82              (cons (cons key newval) make-mms-derivative-data))      (plist-get make-mms-derivative-data key)))
83      (cdr (assq key make-mms-derivative-data))))  
84    (defun make-mms-derivative-gigo (name)
85  (defmacro make-mms-derivative-progn (msg &rest body)    "Insert the text associated with :gigo NAME."
86    `(progn    (insert (cdr (assq name (make-mms-derivative-data :gigo)))))
87       (message "(%s) %s" (point) ,msg)  
88       ,@body))  (defun make-mms-derivative (filename)
89      "Take FILENAME contents, load FILENAME-2mms, and write out the result.
90  (put 'make-mms-derivative-progn 'lisp-indent-function 1)  The output file is specified by the :output directive in FILENAME-2mms.
91    See commentary of make-mms-derivative.el for full documentation."
 (defun make-mms-derivative-load-edits-file (name)  
   (make-mms-derivative-data 'edits-filename name)  
   (let (raw-data  
         (cur (current-buffer))  
         (wbuf (get-buffer-create "*make-mms-derivative-load-edits-file work")))  
     (set-buffer wbuf)  
     (insert-file-contents name)  
     (keep-lines "^;;;[0-9]+;;")  
     (goto-char (point-max))  
     (while (re-search-backward "^;;;\\([0-9]+\\);;\\(.*\\)$" (point-min) t)  
       (let* ((i (string-to-number (match-string 1)))  
              (line (match-string 2))  
              (look (assq i raw-data)))  
         (if look  
             (setcdr look (cons line (cdr look)))  
           (setq raw-data (cons (list i line) raw-data)))))  
     (kill-buffer wbuf)  
     (set-buffer cur)  
     (mapcar (lambda (ent)  
               (setcdr ent (mapconcat (lambda (line)  
                                        (concat line "\n"))  
                                      (cdr ent)  
                                      "")))  
             raw-data)  
     (make-mms-derivative-data 'raw-data raw-data))  
   (load name))  
   
 (defun make-mms-derivative-insert-raw-data (n)  
   (insert (cdr (assq n (make-mms-derivative-data 'raw-data)))))  
   
 (defun make-mms-derivative (file)  
92    (interactive "fSource File: ")    (interactive "fSource File: ")
93    (let ((root (expand-file-name make-mms-derivative-root-dir))    (let* ((todo (let ((fn (concat filename "-2mms")))
94          (file (expand-file-name file)))                   (unless (file-exists-p fn)
95      (when (file-name-absolute-p (file-relative-name file root))                     (error "Could not find %s" fn))
96        (error "Not under root (%s)" root))                   (set-buffer (get-buffer-create " *make-mms-derivative todo*"))
97      (let ((edits-filename (concat file "-2mms")))                   (insert-file-contents fn)
98        (unless (file-exists-p edits-filename)                   (current-buffer)))
99          (error "Could not find %s" edits-filename))           (deriv (get-buffer-create (format "*mms-derivative: %s"
100        (let ((buf (get-buffer-create                                             (file-relative-name filename))))
101                    (format "*mms-derivative: %s"           output gigo form)
102                            (file-relative-name file root)))))      (set-buffer todo)
103          (message "Munging ...")      (re-search-forward "^:output")
104          (switch-to-buffer buf)      (setq output (expand-file-name (read (current-buffer))
105          (erase-buffer)                                     (file-name-directory filename)))
106          (make-variable-buffer-local 'make-mms-derivative-data)      (goto-char (point-min))
107          (insert-file file)      (while (re-search-forward "^:gigo" (point-max) t)
108          (make-mms-derivative-load-edits-file edits-filename)        (let ((name (read (current-buffer)))
109          (let ((out (make-mms-derivative-data 'write-under-root)))              (p (progn (forward-line 1) (point))))
110            (when out          (while (looking-at ";;")
111              (write-file            (delete-char 2)
112               (expand-file-name rel-filename make-mms-derivative-root-dir)))            (forward-line 1))
113            (kill-buffer buf)          (setq gigo (cons (cons name (buffer-substring p (point))) gigo))
114            (unless out (message "Munging ... done")))))))          (delete-region p (point))))
115        (message "Munging...")
116        (switch-to-buffer deriv)
117        (erase-buffer)
118        (insert-file-contents filename)
119        (set (make-local-variable 'make-mms-derivative-data)
120             (list :gigo gigo))
121        (set-buffer todo)
122        (goto-char (point-min))
123        (while (condition-case nil
124                   (setq form (read (current-buffer)))
125                 (end-of-file nil))
126          (if (stringp form)
127              (message "%d: %s" (count-lines (point-min) (point)) form)
128            (save-excursion
129              (set-buffer deriv)
130              (eval form))))
131        (set-buffer deriv)
132        (message "Munging...done")
133        (write-file output)
134        (kill-buffer todo)
135        (kill-buffer deriv)))
136    
137  (provide 'make-mms-derivative)  (provide 'make-mms-derivative)
138    

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26