mab.ls (16501B)
1 (defvar *loaded* 0) ;; onload counter 2 3 (defhandler "on_allinfo_loaded" () 4 (incf *loaded*) 5 (when (< 2 *loaded*) ;; call original code, both iframes loaded 6 (main))) 7 8 (defhandler "on_comment_loaded" () 9 (incf *loaded*) 10 (when (< 2 *loaded*) ;; call original code, both iframes loaded 11 (main))) 12 13 (defun main2 () 14 (when (zerop *loaded*) 15 (incf *loaded*) 16 (wremove (wget "loading")) 17 (if window.name 18 (case window.name 19 ("Settings" 20 (load-xml "mab.glade" 21 (lambda (glade) 22 (let ((widgets (parse-glade glade))) 23 (wbuild document.document-element 24 (array (slot-value widgets "settings")))) 25 (init-settings)))) 26 ("About" 27 (load-xml "mab.glade" 28 (lambda (glade) 29 (let ((widgets (parse-glade glade))) 30 (wbuild document.document-element 31 (array (slot-value widgets "about")))) 32 #+nil(init)))) 33 ("Help" 34 (load-xml "mab.glade" 35 (lambda (glade) 36 (let ((widgets (parse-glade glade))) 37 (wbuild document.document-element 38 (array (slot-value widgets "helpWin")))) 39 #+nil(init))))) 40 (load-xml "mab.glade" 41 (lambda (glade) 42 (let ((widgets (parse-glade glade))) 43 (wbuild document.document-element 44 (array (slot-value widgets "amazWindow")))) 45 (init)))))) 46 47 (defun settings-dialog () 48 #+nil(window.open-dialog "mab.xul" "Settings" 49 "chrome,centerscreen,modal,width=440,height=300" 50 settings) 51 (window.open "mab.xul" "Settings" 52 "chrome,centerscreen,modal,width=440,height=300")) 53 54 (defun about-dialog () 55 (window.open "mab.xul" "About" 56 "chrome,centerscreen,modal,width=450,height=350")) 57 58 (defun help-dialog () 59 (window.open "mab.xul" "Help" 60 "chrome,centerscreen,resizable,width=640,height=500")) 61 62 (defun init () 63 (let ((w (wget "amazWindow")) 64 (cs (wmake w "xul:commandset" (create :id "mabCommand"))) 65 (ks (wmake w "xul:keyset")) 66 (ms (wmake cs "xul:commandset" (create :id "menubarCommand")))) 67 ;; Some buttons that have to be disabled in remote MAB 68 (wmake w "xul:broadcaster" (create :id "isSearchRunning" :disabled "true")) 69 (wmake w "xul:broadcaster" (create :id "isMabRemote" :disabled "false")) 70 ;; This invisible spacer is used to store preferences. In this way I 71 ;; can store preferences for remote and installed MAB version 72 (wmake w "xul:spacer" (create :id "settings-spacer" 73 :hidden "true" 74 :search "lite" 75 :nr-result 20 76 :persist "search nrResult")) 77 (dolist (obj (list (list "newSearchCmd" "newSearch()") 78 (list "nextCmd" "nextRecord()") 79 (list "clearCmd" "clearAll()") 80 (list "commentCmd" "getComment()") 81 (list "goAmazonCmd" "goAmazon()") 82 (list "addCartCmd" "addCart()") 83 (list "goGoogleCmd" "goGoogle()") 84 (list "deleteCmd" "deleteRow()"))) 85 (wmake cs "xul:command" (create :id (aref obj 0) 86 :oncommand (aref obj 1)))) 87 (dolist (obj (list (list "newCmd" "newDoc()") 88 (list "openCmd" "openDoc('open')" "isMabRemote") 89 (list "closeCmd" "closeDoc()") 90 (list "mergeCmd" "openDoc('merge')" "isMabRemote") 91 (list "saveCmd" "saveDoc()" "isMabRemote") 92 (list "saveAsCmd" "saveAsDoc()" "isMabRemote") 93 (list "exportXMLCmd" "exportXMLDoc()") 94 (list "exportHTMLCmd" "exportHTMLDoc()") 95 (list "exportTXTCmd" "exportTXTDoc()") 96 (list "makeCoverCmd" "openCoverWin()") 97 (list "exitCmd" "window.close()") 98 (list "simProductCmd" "getSimilarProducts()") 99 (list "reloadExpiredCmd" "reloadExpired()") 100 (list "reloadCmd" "reload()") 101 (list "abortCmd" "abort()") 102 (list "bookmarkCmd" "addBookmark()") 103 ;;(list "settingsCmd" "window.open('settings.xul','Settings','chrome,centerscreen,modal,width=440,height=300');") 104 (list "settingsCmd" "settingsDialog()") 105 ;;(list "topicsCmd" "window.open('help.xul','Help','chrome,centerscreen,resizable,width=640,height=500');") 106 (list "topicsCmd" "helpDialog()") 107 (list "feedbackCmd" "window.open(MAB_FEEDBACK_PAGE)") 108 ;;(list "aboutCmd" "window.open('about.xul','About','chrome,centerscreen,modal,width=450,height=350');"))) 109 (list "aboutCmd" "aboutDialog()"))) 110 (wmake ms "xul:command" (create :id (aref obj 0) 111 :oncommand (aref obj 1) 112 :observes (when (< 2 (length obj)) 113 (aref obj 2))))) 114 (dolist (obj (list (list "search-key" "VK_RETURN" "newSearchCmd") 115 (list "search-key" "VK_ENTER" "newSearchCmd") 116 (list "deleteKey" "VK_DELETE" "deleteCmd"))) 117 (wmake ks "xul:key" (create :id (aref obj 0) 118 :keycode (aref obj 1) 119 :command (aref obj 2)))) 120 (dolist (obj (list (list "new-key" "accel" "n" "newCmd") 121 (list "close-key" "accel" "w" "closeCmd") 122 (list "save-key" "accel" "s" "saveCmd") 123 (list "review-key" "accel" "r" "commentCmd"))) 124 (wmake ks "xul:key" (create :id (aref obj 0) 125 :modifiers (aref obj 1) 126 :key (aref obj 2) 127 :command (aref obj 3))))) 128 ;; now set up existing widgets 129 (dolist (obj (list (list "new-icon" "newCmd" "new-key") 130 (list "save-icon" "saveCmd" "save-key") 131 (list "comment-button" "commentCmd" "review-key") 132 (list "delete-btn" "deleteCmd" "delete-key") 133 (list "open-icon" "openCmd") 134 (list "reload-btn" "reloadCmd") 135 (list "clear-btn" "clearCmd") 136 ;; menuitems 137 (list "new1" "newCmd" "new-key") 138 (list "open1" "openCmd") 139 (list "merge1" "mergeCmd") 140 (list "close2" "closeCmd" "close-key") 141 (list "save1" "saveCmd" "save-key") 142 (list "save_as1" "saveAsCmd") 143 (list "export_html1" "exportHTMLCmd") 144 (list "export_xml1" "exportXMLCmd") 145 (list "quit1" "exitCmd") 146 (list "mabAddBookmark" "bookmarkCmd") 147 (list "reload1" "reloadCmd") 148 (list "load_reviews1" "commentCmd" "review-key") 149 (list "load_similar_products1" "simProductCmd") 150 (list "delete_rows1" "deleteCmd") 151 (list "text_summary1" "exportTXTCmd") 152 (list "make_cd_cover1" "makeCoverCmd") 153 (list "reload_expired1" "reloadExpiredCmd") 154 (list "trash_all1" "clearCmd") 155 (list "settings1" "settingsCmd") 156 (list "content1" "topicsCmd") 157 (list "feedback1" "feedbackCmd") 158 (list "about1" "aboutCmd") 159 ;; buttons 160 (list "search-btn" "newSearchCmd"))) 161 (let ((w (wget (aref obj 0)))) 162 (wsetp w "command" (aref obj 1)) 163 (when (< 2 (length obj)) 164 (wsetp w "key" (aref obj 2))))) 165 (dolist (obj (list (list "goAmazon-icon" "goAmazonCmd" "a") 166 (list "addCart-icon" "addCartCmd" "d") 167 (list "goGoogle-icon" "goGoogleCmd" "g") 168 (list "goAmazon-button" "goAmazonCmd" "a") 169 (list "addCart-button" "addCartCmd" "d") 170 (list "next-btn" "nextCmd" "m"))) 171 (let ((w (wget (aref obj 0)))) 172 (wsetp w "command" (aref obj 1)) 173 (wsetp w "accesskey" (aref obj 2)))) 174 (dolist (obj (list (list "none1" "setLabel('none')") 175 (list "orange1" "setLabel('Orange')") 176 (list "blue1" "setLabel('Blue')") 177 (list "green1" "setLabel('Green')") 178 (list "maroon1" "setLabel('Maroon')") 179 (list "olive1" "setLabel('Olive')") 180 (list "teal1" "setLabel('Teal')") 181 (list "purple1" "setLabel('Purple')") 182 ;; combo boxes 183 (list "locale-popup" 184 nil ;;"myProductLineController.update()" 185 "value") 186 (list "mode-popup" 187 nil ;;"myProductLineController.update()" 188 "value") 189 (list "search-popup" nil "value") 190 (list "sort-popup" nil "value"))) 191 (let ((w (wget (aref obj 0)))) 192 (when (aref obj 1) 193 ;;(alert (+ w " " (aref obj 1))) 194 (wsetp w "oncommand" (aref obj 1))) ;; oncommand 195 (when (aref obj 2) 196 (wsetp w "persist" (aref obj 2))))) 197 (dolist (obj (list "ProductName" "Author" "Manufacturer" "ReleaseDate" 198 "ListPrice" "OurPrice" "UsedPrice")) 199 (wsetp (wget obj) "class" "detail")) 200 (let ((w (wget "abort-icon"))) 201 ;;(wsetp w "oncommand" " ") ;; TODO override on_abort oncommand 202 (wsetp w "keycode" "VK_ESCAPE") 203 (wsetp w "observes" "isSearchRunning")) 204 (let ((w (wget "meter"))) 205 (wsetp w "value" 0) 206 (wsetp w "mode" "determined")) 207 ;; set disabled to false (due to some hack in original code?) 208 (dolist (n (list "isMabRemote" "search-btn")) 209 (wsetp (wget n) "disabled" "false")) 210 (dolist (n (list "locale-popup" "mode-popup" "search-popup" "sort-popup")) 211 (let ((w (wget n))) 212 ;; each menupopup/menuitem 213 (dolist (w2 (slot-value (aref w.child-nodes 0) 'child-nodes)) 214 (wsetp w2 "disabled" "false")))) 215 ;; remove dummy menu item added in glade to create windows-menu_menu 216 (wempty (wget "windows-menu_menu")) 217 ;; TODO build tree 218 (let ((w (wget "result-tree")) 219 (h (wmake w "xul:treecols"))) 220 (wsetp w "enableColumnDrag" "true") 221 (wsetp w "onselect" "showDetails()") 222 (dolist (x (list 223 (create 224 :id "expired-col" 225 :src "../skin/images/expired.png" 226 :label "Expired" 227 :fixed "true" 228 :hidden "true" 229 :persist "ordinal hidden" 230 :class "numeric treecol-image" 231 :sort-direction "normal" 232 :tooltiptext "Click to sort by expired products information" 233 :onclick "sortResult(this,'MABTSLastUpdate')") 234 (create 235 :id "status-col" 236 :src "../skin/images/status_unread.png" 237 :label "Status" 238 :fixed "true" 239 :persist "ordinal hidden" 240 :class "string treecol-image" 241 :sort-direction "normal" 242 :tooltiptext "Click to sort by read" 243 :onclick "sortResult(this,'MABStatus')") 244 (create 245 :id "name-col" 246 :label "Product Name" 247 :flex "2" 248 :persist "width ordinal" 249 :class "string" 250 :sort-direction "normal" 251 :tooltiptext "Click to sort by product name" 252 :onclick "sortResult(this,'ProductName')") 253 (create 254 :id "catalog-col" 255 :label "Catalog" 256 :flex "1" 257 :persist "width ordinal hidden" 258 :class "string" 259 :sort-direction "normal" 260 :tooltiptext "Click to sort by catalog" 261 :onclick "sortResult(this,'Catalog')") 262 (create 263 :id "locale-col" 264 :label "Country" 265 :flex "1" 266 :hidden "true" 267 :persist "width ordinal hidden" 268 :class "string" 269 :sort-direction "normal" 270 :tooltiptext "Click to sort by country" 271 :onclick "sortResult(this,'MABLocale')") 272 (create 273 :id "price-col" 274 :label "Our Price" 275 :flex "1" 276 :persist "width ordinal hidden" 277 :class "numeric" 278 :sort-direction "normal" 279 :tooltiptext "Click to sort by our Price" 280 :onclick "sortResult(this,'OurPrice')") 281 (create 282 :id "used-price-col" 283 :label "Used Price" 284 :flex "1" 285 :persist "width ordinal hidden" 286 :class "numeric" 287 :sort-direction "normal" 288 :tooltiptext "Click to sort by used Price" 289 :onclick "sortResult(this,'UsedPrice')") 290 (create 291 :id "rating-col" 292 :label "Rating" 293 :flex "1" 294 :hidden "true" 295 :persist "width ordinal hidden" 296 :class "numeric" 297 :sort-direction "normal" 298 :tooltiptext "Click to sort by customers rating" 299 :onclick "sortResult(this,'AvgCustomerRating')") 300 (create 301 :id "rank-col" 302 :label "Rank" 303 :flex "1" 304 :hidden "true" 305 :persist "width ordinal hidden" 306 :class "numeric" 307 :sort-direction "normal" 308 :tooltiptext "Click to sort by sales rank" 309 :onclick "sortResult(this,'SalesRank')") 310 (create 311 :id "released-col" 312 :label "Released" 313 :flex "1" 314 :hidden "true" 315 :persist "width ordinal hidden" 316 :class "date" 317 :sort-direction "normal" 318 :tooltiptext "Click to sort by released year" 319 :onclick "sortResult(this,'ReleaseDate')") 320 (create 321 :id "label-col" 322 :src "../skin/images/label.png" 323 :label "Label" 324 :flex "1" 325 :hidden "true" 326 :persist "width ordinal hidden" 327 :class "string treecol-image" 328 :sort-direction "normal" 329 :tooltiptext "Click to sort by your labels" 330 :onclick "sortResult(this,'MABLabel')"))) 331 (wmake h "xul:treecol" x) 332 ;; TODO splitter even for the last one??? 333 (wmake h "xul:splitter" (create :class "tree-splitter"))) 334 (wmake w "xul:treechildren" (create :id "list-tree" 335 :flex 1 336 :contextmenu "relatedcontext"))) 337 ;; fix DocOpenManager;-( 338 #+nil(setf *doc-open-manager.prototype.win-popup (wget "windows-popup_menu"))) 339 340 (defun init-settings () 341 ;; TODO 342 #+nil(let ((w (wget "settings-header"))) 343 (wadda w.parent-node 344 (wmake h "xul:dialogheader" (create :title (wgetp w "value")))) 345 (wremove w))) 346 347 (defhandler "on_domain_changed" () 348 (my-product-line-controller.update)) 349 350 (defhandler "on_catalog_changed" () 351 (my-product-line-controller.update)) 352 353 (defhandler "on_abort" () 354 ;; empty handler, handler by observes/command 355 ) 356 357 (defhandler "on_change_help_page" () 358 (let ((wframe (wget "help-iframe")) 359 (wlist (wget "help-list"))) 360 (wsetp wframe "src" (wgetp wlist.selected-item "value"))))