|
0
|
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))))))))
|
