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) |
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 |
|
|