Mercurial > hg > xemacs-beta
comparison lisp/ilisp/ilisp-low.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:45:50 +0200 |
parents | |
children | b82b59fe008d |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:376386a54a3c |
---|---|
1 ;;; -*- Mode: Emacs-Lisp -*- | |
2 | |
3 ;;; ilisp-low.el -- | |
4 | |
5 ;;; This file is part of ILISP. | |
6 ;;; Version: 5.7 | |
7 ;;; | |
8 ;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell | |
9 ;;; 1993, 1994 Ivan Vasquez | |
10 ;;; 1994, 1995 Marco Antoniotti and Rick Busdiecker | |
11 ;;; | |
12 ;;; Other authors' names for which this Copyright notice also holds | |
13 ;;; may appear later in this file. | |
14 ;;; | |
15 ;;; Send mail to 'ilisp-request@lehman.com' to be included in the | |
16 ;;; ILISP mailing list. 'ilisp@lehman.com' is the general ILISP | |
17 ;;; mailing list were bugs and improvements are discussed. | |
18 ;;; | |
19 ;;; ILISP is freely redistributable under the terms found in the file | |
20 ;;; COPYING. | |
21 | |
22 | |
23 | |
24 ;;; | |
25 ;;; ILISP low level interface functions Lisp <-> Emacs | |
26 ;;; | |
27 ;;; | |
28 | |
29 | |
30 | |
31 ;;;%Lisp mode extensions | |
32 ;;;%%Sexps | |
33 (defun lisp-previous-sexp (&optional prefix) | |
34 "Return the previous sexp. If PREFIX is T, then prefix like ' or #' | |
35 are allowed." | |
36 (save-excursion | |
37 (condition-case () | |
38 (progn | |
39 (if (and (memq major-mode ilisp-modes) | |
40 (= (point) | |
41 (process-mark (get-buffer-process (current-buffer))))) | |
42 nil | |
43 (if (not | |
44 (or (eobp) (memq (char-after (point)) '(? ?\) ?\n ?\t)))) | |
45 (forward-sexp)) | |
46 (skip-chars-backward " \t\n") | |
47 (let ((point (point))) | |
48 (backward-sexp) | |
49 (skip-chars-backward "^ \t\n(\",") | |
50 (if (not prefix) (skip-chars-forward "#'")) | |
51 (buffer-substring (point) point)))) | |
52 (error nil)))) | |
53 | |
54 ;;; | |
55 (defun lisp-def-name (&optional namep) | |
56 "Return the name of a definition assuming that you are at the start | |
57 of the sexp. If the form starts with DEF, the form start and the next | |
58 symbol will be returned. Optional NAMEP will return only the name without the defining symbol." | |
59 (let ((case-fold-search t)) | |
60 (if (looking-at | |
61 ;; (( \( (def*) (( \( (setf)) | \(?)) | \(?) (symbol) | |
62 ;; 12 3 3 45 6 65 42 1 7 7 | |
63 ;;0011\(22 def* 22 32 43\(54 setf54 43 \(?32 11 00 60 60 | |
64 "\\(\\((\\(def[^ \t\n]*\\)[ \t\n]+\\(\\((\\(setf\\)[ \t\n]+\\)\\|(?\\)\\)\\|(?\\)\\([^ \t\n)]*\\)") | |
65 (let ((symbol (buffer-substring (match-beginning 7) (match-end 7)))) | |
66 (if (match-end 6) | |
67 (concat (if (not namep) | |
68 (concat | |
69 (buffer-substring (match-beginning 3) (match-end 3)) | |
70 " ")) | |
71 "(" | |
72 (buffer-substring (match-beginning 6) (match-end 6)) | |
73 " " symbol ")") | |
74 (if (match-end 3) | |
75 (concat (if (not namep) | |
76 (concat | |
77 (buffer-substring (match-beginning 3) | |
78 (match-end 3)) | |
79 " ")) | |
80 symbol) | |
81 symbol)))))) | |
82 | |
83 | |
84 ;;; | |
85 (defun lisp-minus-prefix () | |
86 "Set current-prefix-arg to its absolute value if numeric and return | |
87 T if it is a negative." | |
88 (if current-prefix-arg | |
89 (if (symbolp current-prefix-arg) | |
90 (progn (setq current-prefix-arg nil) t) | |
91 (if (< (setq current-prefix-arg | |
92 (prefix-numeric-value current-prefix-arg)) | |
93 0) | |
94 (progn | |
95 (setq current-prefix-arg (- current-prefix-arg)) t))))) | |
96 | |
97 | |
98 | |
99 ;;;%%Defuns | |
100 (defun lisp-defun-region-and-name () | |
101 "Return the region of the current defun and the name starting it." | |
102 (save-excursion | |
103 (let ((end (lisp-defun-end)) | |
104 (begin (lisp-defun-begin))) | |
105 (list begin end (lisp-def-name))))) | |
106 | |
107 ;;; | |
108 (defun lisp-region-name (start end) | |
109 "Return a name for the region from START to END." | |
110 (save-excursion | |
111 (goto-char start) | |
112 (if (re-search-forward "^[ \t]*[^;\n]" end t) | |
113 (forward-char -1)) | |
114 (setq start (point)) | |
115 (goto-char end) | |
116 (re-search-backward "^[ \t]*[^;\n]" start 'move) | |
117 (end-of-line) | |
118 (skip-chars-backward " \t") | |
119 (setq end (min (point) end)) | |
120 (goto-char start) | |
121 (let ((from | |
122 (if (= (char-after (point)) ?\() | |
123 (lisp-def-name) | |
124 (buffer-substring (point) | |
125 (progn (forward-sexp) (point)))))) | |
126 (goto-char end) | |
127 (if (= (char-after (1- (point))) ?\)) | |
128 (progn | |
129 (backward-sexp) | |
130 (if (= (point) start) | |
131 from | |
132 (concat "from " from " to " (lisp-def-name)))) | |
133 (concat "from " from " to " | |
134 (buffer-substring (save-excursion | |
135 (backward-sexp) | |
136 (point)) | |
137 (1- (point)))))))) |