/[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.1 by dmurray, Sat Nov 12 09:38:32 2005 UTC revision 1.2 by dmurray, Sat Jan 21 20:38:50 2006 UTC
# Line 169  Line 169 
169                   (redisplay-frame-panes *application-frame*)                   (redisplay-frame-panes *application-frame*)
170                   buffer))))))                   buffer))))))
171    
172    (defun directory-of-buffer (buffer)
173      "Extract the directory part of the filepath to the file in BUFFER.
174       If BUFFER does not have a filepath, the path to the users home
175       directory will be returned."
176      (make-pathname
177       :directory
178       (pathname-directory
179        (or (filepath buffer)
180            (user-homedir-pathname)))))
181    
182  (define-command (com-find-file :name t :command-table buffer-table) ()  (define-command (com-find-file :name t :command-table buffer-table) ()
183    (let* ((filepath (accept 'pathname :prompt "Find File")))    (let* ((filepath (accept 'pathname :prompt "Find File"
184                               :default (directory-of-buffer (buffer (current-window)))
185                               :default-type 'pathname
186                               :insert-default t)))
187      (find-file filepath)))      (find-file filepath)))
188    
189  (set-key 'com-find-file  (set-key 'com-find-file
# Line 214  Line 227 
227                       nil)))))))                       nil)))))))
228    
229  (define-command (com-find-file-read-only :name t :command-table buffer-table) ()  (define-command (com-find-file-read-only :name t :command-table buffer-table) ()
230    (let ((filepath (accept 'pathname :Prompt "Find file read only")))    (let ((filepath (accept 'pathname :Prompt "Find file read only"
231                              :default (directory-of-buffer (buffer (current-window)))
232                              :default-type 'pathname
233                              :insert-default t)))
234      (find-file-read-only filepath)))      (find-file-read-only filepath)))
235    
236  (set-key 'com-find-file-read-only  (set-key 'com-find-file-read-only
# Line 235  Line 251 
251          (needs-saving buffer) t))          (needs-saving buffer) t))
252    
253  (define-command (com-set-visited-file-name :name t :command-table buffer-table) ()  (define-command (com-set-visited-file-name :name t :command-table buffer-table) ()
254    (let ((filename (accept 'pathname :prompt "New file name")))    (let ((filename (accept 'pathname :prompt "New file name"
255                              :default (directory-of-buffer (buffer (current-window)))
256                              :default-type 'pathname
257                              :insert-default t)))
258      (set-visited-file-name filename (buffer (current-window)))))      (set-visited-file-name filename (buffer (current-window)))))
259    
260  (define-command (com-insert-file :name t :command-table buffer-table) ()  (define-command (com-insert-file :name t :command-table buffer-table) ()
261    (let ((filename (accept 'pathname :prompt "Insert File"))    (let ((filename (accept 'pathname :prompt "Insert File"
262                              :default (directory-of-buffer (buffer (current-window)))
263                              :default-type 'pathname
264                              :insert-default t))
265          (pane (current-window)))          (pane (current-window)))
266      (when (probe-file filename)      (when (probe-file filename)
267        (setf (mark pane) (clone-mark (point pane) :left))        (setf (mark pane) (clone-mark (point pane) :left))
# Line 325  Line 347 
347      (call-next-method)))      (call-next-method)))
348    
349  (define-command (com-write-buffer :name t :command-table buffer-table) ()  (define-command (com-write-buffer :name t :command-table buffer-table) ()
350    (let ((filepath (accept 'pathname :prompt "Write Buffer to File"))    (let ((filepath (accept 'pathname :prompt "Write Buffer to File"
351                              :default (directory-of-buffer (buffer (current-window)))
352                              :default-type 'pathname
353                              :insert-default t))
354          (buffer (buffer (current-window))))          (buffer (buffer (current-window))))
355      (cond      (cond
356        ((directory-pathname-p filepath)        ((directory-pathname-p filepath)

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

  ViewVC Help
Powered by ViewVC 1.1.5