package ecaml

  1. Overview
  2. Docs
Library for writing Emacs plugin in OCaml

Install

Dune Dependency

Authors

Maintainers

Sources

v0.17.0.tar.gz
sha256=87e76473915e12d718096100a5c4d15d98aba6f99ecbf21814b7389e8c28bb25

doc/src/ecaml/ecaml.ml.html

Source file ecaml.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
(* We export all the Ecaml modules before doing [open!]s, because we want to export Ecaml
   modules that shadow [Core] ones. *)

module Abbrev = Abbrev
module Advice = Advice
module Ansi_color = Ansi_color
module Async_ecaml = Async_ecaml
module Auto_mode_alist = Auto_mode_alist
module Background = Background
module Backup = Backup
module Bookmark = Bookmark
module Browse_url = Browse_url
module Buffer = Buffer
module Buffer_local = Buffer_local
module Caml_embed = Ecaml_value.Caml_embed
module Char_code = Char_code
module Clipboard = Clipboard
module Color = Color
module Command = Command
module Comment = Comment
module Compilation = Compilation
module Completing = Completing
module Current_buffer = Current_buffer
module Customization = Customization
module Debugger = Debugger
module Defconst = Defconst
module Defun = Defun
module Defvar = Defvar
module Directory = Directory
module Display = Display
module Display_property = Display_property
module Documentation = Documentation
module Ecaml_profile = Ecaml_profile
module Echo_area = Echo_area
module Ediff = Ediff
module Elisp_gc = Elisp_gc
module Elisp_time = Elisp_time
module Emacs_backtrace = Emacs_backtrace
module Emacs_version = Emacs_version
module Eval = Eval
module Evil = Evil
module Expect_test_config = Async_ecaml.Expect_test_config
module Face = Face
module Feature = Feature
module File = File
module Filename = Filename
module Find_function = Find_function
module Form = Ecaml_value.Form
module Frame = Frame
module Funcall = Ecaml_value.Funcall
module Function = Ecaml_value.Function
module Grep = Grep
module Hash_table = Hash_table
module Help = Help
module Hook = Hook
module Input_event = Input_event
module Key_sequence = Key_sequence
module Keymap = Keymap
module Kill_ring = Kill_ring
module Line_and_column = Line_and_column
module Load = Load
module Load_history = Load_history
module Major_mode = Major_mode
module Marker = Marker
module Minibuffer = Minibuffer
module Minor_mode = Minor_mode
module Mode_line = Mode_line
module Modified_tick = Modified_tick
module Obarray = Obarray
module Obsolete = Obsolete
module Ocaml_or_elisp_value = Ocaml_or_elisp_value
module Org_table = Org_table
module Overlay = Overlay
module Plist = Plist
module Point = Point
module Position = Position
module Print = Print
module Process = Process
module Progress_reporter = Progress_reporter
module Regexp = Regexp
module Rx = Rx
module Selected_window = Selected_window
module Symbol = Symbol
module Symbol_prefix = Symbol_prefix
module Sync_or_async = Sync_or_async
module Syntax_table = Syntax_table
module System = System
module Tabulated_list = Tabulated_list
module Terminal = Terminal
module Text = Text
module Thing_at_point = Thing_at_point
module Timer = Timer
module User = User
module Value = Ecaml_value.Value
module Valueable = Ecaml_value.Valueable
module Var = Var
module Variable_watcher = Variable_watcher
module Vector = Vector
module Window = Window
module Working_directory = Working_directory
open! Core
open! Async_kernel
open! Import
module Q = Q
include Async_ecaml.Export
include Composition_infix

let concat = concat
let defalias = Defun.defalias
let defconst = Defconst.defconst
let defconst_i = Defconst.defconst_i
let defcustom = Customization.defcustom
let defcustom_enum = Customization.defcustom_enum
let defgroup = Customization.Group.defgroup
let define_derived_mode = Major_mode.define_derived_mode
let define_minor_mode = Minor_mode.define_minor_mode
let defun = Defun.defun
let defun_nullary = Defun.defun_nullary
let defun_nullary_nil = Defun.defun_nullary_nil
let defvar = Defvar.defvar
let defvaralias = Defvar.defvaralias
let inhibit_messages = Echo_area.inhibit_messages
let lambda = Defun.lambda
let lambda_nullary = Defun.lambda_nullary
let lambda_nullary_nil = Defun.lambda_nullary_nil
let message = Echo_area.message
let messagef = Echo_area.messagef
let message_s = Echo_area.message_s
let message_text = Echo_area.message_text
let print_s = print_s
let raise_string = raise_string
let sec_ns = sec_ns
let wrap_message = Echo_area.wrap_message

module Returns = Defun.Returns

let provide = (Feature.provide [@warning "-3"])
let inhibit_read_only = Current_buffer.inhibit_read_only

let () =
  if not am_running_test
  then
    let module Unix = Core_unix in
    let should_reopen_stdin = ref true in
    Background.Clock.every [%here] Time_float.Span.second (fun () ->
      match Unix.fstat Unix.stdin with
      | _ -> ()
      | exception _ ->
        if !should_reopen_stdin
        then (
          let new_fd = Unix.openfile "/dev/null" ~mode:[ O_RDONLY ] ~perm:0o666 in
          should_reopen_stdin := Unix.File_descr.equal new_fd Unix.stdin;
          message_s
            ~echo:false
            [%message.omit_nil
              "stdin was closed"
                (should_reopen_stdin : bool ref)
                ~recent_keys:
                  (Input_event.recent_commands_and_keys ()
                    : Input_event.Command_or_key.t array)]))
;;

let () =
  defun_nullary_nil
    ("ecaml-close-stdin" |> Symbol.intern)
    [%here]
    ~docstring:
      {|
Close file descriptor zero, aka stdin.  For testing a bug in `call-process-region'.
|}
    ~interactive:No_arg
    (fun () -> Core_unix.(close stdin))
;;

let () =
  let ecaml_test_raise_name = "ecaml-test-raise" in
  let ecaml_test_raise =
    Funcall.Wrap.(ecaml_test_raise_name <: nil_or int @-> return nil)
  in
  defun
    (ecaml_test_raise_name |> Symbol.intern)
    [%here]
    ~docstring:
      {|
For testing Ecaml.

Test raising from a deep call stack of a function defined by an Ecaml [defun].
|}
    ~interactive:No_arg
    (Returns Value.Type.unit)
    (let open Defun.Let_syntax in
     let%map_open n = optional "number" int in
     let n = Option.value n ~default:0 in
     if n <= 0
     then raise_s [%message "foo" "bar" "baz"]
     else ecaml_test_raise (Some (n - 1)));
  defun_nullary_nil
    ("ecaml-test-sentinel-raise" |> Symbol.intern)
    [%here]
    ~docstring:
      {|
For testing Ecaml.

Test [Process.set_sentinel] on a sentinel that raises.
|}
    ~interactive:No_arg
    (fun () ->
    Process.set_sentinel
      [%here]
      (Process.create "true" [] ~name:"true" ())
      (Returns Value.Type.unit)
      ~sentinel:(fun ~event:_ -> failwith "some error message"));
  (* Replace [false] with [true] to define a function for testing
     [Minibuffer.read_from]. *)
  if false
  then (
    defun_nullary
      ("ecaml-test-minibuffer-y-or-n-with-timeout" |> Symbol.intern)
      [%here]
      ~docstring:{|
For testing Ecaml.

Test [Minibuffer.y_or_n_with_timeout].
|}
      ~interactive:No_arg
      (Returns_deferred Value.Type.unit)
      (fun () ->
      let%bind int =
        Minibuffer.y_or_n_with_timeout ~prompt:"prompt" ~timeout:(Time_ns.Span.second, 13)
      in
      message_s [%message (int : int Minibuffer.Y_or_n_with_timeout.t)];
      return ());
    defun_nullary
      ("ecaml-test-minibuffer" |> Symbol.intern)
      [%here]
      ~docstring:{|
For testing Ecaml.

Test [Minibuffer.read_from].
|}
      ~interactive:No_arg
      (Returns_deferred Value.Type.unit)
      (fun () ->
      let test
        ?default_value
        ?(history = Minibuffer.history)
        ?history_pos
        ?initial_contents
        ()
        ~prompt
        =
        let%bind result =
          Minibuffer.read_from
            ~prompt:(concat [ prompt; ": " ])
            ?initial_contents
            ?default_value
            ~history
            ?history_pos
            ()
        in
        message (concat [ "result: "; result ]);
        return ()
      in
      let%bind () = test () ~prompt:"test 1" in
      let%bind () = test () ~prompt:"test 2" ~default_value:"some-default" in
      let%bind () = test () ~prompt:"test 3" ~initial_contents:"some-contents" in
      test
        ()
        ~prompt:"test 4"
        ~history:
          (Minibuffer.History.find_or_create
             ("some-history-list" |> Symbol.intern)
             [%here])))
;;

let () =
  defun_nullary_nil
    ("ecaml-show-recent-commands-and-keys" |> Symbol.intern)
    [%here]
    ~docstring:
      {|
For debugging.

Show the result of `recent-keys' rendered as Ecaml values.
|}
    ~interactive:No_arg
    (fun () ->
    message_s
      [%sexp
        (Input_event.recent_commands_and_keys () : Input_event.Command_or_key.t array)])
;;

(* Ppx_inline_test_lib runs inline tests immediately when the module defining
   the tests gets loaded.  Therefore, it must be initialized before we load any
   other modules.

   Normally this happens by Ppx_inline_test_lib looking for a magic keyword in
   Sys.argv and configuring itself from the command line arguments if that magic
   keyword is present.  That is unworkable for Ecaml and Emacs, since Emacs has
   its own command line arguments which we want to pass.  So instead we call
   Ppx_inline_test_lib.init directly with arguments taken from an elisp variable
   set by the test runner to the arguments we should pass. *)
let ppx_inline_test_args = Var.Wrap.("ecaml--ppx-inline-test-args" <: list string)

let () =
  match Current_buffer.value ppx_inline_test_args with
  | Some args ->
    (match Ppx_inline_test_lib.init args |> Result.ok_or_failwith with
     | Some help -> message help
     | None -> ())
  | None -> ()
;;

let () =
  defun_nullary_nil
    ("ecaml--ppx-inline-tests-exit" |> Symbol.intern)
    [%here]
    ~docstring:
      {|Exit Emacs through the inline tests runner, printing test results.

This is an internal function of no use to most people.

If we've initialized Ppx_inline_test_lib, then we should call this
after loading the test modules, to print the results and exit.|}
    Ppx_inline_test_lib.exit
;;

let debug_embedded_caml_values () = Caml_embed.debug_sexp ()

module Ref = struct
  include Ref

  let set_temporarily_async r a ~f =
    let old = !r in
    r := a;
    Monitor.protect f ~finally:(fun () ->
      r := old;
      return ())
  ;;
end
OCaml

Innovation. Community. Security.