/[eclipse]/eclipse/lib/sm/sm.lisp
ViewVC logotype

Diff of /eclipse/lib/sm/sm.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.4 by ihatchondo, Fri Mar 5 16:18:28 2004 UTC revision 1.5 by ihatchondo, Mon Mar 8 17:50:24 2004 UTC
# Line 143  Line 143 
143     `(map 'string #'code-char (buffer-read-array8 ,byte-order ,buffer ,index)))     `(map 'string #'code-char (buffer-read-array8 ,byte-order ,buffer ,index)))
144    ((string byte-order buffer index)    ((string byte-order buffer index)
145     `(buffer-write-array8     `(buffer-write-array8
146       (map 'vector #'char-code ,string) ,byte-order ,buffer ,index)))       (map 'array8 #'char-code ,string) ,byte-order ,buffer ,index)))
147    
148  (define-sequence-accessor strings string)  (define-sequence-accessor strings string)
149    
# Line 321  Line 321 
321       :initform nil :initarg :sm-vendor :type string       :initform nil :initarg :sm-vendor :type string
322       :accessor sm-vendor)       :accessor sm-vendor)
323     (sm-protocol-version     (sm-protocol-version
324       :initform nil :initarg :sm-protocol-version       :initform nil :initarg :sm-protocol-version :type card16
325       :accessor sm-protocol-version)       :accessor sm-protocol-version)
326     (sm-protocol-revision     (sm-protocol-revision
327       :initform nil :initarg :sm-protocol-revision       :initform nil :initarg :sm-protocol-revision :type card16
328       :accessor sm-protocol-revision)))       :accessor sm-protocol-revision)))
329    
330  (defun register-xsmp-protocol (opcode)  (defun register-xsmp-protocol (opcode)
# Line 390  Line 390 
390              "XSMP" (ice-connection-string sm-conn) (ice-auth-proto-names)))              "XSMP" (ice-connection-string sm-conn) (ice-auth-proto-names)))
391            (versions (make-default-versions            (versions (make-default-versions
392                          :major +sm-proto-major+ :minor +sm-proto-minor+)))                          :major +sm-proto-major+ :minor +sm-proto-minor+)))
393          (declare (type (simple-array string (*)) protocols))
394          (declare (type versions versions))
395        (post-request :protocol-setup sm-conn        (post-request :protocol-setup sm-conn
396                      :protocol-name "XSMP"                      :protocol-name "XSMP"
397                      :protocol-major-opcode +sm-proto-major+                      :protocol-major-opcode +sm-proto-major+
# Line 404  Line 406 
406        (setf (ice-error-handler sm-conn) (lambda (x) x))        (setf (ice-error-handler sm-conn) (lambda (x) x))
407        (request-case (sm-conn :timeout nil :place request :ice-flush-p nil)        (request-case (sm-conn :timeout nil :place request :ice-flush-p nil)
408          (authentication-required ((index authentication-protocol-index))          (authentication-required ((index authentication-protocol-index))
409            (let ((name (aref protocols index)))            (let ((handler (get-protocol-handler (aref protocols index))))
410              (funcall (get-protocol-handler name) sm-conn request))              (declare (type function handler))
411                (funcall handler sm-conn request))
412            (values))            (values))
413          (protocol-reply (protocol-major-opcode vendor-name release-name)          (protocol-reply (protocol-major-opcode vendor-name release-name)
414            ;; internally register the protocol.            ;; internally register the protocol.
# Line 416  Line 419 
419            ;; collect some connection infos.            ;; collect some connection infos.
420            (with-slots (version-index) request            (with-slots (version-index) request
421              (let ((version (aref versions version-index)))              (let ((version (aref versions version-index)))
422                  (declare (type version version))
423                (setf (sm-protocol-version sm-conn) (aref version 0))                (setf (sm-protocol-version sm-conn) (aref version 0))
424                (setf (sm-protocol-revision sm-conn) (aref version 1))))                (setf (sm-protocol-revision sm-conn) (aref version 1))))
425            (setf (sm-release sm-conn) release-name)            (setf (sm-release sm-conn) release-name)

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

  ViewVC Help
Powered by ViewVC 1.1.5