/[climacs]/climacs/file-commands.lisp
ViewVC logotype

Diff of /climacs/file-commands.lisp

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

revision 1.23 by thenriksen, Tue Aug 1 16:06:37 2006 UTC revision 1.24 by thenriksen, Sun Aug 20 13:06:39 2006 UTC
# Line 24  Line 24 
24  ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,  ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25  ;;; Boston, MA  02111-1307  USA.  ;;; Boston, MA  02111-1307  USA.
26    
27  ;;; File (and buffer) commands for the Climacs editor.  ;;; File (and buffer) commands for the Climacs editor. Note that many
28    ;;; basic commands (such as Find File) are defined in ESA and made
29    ;;; available to Climacs via the ESA-IO-TABLE command table.
30    
31  (in-package :climacs-commands)  (in-package :climacs-commands)
32    
# Line 151  appropriate for the syntax of the buffer Line 153  appropriate for the syntax of the buffer
153    (update-attribute-line (buffer (current-window)))    (update-attribute-line (buffer (current-window)))
154    (evaluate-attribute-line (buffer (current-window))))    (evaluate-attribute-line (buffer (current-window))))
155    
 (define-command (com-find-file :name t :command-table buffer-table)  
     ((filepath 'pathname  
                :prompt "Find File"  
                :default (directory-of-buffer (buffer (current-window)))  
                :default-type 'pathname  
                :insert-default t))  
   "Prompt for a filename then edit that file.  
 If a buffer is already visiting that file, switch to that buffer. Does not create a file if the filename given does not name an existing file."  
   (find-file filepath))  
   
 (set-key `(com-find-file ,*unsupplied-argument-marker*)  
          'buffer-table  
          '((#\x :control) (#\f :control)))  
   
 (define-command (com-find-file-read-only :name t :command-table buffer-table)  
     ((filepath 'pathname :Prompt "Find file read only"  
                :default (directory-of-buffer (buffer (current-window)))  
                :default-type 'pathname  
                :insert-default t))  
   "Prompt for a filename then open that file readonly.  
 If a buffer is already visiting that file, switch to that buffer. If the filename given does not name an existing file, signal an error."  
   (find-file filepath t))  
   
 (set-key `(com-find-file-read-only ,*unsupplied-argument-marker*)  
          'buffer-table  
          '((#\x :control) (#\r :control)))  
   
 (define-command (com-read-only :name t :command-table buffer-table) ()  
   "Toggle the readonly status of the current buffer.  
 When a buffer is readonly, attempts to change the contents of the buffer signal an error."  
   (let ((buffer (buffer (current-window))))  
     (setf (read-only-p buffer) (not (read-only-p buffer)))))  
   
 (set-key 'com-read-only  
          'buffer-table  
          '((#\x :control) (#\q :control)))  
   
 (define-command (com-set-visited-file-name :name t :command-table buffer-table)  
     ((filename 'pathname :prompt "New file name"  
                :default (directory-of-buffer (buffer (current-window)))  
                :default-type 'pathname  
                :insert-default t))  
   "Prompt for a new filename for the current buffer.  
 The next time the buffer is saved it will be saved to a file with that filename."  
   (set-visited-file-name filename (buffer (current-window))))  
   
156  (define-command (com-insert-file :name t :command-table buffer-table)  (define-command (com-insert-file :name t :command-table buffer-table)
157      ((filename 'pathname :prompt "Insert File"      ((filename 'pathname :prompt "Insert File"
158                 :default (directory-of-buffer (buffer (current-window)))                 :default (directory-of-buffer (buffer (current-window)))
# Line 243  Signals an error if the file does not ex Line 199  Signals an error if the file does not ex
199             (display-message "No file ~A" filepath)             (display-message "No file ~A" filepath)
200             (beep))))))             (beep))))))
201    
 (define-command (com-save-buffer :name t :command-table buffer-table) ()  
   "Write the contents of the buffer to a file.  
 If there is filename associated with the buffer, write to that file, replacing its contents. If not, prompt for a filename."  
   (let ((buffer (buffer (current-window))))  
     (if (or (null (filepath buffer))  
             (needs-saving buffer))  
         (save-buffer buffer)  
         (display-message "No changes need to be saved from ~a" (name buffer)))))  
   
 (set-key 'com-save-buffer  
          'buffer-table  
          '((#\x :control) (#\s :control)))  
   
 (define-command (com-write-buffer :name t :command-table buffer-table)  
     ((filepath 'pathname :prompt "Write Buffer to File"  
                :default (directory-of-buffer (buffer (current-window)))  
                :default-type 'pathname  
                :insert-default t))  
   "Prompt for a filename and write the current buffer to it.  
 Changes the file visted by the buffer to the given file."  
   (let ((buffer (buffer (current-window))))  
     (cond  
       ((directory-pathname-p filepath)  
        (display-message "~A is a directory name." filepath))  
       (t  
        (with-open-file (stream filepath :direction :output :if-exists :supersede)  
          (output-to-stream stream buffer 0 (size buffer)))  
        (setf (filepath buffer) filepath  
              (name buffer) (filepath-filename filepath)  
              (needs-saving buffer) nil)  
        (display-message "Wrote: ~a" (filepath buffer))))))  
   
 (set-key `(com-write-buffer ,*unsupplied-argument-marker*)  
          'buffer-table  
          '((#\x :control) (#\w :control)))  
   
202  (defun load-file (file-name)  (defun load-file (file-name)
203    (cond ((directory-pathname-p file-name)    (cond ((directory-pathname-p file-name)
204           (display-message "~A is a directory name." file-name)           (display-message "~A is a directory name." file-name)
# Line 334  If the buffer needs saving, will prompt Line 254  If the buffer needs saving, will prompt
254           '((#\x :control) (#\k)))           '((#\x :control) (#\k)))
255    
256  (define-command (com-toggle-read-only :name t :command-table base-table)  (define-command (com-toggle-read-only :name t :command-table base-table)
257      ((buffer 'buffer :default (current-buffer)))      ((buffer 'buffer :default (current-buffer *application-frame*)))
258    (setf (read-only-p buffer) (not (read-only-p buffer))))    (setf (read-only-p buffer) (not (read-only-p buffer))))
259    
260  (define-presentation-to-command-translator toggle-read-only  (define-presentation-to-command-translator toggle-read-only
# Line 344  If the buffer needs saving, will prompt Line 264  If the buffer needs saving, will prompt
264    (list object))    (list object))
265    
266  (define-command (com-toggle-modified :name t :command-table base-table)  (define-command (com-toggle-modified :name t :command-table base-table)
267      ((buffer 'buffer :default (current-buffer)))      ((buffer 'buffer :default (current-buffer *application-frame*)))
268    (setf (needs-saving buffer) (not (needs-saving buffer))))    (setf (needs-saving buffer) (not (needs-saving buffer))))
269    
270  (define-presentation-to-command-translator toggle-modified  (define-presentation-to-command-translator toggle-modified

Legend:
Removed from v.1.23  
changed lines
  Added in v.1.24

  ViewVC Help
Powered by ViewVC 1.1.5