|
|
1.1 ! root 1: ;; Lisp editing commands for Emacs ! 2: ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc. ! 3: ! 4: ;; This file is part of GNU Emacs. ! 5: ! 6: ;; GNU Emacs is free software; you can redistribute it and/or modify ! 7: ;; it under the terms of the GNU General Public License as published by ! 8: ;; the Free Software Foundation; either version 1, or (at your option) ! 9: ;; any later version. ! 10: ! 11: ;; GNU Emacs is distributed in the hope that it will be useful, ! 12: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ! 13: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! 14: ;; GNU General Public License for more details. ! 15: ! 16: ;; You should have received a copy of the GNU General Public License ! 17: ;; along with GNU Emacs; see the file COPYING. If not, write to ! 18: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ! 19: ! 20: ! 21: (defun forward-sexp (&optional arg) ! 22: "Move forward across one balanced expression. ! 23: With argument, do this that many times." ! 24: (interactive "p") ! 25: (or arg (setq arg 1)) ! 26: (goto-char (or (scan-sexps (point) arg) (buffer-end arg))) ! 27: (if (< arg 0) (backward-prefix-chars))) ! 28: ! 29: (defun backward-sexp (&optional arg) ! 30: "Move backward across one balanced expression. ! 31: With argument, do this that many times." ! 32: (interactive "p") ! 33: (or arg (setq arg 1)) ! 34: (forward-sexp (- arg))) ! 35: ! 36: (defun mark-sexp (arg) ! 37: "Set mark ARG sexps from point." ! 38: (interactive "p") ! 39: (push-mark ! 40: (save-excursion ! 41: (forward-sexp arg) ! 42: (point)))) ! 43: ! 44: (defun forward-list (&optional arg) ! 45: "Move forward across one balanced group of parentheses. ! 46: With argument, do this that many times." ! 47: (interactive "p") ! 48: (or arg (setq arg 1)) ! 49: (goto-char (or (scan-lists (point) arg 0) (buffer-end arg)))) ! 50: ! 51: (defun backward-list (&optional arg) ! 52: "Move backward across one balanced group of parentheses. ! 53: With argument, do this that many times." ! 54: (interactive "p") ! 55: (or arg (setq arg 1)) ! 56: (forward-list (- arg))) ! 57: ! 58: (defun down-list (arg) ! 59: "Move forward down one level of parentheses. ! 60: With argument, do this that many times. ! 61: A negative argument means move backward but still go down a level." ! 62: (interactive "p") ! 63: (let ((inc (if (> arg 0) 1 -1))) ! 64: (while (/= arg 0) ! 65: (goto-char (or (scan-lists (point) inc -1) (buffer-end arg))) ! 66: (setq arg (- arg inc))))) ! 67: ! 68: (defun backward-up-list (arg) ! 69: "Move backward out of one level of parentheses. ! 70: With argument, do this that many times. ! 71: A negative argument means move forward but still to a less deep spot." ! 72: (interactive "p") ! 73: (up-list (- arg))) ! 74: ! 75: (defun up-list (arg) ! 76: "Move forward out of one level of parentheses. ! 77: With argument, do this that many times. ! 78: A negative argument means move backward but still to a less deep spot." ! 79: (interactive "p") ! 80: (let ((inc (if (> arg 0) 1 -1))) ! 81: (while (/= arg 0) ! 82: (goto-char (or (scan-lists (point) inc 1) (buffer-end arg))) ! 83: (setq arg (- arg inc))))) ! 84: ! 85: (defun kill-sexp (arg) ! 86: "Kill the syntactic expression following the cursor. ! 87: With argument, kill that many expressions after (or before) the cursor." ! 88: (interactive "p") ! 89: (let ((opoint (point))) ! 90: (forward-sexp arg) ! 91: (kill-region opoint (point)))) ! 92: ! 93: (defun backward-kill-sexp (arg) ! 94: "Kill the syntactic expression preceding the cursor. ! 95: With argument, kill that many expressions before (or after) the cursor." ! 96: (interactive "p") ! 97: (kill-sexp (- arg))) ! 98: ! 99: (defun beginning-of-defun (&optional arg) ! 100: "Move backward to next beginning-of-defun. ! 101: With argument, do this that many times. ! 102: Returns t unless search stops due to end of buffer." ! 103: (interactive "p") ! 104: (and arg (< arg 0) (forward-char 1)) ! 105: (and (re-search-backward "^\\s(" nil 'move (or arg 1)) ! 106: (progn (beginning-of-line) t))) ! 107: ! 108: (defun buffer-end (arg) ! 109: (if (> arg 0) (point-max) (point-min))) ! 110: ! 111: (defun end-of-defun (&optional arg) ! 112: "Move forward to next end of defun. ! 113: An end of a defun is found by moving forward from the beginning of one." ! 114: (interactive "p") ! 115: (if (or (null arg) (= arg 0)) (setq arg 1)) ! 116: (let ((first t)) ! 117: (while (and (> arg 0) (< (point) (point-max))) ! 118: (let ((pos (point)) npos) ! 119: (while (progn ! 120: (if (and first ! 121: (progn ! 122: (forward-char 1) ! 123: (beginning-of-defun 1))) ! 124: nil ! 125: (or (bobp) (forward-char -1)) ! 126: (beginning-of-defun -1)) ! 127: (setq first nil) ! 128: (forward-list 1) ! 129: (skip-chars-forward " \t") ! 130: (if (looking-at "[;\n]") ! 131: (forward-line 1)) ! 132: (<= (point) pos)))) ! 133: (setq arg (1- arg))) ! 134: (while (< arg 0) ! 135: (let ((pos (point))) ! 136: (beginning-of-defun 1) ! 137: (forward-sexp 1) ! 138: (forward-line 1) ! 139: (if (>= (point) pos) ! 140: (if (beginning-of-defun 2) ! 141: (progn ! 142: (forward-list 1) ! 143: (skip-chars-forward " \t") ! 144: (if (looking-at "[;\n]") ! 145: (forward-line 1))) ! 146: (goto-char (point-min))))) ! 147: (setq arg (1+ arg))))) ! 148: ! 149: (defun mark-defun () ! 150: "Put mark at end of defun, point at beginning." ! 151: (interactive) ! 152: (push-mark (point)) ! 153: (end-of-defun) ! 154: (push-mark (point)) ! 155: (beginning-of-defun) ! 156: (re-search-backward "^\n" (- (point) 1) t)) ! 157: ! 158: (defun insert-parentheses (arg) ! 159: "Put parentheses around next ARG sexps. Leave point after open-paren. ! 160: No argument is equivalent to zero: just insert () and leave point between." ! 161: (interactive "P") ! 162: ;Install these commented-out lines for version 19. ! 163: ; (if arg (skip-chars-forward " \t") ! 164: ; (or (memq (char-syntax (preceding-char)) '(?\ ?> ?\( )) ! 165: ; (insert " "))) ! 166: (insert ?\() ! 167: (save-excursion ! 168: (if arg ! 169: (forward-sexp (prefix-numeric-value arg))) ! 170: (insert ?\)) ! 171: ; (or (memq (char-syntax (following-char)) '(?\ ?> ?\( )) ! 172: ; (insert " ")) ! 173: )) ! 174: ! 175: (defun move-past-close-and-reindent () ! 176: "Move past next ), delete indentation before it, then indent after it." ! 177: (interactive) ! 178: (up-list 1) ! 179: (forward-char -1) ! 180: (while (save-excursion ; this is my contribution ! 181: (let ((before-paren (point))) ! 182: (back-to-indentation) ! 183: (= (point) before-paren))) ! 184: (delete-indentation)) ! 185: (forward-char 1) ! 186: (newline-and-indent)) ! 187: ! 188: (defun lisp-complete-symbol () ! 189: "Perform completion on Lisp symbol preceding point. ! 190: That symbol is compared against the symbols that exist ! 191: and any additional characters determined by what is there ! 192: are inserted. ! 193: If the symbol starts just after an open-parenthesis, ! 194: only symbols with function definitions are considered. ! 195: Otherwise, all symbols with function definitions, values ! 196: or properties are considered." ! 197: (interactive) ! 198: (let* ((end (point)) ! 199: (buffer-syntax (syntax-table)) ! 200: (beg (unwind-protect ! 201: (save-excursion ! 202: (set-syntax-table emacs-lisp-mode-syntax-table) ! 203: (backward-sexp 1) ! 204: (while (= (char-syntax (following-char)) ?\') ! 205: (forward-char 1)) ! 206: (point)) ! 207: (set-syntax-table buffer-syntax))) ! 208: (pattern (buffer-substring beg end)) ! 209: (predicate ! 210: (if (eq (char-after (1- beg)) ?\() ! 211: 'fboundp ! 212: (function (lambda (sym) ! 213: (or (boundp sym) (fboundp sym) ! 214: (symbol-plist sym)))))) ! 215: (completion (try-completion pattern obarray predicate))) ! 216: (cond ((eq completion t)) ! 217: ((null completion) ! 218: (message "Can't find completion for \"%s\"" pattern) ! 219: (ding)) ! 220: ((not (string= pattern completion)) ! 221: (delete-region beg end) ! 222: (insert completion)) ! 223: (t ! 224: (message "Making completion list...") ! 225: (let ((list (all-completions pattern obarray predicate))) ! 226: (or (eq predicate 'fboundp) ! 227: (let (new) ! 228: (while list ! 229: (setq new (cons (if (fboundp (intern (car list))) ! 230: (list (car list) " <f>") ! 231: (car list)) ! 232: new)) ! 233: (setq list (cdr list))) ! 234: (setq list (nreverse new)))) ! 235: (with-output-to-temp-buffer " *Completions*" ! 236: (display-completion-list list))) ! 237: (message "Making completion list...%s" "done")))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.