Changeset 8029

Timestamp:

Jan 8, 2008, 12:39:43 PM (17 years ago)

Author:

gz

Message:

Assume 1 special arg for any form starting with "with-". Remove a bunch of
now-redundant defindent's for well-behaved with-xxx forms.

Remove some unteresting #+cmu code, change #+openmcl => #+clozure in a few places.

Make alpha value be optional in gui::color-values-to-nscolor

Remove bindings-gb.lisp (moving the two bindings it contained into
bindings.lisp).

Location:

branches/event-ide/ccl/cocoa-ide

Files:

• cocoa-utils.lisp (modified) (1 diff)
• compile-hemlock.lisp (modified) (1 diff)
• hemlock/src/bindings-gb.lisp (deleted)
• hemlock/src/bindings.lisp (modified) (2 diffs)
• hemlock/src/defsyn.lisp (modified) (1 diff)
• hemlock/src/fill.lisp (modified) (1 diff)
• hemlock/src/lispmode.lisp (modified) (9 diffs)
• hemlock/src/rompsite.lisp (modified) (1 diff)

branches/event-ide/ccl/cocoa-ide/cocoa-utils.lisp

@@ -102 +102 @@
   (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 ()

branches/event-ide/ccl/cocoa-ide/compile-hemlock.lisp

@@ -89 +89 @@
     "symbol-completion"
     "bindings"
-    "bindings-gb"                       ;Gilbert's bindings
-    ))  
+    ))
 
 (defun compile-hemlock (&optional force)

branches/event-ide/ccl/cocoa-ide/hemlock/src/bindings.lisp

@@ -92 +92 @@
 (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 +193 @@
 (bind-key "Expand Dynamic Abbreviation" #k"meta-`") ;; MCL binding
 
+(bind-key "Help" #k"control-h")
 
 

branches/event-ide/ccl/cocoa-ide/hemlock/src/defsyn.lisp

@@ -65 +65 @@
 (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)

branches/event-ide/ccl/cocoa-ide/hemlock/src/fill.lisp

@@ -64 +64 @@
 (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)

branches/event-ide/ccl/cocoa-ide/hemlock/src/lispmode.lisp

@@ -818 +818 @@
   :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 +839 @@
 ;;; Hemlock forms.
 ;;; 
-(defindent "with-mark" 1)
-(defindent "with-random-typeout" 1)
-(defindent "with-pop-up-display" 1)
 (defindent "defhvar" 1)
 (defindent "hlet" 1)
@@ -841 +844 @@
 (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 +849 @@
 (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 +900 @@
 (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 +908 @@
 (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 +959 @@
 ;;; CLOS forms.
 ;;; 
-(defindent "with-slots" 1)
 (defindent "with-accessors" 2)
 (defindent "defclass" 2)
@@ -978 +970 @@
 
 ;;; Multiprocessing forms.
-(defindent "with-lock-grabbed" 1)
 (defindent "process-wait" 1)
 
@@ -1020 +1011 @@
                                  (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?

branches/event-ide/ccl/cocoa-ide/hemlock/src/rompsite.lisp

@@ -276 +276 @@
    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)))))))))))