/
Documentation.hs
156 lines (140 loc) · 4.73 KB
/
Documentation.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
--
-- Module : IDE.Pane.WebKit.Documentation
-- Copyright : 2007-2011 Juergen Nicklisch-Franken, Hamish Mackenzie
-- License : GPL Nothing
--
-- Maintainer : maintainer@leksah.org
-- Stability : provisional
-- Portability :
--
-- |
--
-----------------------------------------------------------------------------
module IDE.Pane.WebKit.Documentation (
IDEDocumentation(..)
, DocumentationState(..)
, getDocumentation
, loadDoc
, reloadDoc
) where
import Graphics.UI.Frame.Panes
(RecoverablePane(..), PanePath, RecoverablePane, Pane(..))
import Graphics.UI.Gtk
(scrolledWindowSetPolicy, scrolledWindowNew, castToWidget,
ScrolledWindow)
import Data.Typeable (Typeable)
import IDE.Core.Types (IDEAction, IDEM)
import Control.Monad.IO.Class (MonadIO(..))
import Graphics.UI.Frame.ViewFrame (getNotebook)
import IDE.Core.State (reifyIDE)
import Graphics.UI.Gtk.General.Enums (PolicyType(..))
#ifdef WEBKITGTK
import Graphics.UI.Gtk
(eventModifier, eventKeyName, keyPressEvent, afterFocusIn,
containerAdd, Modifier(..))
import Graphics.UI.Gtk.WebKit.Types (WebView(..))
import Graphics.UI.Gtk.WebKit.WebView
(webViewUri, webViewGoBack, webViewZoomOut, webViewZoomIn,
webViewZoomLevel, webViewReload, webViewLoadUri, webViewNew)
import System.Glib.Attributes (AttrOp(..), set, get)
import System.Glib.Signals (on)
import IDE.Core.State (reflectIDE)
import Graphics.UI.Editor.Basics (Connection(..))
#else
import Data.IORef (writeIORef, newIORef, readIORef, IORef)
import Control.Applicative ((<$>))
#endif
data IDEDocumentation = IDEDocumentation {
scrolledView :: ScrolledWindow
#ifdef WEBKITGTK
, webView :: WebView
#else
, docState :: IORef DocumentationState
#endif
} deriving Typeable
data DocumentationState = DocumentationState {
zoom :: Float
, uri :: Maybe String
} deriving(Eq,Ord,Read,Show,Typeable)
instance Pane IDEDocumentation IDEM
where
primPaneName _ = "Doc"
getAddedIndex _ = 0
getTopWidget = castToWidget . scrolledView
paneId b = "*Doc"
instance RecoverablePane IDEDocumentation DocumentationState IDEM where
saveState p = liftIO $ do
#ifdef WEBKITGTK
zoom <- webView p `get` webViewZoomLevel
uri <- webView p `get` webViewUri
return (Just DocumentationState{..})
#else
Just <$> readIORef (docState p)
#endif
recoverState pp DocumentationState {..} = do
nb <- getNotebook pp
mbPane <- buildPane pp nb builder
case mbPane of
Nothing -> return ()
Just p -> liftIO $ do
#ifdef WEBKITGTK
webView p `set` [webViewZoomLevel := zoom]
maybe (return ()) (webViewLoadUri (webView p)) uri
#else
writeIORef (docState p) DocumentationState {..}
#endif
return mbPane
builder pp nb windows = reifyIDE $ \ ideR -> do
scrolledView <- scrolledWindowNew Nothing Nothing
#ifdef WEBKITGTK
webView <- webViewNew
containerAdd scrolledView webView
#else
docState <- newIORef DocumentationState {zoom = 1.0, uri = Nothing}
#endif
scrolledWindowSetPolicy scrolledView PolicyAutomatic PolicyAutomatic
let docs = IDEDocumentation {..}
#ifdef WEBKITGTK
cid1 <- webView `afterFocusIn`
(\_ -> do reflectIDE (makeActive docs) ideR ; return True)
webView `set` [webViewZoomLevel := 2.0]
cid2 <- webView `on` keyPressEvent $ do
key <- eventKeyName
mod <- eventModifier
liftIO $ case (key, mod) of
("plus", [Shift,Control]) -> webViewZoomIn webView >> return True
("minus",[Control]) -> webViewZoomOut webView >> return True
("BackSpace", []) -> webViewGoBack webView >> return True
_ -> return False
return (Just docs, map ConnectC [cid1, cid2])
#else
return (Just docs, [])
#endif
getDocumentation :: Maybe PanePath -> IDEM IDEDocumentation
getDocumentation Nothing = forceGetPane (Right "*Doc")
getDocumentation (Just pp) = forceGetPane (Left pp)
loadDoc :: String -> IDEAction
loadDoc uri = do
#ifdef WEBKITGTK
doc <- getDocumentation Nothing
let view = webView doc
liftIO $ webViewLoadUri view uri
#else
return ()
#endif
reloadDoc :: IDEAction
reloadDoc = do
#ifdef WEBKITGTK
doc <- getDocumentation Nothing
let view = webView doc
liftIO $ webViewReload view
#else
return ()
#endif