1/*****************************************************************************
    2 * This file is part of the Prolog Development Tool (PDT)
    3 * 
    4 * WWW: http://sewiki.iai.uni-bonn.de/research/pdt/start
    5 * Mail: pdt@lists.iai.uni-bonn.de
    6 * Copyright (C): 2004-2012, CS Dept. III, University of Bonn
    7 * 
    8 * All rights reserved. This program is  made available under the terms
    9 * of the Eclipse Public License v1.0 which accompanies this distribution,
   10 * and is available at http://www.eclipse.org/legal/epl-v10.html
   11 * 
   12 ****************************************************************************/
   13
   14
   15:- module( pdt_manual_entry,
   16         [ predicate_manual_entry/5    % (_Module,Pred,Arity,Content)
   17         ]).   18         
   19:- if(current_prolog_flag(dialect, swi)).   20
   21:- use_module(library(lists)).   22%:- use_module(library(helpidx)).
   23:- use_module(library(memfile)).   24:- use_module(library(quintus)).   25
   26% TODO 2012-07: are these still in use?
   27:- use_module(library(pldoc/doc_library)).   28:- use_module(library(explain)).   29:- use_module(library(help)).   30:- use_module(library(make)).   31:- use_module(library('pldoc')).   32:- use_module(library('pldoc/doc_html')).   33%:- use_module(library('http/html_write')).
   34
   35:- use_module(pdt_prolog_library(utils4modules)).   36
   37
   38               /****************************************
   39                * GET THE MANUAL ENTRY FOR A PREDICATE *
   40                ****************************************/
 predicate_manual_entry(+Module, +Pred, +Arity, -Content, -IsDeprecated) is det
   45predicate_manual_entry(Module, Pred,Arity,Content, IsDeprecated) :-
   46    %pldoc:doc_comment(Module:Pred/Arity,_File:_,,Content),
   47    %TODO: The html code is now available:
   48    pldoc_process:doc_comment(Module:Pred/Arity,File:_,_Summary, Comment),
   49	(	atomic(Comment),
   50		sub_atom(Comment, _, _, _, '@deprecated')
   51	->	IsDeprecated = true
   52	;	IsDeprecated = false
   53	),
   54	gen_html_for_pred_(File,Pred/Arity,Content),
   55    !.
   56	
   57predicate_manual_entry(_Module,_Pred,_Arity,'nodoc', _).
   58
   59gen_html_for_pred_(FileSpec,Functor/Arity,Html) :-    
   60	doc_file_objects(FileSpec, _File, Objects, FileOptions, [public_only(false)]),
   61	member(doc(Signature,FilePos,Doc),Objects),
   62	( Functor/Arity=Signature 
   63	; _Module:Functor/Arity=Signature
   64	),
   65	!,
   66	phrase(html([ 
   67	     		\objects([doc(Functor/Arity,FilePos,Doc)], FileOptions)
   68	     ]),List),
   69%	maplist(replace_nl_,List,AtomList),
   70%	atomic_list_concat(AtomList,Html), 
   71	with_output_to(atom(Html), print_html(List)).
 manual_entry(Pred, Arity, Content) is det
TODO: Remove duplicate code by using predicate_manual_entry. Only difference: Use of stream_position versus use of seek.
   80manual_entry(Pred,Arity,Content) :-
   81    predicate(Pred,Arity,_,From,To),
   82    !,
   83    online_help:online_manual_stream(Manual),
   84    new_memory_file(Handle),
   85    open_memory_file(Handle, write, MemStream),
   86    stream_position(Manual, _, '$stream_position'(From, 0, 0)),
   87    Range is To - From,
   88    online_help:copy_chars(Range, Manual, MemStream),
   89    close(MemStream),
   90    memory_file_to_atom(Handle,Content),
   91    free_memory_file(Handle).
   92/*
   93manual_entry(Pred,Arity,Content) :-
   94    meta_data_help(_,Pred,Arity,ContentString),
   95    string_to_atom(ContentString,Content).
   96
   97manual_entry(Pred,-1,Content) :-
   98    meta_data_module(_,Pred,ContentString),
   99    string_to_atom(ContentString,Content).
  100*/
  101
  102:- else.  103
  104predicate_manual_entry(_Module,_Pred,_Arity,'nodoc').
  105
  106:- endif.