diff --git a/opam.ocaml.org/link_blog_doc_ext.sh b/opam.ocaml.org/link_blog_doc_ext.sh deleted file mode 100755 index 24da82fd5..000000000 --- a/opam.ocaml.org/link_blog_doc_ext.sh +++ /dev/null @@ -1,11 +0,0 @@ -#!/bin/sh - -set -ex - -BLOG=$1 -DOC=$2 -EXT=$3 - -ln -n -s -f "$BLOG" blog -ln -n -s -f "$DOC" doc -ln -n -s -f "$EXT" ext diff --git a/script/absolute_urls.ml b/script/absolute_urls.ml deleted file mode 100644 index 134000091..000000000 --- a/script/absolute_urls.ml +++ /dev/null @@ -1,28 +0,0 @@ -(* Convert relative links to absolute ones *) -open Printf - -let make_absolute base orig_url = - let orig_url = String.trim orig_url in (* bypass bug in omd *) - Uri.(to_string (resolve "http" base (of_string orig_url))) - -let () = - let files = ref [] in - let base = ref "//ocaml.org/" in - let to_base = ref "" in - let specs = [ - ("--base", Arg.Set_string base, - "base the base URL to use for resolution (default to \"//ocaml.org/\")"); - ("--path", Arg.Set_string to_base, - "path path to the root of the site (default \"\")"); - ] in - let anon_arg a = files := a :: !files in - Arg.parse (Arg.align specs) anon_arg "absolute_urls [ ..]"; - let to_base = if !to_base = "" then [] else Neturl.split_path !to_base in - List.iter Urlfun.(fun file -> - let split_file = Neturl.split_path file in - let (_, from_base) = remove_common_prefix to_base split_file in - let from_base = String.concat "/" from_base in - let base = Uri.(resolve "http" (of_string !base) (of_string from_base)) in - try map_file (make_absolute base) file file - with (Unknown_file_type _) -> () - ) !files diff --git a/script/meetings.ml b/script/meetings.ml deleted file mode 100644 index 642002a90..000000000 --- a/script/meetings.ml +++ /dev/null @@ -1,243 +0,0 @@ -(* file: meetings.ml - author: Philippe Wang - licence: ISC - date: 2014 - about: This small program was designed for the ocaml.org website. - depends on glical 0.0.3 (later versions might work) - glical: https://github.com/pw374/glical -*) - -let debug = false - -open Printf -open Glical -open Ical - - -let print_announcement out long_title href short_title date = - fprintf out - " -
  • -
    -

    %s

    -

    %s

    - -
    -
    • " - long_title - href - short_title - date - long_title - href - -let print_news out long_title href short_title date = - fprintf out - " -
  • -
    -

    %s

    -

    %s

    - News -
    -
    • " - long_title - href - short_title - date - long_title - href - - -let ( |> ) x f = f x - -let rec extract_vevents ical = - List.fold_left - (fun accu -> function - | Block (loc, "VEVENT", b) as e - when - (try - ignore - (List.find - (function - | Assoc(_, ("DTSTAMP"|"DTSTART"), _, _) -> true - | _ -> false) - b); - true - with Not_found -> false) - -> e::accu - | Block (_, _, b) -> extract_vevents b @ accu - | _ -> accu) - [] - ical - - -let sort_by_date ical = - let compare a b = match a, b with - | Assoc(_, _, _, v1), Assoc(_, _, _, v2) -> - begin match v1#value, v2#value with - | `Datetime d1, `Datetime d2 -> - Pervasives.compare d1 d2 - | _, `Datetime _ -> 1 - | `Datetime _, _ -> -1 - | _ -> compare a b - end - | _ -> compare a b - in - let module S = - Set.Make( - struct - type t = - [`Text of string list - | `Raw of string - | `Datetime of Datetime.t - ] Ical.element - let compare = compare - end) - in - let ls ical = - List.fold_left (fun accu e -> S.add e accu) S.empty ical - |> S.elements - in - let rec sort = function - | Block(loc, s, v)::tl -> - ls (Block(loc, s, sort v)::(sort tl)) - | (Assoc(loc, s, p, r) as e)::tl -> - ls (e::sort tl) - | [] -> [] - in sort ical - -let eprint_size ical = - if debug then eprintf "ical size: %d\n%!" (List.length ical); - ical - -let ical : - [`Datetime of Glical.Datetime.t - | `Raw of string - | `Text of string list ] Ical.t - = - channel_contents stdin - |> lex_ical - |> parse_ical |> eprint_size - |> extract_vevents |> eprint_size - |> Datetime.parse_datetime |> eprint_size - |> sort_by_date |> eprint_size - - - - -let htmlentities s = - let b = Buffer.create (String.length s * 2) in - let rec loop i = - if i = String.length s then - () - else - let () = - match s.[i] with - | ( '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' ) as c -> Buffer.add_char b c - | '"' -> Buffer.add_string b """ - | '\'' -> Buffer.add_string b "'" - | '&' -> Buffer.add_string b "&" - | '<' -> Buffer.add_string b "<" - | '>' -> Buffer.add_string b ">" - | c -> Buffer.add_char b c - in loop (succ i) - in - loop 0; - Buffer.contents b - - -let () = - List.iter - (function - | Block(_, _, e) -> - let summary = - try - match - List.find - (function - | Assoc(_, "SUMMARY", _, x) -> true - | _ -> false) - e - with - | Assoc(_, _, _, x) -> - String.concat " " (text_of_raw x#location x#to_string) - |> htmlentities - | _ -> failwith "SUMMARY" - with Not_found -> "summary missing" - in - let description = - try - match - List.find - (function - | Assoc(_, "DESCRIPTION", _, x) -> true - | _ -> false) - e - with - | Assoc(_, _, _, x) -> - String.concat " " (text_of_raw x#location x#to_string) - |> htmlentities - | _ -> failwith "DESCRIPTION" - with Not_found -> "description missing" - in - let url = - try - match - List.find - (function - | Assoc(_, "URL", _, x) -> true - | _ -> false) - e - with - | Assoc(_, _, _, x) -> - String.concat " " (text_of_raw x#location x#to_string) - |> htmlentities - | _ -> failwith "URL" - with Not_found -> "url missing" - in - let dtstamp = - try - match - List.find - (function - | Assoc(_, ("DTSTAMP"|"DTSTART"), _, x) -> true - | _ -> false) - e - with - | Assoc(_, _, _, dt) -> - begin let open Datetime in - match dt#value with - | `Datetime dt -> - sprintf "%s %d, %d" - (match dt.month with - | 1 -> "January" - | 2 -> "February" - | 3 -> "March" - | 4 -> "April" - | 5 -> "May" - | 6 -> "June" - | 7 -> "July" - | 8 -> "August" - | 9 -> "September" - | 10 -> "October" - | 11 -> "November" - | 12 -> "December" - | _ -> assert false - ) - dt.day - dt.year - | _ -> failwith "DTSTAMP|DTSTART" - end - | _ -> failwith "DTSTAMP|DTSTART" - with Not_found -> "date (DTSTAMP|DTSTART) missing" - in - print_news - stdout - description - url - summary - dtstamp - | _ -> () - ) - ical diff --git a/script/ocamlapplet.bash b/script/ocamlapplet.bash deleted file mode 100755 index 25a3ca88d..000000000 --- a/script/ocamlapplet.bash +++ /dev/null @@ -1,31 +0,0 @@ -#!/bin/bash - -function hash() { - cat | (md5 || md5sum) | sed -e 's| ./*||g' -} - -function id () { - if [[ "$1" != "" ]] - then - echo $1 - else - hash < $tmpfile.ml - fi -} - -tmpfile=$(date +tmp%Y%m%d%H%M%S%N)$RANDOM - -cat > $tmpfile.ml - -script/ocamltohtml < $tmpfile.ml > $tmpfile.html - -if [[ "$TRYOCAMLON" != "" ]] -then - e="$(./htmlescape < $tmpfile.ml)" - echo -n "[try]" >> $tmpfile.html -fi - -cat $tmpfile.html - -rm -f $tmpfile* - diff --git a/site/learn/tutorials/graph.ml b/site/learn/tutorials/graph.ml deleted file mode 100644 index 50a663b92..000000000 --- a/site/learn/tutorials/graph.ml +++ /dev/null @@ -1,107 +0,0 @@ -open GObj - -(* Draw text left, centre or right justified at point. (x,y) point is - * either top left, top middle or top right of text. - *) -let draw_text drawable font position (x, y) text = - let string_width = Gdk.Font.string_width font text in - let string_height = Gdk.Font.string_height font text in - match position with - `Left -> - drawable#string text ~font ~x ~y:(y+string_height) - | `Centre -> - drawable#string text ~font ~x:(x - string_width/2) ~y:(y+string_height) - | `Right -> - drawable#string text ~font ~x:(x - string_width) ~y:(y+string_height) - -(* Filled, black-outlined rectangle. *) -let draw_rectangle (drawable : GDraw.drawable) - fill_col (ll_x, ll_y) (tr_x, tr_y) = - let width = tr_x - ll_x in - let height = tr_y - ll_y in - drawable#set_foreground (`NAME fill_col); - drawable#rectangle ~x:ll_x ~y:ll_y ~width ~height ~filled:true (); - drawable#set_foreground `BLACK; - drawable#rectangle ~x:ll_x ~y:ll_y ~width ~height ~filled:false () - -(* This is the actual graph widget. *) -class graph font ?width ?height ?packing ?show array = - (* Constants. *) - let page_size = 10 in (* Number of bars on "page". *) - let max_y = 10 in (* Maximum on Y scale. *) - - (* Number of data points. *) - let array_size = Array.length array in - - (* Create the containing vbox. *) - let vbox = GPack.vbox ?width ?height ?packing ?show () in - - (* Create the drawing area. *) - let da = GMisc.drawing_area ~packing:vbox#add () in - let drawable = lazy (new GDraw.drawable da#misc#window) in - - (* Create the scrollbar. *) - let adjustment = GData.adjustment - ~lower:0. ~upper:(float_of_int (array_size-1)) - ~step_incr:1. ~page_incr:(float_of_int page_size) () in - let scrollbar = - GRange.scrollbar `HORIZONTAL ~adjustment ~packing:vbox#pack () in - - object (self) - inherit widget vbox#as_widget - - initializer - ignore(da#event#connect#expose - ~callback:(fun _ -> self#repaint (); false)); - ignore(adjustment#connect#value_changed - ~callback:(fun _ -> self#repaint ())) - - (* The title of the graph. *) - val mutable title = "no title" - method set_title t = title <- t - method title = title - - (* Repaint the widget. *) - method private repaint () = - let drawable = Lazy.force drawable in - let (width, height) = drawable#size in - drawable#set_background `WHITE; - drawable#set_foreground `WHITE; - drawable#rectangle ~x:0 ~y:0 ~width ~height ~filled:true (); - drawable#set_foreground `BLACK; - - (* Draw the title. *) - draw_text drawable font `Centre (width/2, 20) title; - - (* Draw the axes. *) - drawable#line ~x:40 ~y:(height-40) ~x:(width-40) ~y:(height-40); - drawable#line ~x:40 ~y:(height-40) ~x:40 ~y:40; - - (* Which part of the data to display? first .. first+page_size-1 *) - let first_bar = int_of_float adjustment#value in - let data = Array.sub array first_bar page_size in - let bar_width = (width - 80) / page_size in - - (* Compute function mapping graph (x, y) to screen coordinates. *) - let map (x,y) = - (40 + x * bar_width, height-40 - y * (height-80) / max_y) - in - - (* Draw the axes scales. *) - draw_text drawable font `Right (40, height-40) "0"; - draw_text drawable font `Right (40, 40) (string_of_int max_y); - for i = 0 to page_size-1 do - let x = 40 + i * bar_width + bar_width/2 in - let y = height-35 in - let v = first_bar + i in - draw_text drawable font `Centre (x, y) (string_of_int v) - done; - - (* Draw the data. *) - for i = 0 to page_size-1 do - let (ll_x,ll_y) = map (i, data.(i)) in - let (tr_x,tr_y) = map (i+1, 0) in - draw_rectangle drawable "red" (ll_x, ll_y) (tr_x, tr_y) - done; - () - end diff --git a/site/learn/tutorials/objcache.ml b/site/learn/tutorials/objcache.ml deleted file mode 100644 index 681ea89c0..000000000 --- a/site/learn/tutorials/objcache.ml +++ /dev/null @@ -1,120 +0,0 @@ -(* Example of finalisation and weak pointers. - * ocamlc unix.cma objcache.ml -o objcache - *) - -open Printf - -(* In-memory format. *) -type record = { mutable name : string; mutable address : string } - -(* On-disk format. *) -let record_size = 256 -let name_size = 64 -let addr_size = 192 - -(* Create a new, empty record. *) -let new_record () = - { name = String.make name_size ' '; - address = String.make addr_size ' ' } - -(* Low-level load/save records to file. *) -let seek_record n fd = - ignore(Unix.lseek fd (n * record_size) Unix.SEEK_SET) - -let write_record record n fd = - seek_record n fd; - ignore(Unix.write fd record.name 0 name_size); - ignore(Unix.write fd record.address 0 addr_size) - -let read_record record n fd = - seek_record n fd; - ignore(Unix.read fd record.name 0 name_size); - ignore(Unix.read fd record.address 0 addr_size) - -(* Lock/unlock the nth record in a file. *) -let lock_record n fd = - seek_record n fd; - Unix.lockf fd Unix.F_LOCK record_size - -let unlock_record n fd = - seek_record n fd; - Unix.lockf fd Unix.F_ULOCK record_size - -(* Total number of records. *) -let nr_records = 10000 - -(* On-disk file. *) -let diskfile = - Unix.openfile "users.bin" [ Unix.O_RDWR; Unix.O_CREAT ] 0o666 - -(* Cache of records. *) -let cache = Weak.create nr_records - - -(* The finaliser function. *) -let finaliser n record = - printf "*** objcache: finalising record %d\n%!" n; - write_record record n diskfile; - unlock_record n diskfile - -(* Get a record from the cache or off disk. *) -let get_record n = - match Weak.get cache n with - | Some record -> - printf "*** objcache: fetching record %d from memory cache\n%!" n; - record - | None -> - printf "*** objcache: loading record %d from disk\n%!" n; - let record = new_record () in - Gc.finalise (finaliser n) record; - lock_record n diskfile; - read_record record n diskfile; - Weak.set cache n (Some record); - record - -(* Synchronise all records. *) -let sync_records () = - Weak.fill cache 0 nr_records None; - Gc.full_major () - -(* Run finalisers on exit. *) -let () = - at_exit Gc.full_major - -(* Pad or truncate a string to a particular fixed length. *) -let fix_string str size = - let len = String.length str in - if len < size then - str ^ String.make (size - len) ' ' - else - String.sub str 0 size - -(* Test code. *) -let rec loop () = - printf "Type the record number to load (0 - %d) or s to sync or q to quit: " - (nr_records-1); - let line = read_line () in - if line.[0] = 's' then ( - sync_records (); - loop () - ) - else if line.[0] <> 'q' then ( - let n = int_of_string line in - let record = get_record n in - printf "Record %d:\n Name: %s\n Address:\n%s\n\n" - n record.name record.address; - print_string "Update this record (y/n)? [n] "; - let answer = read_line () in - if answer.[0] = 'y' then ( - print_string "Name: "; - let name = read_line () in - print_string "Address: "; - let address = read_line () in - record.name <- fix_string name name_size; - record.address <- fix_string address addr_size - ); - loop () - ) - -let () = - loop () diff --git a/site/learn/tutorials/test.ml b/site/learn/tutorials/test.ml deleted file mode 100644 index a3261a2f0..000000000 --- a/site/learn/tutorials/test.ml +++ /dev/null @@ -1,45 +0,0 @@ -(* Graph widget test program. *) - -open GMain -open GdkKeysyms -open Graph - -let font_name = "-*-helvetica-medium-r-normal-*-120-*" - -let locale = GtkMain.Main.init () - -let font = - try - Gdk.Font.load font_name - with - Gpointer.Null -> failwith ("graph.ml: font " ^ font_name ^ ": not found") - -let main () = - let window = GWindow.window ~width:640 ~height:480 - ~title:"LablGtk graph widget demo" () in - let vbox = GPack.vbox ~packing:window#add () in - window#connect#destroy ~callback:Main.quit; - - (* Menu bar *) - let menubar = GMenu.menu_bar ~packing:vbox#pack () in - let factory = new GMenu.factory menubar in - let accel_group = factory#accel_group in - let file_menu = factory#add_submenu "File" in - - (* File menu *) - let factory = new GMenu.factory file_menu ~accel_group in - factory#add_item "Quit" ~key:_Q ~callback: Main.quit; - - (* Data. *) - let array = Array.init 100 (fun _ -> Random.int 10) in - - (* Create a graph in the main area. *) - let graph = new graph font ~packing:vbox#add array in - graph#set_title "Random data"; - - (* Display the windows and enter Gtk+ main loop *) - window#show (); - Main.main () - -let () = - main ()