← Back to branch summary

~ubuntu-branches/ubuntu/quantal/texmacs/quantal

« back to all changes in this revision

Viewing changes to TeXmacs/progs/utils/library/cursor.scm

  • Committer: Bazaar Package Importer
  • Author(s): Atsuhito KOHDA, Kamaraju Kusumanchi, kohda
  • Date: 2009-04-26 19:35:14 UTC
  • mfrom: (1.1.10 upstream) (4.1.4 squeeze)
  • Revision ID: james.westby@ubuntu.com-20090426193514-9yo3oggdslgdls4b
Tags: 1:1.0.7.2-1
http://bugs.debian.org/484073
http://bugs.debian.org/497021
[Kamaraju Kusumanchi <kamaraju@gmail.com>]
* New upstream release
* texmacs crashes if /usr/share/texmacs/TeXmacs/misc/pixmaps/unknown.ps
  is not present. Do not remove it. (Closes: #484073, #497021)
* update patches 03_mupad.dpatch, 04_axiom.dpatch, 11-desktop-file.dpatch
* fix the mime problem in gnome. Thanks to Andrea Gamba for the fix.
[kohda]
* Refined a fix for the mime problem in gnome a bit.
* Try to fix /bin/sh problem (debian/fixsh) but it is not complete fix yet.
* Try to fix hard coded settings for ipa fonts(patches/09_ipa.dpatch), 
  especially for Debian where no ipa fonts exist yet.
* Fixed obsolete Build-Depends: changed libltdl3-dev to 
  libltdl-dev | libltdl7-dev (the latter for Ubuntu?)

Show diffs side-by-side

added added

removed removed

Lines of Context:
TeXmacs/progs/utils/library/cursor.scm
5
5
;; DESCRIPTION : routines for cursor movement
6
6
;; COPYRIGHT   : (C) 2002  Joris van der Hoeven
7
7
;;
8
 
;; This software falls under the GNU general public license and comes WITHOUT
9
 
;; ANY WARRANTY WHATSOEVER. See the file $TEXMACS_PATH/LICENSE for details.
10
 
;; If you don't have this file, write to the Free Software Foundation, Inc.,
11
 
;; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
8
;; This software falls under the GNU general public license version 3 or later.
 
9
;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE
 
10
;; in the root directory or <http://www.gnu.org/licenses/gpl-3.0.html>.
12
11
;;
13
12
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14
13
 
56
55
        (else (label-in-range? lab (cDr p) until))))
57
56
 
58
57
(define (check-pattern p l)
59
 
  (with t (path->tree (list-drop-right p (length l)))
60
 
    (cond ((null? l) #t)
61
 
          ((and (symbol? (car l)) (== (tm-car t) (car l)))
62
 
           (check-pattern p (cdr l)))
63
 
          ((and (number? (car l))
64
 
                (== (car l) (list-ref p (- (length p) (length l) 1))))
65
 
           (check-pattern p (cdr l)))
66
 
          (else #f))))
 
58
  (or (null? l)
 
59
      (with t (path->tree (list-drop-right p (length l)))
 
60
        (cond ((and (symbol? (car l)) (== (tm-car t) (car l)))
 
61
               (check-pattern p (cdr l)))
 
62
              ((and (procedure? (car l)) ((car l) t))
 
63
               (check-pattern p (cdr l)))
 
64
              ((and (number? (car l))
 
65
                    (== (car l) (list-ref p (- (length p) (length l) 1)))
 
66
                    (> (length p) 1))
 
67
               (check-pattern p (cdr l)))
 
68
              (else #f)))))
67
69
 
68
70
(define (innermost-pattern p l)
69
71
  (cond ((<= (length p) (length l)) #f)
74
76
  (with p (cursor-path)
75
77
    (fun)
76
78
    (let* ((q (cursor-path))
77
 
           (pp (innermost-pattern (cDr p) l))
78
 
           (qq (innermost-pattern (cDr q) l)))
79
 
      (if (== pp qq) #f
80
 
          (begin
81
 
            (go-to p)
82
 
            #t)))))
 
79
           (pp (innermost-pattern p l))
 
80
           (qq (innermost-pattern q l)))
 
81
      (if (!= pp qq) (go-to p)))))
 
82
 
 
83
(define (go-to-next-inside-sub fun l)
 
84
  (do ((p (cursor-path) (cursor-path))
 
85
       (q (begin (fun) (cursor-path)) (begin (fun) (cursor-path))))
 
86
      ((or (== p q) (innermost-pattern q l)) (noop))))
 
87
 
 
88
(tm-define (go-to-next-inside fun . l)
 
89
  (with p (cursor-path)
 
90
    (go-to-next-inside-sub fun l)
 
91
    (if (not (innermost-pattern (cursor-path) l)) (go-to p))))
83
92
 
84
93
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
85
94
;; Routines for cursor movement
98
107
 
99
108
(tm-define (go-to-next-tag lab)
100
109
  (go-to-same-buffer (lambda (t p) (path-next-tag t p lab))))
101
 
 
102
110
(tm-define (go-to-previous-tag lab)
103
111
  (go-to-same-buffer (lambda (t p) (path-previous-tag t p lab))))
 
112
(tm-define (go-to-next-tag-same-argument lab)
 
113
  (go-to-same-buffer (lambda (t p) (path-next-tag-same-argument t p lab))))
 
114
(tm-define (go-to-previous-tag-same-argument lab)
 
115
  (go-to-same-buffer (lambda (t p) (path-previous-tag-same-argument t p lab))))
104
116
 
105
117
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
106
118
;; Cursor history