source: trunk/j/src/org/armedbear/lisp/ed.lisp @ 9266

Last change on this file since 9266 was 9021, checked in by piso, 16 years ago

DEFAULT-ED-FUNCTION: added IGNORE declaration.

File size: 5.4 KB
Line 
1;;; ed.lisp
2;;;
3;;; Copyright (C) 2004-2005 Peter Graves
4;;; $Id: ed.lisp,v 1.6 2005-04-30 20:00:09 piso Exp $
5;;;
6;;; This program is free software; you can redistribute it and/or
7;;; modify it under the terms of the GNU General Public License
8;;; as published by the Free Software Foundation; either version 2
9;;; of the License, or (at your option) any later version.
10;;;
11;;; This program 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 this program; if not, write to the Free Software
18;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
19
20;;; Adapted from SBCL.
21
22(in-package #:system)
23
24(defun ed (&optional x)
25  "Starts the editor (on a file or a function if named).  Functions
26from the list *ED-FUNCTIONS* are called in order with X as an argument
27until one of them returns non-NIL; these functions are responsible for
28signalling a FILE-ERROR to indicate failure to perform an operation on
29the file system."
30  (dolist (fun *ed-functions*
31     (error 'simple-error
32      :format-control "Don't know how to ~S ~A"
33      :format-arguments (list 'ed x)))
34    (when (funcall fun x)
35      (return)))
36  (values))
37
38(defun default-ed-function (what)
39  (let ((portfile (merge-pathnames ".j/port" (if (featurep :windows)
40                                                 "C:\\"
41                                                 (user-homedir-pathname))))
42        stream)
43    (when (probe-file portfile)
44      (let* ((port (with-open-file (s portfile) (read s nil nil)))
45             (socket (and (integerp port) (make-socket "127.0.0.1" port))))
46        (setf stream (and socket (get-socket-stream socket)))))
47    (unwind-protect
48     (cond ((stringp what)
49            (if stream
50                (progn
51                  (write-string (namestring (user-homedir-pathname)) stream)
52                  (terpri stream)
53                  (write-string (format nil "~S~%" what) stream))
54                (run-shell-command (format nil "j ~S" what))))
55           ((and what (symbolp what))
56            (when (autoloadp what)
57              (let ((*load-verbose* nil)
58                    (*load-print* nil)
59                    (*autoload-verbose* nil))
60                (resolve what)))
61            (cond ((source what)
62                   (let ((file (namestring (source-pathname what)))
63                         (position (source-file-position what))
64                         (line-number 1)
65                         (pattern (string what)))
66                     (with-open-file (s file)
67                       (dotimes (i position)
68                         (let ((c (read-char s nil s)))
69                           (cond ((eq c s)
70                                  (return))
71                                 ((eql c #\newline)
72                                  (incf line-number)))))
73                       (dotimes (i 10)
74                         (let ((text (read-line s nil s)))
75                           (cond ((eq text s)
76                                  (return))
77                                 ((search pattern text :test 'string-equal)
78                                  (return))
79                                 (t
80                                  (incf line-number))))))
81                     (if stream
82                         (progn
83                           (write-string (namestring (user-homedir-pathname)) stream)
84                           (terpri stream)
85                           (write-string (format nil "+~D~%~S~%" line-number file) stream))
86                         (run-shell-command (format nil "j +~D ~S" line-number file)))))
87                  ((not (null *lisp-home*))
88                   (let ((tagfile (merge-pathnames "tags" *lisp-home*)))
89                     (when (and tagfile (probe-file tagfile))
90                       (with-open-file (s tagfile)
91                         (loop
92                           (let ((text (read-line s nil s)))
93                             (cond ((eq text s)
94                                    (return))
95                                   ((eq what (read-from-string text nil nil))
96                                    ;; Found it!
97                                    (with-input-from-string (string-stream text)
98                                      (let* ((symbol (read string-stream text nil nil)) ; Ignored.
99                                             (file (read string-stream text nil nil))
100                                             (line-number (read string-stream text nil nil)))
101                                        (declare (ignore symbol))
102                                        (when (pathnamep file)
103                                          (setf file (namestring file)))
104                                        (if stream
105                                            (progn
106                                              (write-string (namestring (user-homedir-pathname)) stream)
107                                              (terpri stream)
108                                              (write-string (format nil "+~D~%~S~%" line-number file) stream))
109                                            (run-shell-command (format nil "j +~D ~S" line-number file))))))))))))))))
110     (when stream
111       (close stream))))
112  t)
Note: See TracBrowser for help on using the repository browser.