From 18a0dc261e9648c6e2f4af51a43c9ef47eb75685 Mon Sep 17 00:00:00 2001 From: John Doty Date: Fri, 29 Mar 2019 09:38:15 -0700 Subject: [PATCH] Use ELPA filladapt --- .emacs.d/custom.el | 2 +- .emacs.d/init.el | 4 +- site-lisp/filladapt.el | 981 ----------------------------------------- 3 files changed, 3 insertions(+), 984 deletions(-) delete mode 100644 site-lisp/filladapt.el diff --git a/.emacs.d/custom.el b/.emacs.d/custom.el index 461506c..fda6be4 100644 --- a/.emacs.d/custom.el +++ b/.emacs.d/custom.el @@ -58,7 +58,7 @@ ((sequence "TODO" "|" "DONE" "ABANDONED" "DEFERRED")))) '(package-selected-packages (quote - (vc-hgcmd lsp-ui yaml-mode wgrep fsharp-mode company-lsp cquery mustache-mode clang-format projectile dash-functional mocha add-node-modules-path rjsx-mode xref-js2 js2-refactor company omnisharp geiser cider clojure-mode graphviz-dot-mode multi-term xterm-color thrift markdown-mode tuareg merlin ag use-package flycheck dockerfile-mode js2-mode web-mode zencoding-mode tss switch-window python-mode paredit magit lua-mode go-mode go-autocomplete exec-path-from-shell csharp-mode color-theme-solarized color-theme-monokai auto-complete auto-complete-nxml flymake flyspell json-mode popup ruby-mode company-jedi tide ahg elm-mode monky))) + (filladapt vc-hgcmd lsp-ui yaml-mode wgrep fsharp-mode company-lsp cquery mustache-mode clang-format projectile dash-functional mocha add-node-modules-path rjsx-mode xref-js2 js2-refactor company omnisharp geiser cider clojure-mode graphviz-dot-mode multi-term xterm-color thrift markdown-mode tuareg merlin ag use-package flycheck dockerfile-mode js2-mode web-mode zencoding-mode tss switch-window python-mode paredit magit lua-mode go-mode go-autocomplete exec-path-from-shell csharp-mode color-theme-solarized color-theme-monokai auto-complete auto-complete-nxml flymake flyspell json-mode popup ruby-mode company-jedi tide ahg elm-mode monky))) '(reb-re-syntax (quote string)) '(rmail-mail-new-frame t) '(safe-local-variable-values diff --git a/.emacs.d/init.el b/.emacs.d/init.el index e820590..66ecafd 100644 --- a/.emacs.d/init.el +++ b/.emacs.d/init.el @@ -252,8 +252,8 @@ (setq w32-use-w32-font-dialog t) ;; Adaptive fill for everybody! -(require 'filladapt) -(setq-default filladapt-mode t) +(use-package filladapt :ensure + :init (setq-default filladapt-mode t)) (require 'ido) diff --git a/site-lisp/filladapt.el b/site-lisp/filladapt.el deleted file mode 100644 index 4ae63ab..0000000 --- a/site-lisp/filladapt.el +++ /dev/null @@ -1,981 +0,0 @@ -;;; Adaptive fill -;;; Copyright (C) 1989, 1995-1998 Kyle E. Jones -;;; -;;; This program 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 program 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. -;;; -;;; A copy of the GNU General Public License can be obtained from this -;;; program's author (send electronic mail to kyle@uunet.uu.net) or from -;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA -;;; 02139, USA. -;;; -;;; Send bug reports to kyle_jones@wonderworks.com - -;; LCD Archive Entry: -;; filladapt|Kyle Jones|kyle_jones@wonderworks.com| -;; Minor mode to adaptively set fill-prefix and overload filling functions| -;; 28-February-1998|2.12|~/packages/filladapt.el| - -;; These functions enhance the default behavior of Emacs' Auto Fill -;; mode and the commands fill-paragraph, lisp-fill-paragraph, -;; fill-region-as-paragraph and fill-region. -;; -;; The chief improvement is that the beginning of a line to be -;; filled is examined and, based on information gathered, an -;; appropriate value for fill-prefix is constructed. Also the -;; boundaries of the current paragraph are located. This occurs -;; only if the fill prefix is not already non-nil. -;; -;; The net result of this is that blurbs of text that are offset -;; from left margin by asterisks, dashes, and/or spaces, numbered -;; examples, included text from USENET news articles, etc. are -;; generally filled correctly with no fuss. -;; -;; Since this package replaces existing Emacs functions, it cannot -;; be autoloaded. Save this in a file named filladapt.el in a -;; Lisp directory that Emacs knows about, byte-compile it and put -;; (require 'filladapt) -;; in your .emacs file. -;; -;; Note that in this release Filladapt mode is a minor mode and it is -;; _off_ by default. If you want it to be on by default, use -;; (setq-default filladapt-mode t) -;; -;; M-x filladapt-mode toggles Filladapt mode on/off in the current -;; buffer. -;; -;; Use -;; (add-hook 'text-mode-hook 'turn-on-filladapt-mode) -;; to have Filladapt always enabled in Text mode. -;; -;; Use -;; (add-hook 'c-mode-hook 'turn-off-filladapt-mode) -;; to have Filladapt always disabled in C mode. -;; -;; In many cases, you can extend Filladapt by adding appropriate -;; entries to the following three `defvar's. See `postscript-comment' -;; or `texinfo-comment' as a sample of what needs to be done. -;; -;; filladapt-token-table -;; filladapt-token-match-table -;; filladapt-token-conversion-table - -(and (featurep 'filladapt) - (error "filladapt cannot be loaded twice in the same Emacs session.")) - -(provide 'filladapt) - -(defvar filladapt-version "2.12" - "Version string for filladapt.") - -;; BLOB to make custom stuff work even without customize -(eval-and-compile - (condition-case () - (require 'custom) - (error nil)) - (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) - nil ;; We've got what we needed - ;; We have the old custom-library, hack around it! - (defmacro defgroup (&rest args) - nil) - (defmacro defcustom (var value doc &rest args) - (` (defvar (, var) (, value) (, doc)))))) - -(defgroup filladapt nil - "Enhanced filling" - :group 'fill) - -(defvar filladapt-mode nil - "Non-nil means that Filladapt minor mode is enabled. -Use the filladapt-mode command to toggle the mode on/off.") -(make-variable-buffer-local 'filladapt-mode) - -(defcustom filladapt-mode-line-string " Filladapt" - "*String to display in the modeline when Filladapt mode is active. -Set this to nil if you don't want a modeline indicator for Filladapt." - :type 'string - :group 'filladapt) - -(defcustom filladapt-fill-column-tolerance nil - "*Tolerate filled paragraph lines ending this far from the fill column. -If any lines other than the last paragraph line end at a column -less than fill-column - filladapt-fill-column-tolerance, fill-column will -be adjusted using the filladapt-fill-column-*-fuzz variables and -the paragraph will be re-filled until the tolerance is achieved -or filladapt runs out of fuzz values to try. - -A nil value means behave normally, that is, don't try refilling -paragraphs to make filled line lengths fit within any particular -range." - :type '(choice (const nil) - integer) - :group 'filladapt) - -(defcustom filladapt-fill-column-forward-fuzz 5 - "*Try values from fill-column to fill-column plus this variable -when trying to make filled paragraph lines fall with the tolerance -range specified by filladapt-fill-column-tolerance." - :type 'integer - :group 'filladapt) - -(defcustom filladapt-fill-column-backward-fuzz 5 - "*Try values from fill-column to fill-column minus this variable -when trying to make filled paragraph lines fall with the tolerance -range specified by filladapt-fill-column-tolerance." - :type 'integer - :group 'filladapt) - -;; install on minor-mode-alist -(or (assq 'filladapt-mode minor-mode-alist) - (setq minor-mode-alist (cons (list 'filladapt-mode - 'filladapt-mode-line-string) - minor-mode-alist))) - -(defcustom filladapt-token-table - '( - ;; this must be first - ("^" beginning-of-line) - ;; Included text in news or mail replies - (">+" citation->) - ;; Included text generated by SUPERCITE. We can't hope to match all - ;; the possible variations, your mileage may vary. - ("\\(\\w\\|[0-9]\\)[^'`\"< \t\n]*>[ \t]*" supercite-citation) - ;; Lisp comments - (";+" lisp-comment) - ;; UNIX shell comments - ("#+" sh-comment) - ;; Postscript comments - ("%+" postscript-comment) - ;; C++ comments - ("///*" c++-comment) - ;; Texinfo comments - ("@c[ \t]" texinfo-comment) - ("@comment[ \t]" texinfo-comment) - ;; Bullet types. - ;; - ;; LaTex \item - ;; - ("\\\\item[ \t]" bullet) - ;; - ;; 1. xxxxx - ;; xxxxx - ;; - ("[0-9]+\\.[ \t]" bullet) - ;; - ;; 2.1.3 xxxxx xx x xx x - ;; xxx - ;; - ("[0-9]+\\(\\.[0-9]+\\)+[ \t]" bullet) - ;; - ;; a. xxxxxx xx - ;; xxx xxx - ;; - ("[A-Za-z]\\.[ \t]" bullet) - ;; - ;; 1) xxxx x xx x xx or (1) xx xx x x xx xx - ;; xx xx xxxx xxx xx x x xx x - ;; - ("(?[0-9]+)[ \t]" bullet) - ;; - ;; a) xxxx x xx x xx or (a) xx xx x x xx xx - ;; xx xx xxxx xxx xx x x xx x - ;; - ("(?[A-Za-z])[ \t]" bullet) - ;; - ;; 2a. xx x xxx x x xxx - ;; xxx xx x xx x - ;; - ("[0-9]+[A-Za-z]\\.[ \t]" bullet) - ;; - ;; 1a) xxxx x xx x xx or (1a) xx xx x x xx xx - ;; xx xx xxxx xxx xx x x xx x - ;; - ("(?[0-9]+[A-Za-z])[ \t]" bullet) - ;; - ;; - xx xxx xxxx or * xx xx x xxx xxx - ;; xxx xx xx x xxx x xx x x x - ;; - ("[-~*+]+[ \t]" bullet) - ;; - ;; o xx xxx xxxx xx x xx xxx x xxx xx x xxx - ;; xxx xx xx - ;; - ("o[ \t]" bullet) - ;; don't touch - ("[ \t]+" space) - ("$" end-of-line) - ) - "Table of tokens filladapt knows about. -Format is - - ((REGEXP SYM) ...) - -filladapt uses this table to build a tokenized representation of -the beginning of the current line. Each REGEXP is matched -against the beginning of the line until a match is found. -Matching is done case-sensitively. The corresponding SYM is -added to the list, point is moved to (match-end 0) and the -process is repeated. The process ends when there is no REGEXP in -the table that matches what is at point." - :type '(repeat (list regexp symbol)) - :group 'filladapt) - -(defcustom filladapt-not-token-table - '( - "[Ee]\\.g\\.[ \t,]" - "[Ii]\\.e\\.[ \t,]" - ;; end-of-line isn't a token if whole line is empty - "^$" - ) - "List of regexps that can never be a token. -Before trying the regular expressions in filladapt-token-table, -the regexps in this list are tried. If any regexp in this list -matches what is at point then the token generator gives up and -doesn't try any of the regexps in filladapt-token-table. - -Regexp matching is done case-sensitively." - :type '(repeat regexp) - :group 'filladapt) - -(defcustom filladapt-token-match-table - '( - (citation-> citation->) - (supercite-citation supercite-citation) - (lisp-comment lisp-comment) - (sh-comment sh-comment) - (postscript-comment postscript-comment) - (c++-comment c++-comment) - (texinfo-comment texinfo-comment) - (bullet) - (space bullet space) - (beginning-of-line beginning-of-line) - ) - "Table describing what tokens a certain token will match. - -To decide whether a line belongs in the current paragraph, -filladapt creates a token list for the fill prefix of both lines. -Tokens and the columns where tokens end are compared. This table -specifies what a certain token will match. - -Table format is - - (SYM [SYM1 [SYM2 ...]]) - -The first symbol SYM is the token, subsequent symbols are the -tokens that SYM will match." - :type '(repeat (repeat symbol)) - :group 'filladapt) - -(defcustom filladapt-token-match-many-table - '( - space - ) - "List of tokens that can match multiple tokens. -If one of these tokens appears in a token list, it will eat all -matching tokens in a token list being matched against it until it -encounters a token that doesn't match or a token that ends on -a greater column number." - :type '(repeat symbol) - :group 'filladapt) - -(defcustom filladapt-token-paragraph-start-table - '( - bullet - ) - "List of tokens that indicate the start of a paragraph. -If parsing a line generates a token list containing one of -these tokens, then the line is considered to be the start of a -paragraph." - :type '(repeat symbol) - :group 'filladapt) - -(defcustom filladapt-token-conversion-table - '( - (citation-> . exact) - (supercite-citation . exact) - (lisp-comment . exact) - (sh-comment . exact) - (postscript-comment . exact) - (c++-comment . exact) - (texinfo-comment . exact) - (bullet . spaces) - (space . exact) - (end-of-line . exact) - ) - "Table that specifies how to convert a token into a fill prefix. -Table format is - - ((SYM . HOWTO) ...) - -SYM is the symbol naming the token to be converted. -HOWTO specifies how to do the conversion. - `exact' means copy the token's string directly into the fill prefix. - `spaces' means convert all characters in the token string that are - not a TAB or a space into spaces and copy the resulting string into - the fill prefix." - :type '(repeat (cons symbol (choice (const exact) - (const spaces)))) - :group 'filladapt) - -(defvar filladapt-function-table - (let ((assoc-list - (list (cons 'fill-paragraph (symbol-function 'fill-paragraph)) - (cons 'fill-region (symbol-function 'fill-region)) - (cons 'fill-region-as-paragraph - (symbol-function 'fill-region-as-paragraph)) - (cons 'do-auto-fill (symbol-function 'do-auto-fill))))) - ;; v18 Emacs doesn't have lisp-fill-paragraph - (if (fboundp 'lisp-fill-paragraph) - (nconc assoc-list - (list (cons 'lisp-fill-paragraph - (symbol-function 'lisp-fill-paragraph))))) - assoc-list ) - "Table containing the old function definitions that filladapt usurps.") - -(defcustom filladapt-fill-paragraph-post-hook nil - "Hooks run after filladapt runs fill-paragraph." - :type 'hook - :group 'filladapt) - -(defvar filladapt-inside-filladapt nil - "Non-nil if the filladapt version of a fill function executing. -Currently this is only checked by the filladapt version of -fill-region-as-paragraph to avoid this infinite recursion: - - fill-region-as-paragraph -> fill-paragraph -> fill-region-as-paragraph ...") - -(defcustom filladapt-debug nil - "Non-nil means filladapt debugging is enabled. -Use the filladapt-debug command to turn on debugging. - -With debugging enabled, filladapt will - - a. display the proposed indentation with the tokens highlighted - using filladapt-debug-indentation-face-1 and - filladapt-debug-indentation-face-2. - b. display the current paragraph using the face specified by - filladapt-debug-paragraph-face." - :type 'boolean - :group 'filladapt) - -(if filladapt-debug - (add-hook 'post-command-hook 'filladapt-display-debug-info-maybe)) - -(defvar filladapt-debug-indentation-face-1 'highlight - "Face used to display the indentation when debugging is enabled.") - -(defvar filladapt-debug-indentation-face-2 'secondary-selection - "Another face used to display the indentation when debugging is enabled.") - -(defvar filladapt-debug-paragraph-face 'bold - "Face used to display the current paragraph when debugging is enabled.") - -(defvar filladapt-debug-indentation-extents nil) -(make-variable-buffer-local 'filladapt-debug-indentation-extents) -(defvar filladapt-debug-paragraph-extent nil) -(make-variable-buffer-local 'filladapt-debug-paragraph-extent) - -;; kludge city, see references in code. -(defvar filladapt-old-line-prefix) - -(defun do-auto-fill () - (catch 'done - (if (and filladapt-mode (null fill-prefix)) - (save-restriction - (let ((paragraph-ignore-fill-prefix nil) - ;; if the user wanted this stuff, they probably - ;; wouldn't be using filladapt-mode. - (adaptive-fill-mode nil) - (adaptive-fill-regexp nil) - ;; need this or Emacs 19 ignores fill-prefix when - ;; inside a comment. - (comment-multi-line t) - (filladapt-inside-filladapt t) - fill-prefix retval) - (if (filladapt-adapt nil nil) - (progn - (setq retval (filladapt-funcall 'do-auto-fill)) - (throw 'done retval)))))) - (filladapt-funcall 'do-auto-fill))) - -(defun filladapt-fill-paragraph (function arg) - (catch 'done - (if (and filladapt-mode (null fill-prefix)) - (save-restriction - (let ((paragraph-ignore-fill-prefix nil) - ;; if the user wanted this stuff, they probably - ;; wouldn't be using filladapt-mode. - (adaptive-fill-mode nil) - (adaptive-fill-regexp nil) - ;; need this or Emacs 19 ignores fill-prefix when - ;; inside a comment. - (comment-multi-line t) - fill-prefix retval) - (if (filladapt-adapt t nil) - (progn - (if filladapt-fill-column-tolerance - (let* ((low (- fill-column - filladapt-fill-column-backward-fuzz)) - (high (+ fill-column - filladapt-fill-column-forward-fuzz)) - (old-fill-column fill-column) - (fill-column fill-column) - (lim (- high low)) - (done nil) - (sign 1) - (delta 0)) - (while (not done) - (setq retval (filladapt-funcall function arg)) - (if (filladapt-paragraph-within-fill-tolerance) - (setq done 'success) - (setq delta (1+ delta) - sign (* sign -1) - fill-column (+ fill-column (* delta sign))) - (while (and (<= delta lim) - (or (< fill-column low) - (> fill-column high))) - (setq delta (1+ delta) - sign (* sign -1) - fill-column (+ fill-column - (* delta sign)))) - (setq done (> delta lim)))) - ;; if the paragraph lines never fell - ;; within the tolerances, refill using - ;; the old fill-column. - (if (not (eq done 'success)) - (let ((fill-column old-fill-column)) - (setq retval (filladapt-funcall function arg))))) - (setq retval (filladapt-funcall function arg))) - (run-hooks 'filladapt-fill-paragraph-post-hook) - (throw 'done retval)))))) - ;; filladapt-adapt failed, so do fill-paragraph normally. - (filladapt-funcall function arg))) - -(defun fill-paragraph (arg) - "Fill paragraph at or after point. Prefix arg means justify as well. - -(This function has been overloaded with the `filladapt' version.) - -If `sentence-end-double-space' is non-nil, then period followed by one -space does not end a sentence, so don't break a line there. - -If `fill-paragraph-function' is non-nil, we call it (passing our -argument to it), and if it returns non-nil, we simply return its value." - (interactive "*P") - (let ((filladapt-inside-filladapt t)) - (filladapt-fill-paragraph 'fill-paragraph arg))) - -(defun lisp-fill-paragraph (&optional arg) - "Like \\[fill-paragraph], but handle Emacs Lisp comments. - -(This function has been overloaded with the `filladapt' version.) - -If any of the current line is a comment, fill the comment or the -paragraph of it that point is in, preserving the comment's indentation -and initial semicolons." - (interactive "*P") - (let ((filladapt-inside-filladapt t)) - (filladapt-fill-paragraph 'lisp-fill-paragraph arg))) - -(defun fill-region-as-paragraph (beg end &optional justify - nosqueeze squeeze-after) - "Fill the region as one paragraph. - -(This function has been overloaded with the `filladapt' version.) - -It removes any paragraph breaks in the region and extra newlines at the end, -indents and fills lines between the margins given by the -`current-left-margin' and `current-fill-column' functions. -It leaves point at the beginning of the line following the paragraph. - -Normally performs justification according to the `current-justification' -function, but with a prefix arg, does full justification instead. - -From a program, optional third arg JUSTIFY can specify any type of -justification. Fourth arg NOSQUEEZE non-nil means not to make spaces -between words canonical before filling. Fifth arg SQUEEZE-AFTER, if non-nil, -means don't canonicalize spaces before that position. - -If `sentence-end-double-space' is non-nil, then period followed by one -space does not end a sentence, so don't break a line there." - (interactive "*r\nP") - (if (and filladapt-mode (not filladapt-inside-filladapt)) - (save-restriction - (narrow-to-region beg end) - (let ((filladapt-inside-filladapt t) - line-start last-token) - (goto-char beg) - (while (equal (char-after (point)) ?\n) - (delete-char 1)) - (end-of-line) - (while (zerop (forward-line)) - (if (setq last-token - (car (filladapt-tail (filladapt-parse-prefixes)))) - (progn - (setq line-start (point)) - (move-to-column (nth 1 last-token)) - (delete-region line-start (point)))) - ;; Dance... - ;; - ;; Do this instead of (delete-char -1) to keep - ;; markers on the correct side of the whitespace. - (goto-char (1- (point))) - (insert " ") - (delete-char 1) - - (end-of-line)) - (goto-char beg) - (fill-paragraph justify)) - ;; In XEmacs 19.12 and Emacs 18.59 fill-region relies on - ;; fill-region-as-paragraph to do this. If we don't do - ;; it, fill-region will spin in an endless loop. - (goto-char (point-max))) - (condition-case nil - ;; five args for Emacs 19.31 - (filladapt-funcall 'fill-region-as-paragraph beg end - justify nosqueeze squeeze-after) - (wrong-number-of-arguments - (condition-case nil - ;; four args for Emacs 19.29 - (filladapt-funcall 'fill-region-as-paragraph beg end - justify nosqueeze) - ;; three args for the rest of the world. - (wrong-number-of-arguments - (filladapt-funcall 'fill-region-as-paragraph beg end justify))))))) - -(defun fill-region (beg end &optional justify nosqueeze to-eop) - "Fill each of the paragraphs in the region. - -(This function has been overloaded with the `filladapt' version.) - -Prefix arg (non-nil third arg, if called from program) means justify as well. - -Noninteractively, fourth arg NOSQUEEZE non-nil means to leave -whitespace other than line breaks untouched, and fifth arg TO-EOP -non-nil means to keep filling to the end of the paragraph (or next -hard newline, if `use-hard-newlines' is on). - -If `sentence-end-double-space' is non-nil, then period followed by one -space does not end a sentence, so don't break a line there." - (interactive "*r\nP") - (if (and filladapt-mode (not filladapt-inside-filladapt)) - (save-restriction - (narrow-to-region beg end) - (let ((filladapt-inside-filladapt t) - start) - (goto-char beg) - (while (not (eobp)) - (setq start (point)) - (while (and (not (eobp)) (not (filladapt-parse-prefixes))) - (forward-line 1)) - (if (not (equal start (point))) - (progn - (save-restriction - (narrow-to-region start (point)) - (fill-region start (point) justify nosqueeze to-eop) - (goto-char (point-max))) - (if (and (not (bolp)) (not (eobp))) - (forward-line 1)))) - (if (filladapt-parse-prefixes) - (progn - (save-restriction - ;; for the clipping region - (filladapt-adapt t t) - (fill-paragraph justify) - (goto-char (point-max))) - (if (and (not (bolp)) (not (eobp))) - (forward-line 1))))))) - (condition-case nil - (filladapt-funcall 'fill-region beg end justify nosqueeze to-eop) - (wrong-number-of-arguments - (condition-case nil - (filladapt-funcall 'fill-region beg end justify nosqueeze) - (wrong-number-of-arguments - (filladapt-funcall 'fill-region beg end justify))))))) - -(defvar zmacs-region-stays) ; for XEmacs - -(defun filladapt-mode (&optional arg) - "Toggle Filladapt minor mode. -With arg, turn Filladapt mode on iff arg is positive. When -Filladapt mode is enabled, auto-fill-mode and the fill-paragraph -command are both smarter about guessing a proper fill-prefix and -finding paragraph boundaries when bulleted and indented lines and -paragraphs are used." - (interactive "P") - ;; don't deactivate the region. - (setq zmacs-region-stays t) - (setq filladapt-mode (or (and arg (> (prefix-numeric-value arg) 0)) - (and (null arg) (null filladapt-mode)))) - (if (fboundp 'force-mode-line-update) - (force-mode-line-update) - (set-buffer-modified-p (buffer-modified-p)))) - -(defun turn-on-filladapt-mode () - "Unconditionally turn on Filladapt mode in the current buffer." - (filladapt-mode 1)) - -(defun turn-off-filladapt-mode () - "Unconditionally turn off Filladapt mode in the current buffer." - (filladapt-mode -1)) - -(defun filladapt-funcall (function &rest args) - "Call the old definition of a function that filladapt has usurped." - (apply (cdr (assoc function filladapt-function-table)) args)) - -(defun filladapt-paragraph-start (list) - "Returns non-nil if LIST contains a paragraph starting token. -LIST should be a token list as returned by filladapt-parse-prefixes." - (catch 'done - (while list - (if (memq (car (car list)) filladapt-token-paragraph-start-table) - (throw 'done t)) - (setq list (cdr list))))) - -(defun filladapt-parse-prefixes () - "Parse all the tokens after point and return a list of them. -The tokens regular expressions are specified in -filladapt-token-table. The list returned is of this form - - ((SYM COL STRING) ...) - -SYM is a token symbol as found in filladapt-token-table. -COL is the column at which the token ended. -STRING is the token's text." - (save-excursion - (let ((token-list nil) - (done nil) - (old-point (point)) - (case-fold-search nil) - token-table not-token-table moved) - (catch 'done - (while (not done) - (setq not-token-table filladapt-not-token-table) - (while not-token-table - (if (looking-at (car not-token-table)) - (throw 'done t)) - (setq not-token-table (cdr not-token-table))) - (setq token-table filladapt-token-table - done t) - (while token-table - (if (null (looking-at (car (car token-table)))) - (setq token-table (cdr token-table)) - (goto-char (match-end 0)) - (setq token-list (cons (list (nth 1 (car token-table)) - (current-column) - (buffer-substring - (match-beginning 0) - (match-end 0))) - token-list) - moved (not (eq (point) old-point)) - token-table (if moved nil (cdr token-table)) - done (not moved) - old-point (point)))))) - (nreverse token-list)))) - -(defun filladapt-tokens-match-p (list1 list2) - "Compare two token lists and return non-nil if they match, nil otherwise. -The lists are walked through in lockstep, comparing tokens. - -When two tokens A and B are compared, they are considered to -match if - - 1. A appears in B's list of matching tokens or - B appears in A's list of matching tokens -and - 2. A and B both end at the same column - or - A can match multiple tokens and ends at a column > than B - or - B can match multiple tokens and ends at a column > than A - -In the case where the end columns differ the list pointer for the -token with the greater end column is not moved forward, which -allows its current token to be matched against the next token in -the other list in the next iteration of the matching loop. - -All tokens must be matched in order for the lists to be considered -matching." - (let ((matched t) - (done nil)) - (while (and (not done) list1 list2) - (let* ((token1 (car (car list1))) - (token1-matches-many-p - (memq token1 filladapt-token-match-many-table)) - (token1-matches (cdr (assq token1 filladapt-token-match-table))) - (token1-endcol (nth 1 (car list1))) - (token2 (car (car list2))) - (token2-matches-many-p - (memq token2 filladapt-token-match-many-table)) - (token2-matches (cdr (assq token2 filladapt-token-match-table))) - (token2-endcol (nth 1 (car list2))) - (tokens-match (or (memq token1 token2-matches) - (memq token2 token1-matches)))) - (cond ((not tokens-match) - (setq matched nil - done t)) - ((and token1-matches-many-p token2-matches-many-p) - (cond ((= token1-endcol token2-endcol) - (setq list1 (cdr list1) - list2 (cdr list2))) - ((< token1-endcol token2-endcol) - (setq list1 (cdr list1))) - (t - (setq list2 (cdr list2))))) - (token1-matches-many-p - (cond ((= token1-endcol token2-endcol) - (setq list1 (cdr list1) - list2 (cdr list2))) - ((< token1-endcol token2-endcol) - (setq matched nil - done t)) - (t - (setq list2 (cdr list2))))) - (token2-matches-many-p - (cond ((= token1-endcol token2-endcol) - (setq list1 (cdr list1) - list2 (cdr list2))) - ((< token2-endcol token1-endcol) - (setq matched nil - done t)) - (t - (setq list1 (cdr list1))))) - ((= token1-endcol token2-endcol) - (setq list1 (cdr list1) - list2 (cdr list2))) - (t - (setq matched nil - done t))))) - (and matched (null list1) (null list2)) )) - -(defun filladapt-make-fill-prefix (list) - "Build a fill-prefix for a token LIST. -filladapt-token-conversion-table specifies how this is done." - (let ((prefix-list nil) - (conversion-spec nil)) - (while list - (setq conversion-spec (cdr (assq (car (car list)) - filladapt-token-conversion-table))) - (cond ((eq conversion-spec 'spaces) - (setq prefix-list - (cons - (filladapt-convert-to-spaces (nth 2 (car list))) - prefix-list))) - ((eq conversion-spec 'exact) - (setq prefix-list - (cons - (nth 2 (car list)) - prefix-list)))) - (setq list (cdr list))) - (apply (function concat) (nreverse prefix-list)) )) - -(defun filladapt-paragraph-within-fill-tolerance () - (catch 'done - (save-excursion - (let ((low (- fill-column filladapt-fill-column-tolerance)) - (shortline nil)) - (goto-char (point-min)) - (while (not (eobp)) - (if shortline - (throw 'done nil) - (end-of-line) - (setq shortline (< (current-column) low)) - (forward-line 1))) - t )))) - -(defun filladapt-convert-to-spaces (string) - "Return a copy of STRING, with all non-tabs and non-space changed to spaces." - (let ((i 0) - (space-list '(?\ ?\t)) - (space ?\ ) - (lim (length string))) - (setq string (copy-sequence string)) - (while (< i lim) - (if (not (memq (aref string i) space-list)) - (aset string i space)) - (setq i (1+ i))) - string )) - -(defun filladapt-adapt (paragraph debugging) - "Set fill-prefix based on the contents of the current line. - -If the first arg PARAGRAPH is non-nil, also set a clipping region -around the current paragraph. - -If the second arg DEBUGGING is non-nil, don't do the kludge that's -necessary to make certain paragraph fills work properly." - (save-excursion - (beginning-of-line) - (let ((token-list (filladapt-parse-prefixes)) - curr-list done) - (if (null token-list) - nil - (setq fill-prefix (filladapt-make-fill-prefix token-list)) - (if paragraph - (let (beg end) - (if (filladapt-paragraph-start token-list) - (setq beg (point)) - (save-excursion - (setq done nil) - (while (not done) - (cond ((not (= 0 (forward-line -1))) - (setq done t - beg (point))) - ((not (filladapt-tokens-match-p - token-list - (setq curr-list (filladapt-parse-prefixes)))) - (forward-line 1) - (setq done t - beg (point))) - ((filladapt-paragraph-start curr-list) - (setq done t - beg (point))))))) - (save-excursion - (setq done nil) - (while (not done) - (cond ((not (= 0 (progn (end-of-line) (forward-line 1)))) - (setq done t - end (point))) - ((not (filladapt-tokens-match-p - token-list - (setq curr-list (filladapt-parse-prefixes)))) - (setq done t - end (point))) - ((filladapt-paragraph-start curr-list) - (setq done t - end (point)))))) - (narrow-to-region beg end) - ;; Multiple spaces after the bullet at the start of - ;; a hanging list paragraph get squashed by - ;; fill-paragraph. We kludge around this by - ;; replacing the line prefix with the fill-prefix - ;; used by the rest of the lines in the paragraph. - ;; fill-paragraph will not alter the fill prefix so - ;; we win. The post hook restores the old line prefix - ;; after fill-paragraph has been called. - (if (and paragraph (not debugging)) - (let (col) - (setq col (nth 1 (car (filladapt-tail token-list)))) - (goto-char (point-min)) - (move-to-column col) - (setq filladapt-old-line-prefix - (buffer-substring (point-min) (point))) - (delete-region (point-min) (point)) - (insert fill-prefix) - (add-hook 'filladapt-fill-paragraph-post-hook - 'filladapt-cleanup-kludge-at-point-min))))) - t )))) - -(defun filladapt-cleanup-kludge-at-point-min () - "Cleanup the paragraph fill kludge. -See filladapt-adapt." - (save-excursion - (goto-char (point-min)) - (insert filladapt-old-line-prefix) - (delete-char (length fill-prefix)) - (remove-hook 'filladapt-fill-paragraph-post-hook - 'filladapt-cleanup-kludge-at-point-min))) - -(defun filladapt-tail (list) - "Returns the last cons in LIST." - (if (null list) - nil - (while (consp (cdr list)) - (setq list (cdr list))) - list )) - -(defun filladapt-delete-extent (e) - (if (fboundp 'delete-extent) - (delete-extent e) - (delete-overlay e))) - -(defun filladapt-make-extent (beg end) - (if (fboundp 'make-extent) - (make-extent beg end) - (make-overlay beg end))) - -(defun filladapt-set-extent-endpoints (e beg end) - (if (fboundp 'set-extent-endpoints) - (set-extent-endpoints e beg end) - (move-overlay e beg end))) - -(defun filladapt-set-extent-property (e prop val) - (if (fboundp 'set-extent-property) - (set-extent-property e prop val) - (overlay-put e prop val))) - -(defun filladapt-debug () - "Toggle filladapt debugging on/off in the current buffer." -;; (interactive) - (make-local-variable 'filladapt-debug) - (setq filladapt-debug (not filladapt-debug)) - (if (null filladapt-debug) - (progn - (mapcar (function (lambda (e) (filladapt-set-extent-endpoints e 1 1))) - filladapt-debug-indentation-extents) - (if filladapt-debug-paragraph-extent - (progn - (filladapt-delete-extent filladapt-debug-paragraph-extent) - (setq filladapt-debug-paragraph-extent nil))))) - (add-hook 'post-command-hook 'filladapt-display-debug-info-maybe)) - -(defun filladapt-display-debug-info-maybe () - (cond ((null filladapt-debug) nil) - (fill-prefix nil) - (t - (if (null filladapt-debug-paragraph-extent) - (let ((e (filladapt-make-extent 1 1))) - (filladapt-set-extent-property e 'detachable nil) - (filladapt-set-extent-property e 'evaporate nil) - (filladapt-set-extent-property e 'face - filladapt-debug-paragraph-face) - (setq filladapt-debug-paragraph-extent e))) - (save-excursion - (save-restriction - (let ((ei-list filladapt-debug-indentation-extents) - (ep filladapt-debug-paragraph-extent) - (face filladapt-debug-indentation-face-1) - fill-prefix token-list) - (if (null (filladapt-adapt t t)) - (progn - (filladapt-set-extent-endpoints ep 1 1) - (while ei-list - (filladapt-set-extent-endpoints (car ei-list) 1 1) - (setq ei-list (cdr ei-list)))) - (filladapt-set-extent-endpoints ep (point-min) (point-max)) - (beginning-of-line) - (setq token-list (filladapt-parse-prefixes)) - (message "(%s)" (mapconcat (function - (lambda (q) (symbol-name (car q)))) - token-list - " ")) - (while token-list - (if ei-list - (setq e (car ei-list) - ei-list (cdr ei-list)) - (setq e (filladapt-make-extent 1 1)) - (filladapt-set-extent-property e 'detachable nil) - (filladapt-set-extent-property e 'evaporate nil) - (setq filladapt-debug-indentation-extents - (cons e filladapt-debug-indentation-extents))) - (filladapt-set-extent-property e 'face face) - (filladapt-set-extent-endpoints e (point) - (progn - (move-to-column - (nth 1 - (car token-list))) - (point))) - (if (eq face filladapt-debug-indentation-face-1) - (setq face filladapt-debug-indentation-face-2) - (setq face filladapt-debug-indentation-face-1)) - (setq token-list (cdr token-list))) - (while ei-list - (filladapt-set-extent-endpoints (car ei-list) 1 1) - (setq ei-list (cdr ei-list))))))))))