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

Diff of /climacs/gui.lisp

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

revision 1.170 by dmurray, Fri Aug 5 12:40:56 2005 UTC revision 1.171 by dmurray, Sat Aug 6 20:51:19 2005 UTC
# Line 66  Line 66 
66                  (make-pane 'climacs-info-pane                  (make-pane 'climacs-info-pane
67                             :master-pane extended-pane                             :master-pane extended-pane
68                             :width 900)))                             :width 900)))
69            (setf (windows *application-frame*) (list extended-pane))            (setf (windows *application-frame*) (list extended-pane)
70                    (buffers *application-frame*) (list (buffer extended-pane)))
71    
72            (vertically ()            (vertically ()
73              (scrolling ()              (scrolling ()
74                extended-pane)                extended-pane)
# Line 200  Line 202 
202            (insert-object point char))            (insert-object point char))
203          (insert-object point char))))          (insert-object point char))))
204    
205  (define-command com-self-insert ()  (define-command com-self-insert ((count 'integer))
206    (insert-character *current-gesture*))    (loop repeat count do (insert-character *current-gesture*)))
207    
208  (define-named-command com-beginning-of-line ()  (define-named-command com-beginning-of-line ()
209    (beginning-of-line (point (current-window))))    (beginning-of-line (point (current-window))))
# Line 209  Line 211 
211  (define-named-command com-end-of-line ()  (define-named-command com-end-of-line ()
212    (end-of-line (point (current-window))))    (end-of-line (point (current-window))))
213    
214  (define-named-command com-delete-object ((count 'integer :prompt "Number of Objects"))  (define-named-command com-delete-object ((count 'integer :prompt "Number of Objects")
215    (delete-range (point (current-window)) count))                                           (killp 'boolean :prompt "Kill?"))
216      (let* ((point (point (current-window)))
217             (mark (clone-mark point)))
218        (forward-object mark count)
219        (when killp
220          (kill-ring-standard-push *kill-ring*
221                                   (region-to-sequence point mark)))
222        (delete-region point mark)))
223    
224    (define-named-command com-backward-delete-object ((count 'integer :prompt "Number of Objects")
225                                                      (killp 'boolean :prompt "Kill?"))
226      (let* ((point (point (current-window)))
227             (mark (clone-mark point)))
228        (backward-object mark count)
229        (when killp
230          (kill-ring-standard-push *kill-ring*
231                                   (region-to-sequence mark point)))
232      (delete-region mark point)))
233    
234  (define-named-command com-zap-to-object ()  (define-named-command com-zap-to-object ()
235    (let* ((item (handler-case (accept 't :prompt "Zap to Object")    (let* ((item (handler-case (accept 't :prompt "Zap to Object")
# Line 238  Line 257 
257    (search-forward item-mark item)    (search-forward item-mark item)
258    (delete-range current-point (- (offset item-mark) current-offset))))    (delete-range current-point (- (offset item-mark) current-offset))))
259    
 (define-named-command com-backward-delete-object ((count 'integer :prompt "Number of Objects"))  
   (delete-range (point (current-window)) (- count)))  
   
260  (define-named-command com-transpose-objects ()  (define-named-command com-transpose-objects ()
261    (let* ((point (point (current-window))))    (let* ((point (point (current-window))))
262      (unless (beginning-of-buffer-p point)      (unless (beginning-of-buffer-p point)
# Line 311  Line 327 
327      (unless (or (eq (previous-command win) 'com-previous-line)      (unless (or (eq (previous-command win) 'com-previous-line)
328                  (eq (previous-command win) 'com-next-line))                  (eq (previous-command win) 'com-next-line))
329        (setf (slot-value win 'goal-column) (column-number point)))        (setf (slot-value win 'goal-column) (column-number point)))
330      (previous-line point (slot-value win 'goal-column) numarg)))      (if (plusp numarg)
331            (previous-line point (slot-value win 'goal-column) numarg)
332            (next-line point (slot-value win 'goal-column) (- numarg)))))
333    
334  (define-named-command com-next-line ((numarg 'integer :prompt "How many lines?"))  (define-named-command com-next-line ((numarg 'integer :prompt "How many lines?"))
335    (let* ((win (current-window))    (let* ((win (current-window))
# Line 319  Line 337 
337      (unless (or (eq (previous-command win) 'com-previous-line)      (unless (or (eq (previous-command win) 'com-previous-line)
338                  (eq (previous-command win) 'com-next-line))                  (eq (previous-command win) 'com-next-line))
339        (setf (slot-value win 'goal-column) (column-number point)))        (setf (slot-value win 'goal-column) (column-number point)))
340      (next-line point (slot-value win 'goal-column) numarg)))      (if (plusp numarg)
341            (next-line point (slot-value win 'goal-column) numarg)
342            (previous-line point (slot-value win 'goal-column) (- numarg)))))
343    
344  (define-named-command com-open-line ((numarg 'integer :prompt "How many lines?"))  (define-named-command com-open-line ((numarg 'integer :prompt "How many lines?"))
345    (open-line (point (current-window)) numarg))    (open-line (point (current-window)) numarg))
# Line 329  Line 349 
349    (let* ((pane (current-window))    (let* ((pane (current-window))
350           (point (point pane))           (point (point pane))
351           (mark (offset point)))           (mark (offset point)))
352      (cond ((or numargp (> numarg 1))      (cond ((= 0 numarg)
353               (beginning-of-line point))
354              ((< numarg 0)
355               (loop repeat (- numarg)
356                     until (beginning-of-buffer-p point)
357                     do (beginning-of-line point)
358                     until (beginning-of-buffer-p point)
359                     do (backward-object point)))
360              ((or numargp (> numarg 1))
361             (loop repeat numarg             (loop repeat numarg
362                   until (end-of-buffer-p point)                   until (end-of-buffer-p point)
363                   do (end-of-line point)                   do (end-of-line point)
# Line 348  Line 376 
376        (delete-region mark point))))        (delete-region mark point))))
377    
378  (define-named-command com-forward-word ((count 'integer :prompt "Number of words"))  (define-named-command com-forward-word ((count 'integer :prompt "Number of words"))
379    (forward-word (point (current-window)) count))    (if (plusp count)
380          (forward-word (point (current-window)) count)
381          (backward-word (point (current-window)) (- count))))
382    
383  (define-named-command com-backward-word ((count 'integer :prompt "Number of words"))  (define-named-command com-backward-word ((count 'integer :prompt "Number of words"))
384    (backward-word (point (current-window)) count))    (backward-word (point (current-window)) count))
# Line 392  Line 422 
422           (mark (mark pane)))           (mark (mark pane)))
423      (unless (eq (previous-command pane) 'com-mark-word)      (unless (eq (previous-command pane) 'com-mark-word)
424        (setf (offset mark) (offset point)))        (setf (offset mark) (offset point)))
425      (forward-word mark count)))      (if (plusp count)
426            (forward-word mark count)
427            (backward-word mark (- count)))))
428    
429  (define-named-command com-backward-delete-word ((count 'integer :prompt "Number of words"))  (define-named-command com-backward-delete-word ((count 'integer :prompt "Number of words"))
430    (backward-delete-word (point (current-window)) count))    (backward-delete-word (point (current-window)) count))
# Line 1197  as two values" Line 1229  as two values"
1229                                                  (setf (offset dabbrev-expansion-mark) offset))))                                                  (setf (offset dabbrev-expansion-mark) offset))))
1230                        (move))))))))                        (move))))))))
1231    
1232  (define-named-command com-backward-paragraph ()  (define-named-command com-backward-paragraph ((count 'integer :prompt "Number of paragraphs"))
1233    (let* ((pane (current-window))    (let* ((pane (current-window))
1234           (point (point pane))           (point (point pane))
1235           (syntax (syntax (buffer pane))))           (syntax (syntax (buffer pane))))
1236      (backward-paragraph point syntax)))      (if (plusp count)
1237            (loop repeat count do (backward-paragraph point syntax))
1238            (loop repeat (- count) do (forward-paragraph point syntax)))))
1239    
1240  (define-named-command com-forward-paragraph ()  (define-named-command com-forward-paragraph ((count 'integer :prompt "Number of paragraphs"))
1241    (let* ((pane (current-window))    (let* ((pane (current-window))
1242           (point (point pane))           (point (point pane))
1243           (syntax (syntax (buffer pane))))           (syntax (syntax (buffer pane))))
1244      (forward-paragraph point syntax)))      (if (plusp count)
1245            (loop repeat count do (forward-paragraph point syntax))
1246            (loop repeat (- count) do (backward-paragraph point syntax)))))
1247    
1248  (define-named-command com-mark-paragraph ((count 'integer :prompt "Number of paragraphs"))  (define-named-command com-mark-paragraph ((count 'integer :prompt "Number of paragraphs"))
1249    (let* ((pane (current-window))    (let* ((pane (current-window))
# Line 1216  as two values" Line 1252  as two values"
1252           (syntax (syntax (buffer pane))))           (syntax (syntax (buffer pane))))
1253      (unless (eq (previous-command pane) 'com-mark-paragraph)      (unless (eq (previous-command pane) 'com-mark-paragraph)
1254        (setf (offset mark) (offset point))        (setf (offset mark) (offset point))
1255        (backward-paragraph point syntax))        (if (plusp count)
1256      (loop repeat count do (forward-paragraph mark syntax))))            (backward-paragraph point syntax)
1257              (forward-paragraph point syntax)))
1258        (if (plusp count)
1259            (loop repeat count do (forward-paragraph mark syntax))
1260            (loop repeat (- count) do (backward-paragraph mark syntax)))))
1261    
1262  (define-named-command com-backward-sentence ()  (define-named-command com-backward-sentence ((count 'integer :prompt "Number of sentences"))
1263    (let* ((pane (current-window))    (let* ((pane (current-window))
1264           (point (point pane))           (point (point pane))
1265           (syntax (syntax (buffer pane))))           (syntax (syntax (buffer pane))))
1266      (backward-sentence point syntax)))      (if (plusp count)
1267            (loop repeat count do (backward-sentence point syntax))
1268            (loop repeat (- count) do (forward-sentence point syntax)))))
1269    
1270  (define-named-command com-forward-sentence ()  (define-named-command com-forward-sentence ((count 'integer :prompt "Number of sentences"))
1271    (let* ((pane (current-window))    (let* ((pane (current-window))
1272           (point (point pane))           (point (point pane))
1273           (syntax (syntax (buffer pane))))           (syntax (syntax (buffer pane))))
1274      (forward-sentence point syntax)))      (if (plusp count)
1275            (loop repeat count do (forward-sentence point syntax))
1276            (loop repeat (- count) do (backward-sentence point syntax)))))
1277    
1278  (defun forward-page (mark &optional (count 1))  (defun forward-page (mark &optional (count 1))
1279    (loop repeat count    (loop repeat count
# Line 1240  as two values" Line 1284  as two values"
1284  (define-named-command com-forward-page ((count 'integer :prompt "Number of pages"))  (define-named-command com-forward-page ((count 'integer :prompt "Number of pages"))
1285    (let* ((pane (current-window))    (let* ((pane (current-window))
1286           (point (point pane)))           (point (point pane)))
1287      (forward-page point count)))      (if (plusp count)
1288            (forward-page point count)
1289            (backward-page point count))))
1290    
1291  (defun backward-page (mark &optional (count 1))  (defun backward-page (mark &optional (count 1))
1292    (loop repeat count    (loop repeat count
# Line 1252  as two values" Line 1298  as two values"
1298  (define-named-command com-backward-page ((count 'integer :prompt "Number of pages"))  (define-named-command com-backward-page ((count 'integer :prompt "Number of pages"))
1299    (let* ((pane (current-window))    (let* ((pane (current-window))
1300           (point (point pane)))           (point (point pane)))
1301      (backward-page point count)))      (if (plusp count)
1302            (backward-page point count)
1303            (forward-page point count))))
1304    
1305  (define-named-command com-count-lines-page ()  (define-named-command com-count-lines-page ()
1306    (let* ((pane (current-window))    (let* ((pane (current-window))
# Line 1309  as two values" Line 1357  as two values"
1357    (asdf:operate 'asdf:load-op :climacs))    (asdf:operate 'asdf:load-op :climacs))
1358    
1359  (define-named-command com-backward-expression ((count 'integer :prompt "Number of expressions"))  (define-named-command com-backward-expression ((count 'integer :prompt "Number of expressions"))
   (declare (ignore count))  
1360    (let* ((pane (current-window))    (let* ((pane (current-window))
1361           (point (point pane))           (point (point pane))
1362           (syntax (syntax (buffer pane))))           (syntax (syntax (buffer pane))))
1363      (backward-expression point syntax)))      (if (plusp count)
1364            (loop repeat count do (backward-expression point syntax))
1365            (loop repeat (- count) do (forward-expression point syntax)))))
1366    
1367  (define-named-command com-forward-expression ((count 'integer :prompt "Number of expresssions"))  (define-named-command com-forward-expression ((count 'integer :prompt "Number of expresssions"))
   (declare (ignore count))  
1368    (let* ((pane (current-window))    (let* ((pane (current-window))
1369           (point (point pane))           (point (point pane))
1370           (syntax (syntax (buffer pane))))           (syntax (syntax (buffer pane))))
1371      (forward-expression point syntax)))      (if (plusp count)
1372            (loop repeat count do (forward-expression point syntax))
1373            (loop repeat (- count) do (backward-expression point syntax)))))
1374    
1375  (define-named-command com-mark-expression ((count 'integer :prompt "Number of expressions"))  (define-named-command com-mark-expression ((count 'integer :prompt "Number of expressions"))
   (declare (ignore count))  
1376    (let* ((pane (current-window))    (let* ((pane (current-window))
1377            (point (point pane))            (point (point pane))
1378            (mark (mark pane))            (mark (mark pane))
1379            (syntax (syntax (buffer pane))))            (syntax (syntax (buffer pane))))
1380         (unless (eq (previous-command pane) 'com-mark-expression)         (unless (eq (previous-command pane) 'com-mark-expression)
1381           (setf (offset mark) (offset point)))           (setf (offset mark) (offset point)))
1382         (forward-expression mark syntax)))         (loop repeat count do (forward-expression mark syntax))))
1383    
1384  (define-named-command com-eval-defun ()  (define-named-command com-eval-defun ()
1385    (let* ((pane (current-window))    (let* ((pane (current-window))
# Line 1338  as two values" Line 1387  as two values"
1387           (syntax (syntax (buffer pane))))           (syntax (syntax (buffer pane))))
1388      (eval-defun point syntax)))      (eval-defun point syntax)))
1389    
1390  (define-named-command com-beginning-of-definition ()  (define-named-command com-beginning-of-definition ((count 'integer :prompt "Number of definitions"))
1391    (let* ((pane (current-window))    (let* ((pane (current-window))
1392           (point (point pane))           (point (point pane))
1393           (syntax (syntax (buffer pane))))           (syntax (syntax (buffer pane))))
1394      (beginning-of-definition point syntax)))      (if (plusp count)
1395            (loop repeat count do (beginning-of-definition point syntax))
1396            (loop repeat (- count) do (end-of-definition point syntax)))))
1397    
1398  (define-named-command com-end-of-definition ()  (define-named-command com-end-of-definition ((count 'integer :prompt "Number of definitions"))
1399    (let* ((pane (current-window))    (let* ((pane (current-window))
1400           (point (point pane))           (point (point pane))
1401           (syntax (syntax (buffer pane))))           (syntax (syntax (buffer pane))))
1402      (end-of-definition point syntax)))      (if (plusp count)
1403            (loop repeat count do (end-of-definition point syntax))
1404            (loop repeat (- count) do (beginning-of-definition point syntax)))))
1405    
1406  (define-named-command com-mark-definition ()  (define-named-command com-mark-definition ()
1407    (let* ((pane (current-window))    (let* ((pane (current-window))
# Line 1409  as two values" Line 1462  as two values"
1462      (dead-escape-set-key (remove :meta gesture)  command)))      (dead-escape-set-key (remove :meta gesture)  command)))
1463    
1464  (loop for code from (char-code #\Space) to (char-code #\~)  (loop for code from (char-code #\Space) to (char-code #\~)
1465        do (global-set-key (code-char code) 'com-self-insert))        do (global-set-key (code-char code) `(com-self-insert ,*numeric-argument-marker*)))
1466    
1467  (global-set-key #\Newline 'com-self-insert)  (global-set-key #\Newline `(com-self-insert ,*numeric-argument-marker*))
1468  (global-set-key #\Tab 'com-indent-line)  (global-set-key #\Tab 'com-indent-line)
1469  (global-set-key '(#\i :control) 'com-indent-line)  (global-set-key '(#\i :control) 'com-indent-line)
1470  (global-set-key '(#\: :shift :meta) `(com-eval-expression ,*numeric-argument-p*))  (global-set-key '(#\: :shift :meta) `(com-eval-expression ,*numeric-argument-p*))
# Line 1420  as two values" Line 1473  as two values"
1473  (global-set-key '(#\b :control) `(com-backward-object ,*numeric-argument-marker*))  (global-set-key '(#\b :control) `(com-backward-object ,*numeric-argument-marker*))
1474  (global-set-key '(#\a :control) 'com-beginning-of-line)  (global-set-key '(#\a :control) 'com-beginning-of-line)
1475  (global-set-key '(#\e :control) 'com-end-of-line)  (global-set-key '(#\e :control) 'com-end-of-line)
1476  (global-set-key '(#\d :control) `(com-delete-object ,*numeric-argument-marker*))  (global-set-key '(#\d :control) `(com-delete-object ,*numeric-argument-marker* ,*numeric-argument-p*))
1477  (global-set-key '(#\p :control) `(com-previous-line ,*numeric-argument-marker*))  (global-set-key '(#\p :control) `(com-previous-line ,*numeric-argument-marker*))
1478  (global-set-key '(#\l :control) 'com-full-redisplay)  (global-set-key '(#\l :control) 'com-full-redisplay)
1479  (global-set-key '(#\n :control) `(com-next-line ,*numeric-argument-marker*))  (global-set-key '(#\n :control) `(com-next-line ,*numeric-argument-marker*))
# Line 1430  as two values" Line 1483  as two values"
1483  (global-set-key '(#\Space :control) 'com-set-mark)  (global-set-key '(#\Space :control) 'com-set-mark)
1484  (global-set-key '(#\y :control) 'com-yank)  (global-set-key '(#\y :control) 'com-yank)
1485  (global-set-key '(#\w :control) 'com-kill-region)  (global-set-key '(#\w :control) 'com-kill-region)
1486  (global-set-key '(#\e :meta) 'com-forward-sentence)  (global-set-key '(#\e :meta) `(com-forward-sentence ,*numeric-argument-marker*))
1487  (global-set-key '(#\a :meta) 'com-backward-sentence)  (global-set-key '(#\a :meta) `(com-backward-sentence ,*numeric-argument-marker*))
1488  (global-set-key '(#\@ :meta :control :shift) `(com-mark-expression ,*numeric-argument-marker*))  (global-set-key '(#\@ :meta :control :shift) `(com-mark-expression ,*numeric-argument-marker*))
1489  (global-set-key '(#\f :meta) `(com-forward-word ,*numeric-argument-marker*))  (global-set-key '(#\f :meta) `(com-forward-word ,*numeric-argument-marker*))
1490  (global-set-key '(#\b :meta) `(com-backward-word ,*numeric-argument-marker*))  (global-set-key '(#\b :meta) `(com-backward-word ,*numeric-argument-marker*))
# Line 1453  as two values" Line 1506  as two values"
1506  (global-set-key '(#\Backspace :meta) `(com-backward-kill-word ,*numeric-argument-marker*))  (global-set-key '(#\Backspace :meta) `(com-backward-kill-word ,*numeric-argument-marker*))
1507  (global-set-key '(#\@ :meta :shift) `(com-mark-word ,*numeric-argument-marker*))  (global-set-key '(#\@ :meta :shift) `(com-mark-word ,*numeric-argument-marker*))
1508  (global-set-key '(#\/ :meta) 'com-dabbrev-expand)  (global-set-key '(#\/ :meta) 'com-dabbrev-expand)
1509  (global-set-key '(#\{ :meta :shift) 'com-backward-paragraph)  (global-set-key '(#\{ :meta :shift) `(com-backward-paragraph ,*numeric-argument-marker*))
1510  (global-set-key '(#\} :meta :shift) 'com-forward-paragraph)  (global-set-key '(#\} :meta :shift) `(com-forward-paragraph ,*numeric-argument-marker*))
1511  (global-set-key '(#\h :meta) `(com-mark-paragraph ,*numeric-argument-marker*))  (global-set-key '(#\h :meta) `(com-mark-paragraph ,*numeric-argument-marker*))
1512  (global-set-key '(#\s :control) 'com-isearch-mode-forward)  (global-set-key '(#\s :control) 'com-isearch-mode-forward)
1513  (global-set-key '(#\r :control) 'com-isearch-mode-backward)  (global-set-key '(#\r :control) 'com-isearch-mode-backward)
# Line 1474  as two values" Line 1527  as two values"
1527  (global-set-key '(:next) 'com-page-down)  (global-set-key '(:next) 'com-page-down)
1528  (global-set-key '(:home :control) 'com-beginning-of-buffer)  (global-set-key '(:home :control) 'com-beginning-of-buffer)
1529  (global-set-key '(:end :control) 'com-end-of-buffer)  (global-set-key '(:end :control) 'com-end-of-buffer)
1530  (global-set-key #\Rubout `(com-delete-object ,*numeric-argument-marker*))  (global-set-key #\Rubout `(com-delete-object ,*numeric-argument-marker* ,*numeric-argument-p*))
1531  (global-set-key #\Backspace `(com-backward-delete-object ,*numeric-argument-marker*))  (global-set-key #\Backspace `(com-backward-delete-object ,*numeric-argument-marker* ,*numeric-argument-p*))
1532    
1533  (global-set-key '(:insert) 'com-toggle-overwrite-mode)  (global-set-key '(:insert) 'com-toggle-overwrite-mode)
1534  (global-set-key '(#\~ :meta :shift) 'com-not-modified)  (global-set-key '(#\~ :meta :shift) 'com-not-modified)
# Line 1483  as two values" Line 1536  as two values"
1536  (global-set-key '(#\b :control :meta) `(com-backward-expression ,*numeric-argument-marker*))  (global-set-key '(#\b :control :meta) `(com-backward-expression ,*numeric-argument-marker*))
1537  (global-set-key '(#\f :control :meta) `(com-forward-expression ,*numeric-argument-marker*))  (global-set-key '(#\f :control :meta) `(com-forward-expression ,*numeric-argument-marker*))
1538  (global-set-key '(#\x :control :meta) 'com-eval-defun)  (global-set-key '(#\x :control :meta) 'com-eval-defun)
1539  (global-set-key '(#\a :control :meta) 'com-beginning-of-definition)  (global-set-key '(#\a :control :meta) `(com-beginning-of-definition ,*numeric-argument-marker*))
1540  (global-set-key '(#\e :control :meta) 'com-end-of-definition)  (global-set-key '(#\e :control :meta) `(com-end-of-definition ,*numeric-argument-marker*))
1541  (global-set-key '(#\h :control :meta) 'com-mark-definition)  (global-set-key '(#\h :control :meta) 'com-mark-definition)
1542  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1543  ;;;  ;;;

Legend:
Removed from v.1.170  
changed lines
  Added in v.1.171

  ViewVC Help
Powered by ViewVC 1.1.5