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

Diff of /climacs/gui.lisp

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

revision 1.189 by dmurray, Tue Sep 13 19:38:02 2005 UTC revision 1.190 by dmurray, Tue Oct 11 21:20:52 2005 UTC
# Line 54  Line 54 
54    "If T, classic look and feel. If NIL, stripped-down look (:")    "If T, classic look and feel. If NIL, stripped-down look (:")
55    
56  ;;; Basic functionality  ;;; Basic functionality
57  (make-command-table 'base-table)  (make-command-table 'base-table :errorp nil)
58  ;;; buffers  ;;; buffers
59  (make-command-table 'buffer-table)  (make-command-table 'buffer-table :errorp nil)
60  ;;; case  ;;; case
61  (make-command-table 'case-table)  (make-command-table 'case-table :errorp nil)
62  ;;; comments  ;;; comments
63  (make-command-table 'comment-table)  (make-command-table 'comment-table :errorp nil)
64  ;;; deleting  ;;; deleting
65  (make-command-table 'deletion-table)  (make-command-table 'deletion-table :errorp nil)
66  ;;; commands used for climacs development  ;;; commands used for climacs development
67  (make-command-table 'development-table)  (make-command-table 'development-table :errorp nil)
68  ;;; editing - making changes to a buffer  ;;; editing - making changes to a buffer
69  (make-command-table 'editing-table)  (make-command-table 'editing-table :errorp nil)
70  ;;; filling  ;;; filling
71  (make-command-table 'fill-table)  (make-command-table 'fill-table :errorp nil)
72  ;;; indentation  ;;; indentation
73  (make-command-table 'indent-table)  (make-command-table 'indent-table :errorp nil)
74  ;;; information about the buffer  ;;; information about the buffer
75  (make-command-table 'info-table)  (make-command-table 'info-table :errorp nil)
76  ;;; lisp-related commands  ;;; lisp-related commands
77  (make-command-table 'lisp-table)  (make-command-table 'lisp-table :errorp nil)
78  ;;; marking things  ;;; marking things
79  (make-command-table 'marking-table)  (make-command-table 'marking-table :errorp nil)
80  ;;; moving around  ;;; moving around
81  (make-command-table 'movement-table)  (make-command-table 'movement-table :errorp nil)
82  ;;; panes  ;;; panes
83  (make-command-table 'pane-table)  (make-command-table 'pane-table :errorp nil)
84  ;;; searching  ;;; searching
85  (make-command-table 'search-table)  (make-command-table 'search-table :errorp nil)
86  ;;; self-insertion  ;;; self-insertion
87  (make-command-table 'self-insert-table)  (make-command-table 'self-insert-table :errorp nil)
88  ;;; windows  ;;; windows
89  (make-command-table 'window-table)  (make-command-table 'window-table :errorp nil)
90    
91  (define-application-frame climacs (standard-application-frame  (define-application-frame climacs (standard-application-frame
92                                     esa-frame-mixin)                                     esa-frame-mixin)
# Line 618  Line 618 
618           'movement-table           'movement-table
619           '((:left :control)))           '((:left :control)))
620    
621  (define-command (com-delete-word :name t :command-table deletion-table) ((count 'integer :prompt "Number of words"))  (define-command (com-delete-word :name t :command-table deletion-table)
622        ((count 'integer :prompt "Number of words"))
623    (delete-word (point (current-window)) count))    (delete-word (point (current-window)) count))
624    
625  (defun kill-word (mark &optional (count 1) (concatenate-p nil))  (defun kill-word (mark &optional (count 1) (concatenate-p nil))
# Line 1579  If with-scrollbars nil, omit the scrolle Line 1580  If with-scrollbars nil, omit the scrolle
1580           'window-table           'window-table
1581           '((#\x :control) (#\o)))           '((#\x :control) (#\o)))
1582    
1583    (defun click-to-offset (window x y)
1584      (with-slots (top bot) window
1585           (let ((new-x (floor x (stream-character-width window #\m)))
1586                 (new-y (floor y (stream-line-height window)))
1587                 (buffer (buffer window)))
1588             (loop for scan from (offset top)
1589                   with lines = 0
1590                   until (= scan (offset bot))
1591                   until (= lines new-y)
1592                   when (eql (buffer-object buffer scan) #\Newline)
1593                     do (incf lines)
1594                   finally (loop for columns from 0
1595                                 until (= scan (offset bot))
1596                                 until (eql (buffer-object buffer scan) #\Newline)
1597                                 until (= columns new-x)
1598                                 do (incf scan))
1599                           (return scan)))))
1600    
1601  (define-command (com-switch-to-this-window :name nil :command-table window-table)  (define-command (com-switch-to-this-window :name nil :command-table window-table)
1602      ((window 'pane) (x 'integer) (y 'integer))      ((window 'pane) (x 'integer) (y 'integer))
1603    (other-window window)    (other-window window)
1604    (with-slots (top bot) window    (when (typep window 'extended-pane)
1605       (let ((new-x (floor x (stream-character-width window #\m)))      (setf (offset (point window))
1606             (new-y (floor y (stream-line-height window)))            (click-to-offset window x y))))
            (buffer (buffer window)))  
        (loop for scan from (offset top)  
              with lines = 0  
              until (= scan (offset bot))  
              until (= lines new-y)  
              when (eql (buffer-object buffer scan) #\Newline)  
                do (incf lines)  
              finally (loop for columns from 0  
                            until (= scan (offset bot))  
                            until (eql (buffer-object buffer scan) #\Newline)  
                            until (= columns new-x)  
                            do (incf scan))  
                      (setf (offset (point window)) scan)))))  
1607    
1608  (define-presentation-to-command-translator blank-area-to-switch-to-this-window  (define-presentation-to-command-translator blank-area-to-switch-to-this-window
1609      (blank-area com-switch-to-this-window window-table :echo nil)      (blank-area com-switch-to-this-window window-table :echo nil)
1610      (object window x y)      (window x y)
1611      (list window x y))
1612    
1613    (define-gesture-name :select-other :pointer-button (:right) :unique nil)
1614    
1615    (define-command (com-mouse-save :name nil :command-table window-table)
1616        ((window 'pane) (x 'integer) (y 'integer))
1617      (when (and (typep window 'extended-pane)
1618                 (eq window (current-window)))
1619        (setf (offset (mark window))
1620              (click-to-offset window x y))
1621        (com-exchange-point-and-mark)
1622        (com-copy-region)))
1623    
1624    (define-presentation-to-command-translator blank-area-to-mouse-save
1625        (blank-area com-mouse-save window-table :echo nil :gesture :select-other)
1626        (window x y)
1627      (list window x y))
1628    
1629    (define-gesture-name :middle-button :pointer-button (:middle) :unique nil)
1630    
1631    (define-command (com-yank-here :name nil :command-table window-table)
1632        ((window 'pane) (x 'integer) (y 'integer))
1633      (when (typep window 'extended-pane)
1634        (other-window window)
1635        (setf (offset (point window))
1636              (click-to-offset window x y))
1637        (com-yank)))
1638    
1639    (define-presentation-to-command-translator blank-area-to-yank-here
1640        (blank-area com-yank-here window-table :echo nil :gesture :middle-button)
1641        (window x y)
1642    (list window x y))    (list window x y))
1643    
1644  (defun single-window ()  (defun single-window ()

Legend:
Removed from v.1.189  
changed lines
  Added in v.1.190

  ViewVC Help
Powered by ViewVC 1.1.5