vms/make-mms-derivative.el

   1 ;;; make-mms-derivative.el --- framework to do horrible things for VMS support
   2
   3 ;; Copyright (C) 2003 Free Software Foundation, Inc.
   4
   5 ;; Author: Thien-Thi Nguyen <ttn@gnu.org>
   6 ;; Keywords: maint build vms mms makefile levitte autoconf war-is-a-lose
   7 ;; Favorite-TV-Game-Show: L'Eredità
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; Under OpenVMS the standard make-like program is called MMS, which
  29 ;; looks for an input file in the default directory named DESCRIP.MMS
  30 ;; and runs the DCL command rules therein.  As of 2003, the build
  31 ;; process requires a hand translation of the Makefile.in and related
  32 ;; Emacs-specific methodology to DCL and TPU commands, so to alleviate
  33 ;; this pain, we provide `make-mms-derivative', which given a source
  34 ;; FILENAME (under `make-mms-derivative-root-dir'), inserts the file
  35 ;; contents in a new buffer and loads FILENAME-2mms.  The elisp in the
  36 ;; -2mms file can (do whatever -- it's emacs -- and) arrange to write
  37 ;; out the modified buffer after FILENAME-2mms loading by using:
  38 ;;
  39 ;;  (make-mms-derivative-data 'write-under-root RELATIVE-FILENAME)
  40 ;;
  41 ;; where RELATIVE-FILENAME is something like "src/descrip.mms_in_in".
  42 ;; Over the long run, the convenience procedures provided (see source)
  43 ;; will be augmented by factoring maximally the -2mms files, squeezing
  44 ;; as much algorithm out of those nasty heuristics as possible.  What
  45 ;; makes them nasty is not that they rely on the conventions of the
  46 ;; Emacs makefiles; that's no big deal.  What makes them nasty is that
  47 ;; they rely on the conventions of separately maintained tools (namely
  48 ;; Autoconf 1.11 under OpenVMS and the rest of GNU), and the separation
  49 ;; of conventions is how people drift apart, dragging their software
  50 ;; behind mercilessly.
  51 ;;
  52 ;; In general, codified thought w/o self-synchronization is doomed.
  53 ;; That a generation would eat its young (most discriminatingly, even)
  54 ;; is no reason GNU cannot build around such woe.
  55
  56 ;;; Code:
  57
  58 (defvar make-mms-derivative-root-dir "AXPA:[TTN.EMACS.EMACS212_3]"
  59   "Source tree root directory.")
  60
  61 (defvar make-mms-derivative-data nil
  62   "Alist of data specific to `make-mms-derivative'.")
  63
  64 (defun make-mms-derivative-data (key &optional newval)
  65   (if newval
  66       (setq make-mms-derivative-data
  67             (cons (cons key newval) make-mms-derivative-data))
  68     (cdr (assq key make-mms-derivative-data))))
  69
  70 (defun make-mms-derivative-write-under-root (rel-filename)
  71   (write-file (expand-file-name rel-filename make-mms-derivative-root-dir)))
  72
  73 (defmacro make-mms-derivative-progn (msg &rest body)
  74   `(progn
  75      (message "(%s) %s" (point) ,msg)
  76      ,@body))
  77
  78 (put 'make-mms-derivative-progn 'lisp-indent-function 1)
  79
  80 (defun make-mms-derivative-load-edits-file (name)
  81   (make-mms-derivative-data 'edits-filename name)
  82   (let (raw-data
  83         (cur (current-buffer))
  84         (wbuf (get-buffer-create "*make-mms-derivative-load-edits-file work")))
  85     (set-buffer wbuf)
  86     (insert-file-contents name)
  87     (keep-lines "^;;;[0-9]+;;")
  88     (goto-char (point-max))
  89     (while (re-search-backward "^;;;\\([0-9]+\\);;\\(.*\\)$" (point-min) t)
  90       (let* ((i (string-to-number (match-string 1)))
  91              (line (match-string 2))
  92              (look (assq i raw-data)))
  93         (if look
  94             (setcdr look (cons line (cdr look)))
  95           (setq raw-data (cons (list i line) raw-data)))))
  96     (kill-buffer wbuf)
  97     (set-buffer cur)
  98     (mapcar '(lambda (ent)
  99                (setcdr ent (mapconcat '(lambda (line)
 100                                          (concat line "\n"))
 101                                       (cdr ent)
 102                                       "")))
 103             raw-data)
 104     (make-mms-derivative-data 'raw-data raw-data))
 105   (load name))
 106
 107 (defun make-mms-derivative-insert-raw-data (n)
 108   (insert (cdr (assq n (make-mms-derivative-data 'raw-data)))))
 109
 110 (defun make-mms-derivative (file)
 111   (interactive "fSource File: ")
 112   (let ((root (expand-file-name make-mms-derivative-root-dir))
 113         (file (expand-file-name file)))
 114     (when (file-name-absolute-p (file-relative-name file root))
 115       (error "Not under root (%s)" root))
 116     (let ((edits-filename (concat file "-2mms")))
 117       (unless (file-exists-p edits-filename)
 118         (error "Could not find %s" edits-filename))
 119       (let ((buf (get-buffer-create
 120                   (format "*mms-derivative: %s"
 121                           (file-relative-name file root)))))
 122         (message "Munging ...")
 123         (switch-to-buffer buf)
 124         (erase-buffer)
 125         (make-variable-buffer-local 'make-mms-derivative-data)
 126         (insert-file file)
 127         (make-mms-derivative-load-edits-file edits-filename)
 128         (let ((out (make-mms-derivative-data 'write-under-root)))
 129           (when out (make-mms-derivative-write-under-root out))
 130           (kill-buffer buf)
 131           (unless out (message "Munging ... done")))))))
 132
 133 (provide 'make-mms-derivative)
 134
 135 ;;; arch-tag: a5b08625-3952-4053-be16-296220e27bb0
 136 ;;; make-mms-derivative.el ends here