--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/hyperbole/kotl/kfill.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,329 @@
+;;!emacs
+;;
+;; FILE:         kfill.el
+;; SUMMARY:      Fill and justify koutline cells (adapted from Kyle Jones' filladapt).
+;; USAGE:        GNU Emacs Lisp Library
+;; KEYWORDS:     outlines, wp
+;;
+;; AUTHOR:       Bob Weiner
+;; ORIG-DATE:    23-Jan-94
+;; LAST-MOD:      4-Nov-95 at 04:53:42 by Bob Weiner
+;;; ************************************************************************
+;;; Public variables
+;;; ************************************************************************
+
+(defvar kfill:function-table
+  (progn
+    (if (featurep 'filladapt)
+	(progn (load "fill")     ;; Save basic fill-paragraph function.
+	       (load "simple"))) ;; Save basic do-auto-fill function.
+    (list (cons 'fill-paragraph (symbol-function 'fill-paragraph))
+	  (cons 'do-auto-fill (symbol-function 'do-auto-fill))))
+  "Table containing the old function definitions that kfill overrides.")
+
+(defvar kfill:prefix-table
+  '(
+    ;; Lists with hanging indents, e.g.
+    ;; 1. xxxxx   or   1)  xxxxx   etc.
+    ;;    xxxxx            xxx
+    ;;
+    ;; Be sure pattern does not match to:  (last word in parens starts
+    ;; newline)
+    (" *(?\\([0-9][0-9a-z.]*\\|[a-z][0-9a-z.]\\)) +" . kfill:hanging-list)
+    (" *\\([0-9]+[a-z.]+[0-9a-z.]*\\|[0-9]+\\|[a-z]\\)\\([.>] +\\|  +\\)"
+     . kfill:hanging-list)
+    ;; Included text in news or mail replies
+    ("[ \t]*\\(>+ *\\)+" . kfill:normal-included-text)
+    ;; Included text generated by SUPERCITE.  We can't hope to match all
+    ;; the possible variations, your mileage may vary.
+    ("[ \t]*[A-Za-z0-9][^'`\"< \t\n]*>[ \t]*" . kfill:supercite-included-text)
+    ;; Lisp comments
+    ("[ \t]*\\(;+[ \t]*\\)+" . kfill:lisp-comment)
+    ;; UNIX shell comments
+    ("[ \t]*\\(#+[ \t]*\\)+" . kfill:sh-comment)
+    ;; Postscript comments
+    ("[ \t]*\\(%+[ \t]*\\)+" . kfill:postscript-comment)
+    ;; C++ comments
+    ("[ \t]*//[/ \t]*" . kfill:c++-comment)
+    ("[?!~*+ -]+ " . kfill:hanging-list)
+    ;; This keeps normal paragraphs from interacting unpleasantly with
+    ;; the types given above.
+    ("[^ \t/#%?!~*+-]" . kfill:normal)
+    )
+"Value is an alist of the form
+
+   ((REGXP . FUNCTION) ...)
+
+When fill-paragraph or do-auto-fill is called, the REGEXP of each alist
+element is compared with the beginning of the current line.  If a match
+is found the corresponding FUNCTION is called.  FUNCTION is called with
+one argument, which is non-nil when invoked on the behalf of
+fill-paragraph, nil for do-auto-fill.  It is the job of FUNCTION to set
+the values of the paragraph-* variables (or set a clipping region, if
+paragraph-start and paragraph-separate cannot be made discerning enough)
+so that fill-paragraph and do-auto-fill work correctly in various
+contexts.")
+
+;;; ************************************************************************
+;;; Public functions
+;;; ************************************************************************
+
+(defun do-auto-fill ()
+  (save-restriction
+    (if (null fill-prefix)
+	(let ((paragraph-ignore-fill-prefix nil)
+	      ;; Need this or Emacs 19 ignores fill-prefix when
+	      ;; inside a comment.
+	      (comment-multi-line t)
+	      fill-prefix)
+	  (kfill:adapt nil)
+	  (kfill:funcall 'do-auto-fill))
+      (kfill:funcall 'do-auto-fill))))
+
+(defun fill-paragraph (arg &optional skip-prefix-remove)
+  "Fill paragraph at or after point.  Prefix ARG means justify as well."
+  (interactive "*P")
+  ;; Emacs 19 expects a specific symbol here.
+  (if (and arg (not (symbolp arg))) (setq arg 'full))
+  (or skip-prefix-remove (kfill:remove-paragraph-prefix))
+  (save-restriction
+    (catch 'done
+      (if (null fill-prefix)
+	(let ((paragraph-ignore-fill-prefix nil)
+	      ;; Need this or Emacs 19 ignores fill-prefix when
+	      ;; inside a comment.
+	      (comment-multi-line t)
+	      (paragraph-start paragraph-start)
+	      (paragraph-separate paragraph-separate)
+	      fill-prefix)
+	    (if (kfill:adapt t)
+		(throw 'done (kfill:funcall 'fill-paragraph arg)))))
+      ;; Kfill:adapt failed or fill-prefix is set, so do a basic
+      ;; paragraph fill as adapted from par-align.el.
+      (kfill:fill-paragraph arg skip-prefix-remove))))
+
+;;;
+;;; Redefine this function so that it sets 'fill-prefix-prev' also.
+;;;
+(defun set-fill-prefix (&optional turn-off)
+  "Set the fill-prefix to the current line up to point.
+Also sets fill-prefix-prev to previous value of fill-prefix.
+Filling expects lines to start with the fill prefix and reinserts the fill
+prefix in each resulting line."
+  (interactive)
+  (setq fill-prefix-prev fill-prefix
+	fill-prefix (if turn-off
+			nil
+		      (buffer-substring
+		       (save-excursion (beginning-of-line) (point))
+		       (point))))
+  (if (equal fill-prefix-prev "")
+      (setq fill-prefix-prev nil))
+  (if (equal fill-prefix "")
+      (setq fill-prefix nil))
+  (if fill-prefix
+      (message "fill-prefix: \"%s\"" fill-prefix)
+    (message "fill-prefix cancelled")))
+
+;;; ************************************************************************
+;;; Private functions
+;;; ************************************************************************
+
+(defun kfill:adapt (paragraph)
+  (let ((table kfill:prefix-table)
+	case-fold-search
+	success )
+    (save-excursion
+      (beginning-of-line)
+      (while table
+	(if (not (looking-at (car (car table))))
+	    (setq table (cdr table))
+	  (funcall (cdr (car table)) paragraph)
+	  (setq success t table nil))))
+    success ))
+
+(defun kfill:c++-comment (paragraph)
+  (setq fill-prefix (buffer-substring (match-beginning 0) (match-end 0)))
+  (if paragraph
+      (setq paragraph-separate "^[^ \t/]")))
+
+(defun kfill:fill-paragraph (justify-flag &optional leave-prefix)
+  (save-excursion
+    (end-of-line)
+    ;; Backward to para begin
+    (re-search-backward (concat "\\`\\|" paragraph-separate))
+    (forward-line 1)
+    (let ((region-start (point)))
+      (forward-line -1)
+      (let ((from (point)))
+	(forward-paragraph)
+	;; Forward to real paragraph end
+	(re-search-forward (concat "\\'\\|" paragraph-separate))
+	(or (= (point) (point-max)) (beginning-of-line))
+	(or leave-prefix
+	    (kfill:replace-string
+	      (or fill-prefix fill-prefix-prev)
+	      "" nil region-start (point)))
+	(fill-region-as-paragraph from (point) justify-flag)))))
+
+(defun kfill:funcall (function &rest args)
+  (apply (cdr (assq function kfill:function-table)) args))
+
+(defun kfill:hanging-list (paragraph)
+  (let (prefix match beg end)
+    (setq prefix (make-string (- (match-end 0) (match-beginning 0)) ?\ ))
+    (if paragraph
+	(progn
+	  (setq match (buffer-substring (match-beginning 0) (match-end 0)))
+	  (if (string-match "^ +$" match)
+	      (save-excursion
+		(while (and (not (bobp)) (looking-at prefix))
+		  (forward-line -1))
+
+		(cond ((kfill:hanging-p)
+		       (setq beg (point)))
+		      (t (setq beg (progn (forward-line 1) (point))))))
+	    (setq beg (point)))
+	  (save-excursion
+	    (forward-line)
+	    (while (and (looking-at prefix)
+			(not (equal (char-after (match-end 0)) ?\ )))
+	      (forward-line))
+	    (setq end (point)))
+	  (narrow-to-region beg end)))
+    (setq fill-prefix prefix)))
+
+(defun kfill:hanging-p ()
+  "Return non-nil iff point is in front of a hanging list."
+  (eval kfill:hanging-expression))
+
+(defun kfill:lisp-comment (paragraph)
+  (setq fill-prefix (buffer-substring (match-beginning 0) (match-end 0)))
+  (if paragraph
+      (setq paragraph-separate
+	    (concat "^" fill-prefix " *;\\|^"
+		    (kfill:negate-string fill-prefix)))))
+
+(defun kfill:negate-string (string)
+  (let ((len (length string))
+	(i 0) string-list)
+    (setq string-list (cons "\\(" nil))
+    (while (< i len)
+      (setq string-list
+	    (cons (if (= i (1- len)) "" "\\|")
+		  (cons "]"
+			(cons (substring string i (1+ i))
+			      (cons "[^"
+				    (cons (regexp-quote (substring string 0 i))
+					  string-list)))))
+	    i (1+ i)))
+    (setq string-list (cons "\\)" string-list))
+    (apply 'concat (nreverse string-list))))
+
+(defun kfill:normal (paragraph)
+  (if paragraph
+      (setq paragraph-separate
+	    (concat paragraph-separate "\\|^[ \t/#%?!~*+-]"))))
+
+(defun kfill:normal-included-text (paragraph)
+  (setq fill-prefix (buffer-substring (match-beginning 0) (match-end 0)))
+  (if paragraph
+      (setq paragraph-separate
+	    (concat "^" fill-prefix " *>\\|^"
+		    (kfill:negate-string fill-prefix)))))
+
+(defun kfill:postscript-comment (paragraph)
+  (setq fill-prefix (buffer-substring (match-beginning 0) (match-end 0)))
+  (if paragraph
+      (setq paragraph-separate
+	    (concat "^" fill-prefix " *%\\|^"
+		    (kfill:negate-string fill-prefix)))))
+
+(defun kfill:remove-paragraph-prefix (&optional indent-str)
+  "Remove fill prefix from current paragraph."
+  (save-excursion
+    (end-of-line)
+    ;; Backward to para begin
+    (re-search-backward (concat "\\`\\|" paragraph-separate))
+    (forward-line 1)
+    (let ((region-start (point)))
+      (forward-line -1)
+      (forward-paragraph)
+      ;; Forward to real paragraph end
+      (re-search-forward (concat "\\'\\|" paragraph-separate))
+      (or (= (point) (point-max)) (beginning-of-line))
+      (kfill:replace-string (or fill-prefix fill-prefix-prev)
+				(if (eq major-mode 'kotl-mode)
+				    (or indent-str
+					(make-string (kcell-view:indent) ?  ))
+				  "")
+				nil region-start (point)))))
+
+(defun kfill:replace-string (fill-str-prev fill-str &optional suffix start end)
+  "Replace whitespace separated FILL-STR-PREV with FILL-STR.
+Optional SUFFIX non-nil means replace at ends of lines, default is beginnings.
+Optional arguments START and END specify the replace region, default is the
+current region."
+  (if fill-str-prev
+      (progn (if start
+		 (let ((s (min start end)))
+		   (setq end (max start end)
+			 start s))
+	       (setq start (region-beginning)
+		     end (region-end)))
+	     (if (not fill-str) (setq fill-str ""))
+	     (save-excursion
+	       (save-restriction
+		 (narrow-to-region start end)
+		 (goto-char (point-min))
+		 (let ((prefix
+			(concat
+			 (if suffix nil "^")
+			 "[ \t]*"
+			 (regexp-quote
+			  ;; Get non-whitespace separated fill-str-prev
+			  (substring
+			   fill-str-prev
+			   (or (string-match "[^ \t]" fill-str-prev) 0)
+			   (if (string-match
+				"[ \t]*\\(.*[^ \t]\\)[ \t]*$"
+				fill-str-prev)
+			       (match-end 1))))
+			 "[ \t]*"
+			 (if suffix "$"))))
+		   (while (re-search-forward prefix nil t)
+		     (replace-match fill-str nil t))))))))
+
+(defun kfill:sh-comment (paragraph)
+  (setq fill-prefix (buffer-substring (match-beginning 0) (match-end 0)))
+  (if paragraph
+      (setq paragraph-separate
+	    (concat "^" fill-prefix " *#\\|^"
+		    (kfill:negate-string fill-prefix)))))
+
+(defun kfill:supercite-included-text (paragraph)
+  (setq fill-prefix (buffer-substring (match-beginning 0) (match-end 0)))
+  (if paragraph
+      (setq paragraph-separate
+	    (concat "^" (kfill:negate-string fill-prefix)))))
+
+;;; ************************************************************************
+;;; Private variables
+;;; ************************************************************************
+
+(defconst kfill:hanging-expression
+  (cons 'or
+	(delq nil (mapcar (function
+			    (lambda (pattern-type)
+			      (if (eq (cdr pattern-type) 'kfill:hanging-list)
+				  (list 'looking-at (car pattern-type)))))
+			  kfill:prefix-table)))
+  "Conditional expression used to test for hanging indented lists.")
+
+(defvar fill-prefix-prev nil
+  "Prior string inserted at front of new line during filling, or nil for none.
+Setting this variable automatically makes it local to the current buffer.")
+(make-variable-buffer-local 'fill-prefix-prev)
+
+
+(provide 'kfill)