1/*  Part of XPCE --- The SWI-Prolog GUI toolkit
    2
    3    Author:        Jan Wielemaker and Anjo Anjewierden
    4    E-mail:        jan@swi.psy.uva.nl
    5    WWW:           http://www.swi.psy.uva.nl/projects/xpce/
    6    Copyright (c)  1985-2002, University of Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(emacs_extend,
   36          [ declare_emacs_mode/2,
   37            declare_emacs_mode/3
   38          ]).   39:- use_module(library(pce)).   40:- require([ atomic_list_concat/2,
   41             send_list/3
   42           ]).   43
   44                /********************************
   45                *         DECLARE MODES         *
   46                ********************************/
   47
   48:- dynamic                              % ensure it is restored over a state
   49    emacs_mode_name/1.   50
   51fix_mode_name_type :-
   52    get(@pce, convert, mode_name, type, Type),
   53    send(Type, name_reference, mode_name_type),
   54    send(Type, kind, name_of),
   55    send(Type, slot, context, new(Ctx, chain)),
   56    send_list(Ctx, append,
   57              [ fundamental
   58              , prolog
   59              , shell
   60              ]),
   61    forall(emacs_mode_name(Mode), send(Ctx, append, Mode)),
   62    send(Ctx, sort, unique := @on).
   63
   64:- initialization fix_mode_name_type.   65
   66%!  declare_emacs_mode(+ModeName, +FileSpec).
   67%
   68%   Specifies that PceEmacs mode `ModeName' may be defined by
   69%   (auto)loading `FileSpec'.
   70
   71declare_emacs_mode(Mode, File) :-
   72    get(string('emacs_%s_mode', Mode), value, EmacsModeClass),
   73    (   File == []
   74    ->  true
   75    ;   pce_autoload(EmacsModeClass, File)
   76    ),
   77    (   \+ special_mode(Mode)
   78    ->  get(@mode_name_type, context, Ctx),
   79        send(Ctx, add, Mode),
   80        send(Ctx, sort, unique := @on),
   81        assert(emacs_mode_name(Mode))
   82    ;   true
   83    ).
   84
   85special_mode(shell).
   86special_mode(gdb).
   87special_mode(annotate).
   88
   89
   90%!  declare_emacs_mode(+ModeName, +FileSpec, +ListOfPatterns)
   91%
   92%   Sames as declare_emacs_mode/2.  `ListOfPatterns' is a list of
   93%   regular expressions that will automatically start this mode.
   94
   95declare_emacs_mode(Mode, File, Extensions) :-
   96    declare_emacs_mode(Mode, File),
   97    declare_file_patterns(Extensions, Mode, @emacs_mode_list).
   98
   99declare_file_patterns([], _, _).
  100declare_file_patterns([Ext|Rest], Mode, Sheet) :-
  101    send(Sheet, value, regex(Ext), Mode),
  102    declare_file_patterns(Rest, Mode, Sheet).
  103
  104%       :- emacs_begin_mode(+Mode, +Super, +Summary, +Bindings, +Syntax).
  105%
  106%       Binding:
  107%
  108%               Selector = [key(Key)]
  109%                          [+ button(Button)]
  110%                          [+ button(Button, Function)]         (pullright)
  111%
  112%       Syntax:
  113%
  114%               Char [=+] Category(Args)
  115
  116emacs_expansion((:- emacs_begin_mode(Mode, Super, Summary, Bindings, Syntax)),
  117                [(:- pce_begin_class(PceMode, PceSuper, Summary)),
  118                 (:- pce_class_directive(emacs_extend:emacs_mode_bindings(Mode,
  119                                                             Module,
  120                                                             Bindings,
  121                                                             Syntax)))
  122                ]) :-
  123    emacs_mode_class(Mode, PceMode),
  124    emacs_mode_class(Super, PceSuper),
  125    prolog_load_context(module, Module).
  126emacs_expansion((:- emacs_extend_mode(Mode, Bindings)),
  127                [(:- pce_extend_class(PceMode)),
  128                 (:- pce_class_directive(emacs_extend:emacs_mode_bindings(Mode,
  129                                                             Module,
  130                                                             Bindings,
  131                                                             [])))
  132                ]) :-
  133    emacs_mode_class(Mode, PceMode),
  134    prolog_load_context(module, Module).
  135emacs_expansion((:- emacs_end_mode), (:- pce_end_class)).
  136
  137%!  emacs_mode_bindings(+Mode, +Module, +Bindings, +Syntax)
  138
  139:- public emacs_mode_bindings/4. % called from code expanded by emacs_expansion/2.
  140
  141emacs_mode_bindings(Mode, Module, Bindings, Syntax) :-
  142    emacs_mode_class(Mode, PceClass),
  143    get(@pce, convert, PceClass, class, ClassObject),
  144    get(ClassObject, super_class, SuperClass),
  145    get(SuperClass, name, SuperName),
  146    emacs_mode_class(SuperMode, SuperName),
  147    new(KB, emacs_key_binding(Mode, SuperMode)),
  148    new(MM, emacs_mode_menu(Mode, SuperMode)),
  149    (   get(@syntax_tables, member, Mode, ST)
  150    ->  true
  151    ;   new(ST, syntax_table(Mode, SuperMode))
  152    ),
  153    make_bindings(Bindings, Module, KB, MM),
  154    send(KB, apply_preferences),
  155    make_syntax(Syntax, ST).
  156
  157make_bindings([], _, _, _).
  158make_bindings([Selector = Term|Rest], Module, KB, MM) :-
  159    bind(Term, Selector, Module, KB, MM),
  160    make_bindings(Rest, Module, KB, MM).
  161
  162make_syntax([], _).
  163make_syntax([S|Rest], ST) :-
  164    syntax(S, ST),
  165    make_syntax(Rest, ST).
  166
  167bind(key(Key), Selector, _, KB, _) :-
  168    send(KB, function, Key, Selector).
  169bind(-button(Button), Selector, _, _, MM) :-
  170    send(MM, delete, Button, Selector).
  171bind(button(Button), Selector, _, _, MM) :-
  172    send(MM, append, Button, Selector).
  173bind(button(Button, Func), Selector, Module, _, MM) :-
  174    send(MM, Module:append(Button, emacs_argument_item(Selector, Func))).
  175bind(A+B, Selector, Module, KB, MM) :-
  176    bind(A, Selector, Module, KB, MM),
  177    bind(B, Selector, Module, KB, MM).
  178
  179syntax(Char = Term, ST) :-
  180    Term =.. TermArgs,
  181    Msg =.. [syntax, Char | TermArgs],
  182    send(ST, Msg).
  183syntax(Char + Term, ST) :-
  184    Term =.. TermArgs,
  185    Msg =.. [add_syntax, Char | TermArgs],
  186    send(ST, Msg).
  187syntax(paragraph_end(End), ST) :-
  188    (   is_list(End)
  189    ->  atomic_list_concat(End, '|', Regex)
  190    ;   Regex = End
  191    ),
  192    send(ST, paragraph_end, Regex).
  193syntax(sentence_end(End), ST) :-
  194    (   is_list(End)
  195    ->  atomic_list_concat(End, '|', Regex)
  196    ;   Regex = End
  197    ),
  198    send(ST, sentence_end, Regex).
  199syntax(quasi_quotation(Start, End), ST) :-
  200    send(ST, quasi_quotation_start, Start),
  201    send(ST, quasi_quotation_end, End).
  202syntax(prolog, ST) :-
  203    send(ST, prolog, @on).
  204
  205
  206                 /*******************************
  207                 *             UTIL             *
  208                 *******************************/
  209
  210%!  emacs_mode_class(?ModeName, ?ClassName)
  211%
  212%   Convert between plain PceEmacs modename and the mode class.
  213
  214emacs_mode_class(@default, emacs_mode) :- !.
  215emacs_mode_class([], emacs_mode) :- !.
  216emacs_mode_class(ModeName, ClassName) :-
  217    atom(ModeName),
  218    !,
  219    atomic_list_concat([emacs_, ModeName, '_mode'], ClassName).
  220emacs_mode_class(ModeName, ClassName) :-
  221    atom_concat(emacs_, M0, ClassName),
  222    atom_concat(ModeName, '_mode', M0),
  223    !.
  224emacs_mode_class(@default, emacs_mode).
  225
  226
  227                 /*******************************
  228                 *         REGISTRATION         *
  229                 *******************************/
  230
  231:- multifile
  232    user:pce_pre_expansion_hook/2.  233:- dynamic
  234    user:pce_pre_expansion_hook/2.  235
  236user:pce_pre_expansion_hook(In, Out) :-
  237    emacs_expansion(In, Out)