From 031399dbcfb761aa15417a4b5fd4a0edea7490e6 Mon Sep 17 00:00:00 2001 From: malc Date: Fri, 24 Jul 2015 20:53:09 +0300 Subject: [PATCH] Save (and optionally show) origin in history --- config.ml | 102 +++++++++++++++++++++++++++++++++----------------------------- main.ml | 23 +++++++++----- 2 files changed, 70 insertions(+), 55 deletions(-) diff --git a/config.ml b/config.ml index 2ecdf1f..3ce8711 100644 --- a/config.ml +++ b/config.ml @@ -296,7 +296,7 @@ and outlinekind = | Olaunch of launchcommand | Oremote of (filename * pageno) | Oremotedest of (filename * destname) - | Ohistory of (filename * (conf * outline list * x * anchor)) + | Ohistory of (filename * (conf * outline list * x * anchor * filename)) | Oaction of (unit -> unit) and outline = (caption * outlinelevel * outlinekind) and outlinelevel = int @@ -1126,16 +1126,17 @@ let bookmark_of attrs = ;; let doc_of attrs = - let rec fold path page rely pan visy = function - | ("path", v) :: rest -> fold v page rely pan visy rest - | ("page", v) :: rest -> fold path v rely pan visy rest - | ("rely", v) :: rest -> fold path page v pan visy rest - | ("pan", v) :: rest -> fold path page rely v visy rest - | ("visy", v) :: rest -> fold path page rely pan v rest - | _ :: rest -> fold path page rely pan visy rest - | [] -> path, page, rely, pan, visy + let rec fold path page rely pan visy origin = function + | ("path", v) :: rest -> fold v page rely pan visy origin rest + | ("page", v) :: rest -> fold path v rely pan visy origin rest + | ("rely", v) :: rest -> fold path page v pan visy origin rest + | ("pan", v) :: rest -> fold path page rely v visy origin rest + | ("visy", v) :: rest -> fold path page rely pan v origin rest + | ("origin", v) :: rest -> fold path page rely pan visy v rest + | _ :: rest -> fold path page rely pan visy origin rest + | [] -> path, page, rely, pan, visy, origin in - fold E.s "0" "0" "0" "0" attrs + fold E.s "0" "0" "0" "0" E.s attrs ;; let map_of attrs = @@ -1261,8 +1262,9 @@ let get s = else { v with f = uifont (Buffer.create 10) } | Vopen ("doc", attrs, closed) -> - let pathent, spage, srely, span, svisy = doc_of attrs in + let pathent, spage, srely, span, svisy, origin = doc_of attrs in let path = unent pathent + and origin = unent origin and pageno = fromstring int_of_string spos "page" spage 0 and rely = fromstring float_of_string spos "rely" srely 0.0 and pan = fromstring int_of_string spos "pan" span 0 @@ -1270,8 +1272,8 @@ let get s = let c = config_of dc attrs in let anchor = (pageno, rely, visy) in if closed - then (Hashtbl.add h path (c, [], pan, anchor); v) - else { v with f = doc path pan anchor c [] } + then (Hashtbl.add h path (c, [], pan, anchor, origin); v) + else { v with f = doc path origin pan anchor c [] } | Vopen _ -> error "unexpected subelement in llppconfig" s spos @@ -1319,14 +1321,14 @@ let get s = | Vclose _ -> error "unexpected close in ui-font" s spos | Vend -> error "unexpected end of input in ui-font" s spos - and doc path pan anchor c bookmarks v t spos _ = + and doc path origin pan anchor c bookmarks v t spos _ = match t with | Vdata | Vcdata -> v | Vend -> error "unexpected end of input in doc" s spos | Vopen ("bookmarks", _, closed) -> if closed then v - else { v with f = pbookmarks path pan anchor c bookmarks } + else { v with f = pbookmarks path origin pan anchor c bookmarks } | Vopen ("keymap", attrs, closed) -> let modename = @@ -1339,7 +1341,7 @@ let get s = let ret keymap = let h = findkeyhash c modename in KeyMap.iter (Hashtbl.replace h) keymap; - doc path pan anchor c bookmarks + doc path origin pan anchor c bookmarks in { v with f = pkeymap ret KeyMap.empty } @@ -1347,7 +1349,7 @@ let get s = error "unexpected subelement in doc" s spos | Vclose "doc" -> - Hashtbl.add h path (c, List.rev bookmarks, pan, anchor); + Hashtbl.add h path (c, List.rev bookmarks, pan, anchor, origin); { v with f = llppconfig } | Vclose _ -> error "unexpected close in doc" s spos @@ -1380,7 +1382,7 @@ let get s = | Vclose _ -> error "unexpected close in keymap" s spos - and pbookmarks path pan anchor c bookmarks v t spos _ = + and pbookmarks path origin pan anchor c bookmarks v t spos _ = match t with | Vdata | Vcdata -> v | Vend -> error "unexpected end of input in bookmarks" s spos @@ -1393,7 +1395,7 @@ let get s = (unent titleent, 0, Oanchor (page, rely, visy)) :: bookmarks in if closed - then { v with f = pbookmarks path pan anchor c bookmarks } + then { v with f = pbookmarks path origin pan anchor c bookmarks } else let f () = v in { v with f = skip "item" f } @@ -1402,7 +1404,7 @@ let get s = error "unexpected subelement in bookmarks" s spos | Vclose "bookmarks" -> - { v with f = doc path pan anchor c bookmarks } + { v with f = doc path origin pan anchor c bookmarks } | Vclose _ -> Parser.parse_error "unexpected close in bookmarks" s spos @@ -1489,7 +1491,7 @@ let load openlast = then ( let path, _ = Hashtbl.fold - (fun path (conf, _, _, _) ((_, besttime) as best) -> + (fun path (conf, _, _, _, _) ((_, besttime) as best) -> if conf.lastvisit > besttime then (path, conf.lastvisit) else best) @@ -1498,16 +1500,17 @@ let load openlast = in state.path <- path; ); - let pc, pb, px, pa = + let pc, pb, px, pa, po = try let absname = abspath state.path in Hashtbl.find h absname - with Not_found -> dc, [], 0, emptyanchor + with Not_found -> dc, [], 0, emptyanchor, E.s in setconf defconf dc; setconf conf pc; state.bookmarks <- pb; state.x <- px; + state.origin <- po; if conf.jumpback then state.anchor <- pa; cbput state.hists.nav pa; @@ -1519,8 +1522,8 @@ let load openlast = let gethist listref = let f (h, _) = listref := - Hashtbl.fold (fun path (pc, pb, px, pa) accu -> - (path, pc, pb, px, pa) :: accu) + Hashtbl.fold (fun path (pc, pb, px, pa, po) accu -> + (path, pc, pb, px, pa, po) :: accu) h []; true in @@ -1767,13 +1770,18 @@ let save1 bb leavebirdseye x h dc = ) else Buffer.add_string bb "/>\n"; - let adddoc path pan anchor c bookmarks time = + let adddoc path pan anchor c bookmarks time origin = if bookmarks == [] && c = dc && anchor = emptyanchor then () else ( Printf.bprintf bb " emptyanchor then ( let n, rely, visy = anchor in @@ -1858,30 +1866,30 @@ let save1 bb leavebirdseye x h dc = | LinkNav _ -> x, conf in let docpath = if nonemptystr state.path then abspath state.path else E.s in - if docpath <> E.s + if nonemptystr docpath then ( adddoc docpath pan (getanchor ()) - ( - let autoscrollstep = - match state.autoscroll with - | Some step -> step - | None -> conf.autoscrollstep - in - begin match state.mode with - | Birdseye beye -> leavebirdseye beye true - | Textentry _ - | View - | LinkNav _ -> () - end; - { conf with autoscrollstep = autoscrollstep } - ) - (if conf.savebmarks then state.bookmarks else []) - (now ()) + ( + let autoscrollstep = + match state.autoscroll with + | Some step -> step + | None -> conf.autoscrollstep + in + begin match state.mode with + | Birdseye beye -> leavebirdseye beye true + | Textentry _ + | View + | LinkNav _ -> () + end; + { conf with autoscrollstep = autoscrollstep } + ) + (if conf.savebmarks then state.bookmarks else []) + (now ()) + state.origin ); - - Hashtbl.iter (fun path (c, bookmarks, x, anchor) -> + Hashtbl.iter (fun path (c, bookmarks, x, anchor, origin) -> if docpath <> abspath path - then adddoc path x anchor c bookmarks c.lastvisit + then adddoc path x anchor c bookmarks c.lastvisit origin ) h; Buffer.add_string bb "\n"; true; @@ -1931,7 +1939,7 @@ let gc fdi fdo = let href = ref (Hashtbl.create 0) in let cref = ref defconf in let push (h, dc) = - let f path (pc, _pb, _px, _pa) = + let f path (pc, _pb, _px, _pa, _po) = let s = Printf.sprintf "%s\000%ld\000" path (Int32.of_float pc.lastvisit) in diff --git a/main.ml b/main.ml index 8468fb5..5699147 100644 --- a/main.ml +++ b/main.ml @@ -3351,7 +3351,7 @@ object (self) end let genhistoutlines = - let order ty (p1, c1, _, _, _) (p2, c2, _, _, _) = + let order ty (p1, c1, _, _, _, _) (p2, c2, _, _, _, _) = match ty with | `lastvisit -> compare c1.lastvisit c2.lastvisit | `path -> compare p2 p1 @@ -3366,6 +3366,7 @@ let genhistoutlines = else compare c1.title c2.title in let showfullpath = ref false in + let showorigin = ref true in fun orderty -> let setorty s t = let s = if orderty = t then "[@Uradical] " ^ s else "[ ] " ^ s in @@ -3376,9 +3377,12 @@ let genhistoutlines = then let ol = List.fold_left - (fun accu (path, c, b, x, a) -> - let hist = (path, (c, b, x, a)) in - let s = if !showfullpath then path else Filename.basename path in + (fun accu (path, c, b, x, a, o) -> + let hist = (path, (c, b, x, a, o)) in + let s = + let s = if nonemptystr o && !showorigin then o else path in + if !showfullpath then s else Filename.basename s + in let base = mbtoutf8 s in (base ^ "\000" ^ c.title, 1, Ohistory hist) :: accu ) @@ -3388,24 +3392,27 @@ let genhistoutlines = setorty "Sort by title" `title; (if !showfullpath then "@Uradical " else " ") ^ "Show full path", 0, Oaction (fun () -> - showfullpath := not !showfullpath; reeenterhist := true) + showfullpath := not !showfullpath; reeenterhist := true); + (if !showorigin then "@Uradical " + else " ") ^ "Show origin", 0, Oaction (fun () -> + showorigin := not !showorigin; reeenterhist := true) ] (List.sort (order orderty) !list) in Array.of_list ol else E.a; ;; -let gotohist (path, (c, bookmarks, x, anchor)) = +let gotohist (path, (c, bookmarks, x, anchor, origin)) = Config.save leavebirdseye; state.anchor <- anchor; state.bookmarks <- bookmarks; - state.origin <- E.s; + state.origin <- origin; state.x <- x; setconf conf c; let x0, y0, x1, y1 = conf.trimfuzz in wcmd "trimset %d %d %d %d %d" (btod conf.trimmargins) x0 y0 x1 y1; reshape ~firsttime:true state.winw state.winh; - opendoc path E.s; + opendoc path origin; setzoom c.zoom; ;; -- 2.11.4.GIT