1/*   bibtex_cmd
    2     Author: poo.
    3
    4     Copyright (C) 2018 poo
    5
    6     This program is free software: you can redistribute it and/or modify
    7     it under the terms of the GNU General Public License as published by
    8     the Free Software Foundation, either version 3 of the License, or
    9     at your option) any later version.
   10
   11     This program is distributed in the hope that it will be useful,
   12     but WITHOUT ANY WARRANTY; without even the implied warranty of
   13     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   14     GNU General Public License for more details.
   15
   16     You should have received a copy of the GNU General Public License
   17     along with this program.  If not, see <http://www.gnu.org/licenses/>.
   18
   19     05 jun 2018
   20*/
   21
   22
   23:- module(bibtex_cmd, [
   24	      bibtex_use/1,
   25	      bibtex_search_author/1,
   26	      bibtex_search_nth/1,
   27	      bibtex_list/0
   28	  ]).

bibtex_cmd: Commands for reading and writing BibTeX.

*/

   34:- use_module(library(bibtex)).   35:- use_module(library(bibtex_create)).   36:- use_module(library(ansi_term)).   37
   38:- dynamic bibtex_default/1.
 bibtex_use(+Path:term) is det
Declares that we're using the given BibTeX file.

This predicate can be called more than once.

Arguments:
Path- A term with the path of the file. */
   49bibtex_use(Path) :-
   50    asserta(bibtex_default(Path)).
 print_field(+Field:pred) is det
Prints a BibTeX field.

Note: Displays differently some common fields.

Arguments:
Field- A field/2 predicate. */
   61print_field(field(author, Value)) :- !,
   62    ansi_format([bold], '  author: ~w', [Value]), nl.
   63print_field(field(title, Value)) :- !,
   64    ansi_format([bold], '  title: ~w', [Value]), nl.
   65print_field(field(Name, Value)) :-
   66    format('  ~w: ~w', [Name, Value]), nl.
 print_entry(+Entry:pred) is det
Prints a BibTeX entry into current output.
Arguments:
Entry- An entry/3 predicate. */
   75print_entry(entry(Type, Key, Fields)) :-
   76    ansi_format([fg(green)], '~w:~w', [Type, Key]), nl,
   77    maplist(print_field, Fields).
 bibtex_search_author(+Name:string) is nondet
Displays all the BibTeX entries which authors has Name as substring.

If more than one BibTeX file is declared using bibtex_use/1, then this command is non-deterministic. Otherwise, it is det.

Arguments:
Name- A string with a word. */
   88bibtex_search_author(Name) :-
   89    bibtex_default(Path),
   90    bibtex_author(Path, Name, Lst),
   91    maplist(print_entry, Lst).
   92
   93bibtex_search_nth(Nth) :-
   94    bibtex_default(Path),
   95    nth_bibtex_file(Path, Nth, Lst),
   96    maplist(print_entry, Lst).
   97
   98bibtex_list :-
   99    bibtex_default(Path),
  100    bibtex_file(Path, Lst),
  101    maplist(print_entry, Lst)