lisp/indent.el

   1 ;;; indent.el --- indentation commands for Emacs  -*- lexical-binding:t -*-
   2
   3 ;; Copyright (C) 1985, 1995, 2001-2017 Free Software Foundation, Inc.
   4
   5 ;; Maintainer: emacs-devel@gnu.org
   6 ;; Package: emacs
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; Commands for making and changing indentation in text.  These are
  26 ;; described in the Emacs manual.
  27
  28 ;;; Code:
  29
  30 (defgroup indent nil
  31   "Indentation commands."
  32   :group 'editing)
  33
  34 (defcustom standard-indent 4
  35   "Default number of columns for margin-changing functions to indent."
  36   :group 'indent
  37   :type 'integer)
  38
  39 (defvar indent-line-function 'indent-relative
  40   "Function to indent the current line.
  41 This function will be called with no arguments.
  42 If it is called somewhere where auto-indentation cannot be done
  43 \(e.g. inside a string), the function should simply return `noindent'.
  44 Setting this function is all you need to make TAB indent appropriately.
  45 Don't rebind TAB unless you really need to.")
  46
  47 (defcustom tab-always-indent t
  48   "Controls the operation of the TAB key.
  49 If t, hitting TAB always just indents the current line.
  50 If nil, hitting TAB indents the current line if point is at the left margin
  51 or in the line's indentation, otherwise it inserts a \"real\" TAB character.
  52 If `complete', TAB first tries to indent the current line, and if the line
  53 was already indented, then try to complete the thing at point.
  54
  55 Some programming language modes have their own variable to control this,
  56 e.g., `c-tab-always-indent', and do not respect this variable."
  57   :group 'indent
  58   :type '(choice
  59           (const :tag "Always indent" t)
  60           (const :tag "Indent if inside indentation, else TAB" nil)
  61           (const :tag "Indent, or if already indented complete" complete)))
  62
  63
  64 (defun indent-according-to-mode ()
  65   "Indent line in proper way for current major mode.
  66 Normally, this is done by calling the function specified by the
  67 variable `indent-line-function'.  However, if the value of that
  68 variable is `indent-relative' or `indent-relative-maybe', handle
  69 it specially (since those functions are used for tabbing); in
  70 that case, indent by aligning to the previous non-blank line."
  71   (interactive)
  72   (syntax-propertize (line-end-position))
  73   (if (memq indent-line-function
  74             '(indent-relative indent-relative-maybe))
  75       ;; These functions are used for tabbing, but can't be used for
  76       ;; indenting.  Replace with something ad-hoc.
  77       (let ((column (save-excursion
  78                       (beginning-of-line)
  79                       (if (bobp) 0
  80                         (beginning-of-line 0)
  81                         (if (looking-at "[ \t]*$") 0
  82                           (current-indentation))))))
  83         (if (<= (current-column) (current-indentation))
  84             (indent-line-to column)
  85           (save-excursion (indent-line-to column))))
  86     ;; The normal case.
  87     (funcall indent-line-function)))
  88
  89 (defun indent--default-inside-comment ()
  90   (unless (or (> (current-column) (current-indentation))
  91               (eq this-command last-command))
  92     (let ((ppss (syntax-ppss)))
  93       (when (nth 4 ppss)
  94         (indent-line-to
  95          (save-excursion
  96            (forward-line -1)
  97            (skip-chars-forward " \t")
  98            (when (< (1- (point)) (nth 8 ppss) (line-end-position))
  99              (goto-char (nth 8 ppss))
 100              (when (looking-at comment-start-skip)
 101                (goto-char (match-end 0))))
 102            (current-column)))
 103         t))))
 104
 105 (defun indent-for-tab-command (&optional arg)
 106   "Indent the current line or region, or insert a tab, as appropriate.
 107 This function either inserts a tab, or indents the current line,
 108 or performs symbol completion, depending on `tab-always-indent'.
 109 The function called to actually indent the line or insert a tab
 110 is given by the variable `indent-line-function'.
 111
 112 If a prefix argument is given, after this function indents the
 113 current line or inserts a tab, it also rigidly indents the entire
 114 balanced expression which starts at the beginning of the current
 115 line, to reflect the current line's indentation.
 116
 117 In most major modes, if point was in the current line's
 118 indentation, it is moved to the first non-whitespace character
 119 after indenting; otherwise it stays at the same position relative
 120 to the text.
 121
 122 If `transient-mark-mode' is turned on and the region is active,
 123 this function instead calls `indent-region'.  In this case, any
 124 prefix argument is ignored."
 125   (interactive "P")
 126   (cond
 127    ;; The region is active, indent it.
 128    ((use-region-p)
 129     (indent-region (region-beginning) (region-end)))
 130    ((or ;; indent-to-left-margin is only meant for indenting,
 131         ;; so we force it to always insert a tab here.
 132         (eq indent-line-function 'indent-to-left-margin)
 133         (and (not tab-always-indent)
 134              (or (> (current-column) (current-indentation))
 135                  (eq this-command last-command))))
 136     (insert-tab arg))
 137    (t
 138     (let ((old-tick (buffer-chars-modified-tick))
 139           (old-point (point))
 140           (old-indent (current-indentation)))
 141
 142       ;; Indent the line.
 143       (or (not (eq (funcall indent-line-function) 'noindent))
 144           (indent--default-inside-comment)
 145           (when (or (<= (current-column) (current-indentation))
 146                     (not (eq tab-always-indent 'complete)))
 147             (funcall (default-value 'indent-line-function))))
 148
 149       (cond
 150        ;; If the text was already indented right, try completion.
 151        ((and (eq tab-always-indent 'complete)
 152              (eq old-point (point))
 153              (eq old-tick (buffer-chars-modified-tick)))
 154         (completion-at-point))
 155
 156        ;; If a prefix argument was given, rigidly indent the following
 157        ;; sexp to match the change in the current line's indentation.
 158        (arg
 159         (let ((end-marker
 160                (save-excursion
 161                  (forward-line 0) (forward-sexp) (point-marker)))
 162               (indentation-change (- (current-indentation) old-indent)))
 163           (save-excursion
 164             (forward-line 1)
 165             (when (and (not (zerop indentation-change))
 166                        (< (point) end-marker))
 167               (indent-rigidly (point) end-marker indentation-change))))))))))
 168
 169 (defun insert-tab (&optional arg)
 170   (let ((count (prefix-numeric-value arg)))
 171     (if (and abbrev-mode
 172              (eq (char-syntax (preceding-char)) ?w))
 173         (expand-abbrev))
 174     (if indent-tabs-mode
 175         (insert-char ?\t count)
 176       (indent-to (* tab-width (+ count (/ (current-column) tab-width)))))))
 177
 178 (defun indent-rigidly--current-indentation (beg end)
 179   "Return the smallest indentation in range from BEG to END.
 180 Blank lines are ignored."
 181   (save-excursion
 182     (save-match-data
 183       (let ((beg (progn (goto-char beg) (line-beginning-position)))
 184             indent)
 185         (goto-char beg)
 186         (while (re-search-forward "^\\s-*[[:print:]]" end t)
 187           (setq indent (min (or indent (current-indentation))
 188                             (current-indentation))))
 189         indent))))
 190
 191 (defvar indent-rigidly-map
 192   (let ((map (make-sparse-keymap)))
 193     (define-key map [left]  'indent-rigidly-left)
 194     (define-key map [right] 'indent-rigidly-right)
 195     (define-key map [S-left]  'indent-rigidly-left-to-tab-stop)
 196     (define-key map [S-right] 'indent-rigidly-right-to-tab-stop)
 197     map)
 198   "Transient keymap for adjusting indentation interactively.
 199 It is activated by calling `indent-rigidly' interactively.")
 200
 201 (defun indent-rigidly (start end arg &optional interactive)
 202   "Indent all lines starting in the region.
 203 If called interactively with no prefix argument, activate a
 204 transient mode in which the indentation can be adjusted interactively
 205 by typing \\<indent-rigidly-map>\\[indent-rigidly-left], \\[indent-rigidly-right], \\[indent-rigidly-left-to-tab-stop], or \\[indent-rigidly-right-to-tab-stop].
 206 Typing any other key deactivates the transient mode.
 207
 208 If called from a program, or interactively with prefix ARG,
 209 indent all lines starting in the region forward by ARG columns.
 210 If called from a program, START and END specify the beginning and
 211 end of the text to act on, in place of the region.
 212
 213 Negative values of ARG indent backward, so you can remove all
 214 indentation by specifying a large negative ARG."
 215   (interactive "r\nP\np")
 216   (if (and (not arg) interactive)
 217       (progn
 218         (message
 219          (substitute-command-keys
 220           "Indent region with \\<indent-rigidly-map>\\[indent-rigidly-left], \\[indent-rigidly-right], \\[indent-rigidly-left-to-tab-stop], or \\[indent-rigidly-right-to-tab-stop]."))
 221         (set-transient-map indent-rigidly-map t #'deactivate-mark))
 222     (save-excursion
 223       (goto-char end)
 224       (setq end (point-marker))
 225       (goto-char start)
 226       (or (bolp) (forward-line 1))
 227       (while (< (point) end)
 228         (let ((indent (current-indentation))
 229               eol-flag)
 230           (save-excursion
 231             (skip-chars-forward " \t")
 232             (setq eol-flag (eolp)))
 233           (or eol-flag
 234               (indent-to (max 0 (+ indent (prefix-numeric-value arg))) 0))
 235           (delete-region (point) (progn (skip-chars-forward " \t") (point))))
 236         (forward-line 1))
 237       (move-marker end nil)
 238       ;; Keep the active region in transient mode.
 239       (when (eq (cadr overriding-terminal-local-map) indent-rigidly-map)
 240         (setq deactivate-mark nil)))))
 241
 242 (defun indent-rigidly--pop-undo ()
 243   (and (memq last-command '(indent-rigidly-left indent-rigidly-right
 244                             indent-rigidly-left-to-tab-stop
 245                             indent-rigidly-right-to-tab-stop))
 246        (consp buffer-undo-list)
 247        (eq (car buffer-undo-list) nil)
 248        (pop buffer-undo-list)))
 249
 250 (defun indent-rigidly-left (beg end)
 251   "Indent all lines between BEG and END leftward by one space."
 252   (interactive "r")
 253   (indent-rigidly--pop-undo)
 254   (indent-rigidly
 255    beg end
 256    (if (eq (current-bidi-paragraph-direction) 'right-to-left) 1 -1)))
 257
 258 (defun indent-rigidly-right (beg end)
 259   "Indent all lines between BEG and END rightward by one space."
 260   (interactive "r")
 261   (indent-rigidly--pop-undo)
 262   (indent-rigidly
 263    beg end
 264    (if (eq (current-bidi-paragraph-direction) 'right-to-left) -1 1)))
 265
 266 (defun indent-rigidly-left-to-tab-stop (beg end)
 267   "Indent all lines between BEG and END leftward to a tab stop."
 268   (interactive "r")
 269   (indent-rigidly--pop-undo)
 270   (let* ((current (indent-rigidly--current-indentation beg end))
 271          (rtl (eq (current-bidi-paragraph-direction) 'right-to-left))
 272          (next (indent-next-tab-stop current (if rtl nil 'prev))))
 273     (indent-rigidly beg end (- next current))))
 274
 275 (defun indent-rigidly-right-to-tab-stop (beg end)
 276   "Indent all lines between BEG and END rightward to a tab stop."
 277   (interactive "r")
 278   (indent-rigidly--pop-undo)
 279   (let* ((current (indent-rigidly--current-indentation beg end))
 280          (rtl (eq (current-bidi-paragraph-direction) 'right-to-left))
 281          (next (indent-next-tab-stop current (if rtl 'prev))))
 282     (indent-rigidly beg end (- next current))))
 283
 284 (defun indent-line-to (column)
 285   "Indent current line to COLUMN.
 286 This function removes or adds spaces and tabs at beginning of line
 287 only if necessary.  It leaves point at end of indentation."
 288   (back-to-indentation)
 289   (let ((cur-col (current-column)))
 290     (cond ((< cur-col column)
 291            (if (>= (- column (* (/ cur-col tab-width) tab-width)) tab-width)
 292                (delete-region (point)
 293                               (progn (skip-chars-backward " ") (point))))
 294            (indent-to column))
 295           ((> cur-col column) ; too far right (after tab?)
 296            (delete-region (progn (move-to-column column t) (point))
 297                           (progn (backward-to-indentation 0) (point)))))))
 298
 299 (defun current-left-margin ()
 300   "Return the left margin to use for this line.
 301 This is the value of the buffer-local variable `left-margin' plus the value
 302 of the `left-margin' text-property at the start of the line."
 303   (save-excursion
 304     (back-to-indentation)
 305     (max 0
 306          (+ left-margin (or (get-text-property
 307                              (if (and (eobp) (not (bobp)))
 308                                  (1- (point)) (point))
 309                              'left-margin) 0)))))
 310
 311 (defun move-to-left-margin (&optional n force)
 312   "Move to the left margin of the current line.
 313 With optional argument, move forward N-1 lines first.
 314 The column moved to is the one given by the `current-left-margin' function.
 315 If the line's indentation appears to be wrong, and this command is called
 316 interactively or with optional argument FORCE, it will be fixed."
 317   (interactive (list (prefix-numeric-value current-prefix-arg) t))
 318   (beginning-of-line n)
 319   (skip-chars-forward " \t")
 320   (if (minibufferp (current-buffer))
 321       (if (save-excursion (beginning-of-line) (bobp))
 322           (goto-char (minibuffer-prompt-end))
 323         (beginning-of-line))
 324     (let ((lm (current-left-margin))
 325           (cc (current-column)))
 326       (cond ((> cc lm)
 327              (if (> (move-to-column lm force) lm)
 328                  ;; If lm is in a tab and we are not forcing, move before tab
 329                  (backward-char 1)))
 330             ((and force (< cc lm))
 331              (indent-to-left-margin))))))
 332
 333 ;; This used to be the default indent-line-function,
 334 ;; used in Fundamental Mode, Text Mode, etc.
 335 (defun indent-to-left-margin ()
 336   "Indent current line to the column given by `current-left-margin'."
 337   (save-excursion (indent-line-to (current-left-margin)))
 338   ;; If we are within the indentation, move past it.
 339   (when (save-excursion
 340           (skip-chars-backward " \t")
 341           (bolp))
 342     (skip-chars-forward " \t")))
 343
 344 (defun delete-to-left-margin (&optional from to)
 345   "Remove left margin indentation from a region.
 346 This deletes to the column given by `current-left-margin'.
 347 In no case will it delete non-whitespace.
 348 Args FROM and TO are optional; default is the whole buffer."
 349   (save-excursion
 350     (goto-char (or to (point-max)))
 351     (setq to (point-marker))
 352     (goto-char (or from (point-min)))
 353     (or (bolp) (forward-line 1))
 354     (while (< (point) to)
 355       (delete-region (point) (progn (move-to-left-margin nil t) (point)))
 356       (forward-line 1))
 357     (move-marker to nil)))
 358
 359 (defun set-left-margin (from to width)
 360   "Set the left margin of the region to WIDTH.
 361 If `auto-fill-mode' is active, re-fill the region to fit the new margin.
 362
 363 Interactively, WIDTH is the prefix argument, if specified.
 364 Without prefix argument, the command prompts for WIDTH."
 365   (interactive "r\nNSet left margin to column: ")
 366   (save-excursion
 367     ;; If inside indentation, start from BOL.
 368     (goto-char from)
 369     (skip-chars-backward " \t")
 370     (if (bolp) (setq from (point)))
 371     ;; Place end after whitespace
 372     (goto-char to)
 373     (skip-chars-forward " \t")
 374     (setq to (point-marker)))
 375   ;; Delete margin indentation first, but keep paragraph indentation.
 376   (delete-to-left-margin from to)
 377   (put-text-property from to 'left-margin width)
 378   (indent-rigidly from to width)
 379   (if auto-fill-function (save-excursion (fill-region from to nil t t)))
 380   (move-marker to nil))
 381
 382 (defun set-right-margin (from to width)
 383   "Set the right margin of the region to WIDTH.
 384 If `auto-fill-mode' is active, re-fill the region to fit the new margin.
 385
 386 Interactively, WIDTH is the prefix argument, if specified.
 387 Without prefix argument, the command prompts for WIDTH."
 388   (interactive "r\nNSet right margin to width: ")
 389   (save-excursion
 390     (goto-char from)
 391     (skip-chars-backward " \t")
 392     (if (bolp) (setq from (point))))
 393   (put-text-property from to 'right-margin width)
 394   (if auto-fill-function (save-excursion (fill-region from to nil t t))))
 395
 396 (defun alter-text-property (from to prop func &optional object)
 397   "Programmatically change value of a text-property.
 398 For each region between FROM and TO that has a single value for PROPERTY,
 399 apply FUNCTION to that value and sets the property to the function's result.
 400 Optional fifth argument OBJECT specifies the string or buffer to operate on."
 401   (let ((begin from)
 402         end val)
 403     (while (setq val (get-text-property begin prop object)
 404                  end (text-property-not-all begin to prop val object))
 405       (put-text-property begin end prop (funcall func val) object)
 406       (setq begin end))
 407     (if (< begin to)
 408         (put-text-property begin to prop (funcall func val) object))))
 409
 410 (defun increase-left-margin (from to inc)
 411   "Increase or decrease the left-margin of the region.
 412 With no prefix argument, this adds `standard-indent' of indentation.
 413 A prefix arg (optional third arg INC noninteractively) specifies the amount
 414 to change the margin by, in characters.
 415 If `auto-fill-mode' is active, re-fill the region to fit the new margin."
 416   (interactive "*r\nP")
 417   (setq inc (if inc (prefix-numeric-value inc) standard-indent))
 418   (save-excursion
 419     (goto-char from)
 420     (skip-chars-backward " \t")
 421     (if (bolp) (setq from (point)))
 422     (goto-char to)
 423     (setq to (point-marker)))
 424   (alter-text-property from to 'left-margin
 425                        (lambda (v) (max (- left-margin) (+ inc (or v 0)))))
 426   (indent-rigidly from to inc)
 427   (if auto-fill-function (save-excursion (fill-region from to nil t t)))
 428   (move-marker to nil))
 429
 430 (defun decrease-left-margin (from to inc)
 431   "Make the left margin of the region smaller.
 432 With no prefix argument, decrease the indentation by `standard-indent'.
 433 A prefix arg (optional third arg INC noninteractively) specifies the amount
 434 to change the margin by, in characters.
 435 If `auto-fill-mode' is active, re-fill the region to fit the new margin."
 436   (interactive "*r\nP")
 437   (setq inc (if inc (prefix-numeric-value inc) standard-indent))
 438   (increase-left-margin from to (- inc)))
 439
 440 (defun increase-right-margin (from to inc)
 441   "Increase the right-margin of the region.
 442 With no prefix argument, increase the right margin by `standard-indent'.
 443 A prefix arg (optional third arg INC noninteractively) specifies the amount
 444 to change the margin by, in characters.  A negative argument decreases
 445 the right margin width.
 446 If `auto-fill-mode' is active, re-fill the region to fit the new margin."
 447   (interactive "r\nP")
 448   (setq inc (if inc (prefix-numeric-value inc) standard-indent))
 449   (save-excursion
 450     (alter-text-property from to 'right-margin
 451                          (lambda (v) (+ inc (or v 0))))
 452     (if auto-fill-function
 453         (fill-region from to nil t t))))
 454
 455 (defun decrease-right-margin (from to inc)
 456   "Make the right margin of the region smaller.
 457 With no prefix argument, decrease the right margin by `standard-indent'.
 458 A prefix arg (optional third arg INC noninteractively) specifies the amount
 459 of width to remove, in characters.  A negative argument increases
 460 the right margin width.
 461 If `auto-fill-mode' is active, re-fills region to fit in new margin."
 462   (interactive "*r\nP")
 463   (setq inc (if inc (prefix-numeric-value inc) standard-indent))
 464   (increase-right-margin from to (- inc)))
 465
 466 (defun beginning-of-line-text (&optional n)
 467   "Move to the beginning of the text on this line.
 468 With optional argument, move forward N-1 lines first.
 469 From the beginning of the line, moves past the left-margin indentation, the
 470 fill-prefix, and any indentation used for centering or right-justifying the
 471 line, but does not move past any whitespace that was explicitly inserted
 472 \(such as a tab used to indent the first line of a paragraph)."
 473   (interactive "p")
 474   (beginning-of-line n)
 475   (skip-chars-forward " \t")
 476   ;; Skip over fill-prefix.
 477   (if (and fill-prefix
 478            (not (string-equal fill-prefix "")))
 479       (if (equal fill-prefix
 480                  (buffer-substring
 481                   (point) (min (point-max) (+ (length fill-prefix) (point)))))
 482           (forward-char (length fill-prefix)))
 483     (if (and adaptive-fill-mode adaptive-fill-regexp
 484              (looking-at adaptive-fill-regexp))
 485         (goto-char (match-end 0))))
 486   ;; Skip centering or flushright indentation
 487   (if (memq (current-justification) '(center right))
 488       (skip-chars-forward " \t")))
 489
 490 (defvar indent-region-function #'indent-region-line-by-line
 491   "Short cut function to indent region using `indent-according-to-mode'.
 492 Default is to really run `indent-according-to-mode' on each line.")
 493
 494 (defun indent-region (start end &optional column)
 495   "Indent each nonblank line in the region.
 496 A numeric prefix argument specifies a column: indent each line to that column.
 497
 498 With no prefix argument, the command chooses one of these methods and
 499 indents all the lines with it:
 500
 501   1) If `fill-prefix' is non-nil, insert `fill-prefix' at the
 502      beginning of each line in the region that does not already begin
 503      with it.
 504   2) If `indent-region-function' is non-nil, call that function
 505      to indent the region.
 506   3) Indent each line via `indent-according-to-mode'.
 507
 508 Called from a program, START and END specify the region to indent.
 509 If the third argument COLUMN is an integer, it specifies the
 510 column to indent to; if it is nil, use one of the three methods above."
 511   (interactive "r\nP")
 512   (cond
 513    ;; If a numeric prefix is given, indent to that column.
 514    (column
 515     (setq column (prefix-numeric-value column))
 516     (save-excursion
 517       (goto-char end)
 518       (setq end (point-marker))
 519       (goto-char start)
 520       (or (bolp) (forward-line 1))
 521       (while (< (point) end)
 522         (delete-region (point) (progn (skip-chars-forward " \t") (point)))
 523         (or (eolp)
 524             (indent-to column 0))
 525         (forward-line 1))
 526       (move-marker end nil)))
 527    ;; If a fill-prefix is specified, use it.
 528    (fill-prefix
 529     (save-excursion
 530       (goto-char end)
 531       (setq end (point-marker))
 532       (goto-char start)
 533       (let ((regexp (regexp-quote fill-prefix)))
 534         (while (< (point) end)
 535           (or (looking-at regexp)
 536               (and (bolp) (eolp))
 537               (insert fill-prefix))
 538           (forward-line 1)))))
 539    ;; Use indent-region-function is available.
 540    (indent-region-function
 541     (funcall indent-region-function start end))
 542    ;; Else, use a default implementation that calls indent-line-function on
 543    ;; each line.
 544    (t (indent-region-line-by-line start end)))
 545   ;; In most cases, reindenting modifies the buffer, but it may also
 546   ;; leave it unmodified, in which case we have to deactivate the mark
 547   ;; by hand.
 548   (setq deactivate-mark t))
 549
 550 (defun indent-region-line-by-line (start end)
 551   (save-excursion
 552     (setq end (copy-marker end))
 553     (goto-char start)
 554     (let ((pr (unless (minibufferp)
 555                 (make-progress-reporter "Indenting region..." (point) end))))
 556       (while (< (point) end)
 557         (or (and (bolp) (eolp))
 558             (indent-according-to-mode))
 559         (forward-line 1)
 560         (and pr (progress-reporter-update pr (point))))
 561       (and pr (progress-reporter-done pr))
 562       (move-marker end nil))))
 563
 564 (define-obsolete-function-alias 'indent-relative-maybe
 565   'indent-relative-first-indent-point "26.1")
 566
 567 (defun indent-relative-first-indent-point ()
 568   "Indent the current line like the previous nonblank line.
 569 Indent to the first indentation position in the previous nonblank
 570 line if that position is greater than the current column.
 571
 572 See also `indent-relative'."
 573   (interactive)
 574   (indent-relative t))
 575
 576 (defun indent-relative (&optional first-only unindented-ok)
 577   "Space out to under next indent point in previous nonblank line.
 578 An indent point is a non-whitespace character following whitespace.
 579 The following line shows the indentation points in this line.
 580     ^         ^    ^     ^   ^           ^      ^  ^    ^
 581 If FIRST-ONLY is non-nil, then only the first indent point is
 582 considered.
 583
 584 If the previous nonblank line has no indent points beyond the
 585 column point starts at, then `tab-to-tab-stop' is done, if both
 586 FIRST-ONLY and UNINDENTED-OK are nil, otherwise nothing is done
 587 in this case.
 588
 589 See also `indent-relative-first-indent-point'."
 590   (interactive "P")
 591   (if (and abbrev-mode
 592            (eq (char-syntax (preceding-char)) ?w))
 593       (expand-abbrev))
 594   (let ((start-column (current-column))
 595         indent)
 596     (save-excursion
 597       (beginning-of-line)
 598       (if (re-search-backward "^[^\n]" nil t)
 599           (let ((end (save-excursion (forward-line 1) (point))))
 600             (move-to-column start-column)
 601             ;; Is start-column inside a tab on this line?
 602             (if (> (current-column) start-column)
 603                 (backward-char 1))
 604             (or (looking-at "[ \t]")
 605                 first-only
 606                 (skip-chars-forward "^ \t" end))
 607             (skip-chars-forward " \t" end)
 608             (or (= (point) end) (setq indent (current-column))))))
 609     (cond (indent
 610            (let ((opoint (point-marker)))
 611              (indent-to indent 0)
 612              (if (> opoint (point))
 613                  (goto-char opoint))
 614              (move-marker opoint nil)))
 615           (unindented-ok nil)
 616           (t (tab-to-tab-stop)))))
 617
 618 (defcustom tab-stop-list nil
 619   "List of tab stop positions used by `tab-to-tab-stop'.
 620 This should be nil, or a list of integers, ordered from smallest to largest.
 621 It implicitly extends to infinity through repetition of the last step.
 622 For example, (1 2 5) is equivalent to (1 2 5 8 11 ...).  If the list has
 623 fewer than 2 elements, `tab-width' is used as the \"last step\".
 624 A value of nil means a tab stop every `tab-width' columns."
 625   :group 'indent
 626   :version "24.4"                       ; from explicit list to nil
 627   :safe 'listp
 628   :type '(repeat integer))
 629
 630 (defvar edit-tab-stops-map
 631   (let ((map (make-sparse-keymap)))
 632     (define-key map "\C-x\C-s" 'edit-tab-stops-note-changes)
 633     (define-key map "\C-c\C-c" 'edit-tab-stops-note-changes)
 634     map)
 635   "Keymap used in `edit-tab-stops'.")
 636
 637 (defvar edit-tab-stops-buffer nil
 638   "Buffer whose tab stops are being edited.
 639 This matters if the variable `tab-stop-list' is local in that buffer.")
 640
 641 (defun edit-tab-stops ()
 642   "Edit the tab stops used by `tab-to-tab-stop'.
 643 Creates a buffer *Tab Stops* containing text describing the tab stops.
 644 A colon indicates a column where there is a tab stop.
 645 You can add or remove colons and then do \\<edit-tab-stops-map>\\[edit-tab-stops-note-changes] to make changes take effect."
 646   (interactive)
 647   (setq edit-tab-stops-buffer (current-buffer))
 648   (switch-to-buffer (get-buffer-create "*Tab Stops*"))
 649   (use-local-map edit-tab-stops-map)
 650   (setq-local indent-tabs-mode nil)
 651   (overwrite-mode 1)
 652   (setq truncate-lines t)
 653   (erase-buffer)
 654   (let ((tabs tab-stop-list))
 655     (while tabs
 656       (indent-to (car tabs) 0)
 657       (insert ?:)
 658       (setq tabs (cdr tabs))))
 659   (let ((count 0))
 660     (insert ?\n)
 661     (while (< count 8)
 662       (insert (+ count ?0))
 663     (insert "         ")
 664       (setq count (1+ count)))
 665     (insert ?\n)
 666     (while (> count 0)
 667       (insert "0123456789")
 668       (setq count (1- count))))
 669   (insert "\nTo install changes, type C-c C-c")
 670   (goto-char (point-min)))
 671
 672 (defun edit-tab-stops-note-changes ()
 673   "Put edited tab stops into effect."
 674   (interactive)
 675     (let (tabs)
 676       (save-excursion
 677         (goto-char 1)
 678         (end-of-line)
 679         (while (search-backward ":" nil t)
 680           (setq tabs (cons (current-column) tabs))))
 681       (bury-buffer (prog1 (current-buffer)
 682                           (switch-to-buffer edit-tab-stops-buffer)))
 683       (setq tab-stop-list tabs))
 684   (message "Tab stops installed"))
 685
 686 (defun indent-next-tab-stop (column &optional prev)
 687   "Return the next tab stop after COLUMN.
 688 If PREV is non-nil, return the previous one instead."
 689   (let ((tabs tab-stop-list))
 690     (while (and tabs (>= column (car tabs)))
 691       (setq tabs (cdr tabs)))
 692     (if tabs
 693         (if (not prev)
 694             (car tabs)
 695           (let ((prevtabs (cdr (memq (car tabs) (reverse tab-stop-list)))))
 696             (if (null prevtabs) 0
 697               (if (= column (car prevtabs))
 698                   (or (nth 1 prevtabs) 0)
 699                 (car prevtabs)))))
 700       ;; We passed the end of tab-stop-list: guess a continuation.
 701       (let* ((last2 (last tab-stop-list 2))
 702              (step (if (cdr last2) (- (cadr last2) (car last2)) tab-width))
 703              (last (or (cadr last2) (car last2) 0)))
 704         ;; Repeat the last tab's length.
 705         (+ last (* step (if prev
 706                             (if (<= column last) -1 (/ (- column last 1) step))
 707                           (1+ (/ (- column last) step)))))))))
 708
 709 (defun indent-accumulate-tab-stops (limit)
 710   "Get a list of tab stops before LIMIT (inclusive)."
 711   (let ((tab 0) (tab-stops))
 712     (while (<= (setq tab (indent-next-tab-stop tab)) limit)
 713       (push tab tab-stops))
 714     (nreverse tab-stops)))
 715
 716 (defun tab-to-tab-stop ()
 717   "Insert spaces or tabs to next defined tab-stop column.
 718 The variable `tab-stop-list' is a list of columns at which there are tab stops.
 719 Use \\[edit-tab-stops] to edit them interactively."
 720   (interactive)
 721   (and abbrev-mode (= (char-syntax (preceding-char)) ?w)
 722        (expand-abbrev))
 723   (let ((nexttab (indent-next-tab-stop (current-column))))
 724     (delete-horizontal-space t)
 725     (indent-to nexttab)))
 726
 727 (defun move-to-tab-stop ()
 728   "Move point to next defined tab-stop column.
 729 The variable `tab-stop-list' is a list of columns at which there are tab stops.
 730 Use \\[edit-tab-stops] to edit them interactively."
 731   (interactive)
 732   (let ((nexttab (indent-next-tab-stop (current-column))))
 733     (let ((before (point)))
 734       (move-to-column nexttab t)
 735       (save-excursion
 736         (goto-char before)
 737         ;; If we just added a tab, or moved over one,
 738         ;; delete any superfluous spaces before the old point.
 739         (if (and (eq (preceding-char) ?\s)
 740                  (eq (following-char) ?\t))
 741             (let ((tabend (* (/ (current-column) tab-width) tab-width)))
 742               (while (and (> (current-column) tabend)
 743                           (eq (preceding-char) ?\s))
 744                 (forward-char -1))
 745               (delete-region (point) before)))))))
 746
 747 (define-key global-map "\t" 'indent-for-tab-command)
 748 (define-key esc-map "\C-\\" 'indent-region)
 749 (define-key ctl-x-map "\t" 'indent-rigidly)
 750 (define-key esc-map "i" 'tab-to-tab-stop)
 751
 752 ;;; indent.el ends here