/[climacs]/climacs/gui.lisp
ViewVC logotype

Diff of /climacs/gui.lisp

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

revision 1.85 by rstrandh, Wed Jan 19 14:38:47 2005 UTC revision 1.86 by mvilleneuve, Wed Jan 19 20:04:39 2005 UTC
# Line 109  Line 109 
109    (declare (ignore frame))    (declare (ignore frame))
110    (with-slots (climacs-pane) pane    (with-slots (climacs-pane) pane
111       (let* ((buf (buffer climacs-pane))       (let* ((buf (buffer climacs-pane))
112              (name-info (format nil "   ~a   ~a   Syntax: ~a ~a    ~a"              (name-info (format nil "   ~a   ~a   Syntax: ~a~a~a    ~a"
113                                 (if (needs-saving buf) "**" "--")                                 (if (needs-saving buf) "**" "--")
114                                 (name buf)                                 (name buf)
115                                 (name (syntax buf))                                 (name (syntax buf))
116                                 (if (slot-value climacs-pane 'overwrite-mode)                                 (if (slot-value climacs-pane 'overwrite-mode)
117                                     "Ovwrt"                                     " Ovwrt"
118                                     "")                                     "")
119                                   (if (auto-fill-mode buf)
120                                       " Fill"
121                                       "")
122                                 (if (recordingp *application-frame*)                                 (if (recordingp *application-frame*)
123                                     "Def"                                     "Def"
124                                     ""))))                                     ""))))
# Line 285  Line 288 
288      (setf (slot-value win 'overwrite-mode)      (setf (slot-value win 'overwrite-mode)
289            (not (slot-value win 'overwrite-mode)))))            (not (slot-value win 'overwrite-mode)))))
290    
291  (define-command com-self-insert ()  (defun insert-character (char)
292    (let* ((win (current-window))    (let* ((win (current-window))
293           (point (point win)))           (point (point win)))
294      (unless (constituentp *current-gesture*)      (unless (constituentp char)
295        (possibly-expand-abbrev point))        (possibly-expand-abbrev point))
296      (if (and (slot-value win 'overwrite-mode) (not (end-of-line-p point)))      (if (and (slot-value win 'overwrite-mode) (not (end-of-line-p point)))
297          (progn          (progn
298            (delete-range point)            (delete-range point)
299            (insert-object point *current-gesture*))            (insert-object point char))
300          (insert-object point *current-gesture*))))          (insert-object point char))))
301    
302    (define-command com-self-insert ()
303      (insert-character *current-gesture*))
304    
305    (define-command com-self-filling-insert ()
306      (let* ((pane (current-window))
307             (buffer (buffer pane)))
308        (when (auto-fill-mode buffer)
309          (let* ((fill-column (auto-fill-column buffer))
310                 (point (point pane))
311                 (offset (offset point))
312                 (tab-width (tab-space-count (stream-default-view pane)))
313                 (syntax (syntax buffer)))
314            (when (>= (buffer-display-column buffer offset tab-width)
315                      (1- (auto-fill-column buffer)))
316              (fill-line point
317                         (lambda (mark)
318                           (syntax-line-indentation mark tab-width syntax))
319                         fill-column
320                         tab-width)))))
321      (insert-character *current-gesture*))
322    
323  (define-named-command com-beginning-of-line ()  (define-named-command com-beginning-of-line ()
324    (beginning-of-line (point (current-window))))    (beginning-of-line (point (current-window))))
# Line 475  Line 499 
499  (define-named-command com-delete-indentation ()  (define-named-command com-delete-indentation ()
500    (delete-indentation (point (current-window))))    (delete-indentation (point (current-window))))
501    
502    (define-named-command com-auto-fill-mode ()
503      (let ((buffer (buffer (current-window))))
504        (setf (auto-fill-mode buffer) (not (auto-fill-mode buffer)))))
505    
506  (define-command com-extended-command ()  (define-command com-extended-command ()
507    (let ((item (accept 'command :prompt "Extended Command")))    (let ((item (accept 'command :prompt "Extended Command")))
508      (execute-frame-command *application-frame* item)))      (execute-frame-command *application-frame* item)))
# Line 938  as two values" Line 966  as two values"
966           (find :meta gesture))           (find :meta gesture))
967      (dead-escape-set-key (remove :meta gesture)  command)))      (dead-escape-set-key (remove :meta gesture)  command)))
968    
969  (loop for code from (char-code #\space) to (char-code #\~)  (loop for code from (char-code #\!) to (char-code #\~)
970        do (global-set-key (code-char code) 'com-self-insert))        do (global-set-key (code-char code) 'com-self-insert))
971    
972  (global-set-key #\newline 'com-self-insert)  (global-set-key #\Space 'com-self-filling-insert)
973  (global-set-key #\tab 'com-indent-line)  (global-set-key #\Newline 'com-self-filling-insert)
974    (global-set-key #\Tab 'com-indent-line)
975  (global-set-key '(#\j :control) 'com-newline-and-indent)  (global-set-key '(#\j :control) 'com-newline-and-indent)
976  (global-set-key '(#\f :control) `(com-forward-object ,*numeric-argument-marker*))  (global-set-key '(#\f :control) `(com-forward-object ,*numeric-argument-marker*))
977  (global-set-key '(#\b :control) `(com-backward-object ,*numeric-argument-marker*))  (global-set-key '(#\b :control) `(com-backward-object ,*numeric-argument-marker*))

Legend:
Removed from v.1.85  
changed lines
  Added in v.1.86

  ViewVC Help
Powered by ViewVC 1.1.5