navi2ch-auto-modify.el

   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 (defconst navi2ch-auto-modify-ident
  29   "$Id$")
  30
  31 (eval-when-compile
  32   (require 'cl-lib)
  33   (require 'navi2ch-inline)
  34   (require 'navi2ch-decls))
  35
  36 (defvar navi2ch-auto-modify-variable-list nil
  37   "\e$B@_Dj$r<+F0E*$KJQ99$7$FJ]B8$9$kJQ?tL>$N%j%9%H!#\e(B")
  38
  39 (add-hook 'navi2ch-exit-hook 'navi2ch-auto-modify-save)
  40
  41 (defun navi2ch-auto-modify-subr (body)
  42   (prog2 (setq navi2ch-auto-modify-variable-list nil)
  43       (eval (cons 'progn body))
  44     (let (added)
  45       (dolist (sexp body)
  46         (when (memq (car-safe sexp) '(setq setq-default))
  47           (setq sexp (cdr sexp))
  48           (while sexp
  49             (unless (or (memq (car sexp) navi2ch-auto-modify-variable-list)
  50                         (memq (car sexp) added))
  51               (setq added (cons (car sexp) added)))
  52             (setq sexp (cddr sexp)))))
  53       (when added
  54         (setq navi2ch-auto-modify-variable-list
  55               (append navi2ch-auto-modify-variable-list
  56                       (nreverse added)))))))
  57
  58 (defmacro navi2ch-auto-modify (&rest body)
  59   "`navi2ch-auto-modify-file' \e$B$G;XDj$5$l$?%U%!%$%k$K5-=R$9$k$H!"\e(B
  60 \e$B$=$NCf$K4^$^$l$kJQ?t$N@_Dj$r<+F0E*$KJQ99$7$FJ]B8$9$k!#\e(B
  61
  62 \e$BNc$($P2<5-$N$h$&$K5-=R$9$k$H!"\e(B
  63 \e$BJQ?t\e(B `navi2ch-article-message-filter-by-id-alist' \e$B$H\e(B
  64 `navi2ch-article-message-filter-by-message-alist' \e$B$N@_DjCM$O!"\e(B
  65 Navi2ch \e$B=*N;;~$K<+F0E*$KJQ99!&J]B8$5$l$k!#\e(B
  66
  67 \(navi2ch-auto-modify
  68   (setq navi2ch-article-message-filter-by-id-alist
  69         ...)
  70   (setq navi2ch-article-message-filter-by-message-alist
  71         ...))"
  72   `(navi2ch-auto-modify-subr ',body))
  73
  74 (put 'navi2ch-auto-modify 'lisp-indent-function 0)
  75
  76 (defun navi2ch-auto-modify-variables (variables)
  77   (let (added)
  78     (dolist (var variables)
  79       (unless (or (memq var navi2ch-auto-modify-variable-list)
  80                   (memq var added))
  81         (setq added (cons var added))))
  82     (when added
  83       (setq navi2ch-auto-modify-variable-list
  84             (append navi2ch-auto-modify-variable-list (nreverse added)))))
  85   (navi2ch-auto-modify-save))
  86
  87 (eval-when-compile
  88   (defmacro default-major-mode ()
  89     (if (and (<= 23 emacs-major-version)
  90              (<= 1 emacs-minor-version))
  91         ''major-mode
  92       ''default-major-mode)))
  93
  94 (defun navi2ch-auto-modify-save ()
  95   (run-hooks 'navi2ch-auto-modify-save-hook)
  96   (navi2ch-auto-modify-truncate-lists)
  97   (when navi2ch-auto-modify-variable-list
  98     (let ((navi2ch-auto-modify-file
  99            (if (eq navi2ch-auto-modify-file t)
 100                (locate-library (expand-file-name navi2ch-init-file
 101                                                  navi2ch-directory))
 102              navi2ch-auto-modify-file)))
 103       (when navi2ch-auto-modify-file
 104         (let ((inhibit-read-only t)
 105               (require-final-newline (eq require-final-newline t))
 106               (value-buffer (current-buffer))
 107               (exist-buffer (get-file-buffer navi2ch-auto-modify-file)))
 108           (save-current-buffer
 109             (let ((default-major-mode 'fundamental-mode))
 110               (set-buffer (find-file-noselect navi2ch-auto-modify-file)))
 111             (save-excursion
 112               (save-restriction
 113                 (widen)
 114                 (navi2ch-auto-modify-narrow)
 115                 (navi2ch-auto-modify-save-variables value-buffer)))
 116             (unless exist-buffer
 117               (basic-save-buffer)
 118               (kill-buffer (current-buffer))))))
 119       (navi2ch-auto-modify-customize-variables))))
 120
 121 (defun navi2ch-auto-modify-skip-comments ()
 122   (while (and (not (eobp))
 123               (forward-comment 1))))
 124
 125 (defun navi2ch-auto-modify-narrow ()
 126   (goto-char (point-min))
 127   (navi2ch-auto-modify-skip-comments)
 128   ;; Test for scan errors.
 129   (save-excursion
 130     (while (not (eobp))
 131       (forward-sexp)))
 132   (catch 'loop
 133     (let ((standard-input (current-buffer)))
 134       (while (not (eobp))
 135         (condition-case nil
 136             (let ((beg (point))
 137                   (sexp (read)))
 138               (when (consp sexp)
 139                 (if (eq (car sexp) 'navi2ch-auto-modify)
 140                     (progn
 141                       (narrow-to-region beg (point))
 142                       (throw 'loop nil))
 143                   (when (re-search-backward "\\<navi2ch-auto-modify\\>"
 144                                             (1+ beg) t)
 145                     (goto-char (1+ beg))))))
 146           (invalid-read-syntax nil))
 147         (navi2ch-auto-modify-skip-comments)))
 148     (unless (bobp)
 149       (skip-chars-backward "\n" (1- (point)))
 150       (let ((count (save-excursion (skip-chars-backward "\n"))))
 151         (when (> count -2)
 152           (insert-char ?\n (+ count 2))))
 153       (narrow-to-region (point) (point)))
 154     (insert "(navi2ch-auto-modify)")))
 155
 156 (defun navi2ch-auto-modify-save-variables (&optional buffer)
 157   (goto-char (1+ (point-min)))          ; "\\`("
 158   (forward-sexp)                        ; "navi2ch-auto-modify"
 159   (navi2ch-auto-modify-skip-comments)
 160   (let ((standard-input (current-buffer))
 161         (standard-output (current-buffer))
 162         (print-length nil)
 163         (print-level nil)
 164         modified)
 165     (condition-case nil
 166         (while (not (eobp))
 167           (let ((beg (point))
 168                 (sexp (read)))
 169             (when (memq (car-safe sexp) '(setq setq-default))
 170               (save-excursion
 171                 (goto-char (1+ beg))    ; "("
 172                 (forward-sexp)          ; "setq\\(-default\\)?"
 173                 (navi2ch-auto-modify-skip-comments)
 174                 (condition-case nil
 175                     (while (not (eobp))
 176                       (let ((var (read))
 177                             start end)
 178                         (navi2ch-auto-modify-skip-comments)
 179                         (setq start (point))
 180                         (forward-sexp)
 181                         (delete-region start (point))
 182                         (pp (navi2ch-quote-maybe
 183                              (if (and buffer
 184                                       (local-variable-p var buffer))
 185                                  (with-current-buffer buffer
 186                                    (symbol-value var))
 187                                (symbol-value var))))
 188                         (setq end (point-marker))
 189                         (goto-char start)
 190                         (indent-sexp)
 191                         (forward-sexp)
 192                         (delete-region (point) end)
 193                         (unless (memq var modified)
 194                           (setq modified (cons var modified))))
 195                       (navi2ch-auto-modify-skip-comments))
 196                   (invalid-read-syntax nil))))) ; ")"
 197           (navi2ch-auto-modify-skip-comments))
 198       (invalid-read-syntax nil))        ; ")\\'"
 199     (backward-char)
 200     (dolist (var navi2ch-auto-modify-variable-list)
 201       (unless (memq var modified)
 202         (unless (navi2ch-auto-modify-customize-variable-p var)
 203           (insert ?\n)
 204           (lisp-indent-line)
 205           (let ((start (point))
 206                 end)
 207             (pp (list (if (local-variable-if-set-p var (current-buffer))
 208                           'setq-default
 209                         'setq)
 210                       var
 211                       (navi2ch-quote-maybe
 212                        (if (and buffer
 213                                 (local-variable-p var buffer))
 214                            (with-current-buffer buffer
 215                              (symbol-value var))
 216                          (symbol-value var)))))
 217             (setq end (point-marker))
 218             (goto-char start)
 219             (indent-sexp)
 220             (forward-sexp)
 221             (delete-region (point) end)))
 222         (setq modified (cons var modified))))
 223     (setq navi2ch-auto-modify-variable-list (nreverse modified))))
 224
 225 (defun navi2ch-auto-modify-customize-variable-p (variable)
 226   (or (null navi2ch-auto-modify-file)
 227       (get variable 'saved-value)       ; From `customize-saved'
 228       (get variable 'saved-variable-comment))) ; For XEmacs
 229
 230 (defun navi2ch-auto-modify-customize-variables ()
 231   (let (customized)
 232     (dolist (var navi2ch-auto-modify-variable-list)
 233       (when (navi2ch-auto-modify-customize-variable-p var)
 234         (customize-set-variable var (symbol-value var))
 235         (setq customized t)))
 236     (when customized
 237       (customize-save-customized))))
 238
 239 (defun navi2ch-auto-modify-truncate-lists ()
 240   (when navi2ch-auto-modify-truncate-list-alist
 241     (let (added)
 242       (dolist (slot navi2ch-auto-modify-truncate-list-alist)
 243         (when (> (length (symbol-value (car slot))) (cdr slot))
 244           (if (zerop (cdr slot))
 245               (set (car slot) nil)
 246             (setcdr (nthcdr (1- (cdr slot)) (symbol-value (car slot))) nil))
 247           (unless (or (memq (car slot) navi2ch-auto-modify-variable-list)
 248                       (memq (car slot) added))
 249             (setq added (cons (car slot) added)))))
 250       (when added
 251         (setq navi2ch-auto-modify-variable-list
 252               (append navi2ch-auto-modify-variable-list (nreverse added)))))))
 253
 254 (provide 'navi2ch-auto-modify)
 255 ;;; navi2ch-auto-modify.el ends here