lisp/indent.el

   1 ;;; indent.el --- indentation commands for Emacs
   2
   3 ;; Copyright (C) 1985, 1995, 2001 Free Software Foundation, Inc.
   4
   5 ;; Maintainer: FSF
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; Commands for making and changing indentation in text.  These are
  27 ;; described in the Emacs manual.
  28
  29 ;;; Code:
  30
  31 (defgroup indent nil
  32   "Indentation commands"
  33   :group 'editing)
  34
  35 (defcustom standard-indent 4
  36   "*Default number of columns for margin-changing functions to indent."
  37   :group 'indent
  38   :type 'integer)
  39
  40 (defvar indent-line-function 'indent-relative
  41   "Function to indent the current line.
  42 This function will be called with no arguments.
  43 If it is called somewhere where auto-indentation cannot be done
  44 \(f.ex. inside a string), the function should simply return `noindent'.
  45 Setting this function is all you need to make TAB indent appropriately.
  46 Don't rebind TAB unless you really need to.")
  47
  48 (defcustom tab-always-indent t
  49   "*Controls the operation of the TAB key.
  50 If t, hitting TAB always just indents the current line.
  51 If nil, hitting TAB indents the current line if point is at the left margin
  52   or in the line's indentation, otherwise it insert a `real' tab character."
  53   :group 'indent
  54   :type '(choice (const nil) (const t) (const always)))
  55
  56 (defun indent-according-to-mode ()
  57   "Indent line in proper way for current major mode."
  58   (interactive)
  59   (if (memq indent-line-function
  60             '(indent-relative indent-relative-maybe))
  61       ;; These functions are used for tabbing, but can't be used for
  62       ;; indenting.  Replace with something ad-hoc.
  63       (let ((column (save-excursion
  64                       (beginning-of-line)
  65                       (skip-chars-backward "\n \t")
  66                       (beginning-of-line)
  67                       (current-indentation))))
  68         (if (<= (current-column) (current-indentation))
  69             (indent-line-to column)
  70           (save-excursion (indent-line-to column))))
  71     ;; The normal case.
  72     (funcall indent-line-function)))
  73
  74 (defun indent-for-tab-command (&optional arg)
  75   "Indent line in proper way for current major mode or insert a tab.
  76 Depending on `tab-always-indent', either insert a tab or indent.
  77 If initial point was within line's indentation, position after
  78 the indentation.  Else stay at same point in text.
  79 The function actually called to indent is determined by the value of
  80 `indent-line-function'."
  81   (interactive "P")
  82   (cond
  83    ((or ;; indent-to-left-margin is only meant for indenting,
  84         ;; so we force it to always insert a tab here.
  85         (eq indent-line-function 'indent-to-left-margin)
  86         (and (not tab-always-indent)
  87              (> (current-column) (current-indentation))))
  88     (insert-tab arg))
  89    ;; Those functions are meant specifically for tabbing and not for
  90    ;; indenting, so we can't pass them to indent-according-to-mode.
  91    ((memq indent-line-function '(indent-relative indent-relative-maybe))
  92     (funcall indent-line-function))
  93    (t ;; The normal case.
  94     (indent-according-to-mode))))
  95
  96 (defun insert-tab (&optional arg)
  97   (let ((count (prefix-numeric-value arg)))
  98     (if (and abbrev-mode
  99              (eq (char-syntax (preceding-char)) ?w))
 100         (expand-abbrev))
 101     (if indent-tabs-mode
 102         (insert-char ?\t count)
 103       (indent-to (* tab-width (+ count (/ (current-column) tab-width)))))))
 104
 105 (defun indent-rigidly (start end arg)
 106   "Indent all lines starting in the region sideways by ARG columns.
 107 Called from a program, takes three arguments, START, END and ARG."
 108   (interactive "r\np")
 109   (save-excursion
 110     (goto-char end)
 111     (setq end (point-marker))
 112     (goto-char start)
 113     (or (bolp) (forward-line 1))
 114     (while (< (point) end)
 115       (let ((indent (current-indentation))
 116             eol-flag)
 117         (save-excursion
 118           (skip-chars-forward " \t")
 119           (setq eol-flag (eolp)))
 120         (or eol-flag
 121             (indent-to (max 0 (+ indent arg)) 0))
 122         (delete-region (point) (progn (skip-chars-forward " \t") (point))))
 123       (forward-line 1))
 124     (move-marker end nil)))
 125
 126 (defun indent-line-to (column)
 127   "Indent current line to COLUMN.
 128 This function removes or adds spaces and tabs at beginning of line
 129 only if necessary.  It leaves point at end of indentation."
 130   (back-to-indentation)
 131   (let ((cur-col (current-column)))
 132     (cond ((< cur-col column)
 133            (if (>= (- column (* (/ cur-col tab-width) tab-width)) tab-width)
 134                (delete-region (point)
 135                               (progn (skip-chars-backward " ") (point))))
 136            (indent-to column))
 137           ((> cur-col column) ; too far right (after tab?)
 138            (delete-region (progn (move-to-column column t) (point))
 139                           (progn (back-to-indentation) (point)))))))
 140
 141 (defun current-left-margin ()
 142   "Return the left margin to use for this line.
 143 This is the value of the buffer-local variable `left-margin' plus the value
 144 of the `left-margin' text-property at the start of the line."
 145   (save-excursion
 146     (back-to-indentation)
 147     (max 0
 148          (+ left-margin (or (get-text-property
 149                              (if (and (eobp) (not (bobp)))
 150                                  (1- (point)) (point))
 151                              'left-margin) 0)))))
 152
 153 (defun move-to-left-margin (&optional n force)
 154   "Move to the left margin of the current line.
 155 With optional argument, move forward N-1 lines first.
 156 The column moved to is the one given by the `current-left-margin' function.
 157 If the line's indentation appears to be wrong, and this command is called
 158 interactively or with optional argument FORCE, it will be fixed."
 159   (interactive (list (prefix-numeric-value current-prefix-arg) t))
 160   (beginning-of-line n)
 161   (skip-chars-forward " \t")
 162   (let ((lm (current-left-margin))
 163         (cc (current-column)))
 164     (cond ((> cc lm)
 165            (if (> (move-to-column lm force) lm)
 166                ;; If lm is in a tab and we are not forcing, move before tab
 167                (backward-char 1)))
 168           ((and force (< cc lm))
 169            (indent-to-left-margin)))))
 170
 171 ;; This is the default indent-line-function,
 172 ;; used in Fundamental Mode, Text Mode, etc.
 173 (defun indent-to-left-margin ()
 174   "Indent current line to the column given by `current-left-margin'."
 175   (indent-line-to (current-left-margin)))
 176
 177 (defun delete-to-left-margin (&optional from to)
 178   "Remove left margin indentation from a region.
 179 This deletes to the column given by `current-left-margin'.
 180 In no case will it delete non-whitespace.
 181 Args FROM and TO are optional; default is the whole buffer."
 182   (save-excursion
 183     (goto-char (or to (point-max)))
 184     (setq to (point-marker))
 185     (goto-char (or from (point-min)))
 186     (or (bolp) (forward-line 1))
 187     (while (< (point) to)
 188       (delete-region (point) (progn (move-to-left-margin nil t) (point)))
 189       (forward-line 1))
 190     (move-marker to nil)))
 191
 192 (defun set-left-margin (from to lm)
 193   "Set the left margin of the region to WIDTH.
 194 If `auto-fill-mode' is active, re-fill the region to fit the new margin."
 195   (interactive "r\nNSet left margin to column: ")
 196   (if (interactive-p) (setq lm (prefix-numeric-value lm)))
 197   (save-excursion
 198     ;; If inside indentation, start from BOL.
 199     (goto-char from)
 200     (skip-chars-backward " \t")
 201     (if (bolp) (setq from (point)))
 202     ;; Place end after whitespace
 203     (goto-char to)
 204     (skip-chars-forward " \t")
 205     (setq to (point-marker)))
 206   ;; Delete margin indentation first, but keep paragraph indentation.
 207   (delete-to-left-margin from to)
 208   (put-text-property from to 'left-margin lm)
 209   (indent-rigidly from to lm)
 210   (if auto-fill-function (save-excursion (fill-region from to nil t t)))
 211   (move-marker to nil))
 212
 213 (defun set-right-margin (from to lm)
 214   "Set the right margin of the region to WIDTH.
 215 If `auto-fill-mode' is active, re-fill the region to fit the new margin."
 216   (interactive "r\nNSet right margin to width: ")
 217   (if (interactive-p) (setq lm (prefix-numeric-value lm)))
 218   (save-excursion
 219     (goto-char from)
 220     (skip-chars-backward " \t")
 221     (if (bolp) (setq from (point))))
 222   (put-text-property from to 'right-margin lm)
 223   (if auto-fill-function (save-excursion (fill-region from to nil t t))))
 224
 225 (defun alter-text-property (from to prop func &optional object)
 226   "Programmatically change value of a text-property.
 227 For each region between FROM and TO that has a single value for PROPERTY,
 228 apply FUNCTION to that value and sets the property to the function's result.
 229 Optional fifth argument OBJECT specifies the string or buffer to operate on."
 230   (let ((begin from)
 231         end val)
 232     (while (setq val (get-text-property begin prop object)
 233                  end (text-property-not-all begin to prop val object))
 234       (put-text-property begin end prop (funcall func val) object)
 235       (setq begin end))
 236     (if (< begin to)
 237         (put-text-property begin to prop (funcall func val) object))))
 238
 239 (defun increase-left-margin (from to inc)
 240   "Increase or decrease the left-margin of the region.
 241 With no prefix argument, this adds `standard-indent' of indentation.
 242 A prefix arg (optional third arg INC noninteractively) specifies the amount
 243 to change the margin by, in characters.
 244 If `auto-fill-mode' is active, re-fill the region to fit the new margin."
 245   (interactive "*r\nP")
 246   (setq inc (if inc (prefix-numeric-value inc) standard-indent))
 247   (save-excursion
 248     (goto-char from)
 249     (skip-chars-backward " \t")
 250     (if (bolp) (setq from (point)))
 251     (goto-char to)
 252     (setq to (point-marker)))
 253   (alter-text-property from to 'left-margin
 254                        (lambda (v) (max (- left-margin) (+ inc (or v 0)))))
 255   (indent-rigidly from to inc)
 256   (if auto-fill-function (save-excursion (fill-region from to nil t t)))
 257   (move-marker to nil))
 258
 259 (defun decrease-left-margin (from to inc)
 260   "Make the left margin of the region smaller.
 261 With no prefix argument, decrease the indentation by `standard-indent'.
 262 A prefix arg (optional third arg INC noninteractively) specifies the amount
 263 to change the margin by, in characters.
 264 If `auto-fill-mode' is active, re-fill the region to fit the new margin."
 265   (interactive "*r\nP")
 266   (setq inc (if inc (prefix-numeric-value inc) standard-indent))
 267   (increase-left-margin from to (- inc)))
 268
 269 (defun increase-right-margin (from to inc)
 270   "Increase the right-margin of the region.
 271 With no prefix argument, increase the right margin by `standard-indent'.
 272 A prefix arg (optional third arg INC noninteractively) specifies the amount
 273 to change the margin by, in characters.  A negative argument decreases
 274 the right margin width.
 275 If `auto-fill-mode' is active, re-fill the region to fit the new margin."
 276   (interactive "r\nP")
 277   (if (interactive-p)
 278       (setq inc (if inc (prefix-numeric-value current-prefix-arg)
 279                   standard-indent)))
 280   (save-excursion
 281     (alter-text-property from to 'right-margin
 282        (lambda (v) (+ inc (or v 0))))
 283     (if auto-fill-function
 284         (fill-region from to nil t t))))
 285
 286 (defun decrease-right-margin (from to inc)
 287   "Make the right margin of the region smaller.
 288 With no prefix argument, decrease the right margin by `standard-indent'.
 289 A prefix arg (optional third arg INC noninteractively) specifies the amount
 290 of width to remove, in characters.  A negative argument increases
 291 the right margin width.
 292 If `auto-fill-mode' is active, re-fills region to fit in new margin."
 293   (interactive "*r\nP")
 294   (setq inc (if inc (prefix-numeric-value inc) standard-indent))
 295   (increase-right-margin from to (- inc)))
 296
 297 (defun beginning-of-line-text (&optional n)
 298   "Move to the beginning of the text on this line.
 299 With optional argument, move forward N-1 lines first.
 300 From the beginning of the line, moves past the left-margin indentation, the
 301 fill-prefix, and any indentation used for centering or right-justifying the
 302 line, but does not move past any whitespace that was explicitly inserted
 303 \(such as a tab used to indent the first line of a paragraph)."
 304   (interactive "p")
 305   (beginning-of-line n)
 306   (skip-chars-forward " \t")
 307   ;; Skip over fill-prefix.
 308   (if (and fill-prefix
 309            (not (string-equal fill-prefix "")))
 310       (if (equal fill-prefix
 311                  (buffer-substring
 312                   (point) (min (point-max) (+ (length fill-prefix) (point)))))
 313           (forward-char (length fill-prefix)))
 314     (if (and adaptive-fill-mode adaptive-fill-regexp
 315              (looking-at adaptive-fill-regexp))
 316         (goto-char (match-end 0))))
 317   ;; Skip centering or flushright indentation
 318   (if (memq (current-justification) '(center right))
 319       (skip-chars-forward " \t")))
 320
 321 (defvar indent-region-function nil
 322   "Short cut function to indent region using `indent-according-to-mode'.
 323 A value of nil means really run `indent-according-to-mode' on each line.")
 324
 325 (defun indent-region (start end column)
 326   "Indent each nonblank line in the region.
 327 With prefix no argument, indent each line using `indent-according-to-mode',
 328 or use `indent-region-function' to do the whole region if that's non-nil.
 329 If there is a fill prefix, make each line start with the fill prefix.
 330 With argument COLUMN, indent each line to that column.
 331
 332 When you call this from a program, START and END specify
 333 the region to indent, and COLUMN specifies the indentation column.
 334 If COLUMN is nil, then indent each line according to the mode."
 335   (interactive "r\nP")
 336   (if (null column)
 337       (if fill-prefix
 338           (save-excursion
 339             (goto-char end)
 340             (setq end (point-marker))
 341             (goto-char start)
 342             (let ((regexp (regexp-quote fill-prefix)))
 343               (while (< (point) end)
 344                 (or (looking-at regexp)
 345                     (and (bolp) (eolp))
 346                     (insert fill-prefix))
 347                 (forward-line 1))))
 348         (if indent-region-function
 349             (funcall indent-region-function start end)
 350           (save-excursion
 351             (setq end (copy-marker end))
 352             (goto-char start)
 353             (while (< (point) end)
 354               (or (and (bolp) (eolp))
 355                   (funcall indent-line-function))
 356               (forward-line 1))
 357             (move-marker end nil))))
 358     (setq column (prefix-numeric-value column))
 359     (save-excursion
 360       (goto-char end)
 361       (setq end (point-marker))
 362       (goto-char start)
 363       (or (bolp) (forward-line 1))
 364       (while (< (point) end)
 365         (delete-region (point) (progn (skip-chars-forward " \t") (point)))
 366         (or (eolp)
 367             (indent-to column 0))
 368         (forward-line 1))
 369       (move-marker end nil))))
 370
 371 (defun indent-relative-maybe ()
 372   "Indent a new line like previous nonblank line.
 373 If the previous nonblank line has no indent points beyond the
 374 column point starts at, this command does nothing.
 375
 376 See also `indent-relative'."
 377   (interactive)
 378   (indent-relative t))
 379
 380 (defun indent-relative (&optional unindented-ok)
 381   "Space out to under next indent point in previous nonblank line.
 382 An indent point is a non-whitespace character following whitespace.
 383 The following line shows the indentation points in this line.
 384     ^         ^    ^     ^   ^           ^      ^  ^    ^
 385 If the previous nonblank line has no indent points beyond the
 386 column point starts at, `tab-to-tab-stop' is done instead, unless
 387 this command is invoked with a numeric argument, in which case it
 388 does nothing.
 389
 390 See also `indent-relative-maybe'."
 391   (interactive "P")
 392   (if (and abbrev-mode
 393            (eq (char-syntax (preceding-char)) ?w))
 394       (expand-abbrev))
 395   (let ((start-column (current-column))
 396         indent)
 397     (save-excursion
 398       (beginning-of-line)
 399       (if (re-search-backward "^[^\n]" nil t)
 400           (let ((end (save-excursion (forward-line 1) (point))))
 401             (move-to-column start-column)
 402             ;; Is start-column inside a tab on this line?
 403             (if (> (current-column) start-column)
 404                 (backward-char 1))
 405             (or (looking-at "[ \t]")
 406                 unindented-ok
 407                 (skip-chars-forward "^ \t" end))
 408             (skip-chars-forward " \t" end)
 409             (or (= (point) end) (setq indent (current-column))))))
 410     (if indent
 411         (let ((opoint (point-marker)))
 412           (indent-to indent 0)
 413           (if (> opoint (point))
 414               (goto-char opoint))
 415           (move-marker opoint nil))
 416       (tab-to-tab-stop))))
 417
 418 (defcustom tab-stop-list
 419   '(8 16 24 32 40 48 56 64 72 80 88 96 104 112 120)
 420   "*List of tab stop positions used by `tab-to-tab-stop'.
 421 This should be a list of integers, ordered from smallest to largest."
 422   :group 'indent
 423   :type '(repeat integer))
 424
 425 (defvar edit-tab-stops-map
 426   (let ((map (make-sparse-keymap)))
 427     (define-key map "\C-x\C-s" 'edit-tab-stops-note-changes)
 428     (define-key map "\C-c\C-c" 'edit-tab-stops-note-changes)
 429     map)
 430   "Keymap used in `edit-tab-stops'.")
 431
 432 (defvar edit-tab-stops-buffer nil
 433   "Buffer whose tab stops are being edited--in case
 434 the variable `tab-stop-list' is local in that buffer.")
 435
 436 (defun edit-tab-stops ()
 437   "Edit the tab stops used by `tab-to-tab-stop'.
 438 Creates a buffer *Tab Stops* containing text describing the tab stops.
 439 A colon indicates a column where there is a tab stop.
 440 You can add or remove colons and then do \\<edit-tab-stops-map>\\[edit-tab-stops-note-changes] to make changes take effect."
 441   (interactive)
 442   (setq edit-tab-stops-buffer (current-buffer))
 443   (switch-to-buffer (get-buffer-create "*Tab Stops*"))
 444   (use-local-map edit-tab-stops-map)
 445   (make-local-variable 'indent-tabs-mode)
 446   (setq indent-tabs-mode nil)
 447   (overwrite-mode 1)
 448   (setq truncate-lines t)
 449   (erase-buffer)
 450   (let ((tabs tab-stop-list))
 451     (while tabs
 452       (indent-to (car tabs) 0)
 453       (insert ?:)
 454       (setq tabs (cdr tabs))))
 455   (let ((count 0))
 456     (insert ?\n)
 457     (while (< count 8)
 458       (insert (+ count ?0))
 459     (insert "         ")
 460       (setq count (1+ count)))
 461     (insert ?\n)
 462     (while (> count 0)
 463       (insert "0123456789")
 464       (setq count (1- count))))
 465   (insert "\nTo install changes, type C-c C-c")
 466   (goto-char (point-min)))
 467
 468 (defun edit-tab-stops-note-changes ()
 469   "Put edited tab stops into effect."
 470   (interactive)
 471     (let (tabs)
 472       (save-excursion
 473         (goto-char 1)
 474         (end-of-line)
 475         (while (search-backward ":" nil t)
 476           (setq tabs (cons (current-column) tabs))))
 477       (bury-buffer (prog1 (current-buffer)
 478                           (switch-to-buffer edit-tab-stops-buffer)))
 479       (setq tab-stop-list tabs))
 480   (message "Tab stops installed"))
 481
 482 (defun tab-to-tab-stop ()
 483   "Insert spaces or tabs to next defined tab-stop column.
 484 The variable `tab-stop-list' is a list of columns at which there are tab stops.
 485 Use \\[edit-tab-stops] to edit them interactively."
 486   (interactive)
 487   (and abbrev-mode (= (char-syntax (preceding-char)) ?w)
 488        (expand-abbrev))
 489   (let ((tabs tab-stop-list))
 490     (while (and tabs (>= (current-column) (car tabs)))
 491       (setq tabs (cdr tabs)))
 492     (if tabs
 493         (let ((opoint (point)))
 494           (delete-horizontal-space t)
 495           (indent-to (car tabs)))
 496       (insert ?\ ))))
 497
 498 (defun move-to-tab-stop ()
 499   "Move point to next defined tab-stop column.
 500 The variable `tab-stop-list' is a list of columns at which there are tab stops.
 501 Use \\[edit-tab-stops] to edit them interactively."
 502   (interactive)
 503   (let ((tabs tab-stop-list))
 504     (while (and tabs (>= (current-column) (car tabs)))
 505       (setq tabs (cdr tabs)))
 506     (if tabs
 507         (let ((before (point)))
 508           (move-to-column (car tabs) t)
 509           (save-excursion
 510             (goto-char before)
 511             ;; If we just added a tab, or moved over one,
 512             ;; delete any superfluous spaces before the old point.
 513             (if (and (eq (preceding-char) ?\ )
 514                      (eq (following-char) ?\t))
 515                 (let ((tabend (* (/ (current-column) tab-width) tab-width)))
 516                   (while (and (> (current-column) tabend)
 517                               (eq (preceding-char) ?\ ))
 518                     (forward-char -1))
 519                   (delete-region (point) before))))))))
 520
 521 (define-key global-map "\t" 'indent-for-tab-command)
 522 (define-key esc-map "\C-\\" 'indent-region)
 523 (define-key ctl-x-map "\t" 'indent-rigidly)
 524 (define-key esc-map "i" 'tab-to-tab-stop)
 525
 526 ;;; indent.el ends here