Changeset 6572 for branches

Timestamp:

May 20, 2007, 12:49:21 AM (18 years ago)

Author:

Gary Byers

Message:

Remove some functions/other constructs that're unlikely to be used.

Location:

branches/ide-1.0/ccl/hemlock/src

Files:

• filecoms.lisp (modified) (5 diffs)
• listener.lisp (modified) (1 diff)
• macros.lisp (modified) (1 diff)

branches/ide-1.0/ccl/hemlock/src/filecoms.lisp

@@ -842 +842 @@
   (message "Buffer marked as unmodified."))
 
-(defcommand "Check Buffer Modified" (p)
-  "Say whether the buffer is modified or not."
-  "Say whether the current buffer is modified or not."
-  (declare (ignore p))
-  (clear-echo-area)
-  (message "Buffer ~S ~:[is not~;is~] modified."
-           (buffer-name (current-buffer)) (buffer-modified (current-buffer))))
+
 
 (defcommand "Set Buffer Read-Only" (p)
@@ -868 +862 @@
 
 
-;;; TODO: If this is true, it is possible to make Hemlock unusable by
-;;; killing last buffer and selecting Echo Area as the new buffer.
-(defhvar "Ask for New Buffer"
-  "If true, user is prompted for new buffer after current buffer is
-   deleted.  If false then previous buffer is selected automatically."
-  :value nil)
-
-
-(defcommand "Kill Buffer" (p &optional buffer-name)
-  "Prompts for a buffer to delete.
-  If the buffer is modified, then let the user save the file before doing so.
-  When deleting the current buffer, prompts for a new buffer to select.  If
-  a buffer other than the current one is deleted then any windows into it
-  are deleted."
-  "Delete buffer Buffer-Name, doing sensible things if the buffer is displayed
-  or current."
-  (declare (ignore p))
-  (let ((buffer (if buffer-name
-                    (getstring buffer-name *buffer-names*)
-                    (prompt-for-buffer :prompt "Kill Buffer: "
-                                       :default (current-buffer)))))
-    (unless buffer
-      (editor-error "No buffer named ~S" buffer-name))
-    (when (and (buffer-modified buffer)
-               (prompt-for-y-or-n :prompt "Save it first? "))
-      (save-file-command nil buffer))
-    (if (eq buffer (current-buffer))
-        (let* ((previous (or (previous-buffer)
-                             (editor-error "Cannot kill last buffer.")))
-               (new (if (value ask-for-new-buffer)
-                        (prompt-for-buffer
-                         :prompt "New Buffer: "
-                         :default previous
-                         :help "Buffer to change to after the current one is killed.")
-                        previous)))
-          (when (eq new buffer)
-            (editor-error "You must select a different buffer."))
-          (dolist (w (buffer-windows buffer))
-            (setf (window-buffer w) new))
-          (setf (current-buffer) new))
-        (dolist (w (buffer-windows buffer))
-          (delete-window w)))
-    (delete-buffer buffer)))
-
-
-(defcommand "Rename Buffer" (p)
-  "Change the current buffer's name.
-  The name, which is prompted for, defaults to the name of the associated
-  file."
-  "Change the name of the current buffer."
-  (declare (ignore p))
-  (let* ((buf (current-buffer))
-         (pn (buffer-pathname buf))
-         (name (if pn (pathname-to-buffer-name pn) (buffer-name buf)))
-         (new (prompt-for-string :prompt "New Name: "
-                                 :help "Give a new name for the current buffer"
-                                 :default name)))
-    (multiple-value-bind (entry foundp) (getstring new *buffer-names*)
-      (cond ((or (not foundp) (eq entry buf))
-             (setf (buffer-name buf) new))
-            (t (editor-error "Name ~S already in use." new))))))
-
-
-(defcommand "Insert Buffer" (p)
-  "Insert the contents of a buffer.
-  The name of the buffer to insert is prompted for."
-  "Prompt for a buffer to insert at the point."
-  (declare (ignore p))
-  (let ((point (current-point))
-        (region (buffer-region (prompt-for-buffer
-                                :default (previous-buffer) 
-                                :help 
-                                "Type the name of a buffer to insert."))))
-    ;;
-    ;; start and end will be deleted by undo stuff
-    (let ((save (region (copy-mark point :right-inserting)
-                        (copy-mark point :left-inserting))))
-      (push-buffer-mark (copy-mark point))
-      (insert-region point region)
-      (make-region-undo :delete "Insert Buffer" save))))
-
-
-
-
-;;;; File utility commands:
-
-(defcommand "Directory" (p)
-  "Do a directory into a pop-up window.  If an argument is supplied, then
-   dot files are listed too (as with ls -a).  Prompts for a pathname which
-   may contain wildcards in the name and type."
-  "Do a directory into a pop-up window."
-  (let* ((dpn (value pathname-defaults))
-         (pn (prompt-for-file
-              :prompt "Directory: "
-              :help "Pathname to do directory on."
-              :default (make-pathname :device (pathname-device dpn)
-                                      :directory (pathname-directory dpn))
-              :must-exist nil)))
-    (setf (value pathname-defaults) (merge-pathnames pn dpn))
-    (with-pop-up-display (s)
-      (print-directory pn s :all p))))
-
-(defcommand "Verbose Directory" (p)
-  "Do a directory into a pop-up window.  If an argument is supplied, then
-   dot files are listed too (as with ls -a).  Prompts for a pathname which
-   may contain wildcards in the name and type."
-  "Do a directory into a pop-up window."
-  (let* ((dpn (value pathname-defaults))
-         (pn (prompt-for-file
-              :prompt "Verbose Directory: "
-              :help "Pathname to do directory on."
-              :default (make-pathname :device (pathname-device dpn)
-                                      :directory (pathname-directory dpn))
-              :must-exist nil)))
-    (setf (value pathname-defaults) (merge-pathnames pn dpn))
-    (with-pop-up-display (s)
-      (print-directory pn s :verbose t :all p))))
-
-
-
-
-;;;; Change log stuff:
-
-(define-file-option "Log" (buffer value)
-  (defhvar "Log File Name"
-    "The name of the file for the change log for the file in this buffer."
-    :buffer buffer  :value value))
-
-(defhvar "Log Entry Template"
-  "The format string used to generate the template for a change-log entry.
-  Three arguments are given: the file, the date (create if available, now
-  otherwise) and the file author, or NIL if not available.  The last \"@\"
-  is deleted and the point placed where it was."
-  :value "~A, ~A, Edit by ~:[???~;~:*~:(~A~)~].~%  @~2%")
-
-(defmode "Log"
-  :major-p t
-  :setup-function
-  #'(lambda (buffer)
-      (setf (buffer-minor-mode buffer "Fill") t))
-  :cleanup-function
-  #'(lambda (buffer)
-      (setf (buffer-minor-mode buffer "Fill") nil)))
-
-(defhvar "Fill Prefix" "The fill prefix in Log mode."
-  :value "  "  :mode "Log")
-
-(define-file-type-hook ("log") (buffer type)
-  (declare (ignore type))
-  (setf (buffer-major-mode buffer) "Log"))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
 
 (defun universal-time-to-string (ut)
@@ -1029 +898 @@
             hour min sec)))
 
-(defvar *back-to-@-pattern* (new-search-pattern :character :backward #\@))
-(defcommand "Log Change" (p)
-  "Make an entry in the change-log file for this buffer.
-  Saves the file in the current buffer if it is modified, then finds the file
-  specified in the \"Log\" file option, adds the template for a change-log
-  entry at the beginning, then does a recursive edit, saving the log file on
-  exit."
-  "Find the change-log file as specified by \"Log File Name\" and edit it."
-  (declare (ignore p))
-  (unless (hemlock-bound-p 'log-file-name)
-    (editor-error "No log file defined."))
-  (let* ((buffer (current-buffer))
-         (pathname (buffer-pathname buffer)))
-    (when (or (buffer-modified buffer) (null pathname))
-      (save-file-command ()))
-    (unwind-protect
-        (progn
-          (find-file-command nil (merge-pathnames
-                                  (value log-file-name)
-                                  (buffer-default-pathname buffer)))
-          (let ((point (current-point)))
-            (buffer-start point)
-            (with-output-to-mark (s point :full)
-              (format s (value log-entry-template)
-                      (namestring pathname)
-                      (universal-time-to-string
-                       (or (file-write-date pathname)
-                           (get-universal-time)))
-                      (file-author pathname)))
-            (when (find-pattern point *back-to-@-pattern*)
-              (delete-characters point 1)))
-          (do-recursive-edit)
-          (when (buffer-modified (current-buffer)) (save-file-command ())))
-      (if (member buffer *buffer-list* :test #'eq)
-          (change-to-buffer buffer)
-          (editor-error "Old buffer has been deleted.")))))
+
 
 
@@ -1071 +905 @@
 ;;;; Window hacking commands:
 
-(defcommand "Next Window" (p)
-  "Change the current window to be the next window and the current buffer
-  to be it's buffer."
-  "Go to the next window.
-  If the next window is the bottom window then wrap around to the top window."
-  (declare (ignore p))
-  (let* ((next (next-window (current-window)))
-         (buffer (window-buffer next)))
-    (setf (current-buffer) buffer  (current-window) next)))
-
-(defcommand "Previous Window" (p)
-  "Change the current window to be the previous window and the current buffer
-  to be it's buffer."
-  "Go to the previous window.
-  If the Previous window is the top window then wrap around to the bottom."
-  (declare (ignore p))
-  (let* ((previous (previous-window (current-window)))
-         (buffer (window-buffer previous)))
-    (setf (current-buffer) buffer  (current-window) previous)))
+
 
 (defcommand "Split Window" (p)
@@ -1102 +918 @@
     (setf (current-window) new)))
 
-(defcommand "New Window" (p)
-  "Make a new window and go to it.
-   The window will display the same buffer as the current one."
-  "Create a new window which displays starting at the same place
-   as the current window."
-  (declare (ignore p))
-  (let ((new (make-window (window-display-start (current-window))
-                          :ask-user t)))
-    (unless new (editor-error "Could not make a new window."))
-    (setf (current-window) new)))
-
-(defcommand "Delete Window" (p)
-  "Delete the current window, going to the previous window."
-  "Delete the window we are in, going to the previous window."
-  (declare (ignore p))
-  (when (= (length *window-list*) 2)
-    (editor-error "Cannot delete only window."))
-  (let ((window (current-window)))
-    (previous-window-command nil)  
-    (delete-window window)))
-
-(defcommand "Line to Top of Window" (p)
-  "Move current line to top of window."
-  "Move current line to top of window."
-  (declare (ignore p))
-  (with-mark ((mark (current-point)))
-    (move-mark (window-display-start (current-window)) (line-start mark))))
-
-(defcommand "Delete Next Window" (p)
-  "Deletes the next window on display."
-  "Deletes then next window on display."
-  (declare (ignore p))
-  (if (<= (length *window-list*) 2)
-      (editor-error "Cannot delete only window")
-      (delete-window (next-window (current-window)))))
-
-(defcommand "Go to One Window" (p)
-  "Deletes all windows leaving one with the \"Default Initial Window X\",
-   \"Default Initial Window Y\", \"Default Initial Window Width\", and
-   \"Default Initial Window Height\"."
-  "Deletes all windows leaving one with the \"Default Initial Window X\",
-   \"Default Initial Window Y\", \"Default Initial Window Width\", and
-   \"Default Initial Window Height\"."
-  (declare (ignore p))
-  (let ((win (make-window (window-display-start (current-window))
-                          :ask-user t
-                          :x (value default-initial-window-x)
-                          :y (value default-initial-window-y)
-                          :width (value default-initial-window-width)
-                          :height (value default-initial-window-height))))
-    (setf (current-window) win)
-    (dolist (w *window-list*)
-      (unless (or (eq w win)
-                  (eq w *echo-area-window*))
-        (delete-window w)))))
-
-(defcommand "Line to Center of Window" (p)
-  "Moves current line to the center of the window."
-  "Moves current line to the center of the window."
-  (declare (ignore p))
-  (center-window (current-window) (current-point)))
+
+
+
+
+

branches/ide-1.0/ccl/hemlock/src/listener.lisp

@@ -667 +667 @@
                  (in-lisp (compile-file (namestring pn) #+cmu :error-file #+cmu nil))))))))
 
-(defcommand "Editor Compile Group" (p)
-  "Compile each file in the current group which needs it in the editor Lisp.
-   If a file has type LISP and there is a curresponding file with type
-   FASL which has been written less recently (or it doesn't exit), then
-   the file is compiled, with error output directed to the \"Compiler Warnings\"
-   buffer.  If a prefix argument is provided, then all the files are compiled.
-   All modified files are saved beforehand."
-  "Do a Compile-File in each file in the current group that seems to need it
-   in the editor Lisp."
-  (save-all-files-command ())
-  (unless *active-file-group* (editor-error "No active file group."))
-  (dolist (file *active-file-group*)
-    (when (string-equal (pathname-type file) "lisp")
-      (let ((tn (probe-file file)))
-        (cond ((not tn)
-               (message "File ~A not found." (namestring file)))
-              ((older-or-non-existent-fasl-p tn p)
-               (with-output-to-window (*error-output* "Compiler Warnings")
-                 (in-lisp (compile-file (namestring tn) #+cmu :error-file #+cmu nil)))))))))
-
-(defcommand "List Compile Group" (p)
-  "List any files that would be compiled by \"Compile Group\".  All Modified
-   files are saved before checking to generate a consistent list."
-  "Do a Compile-File in each file in the current group that seems to need it."
-  (declare (ignore p))
-  (save-all-files-command ())
-  (unless *active-file-group* (editor-error "No active file group."))
-  (with-pop-up-display (s)
-    (write-line "\"Compile Group\" would compile the following files:" s)
-    (force-output s)
-    (dolist (file *active-file-group*)
-      (when (string-equal (pathname-type file) "lisp")
-        (let ((tn (probe-file file)))
-          (cond ((not tn)
-                 (format s "File ~A not found.~%" (namestring file)))
-                ((older-or-non-existent-fasl-p tn)
-                 (write-line (namestring tn) s)))
-          (force-output s))))))
-
-(defhvar "Load Pathname Defaults"
-  "The default pathname used by the load command.")
-
-(defcommand "Editor Load File" (p)
-  "Prompt for a file to load into Editor Lisp."
-  "Prompt for a file to load into the Editor Lisp."
-  (declare (ignore p))
-  (let ((name (truename (prompt-for-file
-                         :default
-                         (or (value load-pathname-defaults)
-                             (buffer-default-pathname (current-buffer)))
-                         :prompt "Editor file to load: "
-                         :help "The name of the file to load"))))
-    (setv load-pathname-defaults name)
-    (in-lisp (load name))))
+
+
+
 
 

branches/ide-1.0/ccl/hemlock/src/macros.lisp

@@ -318 +318 @@
 |#
 
-(defmacro use-buffer (buffer &body forms)
-  "Use-Buffer Buffer {Form}*
-  Has The effect of making Buffer the current buffer during the evaluation
-  of the Forms.  For restrictions see the manual."
-  (let ((gensym (gensym)))
-    `(let ((,gensym *current-buffer*)
-           (*current-buffer* ,buffer))
-       (unwind-protect
-        (progn
-         (use-buffer-set-up ,gensym)
-         ,@forms)
-        (use-buffer-clean-up ,gensym)))))
+