/[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.27 by thenriksen, Mon Dec 18 17:54:40 2006 UTC revision 1.28 by thenriksen, Tue Nov 20 12:59:54 2007 UTC
# Line 43  on the first or second non-blank line of Line 43  on the first or second non-blank line of
43  An example attribute-list is:  An example attribute-list is:
44    
45  ;; -*- Syntax: Lisp; Base: 10 -*- "  ;; -*- Syntax: Lisp; Base: 10 -*- "
46    (evaluate-attribute-line (buffer (current-window))))    (evaluate-attribute-line (current-buffer)))
47    
48  (define-command (com-update-attribute-list :name t :command-table buffer-table)  (define-command (com-update-attribute-list :name t :command-table buffer-table)
49      ()      ()
# Line 65  An example attribute-list is: Line 65  An example attribute-list is:
65    
66  This command automatically comments the attribute line as  This command automatically comments the attribute line as
67  appropriate for the syntax of the buffer."  appropriate for the syntax of the buffer."
68    (update-attribute-line (buffer (current-window)))    (update-attribute-line (current-buffer))
69    (evaluate-attribute-line (buffer (current-window))))    (evaluate-attribute-line (current-buffer)))
70    
71  (define-command (com-insert-file :name t :command-table buffer-table)  (define-command (com-insert-file :name t :command-table buffer-table)
72      ((filename 'pathname :prompt "Insert File"      ((filename 'pathname :prompt "Insert File"
73                 :default (directory-of-buffer (buffer (current-window)))                           :default (directory-of-buffer (current-buffer))
74                 :default-type 'pathname                           :default-type 'pathname
75                 :insert-default t))                           :insert-default t))
76    "Prompt for a filename and insert its contents at point.    "Prompt for a filename and insert its contents at point.
77  Leaves mark after the inserted contents."  Leaves mark after the inserted contents."
78    (let ((pane (current-window)))    (when (probe-file filename)
79      (when (probe-file filename)      (setf (mark) (clone-mark (point) :left))
80        (setf (mark pane) (clone-mark (point pane) :left))      (with-open-file (stream filename :direction :input)
81        (with-open-file (stream filename :direction :input)        (input-from-stream stream
82          (input-from-stream stream                           (current-buffer)
83                             (buffer pane)                           (offset (point))))
84                             (offset (point pane))))      (psetf (offset (mark)) (offset (point))
85        (psetf (offset (mark pane)) (offset (point pane))             (offset (point)) (offset (mark))))
86               (offset (point pane)) (offset (mark pane))))    (redisplay-frame-panes *application-frame*))
     (redisplay-frame-panes *application-frame*)))  
87    
88  (set-key `(com-insert-file ,*unsupplied-argument-marker*)  (set-key `(com-insert-file ,*unsupplied-argument-marker*)
89           'buffer-table           'buffer-table
# Line 93  Leaves mark after the inserted contents. Line 92  Leaves mark after the inserted contents.
92  (define-command (com-revert-buffer :name t :command-table buffer-table) ()  (define-command (com-revert-buffer :name t :command-table buffer-table) ()
93    "Replace the contents of the current buffer with the visited file.    "Replace the contents of the current buffer with the visited file.
94  Signals an error if the file does not exist."  Signals an error if the file does not exist."
95    (let* ((pane (current-window))    (let* ((save (offset (point)))
96           (buffer (buffer pane))           (filepath (filepath (current-buffer))))
          (filepath (filepath buffer))  
          (save (offset (point pane))))  
97      (when (accept 'boolean :prompt (format nil "Revert buffer from file ~A?"      (when (accept 'boolean :prompt (format nil "Revert buffer from file ~A?"
98                                             (filepath buffer)))                                             filepath))
99        (cond ((directory-pathname-p filepath)        (cond ((directory-pathname-p filepath)
100             (display-message "~A is a directory name." filepath)             (display-message "~A is a directory name." filepath)
101             (beep))             (beep))
102            ((probe-file filepath)            ((probe-file filepath)
103             (unless (check-file-times buffer filepath "Revert" "reverted")             (unless (check-file-times (current-buffer) filepath "Revert" "reverted")
104               (return-from com-revert-buffer))               (return-from com-revert-buffer))
105             (erase-buffer buffer)             (erase-buffer (current-buffer))
106             (with-open-file (stream filepath :direction :input)             (with-open-file (stream filepath :direction :input)
107               (input-from-stream stream buffer 0))               (input-from-stream stream (current-buffer) 0))
108             (setf (offset (point pane)) (min (size buffer) save)             (setf (offset (point)) (min (size (current-buffer)) save)
109                   (file-saved-p buffer) nil))                   (file-saved-p (current-buffer)) nil))
110            (t            (t
111             (display-message "No file ~A" filepath)             (display-message "No file ~A" filepath)
112             (beep))))))             (beep))))))
# Line 154  the name of the next buffer (if any) as Line 151  the name of the next buffer (if any) as
151  (define-command (com-kill-buffer :name t :command-table pane-table)  (define-command (com-kill-buffer :name t :command-table pane-table)
152      ((buffer 'buffer      ((buffer 'buffer
153               :prompt "Kill buffer"               :prompt "Kill buffer"
154               :default (buffer (current-window))))               :default (current-buffer)))
155    "Prompt for a buffer name and kill that buffer.    "Prompt for a buffer name and kill that buffer.
156  If the buffer needs saving, will prompt you to do so before killing it. Uses the current buffer as a default."  If the buffer needs saving, will prompt you to do so before killing it. Uses the current buffer as a default."
157    (kill-buffer buffer))    (kill-buffer buffer))

Legend:
Removed from v.1.27  
changed lines
  Added in v.1.28

  ViewVC Help
Powered by ViewVC 1.1.5