Index: /branches/event-ide/ccl/cocoa-ide/cocoa-utils.lisp =================================================================== --- /branches/event-ide/ccl/cocoa-ide/cocoa-utils.lisp (revision 8028) +++ /branches/event-ide/ccl/cocoa-ide/cocoa-utils.lisp (revision 8029) @@ -102,10 +102,10 @@ (float number ccl::+cgfloat-zero+)) -(defun color-values-to-nscolor (red green blue alpha) +(defun color-values-to-nscolor (red green blue &optional alpha) (#/colorWithCalibratedRed:green:blue:alpha: ns:ns-color (cgfloat red) (cgfloat green) (cgfloat blue) - (cgfloat alpha))) + (cgfloat (or alpha 1.0)))) (defun windows () Index: /branches/event-ide/ccl/cocoa-ide/compile-hemlock.lisp =================================================================== --- /branches/event-ide/ccl/cocoa-ide/compile-hemlock.lisp (revision 8028) +++ /branches/event-ide/ccl/cocoa-ide/compile-hemlock.lisp (revision 8029) @@ -89,6 +89,5 @@ "symbol-completion" "bindings" - "bindings-gb" ;Gilbert's bindings - )) + )) (defun compile-hemlock (&optional force) Index: anches/event-ide/ccl/cocoa-ide/hemlock/src/bindings-gb.lisp =================================================================== --- /branches/event-ide/ccl/cocoa-ide/hemlock/src/bindings-gb.lisp (revision 8028) +++ (revision ) @@ -1,10 +1,0 @@ -(in-package :hemlock) - -(bind-key "Scroll Window Down" #k"pagedown") -(bind-key "Scroll Window Up" #k"pageup") -(bind-key "Undo" #k"control-\/") -(bind-key "Help" #k"control-h") - - - - Index: /branches/event-ide/ccl/cocoa-ide/hemlock/src/bindings.lisp =================================================================== --- /branches/event-ide/ccl/cocoa-ide/hemlock/src/bindings.lisp (revision 8028) +++ /branches/event-ide/ccl/cocoa-ide/hemlock/src/bindings.lisp (revision 8029) @@ -92,4 +92,5 @@ (bind-key "End of Buffer" #k"end") (bind-key "Undo" #k"control-_") +(bind-key "Undo" #k"control-\/") (bind-key "Describe Key" #k"meta-?") (bind-key "What Cursor Position" #k"control-x =") @@ -192,4 +193,5 @@ (bind-key "Expand Dynamic Abbreviation" #k"meta-`") ;; MCL binding +(bind-key "Help" #k"control-h") Index: /branches/event-ide/ccl/cocoa-ide/hemlock/src/defsyn.lisp =================================================================== --- /branches/event-ide/ccl/cocoa-ide/hemlock/src/defsyn.lisp (revision 8028) +++ /branches/event-ide/ccl/cocoa-ide/hemlock/src/defsyn.lisp (revision 8029) @@ -65,5 +65,5 @@ (setf (character-attribute :word-delimiter #+CMU #\formfeed - #+(or EXCL sbcl CLISP OpenMCL) #\page) 1) + #+(or EXCL sbcl CLISP Clozure) #\page) 1) (setf (character-attribute :word-delimiter #\tab) 1) (setf (character-attribute :word-delimiter #\newline) 1) Index: /branches/event-ide/ccl/cocoa-ide/hemlock/src/fill.lisp =================================================================== --- /branches/event-ide/ccl/cocoa-ide/hemlock/src/fill.lisp (revision 8028) +++ /branches/event-ide/ccl/cocoa-ide/hemlock/src/fill.lisp (revision 8029) @@ -64,5 +64,5 @@ (setf (character-attribute :paragraph-delimiter #\linefeed) 1) (setf (character-attribute :paragraph-delimiter - #+CMU #\formfeed #+(or sbcl EXCL CLISP OpenMCL) #\page) 1) + #+CMU #\formfeed #+(or sbcl EXCL CLISP Clozure) #\page) 1) (setf (character-attribute :paragraph-delimiter #\tab) 1) (setf (character-attribute :paragraph-delimiter #\newline) 1) Index: /branches/event-ide/ccl/cocoa-ide/hemlock/src/lispmode.lisp =================================================================== --- /branches/event-ide/ccl/cocoa-ide/hemlock/src/lispmode.lisp (revision 8028) +++ /branches/event-ide/ccl/cocoa-ide/hemlock/src/lispmode.lisp (revision 8029) @@ -818,4 +818,10 @@ :value 2) +(defhvar "Indent With-anything" + "This is the number of special arguments implicitly assumed to be supplied + in calls to functions whose names begin with \"WITH-\". If set to NIL, this + feature is disabled." + :value 1) + (defvar *special-forms* (make-hash-table :test #'equal)) @@ -833,7 +839,4 @@ ;;; Hemlock forms. ;;; -(defindent "with-mark" 1) -(defindent "with-random-typeout" 1) -(defindent "with-pop-up-display" 1) (defindent "defhvar" 1) (defindent "hlet" 1) @@ -841,6 +844,4 @@ (defindent "defattribute" 1) (defindent "command-case" 1) -(defindent "with-input-from-region" 1) -(defindent "with-output-to-mark" 1) (defindent "do-strings" 1) (defindent "save-for-undo" 1) @@ -848,7 +849,5 @@ (defindent "do-headers-buffers" 1) (defindent "do-headers-lines" 1) -(defindent "with-headers-mark" 1) (defindent "frob" 1) ;cover silly FLET and MACROLET names for Rob and Bill. -(defindent "with-writable-buffer" 1) ;;; Common Lisp forms. @@ -901,9 +900,4 @@ (defindent "unwind-protect" 1) (defindent "when" 1) -(defindent "with-input-from-string" 1) -(defindent "with-open-file" 1) -(defindent "with-open-stream" 1) -(defindent "with-output-to-string" 1) -(defindent "with-package-iterator" 1) ;;; Error/condition system forms. @@ -914,5 +908,4 @@ (defindent "restart-bind" 1) (defindent "restart-case" 1) -(defindent "with-simple-restart" 1) ;;; These are for RESTART-CASE branch formatting. (defindent "store-value" 1) @@ -966,5 +959,4 @@ ;;; CLOS forms. ;;; -(defindent "with-slots" 1) (defindent "with-accessors" 2) (defindent "defclass" 2) @@ -978,5 +970,4 @@ ;;; Multiprocessing forms. -(defindent "with-lock-grabbed" 1) (defindent "process-wait" 1) @@ -1020,5 +1011,8 @@ (and (> (length fname) 2) (string= fname "DEF" :end1 3) - (value indent-defanything))))) + (value indent-defanything)) + (and (> (length fname) 4) + (string= fname "WITH-" :end1 5) + (value indent-with-anything))))) (declare (simple-string fname)) ;; Now that we have the form name, did it have special syntax? Index: /branches/event-ide/ccl/cocoa-ide/hemlock/src/rompsite.lisp =================================================================== --- /branches/event-ide/ccl/cocoa-ide/hemlock/src/rompsite.lisp (revision 8028) +++ /branches/event-ide/ccl/cocoa-ide/hemlock/src/rompsite.lisp (revision 8029) @@ -276,35 +276,16 @@ function was defined in. If it was not defined in some file, nil is returned." - #+CMU - (flet ((frob (code) - (let ((info (kernel:%code-debug-info code))) - (when info - (let ((sources (c::debug-info-source info))) - (when sources - (let ((source (car sources))) - (when (eq (c::debug-source-from source) :file) - (c::debug-source-name source))))))))) + (flet ((true-namestring (path) (namestring (truename path)))) (typecase function - (symbol (fun-defined-from-pathname (fdefinition function))) - (kernel:byte-closure - (fun-defined-from-pathname (kernel:byte-closure-function function))) - (kernel:byte-function - (frob (c::byte-function-component function))) - (function - (frob (kernel:function-code-header (kernel:%function-self function)))) - (t nil))) - #+openmcl - (flet ((true-namestring (path) (namestring (truename path)))) - (typecase function - (function (fun-defined-from-pathname (ccl::function-name function))) - (symbol (let* ((info (ccl::%source-files function))) - (if (atom info) - (true-namestring info) - (let* ((finfo (assq 'function info))) - (when finfo - (true-namestring - (if (atom finfo) - finfo - (car finfo))))))))))) + (function (fun-defined-from-pathname (ccl:function-name function))) + (symbol (let* ((info (ccl::%source-files function))) + (if (atom info) + (true-namestring info) + (let* ((finfo (assq 'function info))) + (when finfo + (true-namestring + (if (atom finfo) + finfo + (car finfo)))))))))))