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

Contents of /climacs/file-commands.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.27 - (hide annotations)
Mon Dec 18 17:54:40 2006 UTC (7 years, 4 months ago) by thenriksen
Branch: MAIN
Changes since 1.26: +0 -85 lines
These definitions are not necessary anymore (and haven't been for
quite a while).
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.23 (evaluate-attribute-line (buffer (current-window))))
47    
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     (update-attribute-line (buffer (current-window)))
69     (evaluate-attribute-line (buffer (current-window))))
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     :default (directory-of-buffer (buffer (current-window)))
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 dmurray 1.16 (let ((pane (current-window)))
79 dmurray 1.1 (when (probe-file filename)
80     (setf (mark pane) (clone-mark (point pane) :left))
81     (with-open-file (stream filename :direction :input)
82     (input-from-stream stream
83     (buffer pane)
84     (offset (point pane))))
85     (psetf (offset (mark pane)) (offset (point pane))
86     (offset (point pane)) (offset (mark pane))))
87     (redisplay-frame-panes *application-frame*)))
88    
89 dmurray 1.16 (set-key `(com-insert-file ,*unsupplied-argument-marker*)
90 dmurray 1.1 'buffer-table
91     '((#\x :control) (#\i :control)))
92    
93     (define-command (com-revert-buffer :name t :command-table buffer-table) ()
94 dmurray 1.10 "Replace the contents of the current buffer with the visited file.
95     Signals an error if the file does not exist."
96 dmurray 1.1 (let* ((pane (current-window))
97     (buffer (buffer pane))
98     (filepath (filepath buffer))
99     (save (offset (point pane))))
100     (when (accept 'boolean :prompt (format nil "Revert buffer from file ~A?"
101     (filepath buffer)))
102     (cond ((directory-pathname-p filepath)
103     (display-message "~A is a directory name." filepath)
104     (beep))
105     ((probe-file filepath)
106 dmurray 1.11 (unless (check-file-times buffer filepath "Revert" "reverted")
107     (return-from com-revert-buffer))
108 dmurray 1.1 (erase-buffer buffer)
109     (with-open-file (stream filepath :direction :input)
110     (input-from-stream stream buffer 0))
111 dmurray 1.11 (setf (offset (point pane)) (min (size buffer) save)
112     (file-saved-p buffer) nil))
113 dmurray 1.1 (t
114     (display-message "No file ~A" filepath)
115     (beep))))))
116    
117 thenriksen 1.22 (defun load-file (file-name)
118     (cond ((directory-pathname-p file-name)
119     (display-message "~A is a directory name." file-name)
120     (beep))
121     (t
122     (cond ((probe-file file-name)
123     (load file-name))
124     (t
125     (display-message "No such file: ~A" file-name)
126     (beep))))))
127    
128     (define-command (com-load-file :name t :command-table base-table) ()
129     "Prompt for a filename and CL:LOAD that file.
130     Signals and error if the file does not exist."
131     (let ((filepath (accept 'pathname :prompt "Load File")))
132     (load-file filepath)))
133    
134     (set-key 'com-load-file
135     'base-table
136     '((#\c :control) (#\l :control)))
137    
138     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
139     ;;;
140     ;;; Buffer commands
141    
142 thenriksen 1.25 (define-command (com-switch-to-buffer :name t :command-table pane-table)
143     ((buffer 'buffer :default (or (second (buffers *application-frame*))
144     (any-buffer))))
145 thenriksen 1.22 "Prompt for a buffer name and switch to that buffer.
146 thenriksen 1.25 If the a buffer with that name does not exist, create it. Uses
147     the name of the next buffer (if any) as a default."
148     (switch-to-buffer (current-window) buffer))
149 thenriksen 1.22
150 thenriksen 1.25 (set-key `(com-switch-to-buffer ,*unsupplied-argument-marker*)
151 thenriksen 1.22 'pane-table
152     '((#\x :control) (#\b)))
153    
154     (define-command (com-kill-buffer :name t :command-table pane-table)
155     ((buffer 'buffer
156     :prompt "Kill buffer"
157 thenriksen 1.25 :default (buffer (current-window))))
158 thenriksen 1.22 "Prompt for a buffer name and kill that buffer.
159     If the buffer needs saving, will prompt you to do so before killing it. Uses the current buffer as a default."
160     (kill-buffer buffer))
161    
162     (set-key `(com-kill-buffer ,*unsupplied-argument-marker*)
163     'pane-table
164     '((#\x :control) (#\k)))
165    
166 thenriksen 1.25 (define-command (com-toggle-read-only :name t :command-table buffer-table)
167 thenriksen 1.24 ((buffer 'buffer :default (current-buffer *application-frame*)))
168 thenriksen 1.22 (setf (read-only-p buffer) (not (read-only-p buffer))))
169    
170     (define-presentation-to-command-translator toggle-read-only
171 thenriksen 1.25 (read-only com-toggle-read-only buffer-table
172 thenriksen 1.22 :gesture :menu)
173     (object)
174     (list object))
175    
176 thenriksen 1.25 (define-command (com-toggle-modified :name t :command-table buffer-table)
177 thenriksen 1.24 ((buffer 'buffer :default (current-buffer *application-frame*)))
178 thenriksen 1.22 (setf (needs-saving buffer) (not (needs-saving buffer))))
179    
180     (define-presentation-to-command-translator toggle-modified
181 thenriksen 1.25 (modified com-toggle-modified buffer-table
182 thenriksen 1.22 :gesture :menu)
183     (object)
184     (list object))

  ViewVC Help
Powered by ViewVC 1.1.5