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

Contents of /climacs/file-commands.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.30 - (hide annotations)
Sat Jan 26 23:06:04 2008 UTC (6 years, 2 months ago) by thenriksen
Branch: MAIN
Changes since 1.29: +3 -1 lines
Make defaults for view-switching slightly nicer.
1 dmurray 1.1 ;;; -*- Mode: Lisp; Package: CLIMACS-GUI -*-
2    
3     ;;; (c) copyright 2004-2005 by
4     ;;; Robert Strandh (strandh@labri.fr)
5     ;;; (c) copyright 2004-2005 by
6     ;;; Elliott Johnson (ejohnson@fasl.info)
7     ;;; (c) copyright 2005 by
8     ;;; Matthieu Villeneuve (matthieu.villeneuve@free.fr)
9     ;;; (c) copyright 2005 by
10     ;;; Aleksandar Bakic (a_bakic@yahoo.com)
11    
12     ;;; This library is free software; you can redistribute it and/or
13     ;;; modify it under the terms of the GNU Library General Public
14     ;;; License as published by the Free Software Foundation; either
15     ;;; version 2 of the License, or (at your option) any later version.
16     ;;;
17     ;;; This library is distributed in the hope that it will be useful,
18     ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19     ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20     ;;; Library General Public License for more details.
21     ;;;
22     ;;; You should have received a copy of the GNU Library General Public
23     ;;; License along with this library; if not, write to the
24     ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25     ;;; Boston, MA 02111-1307 USA.
26    
27 thenriksen 1.24 ;;; 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 dmurray 1.1
31 thenriksen 1.21 (in-package :climacs-commands)
32 dmurray 1.1
33 thenriksen 1.23 (define-command (com-reparse-attribute-list :name t :command-table buffer-table)
34     ()
35 dmurray 1.12 "Reparse the current buffer's attribute list.
36     An attribute list is a line of keyword-value pairs, each keyword separated
37     from the corresponding value by a colon. If another keyword-value pair
38     follows, the value should be terminated by a colon. The attribute list
39     is surrounded by '-*-' sequences, but the opening '-*-' need not be at the
40     beginning of the line. Climacs looks for the attribute list
41     on the first or second non-blank line of the file.
42    
43     An example attribute-list is:
44    
45     ;; -*- Syntax: Lisp; Base: 10 -*- "
46 thenriksen 1.28 (evaluate-attribute-line (current-buffer)))
47 thenriksen 1.23
48     (define-command (com-update-attribute-list :name t :command-table buffer-table)
49     ()
50     "Update the current buffers attribute list to reflect the
51     settings of the syntax of the buffer.
52    
53     After the attribute list has been updated, it will also be
54     re-evaluated. An attribute list is a line of keyword-value pairs,
55     each keyword separated from the corresponding value by a
56     colon. If another keyword-value pair follows, the value should be
57     terminated by a colon. The attribute list is surrounded by '-*-'
58     sequences, but the opening '-*-' need not be at the beginning of
59     the line. Climacs looks for the attribute list on the first or
60     second non-blank line of the file.
61    
62     An example attribute-list is:
63    
64     ;; -*- Syntax: Lisp; Base: 10 -*-
65    
66     This command automatically comments the attribute line as
67     appropriate for the syntax of the buffer."
68 thenriksen 1.28 (update-attribute-line (current-buffer))
69     (evaluate-attribute-line (current-buffer)))
70 thenriksen 1.6
71 dmurray 1.16 (define-command (com-insert-file :name t :command-table buffer-table)
72     ((filename 'pathname :prompt "Insert File"
73 thenriksen 1.28 :default (directory-of-buffer (current-buffer))
74     :default-type 'pathname
75     :insert-default t))
76 dmurray 1.10 "Prompt for a filename and insert its contents at point.
77     Leaves mark after the inserted contents."
78 thenriksen 1.28 (when (probe-file filename)
79     (setf (mark) (clone-mark (point) :left))
80     (with-open-file (stream filename :direction :input)
81     (input-from-stream stream
82     (current-buffer)
83     (offset (point))))
84     (psetf (offset (mark)) (offset (point))
85     (offset (point)) (offset (mark))))
86     (redisplay-frame-panes *application-frame*))
87 dmurray 1.1
88 dmurray 1.16 (set-key `(com-insert-file ,*unsupplied-argument-marker*)
89 dmurray 1.1 'buffer-table
90     '((#\x :control) (#\i :control)))
91    
92     (define-command (com-revert-buffer :name t :command-table buffer-table) ()
93 dmurray 1.10 "Replace the contents of the current buffer with the visited file.
94     Signals an error if the file does not exist."
95 thenriksen 1.28 (let* ((save (offset (point)))
96     (filepath (filepath (current-buffer))))
97 dmurray 1.1 (when (accept 'boolean :prompt (format nil "Revert buffer from file ~A?"
98 thenriksen 1.28 filepath))
99 dmurray 1.1 (cond ((directory-pathname-p filepath)
100     (display-message "~A is a directory name." filepath)
101     (beep))
102     ((probe-file filepath)
103 thenriksen 1.28 (unless (check-file-times (current-buffer) filepath "Revert" "reverted")
104 dmurray 1.11 (return-from com-revert-buffer))
105 thenriksen 1.28 (erase-buffer (current-buffer))
106 dmurray 1.1 (with-open-file (stream filepath :direction :input)
107 thenriksen 1.28 (input-from-stream stream (current-buffer) 0))
108     (setf (offset (point)) (min (size (current-buffer)) save)
109     (file-saved-p (current-buffer)) nil))
110 dmurray 1.1 (t
111     (display-message "No file ~A" filepath)
112     (beep))))))
113    
114 thenriksen 1.22 (defun load-file (file-name)
115     (cond ((directory-pathname-p file-name)
116     (display-message "~A is a directory name." file-name)
117     (beep))
118     (t
119     (cond ((probe-file file-name)
120     (load file-name))
121     (t
122     (display-message "No such file: ~A" file-name)
123     (beep))))))
124    
125     (define-command (com-load-file :name t :command-table base-table) ()
126     "Prompt for a filename and CL:LOAD that file.
127     Signals and error if the file does not exist."
128     (let ((filepath (accept 'pathname :prompt "Load File")))
129     (load-file filepath)))
130    
131     (set-key 'com-load-file
132     'base-table
133     '((#\c :control) (#\l :control)))
134    
135     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
136     ;;;
137     ;;; Buffer commands
138    
139 thenriksen 1.29 (define-command (com-switch-to-view :name t :command-table pane-table)
140 thenriksen 1.30 ;; Perhaps the default should be an undisplayed view?
141     ((view 'view :default (or (find (current-view) (views *application-frame*)
142     :test (complement #'eq))
143 thenriksen 1.29 (any-view))))
144 thenriksen 1.22 "Prompt for a buffer name and switch to that buffer.
145 thenriksen 1.25 If the a buffer with that name does not exist, create it. Uses
146     the name of the next buffer (if any) as a default."
147 thenriksen 1.29 (handler-case (switch-to-view (current-window) view)
148     (view-already-displayed (condition)
149     (other-window (window condition)))))
150 thenriksen 1.22
151 thenriksen 1.29 (set-key `(com-switch-to-view ,*unsupplied-argument-marker*)
152 thenriksen 1.22 'pane-table
153     '((#\x :control) (#\b)))
154    
155 thenriksen 1.29 (define-command (com-kill-view :name t :command-table pane-table)
156     ((view 'view :prompt "Kill view"
157     :default (current-view)))
158     "Prompt for a view name and kill that view.
159     If the view is of a buffer and the buffer needs saving, you will
160     be prompted to do so before killing it. Uses the current view
161     as a default."
162     (kill-view view))
163 thenriksen 1.22
164 thenriksen 1.29 (set-key `(com-kill-view ,*unsupplied-argument-marker*)
165 thenriksen 1.22 'pane-table
166     '((#\x :control) (#\k)))
167    
168 thenriksen 1.25 (define-command (com-toggle-read-only :name t :command-table buffer-table)
169 thenriksen 1.24 ((buffer 'buffer :default (current-buffer *application-frame*)))
170 thenriksen 1.22 (setf (read-only-p buffer) (not (read-only-p buffer))))
171    
172     (define-presentation-to-command-translator toggle-read-only
173 thenriksen 1.25 (read-only com-toggle-read-only buffer-table
174 thenriksen 1.22 :gesture :menu)
175     (object)
176     (list object))
177    
178 thenriksen 1.25 (define-command (com-toggle-modified :name t :command-table buffer-table)
179 thenriksen 1.24 ((buffer 'buffer :default (current-buffer *application-frame*)))
180 thenriksen 1.22 (setf (needs-saving buffer) (not (needs-saving buffer))))
181    
182     (define-presentation-to-command-translator toggle-modified
183 thenriksen 1.25 (modified com-toggle-modified buffer-table
184 thenriksen 1.22 :gesture :menu)
185     (object)
186     (list object))

  ViewVC Help
Powered by ViewVC 1.1.5