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