backquote - old style

[Sam Steingold]

My pet peeve with the elisp files in Emacs is old-style backquote.
(I wrote the appended code in 1999.)
RMS and Gerd after him postponed the fix until 21.1 was out.
May I go over the *.el files and change them?

My rationale is that the old-style backquote is hard to implement in a
CL, so the files with the old-style backquote are hard to load into a
CL (I have code to load emacs-lisp into common-lisp).

-- 
Sam Steingold (http://www.podval.org/~sds)
Keep Jerusalem united! <http://www.onejerusalem.org/Petition.asp>
Read, think and remember! <http://www.iris.org.il> <http://www.memri.org/>
A year spent in artificial intelligence is enough to make one believe in God.


;; File: <fix-bq.el - 1999-02-23 Tue 15:30:13 EST address@hidden>
;; Fix the old-style emacs backqoute
;; Copyright (C) 1999 Sam Steingold; GNU GPL-2 is applicable.

;; set `fix-backquote-patch-file' and `fix-backquote-auto' to your taste
;; (which usually means (setq fix-backquote-auto t) for directories and
;; (setq fix-backquote-auto nil) for files.)

(eval-when-compile (require 'cl))

(defvar fix-backquote-patch-file "/usr/local/src/patches/emacs-backquote.diff"
  "The backquote diff file or nil.")

(defvar fix-backquote-auto nil
  "Be non-interactive.")

(defun fix-backquote-ask (prompt)
  "Possibly ask a question, depending on `fix-backquote-auto'."
  (or fix-backquote-auto (y-or-n-p prompt)))

(defun fix-backquote-dir (dir)
  "Fix all files in the directory."
  (interactive "DWhich directory to fix: ")
  (when (and fix-backquote-patch-file
             (file-exists-p fix-backquote-patch-file))
    (delete-file fix-backquote-patch-file))
  (save-some-buffers)
  (let ((enable-local-variables nil) (find-file-hooks nil)
        (global-font-lock-mode nil) (write-file-hooks nil))
    (with-output-to-temp-buffer "fix backquote log"
      (princ (format-time-string "fix-backquote-dir started: %Y-%m-%d %T\n"))
      (labels ((fbd (dd)
                 (princ (format " -dir-> %s\n" dd))
                 (dolist (ff (directory-files dd t))
                   (if (and (not (string-match "/\\.\\.$" ff))
                            (not (string-match "/\\.$" ff))
                            (file-directory-p ff))
                       (fbd ff)
                       (when (string-match "\\.el$" ff)
                         (princ (format " -file-> %s [%s]\n" ff
                                        (if (fix-backquote-file ff)
                                            "NEW" "old"))))))))
        (fbd dir))
      (princ (format-time-string "fix-backquote-dir done: %Y-%m-%d %T\n")))))

(defun fix-backquote-in-the-code-p ()
  "Check whether we are in the code - not comment or string.
Quite lousy."
  (save-excursion
    (beginning-of-line)
    (and (not (looking-at "[    ]*\""))
         (not (looking-at "[    ]*;")))))

(defun fix-backquote-file (file)
  "Fix everything in the file.
Returns t if the file was modifies, nil otherwise."
  (interactive "fWhich file to fix: ")
  (message "fix-backquote-file: %s" file)
  (let ((buf (find-file-noselect file t t)))
    (with-current-buffer buf
      (emacs-lisp-mode)
      (goto-char 0)
      (setq buffer-read-only nil)
      (while (re-search-forward "(`[    \n]+" nil t)
        (when (and (fix-backquote-in-the-code-p)
                   (fix-backquote-ask "ix this instance? "))
          (fix-backquote-defun)))
      (cond ((buffer-modified-p buf)
             (cond ((fix-backquote-ask "Create the diff file? ")
                    (copy-file file (concat file ".old") t t)
                    (basic-save-buffer)
                    (shell-command (format "diff -cwb %s.old %s >> %s" file
                                           file fix-backquote-patch-file)))
                   ((basic-save-buffer)))
             (when (fix-backquote-ask "Kill buffer? ")
               (kill-buffer buf))
             t)
            (t (kill-buffer buf)
               nil)))))

(defun fix-backquote-defun ()
  "Fix the current defun."
  (interactive)
  (save-restriction
    (narrow-to-defun)
    (fix-backquote-sexp "(`[    \n]+" "`")
    (fix-backquote-sexp "(,@[   \n]+" ",@")
    (fix-backquote-sexp "(,[    \n]+" ",")
    (goto-char (point-min))
    (search-forward "(")
    (forward-char -1)
    (indent-sexp)
    (forward-sexp 1)))

(defun fix-backquote-sexp (str1 str2)
  "Remove parens and spaces."
  (goto-char (point-min))
  (while (re-search-forward str1 nil t)
    (cond ((fix-backquote-in-the-code-p)
           (replace-match str2)
           (forward-sexp 1)
           (delete-char 1)
           (forward-sexp -1))
          (t (forward-line 1)))))