;; Rewrite DEFVAR_LISP variables.
;; Compatibility defines are added to globals.h.
;; Invoke as:  emacs --script rewrite-globals.el

(defvar defvar-list '())

(defvar global-text-list '())

(defvar variables-written '())

(defun error-at (text)
  (save-buffer)
  (error "%s:%d: %s"
	 (buffer-file-name)
	 (line-number-at-pos (point))
	 text))

(defun message-at (text)
  (save-buffer)
  (message "%s:%d: %s"
	   (buffer-file-name)
	   (line-number-at-pos (point))
	   text))

(defun extract-defvars ()
  "Extract DEFVAR_{LISP,INT,BOOL} variable names for later processing.
Also, rewrite DEFVAR invocations to remove the `&' from the 2nd arg."
  (let ((case-fold-search nil))
    (while (re-search-forward "^[^#*]*\\(DEFVAR_[A-Z_]*\\)" nil 'move)
      (let ((kind (match-string 1)))
	(unless (member kind '("DEFVAR_KBOARD" "DEFVAR_PER_BUFFER"))
	  ;; Skip the paren and the first argument.
	  (skip-chars-forward " (")
	  (forward-sexp)
	  (skip-chars-forward ", \t\n")
	  ;; `...' and `no_cell' are special -- they mean that
	  ;; this is a phony DEFVAR.
	  ;; buffer_defaults will have to be handled separately.
	  (unless (looking-at "\\(no_cell\\|\\.\\.\\.\\|&buffer_defaults[^,]*\\),")
	    (if (looking-at "&\\(\\_<\\(\\sw\\|\\s_\\)+\\_>\\)")
		(let ((var-name (match-string 1)))
		  ;; This would improve safety but it interferes with
		  ;; buffer_defaults.
		  ;; (delete-char 1)
		  ;; (insert "f_")
		  (push var-name defvar-list)))))))))

(defun maybe-extract-comment ()
  (let ((here (point)))
    (skip-chars-backward " \t\n")
    (backward-char 2)
    (if (looking-at "[*]/")
	(progn
	 (search-backward "/*" nil 'move)
	 (if (bobp)
	     ""
	   (let ((result (buffer-substring (point) here)))
	     (delete-region (point) here)
	     result)))
      (goto-char here)
      "")))

(defun munge-V ()
  (interactive)
  (while (re-search-forward "^\\(extern \\|static \\)?\\(Lisp_Object\\|int\\|EMACS_INT\\) \\([^(;]\\|\n\\)+;" nil 'move)
    (goto-char (match-end 2))
    (forward-char)
    (let ((is-extern (equal (match-string 1) "extern "))
	  (type (match-string 2))
	  (start (match-beginning 0))
	  (this-text "")
	  (this-comment "")
	  (skipped-one nil)
	  (last-start (point))
	  (deleted-last nil))
      (while (not (looking-at ";"))
	(if (and (looking-at "[a-z0-9A-Z_]+")
		 (member (match-string 0) defvar-list))
	    (let ((var-name (match-string 0))
		  (var-start (match-beginning 0))
		  (var-end (match-end 0)))
	      ;; Output to globals.h.
	      (unless is-extern
		(cond
		 ((member var-name variables-written)
		  (message-at "Duplicate seen"))
		 ((string-match "buffer_defaults_" var-name)
		  ;; Ignore.
		  )
		 (t
		  (setq this-text (concat this-text
					  type " " ;; "f_"
					  var-name ";\n"))
		  (push var-name variables-written))))
	      ;; FIXME: must handle comment stuff here too.
	      ;; Remove it and trailing ",".
	      (goto-char var-end)
	      (skip-chars-forward " \t\n,")
	      (delete-region var-start (point))
	      (setq deleted-last t)
	      ;; Leave LAST-START pointing to the same spot.
	      )
	  ;; If the last was a delete, delete the "," before this
	  ;; one.
	  (if deleted-last
	      (delete-region last-start (point)))
	  (setq deleted-last nil)
	  ;; Skip sexps until we hit the next declaration.
	  (while (not (looking-at "[;,]"))
	    (forward-sexp)
	    (skip-chars-forward " \t\n"))
	  (setq skipped-one t)
	  (setq last-start (point)))
	;; Move to the start of the next declaration.
	(skip-chars-forward ", \t\n"))
      (cond
       ((not skipped-one)
	;; If we removed all the individual declarations, then remove
	;; the whole thing.
	(end-of-line)
	(forward-char)
	(delete-region start (point))
	(setq this-comment (maybe-extract-comment)))
       (deleted-last
	;; If the last was a delete, delete the "," now.
	(delete-region last-start (point))))
      ;; Only update the globals when we see the variable's
      ;; definition.
      (if is-extern
	  (if (not (equal this-comment ""))
	      (message "declaration has comment: %s" this-text))
	(push (cons this-comment this-text) global-text-list)))))

(defconst V-dir ".")

(defun no-newlines ()
  (let ((here (point)))
    (skip-chars-backward " \t\n")
    (delete-region (point) here)))

(defun just-one-newline ()
  (no-newlines)
  (insert "\n"))

(defun munge-V-directory ()
  ;; Compute files early to avoid problems with .# files.
  (let ((files (directory-files V-dir t "[ch]$")))

    ;; First extract all defvars.
    (dolist (file files)
      (save-excursion
	(message "Scanning %s" file)
	(find-file file)
	(extract-defvars)
	(save-buffer)))

    (setq defvar-list (delete-dups (sort defvar-list #'string<)))

    (dolist (file files)
      (save-excursion
	(message "Processing %s" file)
	(find-file file)
	(goto-char (point-min))
	(munge-V)
	(save-buffer)))

    (message "Creating globals.h")
    (find-file "globals.h")
    (erase-buffer)
    (insert "struct emacs_globals\n{")
    (dolist (item (nreverse global-text-list))
      (insert "\n")
      (unless (string= (car item) "")
	(insert (car item))
	(just-one-newline))
      (insert (cdr item))
      (just-one-newline))
    (insert "};\n\n")
    (insert "extern struct emacs_globals globals;\n\n")
    (indent-region (point-min) (point-max))
    (goto-char (point-max))
    (dolist (v defvar-list)
      (insert "#define " v " \\\n    "
	      (if (string-match "buffer_defaults_" v)
		  (concat "buffer_defaults." (substring v 16))
		(concat "globals." ;; "f_"
			v))
	      "\n"))
    (let ((version-control 'never))
      (save-buffer))

    (message "Updating lisp.h")
    (find-file "lisp.h")
    (goto-char (point-max))
    (search-backward "#endif")
    (insert "#include \"globals.h\"\n\n")
    (save-buffer)))

(munge-V-directory)