Permalink
Browse files

v0.9.115.24+69

  • Loading branch information...
trefis committed Nov 2, 2017
1 parent 0ed8405 commit 25a9f825f18d722e73b0cfc0050de74dd9811a09
Showing with 7,765 additions and 1,312 deletions.
  1. +125 −0 src/advice.ml
  2. +104 −0 src/advice.mli
  3. +315 −115 src/ansi_color.ml
  4. +7 −3 src/ansi_color.mli
  5. +67 −0 src/auto_mode_alist.ml
  6. +19 −0 src/auto_mode_alist.mli
  7. +4 −0 src/backup.ml
  8. +7 −0 src/backup.mli
  9. +41 −10 src/buffer.ml
  10. +29 −5 src/buffer.mli
  11. +10 −0 src/buffer0.ml
  12. +26 −0 src/char_code.ml
  13. +26 −0 src/char_code.mli
  14. +18 −1 src/color.ml
  15. +8 −3 src/color.mli
  16. +11 −3 src/command.ml
  17. +2 −4 src/command.mli
  18. +13 −0 src/comment.ml
  19. +19 −0 src/comment.mli
  20. +6 −0 src/compilation.ml
  21. +6 −0 src/compilation.mli
  22. +150 −37 src/current_buffer.ml
  23. +141 −20 src/current_buffer.mli
  24. +66 −0 src/current_buffer0.ml
  25. +109 −0 src/customization.ml
  26. +56 −0 src/customization.mli
  27. +46 −0 src/directory.ml
  28. +34 −0 src/directory.mli
  29. +79 −41 src/ecaml.ml
  30. +5 −3 src/echo_area.ml
  31. +6 −2 src/face.ml
  32. +3 −4 src/face.mli
  33. +5 −5 src/feature.ml
  34. +4 −0 src/feature0.ml
  35. +36 −0 src/file.ml
  36. +24 −0 src/file.mli
  37. +10 −1 src/filename.ml
  38. +5 −1 src/filename.mli
  39. +57 −0 src/find_function.ml
  40. +10 −0 src/find_function.mli
  41. +51 −17 src/form.ml
  42. +23 −11 src/form.mli
  43. +1 −1 src/frame.ml
  44. +2 −4 src/frame.mli
  45. +14 −26 src/function.ml
  46. +1 −6 src/function.mli
  47. +11 −0 src/grep.ml
  48. +12 −0 src/grep.mli
  49. +1 −3 src/hash_table.mli
  50. +112 −0 src/hook.ml
  51. +78 −0 src/hook.mli
  52. +92 −0 src/input_event.ml
  53. +69 −0 src/input_event.mli
  54. +14 −0 src/input_event0.ml
  55. +13 −0 src/key_sequence.ml
  56. +47 −0 src/key_sequence.mli
  57. +37 −0 src/key_sequence0.ml
  58. +109 −0 src/keymap.ml
  59. +76 −0 src/keymap.mli
  60. +3 −4 src/load.ml
  61. +1 −1 src/load.mli
  62. +56 −14 src/load_history.ml
  63. +25 −12 src/load_history.mli
  64. +67 −0 src/major_mode.ml
  65. +45 −0 src/major_mode.mli
  66. +0 −8 src/marker.ml
  67. +1 −9 src/marker.mli
  68. +30 −0 src/minibuffer.ml
  69. +27 −0 src/minibuffer.mli
  70. +29 −0 src/minor_mode.ml
  71. +30 −0 src/minor_mode.mli
  72. +20 −0 src/obarray.ml
  73. +17 −0 src/obarray.mli
  74. +9 −2 src/point.ml
  75. +9 −0 src/point.mli
  76. +7 −1 src/position.ml
  77. +3 −3 src/position.mli
  78. +45 −8 src/process.ml
  79. +29 −3 src/process.mli
  80. +471 −294 src/q.ml
  81. +9 −2 src/regexp.ml
  82. +8 −5 src/regexp.mli
  83. +1 −0 src/selected_window.ml
  84. +3 −0 src/selected_window.mli
  85. +2 −36 src/symbol.ml
  86. +3 −17 src/symbol.mli
  87. +134 −0 src/syntax_table.ml
  88. +77 −0 src/syntax_table.mli
  89. +35 −0 src/system.ml
  90. +25 −0 src/system.mli
  91. +15 −3 src/text.ml
  92. +12 −6 src/text.mli
  93. +45 −0 src/timer.ml
  94. +50 −0 src/timer.mli
  95. +42 −0 src/user.ml
  96. +40 −0 src/user.mli
  97. +113 −13 src/value.ml
  98. +33 −2 src/value_intf.ml
  99. +42 −0 src/var.ml
  100. +42 −0 src/var.mli
  101. +17 −1 src/vector.ml
  102. +2 −2 src/vector.mli
  103. +18 −0 src/working_directory.ml
  104. +10 −0 src/working_directory.mli
  105. +57 −0 test/import.ml
  106. +106 −0 test/test_advice.ml
  107. 0 test/{test_ansi_color_two_codes.mli → test_advice.mli}
  108. +543 −128 test/test_ansi_color.ml
  109. +1 −9 test/test_ansi_color.mli
  110. +0 −13 test/test_ansi_color_two_codes.ml
  111. +0 −13 test/test_ansi_color_two_escapes.ml
  112. +553 −0 test/test_auto_mode_alist.ml
  113. 0 test/{test_ansi_color_two_escapes.mli → test_auto_mode_alist.mli}
  114. +107 −0 test/test_buffer.ml
  115. +51 −0 test/test_char_code.ml
  116. +1 −0 test/test_char_code.mli
  117. +52 −0 test/test_color.ml
  118. +2 −1 test/test_command.ml
  119. +18 −0 test/test_comment.ml
  120. +1 −0 test/test_comment.mli
  121. +464 −44 test/test_current_buffer.ml
  122. +60 −0 test/test_directory.ml
  123. +1 −0 test/test_directory.mli
  124. +2 −2 test/test_ecaml.ml
  125. +2 −2 test/test_face.ml
  126. +4 −8 test/test_feature.ml
  127. +58 −0 test/test_file.ml
  128. +1 −1 test/test_filename.ml
  129. +11 −0 test/test_find_function.ml
  130. +1 −0 test/test_find_function.mli
  131. +56 −3 test/test_form.ml
  132. +5 −5 test/test_frame.ml
  133. +37 −11 test/test_function.ml
  134. +162 −0 test/test_hook.ml
  135. +1 −0 test/test_hook.mli
  136. +87 −0 test/test_input_event.ml
  137. +1 −0 test/test_input_event.mli
  138. +12 −60 test/test_int.ml
  139. +108 −0 test/test_key_sequence.ml
  140. +1 −0 test/test_key_sequence.mli
  141. +185 −0 test/test_keymap.ml
  142. +1 −0 test/test_keymap.mli
  143. +2 −2 test/test_load.ml
  144. +21 −5 test/test_load_history.ml
  145. +94 −0 test/test_major_mode.ml
  146. +1 −0 test/test_major_mode.mli
  147. +0 −25 test/test_marker.ml
  148. +86 −0 test/test_minibuffer.ml
  149. +1 −0 test/test_minibuffer.mli
  150. +48 −0 test/test_minor_mode.ml
  151. +1 −0 test/test_minor_mode.mli
  152. +114 −0 test/test_obarray.ml
  153. +1 −0 test/test_obarray.mli
  154. +33 −18 test/test_point.ml
  155. +70 −23 test/test_process.ml
  156. +32 −0 test/test_regexp.ml
  157. +1 −4 test/test_selected_window.ml
  158. +0 −111 test/test_symbol.ml
  159. +80 −0 test/test_syntax_table.ml
  160. +4 −0 test/test_syntax_table.mli
  161. +28 −0 test/test_system.ml
  162. +1 −0 test/test_system.mli
  163. +44 −30 test/test_text.ml
  164. +54 −0 test/test_timer.ml
  165. +1 −0 test/test_timer.mli
  166. +55 −5 test/test_value.ml
  167. +60 −0 test/test_var.ml
  168. +1 −0 test/test_var.mli
  169. +1 −1 test/test_vector.ml
  170. +5 −16 test/test_window.ml
@@ -0,0 +1,125 @@
open! Core_kernel
open! Import
module Class = struct
type t =
| After
| Around
| Before
[@@deriving sexp_of]
let to_symbol = function
| After -> Q.after
| Around -> Q.around
| Before -> Q.before
;;
let to_value t = t |> to_symbol |> Symbol.to_value
end
module Position = struct
type t =
| First
| Last
| Zero_based of int
[@@deriving sexp_of]
let to_form = function
| First -> Q.first |> Form.symbol
| Last -> Q.last |> Form.symbol
| Zero_based i -> i |> Form.int
;;
end
module Name = struct
type t = Symbol.t [@@deriving sexp_of]
let of_symbol t = t
end
let disable ?(class_ = Class.Around) name function_ =
Symbol.funcall3_i Q.ad_disable_advice
(function_ |> Symbol.to_value)
(class_ |> Class.to_value)
(name |> Symbol.to_value)
;;
let enable ?(class_ = Class.Around) name function_ =
Symbol.funcall3_i Q.ad_enable_advice
(function_ |> Symbol.to_value)
(class_ |> Class.to_value)
(name |> Symbol.to_value)
;;
let activate_function symbol =
Symbol.funcall1_i Q.ad_activate (symbol |> Symbol.to_value);
;;
let deactivate_function symbol =
Symbol.funcall1_i Q.ad_deactivate (symbol |> Symbol.to_value);
;;
let unadvise_function symbol =
Symbol.funcall1_i Q.ad_unadvise (symbol |> Symbol.to_value);
;;
let activate_functions_with_advice_matching regexp =
Symbol.funcall1_i Q.ad_activate_regexp (regexp |> Regexp.to_value)
;;
let deactivate_functions_with_advice_matching regexp =
Symbol.funcall1_i Q.ad_deactivate_regexp (regexp |> Regexp.to_value)
;;
let activate_all () = Symbol.funcall0_i Q.ad_activate_all
let deactivate_all () = Symbol.funcall0_i Q.ad_deactivate_all
let unadvise_all () = Symbol.funcall0_i Q.ad_unadvise_all
let ad_return_value = Var.create Q.ad_return_value Value.Type.value
let defadvice
?(docstring = "")
?(position = Position.First)
here
~advice_name
~for_function
body
: unit =
let module F = Form in
let args = Symbol.create ~name:"args" in
let inner = Symbol.create ~name:"inner" in
let rest_arg = Symbol.create ~name:"rest" in
let q = F.symbol in
F.eval_i (
F.list
[ q Q.defadvice
; q for_function
; F.list [ q Q.around
; q advice_name
; position |> Position.to_form ]
; docstring |> F.string
; F.let_
[ args, F.list [ q Q.ad_get_args; 0 |> F.int ]
; inner, F.lambda [%here] ~args:[] ~rest_arg
~body:(F.progn
[ F.list [ q Q.ad_set_args
; 0 |> F.int
; q rest_arg ]
; q Q.ad_do_it ])]
(F.list (
[ q Q.funcall
; F.quote (
Function.create here ~args:[]
(function _ ->
let args =
Current_buffer.value_exn (Var.create args Value.Type.(list value))
in
let inner =
Current_buffer.value_exn (Var.create inner Value.Type.value) in
Current_buffer.set_value ad_return_value
(body
~args
~inner:(fun args -> Value.funcallN inner args));
Value.nil)
|> Function.to_value)]))])
;;
@@ -0,0 +1,104 @@
(** The "advice" feature lets you add to the existing definition of a function, by
"advising the function". Each function can have multiple "pieces of advice",
separately defined. Each defined piece of advice can be "enabled" or "disabled"
explicitly. All the enabled pieces of advice for any given function actually take
effect when you "activate" advice for that function, or when you define or redefine
the function. Note that enabling a piece of advice and activating advice for a
function are not the same thing.
[(Info-goto-node "(elisp)Advising Functions")] *)
open! Core_kernel
open! Import
(** A [Class.t] specifies the "class" of the advice--one of `before', `after',
or `around'. Before-advice runs before the function itself;
after-advice runs after the function itself; around-advice is wrapped
around the execution of the function itself.
[(Info-goto-node "(elisp)Defining Advice")] *)
module Class : sig
type t =
| After
| Around
| Before
[@@deriving sexp_of]
end
(** The position of one piece of advice in the list of all pieces of advice for a
function. *)
module Position : sig
type t =
| First
| Last
| Zero_based of int
[@@deriving sexp_of]
end
module Name : sig
type t [@@deriving sexp_of]
val of_symbol : Symbol.t -> t
end
(** [defadvice] currently only supports [Around] advice.
[(describe-function 'defadvice)]
[(Info-goto-node "(elisp)Defining Advice")]
[(Info-goto-node "(elisp)Around-Advice")] *)
val defadvice
: ?docstring : string
-> ?position : Position.t (** default is [First] *)
-> Source_code_position.t
-> advice_name : Name.t
-> for_function : Symbol.t
-> (args : Value.t list
-> inner : (Value.t list -> Value.t)
-> Value.t)
-> unit
(** [(describe-function 'ad-enable-advice)]
[(Info-goto-node "(elisp)Enabling Advice")] *)
val enable
: ?class_ : Class.t (** default is [Around] *)
-> Name.t
-> Symbol.t
-> unit
(** [(describe-function 'ad-disable-advice)]
[(Info-goto-node "(elisp)Enabling Advice")] *)
val disable
: ?class_ : Class.t (** default is [Around] *)
-> Name.t
-> Symbol.t
-> unit
(** [(describe-function 'ad-activate)]
[(Info-goto-node "(elisp)Activation of advice")] *)
val activate_function : Symbol.t -> unit
(** [(describe-function 'ad-activate-regexp)]
[(Info-goto-node "(elisp)Activation of advice")] *)
val activate_functions_with_advice_matching : Regexp.t -> unit
(** [(describe-function 'ad-activate-all)]
[(Info-goto-node "(elisp)Activation of advice")] *)
val activate_all : unit -> unit
(** [(describe-function 'ad-deactivate)]
[(Info-goto-node "(elisp)Activation of advice")] *)
val deactivate_function : Symbol.t -> unit
(** [(describe-function 'ad-deactivate-regexp)]
[(Info-goto-node "(elisp)Activation of advice")] *)
val deactivate_functions_with_advice_matching : Regexp.t -> unit
(** [(describe-function 'ad-deactivate-all)]
[(Info-goto-node "(elisp)Activation of advice")] *)
val deactivate_all : unit -> unit
(** [(describe-function 'ad-unadvise)]
[(Info-goto-node "(elisp)Defining advice")] *)
val unadvise_function : Symbol.t -> unit
(** [(describe-function 'ad-unadvise-all)]
[(Info-goto-node "(elisp)Defining advice")] *)
val unadvise_all : unit -> unit
Oops, something went wrong.

0 comments on commit 25a9f82

Please sign in to comment.