Changeset 2481

Show
Ignore:
Timestamp:
02/12/08 13:19:24 (1 year ago)
Author:
ksprotte
Message:

bos trunk-reorg compiles for the first time

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • branches/trunk-reorg/projects/bos/web/allocation-area-handlers.lisp

    r2479 r2481  
    124124              do (incf dest-y copy-height)) 
    125125        (cl-gd:draw-polygon vertices :color (elt colors 1)) 
    126         (emit-image-to-browser req cl-gd:*default-image* :png))))) 
     126        (emit-image-to-browser cl-gd:*default-image* :png))))) 
    127127 
    128128(defclass create-allocation-area-handler (admin-only-handler form-handler) 

  • branches/trunk-reorg/projects/bos/web/contract-image-handler.lisp

    r2479 r2481  
    88  (:default-initargs :class 'contract)) 
    99 
    10 (defmethod handle-object ((handler contract-image-handler) contract req) 
     10(defmethod handle-object ((handler contract-image-handler) contract) 
    1111  "Create and return a GD image of the contract.  The returned 
    1212rectangular image will have the size of the contracts' bounding box. 
    …… 
    2828            (cl-gd:do-pixels-in-row (x) 
    2929              (setf (cl-gd:raw-pixel) (aref work-array x y))))) 
    30         (emit-image-to-browser req cl-gd:*default-image* :png :cache-sticky t)))) 
     30        (emit-image-to-browser cl-gd:*default-image* :png :cache-sticky t)))) 

  • branches/trunk-reorg/projects/bos/web/map-handlers.lisp

    r2479 r2481  
    8383;;            (> changed-time (date-to-universal-time ims))) 
    8484;;        (let ((image (image-tile-image tile (apply #'parse-operations operation-strings)))) 
    85 ;;          (emit-image-to-browser req image :png 
     85;;          (emit-image-to-browser image :png 
    8686;;                                 :date changed-time 
    8787;;                                 :max-age 60) 
    …… 
    9999        (all-layer-names (mapcar #'symbol-name (image-tile-layers tile)))) 
    100100    (dolist (layer-name all-layer-names) 
    101       (when (query-param req layer-name) 
     101      (when (query-param layer-name) 
    102102        (push layer-name active-layers))) 
    103103    (or (reverse active-layers) all-layer-names))) 

  • branches/trunk-reorg/projects/bos/web/reports-xml-handler.lisp

    r2479 r2481  
    2020    year)) 
    2121 
    22 (defmethod handle ((handler reports-xml-handler) req) 
     22(defmethod handle ((handler reports-xml-handler)) 
    2323  (with-xml-response () 
    2424    (destructuring-bind (name &optional *year* &rest arguments) (decoded-handler-path handler) 

  • branches/trunk-reorg/projects/bos/web/sponsor-handlers.lisp

    r2479 r2481  
    179179    (with-bos-cms-page (:title "Saving sponsor data") 
    180180      (dolist (field-name '(full-name email password country language info-text)) 
    181         (let ((field-value (query-param req (string-downcase (symbol-name field-name))))) 
     181        (let ((field-value (query-param (string-downcase (symbol-name field-name))))) 
    182182          (when (and field-value 
    183183                     (not (equal field-value (slot-value sponsor field-name)))) 
    …… 
    186186            (html (:p "Changed " (:princ-safe (string-downcase (symbol-name field-name)))))))) 
    187187      (dolist (contract (sponsor-contracts sponsor)) 
    188         (when (and (query-param req (contract-checkbox-name contract)) 
     188        (when (and (query-param (contract-checkbox-name contract)) 
    189189                   (not (contract-paidp contract))) 
    190190          (change-slot-values contract 'paidp t) 
    …… 
    250250  ()) 
    251251 
    252 (defmethod handle ((handler m2-javascript-handler) req) 
    253   (multiple-value-bind (sponsor-id-or-x y) (parse-url req) 
     252(defmethod handle ((handler m2-javascript-handler)) 
     253  (multiple-value-bind (sponsor-id-or-x y) (parse-url) 
    254254    (let ((sponsor (cond 
    255255                     (y 

  • branches/trunk-reorg/projects/bos/web/startup.lisp

    r2385 r2481  
    4343                            :worldpay-test-mode *worldpay-test-mode*) 
    4444  (format t "~&; Starting aserve~@[ in debug mode~].~%" debug) 
    45   (force-output) 
    46   (setq *webserver* 
    47         (if debug 
    48             (progn (net.aserve::debug-on :notrap) 
    49                    (net.aserve:start :port *port* :listeners 0)) 
    50             (progn (net.aserve::debug-off :all) 
    51                    (net.aserve:start :port *port* :listeners *listeners*))))) 
     45  (force-output)   
     46  (setq hunchentoot:*catch-errors-p* (not debug)) 
     47  (hunchentoot:start-server :port *port*)) 

  • branches/trunk-reorg/projects/bos/web/webserver.lisp

    r2479 r2481  
    2323;; and change the template name according to the outcome. 
    2424 
    25 (defmethod find-template-pathname ((handler worldpay-template-handler) template-name &key request) 
     25(defmethod find-template-pathname ((Handler worldpay-template-handler) template-name) 
    2626  (cond 
    2727    ((scan #?r"(^|.*/)handle-sale" template-name) 
    28      (with-query-params (request cartId name address country transStatus lang MC_gift)       
     28     (with-query-params (cartId name address country transStatus lang MC_gift)       
    2929       (unless (website-supports-language lang) 
    3030         (setf lang *default-language*)) 
    31        (bos.m2::remember-worldpay-params cartId (all-request-params request)) 
     31       (bos.m2::remember-worldpay-params cartId (all-request-params)) 
    3232       (let ((contract (get-contract (parse-integer cartId)))) 
    3333         (sponsor-set-language (contract-sponsor contract) lang) 
    …… 
    129129 
    130130(defmethod handle ((handler statistics-handler)) 
    131   (let ((stats-name (parse-url req))) 
     131  (let ((stats-name (parse-url))) 
    132132    (cond 
    133133      (stats-name 
    …… 
    169169        (call-next-method)))) 
    170170 
    171 (defmethod authorize :after ((authorizer bos-authorizer) 
    172                              (req http-request) 
    173                              (ent net.aserve::entity)) 
    174   (let ((new-language (or (language-from-url (uri-path (hunchentoot:request-uri))) 
    175                           (query-param req "language"))) 
    176         (current-language (gethash :language (bknr-session-variables *session*)))) 
    177     (when (or (not current-language) 
    178               (and new-language 
    179                    (not (equal new-language current-language)))) 
    180       (setf (gethash :language (bknr-session-variables *session*)) 
    181             (or new-language 
    182                 (find-browser-prefered-language req) 
    183                 *default-language*))))) 
     171;; trunk-reorg adaption 
     172;; (defmethod authorize :after ((authorizer bos-authorizer) 
     173;;                           (req http-request) 
     174;;                           (ent net.aserve::entity)) 
     175;;   (let ((new-language (or (language-from-url (uri-path (hunchentoot:request-uri))) 
     176;;                        (query-param "language"))) 
     177;;      (current-language (gethash :language (bknr-session-variables *session*)))) 
     178;;     (when (or (not current-language) 
     179;;            (and new-language 
     180;;                 (not (equal new-language current-language)))) 
     181;;       (setf (gethash :language (bknr-session-variables *session*)) 
     182;;          (or new-language 
     183;;              (find-browser-prefered-language req) 
     184;;              *default-language*))))) 
    184185 
    185186(defun publish-website (&key website-directory website-url (worldpay-test-mode t) (vhosts :wild))