Function: align-region
align-region is a byte-compiled function defined in align.el.gz.
Signature
(align-region BEG END SEPARATE RULES EXCLUDE-RULES &optional FUNC)
Documentation
Align a region based on a given set of alignment rules.
BEG and END specify the region to be aligned. Either may be nil, in
which case the range will stop at the nearest section division (see
align-region-separate, and align-region-heuristic for more
information').
The region will be divided into separate alignment sections based on the value of SEPARATE.
RULES and EXCLUDE-RULES are a pair of lists describing how to align
the region, and which text areas within it should be excluded from
alignment. See the align-rules-list for more information on the
required format of these two lists.
If FUNC is specified, no text will be modified. What align-region
will do with the rules is to search for the alignment areas, as it
regularly would, taking account for exclusions, and then call FUNC,
first with the beginning and ending of the region to be aligned
according to that rule (this can be different for each rule, if BEG
and END were nil), and then with the beginning and ending of each
text region that the rule would have applied to.
The signature of FUNC should thus be:
(defun my-align-function (beg end mode)
"If MODE is a rule (a list), return t if BEG to END are to be searched.
Otherwise BEG to END will be a region of text that matches the rule's
definition, and MODE will be non-nil if any changes are necessary."
(unless (and mode (listp mode))
(message "Would have aligned from %d to %d..." beg end)))
This feature (of passing a FUNC) is used internally to locate the position of exclusion areas, but could also be used for any other purpose where you might want to know where the regions that the aligner would have dealt with are.
Source Code
;; Defined in /usr/src/emacs/lisp/align.el.gz
(defun align-region (beg end separate rules exclude-rules
&optional func)
"Align a region based on a given set of alignment rules.
BEG and END specify the region to be aligned. Either may be nil, in
which case the range will stop at the nearest section division (see
`align-region-separate', and `align-region-heuristic' for more
information').
The region will be divided into separate alignment sections based on
the value of SEPARATE.
RULES and EXCLUDE-RULES are a pair of lists describing how to align
the region, and which text areas within it should be excluded from
alignment. See the `align-rules-list' for more information on the
required format of these two lists.
If FUNC is specified, no text will be modified. What `align-region'
will do with the rules is to search for the alignment areas, as it
regularly would, taking account for exclusions, and then call FUNC,
first with the beginning and ending of the region to be aligned
according to that rule (this can be different for each rule, if BEG
and END were nil), and then with the beginning and ending of each
text region that the rule would have applied to.
The signature of FUNC should thus be:
(defun my-align-function (beg end mode)
\"If MODE is a rule (a list), return t if BEG to END are to be searched.
Otherwise BEG to END will be a region of text that matches the rule's
definition, and MODE will be non-nil if any changes are necessary.\"
(unless (and mode (listp mode))
(message \"Would have aligned from %d to %d...\" beg end)))
This feature (of passing a FUNC) is used internally to locate the
position of exclusion areas, but could also be used for any other
purpose where you might want to know where the regions that the
aligner would have dealt with are."
(let ((end-mark (and end (copy-marker end t)))
(real-beg beg)
(report (and (not func) align-large-region beg end
(>= (- end beg) align-large-region)))
(rule-index 1)
(rule-count (length rules))
markers)
(if (and align-indent-before-aligning real-beg end-mark)
(indent-region real-beg end-mark nil))
(while rules
(let* ((rule (car rules))
(run-if (assq 'run-if rule))
(modes (assq 'modes rule)))
;; unless the `run-if' form tells us not to, look for the
;; rule..
(unless (or (and modes (not (apply #'derived-mode-p (eval (cdr modes)))))
(and run-if (not (funcall (cdr run-if)))))
(let* ((case-fold-search case-fold-search)
(case-fold (assq 'case-fold rule))
(regexp (cdr (assq 'regexp rule)))
(regfunc (and (functionp regexp) regexp))
(rulesep (assq 'separate rule))
(thissep (if rulesep (cdr rulesep) separate))
same (eol 0)
search-start
groups ;; group-c
spacing spacing-c
tab-stop tab-stop-c
repeat repeat-c
valid valid-c
first
regions index
last-point
save-match-data
exclude-p
align-props)
(save-excursion
;; if beg and end were not given, figure out what the
;; current alignment region should be. Depending on the
;; value of `align-region-separate' it's possible for
;; each rule to have its own definition of what that
;; current alignment section is.
(if real-beg
(goto-char beg)
(if (or (not thissep) (eq thissep 'entire))
(error "Cannot determine alignment region for `%s'"
(symbol-name (cdr (assq 'title rule)))))
(beginning-of-line)
(while (and (not (eobp))
(looking-at "^\\s-*$"))
(forward-line))
(let* ((here (point))
(start here))
(while (and here
(let ((terminus
(and align-region-heuristic
(- (point)
align-region-heuristic))))
(if regfunc
(funcall regfunc terminus t)
(re-search-backward regexp
terminus t))))
(if (align-new-section-p (point) here thissep)
(setq beg here
here nil)
(setq here (point))))
(if (not here)
(goto-char beg))
(beginning-of-line)
(setq beg (point))
(goto-char start)
(setq here (point))
(while (and here
(let ((terminus
(and align-region-heuristic
(+ (point)
align-region-heuristic))))
(if regfunc
(funcall regfunc terminus nil)
(re-search-forward regexp terminus t))))
(if (align-new-section-p here (point) thissep)
(setq end here
here nil)
(setq here (point))))
(if (not here)
(goto-char end))
(forward-line)
(setq end (point))
(align--set-marker end-mark end t)
(goto-char beg)))
;; If we have a region to align, and `func' is set and
;; reports back that the region is ok, then align it.
(when (or (not func)
(funcall func beg end rule))
(let (rule-beg exclude-areas)
;; determine first of all where the exclusions
;; lie in this region
(when exclude-rules
(align-region
beg end 'entire
exclude-rules nil
(lambda (b e mode)
(or (and mode (listp mode))
(setq exclude-areas
(cons (cons b e)
exclude-areas)))))
(setq exclude-areas
(nreverse
(sort exclude-areas #'car-less-than-car))))
;; set `case-fold-search' according to the
;; (optional) `case-fold' property
(and case-fold
(setq case-fold-search (cdr case-fold)))
;; while we can find the rule in the alignment
;; region..
(while (and (< (point) end-mark)
(setq search-start (point))
(if regfunc
(funcall regfunc end-mark nil)
(re-search-forward regexp
end-mark t)))
;; give the user some indication of where we
;; are, if it's a very large region being
;; aligned
(if report
(let ((symbol (car rule)))
(if (and symbol (symbolp symbol))
(message
"Aligning `%s' (rule %d of %d) %d%%..."
(symbol-name symbol) rule-index rule-count
(floor (* (- (point) real-beg) 100.0)
(- end-mark real-beg)))
(message
"Aligning %d%%..."
(floor (* (- (point) real-beg) 100.0)
(- end-mark real-beg))))))
;; if the search ended us on the beginning of
;; the next line, move back to the end of the
;; previous line.
(if (and (bolp) (> (point) search-start))
(forward-char -1))
;; lookup the `group' attribute the first time
;; that we need it
(unless nil ;; group-c
(setq groups (or (cdr (assq 'group rule)) 1))
(unless (listp groups)
(setq groups (list groups)))
(setq first (car groups)))
(unless spacing-c
(setq spacing (cdr (assq 'spacing rule))
spacing-c t))
(unless tab-stop-c
(setq tab-stop
(let ((rule-ts (assq 'tab-stop rule)))
(cond (rule-ts
(cdr rule-ts))
((symbolp align-to-tab-stop)
(symbol-value align-to-tab-stop))
(t
align-to-tab-stop)))
tab-stop-c t))
;; test whether we have found a match on the same
;; line as a previous match
(when (> (point) eol)
(setq same nil)
(align--set-marker eol (line-end-position)))
;; lookup the `repeat' attribute the first time
(or repeat-c
(setq repeat (cdr (assq 'repeat rule))
repeat-c t))
;; lookup the `valid' attribute the first time
(or valid-c
(setq valid (assq 'valid rule)
valid-c t))
;; remember the beginning position of this rule
;; match, and save the match-data, since either
;; the `valid' form, or the code that searches for
;; section separation, might alter it
(setq rule-beg (match-beginning first)
save-match-data (match-data))
(or rule-beg
(error "No match for subexpression %s" first))
;; unless the `valid' attribute is set, and tells
;; us that the rule is not valid at this point in
;; the code..
(unless (and valid (not (funcall (cdr valid))))
;; look to see if this match begins a new
;; section. If so, we should align what we've
;; collected so far, and then begin collecting
;; anew for the next alignment section
(when (and last-point
(align-new-section-p last-point rule-beg
thissep))
(align-regions regions align-props rule func)
(setq regions nil)
(setq align-props nil))
(align--set-marker last-point rule-beg t)
;; restore the match data
(set-match-data save-match-data)
;; check whether the region to be aligned
;; straddles an exclusion area
(let ((excls exclude-areas))
(setq exclude-p nil)
(while excls
(if (and (< (match-beginning (car groups))
(cdar excls))
(> (match-end (car (last groups)))
(caar excls)))
(setq exclude-p t
excls nil)
(setq excls (cdr excls)))))
;; go through the parenthesis groups
;; matching whitespace to be contracted or
;; expanded (or possibly justified, if the
;; `justify' attribute was set)
(unless exclude-p
(dolist (g groups)
;; We must use markers, since
;; `align-areas' may modify the buffer.
;; Avoid polluting the markers.
(let* ((group-beg (copy-marker
(match-beginning g) t))
(group-end (copy-marker
(match-end g) t))
(region (cons group-beg group-end))
(props (cons (if (listp spacing)
(car spacing)
spacing)
(if (listp tab-stop)
(car tab-stop)
tab-stop))))
(push group-beg markers)
(push group-end markers)
(setq index (if same (1+ index) 0))
(cond
((nth index regions)
(setcar (nthcdr index regions)
(cons region
(nth index regions))))
(regions
(nconc regions
(list (list region)))
(nconc align-props (list props)))
(t
(setq regions
(list (list region)))
(setq align-props (list props)))))
;; If any further rule matches are found
;; before `eol', they are on the same
;; line as this one; this can only
;; happen if the `repeat' attribute is
;; non-nil.
(if (listp spacing)
(setq spacing (cdr spacing)))
(if (listp tab-stop)
(setq tab-stop (cdr tab-stop)))
(setq same t))
;; if `repeat' has not been set, move to
;; the next line; don't bother searching
;; anymore on this one
(if (and (not repeat) (not (bolp)))
(forward-line))
;; if the search did not change point,
;; move forward to avoid an infinite loop
(if (= (point) search-start)
(forward-char)))))
;; when they are no more matches for this rule,
;; align whatever was left over
(if regions
(align-regions regions align-props rule func))))))))
(setq rules (cdr rules)
rule-index (1+ rule-index)))
;; This function can use a lot of temporary markers, so instead of
;; waiting for the next GC we delete them immediately (Bug#10047).
(when end-mark (set-marker end-mark nil))
(dolist (m markers)
(set-marker m nil))
(if report
(message "Aligning...done"))))