src/hack-buffer-objfwd.el

   1 ;; Rewrite all references to buffer-objfwd fields in struct buffer
   2 ;; to use accessor macros.
   3 ;; This works in a tricky way: it renames all such fields, then
   4 ;; recompiles Emacs.  Then it visits each error location and
   5 ;; rewrites the expressions.
   6 ;; This has a few requirements in order to work.
   7 ;; First, Emacs must compile before the script is run.
   8 ;; It does not handle errors arising for other reasons.
   9 ;; Second, you need a GCC which has been hacked to emit proper
  10 ;; column location even when the -> expression in question has
  11 ;; been wrapped in a macro call.  (This is a one-liner in libcpp.)
  12 ;; After running this script, a few changes need to be made by hand.
  13 ;; These occur mostly in macros in headers, but also in
  14 ;; reset_buffer and reset_buffer_local_variables.  Finally,
  15 ;; DEFVAR_PER_BUFFER and the GC should not use these accessors.
  16
  17 (defvar gcc-prefix "/home/tromey/gnu/Trunk/install/")
  18
  19 (defvar emacs-src "/home/tromey/gnu/Emacs/Gitorious/emacs-mt/src/")
  20 (defvar emacs-build "/home/tromey/gnu/Emacs/Gitorious/build/src/")
  21
  22 (defun file-error (text)
  23   (error "%s:%d:%d: error: expected %s"
  24          buffer-file-name (line-number-at-pos (point))
  25          (current-column)
  26          text))
  27
  28 (defun assert-looking-at (exp)
  29   (unless (looking-at exp)
  30     (file-error exp)))
  31
  32 (defvar field-names nil)
  33
  34 (defvar field-regexp nil)
  35
  36 (defun modify-buffer.h ()
  37   (message "Modifying fields in struct buffer")
  38   (find-file (expand-file-name "buffer.h" emacs-src))
  39   (goto-char (point-min))
  40   (re-search-forward "^struct buffer$")
  41   (forward-line)
  42   (assert-looking-at "^{")
  43   (let ((starting-point (point))
  44         (closing-brace (save-excursion
  45                          (forward-sexp)
  46                          (point))))
  47     ;; Find each field.
  48     (while (re-search-forward "^\\s *Lisp_Object\\s +"
  49                               closing-brace 'move)
  50       (goto-char (match-end 0))
  51       (while (not (looking-at ";"))
  52         (assert-looking-at "\\([A-Za-z0-9_]+\\)\\(;\\|,\\s *\\)")
  53         ;; Remember the name so we can generate accessors.
  54         (push (match-string 1) field-names)
  55         ;; Rename it.
  56         (goto-char (match-beginning 2))
  57         (insert "_")
  58         ;; On to the next one, if any.
  59         (if (looking-at ",\\s *")
  60             (goto-char (match-end 0)))))
  61     ;; Generate accessors.
  62     (goto-char starting-point)
  63     (forward-sexp)
  64     (forward-line)
  65     (insert "\n")
  66     (dolist (name field-names)
  67       (insert "#define BUF_" (upcase name) "(BUF) "
  68               "*find_variable_location (&((BUF)->"
  69               name "_))\n"))
  70     (insert "\n"))
  71   (setq field-regexp (concat "\\(->\\|\\.\\)"
  72                              (regexp-opt field-names t)
  73                              "\\_>"))
  74   (save-buffer))
  75
  76 (defun get-field-name ()
  77   (save-excursion
  78     (assert-looking-at "\\(\\.\\|->\\)\\([A-Za-z0-9_]+\\)\\_>")
  79     (prog1
  80         (match-string 2)
  81       (delete-region (match-beginning 0) (match-end 0)))))
  82
  83 (defun skip-backward-lhs ()
  84   (skip-chars-backward " \t\n")
  85   (cond
  86    ((eq (char-before) ?\])
  87     (file-error "array ref!")
  88     ;; fixme
  89     )
  90    ((eq (char-before) ?\))
  91     ;; A paren expression is preceding.
  92     ;; See if this is just a paren expression or whether it is a
  93     ;; function call.
  94     ;; For now assume that there are no function-calls-via-expr.
  95     (backward-sexp)
  96     (skip-chars-backward " \t\n")
  97     (if (save-excursion
  98           (backward-char)
  99           (looking-at "[A-Za-z0-9_]"))
 100         (backward-sexp)))
 101    ((save-excursion
 102       (backward-char)
 103       (looking-at "[A-Za-z0-9_]"))
 104     (backward-sexp))
 105    (t
 106     (file-error "unhandled case!"))))
 107
 108 (defun do-fix-instance ()
 109   (cond
 110    ((looking-at "->")
 111     (let ((field-name (get-field-name)))
 112       (insert ")")
 113       (backward-char)
 114       (skip-backward-lhs)
 115       (insert "BUF_" (upcase field-name) " (")))
 116    ((eq (char-after) ?.)
 117     (let ((field-name (get-field-name)))
 118       (insert ")")
 119       (backward-char)
 120       (backward-sexp)
 121       (assert-looking-at "\\(buffer_defaults\\|buffer_local_flags\\)")
 122       (insert "BUF_" (upcase field-name) " (&")))
 123    (t
 124     (message "%s:%d:%d: warning: did not see -> or ., probably macro"
 125              buffer-file-name (line-number-at-pos (point))
 126              (current-column)))))
 127
 128 (defun update-header-files ()
 129   (dolist (file (directory-files emacs-src t "h$"))
 130     (message "Applying header changes to %s" file)
 131     (find-file file)
 132     (while (re-search-forward
 133             "\\(current_buffer->\\|buffer_defaults\\.\\)"
 134             nil 'move)
 135       (goto-char (match-end 0))
 136       (skip-chars-backward "->.")
 137       (when (looking-at field-regexp)
 138         (do-fix-instance)))
 139     (goto-char (point-min))
 140     (while (search-forward "XBUFFER (" nil 'move)
 141       (goto-char (- (match-end 0) 1))
 142       (forward-sexp)
 143       ;; This works even for the new #define BUF_ macros
 144       ;; because the field-regexp ends with \_>.
 145       (when (looking-at field-regexp)
 146         (do-fix-instance)))
 147     (save-buffer)))
 148
 149 (defun fix-one-instance (filename line column)
 150   (message "%s:%d:%d: info: fixing instance" filename line column)
 151   (find-file filename)
 152   (goto-char (point-min))
 153   (forward-line (- line 1))
 154   ;; (move-to-column (- column 1))
 155   (forward-char (- column 1))
 156   (do-fix-instance))
 157
 158 (defvar make-accumulation "")
 159
 160 (defvar last-error-line nil)
 161 (defvar error-list nil)
 162
 163 (defun make-filter (process string)
 164   (setq make-accumulation (concat make-accumulation string))
 165   (while (string-match "^[^\n]*\n" make-accumulation)
 166     (let ((line (substring (match-string 0 make-accumulation) 0 -1)))
 167       (setq make-accumulation (substring make-accumulation
 168                                          (match-end 0)))
 169       (message "%s" line)
 170       (if (string-match "^\\([^:]+\\):\\([0-9]+\\):\\([0-9]+\\)+: error:"
 171                         line)
 172           (save-excursion
 173             (let ((file-name (match-string 1 line))
 174                   (line-no (string-to-number (match-string 2 line)))
 175                   (col-no (string-to-number (match-string 3 line))))
 176               ;; Process all errors on a given line in reverse order.
 177               (unless (eq line-no last-error-line)
 178                 (dolist (one-item error-list)
 179                   (apply #'fix-one-instance one-item))
 180                 (setq error-list nil)
 181                 (setq last-error-line line-no))
 182               (push (list file-name line-no col-no) error-list)))))))
 183
 184 (defvar make-done nil)
 185
 186 (defun make-sentinel (process string)
 187   (dolist (one-item error-list)
 188     (apply #'fix-one-instance one-item))
 189   (setq make-done t))
 190
 191 (defun recompile-emacs ()
 192   (let* ((default-directory emacs-build)
 193          (output-buffer (get-buffer-create "*recompile*"))
 194          (make (start-process "make" output-buffer "make" "-k")))
 195     (set-process-filter make #'make-filter)
 196     (set-process-sentinel make #'make-sentinel)
 197     (while (not make-done)
 198       (accept-process-output))))
 199
 200 (modify-buffer.h)
 201 (update-header-files)
 202 (recompile-emacs)
 203 (dolist (buf (buffer-list))
 204   (with-current-buffer buf
 205     (when buffer-file-name
 206       (message "Saving %s" buffer-file-name)
 207       (save-buffer))))