1;;; navi2ch-auto-modify.el --- auto file modification module for navi2ch -*- coding: iso-2022-7bit; -*- 2 3;; Copyright (C) 2003, 2005, 2006 by Navi2ch Project 4 5;; Author: extra <ekisutora@users.sourceforge.net> 6;; Keywords: network, 2ch 7 8;; This file is free software; you can redistribute it and/or modify 9;; it under the terms of the GNU General Public License as published by 10;; the Free Software Foundation; either version 2, or (at your option) 11;; any later version. 12 13;; This file is distributed in the hope that it will be useful, 14;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16;; GNU General Public License for more details. 17 18;; You should have received a copy of the GNU General Public License 19;; along with GNU Emacs; see the file COPYING. If not, write to 20;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 21;; Boston, MA 02111-1307, USA. 22 23;;; Commentary: 24 25;; 26 27;;; Code: 28(provide 'navi2ch-auto-modify) 29(defconst navi2ch-auto-modify-ident 30 "$Id$") 31 32(eval-when-compile (require 'cl)) 33 34(require 'navi2ch-vars) 35(require 'navi2ch-util) 36 37(defvar navi2ch-auto-modify-variable-list nil 38 "$B@_Dj$r<+F0E*$KJQ99$7$FJ]B8$9$kJQ?tL>$N%j%9%H!#(B") 39 40(add-hook 'navi2ch-exit-hook 'navi2ch-auto-modify-save) 41 42(defun navi2ch-auto-modify-subr (body) 43 (prog2 (setq navi2ch-auto-modify-variable-list nil) 44 (eval (cons 'progn body)) 45 (let (added) 46 (dolist (sexp body) 47 (when (memq (car-safe sexp) '(setq setq-default)) 48 (setq sexp (cdr sexp)) 49 (while sexp 50 (unless (or (memq (car sexp) navi2ch-auto-modify-variable-list) 51 (memq (car sexp) added)) 52 (setq added (cons (car sexp) added))) 53 (setq sexp (cddr sexp))))) 54 (when added 55 (setq navi2ch-auto-modify-variable-list 56 (append navi2ch-auto-modify-variable-list 57 (nreverse added))))))) 58 59(defmacro navi2ch-auto-modify (&rest body) 60 "`navi2ch-auto-modify-file' $B$G;XDj$5$l$?%U%!%$%k$K5-=R$9$k$H!"(B 61$B$=$NCf$K4^$^$l$kJQ?t$N@_Dj$r<+F0E*$KJQ99$7$FJ]B8$9$k!#(B 62 63$BNc$($P2<5-$N$h$&$K5-=R$9$k$H!"(B 64$BJQ?t(B `navi2ch-article-message-filter-by-id-alist' $B$H(B 65`navi2ch-article-message-filter-by-message-alist' $B$N@_DjCM$O!"(B 66Navi2ch $B=*N;;~$K<+F0E*$KJQ99!&J]B8$5$l$k!#(B 67 68\(navi2ch-auto-modify 69 (setq navi2ch-article-message-filter-by-id-alist 70 ...) 71 (setq navi2ch-article-message-filter-by-message-alist 72 ...))" 73 `(navi2ch-auto-modify-subr ',body)) 74 75(put 'navi2ch-auto-modify 'lisp-indent-function 0) 76 77(defun navi2ch-auto-modify-variables (variables) 78 (let (added) 79 (dolist (var variables) 80 (unless (or (memq var navi2ch-auto-modify-variable-list) 81 (memq var added)) 82 (setq added (cons var added)))) 83 (when added 84 (setq navi2ch-auto-modify-variable-list 85 (append navi2ch-auto-modify-variable-list (nreverse added))))) 86 (navi2ch-auto-modify-save)) 87 88(eval-when-compile 89 (defmacro default-major-mode () 90 (if (and (<= 23 emacs-major-version) 91 (<= 1 emacs-minor-version)) 92 ''major-mode 93 ''default-major-mode))) 94 95(defun navi2ch-auto-modify-save () 96 (run-hooks 'navi2ch-auto-modify-save-hook) 97 (navi2ch-auto-modify-truncate-lists) 98 (when navi2ch-auto-modify-variable-list 99 (let ((navi2ch-auto-modify-file 100 (if (eq navi2ch-auto-modify-file t) 101 (locate-library (expand-file-name navi2ch-init-file 102 navi2ch-directory)) 103 navi2ch-auto-modify-file))) 104 (when navi2ch-auto-modify-file 105 (let ((inhibit-read-only t) 106 (require-final-newline (eq require-final-newline t)) 107 (value-buffer (current-buffer)) 108 (exist-buffer (get-file-buffer navi2ch-auto-modify-file))) 109 (save-current-buffer 110 (let ((default-major-mode 'fundamental-mode)) 111 (set-buffer (find-file-noselect navi2ch-auto-modify-file))) 112 (save-excursion 113 (save-restriction 114 (widen) 115 (navi2ch-auto-modify-narrow) 116 (navi2ch-auto-modify-save-variables value-buffer))) 117 (unless exist-buffer 118 (basic-save-buffer) 119 (kill-buffer (current-buffer)))))) 120 (navi2ch-auto-modify-customize-variables)))) 121 122(defun navi2ch-auto-modify-skip-comments () 123 (while (and (not (eobp)) 124 (forward-comment 1)))) 125 126(defun navi2ch-auto-modify-narrow () 127 (goto-char (point-min)) 128 (navi2ch-auto-modify-skip-comments) 129 ;; Test for scan errors. 130 (save-excursion 131 (while (not (eobp)) 132 (forward-sexp))) 133 (catch 'loop 134 (let ((standard-input (current-buffer))) 135 (while (not (eobp)) 136 (condition-case nil 137 (let ((beg (point)) 138 (sexp (read))) 139 (when (consp sexp) 140 (if (eq (car sexp) 'navi2ch-auto-modify) 141 (progn 142 (narrow-to-region beg (point)) 143 (throw 'loop nil)) 144 (when (re-search-backward "\\<navi2ch-auto-modify\\>" 145 (1+ beg) t) 146 (goto-char (1+ beg)))))) 147 (invalid-read-syntax nil)) 148 (navi2ch-auto-modify-skip-comments))) 149 (unless (bobp) 150 (skip-chars-backward "\n" (1- (point))) 151 (let ((count (save-excursion (skip-chars-backward "\n")))) 152 (when (> count -2) 153 (insert-char ?\n (+ count 2)))) 154 (narrow-to-region (point) (point))) 155 (insert "(navi2ch-auto-modify)"))) 156 157(defun navi2ch-auto-modify-save-variables (&optional buffer) 158 (goto-char (1+ (point-min))) ; "\\`(" 159 (forward-sexp) ; "navi2ch-auto-modify" 160 (navi2ch-auto-modify-skip-comments) 161 (let ((standard-input (current-buffer)) 162 (standard-output (current-buffer)) 163 (print-length nil) 164 (print-level nil) 165 modified) 166 (condition-case nil 167 (while (not (eobp)) 168 (let ((beg (point)) 169 (sexp (read))) 170 (when (memq (car-safe sexp) '(setq setq-default)) 171 (save-excursion 172 (goto-char (1+ beg)) ; "(" 173 (forward-sexp) ; "setq\\(-default\\)?" 174 (navi2ch-auto-modify-skip-comments) 175 (condition-case nil 176 (while (not (eobp)) 177 (let ((var (read)) 178 start end) 179 (navi2ch-auto-modify-skip-comments) 180 (setq start (point)) 181 (forward-sexp) 182 (delete-region start (point)) 183 (pp (navi2ch-quote-maybe 184 (if (and buffer 185 (local-variable-p var buffer)) 186 (with-current-buffer buffer 187 (symbol-value var)) 188 (symbol-value var)))) 189 (setq end (point-marker)) 190 (goto-char start) 191 (indent-sexp) 192 (forward-sexp) 193 (delete-region (point) end) 194 (unless (memq var modified) 195 (setq modified (cons var modified)))) 196 (navi2ch-auto-modify-skip-comments)) 197 (invalid-read-syntax nil))))) ; ")" 198 (navi2ch-auto-modify-skip-comments)) 199 (invalid-read-syntax nil)) ; ")\\'" 200 (backward-char) 201 (dolist (var navi2ch-auto-modify-variable-list) 202 (unless (memq var modified) 203 (unless (navi2ch-auto-modify-customize-variable-p var) 204 (insert ?\n) 205 (lisp-indent-line) 206 (let ((start (point)) 207 end) 208 (pp (list (if (local-variable-if-set-p var (current-buffer)) 209 'setq-default 210 'setq) 211 var 212 (navi2ch-quote-maybe 213 (if (and buffer 214 (local-variable-p var buffer)) 215 (with-current-buffer buffer 216 (symbol-value var)) 217 (symbol-value var))))) 218 (setq end (point-marker)) 219 (goto-char start) 220 (indent-sexp) 221 (forward-sexp) 222 (delete-region (point) end))) 223 (setq modified (cons var modified)))) 224 (setq navi2ch-auto-modify-variable-list (nreverse modified)))) 225 226(defun navi2ch-auto-modify-customize-variable-p (variable) 227 (or (null navi2ch-auto-modify-file) 228 (get variable 'saved-value) ; From `customize-saved' 229 (get variable 'saved-variable-comment))) ; For XEmacs 230 231(defun navi2ch-auto-modify-customize-variables () 232 (let (customized) 233 (dolist (var navi2ch-auto-modify-variable-list) 234 (when (navi2ch-auto-modify-customize-variable-p var) 235 (customize-set-variable var (symbol-value var)) 236 (setq customized t))) 237 (when customized 238 (customize-save-customized)))) 239 240(defun navi2ch-auto-modify-truncate-lists () 241 (when navi2ch-auto-modify-truncate-list-alist 242 (let (added) 243 (dolist (slot navi2ch-auto-modify-truncate-list-alist) 244 (when (> (length (symbol-value (car slot))) (cdr slot)) 245 (if (zerop (cdr slot)) 246 (set (car slot) nil) 247 (setcdr (nthcdr (1- (cdr slot)) (symbol-value (car slot))) nil)) 248 (unless (or (memq (car slot) navi2ch-auto-modify-variable-list) 249 (memq (car slot) added)) 250 (setq added (cons (car slot) added))))) 251 (when added 252 (setq navi2ch-auto-modify-variable-list 253 (append navi2ch-auto-modify-variable-list (nreverse added))))))) 254 255;;; navi2ch-auto-modify.el ends here 256