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