Merge branch 'add-ed-hooks' into 'develop'

Add ed hooks

See merge request embeddable-common-lisp/ecl!253

CHANGELOG

@@ -28,6 +28,8 @@
     parameter given to configure script).
 
 * Pending changes since 21.2.1
+** Enhancements
+- Add hook functions for cl:ed via ext:*ed-functions* list
 * 21.2.1 changes since 20.4.24
 ** Announcement
 Dear Community,

src/c/symbols_list.h

@@ -1233,6 +1233,7 @@ cl_symbols[] = {
 {SYS_ "RMDIR" ECL_FUN("si_rmdir", si_rmdir, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
 {EXT_ "MAKE-PIPE" ECL_FUN("si_make_pipe", si_make_pipe, 0) ECL_VAR(EXT_ORDINARY, OBJNULL)},
 /* package extensions */
+{EXT_ "*ED-FUNCTIONS*" ECL_FUN(NULL, NULL, -1) ECL_VAR(EXT_SPECIAL, OBJNULL)},
 {SYS_ "*IGNORE-PACKAGE-LOCKS*" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_SPECIAL, ECL_NIL)},
 {EXT_ "PACKAGE-LOCK" ECL_FUN("si_package_lock", si_package_lock, 2) ECL_VAR(EXT_ORDINARY, OBJNULL)},
 {EXT_ "PACKAGE-LOCKED-P" ECL_FUN("si_package_locked_p", si_package_locked_p, 1) ECL_VAR(EXT_ORDINARY, OBJNULL)},

src/cmp/proclamations.lsp

@@ -1363,8 +1363,7 @@
 (proclamation get-internal-run-time () unsigned-byte :no-side-effects)
 (proclamation disassemble ((or function-designator list)) null)
 (proclamation room (&optional (member t nil :default)) (values &rest t))
-(proclamation ed (&optional (or null pathname string function-name))
-              (values &rest t))
+(proclamation ed (&optional t) (values &rest t))
 (proclamation inspect (t) (values &rest t))
 (proclamation dribble (&optional pathname-designator) (values &rest t))
 (proclamation lisp-implementation-type () (or string null) :pure)

src/doc/manual/standards/environment.txi

@@ -9,6 +9,7 @@
 @node Environment - Dictionary
 @subsection Dictionary
 @lspindex disassemble
+@lspindex ed
 @lspindex trace
 
 @defun disassemble function-designator*
@@ -29,6 +30,23 @@ ECL only has a particular difference: it has two different compilers, one based
 @end itemize
 @end defun
 
+@defun ed x?
+Invoke an editor on the file or object specified by @var{x}.
+@paragraph Synopsis
+(ed @var{x?})
+@table @var
+@item x
+@code{nil}, a file path, or an object to edit.
+@end table
+
+@paragraph Description
+Starts the editor (on a file or an object if named).  Functions from the list @var{ext:*ed-functions*} are called in order with @var{x} as an argument until one of them returns non-@code{nil}; these functions are responsible for signalling a @code{file-error} to indicate failure to perform an operation on the file system. If no function returns a non-@code{nil} value or @var{ext:*ed-functions*} is @code{nil} then a @code{simple-error} will be signalled.
+
+The Common Lisp specification states that the @var{x} argument is either @code{nil}, a function name, or an instance of @var{string} or @var{pathname} and that a @var{type-error} may be signalled if is not one of these types. ECL does not check the type of @var{x} and thus permits any object to be passed to the hook functions. This allows for the possibility of editing other objects that have a representation in source code such as class definitions. Therefore, the hook functions should not make any assumptions about the type of @var{x} and should instead return @code{nil} if there is not an approriate edit method for a specific value of @var{x}.
+
+By default @var{ext:*ed-functions*} contains a single function that attempts to run the program named in the environment variable @code{EDITOR}. If this environment variable is not set then the fallback program is @code{vi}.
+@end defun
+
 @defmac trace function-name*
 Follow the execution of functions
 @paragraph Synopsis

src/lsp/autoload.lsp

@@ -46,12 +46,44 @@ Gives a global declaration.  See DECLARE for possible DECL-SPECs."
 
 ;;; Editor.
 
-(defun ed (&optional filename)
-  "Args: (&optional filename)
-Invokes the editor.  The action depends on the version of ECL.  See the ECL
-Report for details."
-  (ext:system (format nil "~S ~A" (or (si::getenv "EDITOR") "vi") filename)))
+;;; Default editor hook which calls external program defined by the EDITOR
+;;; environment variable or vi if that is not defined.
+(declaim (ftype (function (t) boolean) ed-external))
+(defun ed-external (x)
+  (when (typep x '(or null pathname string))
+    (run-program (or (getenv "EDITOR") "vi") (and x (list x)))
+    t))
 
+;;; Copied mostly from SBCL
+(declaim (type list *ed-functions*))
+(defvar *ed-functions* (list #'ed-external)
+  "See function documentation for ED.")
+
+(defun ed (&optional x)
+  "Starts the editor (on a file or an object if named).  Functions from the
+list EXT:*ED-FUNCTIONS* are called in order with X as an argument until one
+of them returns non-NIL; these functions are responsible for signalling a
+FILE-ERROR to indicate failure to perform an operation on the file system.
+If no function returns a non-NIL value or EXT:*ED-FUNCTIONS* is NIL then a
+SIMPLE-ERROR will be signalled.
+
+The Common Lisp specification states that the X argument is either NIL, a
+function name, or an instance of STRING or PATHNAME and that a TYPE-ERROR
+may be signalled if is not one of these types. ECL does not check the type
+of X and thus permits any object to be passed to the hook functions. This
+allows for the possibility of editing other objects that have a
+representation in source code such as class definitions. Therefore, the
+hook functions should not make any assumptions about the type of X and
+should instead return NIL if there is not an approriate edit method for a
+specific value of X.
+
+By default EXT:*ED-FUNCTIONS* contains a single function that attempts to
+run the program named in the environment variable EDITOR. If this
+environment variable is not set then the fallback program is vi."
+  (dolist (fun *ed-functions*
+           (error "Do not know how to ED ~a." x))
+    (when (funcall fun x)
+      (return t))))
 
 ;;; Allocator.
 

src/tests/normal-tests/mixed.lsp

@@ -378,3 +378,20 @@
       (setf stream-var inner-stream-var)
       (is (open-stream-p stream-var)))
     (is (not (open-stream-p stream-var)))))
+
+;;;; Author:   Tarn W. Burton
+;;;; Created:  2021-06-05
+;;;; Contains: *ed-functions* tests
+(test mix.0020.ed-functions
+  (let ((ext:*ed-functions* (list (lambda (x)
+                                    (equal x "foo"))
+                                  (lambda (x)
+                                    (equal x "bar"))
+                                  (lambda (x)
+                                    (when (equal x "baz")
+                                      (error 'file-error :pathname x))))))
+    (is (ed "foo"))
+    (is (ed "bar"))
+    (signals simple-error (ed "qux"))
+    (signals file-error (ed "baz"))))
+