return r;
}
+static foreign_t
+sweep_funcall0(term_t f, term_t v) {
+ char * string = NULL;
+ emacs_value r = NULL;
+ size_t l = -1;
+ term_t n = PL_new_term_ref();
+
+ if (PL_get_nchars(f, &l, &string, CVT_STRING|REP_UTF8)) {
+ r = current_env->funcall(current_env, current_env->intern(current_env, string), 0, NULL);
+ if (value_to_term(current_env, r, n) >= 0) {
+ if (PL_unify(n, v)) {
+ return TRUE;
+ }
+ }
+ }
+ return FALSE;
+}
+
+static foreign_t
+sweep_funcall1(term_t f, term_t a, term_t v) {
+ char * string = NULL;
+ emacs_value e = NULL;
+ emacs_value r = NULL;
+ size_t l = -1;
+ term_t n = PL_new_term_ref();
+
+ if (PL_get_nchars(f, &l, &string, CVT_STRING|REP_UTF8)) {
+ e = term_to_value(current_env, a);
+ if (e != NULL) {
+ r = current_env->funcall(current_env, current_env->intern(current_env, string), 1, &e);
+ if (value_to_term(current_env, r, n) >= 0) {
+ if (PL_unify(n, v)) {
+ return TRUE;
+ }
+ }
+ }
+ }
+ return FALSE;
+}
+
static emacs_value
sweep_initialize(emacs_env *env, ptrdiff_t nargs, emacs_value *args, void *data)
{
if (PL_version_info(PL_VERSION_SYSTEM < 80516))
PL_action(PL_GMP_SET_ALLOC_FUNCTIONS, FALSE);
+ PL_register_foreign("sweep_funcall", 3, sweep_funcall1, 0);
+ PL_register_foreign("sweep_funcall", 2, sweep_funcall0, 0);
+
r = PL_initialise(nargs, argv);
for (i = 0; i < nargs; i++) {
env->funcall(env, Qprovide, 1, (emacs_value[]){Qfeat});
}
-static foreign_t
-sweep_funcall0(term_t f, term_t v) {
- char * string = NULL;
- emacs_value r = NULL;
- size_t l = -1;
- term_t n = PL_new_term_ref();
-
- if (PL_get_nchars(f, &l, &string, CVT_STRING|REP_UTF8)) {
- r = current_env->funcall(current_env, current_env->intern(current_env, string), 0, NULL);
- if (value_to_term(current_env, r, n) >= 0) {
- if (PL_unify(n, v)) {
- return TRUE;
- }
- }
- }
- return FALSE;
-}
-
-static foreign_t
-sweep_funcall1(term_t f, term_t a, term_t v) {
- char * string = NULL;
- emacs_value e = NULL;
- emacs_value r = NULL;
- size_t l = -1;
- term_t n = PL_new_term_ref();
-
- if (PL_get_nchars(f, &l, &string, CVT_STRING|REP_UTF8)) {
- e = term_to_value(current_env, a);
- if (e != NULL) {
- r = current_env->funcall(current_env, current_env->intern(current_env, string), 1, &e);
- if (value_to_term(current_env, r, n) >= 0) {
- if (PL_unify(n, v)) {
- return TRUE;
- }
- }
- }
- }
- return FALSE;
-}
-
int
emacs_module_init (struct emacs_runtime *runtime)
{
emacs_value args_cleanup[] = {symbol_cleanup, func_cleanup};
env->funcall (env, env->intern (env, "defalias"), 2, args_cleanup);
- PL_register_foreign("sweep_funcall", 3, sweep_funcall1, 0);
- PL_register_foreign("sweep_funcall", 2, sweep_funcall0, 0);
-
provide(env, "sweep-module");
return 0;
sweep_op_info/2,
sweep_imenu_index/2,
sweep_module_path/2,
+ sweep_top_level_server/2,
+ sweep_accept_top_level_client/2,
write_sweep_module_location/0
]).
:- dynamic sweep_current_color/3,
sweep_open/2,
+ sweep_top_level_thread_buffer/2,
sweep_source_time/2,
sweep_current_comment/3.
sweep_setup_message_hook(_, _) :-
- retractall(user:thread_message_hook(_, _, _)),
asserta((
user:thread_message_hook(Term, Kind, Lines) :-
sweep_message_hook(Term, Kind, Lines)
- )).
+ ),
+ Ref),
+ at_halt(erase(Ref)).
sweep_message_hook(Term, Kind0, _Lines) :-
should_handle_message_kind(Kind0, Kind),
Path,
[file_type(executable), access(read)]),
writeln(Path).
+
+sweep_top_level_server(_, Port) :-
+ tcp_socket(ServerSocket),
+ tcp_setopt(ServerSocket, reuseaddr),
+ tcp_bind(ServerSocket, Port),
+ tcp_listen(ServerSocket, 5),
+ thread_create(sweep_top_level_server_loop(ServerSocket), T,
+ [ alias(sweep_top_level_server)
+ ]),
+ at_halt(( is_thread(T),
+ thread_property(T, status(running))
+ -> thread_signal(T, thread_exit(0)),
+ thread_join(T, _)
+ ; true
+ )).
+
+sweep_top_level_server_loop(ServerSocket) :-
+ thread_get_message(Message),
+ sweep_top_level_server_loop_(Message, ServerSocket).
+
+sweep_top_level_server_loop_(accept(Buffer), ServerSocket) :-
+ !,
+ tcp_accept(ServerSocket, Slave, Peer),
+ tcp_open_socket(Slave, InStream, OutStream),
+ set_stream(InStream, close_on_abort(false)),
+ set_stream(OutStream, close_on_abort(false)),
+ thread_create(sweep_top_level_client(InStream, OutStream, Peer), T, [detached(true)]),
+ at_halt(( is_thread(T),
+ thread_property(T, status(running))
+ -> thread_signal(T, thread_exit(0)),
+ thread_join(T, _)
+ ; true
+ )),
+ thread_property(T, id(Id)),
+ asserta(sweep_top_level_thread_buffer(Id, Buffer)),
+ sweep_top_level_server_loop(ServerSocket).
+sweep_top_level_server_loop_(_, _).
+
+sweep_top_level_client(InStream, OutStream, ip(127,0,0,1)) :-
+ !,
+ set_prolog_IO(InStream, OutStream, OutStream),
+ set_stream(InStream, tty(true)),
+ set_prolog_flag(tty_control, false),
+ current_prolog_flag(encoding, Enc),
+ set_stream(user_input, encoding(Enc)),
+ set_stream(user_output, encoding(Enc)),
+ set_stream(user_error, encoding(Enc)),
+ set_stream(user_input, newline(detect)),
+ set_stream(user_output, newline(dos)),
+ set_stream(user_error, newline(dos)),
+ call_cleanup(prolog,
+ ( close(InStream, [force(true)]),
+ close(OutStream, [force(true)]),
+ thread_self(Self),
+ thread_property(Self, id(Id)),
+ retractall(sweep_top_level_thread_buffer(Id, _))
+ )).
+sweep_top_level_client(InStream, OutStream, _) :-
+ close(InStream),
+ close(OutStream),
+ thread_self(Self),
+ thread_property(Self, id(Id)),
+ retractall(sweep_top_level_thread_buffer(Id, _)).
+
+sweep_accept_top_level_client(Buffer, _) :-
+ thread_send_message(sweep_top_level_server, accept(Buffer)).
(defun sweeprolog-start-prolog-server ()
(sweeprolog-open-query "user"
- "prolog_server"
- "prolog_server"
- nil t)
+ "sweep"
+ "sweep_top_level_server"
+ nil)
(let ((sol (sweeprolog-next-solution)))
(sweeprolog-close-query)
(when (sweeprolog-true-p sol)
;; (remove-list-of-text-properties beg end '(font-lock-face)))
(sweeprolog-grammar-rule-face))
("method" (sweeprolog-method-face))
- ("class" (sweeprolog-class-face))))
+ ("class" (sweeprolog-class-face))
+ ;; (_ (message "%S" arg) nil)
+ ))
(defun sweeprolog--colourise (args)
"ARGS is a list of the form (BEG LEN . SEM)."
(arg (cddr args))
(flf (sweeprolog--colour-term-to-face arg)))
(with-silent-modifications
- (font-lock--add-text-property beg end 'font-lock-face flf (current-buffer) nil))))
+ (put-text-property beg end 'font-lock-face flf))))
(defun sweeprolog-colourise-buffer (&optional buffer)
(interactive)
(end (point-max))
(contents (buffer-substring-no-properties beg end)))
(sweeprolog-open-query "user"
- "sweep"
- "sweep_load_buffer"
- (cons contents (buffer-file-name)))
+ "sweep"
+ "sweep_load_buffer"
+ (cons contents (buffer-file-name)))
(let ((sol (sweeprolog-next-solution)))
(sweeprolog-close-query)
(if (sweeprolog-true-p sol)
(generate-new-buffer-name "*sweeprolog-top-level*"))))))
(list buffer)))
(let ((buf (get-buffer-create (or buffer "*sweeprolog-top-level*"))))
- (with-current-buffer buf
- (unless (eq major-mode 'sweeprolog-top-level-mode)
- (sweeprolog-top-level-mode)))
- (make-comint-in-buffer "sweeprolog-top-level"
- buf
- (cons "localhost"
- sweeprolog-prolog-server-port))
- (pop-to-buffer buf sweeprolog-top-level-display-action)))
+ (with-current-buffer buf
+ (unless (eq major-mode 'sweeprolog-top-level-mode)
+ (sweeprolog-top-level-mode)))
+ (sweeprolog-open-query "user"
+ "sweep"
+ "sweep_accept_top_level_client"
+ (buffer-name buf))
+ (let ((sol (sweeprolog-next-solution)))
+ (sweeprolog-close-query)
+ (unless (sweeprolog-true-p sol)
+ (error "Failed to create new top-level!")))
+ (make-comint-in-buffer "sweeprolog-top-level"
+ buf
+ (cons "localhost"
+ sweeprolog-prolog-server-port))
+ (pop-to-buffer buf sweeprolog-top-level-display-action)))
(defun sweeprolog-top-level--post-self-insert-function ()
(when-let ((pend (cdr comint-last-prompt)))
projects / dict.git / commitdiff