Ｅｌｉｓｐで文字列置換

久しぶりに elisp でプログラム。

オープンソースの始祖であるところのＧＮＵの鉄則に従って、書いた分だけここに置いておきます。

文字列変換というごくごくシンプルなものですが、変換後にバッファでのポイントの位置がずれることに注意。

(defun replace-tags-region (from-string to-string begin end)
"Replaces from-string to to-string in the region from begin to end."
  (let ((len (- (length to-string)(length from-string))))
    (goto-char begin)
    (while (search-forward from-string end t)
      (replace-match to-string t)
      (setq end (+ end len)))))

(defun replace-tags-list (tag-list)
"Takes a list of (from-string to-string) and replaces all from-string to to-string in the buffer."
  (replace-tags-region (car tag-list) (cadr tag-list)(point-min)(point-max))) 

  

;; Usage:
;; (setq tag-list '(("TABLE" "table")("TD" "td")("TR" "tr")))
;; (replace-tags tag-list)

(defun replace-tags (tag-list)
"Takes a list of lists of (from-string to-string) and replaces all from-string to to-string in the buffer."
  (mapcar 'replace-tags-list tag-list))

(defun create-end-tag (tag-name)
  "Creates closing tag from the given tag-name."
  (concat "</" tag-name ">"))

(defun create-half-begin-tag (tag-name)
  "Creates opening tag from the given tag-name."
  (concat "<" tag-name " "))

(defun create-attribute-tag (tag-name)
  "Creates attribute string from the given tag-name."
  (concat " " tag-name "=\""))

(defun create-begin-tag (tag-name)
  "Creates opening tag from the given tag-name."
  (concat "<" tag-name ">"))

 

;; Usage:
;;(setq tag-list '("TABLE" "TD" "B" "BR" "A" "HTML" "NOSCRIPT" "SCRIPT" "HEAD" "BODY" "TR" "TITLE" "I"))
;;(mapcar (lambda (x)(create-replacement-list 'create-end-tag x)) tag-list)
(defun create-replacement-list (create-list tag-name)
"Creates a list of tag name and lowercase tag name lists."
  (cons (funcall create-list tag-name) (list (funcall create-list (downcase tag-name)))))

(defun lowercase-html-tags()
"Converts uppercase HTML tag names to lowercase."
  (interactive)
  (let* ((tag-list '("TABLE" "TD" "B" "BR" "A" "HTML" "NOSCRIPT" "SCRIPT" "HEAD" "BODY" "TR" "TITLE" "I"))
  (attribute-list '("VALIGN" "ALIGN" "WIDTH" "HEIGHT" "BOTTOM" "CLASS" "BGCOLOR" "BORDER" "LEFT" "RIGHT" "TOP" "CELLPADDING" "CELLSPACING" "BORDERCOLOR" "CENTER" "MIDDLE" "HREF" "COLSPAN" "ROWSPAN" "SRC" "onMouseOver" "onMouseOut" "ALT" "NAME" "ID" "VSPACE" "LINK" "META" "LEFTMARGIN" "TOPMARGIN" "MARGINWIDTH" "MARGINHEIGHT" "onLoad" "BACKGROUND" "TYPE" "HTTP-EQUIV" "CONTENT" "REL" "LANGUAGE"))
  (half-tag-list '("TABLE" "TD" "A" "IMG" "LINK" "META" "SCRIPT" "BODY" "TR" "DIV"))
  (replacement-end-tags (mapcar (lambda (x)(create-replacement-list 'create-end-tag x)) tag-list))
  (replacement-begin-tags (mapcar (lambda (x)(create-replacement-list 'create-begin-tag x)) tag-list))
  (replacement-half-begin-tags (mapcar (lambda (x)(create-replacement-list 'create-half-begin-tag x)) half-tag-list))
  (replacement-attribute-tags (mapcar (lambda (x)(create-replacement-list 'create-attribute-tag x)) attribute-list)))
    (replace-tags replacement-attribute-tags)
    (replace-tags replacement-end-tags)
    (replace-tags replacement-half-begin-tags)
    (replace-tags replacement-begin-tags)))