diff --git a/CHANGELOG b/CHANGELOG index ecd1d5171..3ab6e281b 100644 --- a/CHANGELOG +++ b/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, diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index ad236595f..360987d1c 100755 --- a/src/c/symbols_list.h +++ b/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)}, diff --git a/src/cmp/proclamations.lsp b/src/cmp/proclamations.lsp index a9497a403..2a52a1eff 100644 --- a/src/cmp/proclamations.lsp +++ b/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) diff --git a/src/doc/manual/standards/environment.txi b/src/doc/manual/standards/environment.txi index aed835e45..f9d8b2591 100644 --- a/src/doc/manual/standards/environment.txi +++ b/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 diff --git a/src/lsp/autoload.lsp b/src/lsp/autoload.lsp index ff6ea5c69..a6e16399b 100644 --- a/src/lsp/autoload.lsp +++ b/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. diff --git a/src/tests/normal-tests/mixed.lsp b/src/tests/normal-tests/mixed.lsp index 1c108dbad..b9f88ba53 100644 --- a/src/tests/normal-tests/mixed.lsp +++ b/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")))) +