/* Part of XPCE --- The SWI-Prolog GUI toolkit Author: Jan Wielemaker and Anjo Anjewierden E-mail: wielemak@science.uva.nl WWW: http://www.swi.psy.uva.nl/projects/xpce/ Copyright (c) 1999-2020, University of Amsterdam CWI, Amsterdam All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ :- module(emacs_bookmarks, []). :- use_module(library(pce)). :- use_module(library(toolbar)). :- use_module(library(pce_toc)). :- use_module(library(pce_report)). :- use_module(library(persistent_frame)). :- require([ '$my_file'/1, call_cleanup/2, file_directory_name/2, term_to_atom/2, absolute_file_name/3, default/3, get_chain/3, send_list/3 ]). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - This module provides the first definition of an advanced bookmarking system for PceEmacs. Bookmarks are kept in the file /emacs_bookmarks as Prolog data. Bookmarks can be annotated and are time-stampted. The bookmark mechanism is available through the Browse menu of PceEmacs. Some issues to consider: * Save `collapsed' status of nodes? * Selective expansion * Search - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_global(@emacs_mark_list, new(emacs_bookmark_editor)). resource(save, image, image('16x16/save.xpm')). resource(cut, image, image('16x16/cut.xpm')). resource(open, image, image('16x16/book2.xpm')). :- pce_begin_class(emacs_bookmark_editor, persistent_frame, "PceEmacs bookmark administration and viewing"). variable(file, file, get, "File for holding the bookmarks"). variable(exit_message, code, get, "Registered exit message"). initialise(BM) :-> send_super(BM, initialise, 'PceEmacs bookmarks'), send(BM, done_message, message(BM, status, hidden)), send(BM, append, new(D, dialog)), send(BM, fill_dialog), send(new(emacs_bookmark_window), below, D), send(new(V, view(size := size(40,8))), below, D), send(V, font, normal), send(V, ver_stretch, 0), send(@pce, exit_message, new(Msg, message(BM, save))), send(BM, slot, exit_message, Msg), ignore(send(BM, load)). fill_dialog(BM) :-> get(BM, member, dialog, D), send(D, pen, 0), send(D, gap, size(0, 5)), send(D, append, new(TB, tool_bar(BM))), send_list(TB, append, [ tool_button(save, resource(save), 'Save bookmarks'), gap, tool_button(goto, resource(open), 'Open editor'), tool_button(cut, resource(cut), 'Delete selection') ]), send(D, append, graphical(0,0,10,1), right), % make a gap send(D, append, new(reporter), right), send(D, resize_message, message(D, layout, @arg2)). unlink(BM) :-> get(BM, exit_message, Msg), get(@pce, exit_messages, Chain), send(Chain, delete_all, Msg), send(BM, save), send_super(BM, unlink). tree(BM, Tree:toc_tree) :<- get(BM, member, emacs_bookmark_window, W), get(W, tree, Tree). view(BM, V:view) :<- "View for annotations":: get(BM, member, view, V). selection(BM, Sel:'name|emacs_bookmark') :<- get(BM, member, emacs_bookmark_window, W), get(W, selection, Sel0), get(Sel0, map, @arg1?identifier, Sel1), get(Sel1, head, Sel). :- pce_group(edit). goto(BM) :-> "Edit current selection":: get(BM, member, emacs_bookmark_window, W), ( get(BM, selection, Sel), send(Sel, instance_of, emacs_bookmark) -> send(W, open_node, Sel) ; send(BM, report, warning, 'No selection') ). cut(BM) :-> "Delete selected nodes":: get(BM, member, emacs_bookmark_window, W), ( get(W, selection, Nodes), \+ send(Nodes, empty) -> send(Nodes, for_all, message(@arg1, delete_tree)) ; send(BM, report, warning, 'No selection') ). :- pce_group(interface). bookmark(F, BM:emacs_bookmark, Sort:[bool]) :-> "Append a bookmark":: get(F, tree, Tree), send(Tree?root, append, BM, Sort). append_hit(F, Buffer:emacs_buffer, SOL:int) :-> "Add bookmark for indicated line":: get(Buffer, scan, SOL, line, 0, end, EOL), get(Buffer, contents, SOL, EOL-SOL, Title), send(Title, translate, '\t', ' '), get(Buffer, line_number, SOL, Line), ( get(Buffer, file, File), File \== @nil, get(File, absolute_path, FileName) -> true ; send(Buffer, report, warning, 'No associated file'), fail ), send(F, bookmark, new(BM, emacs_bookmark(FileName, Line, Title))), send(BM, link, Buffer), send(F, open). loaded_buffer(F, TB:emacs_buffer) :-> "PceEmacs has loaded a file":: get(F, tree, Tree), send(Tree?root, loaded_buffer, TB). saved_buffer(_F, TB:emacs_buffer) :-> "PceEmacs has saved this buffer":: send(TB, for_all_fragments, if(message(@arg1, send_hyper, bookmark, update))). current(F, BM:emacs_bookmark*, UpdateSelection:[bool]) :-> "Make this bookmark the current one":: ( UpdateSelection \== @off, get(F, member, emacs_bookmark_window, BW) -> send(BW, selection, BM) ; true ), get(F, view, View), ( get(View, modified, @on), get(View, hypered, bookmark, BM2) -> send(BM2, note, View?contents) ; true ), send(View, delete_hypers, bookmark), ( BM == @nil -> send(View, clear), send(View, editable, @off), send(View, background, grey80) ; new(_, hyper(View, BM, bookmark, editor)), ( get(BM, note, Note), Note \== @nil -> send(View, contents, Note), send(View, modified, @off) ; true ), send(View, editable, @on), send(View, background, white) ). :- pce_group(file). save(BM) :-> "Save bookmarks to file":: send(BM, current, @nil), get(BM, bookmarks_file, write, File), get(BM, tree, Tree), get(Tree, root, Root), ignore(pce_catch_error(_, send(file(File), backup))), ( catch(setup_call_cleanup( open(File, write, Fd), ( format(Fd, '/* PceEmacs Bookmarks */~n~n', []), send(Root, save, Fd) ), close(Fd)), _, fail) -> send(BM, report, status, 'Saved bookmarks to %s', File) ; send(BM, report, status, 'Failed to save bookmarks to %s', File) ). load(BM) :-> "Load bookmarks from file":: get(BM, bookmarks_file, File), catch(open(File, read, Fd), _, fail), call_cleanup(( read(Fd, Term0), load_bookmarks(Term0, Fd, BM) ), close(Fd)). load_bookmarks(end_of_file, _, _) :- !. load_bookmarks(Term, Fd, BM) :- !, load_bookmark(Term, BM), read(Fd, Term2), load_bookmarks(Term2, Fd, BM). load_bookmark(bookmark(File0, Line, Title, Stamp, Note), BM) :- !, ( absolute_file_name(File0, [ access(read), file_errors(fail) ], File) -> new(Created, date), FStamp is float(Stamp), % avoid overflow send(Created, posix_value, FStamp), send(BM, bookmark, new(M, emacs_bookmark(File, Line, Title, Created, Note)), @off), % do not sort ( get(@emacs, file_buffer, File, Buffer) -> send(M, link, Buffer) ; true ) ; true ). load_bookmark(Term, BM) :- term_to_atom(Term, Atom), send(BM, report, warning, 'Unknown term in bookmarks file: %s', Atom). bookmarks_file(BM, Access:[{read,write}], File:name) :<- ( get(BM, file, F), F \== @nil, send(F, access, Access) -> get(F, absolute_path, File) ; get(@pce, application_data, DataDir), ( Access == write -> get(DataDir, path, Path), '$my_file'(Path) % process owns path ; true ), get(DataDir, file, emacs_bookmarks, F), get(F, absolute_path, File), send(BM, slot, file, File) % use the absolute path ). :- pce_end_class(emacs_bookmark_editor). :- pce_begin_class(emacs_bookmark_window, toc_window). initialise(BW) :-> send_super(BW, initialise), send(BW, root, emacs_toc_bookmark_folder(/)). open_node(BW, Id:any) :-> "Open bookmark on double-click":: ( send(Id, instance_of, emacs_bookmark) -> ( send(Id, exists) -> ignore(send(Id, update)), send(@emacs, goto_source_location, Id, tab) ; ( get(Id, file_name, File), send(@display, confirm, 'Marked file "%s" does not exist.\nDelete bookmark?', File) -> get(BW, node, Id, Node), send(Node, delete_tree) ; true ) ) ). select_node(BW, Id:any) :-> "User selected a node":: ( send(Id, instance_of, emacs_bookmark) -> send(BW?frame, current, Id) ; true ). selection(BW, Sel:any*) :-> ( Sel == @nil -> send(BW?frame, current, @nil, @off) ; true ), send_super(BW, selection, Sel). :- pce_end_class. :- pce_begin_class(emacs_toc_bookmark_folder, toc_folder, "Represent directory in bookmarks"). initialise(F, Path:name) :-> ( Path == / -> ( has_drives -> RootName = 'My Computer' ; RootName = '/' ), send_super(F, initialise, RootName, @nil) ; get(file(Path), base_name, BaseName), send_super(F, initialise, BaseName, Path) ). collapsed(F, Val:bool*) :-> "Disable toc_window expansion mechanism":: send_class(F, node, collapsed(Val)). append(F, BM:emacs_bookmark, Sort:[bool]) :-> get(BM, file_name, FileName), get(F, identifier, Path), ( Path == @nil % this is the root -> true ; send(FileName, prefix, Path) ), get(F, sons, Sons), ( get(Sons, find, message(@arg1, append, BM), _) -> true ; sub_directory(Path, FileName, SubPath), SubPath \== FileName, send(F, collapsed, @off), send(F, son, new(S, emacs_toc_bookmark_folder(SubPath))), send(S, append, BM), ( Sort \== @off -> send(F, sort) ; true ) ; send_class(F, node, collapsed(@off)), send(F, son, new(emacs_toc_bookmark(BM))), ( Sort \== @off -> send(F, sort) ; true ) ). sort(F) :-> "Sort the nodes":: send(F, sort_sons, ?(@arg1, compare, @arg2)). compare(F, N:toc_node, Diff:{smaller,equal,larger}) :<- "Put folders before files, otherwise alphabetical":: ( send(N, instance_of, toc_folder) -> get(F, member, text, T0), get(N, member, text, T1), get(T0?string, compare, T1?string, Diff) ; Diff = smaller ). sub_directory(@nil, File, SubPath) :- !, ( has_drives -> new(Re, regex('[a-zA-Z]:')) ; new(Re, regex('/[^/]*')) ), send(Re, match, File), get(Re, register_value, File, 0, name, SubPath). sub_directory(Path, File, SubPath) :- send(File, prefix, Path), file_directory_name(File, FileDir), ( FileDir == Path -> SubPath = File ; sub_directory(Path, FileDir, SubPath) ). save(F, Fd:prolog) :-> "Save bookmarks to file":: get_chain(F, sons, Sons), save_sons(Sons, Fd). save_sons([], _). save_sons([H|T], Fd) :- send(H, save, Fd), save_sons(T, Fd). loaded_buffer(F, TB:emacs_buffer) :-> "PceEmacs has loaded this buffer":: ( get(TB, file, File), File \== @nil, get(File, absolute_path, Path), get(F, identifier, Id), ( Id == @nil -> true ; send(Path, prefix, Id) ) -> send(F?sons, for_all, message(@arg1, loaded_buffer, TB)) ; true ). :- pce_end_class(emacs_toc_bookmark_folder). :- pce_begin_class(emacs_toc_bookmark, toc_file, "Represent a bookmark"). initialise(F, BM:emacs_bookmark) :-> get(BM, title, Title), get(BM, file_name, Path), get(file(Path), base_name, File), get(BM, line_no, Line), send_super(F, initialise, string('%s:%d %s', File, Line, Title), BM), send(BM, slot, node, F). unlink(F) :-> get(F, identifier, BM), send(BM, slot, node, @nil), send_super(F, unlink). update(F) :-> "Update label after changed bookmark":: get(F, identifier, BM), get(BM, title, Title), get(BM, file_name, Path), get(file(Path), base_name, File), get(BM, line_no, Line), send(F, label, string('%s:%d %s', File, Line, Title)). append(_F, _BM:emacs_bookmark) :-> "Can't append to a file":: fail. save(F, Fd:prolog) :-> "Save bookmarks to file":: get(F, identifier, BM), get(BM, term, bookmark(File, Line, Title, Stamp, NoteText)), format(Fd, 'bookmark(~q, ~q, ~q, ~0f, ~q).~n', [File, Line, Title, Stamp, NoteText]). loaded_buffer(F, TB:emacs_buffer) :-> "PceEmacs has loaded this buffer":: get(F, identifier, BM), get(BM, file_name, FileName), ( get(TB, file, File), File \== @nil, get(File, absolute_path, Path), Path == FileName -> send(BM, link, TB) ; true ). compare(F, N2:toc_node, Diff:{smaller,equal,larger}) :<- ( send(N2, instance_of, emacs_toc_bookmark_folder) -> Diff = larger ; get(F, identifier, BM0), get(N2, identifier, BM1), ( get(BM0, file_name, F1), get(BM1, file_name, F2), get(file(F1), base_name, B1), get(file(F2), base_name, B2), get(B1, compare, B2, Diff), Diff \== equal -> true ; get(BM0, line_no, L0), get(BM1, line_no, L1), get(number(L0), compare, L1, Diff) ) ). :- pce_end_class(emacs_toc_bookmark). :- pce_begin_class(emacs_bookmark, source_location, "Bookmark in PceEmacs"). variable(title, string, get, "Represented title"). variable(created, date, get, "Date of creation"). variable(note, string*, both, "Annotation"). variable(node, emacs_toc_bookmark*, get, "Visualiser"). initialise(BM, File:name, Line:int, Title:string, Created:[date], Note:[string]*) :-> send_super(BM, initialise, File, Line), send(BM, slot, title, Title), ( Created == @default -> send(BM, slot, created, new(date)) ; send(BM, slot, created, Created) ), default(Note, @nil, TheNote), send(BM, slot, note, TheNote). term(BM, Term:prolog) :<- "Describe bookmark as a Prolog term":: ignore(send(BM, update)), get(BM, file_name, File), get(BM, line_no, Line), get(BM?title, value, Title), get(BM?created, posix_value, Stamp), ( get(BM, note, Note), Note \== @nil -> get(Note, value, NoteText) ; NoteText = '' ), Term = bookmark(File, Line, Title, Stamp, NoteText). exists(BM) :-> "Test whether associated file exists":: get(BM, file_name, File), send(file(File), exists). :- pce_group(buffer). link(BM, To:text_buffer) :-> "Link the bookmark using a fragment":: get(BM, line_no, Line), get(To, scan, 0, line, Line-1, start, SOL), get(To, scan, SOL, line, 0, end, EOL), new(_, emacs_bookmark_hyper(BM, fragment(To, SOL, EOL-SOL, bookmark))). % format('Linked ~p to ~p~n', [BM, To]). update(BM) :-> "If bookmark is linked, update <-line_no":: get(BM, hypered, fragment, Fragment), ( get(Fragment, text_buffer, TB), TB \== @nil -> get(Fragment, start, Start), get(TB, line_number, Start, Line), ( get(BM, line_no, Line) -> true ; send(BM, line_no, Line), Modified = true ), get(Fragment, string, Title), send(Title, translate, '\t', ' '), ( send(BM?title, equal, Title) -> true ; send(BM, slot, title, Title), Modified = true ), ( Modified == true -> send(BM, modified) ; true ) ; true % destroy? ). modified(BM) :-> "Bookmark parameters have been modified":: get(BM, node, Node), send(Node, update). :- pce_end_class(emacs_bookmark). :- pce_begin_class(emacs_bookmark_hyper, hyper, "Hyper from bookmark to fragment"). initialise(H, BM:emacs_bookmark, To:fragment) :-> send_super(H, initialise, BM, To, fragment, bookmark). unlink_from(H) :-> "Bookmark is deleted":: get(H, to, Fragment), free(Fragment), free(H). unlink_to(H) :-> "Fragment is deleted, update line":: get(H, from, BM), send(BM, update), free(H). :- pce_end_class. /******************************* * MISC * *******************************/ :- dynamic has_drives/1. % See whether there is only one logical root in the filesystem or % there are multiple. has_drives :- has_drives(True), !, True = true. has_drives :- ( get(directory(.), roots, Roots), get(Roots, size, 1) -> assert(has_drives(false)), fail ; assert(has_drives(true)) ).