]> code.delx.au - gnu-emacs/blobdiff - vms/make-mms-derivative.el
(note_mode_line_or_margin_highlight): Fix :pointer
[gnu-emacs] / vms / make-mms-derivative.el
index 390d08d3dd494c269f8ca5c4f2afc6eab1a13160..666ca4ae657188a6ac4c3220ecb229b3a4379934 100644 (file)
@@ -55,7 +55,7 @@
 
 ;;; Code:
 
-(defvar make-mms-derivative-root-dir "~/build/GNU/emacs"
+(defvar make-mms-derivative-root-dir "AXPA:[TTN.EMACS.EMACS212_3]"
   "Source tree root directory.")
 
 (defvar make-mms-derivative-data nil
 
 (defun make-mms-derivative-load-edits-file (name)
   (make-mms-derivative-data 'edits-filename name)
-  (let ((i 0) tmp res)
-    (while (progn
-             (setq tmp
-                   (shell-command-to-string
-                    (format "grep '^;;;%s;;' %s | sed 's/^;;;[0-9][0-9]*;;//g'"
-                            i name)))
-             (not (string= "" tmp)))
-      (setq res (cons (cons i tmp) res)
-            i (1+ i)))
-    (make-mms-derivative-data 'raw-data res))
+  (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)
   (interactive "fSource File: ")
   (let ((root (expand-file-name make-mms-derivative-root-dir))
         (file (expand-file-name file)))
-    (unless (string-match (concat "^" root) file)
+    (when (file-name-absolute-p (file-relative-name file root))
       (error "Not under root (%s)" root))
     (let ((edits-filename (concat file "-2mms")))
       (unless (file-exists-p edits-filename)
         (error "Could not find %s" edits-filename))
-      (let* ((pre (+ (length root) (if (string= "/" (substring root -1)) 0 1)))
-             (buf (get-buffer-create (format "*mms-derivative: %s"
-                                             (substring file pre)))))
+      (let ((buf (get-buffer-create
+                 (format "*mms-derivative: %s"
+                         (file-relative-name file root)))))
         (message "Munging ...")
         (switch-to-buffer buf)
         (erase-buffer)