;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
;;        David J. Biesack

;; This file is not part of GNU Emacs.

;; GNU Emacs 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.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; 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:

;; long-lines.el

;; provides function long-lines (a great function to put on
;; write-file-hooks) which scans the buffer for excessively long lines.
;; Long lines are recorded in a buffer named "*Long Lines*" which may be
;; copied into the *compilation* buffer for parsing as error messages.
;; long-lines can also be run interactively. An optional arg can specify
;; the maximul line length; it will override the local value of
;; *max-line-length*.

;; To use, simply add 'long-lines to your write-file-hooks and set the
;; value of *max-line-length* to the maximumn line length for your
;; buffer.  For example, I set *max-line-length* in my c-mode-hook so
;; all C buffers will have a maximum of 72 characters.

;; By default, long-lines only marks long lines; the file will still be
;; written even if long lines were found. Set *dont-write-if-long-lines*
;; to t if you don't want files with long lines written.
;;
;; Change History:
;;
;; sasdjb Mon Jun 26 11:33:47 1989: long-lines no longer raises and error
;; if the file has long lines and *long-lines-are-error* is non-nil.
;; This had caused a serious bug because Emacs does not save the file
;; and all that is left is the # backup. I'll send a message to the GNU
;; project about this; I think it is a bug.

;; Author: David Biesack (David.Biesack@sas.com  or biesack@mindspring.com)
;; Last Modified By: biesack@mindspring.com
;; Last Modified: Thu Mar 15 17:45:29 2001

(defvar *max-line-length* nil
  "*The maximum line length for the buffer.  This variable is local to
each buffer. If nil (the default), then long-lines does nothing.  If
numeric, long-lines will mark each line in the buffer which is longer
than *max-line-length*")

(make-variable-buffer-local '*max-line-length*)
(setq-default *max-line-length* nil)

(defvar *long-lines-are-errors* t
  "If non-nil, then long-lines signals an error
if excessively long lines were found. Thus, if long-lines is
a write-file-hook, the file will not be saved.")

(defun long-lines (&optional arg)

  "Check the buffer for lines longer than *max-line-length*.
If run interactively, an optional ARG can override
*max-line-length*, which local to each buffer. If nil, then no check is
done.  If numeric, all lines longer than its value will be logged in the
buffer \"*Long Lines*\". This logged information can be copied into the
*compilation* buffer for parsing via \\[next-error] by invoking
\\[compile-long-lines].  long-lines is ideal for write-file-hooks. See
also the variable *long-lines-are-errors*, which is used to control
whether files with excessively long lines are saved or not."

  (interactive "P")
  (and (or (numberp arg) (numberp *max-line-length*))
       (let ((file-name (buffer-file-name))
	     long-lines
	     (max-length (or arg *max-line-length*))
	     (line-number 1))
	 (save-excursion
	   (beginning-of-buffer)
	   (end-of-line 1)
	   (while (not (eobp))
	     (if (> (current-column) max-length)
		 (setq long-lines (cons (cons line-number
					      (current-column))
					long-lines)))
	     (end-of-line 2)
	     (setq line-number (1+ line-number))))
	 (if long-lines
	     (make-long-lines-buffer (buffer-file-name
				       (current-buffer))
				     (nreverse long-lines)
				     max-length)
	     (no-long-lines (buffer-file-name (current-buffer)))
	     ))))

(defvar max-length)

(defun no-long-lines (file-name)
  (remove-file-from-long-lines-buffer file-name)
  (message "No lines in %s have more than %d characters."
    file-name max-length)
  (let ((buffer (current-buffer))
	(ll  (get-buffer *long-lines-buffer*)))
    (cond ((null ll))
	  ((and (set-buffer ll) (zerop (buffer-size)))
	   (set-buffer buffer)
	   (kill-buffer ll))
	  )
    (set-buffer buffer)
    )
  nil)

(defun remove-file-from-long-lines-buffer (file-name &optional max-length)
  (let ((buffer (current-buffer))
	msg)
    (unwind-protect
         (progn
           (set-buffer (get-buffer-create *long-lines-buffer*))
           (setq msg (format
                       "Scanning file %s for lines longer than " file-name))
           (beginning-of-buffer)
           (if (search-forward (substring msg 0 (+ 35 (length file-name))) nil t)
               (let ((point (progn (end-of-line 0) (point-bol))))
                 (if (re-search-forward "^Scanning file" nil t)
                     (delete-region point (point-bol))
                     (delete-region point (progn (end-of-buffer) (point)))))))
           (set-buffer buffer))
    msg))


(defvar *long-lines-buffer* "*Long Lines*")

(defun point-bol ()
  (save-excursion (beginning-of-line 1) (point)))

(defvar *dont-write-if-long-lines* nil
  "*If non-nil, then a file with long lines won't be written
if write-file-hooks invokes long-lines.")

(defun make-long-lines-buffer (file-name long-lines max-length)
  (let ((buffer (current-buffer))
	pop-up-window
	(n (length long-lines))
	msg)
    (unwind-protect
         (progn
           (set-buffer (get-buffer-create *long-lines-buffer*))
           (setq msg (remove-file-from-long-lines-buffer file-name max-length))
           (end-of-buffer)
           (insert msg)
           (setq msg (substitute-command-keys (format
                                                "%s has %d lines longer than %d characters: use \\[compile-long-lines]."
                                                file-name n max-length)))
           (insert msg "\n")
           (while long-lines
             (insert file-name ":"
                     (int-to-string (car (car long-lines))) ": This line has "
                     (int-to-string (cdr (car long-lines))) " characters\n")
             (setq long-lines (cdr long-lines)))
           (display-buffer (current-buffer)))
      (set-buffer buffer))
    (if *long-lines-are-errors*
        (progn
          ;; (error msg)
          (beep)
          (setq *stop-compile* "One or more buffers had long lines.")
          (message msg))))
  *dont-write-if-long-lines*)


(defun compile-long-lines ()
  "Copy the buffer \"*Long Lines*\" into the *compilation* buffer,
where the messages can be parsed and long lines visited with
\\[next-error]."

  (interactive)
  (let (pop-up-windows
	(buffer (current-buffer)))
    (or (get-buffer *long-lines-buffer*)
	(error "#<buffer %s> does not exist!" *long-lines-buffer*))
    (and (get-buffer "*compilation*")
	 (y-or-n-p "Erase the current *compilation* buffer? ")
	 (set-buffer (get-buffer "*compilation*"))
	 (erase-buffer))
    (set-buffer (get-buffer-create "*compilation*"))
    (setq compilation-error-list t
          compilation-error-message "No more long line hits.")
    (end-of-buffer )
    (insert-buffer *long-lines-buffer*)
    (display-buffer (current-buffer))
    (kill-buffer *long-lines-buffer*)
    (set-buffer buffer)))

(fset 'cll 'compile-long-lines)
(fset 'll 'long-lines)
(add-hooks 'write-file-hooks 'long-lines)
(provide 'long-lines)