Find file
Fetching contributors…
Cannot retrieve contributors at this time
256 lines (228 sloc) 8.2 KB
;;; navi2ch-auto-modify.el --- auto file modification module for navi2ch -*- coding: iso-2022-7bit; -*-
;; Copyright (C) 2003, 2005, 2006 by Navi2ch Project
;; Author: extra <>
;; Keywords: network, 2ch
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;; Code:
(provide 'navi2ch-auto-modify)
(defconst navi2ch-auto-modify-ident
(eval-when-compile (require 'cl))
(require 'navi2ch-vars)
(require 'navi2ch-util)
(defvar navi2ch-auto-modify-variable-list nil
(add-hook 'navi2ch-exit-hook 'navi2ch-auto-modify-save)
(defun navi2ch-auto-modify-subr (body)
(prog2 (setq navi2ch-auto-modify-variable-list nil)
(eval (cons 'progn body))
(let (added)
(dolist (sexp body)
(when (memq (car-safe sexp) '(setq setq-default))
(setq sexp (cdr sexp))
(while sexp
(unless (or (memq (car sexp) navi2ch-auto-modify-variable-list)
(memq (car sexp) added))
(setq added (cons (car sexp) added)))
(setq sexp (cddr sexp)))))
(when added
(setq navi2ch-auto-modify-variable-list
(append navi2ch-auto-modify-variable-list
(nreverse added)))))))
(defmacro navi2ch-auto-modify (&rest body)
"`navi2ch-auto-modify-file' $B$G;XDj$5$l$?%U%!%$%k$K5-=R$9$k$H!"(B
$BJQ?t(B `navi2ch-article-message-filter-by-id-alist' $B$H(B
`navi2ch-article-message-filter-by-message-alist' $B$N@_DjCM$O!"(B
Navi2ch $B=*N;;~$K<+F0E*$KJQ99!&J]B8$5$l$k!#(B
(setq navi2ch-article-message-filter-by-id-alist
(setq navi2ch-article-message-filter-by-message-alist
`(navi2ch-auto-modify-subr ',body))
(put 'navi2ch-auto-modify 'lisp-indent-function 0)
(defun navi2ch-auto-modify-variables (variables)
(let (added)
(dolist (var variables)
(unless (or (memq var navi2ch-auto-modify-variable-list)
(memq var added))
(setq added (cons var added))))
(when added
(setq navi2ch-auto-modify-variable-list
(append navi2ch-auto-modify-variable-list (nreverse added)))))
(defmacro default-major-mode ()
(if (and (<= 23 emacs-major-version)
(<= 1 emacs-minor-version))
(defun navi2ch-auto-modify-save ()
(run-hooks 'navi2ch-auto-modify-save-hook)
(when navi2ch-auto-modify-variable-list
(let ((navi2ch-auto-modify-file
(if (eq navi2ch-auto-modify-file t)
(locate-library (expand-file-name navi2ch-init-file
(when navi2ch-auto-modify-file
(let ((inhibit-read-only t)
(require-final-newline (eq require-final-newline t))
(value-buffer (current-buffer))
(exist-buffer (get-file-buffer navi2ch-auto-modify-file)))
(let ((default-major-mode 'fundamental-mode))
(set-buffer (find-file-noselect navi2ch-auto-modify-file)))
(navi2ch-auto-modify-save-variables value-buffer)))
(unless exist-buffer
(kill-buffer (current-buffer))))))
(defun navi2ch-auto-modify-skip-comments ()
(while (and (not (eobp))
(forward-comment 1))))
(defun navi2ch-auto-modify-narrow ()
(goto-char (point-min))
;; Test for scan errors.
(while (not (eobp))
(catch 'loop
(let ((standard-input (current-buffer)))
(while (not (eobp))
(condition-case nil
(let ((beg (point))
(sexp (read)))
(when (consp sexp)
(if (eq (car sexp) 'navi2ch-auto-modify)
(narrow-to-region beg (point))
(throw 'loop nil))
(when (re-search-backward "\\<navi2ch-auto-modify\\>"
(1+ beg) t)
(goto-char (1+ beg))))))
(invalid-read-syntax nil))
(unless (bobp)
(skip-chars-backward "\n" (1- (point)))
(let ((count (save-excursion (skip-chars-backward "\n"))))
(when (> count -2)
(insert-char ?\n (+ count 2))))
(narrow-to-region (point) (point)))
(insert "(navi2ch-auto-modify)")))
(defun navi2ch-auto-modify-save-variables (&optional buffer)
(goto-char (1+ (point-min))) ; "\\`("
(forward-sexp) ; "navi2ch-auto-modify"
(let ((standard-input (current-buffer))
(standard-output (current-buffer))
(print-length nil)
(print-level nil)
(condition-case nil
(while (not (eobp))
(let ((beg (point))
(sexp (read)))
(when (memq (car-safe sexp) '(setq setq-default))
(goto-char (1+ beg)) ; "("
(forward-sexp) ; "setq\\(-default\\)?"
(condition-case nil
(while (not (eobp))
(let ((var (read))
start end)
(setq start (point))
(delete-region start (point))
(pp (navi2ch-quote-maybe
(if (and buffer
(local-variable-p var buffer))
(with-current-buffer buffer
(symbol-value var))
(symbol-value var))))
(setq end (point-marker))
(goto-char start)
(delete-region (point) end)
(unless (memq var modified)
(setq modified (cons var modified))))
(invalid-read-syntax nil))))) ; ")"
(invalid-read-syntax nil)) ; ")\\'"
(dolist (var navi2ch-auto-modify-variable-list)
(unless (memq var modified)
(unless (navi2ch-auto-modify-customize-variable-p var)
(insert ?\n)
(let ((start (point))
(pp (list (if (local-variable-if-set-p var (current-buffer))
(if (and buffer
(local-variable-p var buffer))
(with-current-buffer buffer
(symbol-value var))
(symbol-value var)))))
(setq end (point-marker))
(goto-char start)
(delete-region (point) end)))
(setq modified (cons var modified))))
(setq navi2ch-auto-modify-variable-list (nreverse modified))))
(defun navi2ch-auto-modify-customize-variable-p (variable)
(or (null navi2ch-auto-modify-file)
(get variable 'saved-value) ; From `customize-saved'
(get variable 'saved-variable-comment))) ; For XEmacs
(defun navi2ch-auto-modify-customize-variables ()
(let (customized)
(dolist (var navi2ch-auto-modify-variable-list)
(when (navi2ch-auto-modify-customize-variable-p var)
(customize-set-variable var (symbol-value var))
(setq customized t)))
(when customized
(defun navi2ch-auto-modify-truncate-lists ()
(when navi2ch-auto-modify-truncate-list-alist
(let (added)
(dolist (slot navi2ch-auto-modify-truncate-list-alist)
(when (> (length (symbol-value (car slot))) (cdr slot))
(if (zerop (cdr slot))
(set (car slot) nil)
(setcdr (nthcdr (1- (cdr slot)) (symbol-value (car slot))) nil))
(unless (or (memq (car slot) navi2ch-auto-modify-variable-list)
(memq (car slot) added))
(setq added (cons (car slot) added)))))
(when added
(setq navi2ch-auto-modify-variable-list
(append navi2ch-auto-modify-variable-list (nreverse added)))))))
;;; navi2ch-auto-modify.el ends here