← Back to branch summary

~ubuntu-branches/ubuntu/hardy/ocaml-doc/hardy

« back to all changes in this revision

Viewing changes to examples/tools/add_banner.ml

  • Committer: Bazaar Package Importer
  • Author(s): Samuel Mimram
  • Date: 2007-09-08 01:49:22 UTC
  • mfrom: (0.1.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070908014922-lvihyehz0ndq7suu
Tags: 3.10-1
* New upstream release.
* Removed camlp4 documentation since it is not up-to-date.
* Updated to standards version 3.7.2, no changes needed.
* Updated my email address.

Show diffs side-by-side

added added

removed removed

Lines of Context:
examples/tools/add_banner.ml
1
 
(***********************************************************************)
2
 
(*                                                                     *)
3
 
(*                           Objective Caml                            *)
4
 
(*                                                                     *)
5
 
(*               Pierre Weis, projet Cristal, INRIA Rocquencourt       *)
6
 
(*                                                                     *)
7
 
(*  Copyright 2001 Institut National de Recherche en Informatique et   *)
8
 
(*  en Automatique.  All rights reserved.  This file is distributed    *)
9
 
(*  only by permission.                                                *)
10
 
(*                                                                     *)
11
 
(***********************************************************************)
12
 
 
13
 
let string_of_ic ic =
14
 
 let l = in_channel_length ic in
15
 
 let buf = String.create 1024 in
16
 
 let res = Buffer.create l in
17
 
 try
18
 
  while true do
19
 
   let n = input ic buf 0 1024 in
20
 
   if n = 0 then raise Exit else
21
 
   Buffer.add_substring res buf 0 n
22
 
  done;
23
 
  Buffer.contents res
24
 
 with Exit -> Buffer.contents res;;
25
 
 
26
 
let string_of_file fname =
27
 
 let ic = open_in fname in
28
 
 let r = string_of_ic ic in
29
 
 close_in ic;
30
 
 r;;
31
 
 
32
 
let copy_channel ic oc =
33
 
 let buf = String.create 1024 in
34
 
 try
35
 
  while true do
36
 
   let n = input ic buf 0 1024 in
37
 
   if n = 0 then raise Exit else
38
 
   output oc buf 0 n
39
 
  done
40
 
 with Exit -> ();;
41
 
 
42
 
let copy_file s copy =
43
 
  let ic = open_in s in
44
 
  let oc = open_out copy in
45
 
  copy_channel ic oc;
46
 
  close_out oc;
47
 
  close_in ic;;
48
 
 
49
 
let bannerize_channel banner ic oc =
50
 
 output_string oc banner;
51
 
 copy_channel ic oc;;
52
 
 
53
 
let ckpname fname = fname ^ "~";;
54
 
let ckp_file fname =
55
 
 let copy = ckpname fname in
56
 
 copy_file fname copy;
57
 
 copy;;
58
 
 
59
 
let bannerize_file banner s =
60
 
 let copy = ckp_file s in
61
 
 let ic = open_in copy in
62
 
 let oc = open_out s in
63
 
 bannerize_channel banner ic oc;
64
 
 close_out oc;
65
 
 close_in ic;;
66
 
 
67
 
let with_in_channel fname f =
68
 
 let ic = open_in fname in
69
 
 try
70
 
  let r = f ic in
71
 
  close_in ic;
72
 
  r
73
 
 with x -> close_in ic; raise x;;
74
 
 
75
 
let with_out_channel fname f =
76
 
 let oc = open_out fname in
77
 
 try
78
 
  let r = f oc in
79
 
  close_out oc;
80
 
  r
81
 
 with x -> close_out oc; raise x;;
82
 
 
83
 
let string_of_file fname = with_in_channel fname string_of_ic;;
84
 
 
85
 
let copy_file s copy =
86
 
 with_in_channel s (fun ic -> with_out_channel copy (copy_channel ic));;
87
 
 
88
 
let bannerize_file banner fname =
89
 
 let copy = ckp_file fname in
90
 
 with_in_channel copy
91
 
  (fun ic -> with_out_channel fname (bannerize_channel banner ic));;
92
 
 
93
 
let skip_banner_channel banner_marker ic =
94
 
 let l = try input_line ic with End_of_file -> "" in
95
 
 if l = banner_marker then
96
 
  try
97
 
   while input_line ic <> banner_marker do () done
98
 
  with End_of_file ->
99
 
  invalid_arg "replace_banner: end of banner not found"
100
 
 else seek_in ic 0;;
101
 
 
102
 
(* The main function to rewrite files with banners. *)
103
 
let replace_banner banner_marker banner fname =
104
 
 let copy = ckp_file fname in
105
 
 with_in_channel copy
106
 
  (fun ic ->
107
 
     skip_banner_channel banner_marker ic;
108
 
     with_out_channel fname (bannerize_channel banner ic));;
109
 
 
110
 
(* To get the banner's marker. *)
111
 
let get_first_line fname = with_in_channel fname input_line;;
112
 
 
113
 
let main () =
114
 
 let files = ref [] in
115
 
 let banner_file = ref "banner" in
116
 
 let set_banner_file fname = banner_file := fname in
117
 
 let record_file_name s = files := s :: !files in
118
 
 let b_opt =  Arg.String set_banner_file
119
 
 and b_message =
120
 
   " <banner file>: set the contents of file <banner file> as the banner   \n\
121
 
      (default name for the banner file is \"banner\")." in
122
 
 Arg.parse
123
 
  ["-b", b_opt, b_message;
124
 
   "--banner", b_opt, b_message]
125
 
  record_file_name
126
 
  "Usage: banner [-b | --banner <banner file>] <files>\n\n\
127
 
   This command adds a banner to the top of each file given in the list of\n\
128
 
   argument files.\n\
129
 
   The text of the banner is the contents of a <banner file> that can\n\
130
 
   be fixed with the [-b] option (default banner file name is \"banner\").\n\
131
 
   The text of a banner must be comprised between two identical lines,\n\
132
 
   the ``banner markers'' (hence the first and the last lines of the\n\
133
 
   banner file must be identical).\n\
134
 
   Two banners are considered similar if they have the same banner markers.\n\
135
 
   If a file already had a similar banner, this banner is removed \
136
 
   before adding\n\
137
 
   the contents of the <banner file>. This way, slight modifications of the\n\
138
 
   banner are easily handled.\n\n\
139
 
   Prior to add a banner to the file \"f\", a checkpoint of \"f\" is\n\
140
 
   written in the file named [f~].";
141
 
 let banner_marker = get_first_line !banner_file in
142
 
 let banner = string_of_file !banner_file in
143
 
 List.iter (replace_banner banner_marker banner) !files;;
144
 
 
145
 
try main () with Sys_error s -> prerr_endline ("Fatal error: " ^ s); exit 1;;
146