1/* Part of XPCE --- The SWI-Prolog GUI toolkit 2 3 Author: Jan Wielemaker and Anjo Anjewierden 4 E-mail: J.Wielemaker@cs.vu.nl 5 WWW: http://www.swi-prolog.org/projects/xpce/ 6 Copyright (c) 1985-2011, University of Amsterdam 7 VU University Amsterdam 8 All rights reserved. 9 10 Redistribution and use in source and binary forms, with or without 11 modification, are permitted provided that the following conditions 12 are met: 13 14 1. Redistributions of source code must retain the above copyright 15 notice, this list of conditions and the following disclaimer. 16 17 2. Redistributions in binary form must reproduce the above copyright 18 notice, this list of conditions and the following disclaimer in 19 the documentation and/or other materials provided with the 20 distribution. 21 22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 POSSIBILITY OF SUCH DAMAGE. 34*/ 35 36:- module(emacs_buffer, []). 37:- use_module(library(pce)). 38:- require([ between/3 39 , default/3 40 , ignore/1 41 ]). 42 43:- pce_begin_class(emacs_buffer(file, name), text_buffer). 44 45variable(name, name, get, "Name of this buffer"). 46variable(directory, directory, both, "Associated CWD"). 47variable(file, file*, get, "Associated file"). 48variable(prompt_reload, bool := @on, both, "Prompt before reloading"). 49variable(mode, name, get, "Major mode of operation"). 50variable(time_stamp, date*, get, "Time-stamp for file"). 51variable(ensure_newline, bool := @on, both, "Add newline when done"). 52variable(ensure_no_whitespace_errors, 53 bool, both, "Remove trailing whitespace when done"). 54variable(tab_width, int := 8, both, "Width of a tab"). 55variable(auto_save_mode, bool, both, "Auto-save?"). 56variable(auto_save_count, number, get, "Auto-save at expiration"). 57variable(saved_caret, int, both, "Saved caret on last quit"). 58variable(saved_fill, bool := @off, both, "Saved fill_mode on quit"). 59variable(margin_width, '0..' := 0, get, "Margin width of editors"). 60variable(coloured_generation, 61 int := -1, 62 both, 63 "Last generation of the text-buffer that was coloured"). 64variable(xref_generation, 65 int := -1, 66 both, 67 "Last generation we analysed"). 68 69class_variable(undo_buffer_size, int, 40000). 70class_variable(ensure_no_whitespace_errors, bool, @on). 71class_variable(newline_existing_file, {posix,dos,detect}, detect). 72class_variable(newline_new_file, {posix,dos}, posix). 73:- if(current_prolog_flag(windows, true)). 74class_variable(newline_new_file, {posix,dos}, dos). 75class_variable(unicode_encoding, {utf8,unicode_le,unicode_be}, unicode_le). 76:- else. 77class_variable(newline_new_file, {posix,dos}, posix). 78class_variable(unicode_encoding, {utf8,unicode_le,unicode_be}, utf8). 79:- endif. 80 81initialise(B, File:file*, Name:[name]) :-> 82 "Create from file and name":: 83 send(B, send_super, initialise), 84 send(B, saved_caret, 0), 85 86 ( File == @nil 87 -> send(B, undo_buffer_size, 0), 88 send(B, auto_save_mode, @off), 89 default(Name, '*scratch*', BufBaseName), 90 ( BufBaseName == '*scratch*' 91 -> send(B, slot, mode, prolog), 92 scratch_text(Text), 93 send(B, insert, 0, Text), 94 send(B, saved_caret, B?size) 95 ; send(B, slot, mode, fundamental) 96 ), 97 send(B, directory, directory('.')) 98 ; send(File, absolute_path), 99 get(File, base_name, FileBaseName), 100 default(Name, FileBaseName, BufBaseName), 101 send(B, file, File), 102 send(B, auto_save_mode, @on), 103 send(@emacs_base_names, append, FileBaseName, B), 104 send(B, determine_initial_mode), 105 ( object(@emacs_mark_list) 106 -> ignore(send(@emacs_mark_list, loaded_buffer, B)) 107 ; true 108 ) 109 ), 110 111 send(B, init_mode_defaults), 112 send(B, slot, auto_save_count, number(300)), 113 send(B, name, BufBaseName). 114 115 116unlink(B) :-> 117 "Remove from buffer-list and base_name table":: 118 send(@emacs_buffers, delete, B?name), 119 ( get(B, file, File), File \== @nil 120 -> send(@emacs_base_names, delete, File?base_name, B) 121 ; true 122 ), 123 send(B, send_super, unlink). 124 125report(B, 126 Kind:kind={status,inform,progress,done,warning,error,fatal}, 127 Format:format=[char_array], 128 Argv:any ...) :-> 129 "Report to associated editors":: 130 get(B, editors, Editors), 131 Message =.. [message, @arg1, report, Kind, Format | Argv], 132 send(Editors, for_all, Message). 133 134 135scratch_text('% This buffer is for notes you don\'t want to save.\n\c 136 % If you want to create a file, visit that file with C-x C-f,\n\c 137 % then enter the text in that file\'s own buffer.\n\n'). 138 139:- pce_global(@emacs_interpreter_regex, 140 new(regex('#!(\\S+)\\s'))). 141:- pce_global(@emacs_mode_regex, % -*- Mode -*- 142 % -*- mode: Mode; ... -*- 143 new(regex('.*-\\*-\\s*([Mm]ode:\\s*(\\w+);.*-\\*-|(\\w+)\\s*-\\*-)'))). 144 145 146% ->determine_initial_mode uses the following steps: 147% 148% 1. If the file is a loaded file, it is a Prolog file 149% 2. The Emacs magic sequences -*- Mode -*- or -*- mode: Mode; ... -*- 150% 3. Try @emacs_content_mode_list 151% 4. Try #! interpreter (PrologScript) 152% 5. Try the file-name 153 154determine_initial_mode(B) :-> 155 "Determine initial mode":: 156 ( get(B, file, File), File \== @nil, 157 get(File, name, FileName), 158 absolute_file_name(FileName, FilePath), 159 source_file(FilePath), 160 \+ source_file_property(FilePath, derived_from(_,_)) 161 -> send(B, slot, mode, prolog) 162 ; send(@emacs_mode_regex, match, B), 163 member(Reg, [2,3]), 164 get(@emacs_mode_regex, register_value, B, Reg, Mode0), 165 get(Mode0?downcase, value, Mode), 166 get(@pce, convert, Mode, emacs_mode, _ModeObject) 167 -> send(B, slot, mode, Mode) 168 ; content_from_mode(B, Mode) 169 -> send(B, slot, mode, Mode) 170 ; ( send(@emacs_interpreter_regex, match, B), 171 get(@emacs_interpreter_regex, register_value, B, 1, Match), 172 To = @emacs_interpreter_mode_list 173 ; get(B, file, File), 174 get(File, base_name, Match), 175 To = @emacs_mode_list 176 ), 177 get(To?members, find, 178 message(@arg1?name, match, Match), Att) 179 -> send(B, slot, mode, Att?value) 180 ; send(B, slot, mode, @emacs_default_mode) 181 ), 182 send(B, set_temp_file). 183 184set_temp_file(B) :-> 185 "Clear ->prompt_reload if this is a temp file":: 186 get(B, file, File), 187 ( no_backup(File) 188 -> send(B, prompt_reload, @off) 189 ; true 190 ). 191 192 193%! content_from_mode(+Buffer, -Mode) is semidet. 194% 195% Search Buffer with the patterns from @emacs_content_mode_list 196 197content_from_mode(B, Mode) :- 198 get(@emacs_content_mode_list?members, find, 199 message(@arg1?name?first, search, B, 200 0, @arg1?name?second), 201 Att), 202 get(Att, value, Mode). 203 204 205attach(B, E:editor) :-> 206 "A new editor is attached. Prepare it":: 207 get(B, editors, Editors), 208 ( send(Editors, empty) 209 -> get(B, saved_caret, Caret), 210 get(B, saved_fill, Fill), 211 get(B, tab_width, TabWidth) 212 ; get(Editors?head, caret, Caret), 213 get(Editors?head, fill_mode, Fill), 214 get(Editors?head, tab_distance, TabWidth) 215 ), 216 get(B, margin_width, MW), 217 send(B, send_super, attach, E), 218 send(E, caret, Caret), 219 send(E, fill_mode, Fill), 220 send(E, margin_width, MW), 221 send(E, tab_distance, TabWidth). 222 223 224detach(B, E:editor) :-> 225 "An editor is detached":: 226 get(B, editors, Editors), 227 ( get(Editors, size, 1) 228 -> send(B, saved_caret, E?caret), 229 send(B, saved_fill, E?fill_mode) 230 ; true 231 ), 232 send(B, send_super, detach, E). 233 234 235name(B, Name:name) :-> 236 "Rename buffer to name":: 237 get(B, name, OldName), 238 ( Name == OldName 239 -> true 240 ; ( get(@emacs_buffers, member, Name, _) 241 -> between(2, 1000000, N), 242 get(Name, append, string('<%d>', N), BufName), 243 \+ get(@emacs_buffers, member, BufName, _), 244 ! 245 ; BufName = Name 246 ), 247 send(B, slot, name, BufName), 248 ( OldName \== @nil, 249 get(@emacs_buffers, member, OldName, DictItem) 250 -> send(DictItem, key, BufName) 251 ; send(@emacs_buffers, append, dict_item(BufName, @default, B)) 252 ), 253 send(B, update_label), 254 send(B?editors, for_some, message(@arg1?frame, label, BufName)) 255 ). 256 257 258lookup(_Ctx, File:file*, Name:[name], Buffer:emacs_buffer) :<- 259 "Lookup in name and file-table":: 260 ( Name \== @default, 261 get(@emacs_buffers, member, Name, DictItem), 262 get(DictItem, object, Buffer) 263 -> true 264 ; File \== @nil, 265 get(@emacs_base_names, member, File?base_name, Chain), 266 get(Chain, find, message(@arg1?file, same, File), Buffer) 267 ; File \== @nil, 268 send(File, exists), 269 send(File, check_object), 270 get(File, object, Buffer), 271 send(Buffer, instance_of, emacs_buffer), 272 get(Buffer, name, BufName), 273 send(Buffer, slot, name, ''), 274 send(Buffer, name, BufName), 275 send(Buffer, slot, file, File), 276 send(@emacs_base_names, append, File?base_name, Buffer), 277 send(Buffer, reset_undo), 278 send(Buffer, modified, @off), 279 send(Buffer, slot, time_stamp, File?time), 280 send(Buffer, loaded) 281 ). 282 283 284 /******************************* 285 * LOAD/SAVE * 286 *******************************/ 287 288file(B, File:file) :-> 289 "Switch to indicated file":: 290 send(B, clear), 291 ( send(directory(File?name), exists) 292 -> send(File, error, open_file, read, 'is a directory') 293 ; send(File, exists) 294 -> get(B, newline_existing_file, OpenMode), 295 send(File, newline_mode, OpenMode), 296 ignore(send(B, insert_file, 0, File)), 297 send(B, reset_undo), 298 send(B, modified, @off), 299 send(B, slot, time_stamp, File?time) 300 ; send(B, reset_undo), 301 send(B, modified, @off), 302 get(B, newline_new_file, Mode), 303 send(File, newline_mode, Mode) 304 ), 305 send(B, slot, file, File), 306 new(F2, file(File?absolute_path)), 307 send(B, directory, F2?directory_name). 308 309 310save(B, File:[file]) :-> 311 "->do_save and update time_stamp":: 312 ( File == @default 313 -> get(B, file, SaveFile), 314 ( SaveFile == @nil 315 -> send(B, report, error, 'No file associated to this buffer'), 316 fail 317 ; true 318 ) 319 ; SaveFile = File, 320 ( get(B, file, OldFile), OldFile \== @nil 321 -> send(@emacs_base_names, delete, OldFile?base_name, B) 322 ; true 323 ), 324 send(File, absolute_path), 325 get(File, base_name, BaseName), 326 send(B, slot, file, File), 327 send(B, directory, File?directory_name), 328 send(B, name, BaseName), 329 send(@emacs_base_names, append, File?base_name, B) 330 ), 331 ( get(B, ensure_newline, @on) 332 -> send(B, complete_last_line) 333 ; true 334 ), 335 ( get(B, ensure_no_whitespace_errors, @on) 336 -> send(B, fix_whitespace_errors) 337 ; true 338 ), 339 ( no_backup(SaveFile) 340 -> true 341 ; ignore(send(SaveFile, backup)) 342 ), 343 send(B, do_save, SaveFile), 344 send(B, slot, time_stamp, SaveFile?time), 345 ( object(@emacs_mark_list) 346 -> ignore(send(@emacs_mark_list, saved_buffer, B)) 347 ; true 348 ). 349 350no_backup(File) :- 351 get(@emacs_no_backup_list, find, 352 message(@arg1, match, File?name), _). 353 354 355complete_last_line(B) :-> 356 "Add \\n if needed":: 357 get(B, size, Size), 358 ( ( Size == 0 359 ; get(B, character, Size-1, 10) 360 ) 361 -> true 362 ; send(B, append, string('\n')) 363 ). 364 365fix_whitespace_errors(B) :-> 366 "Remove trailing spaces and tabs from lines":: 367 new(Count, number(0)), 368 send(B, fix_trailing_space_errors, Count), 369 send(B, fix_space_tab_errors, Count), 370 ( get(Count, value, 0) 371 -> true 372 ; send(B, report, status, 373 'Fixed %d whitespace errors', Count) 374 ). 375 376fix_trailing_space_errors(B, Count:number) :-> 377 "Remove trailing spaces and tabs from lines":: 378 new(Re, regex('[ \t]+\n')), 379 send(Re, for_all, B, 380 and(message(@arg1, replace, @arg2, '\n'), 381 message(Count, plus, 1))). 382 383fix_space_tab_errors(B, Count:number) :-> 384 "Replace space+tab sequences":: 385 new(Re, regex(' +\t')), 386 send(Re, for_all, B, 387 and(message(B, fix_space_tab, Re), 388 message(Count, plus, 1))). 389 390fix_space_tab(B, Re:regex) :-> 391 "Fix matched spaces followed by tab":: 392 ( get(B?editors, head, E) 393 -> get(Re, register_start, 0, Start), 394 get(Re, register_end, 0, End), 395 get(E, column, Start, StartCol), 396 get(E, column, End, EndCol), 397 get(E, tab_distance, TD), 398 tabs(StartCol, EndCol, TD, Tabs), 399 tab_atom(Tabs, Atom), 400 send(Re, replace, B, Atom) 401 ; true 402 ). 403 404tabs(SC, EC, _, 0) :- 405 SC >= EC, 406 !. 407tabs(SC, EC, TD, N) :- 408 SC2 is ((SC+TD)//TD)*TD, 409 tabs(SC2, EC, TD, N0), 410 N is N0+1. 411 412tab_atom(N, Atom) :- 413 length(List, N), 414 maplist(=(0'\t), List), 415 atom_codes(Atom, List). 416 417 418do_save(B, SaveFile:file, Start:[int], Length:[int]) :-> 419 "Do the actual saving":: 420 get(B, unicode_encoding, FallBackEncoding), 421 ( pce_catch_error(io_error, 422 send_super(B, save, SaveFile, Start, Length)) 423 -> true 424 ; get(SaveFile, name, FileName), 425 \+ access_file(FileName, write) 426 -> send(B, report, error, 'Cannot write %s (permission denied)', FileName), 427 fail 428 ; get(SaveFile, encoding, Encoding), 429 Encoding \== FallBackEncoding 430 -> send(SaveFile, encoding, FallBackEncoding), 431 send(SaveFile, bom, @on), 432 send_super(B, save, SaveFile, Start, Length), 433 once(user_encoding(FallBackEncoding, UserEnc)), 434 send(B, report, warning, 435 'Could not save using default locale; saved using %s', UserEnc) 436 ; send_super(B, save, SaveFile, Start, Length) 437 ). 438 439user_encoding(utf8, 'UTF-8'). 440user_encoding(unicode_le, 'UTF-16 (little endian)'). 441user_encoding(unicode_be, 'UTF-16 (big endian)'). 442user_encoding(Enc, Enc). 443 444 445write_region(B, File:file, Start:int, Length:int) :-> 446 "Wrote region to file (start, length)":: 447 send(B, do_save, File, Start, Length). 448 449 450save_if_modified(B, Confirm:[bool]) :-> 451 "Save if associated with a file and modified":: 452 ( get(B, modified, @on), 453 get(B, file, File), File \== @nil 454 -> ( ( Confirm == @off 455 ; send(@display, confirm, 456 '%s is modified. Save?', File?name) 457 ) 458 -> send(B, save) 459 ; fail 460 ) 461 ; true 462 ). 463 464 465 /******************************* 466 * AUTO-SAVE * 467 *******************************/ 468 469check_auto_save(B) :-> 470 "Check whether to auto_save":: 471 ( get(B, modified, @on), 472 get(B, auto_save_count, C), 473 send(C, minus, 1), 474 send(C, equal, 0), 475 get(B, auto_save_mode, @on) 476 -> send(B, auto_save) 477 ; true 478 ). 479 480 481auto_save_file(B, F:file) :<- 482 get(B, file, File), File \== @nil, 483 get(File, backup_file_name, '#', Name), 484 new(F, file(Name)). 485 486 487auto_save(B) :-> 488 "Auto-save the buffer (when file)":: 489 ( get(B, auto_save_file, File) 490 -> send(B, report, status, 'Auto saving ...'), 491 send(@display, flush), 492 ignore(send(B, send_super, save, File, 0, B?size)), 493 send(B?auto_save_count, value, 300), 494 send(B, report, status, 'Auto saving ... done') 495 ; true 496 ). 497 498 499delete_auto_save_file(B) :-> 500 "Delete the autosave-file if present":: 501 ( get(B, auto_save_file, File) 502 -> ignore(send(File, remove)) 503 ; true 504 ). 505 506 507 /******************************* 508 * KILL * 509 *******************************/ 510 511kill(B) :-> 512 "->save_if_modified and ->free":: 513 ( get(B, modified, @off) 514 -> send(B, free) 515 ; get(B, file, File), File \== @nil, \+ get(B, size, 0) 516 -> new(D, dialog('Kill modified buffer?')), 517 send(D, append, new(L, label(reporter))), 518 send(L, format, 'Buffer %s is modified', B?name), 519 send(D, append, 520 button('save & kill', message(D, return, save_and_kill))), 521 send(D, append, 522 button(kill, message(D, return, kill))), 523 send(D, append, 524 button(cancel, message(D, return, cancel))), 525 get(D, confirm_centered, Rval), 526 send(D, destroy), 527 ( Rval == save_and_kill 528 -> send(B, save), 529 send(B, free) 530 ; Rval == kill 531 -> send(B, free) 532 ; fail 533 ) 534 ; send(B, free) 535 ). 536 537 538revert(B) :-> 539 "Reload associated file":: 540 get(B, file, File), 541 ( File == @nil 542 -> send(B, report, warning, 'No file'), 543 fail 544 ; new(Carets, chain), 545 get(B, editors, Editors), 546 send(Editors, for_all, message(Carets, append, @arg1?caret)), 547 new(@emacs_reverting, object), % avoid trap 548 send(B, file, File), 549 send(Editors, for_all, 550 and(message(@arg1, caret, Carets?head), 551 message(Carets, delete_head))), 552 ( get(Editors, head, First) 553 -> send(First?mode, auto_colourise_buffer) 554 ; true 555 ), 556 free(@emacs_reverting), 557 send(B, report, status, 'Reloaded %s', File?absolute_path) 558 ). 559 560 561 /******************************* 562 * NAME/LABEL * 563 *******************************/ 564 565update_label(B) :-> 566 "Update label in the buffer-menu":: 567 get(B, name, Name), 568 ( Name \== @nil 569 -> get(@emacs_buffers, member, Name, DictItem), 570 ( get(B, modified, @on) 571 -> send(DictItem, label, string('%s\t**', Name)), 572 new(EditorLabel, string('%s [modified]', Name)) 573 ; send(DictItem, label, Name), 574 EditorLabel = Name 575 ), 576 send(B?editors, for_all, 577 message(@arg1, label, EditorLabel)) 578 ; true 579 ). 580 581 582 /******************************* 583 * MARGINS * 584 *******************************/ 585 586margin_width(B, W:'0..') :-> 587 "Set width of the margin for associated editors":: 588 send(B, slot, margin_width, W), 589 send(B?editors, for_all, 590 message(@arg1, margin_width, W)). 591 592 593 /******************************* 594 * MODIFIED * 595 *******************************/ 596 597modified(B, Val:bool) :-> 598 "Check the file; mark buffer-menu":: 599 send_super(B, modified, Val), 600 ( Val == @on 601 -> send(B, check_modified_file) 602 ; send(B, delete_auto_save_file) 603 ), 604 send(B, update_label). 605 606 607check_modified_file(B, Frame:frame=[frame], Confirm:confirm=[bool]) :-> 608 "Check if file has been modified after buffer":: 609 ( get(B, file, File), 610 File \== @nil, 611 send(File, exists), 612 get(B, time_stamp, Stamp), 613 get(File, time, FileStamp), 614 \+ send(Stamp, equal, FileStamp), 615 \+ object(@emacs_reverting) 616 -> ( confirm_reload(B, Frame, Confirm, File) 617 -> send(B, revert) 618 ; true 619 ) 620 ; true 621 ). 622 623confirm_reload(_, _, @off, _) :- !. 624confirm_reload(B, _, @default, _) :- 625 get(B, prompt_reload, @off), 626 !, 627 send(B, saved_caret, 0), 628 send(B?editors, for_all, message(@arg1, caret, 0)). 629confirm_reload(_, Frame, _, File) :- 630 new(D, dialog('Modified file')), 631 send(D, append, 632 label(title, string('File %N was modified', File))), 633 send(D, append, 634 button(reload_file, message(D, return, reload_file))), 635 send(D, append, 636 button(edit_buffer, message(D, return, edit_buffer))), 637 ( Frame \== @default 638 -> EmacsFrame = Frame 639 ; get(@emacs, current_frame, EmacsFrame) 640 -> true 641 ; EmacsFrame = @nil 642 ), 643 ( EmacsFrame \== @default 644 -> get(EmacsFrame?area, center, Position), 645 send(D, transient_for, EmacsFrame) 646 ; Position = @default 647 ), 648 get(D, confirm_centered, Position, RVal), 649 send(D, destroy), 650 RVal == reload_file. 651 652 653 /******************************* 654 * OPEN WINDOW * 655 *******************************/ 656 657open(B, How:[{here,tab,window}], Frame:emacs_frame) :<- 658 "Create window for buffer":: 659 ( How == window 660 -> send(new(Frame, emacs_frame(B)), open) 661 ; How == tab, 662 get(@emacs, current_frame, Frame) 663 -> send(Frame, tab, B, @on), 664 send(Frame, expose) 665 ; get(@emacs, current_frame, Frame) 666 -> send(Frame, buffer, B), 667 send(Frame, expose) 668 ; send(new(Frame, emacs_frame(B)), open) 669 ), 670 send(B, check_modified_file, Frame). 671 672open(B, How:[{here,tab,window}]) :-> 673 "Create window for buffer":: 674 get(B, open, How, _). 675 676 677 /******************************* 678 * MODE * 679 *******************************/ 680 681mode(B, Mode:name) :-> 682 "Switch to named mode":: 683 ( get(B, mode, Mode) 684 -> true 685 ; send(B, slot, mode, Mode), 686 send(B, init_mode_defaults), 687 send(B?editors, for_some, message(@arg1, mode, Mode)) 688 ). 689 690init_mode_defaults(B) :-> 691 "Initialise defaults from the current mode":: 692 get(B, mode, ModeName), 693 atomic_list_concat([emacs_, ModeName, '_mode'], ClassName), 694 get(@pce, convert, ClassName, class, ModeClass), 695 ( copy_class_var(Name), 696 get(ModeClass, class_variable, Name, CV), 697 get(CV, value, Value), 698 send(B, Name, Value), 699 fail 700 ; true 701 ). 702 703copy_class_var(indent_tabs). 704copy_class_var(tab_width). 705 706 707 /******************************* 708 * LANGUAGE SUPPORT * 709 *******************************/ 710 711% emacs_buffer<-name_and_arity returns the name and arity if the 712% caret is in the functor of the term. If the arity cannot be 713% determined, arity is returned as @default. 714 715name_and_arity(TB, Pos:int, Tuple:tuple) :<- 716 "Find name and arity of term at position":: 717 ( get(TB, character, Pos, C0) 718 ; get(TB, character, Pos-1, C0) 719 ), 720 send(TB?syntax, has_syntax, C0, word), 721 !, 722 get(TB, scan, Pos, word, 0, start, P1), 723 get(TB, scan, P1, word, 0, end, P2), 724 get(TB, contents, P1, P2-P1, NameString), 725 ( get(TB, character, P2, 0'() 726 -> P4 is P2 + 1, 727 ( count_args(TB, P4, 0, 0, Arity) 728 -> true 729 ; Arity = @default 730 ) 731 ; Arity = 0 732 ), 733 new(Tuple, tuple(NameString?value, Arity)). 734 735 736count_args(TB, Here, _, _, _) :- 737 get(TB, size, Here), 738 !, 739 fail. 740count_args(_TB, _Here, 20, _, _) :- 741 !, 742 fail. 743count_args(TB, Here, NAT, A0, A) :- 744 get(TB, scan, Here, term, 1, EndTerm), 745 get(TB, skip_comment, EndTerm, Next), 746 ( get(TB, character, Next, 0')) 747 -> A is A0 + 1 748 ; get(TB, character, Next, 0',) 749 -> A1 is A0 + 1, 750 count_args(TB, EndTerm, 0, A1, A) 751 ; NNAT is NAT + 1, 752 count_args(TB, EndTerm, NNAT, A0, A) 753 ). 754 755:- pce_end_class. 756 757 758