PageRenderTime 97ms CodeModel.GetById 47ms RepoModel.GetById 0ms app.codeStats 2ms

/ntemacs23.1/lisp/simple.el

https://bitbucket.org/fangzhzh/temp
Emacs Lisp | 6544 lines | 5181 code | 606 blank | 757 comment | 235 complexity | 6d2a25e1237d3e531aaeefda655f008d MD5 | raw file
Possible License(s): GPL-3.0, AGPL-3.0

Large files files are truncated, but you can click here to view the full file

  1. ;;; simple.el --- basic editing commands for Emacs
  2. ;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
  3. ;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
  4. ;; Free Software Foundation, Inc.
  5. ;; Maintainer: FSF
  6. ;; Keywords: internal
  7. ;; This file is part of GNU Emacs.
  8. ;; GNU Emacs is free software: you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation, either version 3 of the License, or
  11. ;; (at your option) any later version.
  12. ;; GNU Emacs is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. ;; GNU General Public License for more details.
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  18. ;;; Commentary:
  19. ;; A grab-bag of basic Emacs commands not specifically related to some
  20. ;; major mode or to file-handling.
  21. ;;; Code:
  22. ;; This is for lexical-let in apply-partially.
  23. (eval-when-compile (require 'cl))
  24. (declare-function widget-convert "wid-edit" (type &rest args))
  25. (declare-function shell-mode "shell" ())
  26. (defvar compilation-current-error)
  27. (defcustom idle-update-delay 0.5
  28. "Idle time delay before updating various things on the screen.
  29. Various Emacs features that update auxiliary information when point moves
  30. wait this many seconds after Emacs becomes idle before doing an update."
  31. :type 'number
  32. :group 'display
  33. :version "22.1")
  34. (defgroup killing nil
  35. "Killing and yanking commands."
  36. :group 'editing)
  37. (defgroup paren-matching nil
  38. "Highlight (un)matching of parens and expressions."
  39. :group 'matching)
  40. (defun get-next-valid-buffer (list &optional buffer visible-ok frame)
  41. "Search LIST for a valid buffer to display in FRAME.
  42. Return nil when all buffers in LIST are undesirable for display,
  43. otherwise return the first suitable buffer in LIST.
  44. Buffers not visible in windows are preferred to visible buffers,
  45. unless VISIBLE-OK is non-nil.
  46. If the optional argument FRAME is nil, it defaults to the selected frame.
  47. If BUFFER is non-nil, ignore occurrences of that buffer in LIST."
  48. ;; This logic is more or less copied from other-buffer.
  49. (setq frame (or frame (selected-frame)))
  50. (let ((pred (frame-parameter frame 'buffer-predicate))
  51. found buf)
  52. (while (and (not found) list)
  53. (setq buf (car list))
  54. (if (and (not (eq buffer buf))
  55. (buffer-live-p buf)
  56. (or (null pred) (funcall pred buf))
  57. (not (eq (aref (buffer-name buf) 0) ?\s))
  58. (or visible-ok (null (get-buffer-window buf 'visible))))
  59. (setq found buf)
  60. (setq list (cdr list))))
  61. (car list)))
  62. (defun last-buffer (&optional buffer visible-ok frame)
  63. "Return the last buffer in FRAME's buffer list.
  64. If BUFFER is the last buffer, return the preceding buffer instead.
  65. Buffers not visible in windows are preferred to visible buffers,
  66. unless optional argument VISIBLE-OK is non-nil.
  67. Optional third argument FRAME nil or omitted means use the
  68. selected frame's buffer list.
  69. If no such buffer exists, return the buffer `*scratch*', creating
  70. it if necessary."
  71. (setq frame (or frame (selected-frame)))
  72. (or (get-next-valid-buffer (nreverse (buffer-list frame))
  73. buffer visible-ok frame)
  74. (get-buffer "*scratch*")
  75. (let ((scratch (get-buffer-create "*scratch*")))
  76. (set-buffer-major-mode scratch)
  77. scratch)))
  78. (defun next-buffer ()
  79. "Switch to the next buffer in cyclic order."
  80. (interactive)
  81. (let ((buffer (current-buffer)))
  82. (switch-to-buffer (other-buffer buffer t))
  83. (bury-buffer buffer)))
  84. (defun previous-buffer ()
  85. "Switch to the previous buffer in cyclic order."
  86. (interactive)
  87. (switch-to-buffer (last-buffer (current-buffer) t)))
  88. ;;; next-error support framework
  89. (defgroup next-error nil
  90. "`next-error' support framework."
  91. :group 'compilation
  92. :version "22.1")
  93. (defface next-error
  94. '((t (:inherit region)))
  95. "Face used to highlight next error locus."
  96. :group 'next-error
  97. :version "22.1")
  98. (defcustom next-error-highlight 0.5
  99. "Highlighting of locations in selected source buffers.
  100. If a number, highlight the locus in `next-error' face for the given time
  101. in seconds, or until the next command is executed.
  102. If t, highlight the locus until the next command is executed, or until
  103. some other locus replaces it.
  104. If nil, don't highlight the locus in the source buffer.
  105. If `fringe-arrow', indicate the locus by the fringe arrow."
  106. :type '(choice (number :tag "Highlight for specified time")
  107. (const :tag "Semipermanent highlighting" t)
  108. (const :tag "No highlighting" nil)
  109. (const :tag "Fringe arrow" fringe-arrow))
  110. :group 'next-error
  111. :version "22.1")
  112. (defcustom next-error-highlight-no-select 0.5
  113. "Highlighting of locations in `next-error-no-select'.
  114. If number, highlight the locus in `next-error' face for given time in seconds.
  115. If t, highlight the locus indefinitely until some other locus replaces it.
  116. If nil, don't highlight the locus in the source buffer.
  117. If `fringe-arrow', indicate the locus by the fringe arrow."
  118. :type '(choice (number :tag "Highlight for specified time")
  119. (const :tag "Semipermanent highlighting" t)
  120. (const :tag "No highlighting" nil)
  121. (const :tag "Fringe arrow" fringe-arrow))
  122. :group 'next-error
  123. :version "22.1")
  124. (defcustom next-error-recenter nil
  125. "Display the line in the visited source file recentered as specified.
  126. If non-nil, the value is passed directly to `recenter'."
  127. :type '(choice (integer :tag "Line to recenter to")
  128. (const :tag "Center of window" (4))
  129. (const :tag "No recentering" nil))
  130. :group 'next-error
  131. :version "23.1")
  132. (defcustom next-error-hook nil
  133. "List of hook functions run by `next-error' after visiting source file."
  134. :type 'hook
  135. :group 'next-error)
  136. (defvar next-error-highlight-timer nil)
  137. (defvar next-error-overlay-arrow-position nil)
  138. (put 'next-error-overlay-arrow-position 'overlay-arrow-string "=>")
  139. (add-to-list 'overlay-arrow-variable-list 'next-error-overlay-arrow-position)
  140. (defvar next-error-last-buffer nil
  141. "The most recent `next-error' buffer.
  142. A buffer becomes most recent when its compilation, grep, or
  143. similar mode is started, or when it is used with \\[next-error]
  144. or \\[compile-goto-error].")
  145. (defvar next-error-function nil
  146. "Function to use to find the next error in the current buffer.
  147. The function is called with 2 parameters:
  148. ARG is an integer specifying by how many errors to move.
  149. RESET is a boolean which, if non-nil, says to go back to the beginning
  150. of the errors before moving.
  151. Major modes providing compile-like functionality should set this variable
  152. to indicate to `next-error' that this is a candidate buffer and how
  153. to navigate in it.")
  154. (make-variable-buffer-local 'next-error-function)
  155. (defvar next-error-move-function nil
  156. "Function to use to move to an error locus.
  157. It takes two arguments, a buffer position in the error buffer
  158. and a buffer position in the error locus buffer.
  159. The buffer for the error locus should already be current.
  160. nil means use goto-char using the second argument position.")
  161. (make-variable-buffer-local 'next-error-move-function)
  162. (defsubst next-error-buffer-p (buffer
  163. &optional avoid-current
  164. extra-test-inclusive
  165. extra-test-exclusive)
  166. "Test if BUFFER is a `next-error' capable buffer.
  167. If AVOID-CURRENT is non-nil, treat the current buffer
  168. as an absolute last resort only.
  169. The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffer
  170. that normally would not qualify. If it returns t, the buffer
  171. in question is treated as usable.
  172. The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called in each buffer
  173. that would normally be considered usable. If it returns nil,
  174. that buffer is rejected."
  175. (and (buffer-name buffer) ;First make sure it's live.
  176. (not (and avoid-current (eq buffer (current-buffer))))
  177. (with-current-buffer buffer
  178. (if next-error-function ; This is the normal test.
  179. ;; Optionally reject some buffers.
  180. (if extra-test-exclusive
  181. (funcall extra-test-exclusive)
  182. t)
  183. ;; Optionally accept some other buffers.
  184. (and extra-test-inclusive
  185. (funcall extra-test-inclusive))))))
  186. (defun next-error-find-buffer (&optional avoid-current
  187. extra-test-inclusive
  188. extra-test-exclusive)
  189. "Return a `next-error' capable buffer.
  190. If AVOID-CURRENT is non-nil, treat the current buffer
  191. as an absolute last resort only.
  192. The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffer
  193. that normally would not qualify. If it returns t, the buffer
  194. in question is treated as usable.
  195. The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called in each buffer
  196. that would normally be considered usable. If it returns nil,
  197. that buffer is rejected."
  198. (or
  199. ;; 1. If one window on the selected frame displays such buffer, return it.
  200. (let ((window-buffers
  201. (delete-dups
  202. (delq nil (mapcar (lambda (w)
  203. (if (next-error-buffer-p
  204. (window-buffer w)
  205. avoid-current
  206. extra-test-inclusive extra-test-exclusive)
  207. (window-buffer w)))
  208. (window-list))))))
  209. (if (eq (length window-buffers) 1)
  210. (car window-buffers)))
  211. ;; 2. If next-error-last-buffer is an acceptable buffer, use that.
  212. (if (and next-error-last-buffer
  213. (next-error-buffer-p next-error-last-buffer avoid-current
  214. extra-test-inclusive extra-test-exclusive))
  215. next-error-last-buffer)
  216. ;; 3. If the current buffer is acceptable, choose it.
  217. (if (next-error-buffer-p (current-buffer) avoid-current
  218. extra-test-inclusive extra-test-exclusive)
  219. (current-buffer))
  220. ;; 4. Look for any acceptable buffer.
  221. (let ((buffers (buffer-list)))
  222. (while (and buffers
  223. (not (next-error-buffer-p
  224. (car buffers) avoid-current
  225. extra-test-inclusive extra-test-exclusive)))
  226. (setq buffers (cdr buffers)))
  227. (car buffers))
  228. ;; 5. Use the current buffer as a last resort if it qualifies,
  229. ;; even despite AVOID-CURRENT.
  230. (and avoid-current
  231. (next-error-buffer-p (current-buffer) nil
  232. extra-test-inclusive extra-test-exclusive)
  233. (progn
  234. (message "This is the only buffer with error message locations")
  235. (current-buffer)))
  236. ;; 6. Give up.
  237. (error "No buffers contain error message locations")))
  238. (defun next-error (&optional arg reset)
  239. "Visit next `next-error' message and corresponding source code.
  240. If all the error messages parsed so far have been processed already,
  241. the message buffer is checked for new ones.
  242. A prefix ARG specifies how many error messages to move;
  243. negative means move back to previous error messages.
  244. Just \\[universal-argument] as a prefix means reparse the error message buffer
  245. and start at the first error.
  246. The RESET argument specifies that we should restart from the beginning.
  247. \\[next-error] normally uses the most recently started
  248. compilation, grep, or occur buffer. It can also operate on any
  249. buffer with output from the \\[compile], \\[grep] commands, or,
  250. more generally, on any buffer in Compilation mode or with
  251. Compilation Minor mode enabled, or any buffer in which
  252. `next-error-function' is bound to an appropriate function.
  253. To specify use of a particular buffer for error messages, type
  254. \\[next-error] in that buffer when it is the only one displayed
  255. in the current frame.
  256. Once \\[next-error] has chosen the buffer for error messages, it
  257. runs `next-error-hook' with `run-hooks', and stays with that buffer
  258. until you use it in some other buffer which uses Compilation mode
  259. or Compilation Minor mode.
  260. See variables `compilation-parse-errors-function' and
  261. \`compilation-error-regexp-alist' for customization ideas."
  262. (interactive "P")
  263. (if (consp arg) (setq reset t arg nil))
  264. (when (setq next-error-last-buffer (next-error-find-buffer))
  265. ;; we know here that next-error-function is a valid symbol we can funcall
  266. (with-current-buffer next-error-last-buffer
  267. (funcall next-error-function (prefix-numeric-value arg) reset)
  268. (when next-error-recenter
  269. (recenter next-error-recenter))
  270. (run-hooks 'next-error-hook))))
  271. (defun next-error-internal ()
  272. "Visit the source code corresponding to the `next-error' message at point."
  273. (setq next-error-last-buffer (current-buffer))
  274. ;; we know here that next-error-function is a valid symbol we can funcall
  275. (with-current-buffer next-error-last-buffer
  276. (funcall next-error-function 0 nil)
  277. (when next-error-recenter
  278. (recenter next-error-recenter))
  279. (run-hooks 'next-error-hook)))
  280. (defalias 'goto-next-locus 'next-error)
  281. (defalias 'next-match 'next-error)
  282. (defun previous-error (&optional n)
  283. "Visit previous `next-error' message and corresponding source code.
  284. Prefix arg N says how many error messages to move backwards (or
  285. forwards, if negative).
  286. This operates on the output from the \\[compile] and \\[grep] commands."
  287. (interactive "p")
  288. (next-error (- (or n 1))))
  289. (defun first-error (&optional n)
  290. "Restart at the first error.
  291. Visit corresponding source code.
  292. With prefix arg N, visit the source code of the Nth error.
  293. This operates on the output from the \\[compile] command, for instance."
  294. (interactive "p")
  295. (next-error n t))
  296. (defun next-error-no-select (&optional n)
  297. "Move point to the next error in the `next-error' buffer and highlight match.
  298. Prefix arg N says how many error messages to move forwards (or
  299. backwards, if negative).
  300. Finds and highlights the source line like \\[next-error], but does not
  301. select the source buffer."
  302. (interactive "p")
  303. (let ((next-error-highlight next-error-highlight-no-select))
  304. (next-error n))
  305. (pop-to-buffer next-error-last-buffer))
  306. (defun previous-error-no-select (&optional n)
  307. "Move point to the previous error in the `next-error' buffer and highlight match.
  308. Prefix arg N says how many error messages to move backwards (or
  309. forwards, if negative).
  310. Finds and highlights the source line like \\[previous-error], but does not
  311. select the source buffer."
  312. (interactive "p")
  313. (next-error-no-select (- (or n 1))))
  314. ;; Internal variable for `next-error-follow-mode-post-command-hook'.
  315. (defvar next-error-follow-last-line nil)
  316. (define-minor-mode next-error-follow-minor-mode
  317. "Minor mode for compilation, occur and diff modes.
  318. When turned on, cursor motion in the compilation, grep, occur or diff
  319. buffer causes automatic display of the corresponding source code
  320. location."
  321. :group 'next-error :init-value nil :lighter " Fol"
  322. (if (not next-error-follow-minor-mode)
  323. (remove-hook 'post-command-hook 'next-error-follow-mode-post-command-hook t)
  324. (add-hook 'post-command-hook 'next-error-follow-mode-post-command-hook nil t)
  325. (make-local-variable 'next-error-follow-last-line)))
  326. ;; Used as a `post-command-hook' by `next-error-follow-mode'
  327. ;; for the *Compilation* *grep* and *Occur* buffers.
  328. (defun next-error-follow-mode-post-command-hook ()
  329. (unless (equal next-error-follow-last-line (line-number-at-pos))
  330. (setq next-error-follow-last-line (line-number-at-pos))
  331. (condition-case nil
  332. (let ((compilation-context-lines nil))
  333. (setq compilation-current-error (point))
  334. (next-error-no-select 0))
  335. (error t))))
  336. ;;;
  337. (defun fundamental-mode ()
  338. "Major mode not specialized for anything in particular.
  339. Other major modes are defined by comparison with this one."
  340. (interactive)
  341. (kill-all-local-variables)
  342. (unless delay-mode-hooks
  343. (run-hooks 'after-change-major-mode-hook)))
  344. ;; Special major modes to view specially formatted data rather than files.
  345. (defvar special-mode-map
  346. (let ((map (make-sparse-keymap)))
  347. (suppress-keymap map)
  348. (define-key map "q" 'quit-window)
  349. (define-key map " " 'scroll-up)
  350. (define-key map "\C-?" 'scroll-down)
  351. (define-key map "?" 'describe-mode)
  352. (define-key map ">" 'end-of-buffer)
  353. (define-key map "<" 'beginning-of-buffer)
  354. (define-key map "g" 'revert-buffer)
  355. map))
  356. (put 'special-mode 'mode-class 'special)
  357. (define-derived-mode special-mode nil "Special"
  358. "Parent major mode from which special major modes should inherit."
  359. (setq buffer-read-only t))
  360. ;; Making and deleting lines.
  361. (defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))
  362. "Propertized string representing a hard newline character.")
  363. (defun newline (&optional arg)
  364. "Insert a newline, and move to left margin of the new line if it's blank.
  365. If `use-hard-newlines' is non-nil, the newline is marked with the
  366. text-property `hard'.
  367. With ARG, insert that many newlines.
  368. Call `auto-fill-function' if the current column number is greater
  369. than the value of `fill-column' and ARG is nil."
  370. (interactive "*P")
  371. (barf-if-buffer-read-only)
  372. ;; Inserting a newline at the end of a line produces better redisplay in
  373. ;; try_window_id than inserting at the beginning of a line, and the textual
  374. ;; result is the same. So, if we're at beginning of line, pretend to be at
  375. ;; the end of the previous line.
  376. (let ((flag (and (not (bobp))
  377. (bolp)
  378. ;; Make sure no functions want to be told about
  379. ;; the range of the changes.
  380. (not after-change-functions)
  381. (not before-change-functions)
  382. ;; Make sure there are no markers here.
  383. (not (buffer-has-markers-at (1- (point))))
  384. (not (buffer-has-markers-at (point)))
  385. ;; Make sure no text properties want to know
  386. ;; where the change was.
  387. (not (get-char-property (1- (point)) 'modification-hooks))
  388. (not (get-char-property (1- (point)) 'insert-behind-hooks))
  389. (or (eobp)
  390. (not (get-char-property (point) 'insert-in-front-hooks)))
  391. ;; Make sure the newline before point isn't intangible.
  392. (not (get-char-property (1- (point)) 'intangible))
  393. ;; Make sure the newline before point isn't read-only.
  394. (not (get-char-property (1- (point)) 'read-only))
  395. ;; Make sure the newline before point isn't invisible.
  396. (not (get-char-property (1- (point)) 'invisible))
  397. ;; Make sure the newline before point has the same
  398. ;; properties as the char before it (if any).
  399. (< (or (previous-property-change (point)) -2)
  400. (- (point) 2))))
  401. (was-page-start (and (bolp)
  402. (looking-at page-delimiter)))
  403. (beforepos (point)))
  404. (if flag (backward-char 1))
  405. ;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
  406. ;; Set last-command-event to tell self-insert what to insert.
  407. (let ((last-command-event ?\n)
  408. ;; Don't auto-fill if we have a numeric argument.
  409. ;; Also not if flag is true (it would fill wrong line);
  410. ;; there is no need to since we're at BOL.
  411. (auto-fill-function (if (or arg flag) nil auto-fill-function)))
  412. (unwind-protect
  413. (self-insert-command (prefix-numeric-value arg))
  414. ;; If we get an error in self-insert-command, put point at right place.
  415. (if flag (forward-char 1))))
  416. ;; Even if we did *not* get an error, keep that forward-char;
  417. ;; all further processing should apply to the newline that the user
  418. ;; thinks he inserted.
  419. ;; Mark the newline(s) `hard'.
  420. (if use-hard-newlines
  421. (set-hard-newline-properties
  422. (- (point) (prefix-numeric-value arg)) (point)))
  423. ;; If the newline leaves the previous line blank,
  424. ;; and we have a left margin, delete that from the blank line.
  425. (or flag
  426. (save-excursion
  427. (goto-char beforepos)
  428. (beginning-of-line)
  429. (and (looking-at "[ \t]$")
  430. (> (current-left-margin) 0)
  431. (delete-region (point) (progn (end-of-line) (point))))))
  432. ;; Indent the line after the newline, except in one case:
  433. ;; when we added the newline at the beginning of a line
  434. ;; which starts a page.
  435. (or was-page-start
  436. (move-to-left-margin nil t)))
  437. nil)
  438. (defun set-hard-newline-properties (from to)
  439. (let ((sticky (get-text-property from 'rear-nonsticky)))
  440. (put-text-property from to 'hard 't)
  441. ;; If rear-nonsticky is not "t", add 'hard to rear-nonsticky list
  442. (if (and (listp sticky) (not (memq 'hard sticky)))
  443. (put-text-property from (point) 'rear-nonsticky
  444. (cons 'hard sticky)))))
  445. (defun open-line (n)
  446. "Insert a newline and leave point before it.
  447. If there is a fill prefix and/or a `left-margin', insert them
  448. on the new line if the line would have been blank.
  449. With arg N, insert N newlines."
  450. (interactive "*p")
  451. (let* ((do-fill-prefix (and fill-prefix (bolp)))
  452. (do-left-margin (and (bolp) (> (current-left-margin) 0)))
  453. (loc (point))
  454. ;; Don't expand an abbrev before point.
  455. (abbrev-mode nil))
  456. (newline n)
  457. (goto-char loc)
  458. (while (> n 0)
  459. (cond ((bolp)
  460. (if do-left-margin (indent-to (current-left-margin)))
  461. (if do-fill-prefix (insert-and-inherit fill-prefix))))
  462. (forward-line 1)
  463. (setq n (1- n)))
  464. (goto-char loc)
  465. (end-of-line)))
  466. (defun split-line (&optional arg)
  467. "Split current line, moving portion beyond point vertically down.
  468. If the current line starts with `fill-prefix', insert it on the new
  469. line as well. With prefix ARG, don't insert `fill-prefix' on new line.
  470. When called from Lisp code, ARG may be a prefix string to copy."
  471. (interactive "*P")
  472. (skip-chars-forward " \t")
  473. (let* ((col (current-column))
  474. (pos (point))
  475. ;; What prefix should we check for (nil means don't).
  476. (prefix (cond ((stringp arg) arg)
  477. (arg nil)
  478. (t fill-prefix)))
  479. ;; Does this line start with it?
  480. (have-prfx (and prefix
  481. (save-excursion
  482. (beginning-of-line)
  483. (looking-at (regexp-quote prefix))))))
  484. (newline 1)
  485. (if have-prfx (insert-and-inherit prefix))
  486. (indent-to col 0)
  487. (goto-char pos)))
  488. (defun delete-indentation (&optional arg)
  489. "Join this line to previous and fix up whitespace at join.
  490. If there is a fill prefix, delete it from the beginning of this line.
  491. With argument, join this line to following line."
  492. (interactive "*P")
  493. (beginning-of-line)
  494. (if arg (forward-line 1))
  495. (if (eq (preceding-char) ?\n)
  496. (progn
  497. (delete-region (point) (1- (point)))
  498. ;; If the second line started with the fill prefix,
  499. ;; delete the prefix.
  500. (if (and fill-prefix
  501. (<= (+ (point) (length fill-prefix)) (point-max))
  502. (string= fill-prefix
  503. (buffer-substring (point)
  504. (+ (point) (length fill-prefix)))))
  505. (delete-region (point) (+ (point) (length fill-prefix))))
  506. (fixup-whitespace))))
  507. (defalias 'join-line #'delete-indentation) ; easier to find
  508. (defun delete-blank-lines ()
  509. "On blank line, delete all surrounding blank lines, leaving just one.
  510. On isolated blank line, delete that one.
  511. On nonblank line, delete any immediately following blank lines."
  512. (interactive "*")
  513. (let (thisblank singleblank)
  514. (save-excursion
  515. (beginning-of-line)
  516. (setq thisblank (looking-at "[ \t]*$"))
  517. ;; Set singleblank if there is just one blank line here.
  518. (setq singleblank
  519. (and thisblank
  520. (not (looking-at "[ \t]*\n[ \t]*$"))
  521. (or (bobp)
  522. (progn (forward-line -1)
  523. (not (looking-at "[ \t]*$")))))))
  524. ;; Delete preceding blank lines, and this one too if it's the only one.
  525. (if thisblank
  526. (progn
  527. (beginning-of-line)
  528. (if singleblank (forward-line 1))
  529. (delete-region (point)
  530. (if (re-search-backward "[^ \t\n]" nil t)
  531. (progn (forward-line 1) (point))
  532. (point-min)))))
  533. ;; Delete following blank lines, unless the current line is blank
  534. ;; and there are no following blank lines.
  535. (if (not (and thisblank singleblank))
  536. (save-excursion
  537. (end-of-line)
  538. (forward-line 1)
  539. (delete-region (point)
  540. (if (re-search-forward "[^ \t\n]" nil t)
  541. (progn (beginning-of-line) (point))
  542. (point-max)))))
  543. ;; Handle the special case where point is followed by newline and eob.
  544. ;; Delete the line, leaving point at eob.
  545. (if (looking-at "^[ \t]*\n\\'")
  546. (delete-region (point) (point-max)))))
  547. (defun delete-trailing-whitespace ()
  548. "Delete all the trailing whitespace across the current buffer.
  549. All whitespace after the last non-whitespace character in a line is deleted.
  550. This respects narrowing, created by \\[narrow-to-region] and friends.
  551. A formfeed is not considered whitespace by this function."
  552. (interactive "*")
  553. (save-match-data
  554. (save-excursion
  555. (goto-char (point-min))
  556. (while (re-search-forward "\\s-$" nil t)
  557. (skip-syntax-backward "-" (save-excursion (forward-line 0) (point)))
  558. ;; Don't delete formfeeds, even if they are considered whitespace.
  559. (save-match-data
  560. (if (looking-at ".*\f")
  561. (goto-char (match-end 0))))
  562. (delete-region (point) (match-end 0))))))
  563. (defun newline-and-indent ()
  564. "Insert a newline, then indent according to major mode.
  565. Indentation is done using the value of `indent-line-function'.
  566. In programming language modes, this is the same as TAB.
  567. In some text modes, where TAB inserts a tab, this command indents to the
  568. column specified by the function `current-left-margin'."
  569. (interactive "*")
  570. (delete-horizontal-space t)
  571. (newline)
  572. (indent-according-to-mode))
  573. (defun reindent-then-newline-and-indent ()
  574. "Reindent current line, insert newline, then indent the new line.
  575. Indentation of both lines is done according to the current major mode,
  576. which means calling the current value of `indent-line-function'.
  577. In programming language modes, this is the same as TAB.
  578. In some text modes, where TAB inserts a tab, this indents to the
  579. column specified by the function `current-left-margin'."
  580. (interactive "*")
  581. (let ((pos (point)))
  582. ;; Be careful to insert the newline before indenting the line.
  583. ;; Otherwise, the indentation might be wrong.
  584. (newline)
  585. (save-excursion
  586. (goto-char pos)
  587. ;; We are at EOL before the call to indent-according-to-mode, and
  588. ;; after it we usually are as well, but not always. We tried to
  589. ;; address it with `save-excursion' but that uses a normal marker
  590. ;; whereas we need `move after insertion', so we do the save/restore
  591. ;; by hand.
  592. (setq pos (copy-marker pos t))
  593. (indent-according-to-mode)
  594. (goto-char pos)
  595. ;; Remove the trailing white-space after indentation because
  596. ;; indentation may introduce the whitespace.
  597. (delete-horizontal-space t))
  598. (indent-according-to-mode)))
  599. (defun quoted-insert (arg)
  600. "Read next input character and insert it.
  601. This is useful for inserting control characters.
  602. With argument, insert ARG copies of the character.
  603. If the first character you type after this command is an octal digit,
  604. you should type a sequence of octal digits which specify a character code.
  605. Any nondigit terminates the sequence. If the terminator is a RET,
  606. it is discarded; any other terminator is used itself as input.
  607. The variable `read-quoted-char-radix' specifies the radix for this feature;
  608. set it to 10 or 16 to use decimal or hex instead of octal.
  609. In overwrite mode, this function inserts the character anyway, and
  610. does not handle octal digits specially. This means that if you use
  611. overwrite as your normal editing mode, you can use this function to
  612. insert characters when necessary.
  613. In binary overwrite mode, this function does overwrite, and octal
  614. digits are interpreted as a character code. This is intended to be
  615. useful for editing binary files."
  616. (interactive "*p")
  617. (let* ((char
  618. ;; Avoid "obsolete" warnings for translation-table-for-input.
  619. (with-no-warnings
  620. (let (translation-table-for-input input-method-function)
  621. (if (or (not overwrite-mode)
  622. (eq overwrite-mode 'overwrite-mode-binary))
  623. (read-quoted-char)
  624. (read-char))))))
  625. ;; This used to assume character codes 0240 - 0377 stand for
  626. ;; characters in some single-byte character set, and converted them
  627. ;; to Emacs characters. But in 23.1 this feature is deprecated
  628. ;; in favor of inserting the corresponding Unicode characters.
  629. ;; (if (and enable-multibyte-characters
  630. ;; (>= char ?\240)
  631. ;; (<= char ?\377))
  632. ;; (setq char (unibyte-char-to-multibyte char)))
  633. (if (> arg 0)
  634. (if (eq overwrite-mode 'overwrite-mode-binary)
  635. (delete-char arg)))
  636. (while (> arg 0)
  637. (insert-and-inherit char)
  638. (setq arg (1- arg)))))
  639. (defun forward-to-indentation (&optional arg)
  640. "Move forward ARG lines and position at first nonblank character."
  641. (interactive "^p")
  642. (forward-line (or arg 1))
  643. (skip-chars-forward " \t"))
  644. (defun backward-to-indentation (&optional arg)
  645. "Move backward ARG lines and position at first nonblank character."
  646. (interactive "^p")
  647. (forward-line (- (or arg 1)))
  648. (skip-chars-forward " \t"))
  649. (defun back-to-indentation ()
  650. "Move point to the first non-whitespace character on this line."
  651. (interactive "^")
  652. (beginning-of-line 1)
  653. (skip-syntax-forward " " (line-end-position))
  654. ;; Move back over chars that have whitespace syntax but have the p flag.
  655. (backward-prefix-chars))
  656. (defun fixup-whitespace ()
  657. "Fixup white space between objects around point.
  658. Leave one space or none, according to the context."
  659. (interactive "*")
  660. (save-excursion
  661. (delete-horizontal-space)
  662. (if (or (looking-at "^\\|\\s)")
  663. (save-excursion (forward-char -1)
  664. (looking-at "$\\|\\s(\\|\\s'")))
  665. nil
  666. (insert ?\s))))
  667. (defun delete-horizontal-space (&optional backward-only)
  668. "Delete all spaces and tabs around point.
  669. If BACKWARD-ONLY is non-nil, only delete them before point."
  670. (interactive "*P")
  671. (let ((orig-pos (point)))
  672. (delete-region
  673. (if backward-only
  674. orig-pos
  675. (progn
  676. (skip-chars-forward " \t")
  677. (constrain-to-field nil orig-pos t)))
  678. (progn
  679. (skip-chars-backward " \t")
  680. (constrain-to-field nil orig-pos)))))
  681. (defun just-one-space (&optional n)
  682. "Delete all spaces and tabs around point, leaving one space (or N spaces)."
  683. (interactive "*p")
  684. (let ((orig-pos (point)))
  685. (skip-chars-backward " \t")
  686. (constrain-to-field nil orig-pos)
  687. (dotimes (i (or n 1))
  688. (if (= (following-char) ?\s)
  689. (forward-char 1)
  690. (insert ?\s)))
  691. (delete-region
  692. (point)
  693. (progn
  694. (skip-chars-forward " \t")
  695. (constrain-to-field nil orig-pos t)))))
  696. (defun beginning-of-buffer (&optional arg)
  697. "Move point to the beginning of the buffer; leave mark at previous position.
  698. With \\[universal-argument] prefix, do not set mark at previous position.
  699. With numeric arg N, put point N/10 of the way from the beginning.
  700. If the buffer is narrowed, this command uses the beginning and size
  701. of the accessible part of the buffer.
  702. Don't use this command in Lisp programs!
  703. \(goto-char (point-min)) is faster and avoids clobbering the mark."
  704. (interactive "^P")
  705. (or (consp arg)
  706. (region-active-p)
  707. (push-mark))
  708. (let ((size (- (point-max) (point-min))))
  709. (goto-char (if (and arg (not (consp arg)))
  710. (+ (point-min)
  711. (if (> size 10000)
  712. ;; Avoid overflow for large buffer sizes!
  713. (* (prefix-numeric-value arg)
  714. (/ size 10))
  715. (/ (+ 10 (* size (prefix-numeric-value arg))) 10)))
  716. (point-min))))
  717. (if (and arg (not (consp arg))) (forward-line 1)))
  718. (defun end-of-buffer (&optional arg)
  719. "Move point to the end of the buffer; leave mark at previous position.
  720. With \\[universal-argument] prefix, do not set mark at previous position.
  721. With numeric arg N, put point N/10 of the way from the end.
  722. If the buffer is narrowed, this command uses the beginning and size
  723. of the accessible part of the buffer.
  724. Don't use this command in Lisp programs!
  725. \(goto-char (point-max)) is faster and avoids clobbering the mark."
  726. (interactive "^P")
  727. (or (consp arg) (region-active-p) (push-mark))
  728. (let ((size (- (point-max) (point-min))))
  729. (goto-char (if (and arg (not (consp arg)))
  730. (- (point-max)
  731. (if (> size 10000)
  732. ;; Avoid overflow for large buffer sizes!
  733. (* (prefix-numeric-value arg)
  734. (/ size 10))
  735. (/ (* size (prefix-numeric-value arg)) 10)))
  736. (point-max))))
  737. ;; If we went to a place in the middle of the buffer,
  738. ;; adjust it to the beginning of a line.
  739. (cond ((and arg (not (consp arg))) (forward-line 1))
  740. ((> (point) (window-end nil t))
  741. ;; If the end of the buffer is not already on the screen,
  742. ;; then scroll specially to put it near, but not at, the bottom.
  743. (overlay-recenter (point))
  744. (recenter -3))))
  745. (defun mark-whole-buffer ()
  746. "Put point at beginning and mark at end of buffer.
  747. You probably should not use this function in Lisp programs;
  748. it is usually a mistake for a Lisp function to use any subroutine
  749. that uses or sets the mark."
  750. (interactive)
  751. (push-mark (point))
  752. (push-mark (point-max) nil t)
  753. (goto-char (point-min)))
  754. ;; Counting lines, one way or another.
  755. (defun goto-line (line &optional buffer)
  756. "Goto LINE, counting from line 1 at beginning of buffer.
  757. Normally, move point in the current buffer, and leave mark at the
  758. previous position. With just \\[universal-argument] as argument,
  759. move point in the most recently selected other buffer, and switch to it.
  760. If there's a number in the buffer at point, it is the default for LINE.
  761. This function is usually the wrong thing to use in a Lisp program.
  762. What you probably want instead is something like:
  763. (goto-char (point-min)) (forward-line (1- N))
  764. If at all possible, an even better solution is to use char counts
  765. rather than line counts."
  766. (interactive
  767. (if (and current-prefix-arg (not (consp current-prefix-arg)))
  768. (list (prefix-numeric-value current-prefix-arg))
  769. ;; Look for a default, a number in the buffer at point.
  770. (let* ((default
  771. (save-excursion
  772. (skip-chars-backward "0-9")
  773. (if (looking-at "[0-9]")
  774. (buffer-substring-no-properties
  775. (point)
  776. (progn (skip-chars-forward "0-9")
  777. (point))))))
  778. ;; Decide if we're switching buffers.
  779. (buffer
  780. (if (consp current-prefix-arg)
  781. (other-buffer (current-buffer) t)))
  782. (buffer-prompt
  783. (if buffer
  784. (concat " in " (buffer-name buffer))
  785. "")))
  786. ;; Read the argument, offering that number (if any) as default.
  787. (list (read-from-minibuffer (format (if default "Goto line%s (%s): "
  788. "Goto line%s: ")
  789. buffer-prompt
  790. default)
  791. nil nil t
  792. 'minibuffer-history
  793. default)
  794. buffer))))
  795. ;; Switch to the desired buffer, one way or another.
  796. (if buffer
  797. (let ((window (get-buffer-window buffer)))
  798. (if window (select-window window)
  799. (switch-to-buffer-other-window buffer))))
  800. ;; Leave mark at previous position
  801. (or (region-active-p) (push-mark))
  802. ;; Move to the specified line number in that buffer.
  803. (save-restriction
  804. (widen)
  805. (goto-char (point-min))
  806. (if (eq selective-display t)
  807. (re-search-forward "[\n\C-m]" nil 'end (1- line))
  808. (forward-line (1- line)))))
  809. (defun count-lines-region (start end)
  810. "Print number of lines and characters in the region."
  811. (interactive "r")
  812. (message "Region has %d lines, %d characters"
  813. (count-lines start end) (- end start)))
  814. (defun what-line ()
  815. "Print the current buffer line number and narrowed line number of point."
  816. (interactive)
  817. (let ((start (point-min))
  818. (n (line-number-at-pos)))
  819. (if (= start 1)
  820. (message "Line %d" n)
  821. (save-excursion
  822. (save-restriction
  823. (widen)
  824. (message "line %d (narrowed line %d)"
  825. (+ n (line-number-at-pos start) -1) n))))))
  826. (defun count-lines (start end)
  827. "Return number of lines between START and END.
  828. This is usually the number of newlines between them,
  829. but can be one more if START is not equal to END
  830. and the greater of them is not at the start of a line."
  831. (save-excursion
  832. (save-restriction
  833. (narrow-to-region start end)
  834. (goto-char (point-min))
  835. (if (eq selective-display t)
  836. (save-match-data
  837. (let ((done 0))
  838. (while (re-search-forward "[\n\C-m]" nil t 40)
  839. (setq done (+ 40 done)))
  840. (while (re-search-forward "[\n\C-m]" nil t 1)
  841. (setq done (+ 1 done)))
  842. (goto-char (point-max))
  843. (if (and (/= start end)
  844. (not (bolp)))
  845. (1+ done)
  846. done)))
  847. (- (buffer-size) (forward-line (buffer-size)))))))
  848. (defun line-number-at-pos (&optional pos)
  849. "Return (narrowed) buffer line number at position POS.
  850. If POS is nil, use current buffer location.
  851. Counting starts at (point-min), so the value refers
  852. to the contents of the accessible portion of the buffer."
  853. (let ((opoint (or pos (point))) start)
  854. (save-excursion
  855. (goto-char (point-min))
  856. (setq start (point))
  857. (goto-char opoint)
  858. (forward-line 0)
  859. (1+ (count-lines start (point))))))
  860. (defun what-cursor-position (&optional detail)
  861. "Print info on cursor position (on screen and within buffer).
  862. Also describe the character after point, and give its character code
  863. in octal, decimal and hex.
  864. For a non-ASCII multibyte character, also give its encoding in the
  865. buffer's selected coding system if the coding system encodes the
  866. character safely. If the character is encoded into one byte, that
  867. code is shown in hex. If the character is encoded into more than one
  868. byte, just \"...\" is shown.
  869. In addition, with prefix argument, show details about that character
  870. in *Help* buffer. See also the command `describe-char'."
  871. (interactive "P")
  872. (let* ((char (following-char))
  873. (beg (point-min))
  874. (end (point-max))
  875. (pos (point))
  876. (total (buffer-size))
  877. (percent (if (> total 50000)
  878. ;; Avoid overflow from multiplying by 100!
  879. (/ (+ (/ total 200) (1- pos)) (max (/ total 100) 1))
  880. (/ (+ (/ total 2) (* 100 (1- pos))) (max total 1))))
  881. (hscroll (if (= (window-hscroll) 0)
  882. ""
  883. (format " Hscroll=%d" (window-hscroll))))
  884. (col (current-column)))
  885. (if (= pos end)
  886. (if (or (/= beg 1) (/= end (1+ total)))
  887. (message "point=%d of %d (%d%%) <%d-%d> column=%d%s"
  888. pos total percent beg end col hscroll)
  889. (message "point=%d of %d (EOB) column=%d%s"
  890. pos total col hscroll))
  891. (let ((coding buffer-file-coding-system)
  892. encoded encoding-msg display-prop under-display)
  893. (if (or (not coding)
  894. (eq (coding-system-type coding) t))
  895. (setq coding (default-value 'buffer-file-coding-system)))
  896. (if (eq (char-charset char) 'eight-bit)
  897. (setq encoding-msg
  898. (format "(%d, #o%o, #x%x, raw-byte)" char char char))
  899. ;; Check if the character is displayed with some `display'
  900. ;; text property. In that case, set under-display to the
  901. ;; buffer substring covered by that property.
  902. (setq display-prop (get-text-property pos 'display))
  903. (if display-prop
  904. (let ((to (or (next-single-property-change pos 'display)
  905. (point-max))))
  906. (if (< to (+ pos 4))
  907. (setq under-display "")
  908. (setq under-display "..."
  909. to (+ pos 4)))
  910. (setq under-display
  911. (concat (buffer-substring-no-properties pos to)
  912. under-display)))
  913. (setq encoded (and (>= char 128) (encode-coding-char char coding))))
  914. (setq encoding-msg
  915. (if display-prop
  916. (if (not (stringp display-prop))
  917. (format "(%d, #o%o, #x%x, part of display \"%s\")"
  918. char char char under-display)
  919. (format "(%d, #o%o, #x%x, part of display \"%s\"->\"%s\")"
  920. char char char under-display display-prop))
  921. (if encoded
  922. (format "(%d, #o%o, #x%x, file %s)"
  923. char char char
  924. (if (> (length encoded) 1)
  925. "..."
  926. (encoded-string-description encoded coding)))
  927. (format "(%d, #o%o, #x%x)" char char char)))))
  928. (if detail
  929. ;; We show the detailed information about CHAR.
  930. (describe-char (point)))
  931. (if (or (/= beg 1) (/= end (1+ total)))
  932. (message "Char: %s %s point=%d of %d (%d%%) <%d-%d> column=%d%s"
  933. (if (< char 256)
  934. (single-key-description char)
  935. (buffer-substring-no-properties (point) (1+ (point))))
  936. encoding-msg pos total percent beg end col hscroll)
  937. (message "Char: %s %s point=%d of %d (%d%%) column=%d%s"
  938. (if enable-multibyte-characters
  939. (if (< char 128)
  940. (single-key-description char)
  941. (buffer-substring-no-properties (point) (1+ (point))))
  942. (single-key-description char))
  943. encoding-msg pos total percent col hscroll))))))
  944. ;; Initialize read-expression-map. It is defined at C level.
  945. (let ((m (make-sparse-keymap)))
  946. (define-key m "\M-\t" 'lisp-complete-symbol)
  947. (set-keymap-parent m minibuffer-local-map)
  948. (setq read-expression-map m))
  949. (defvar read-expression-history nil)
  950. (defvar minibuffer-completing-symbol nil
  951. "Non-nil means completing a Lisp symbol in the minibuffer.")
  952. (defvar minibuffer-default nil
  953. "The current default value or list of default values in the minibuffer.
  954. The functions `read-from-minibuffer' and `completing-read' bind
  955. this variable locally.")
  956. (defcustom eval-expression-print-level 4
  957. "Value for `print-level' while printing value in `eval-expression'.
  958. A value of nil means no limit."
  959. :group 'lisp
  960. :type '(choice (const :tag "No Limit" nil) integer)
  961. :version "21.1")
  962. (defcustom eval-expression-print-length 12
  963. "Value for `print-length' while printing value in `eval-expression'.
  964. A value of nil means no limit."
  965. :group 'lisp
  966. :type '(choice (const :tag "No Limit" nil) integer)
  967. :version "21.1")
  968. (defcustom eval-expression-debug-on-error t
  969. "If non-nil set `debug-on-error' to t in `eval-expression'.
  970. If nil, don't change the value of `debug-on-error'."
  971. :group 'lisp
  972. :type 'boolean
  973. :version "21.1")
  974. (defun eval-expression-print-format (value)
  975. "Format VALUE as a result of evaluated expression.
  976. Return a formatted string which is displayed in the echo area
  977. in addition to the value printed by prin1 in functions which
  978. display the result of expression evaluation."
  979. (if (and (integerp value)
  980. (or (not (memq this-command '(eval-last-sexp eval-print-last-sexp)))
  981. (eq this-command last-command)
  982. (if (boundp 'edebug-active) edebug-active)))
  983. (let ((char-string
  984. (if (or (if (boundp 'edebug-active) edebug-active)
  985. (memq this-command '(eval-last-sexp eval-print-last-sexp)))
  986. (prin1-char value))))
  987. (if char-string
  988. (format " (#o%o, #x%x, %s)" value value char-string)
  989. (format " (#o%o, #x%x)" value value)))))
  990. ;; We define this, rather than making `eval' interactive,
  991. ;; for the sake of completion of names like eval-region, eval-buffer.
  992. (defun eval-expression (eval-expression-arg
  993. &optional eval-expression-insert-value)
  994. "Evaluate EVAL-EXPRESSION-ARG and print value in the echo area.
  995. Value is also consed on to front of the variable `values'.
  996. Optional argument EVAL-EXPRESSION-INSERT-VALUE, if non-nil, means
  997. insert the result into the current buffer instead of printing it in
  998. the echo area. Truncates long output according to the value of the
  999. variables `eval-expression-print-length' and `eval-expression-print-level'.
  1000. If `eval-expression-debug-on-error' is non-nil, which is the default,
  1001. this command arranges for all errors to enter the debugger."
  1002. (interactive
  1003. (list (let ((minibuffer-completing-symbol t))
  1004. (read-from-minibuffer "Eval: "
  1005. nil read-expression-map t
  1006. 'read-expression-history))
  1007. current-prefix-arg))
  1008. (if (null eval-expression-debug-on-error)
  1009. (setq values (cons (eval eval-expression-arg) values))
  1010. (let ((old-value (make-symbol "t")) new-value)
  1011. ;; Bind debug-on-error to something unique so that we can
  1012. ;; detect when evaled code changes it.
  1013. (let ((debug-on-error old-value))
  1014. (setq values (cons (eval eval-expression-arg) values))
  1015. (setq new-value debug-on-error))
  1016. ;; If evaled code has changed the value of debug-on-error,
  1017. ;; propagate that change to the global binding.
  1018. (unless (eq old-value new-value)
  1019. (setq debug-on-error new-value))))
  1020. (let ((print-length eval-expression-print-length)
  1021. (print-level eval-expression-print-level))
  1022. (if eval-expression-insert-value
  1023. (with-no-warnings
  1024. (let ((standard-output (current-buffer)))
  1025. (prin1 (car values))))
  1026. (prog1
  1027. (prin1 (car values) t)
  1028. (let ((str (eval-expression-print-format (car values))))
  1029. (if str (princ str t)))))))
  1030. (defun edit-and-eval-command (prompt command)
  1031. "Prompting with PROMPT, let user edit COMMAND and eval result.
  1032. COMMAND is a Lisp expression. Let user edit that expression in
  1033. the minibuffer, then read and evaluate the result."
  1034. (let ((command
  1035. (let ((print-level nil)
  1036. (minibuffer-history-sexp-flag (1+ (minibuffer-depth))))
  1037. (unwind-protect
  1038. (read-from-minibuffer prompt
  1039. (prin1-to-string command)
  1040. read-expression-map t
  1041. 'command-history)
  1042. ;; If command was added to command-history as a string,
  1043. ;; get rid of that. We want only evaluable expressions there.
  1044. (if (stringp (car command-history))
  1045. (setq command-history (cdr command-history)))))))
  1046. ;; If command to be redone does not match front of history,
  1047. ;; add it to the history.
  1048. (or (equal command (car command-history))
  1049. (setq command-history (cons command command-history)))
  1050. (eval command)))
  1051. (defun repeat-complex-command (arg)
  1052. "Edit and re-evaluate last complex command, or ARGth from last.
  1053. A complex command is one which used the minibuffer.
  1054. The command is placed in the minibuffer as a Lisp form for editing.
  1055. The result is executed, repeating the command as changed.
  1056. If the command has been changed or is not the most recent previous
  1057. command it is added to the front of the command history.
  1058. You can use the minibuffer history commands \
  1059. \\<minibuffer-local-map>\\[next-history-element] and \\[previous-history-element]
  1060. to get different commands to edit and resubmit."
  1061. (interactive "p")
  1062. (let ((elt (nth (1- arg) command-history))
  1063. newcmd)
  1064. (if elt
  1065. (progn
  1066. (setq newcmd
  1067. (let ((print-level nil)
  1068. (minibuffer-history-position arg)
  1069. (minibuffer-history-sexp-flag (1+ (minibuffer-depth))))
  1070. (unwind-protect
  1071. (read-from-minibuffer
  1072. "Redo: " (prin1-to-string elt) read-expression-map t
  1073. (cons 'command-history arg))
  1074. ;; If command was added to command-history as a
  1075. ;; string, get rid of that. We want only
  1076. ;; evaluable expressions there.
  1077. (if (stringp (car command-history))
  1078. (setq command-history (cdr command-history))))))
  1079. ;; If command to be redone does not match front of history,
  1080. ;; add it to the history.
  1081. (or (equal newcmd (car command-history))
  1082. (setq command-history (cons newcmd command-history)))
  1083. (eval newcmd))
  1084. (if command-history
  1085. (error "Argument %d is beyond length of command history" arg)
  1086. (error "There are no previous complex commands to repeat")))))
  1087. (defvar minibuffer-history nil
  1088. "Default minibuffer history list.
  1089. This is used for all minibuffer input
  1090. except when an alternate history list is specified.
  1091. Maximum length of the history list is determined by the value
  1092. of `history-length', which see.")
  1093. (defvar minibuffer-history-sexp-flag nil
  1094. "Control whether history list elements are expressions or strings.
  1095. If the value of this variable equals current minibuffer depth,
  1096. they are expressions; otherwise they are strings.
  1097. \(That convention is designed to do the right thing for
  1098. recursive uses of the minibuffer.)")
  1099. (setq minibuffer-history-variable 'minibuffer-history)
  1100. (setq minibuffer-history-position nil) ;; Defvar is in C code.
  1101. (defvar minibuffer-history-search-history nil)
  1102. (defvar minibuffer-text-before-history nil
  1103. "Text that was in this minibuffer before any history commands.
  1104. This is nil if there have not yet been any history commands
  1105. in this use of the minibuffer.")
  1106. (add-hook 'minibuffer-setup-hook 'minibuffer-history-initialize)
  1107. (defun minibuffer-history-initialize ()
  1108. (setq minibuffer-text-before-history nil))
  1109. (defun minibuffer-avoid-prompt (new old)
  1110. "A point-motion hook for the minibuffer, that moves point out of the prompt."
  1111. (constrain-to-field nil (point-max)))
  1112. (defcustom minibuffer-history-case-insensitive-variables nil
  1113. "Minibuffer history variables for which matching should ignore case.
  1114. If a history variable is a member of this list, then the
  1115. \\[previous-matching-history-element] and \\[next-matching-history-element]\
  1116. commands ignore case when searching it, regardless of `case-fold-search'."
  1117. :type '(repeat variable)
  1118. :group 'minibuffer)
  1119. (defun previous-matching-history-element (regexp n)
  1120. "Find the previous history element that matches REGEXP.
  1121. \(Previous history elements refer to earlier actions.)
  1122. With prefix argument N, search for Nth previous match.
  1123. If N is negative, find the next or Nth next match.
  1124. Normally, history elements are matched case-insensitively if
  1125. `case-fold-search' is non-nil, but an uppercase letter in REGEXP
  1126. makes the search case-sensitive.
  1127. See also `minibuffer-history-case-insensitive-variables'."
  1128. (interactive
  1129. (let* ((enable-recursive-minibuffers t)
  1130. (regexp (read-from-minibuffer "Previous element matching (regexp): "
  1131. nil
  1132. minibuffer-local-map
  1133. nil
  1134. 'minibuffer-history-search-history
  1135. (car minibuffer-history-search-history))))
  1136. ;; Use the last regexp specified, by default, if input is empty.
  1137. (list (if (string= regexp "")
  1138. (if minibuffer-history-search-history
  1139. (car minibuffer-history-search-history)
  1140. (error "No previous history search regexp"))
  1141. regexp)
  1142. (prefix-numeric-value current-prefix-arg))))
  1143. (unless (zerop n)
  1144. (if (and (zerop minibuffer-history-position)
  1145. (null minibuffer-text-before-history))
  1146. (setq minibuffer-text-before-history
  1147. (minibuffer-contents-no-properties)))
  1148. (let ((history (symbol-value minibuffer-history-variable))
  1149. (case-fold-search
  1150. (if (isearch-no-upper-case-p regexp t) ; assume isearch.el is dumped
  1151. ;; On some systems, ignore case for file names.
  1152. (if (memq minibuffer-history-variable
  1153. minibuffer-history-case-insensitive-variables)
  1154. t
  1155. ;; Respect the user's setting for case-fold-search:
  1156. case-fold-search)
  1157. nil))
  1158. prevpos
  1159. match-string
  1160. match-offset
  1161. (pos minibuffer-history-position))
  1162. (while (/= n 0)
  1163. (setq prevpos pos)
  1164. (setq pos (min (max 1 (+ pos (if (< n 0) -…

Large files files are truncated, but you can click here to view the full file