Improve filling

* lisp/org.el (org-fill-paragraph): Refine filling in comments and in
  paragraphs.  Allow commented blank lines.  Take into consideration
  the indentation of the second line of the paragraph being filled.
(org-comment-or-uncomment-region): Rewrite function.  Now comment
region at a fixed column: the minimal indentation of the region.
(org-fill-context-prefix): Rename function into
`org-adaptive-fill-function'. Also, In a paragraph, choose the same
prefix as the current line.
This commit is contained in:
Nicolas Goaziou 2012-08-28 13:12:09 +02:00
parent 5590972648
commit 11f119776a
1 changed files with 109 additions and 81 deletions

View File

@ -20988,12 +20988,11 @@ hierarchy of headlines by UP levels before marking the subtree."
;; We use our own fill-paragraph and auto-fill functions. These ;; We use our own fill-paragraph and auto-fill functions. These
;; functions will shadow `fill-prefix' (computed internally with ;; functions will shadow `fill-prefix' (computed internally with
;; `org-fill-context-prefix') and pass through to ;; `org-adaptive-fill-function') and pass through to
;; `fill-region-as-paragraph' and `do-auto-fill' as appropriate. ;; `fill-region-as-paragraph' and `do-auto-fill' as appropriate.
(defun org-set-autofill-regexps () (defun org-set-autofill-regexps ()
(interactive) (interactive)
(org-set-local 'fill-paragraph-function 'org-fill-paragraph)
;; Prevent auto-fill from inserting unwanted new items. ;; Prevent auto-fill from inserting unwanted new items.
(when (boundp 'fill-nobreak-predicate) (when (boundp 'fill-nobreak-predicate)
(org-set-local (org-set-local
@ -21002,6 +21001,8 @@ hierarchy of headlines by UP levels before marking the subtree."
(append fill-nobreak-predicate (append fill-nobreak-predicate
'(org-fill-paragraph-separate-nobreak-p '(org-fill-paragraph-separate-nobreak-p
org-fill-line-break-nobreak-p))))) org-fill-line-break-nobreak-p)))))
(org-set-local 'fill-paragraph-function 'org-fill-paragraph)
(org-set-local 'adaptive-fill-function 'org-adaptive-fill-function)
(org-set-local 'normal-auto-fill-function 'org-auto-fill-function) (org-set-local 'normal-auto-fill-function 'org-auto-fill-function)
(org-set-local 'comment-line-break-function 'org-comment-line-break-function) (org-set-local 'comment-line-break-function 'org-comment-line-break-function)
(org-set-local 'align-mode-rules-list (org-set-local 'align-mode-rules-list
@ -21023,19 +21024,19 @@ hierarchy of headlines by UP levels before marking the subtree."
(declare-function message-in-body-p "message" ()) (declare-function message-in-body-p "message" ())
(defvar org-element--affiliated-re) ; From org-element.el (defvar org-element--affiliated-re) ; From org-element.el
(defun org-fill-context-prefix (p) (defun org-adaptive-fill-function ()
"Compute a fill prefix for the line at point P. "Compute a fill prefix for the current line.
Return fill prefix, as a string, or nil if current line isn't Return fill prefix, as a string, or nil if current line isn't
meant to be filled." meant to be filled."
(org-with-wide-buffer (org-with-wide-buffer
(unless (and (derived-mode-p 'message-mode) (not (message-in-body-p))) (unless (and (derived-mode-p 'message-mode) (not (message-in-body-p)))
;; FIXME: This is really the job of orgstruct++-mode ;; FIXME: This is really the job of orgstruct++-mode
(goto-char p) (let* ((p (line-beginning-position))
(beginning-of-line) (element (save-excursion (beginning-of-line)
(let* ((element (org-element-at-point)) (org-element-at-point)))
(type (org-element-type element)) (type (org-element-type element))
(post-affiliated (post-affiliated
(progn (save-excursion
(goto-char (org-element-property :begin element)) (goto-char (org-element-property :begin element))
(while (looking-at org-element--affiliated-re) (forward-line)) (while (looking-at org-element--affiliated-re) (forward-line))
(point)))) (point))))
@ -21053,7 +21054,7 @@ meant to be filled."
(make-string (org-list-item-body-column (make-string (org-list-item-body-column
(org-element-property :begin parent)) (org-element-property :begin parent))
? )) ? ))
((looking-at "\\s-+") (match-string 0)) ((looking-at "[ \t]*") (match-string 0))
(t "")))) (t ""))))
(comment-block (comment-block
;; Only fill contents if P is within block boundaries. ;; Only fill contents if P is within block boundaries.
@ -21065,7 +21066,7 @@ meant to be filled."
(skip-chars-backward " \r\t\n") (skip-chars-backward " \r\t\n")
(line-beginning-position)))) (line-beginning-position))))
(when (and (>= p cbeg) (< p cend)) (when (and (>= p cbeg) (< p cend))
(if (looking-at "\\s-+") (match-string 0) "")))))))))) (if (looking-at "[ \t]*") (match-string 0) ""))))))))))
(declare-function message-goto-body "message" ()) (declare-function message-goto-body "message" ())
(defvar message-cite-prefix-regexp) ; From message.el (defvar message-cite-prefix-regexp) ; From message.el
@ -21099,12 +21100,12 @@ a footnote definition, try to fill the first paragraph within."
(cadadr (assoc 'paragraph-separate org-fb-vars)))) (cadadr (assoc 'paragraph-separate org-fb-vars))))
(fill-paragraph)) (fill-paragraph))
(save-excursion (save-excursion
;; Move to end of line in order to get the first paragraph within ;; Move to end of line in order to get the first paragraph
;; a plain list or a footnote definition. ;; within a plain list or a footnote definition.
(end-of-line) (end-of-line)
(let ((element (org-element-at-point))) (let ((element (org-element-at-point)))
;; First check if point is in a blank line at the beginning of the ;; First check if point is in a blank line at the beginning of
;; buffer. In that case, ignore filling. ;; the buffer. In that case, ignore filling.
(if (< (point) (org-element-property :begin element)) t (if (< (point) (org-element-property :begin element)) t
(case (org-element-type element) (case (org-element-type element)
;; Align Org tables, leave table.el tables as-is. ;; Align Org tables, leave table.el tables as-is.
@ -21113,8 +21114,8 @@ a footnote definition, try to fill the first paragraph within."
(when (eq (org-element-property :type element) 'org) (when (eq (org-element-property :type element) 'org)
(org-table-align)) (org-table-align))
t) t)
;; Elements that may contain `line-break' type objects.
(paragraph (paragraph
;; Paragraphs may contain `line-break' type objects.
(let ((beg (max (point-min) (let ((beg (max (point-min)
(org-element-property :contents-begin element))) (org-element-property :contents-begin element)))
(end (min (point-max) (end (min (point-max)
@ -21131,20 +21132,20 @@ a footnote definition, try to fill the first paragraph within."
(re-search-forward (re-search-forward
(concat "^" message-cite-prefix-regexp) end t)) (concat "^" message-cite-prefix-regexp) end t))
(setq end (match-beginning 0)))) (setq end (match-beginning 0))))
;; Fill paragraph, taking line breaks into consideration. ;; Fill paragraph, taking line breaks into
;; For that, slice the paragraph using line breaks as ;; consideration. For that, slice the paragraph
;; separators, and fill the parts in reverse order to ;; using line breaks as separators, and fill the
;; avoid messing with markers. ;; parts in reverse order to avoid messing with
;; markers.
(save-excursion (save-excursion
(goto-char end) (goto-char end)
(mapc (mapc
(lambda (pos) (lambda (pos)
(let ((fill-prefix (org-fill-context-prefix pos))) (fill-region-as-paragraph pos (point) justify)
(fill-region-as-paragraph pos (point) justify))
(goto-char pos)) (goto-char pos))
;; Find the list of ending positions for line breaks ;; Find the list of ending positions for line
;; in the current paragraph. Add paragraph beginning ;; breaks in the current paragraph. Add paragraph
;; to include first slice. ;; beginning to include first slice.
(nreverse (nreverse
(cons (cons
beg beg
@ -21154,54 +21155,60 @@ a footnote definition, try to fill the first paragraph within."
'line-break 'line-break
(lambda (lb) (org-element-property :end lb))))))) (lambda (lb) (org-element-property :end lb)))))))
t))) t)))
;; Contents of `comment-block' type elements should be filled as ;; Contents of `comment-block' type elements should be
;; plain text. ;; filled as plain text, but only if point is within block
;; markers.
(comment-block (comment-block
(let ((fill-prefix (org-fill-context-prefix (point)))) (let* ((case-fold-search t)
(save-excursion (beg (save-excursion
(goto-char (org-element-property :begin element))
(re-search-forward "^[ \t]*#\\+begin_comment" nil t)
(forward-line)
(point)))
(end (save-excursion
(goto-char (org-element-property :end element))
(re-search-backward "^[ \t]*#\\+end_comment" nil t)
(line-beginning-position))))
(when (and (>= (point) beg) (< (point) end))
(fill-region-as-paragraph (fill-region-as-paragraph
(progn (save-excursion
(goto-char (org-element-property :begin element)) (end-of-line)
(while (looking-at org-element--affiliated-re) (re-search-backward "^[ \t]*$" beg 'move)
(forward-line))
(forward-line)
(point))
(progn
(goto-char (org-element-property :end element))
(skip-chars-backward " \r\t\n")
(line-beginning-position)) (line-beginning-position))
justify))) t) (save-excursion
;; Fill comments, indented or not. (beginning-of-line)
(comment (re-search-forward "^[ \t]*$" end 'move)
(let ((fill-prefix (org-fill-context-prefix (point)))) (line-beginning-position))
(save-excursion justify)))
(fill-region-as-paragraph t)
(progn ;; Fill comments.
(goto-char (org-element-property :begin element)) (comment (fill-comment-paragraph justify))
(while (looking-at org-element--affiliated-re)
(forward-line))
(point))
(progn
(goto-char (org-element-property :end element))
(skip-chars-backward " \r\t\n")
(line-end-position))))))
;; Ignore every other element. ;; Ignore every other element.
(otherwise t))))))) (otherwise t)))))))
(defun org-auto-fill-function () (defun org-auto-fill-function ()
"Auto-fill function." "Auto-fill function."
;; Check if auto-filling is meaningful before computing fill prefix. ;; Check if auto-filling is meaningful.
(let ((fc (current-fill-column))) (let ((fc (current-fill-column)))
(when (and fc (> (current-column) fc)) (when (and fc (> (current-column) fc))
(let ((fill-prefix (org-fill-context-prefix (point)))) (let ((fill-prefix (org-adaptive-fill-function)))
(when fill-prefix (do-auto-fill)))))) (when fill-prefix (do-auto-fill))))))
;;; Comments ;;; Comments
;; We control comments everywhere. `org-comment-or-uncomment-region' ;; Org comments syntax is quite complex. It requires the entire line
;; and `org-insert-comment' takes care of `comment-dwim' behaviour ;; to be just a comment. Also, even with the right syntax at the
;; while `org-comment-line-break-function' handles auto-filling in ;; beginning of line, some some elements (i.e. verse-block or
;; example-block) don't accept comments. Usual Emacs comment commands
;; cannot cope with those requirements. Therefore, Org replaces them.
;; Org still relies on `comment-dwim', but cannot trust
;; `comment-only-p'. So, `comment-region-function' and
;; `uncomment-region-function' both point
;; to`org-comment-or-uncomment-region'. Also, `org-insert-comment'
;; takes care of insertion of comments at the beginning of line while
;; `org-comment-line-break-function' handles auto-filling in
;; a comment. ;; a comment.
(defun org-insert-comment () (defun org-insert-comment ()
@ -21212,35 +21219,56 @@ If the line is empty, insert comment at its beginning."
(org-indent-line) (org-indent-line)
(insert "# ")) (insert "# "))
(defvar comment-empty-lines) ; From newcomment.el.
(defun org-comment-or-uncomment-region (beg end &rest ignore) (defun org-comment-or-uncomment-region (beg end &rest ignore)
"Comment or uncomment each non-blank line in the region. "Comment or uncomment each non-blank line in the region.
Uncomment each non-blank line between BEG and END if it only Uncomment each non-blank line between BEG and END if it only
contains commented lines. Otherwise, comment them." contains commented lines. Otherwise, comment them."
(save-excursion (save-restriction
(goto-char beg) ;; Restrict region
(skip-chars-forward " \r\t\n" end) (narrow-to-region (save-excursion (goto-char beg)
(beginning-of-line) (skip-chars-forward " \r\t\n" end)
(line-beginning-position))
(save-excursion (goto-char end)
(skip-chars-backward " \r\t\n" beg)
(line-end-position)))
(let ((uncommentp (let ((uncommentp
;; UNCOMMENTP is non-nil when every non blank line between ;; UNCOMMENTP is non-nil when every non blank line between
;; BEG and END is a comment. ;; BEG and END is a comment.
(save-excursion (save-excursion
(while (progn (and (not (eobp)) (goto-char (point-min))
(let ((element (org-element-at-point))) (while (and (not (eobp))
(and (eq (org-element-type element) 'comment) (let ((element (org-element-at-point)))
(goto-char (org-element-property (and (eq (org-element-type element) 'comment)
:end element))))))) (goto-char (min (point-max)
(>= (point) end))) (org-element-property
;; Remove or adding comment markers is going to change end :end element)))))))
;; position so make it a marker. (eobp))))
(end (copy-marker end))) (if uncommentp
(while (< (point) end) ;; Only blank lines and comments in region: uncomment it.
(unless (looking-at "\\s-*$") (save-excursion
(if (not uncommentp) (progn (back-to-indentation) (insert "# ")) (goto-char (point-min))
;; Only comments and blank lines in region: uncomment it. (while (not (eobp))
(looking-at "[ \t]*\\(# ?\\)") (when (looking-at "[ \t]*\\(#\\(?: \\|$\\)\\)")
(replace-match "" nil nil nil 1))) (replace-match "" nil nil nil 1))
(forward-line)) (forward-line)))
(set-marker end nil)))) ;; Comment each line in region.
(let ((min-indent (point-max)))
;; First find the minimum indentation across all lines.
(save-excursion
(goto-char (point-min))
(while (and (not (eobp)) (not (zerop min-indent)))
(unless (looking-at "[ \t]*$")
(setq min-indent (min min-indent (current-indentation))))
(forward-line)))
;; Then loop over all lines.
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(unless (and (not comment-empty-lines) (looking-at "[ \t]*$"))
(org-move-to-column min-indent t)
(insert comment-start))
(forward-line))))))))
(defun org-comment-line-break-function (&optional soft) (defun org-comment-line-break-function (&optional soft)
"Break line at point and indent, continuing comment if within one. "Break line at point and indent, continuing comment if within one.