1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
|
;;; $Id: emacspeak-tabulate.el,v 7.0 1997/11/13 15:32:30 raman Exp $
;;; $Author: raman $
;;; Description: Utility to help emacspeak identify tabulated information
;;; Keywords: Emacspeak, Tabulated Data, Visual layout gives structure
;;{{{ LCD Archive entry:
;;; LCD Archive Entry:
;;; emacspeak| T. V. Raman |raman@adobe.com
;;; A speech interface to Emacs |
;;; $Date: 1997/11/13 15:32:30 $ |
;;; $Revision: 7.0 $ |
;;; Location undetermined
;;;
;;}}}
;;{{{ Copyright:
;;;Copyright (C) 1995, 1996, 1997 T. V. Raman Adobe Systems Incorporated
;;; Copyright (c) 1994, 1995 by Digital Equipment Corporation.
;;; All Rights Reserved.
;;;
;;; This file is not part of GNU Emacs, but the same permissions apply.
;;;
;;; GNU Emacs is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;;
;;; GNU Emacs is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Emacs; see the file COPYING. If not, write to
;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;}}}
(require 'cl)
(declaim (optimize (safety 0) (speed 3)))
(require 'emacspeak-speak)
;;{{{ Introduction:
;;; This module is a simple table recognizer.
;;; Can recognize the columns in tabulated output, e.g. ps, ls output
;;}}}
;;{{{ helper functions:
;;; An interval is a cons of start and end
(defsubst ems-make-interval (start end ) (cons start end ))
(defsubst ems-interval-start (interval) (car interval ))
(defsubst ems-interval-end (interval) (cdr interval ))
(defsubst ems-intersect-intervals (i1 i2)
(let ((i (cons (max (ems-interval-start i1)
(ems-interval-start i2))
(min (ems-interval-end i1)
(ems-interval-end i2 )))))
(if (< (car i) (cdr i)) i nil )))
;;}}}
;;{{{ Identify the fields in a region
(defun ems-tabulate-field-separators-in-this-line ()
"Returns a list of intervals specifying the field separators on the line.
Fields are assumed to be delimited by whitespace. "
(let ((positions nil )
(end nil)
(first nil)
(last nil)
(continue t))
(save-excursion
(end-of-line)
(setq end (point ))
(beginning-of-line)
(save-restriction
(narrow-to-region (point) end)
(skip-syntax-forward " ")
(while (and continue
(<= (point) end ))
;skip field
(unless (zerop (skip-syntax-forward "^ "))
(setq first (current-column )))
;skip field separator
(unless (zerop (skip-syntax-forward " "))
(setq last (current-column)))
;check if we found a field separator
(cond
((and first
last
(< first last))
(push (ems-make-interval first last ) positions))
(t (setq continue nil)))
;reset fornext iteration
(setq first nil
last nil )))
(nreverse positions ))))
(defun ems-tabulate-field-separators-in-region (start end )
"Return a list of column separators. "
(when (< end start )
(let ((tmp end))
(setq end start
start tmp )))
(save-restriction
(narrow-to-region start end )
(save-excursion
(goto-char start )
(let ((try nil)
(first nil)
(last nil)
(interval nil)
(new-guesses nil)
(guesses (ems-tabulate-field-separators-in-this-line )))
(while (and guesses
(< (point) end)
(not (= 1 (forward-line 1))))
(setq try guesses)
(while try
(beginning-of-line )
(goto-char (+ (point ) (ems-interval-start (car try ))))
(skip-syntax-forward "^ ")
(setq first (current-column))
(skip-syntax-forward " ")
(setq last (current-column ))
(setq interval
(ems-intersect-intervals (car try)
(ems-make-interval first last )))
(when interval (push interval new-guesses))
(pop try )
(setq first nil
last nil
interval nil ))
(end-of-line)
(setf guesses (nreverse new-guesses)
new-guesses nil))
guesses ))))
(defsubst ems-tabulate-process-column (tl tr br bl mark-headers start)
(let ((header ( buffer-substring tl tr))
(personality-table (emacspeak-possible-voices)))
(emacspeak-voicify-rectangle
tl br
(read (completing-read
(format "Personality for column %s from %s through %s"
header (- tl start) (- tr start))
personality-table nil t )))
(and mark-headers
(emacspeak-put-text-property-on-rectangle
tl br
'field-name header ))))
;;; White space contains a list of intervals giving position of inter
;;; columnal space. All calculations are done in terms of buffer
;;; position.
;;; Invariants: (= (- tl tr) (- bl br))
;;; tl = start for first column
;;; br = end for last column
(defun emacspeak-tabulate-region (start end &optional mark-fields)
"Voicifies the white-space of a table if one found. Optional interactive prefix
arg mark-fields specifies if the header row information is used to mark fields
in the white-space."
(interactive "r\nP")
(let ((white-space (ems-tabulate-field-separators-in-region start end ))
(dtk-stop-immediately nil)
(width nil)
(tl nil)
(tr nil)
(br nil)
(bl nil))
(ems-modify-buffer-safely
(progn
(message "Detected %s rows and %s columns."
(count-lines start end)
(+ 1 (length white-space )))
(sit-for 1.5)
(save-excursion
(goto-char end)
(beginning-of-line)
(setq bl (point))
(setq tl start )
;(goto-char tl )
(setq width (ems-interval-start (car white-space)))
(setq tr (+ tl width)
br (+ bl width))
(ems-tabulate-process-column tl tr br bl mark-fields start)
(while white-space
;move to beginning of next column
(goto-char (+ start (ems-interval-end (car white-space))))
(setq tl (point))
; width of space between columns
(setq width (- tl tr))
(setq bl (+ br width))
(setq white-space (cdr white-space))
;Now detect right edges of this column
(cond
(white-space
;white-space holds column positions, not buffer positions
(setq width (- (ems-interval-start (car white-space ))
(- tl start)))
(setq tr (+ tl width)
br (+ bl width)))
(t (goto-char start)
(end-of-line)
(setq tr (point)
br end)))
(ems-tabulate-process-column tl tr br bl
mark-fields start)))))))
;;}}}
;;{{{ Parse a region of tabular data
(defun ems-tabulate-parse-region (start end)
"Parse region as tabular data and return a vector of vectors"
(let ((table nil)
(col-start start)
(col-end nil)
(j 0)
(left-edge nil)
(row-vector nil)
(white-space (ems-tabulate-field-separators-in-region start
end))
(separators nil)
(row-count (count-lines start end))
(column-count nil)
(element nil))
(setq column-count (1+ (length white-space)))
(setq table (make-vector row-count nil))
(save-excursion
(goto-char start)
(loop for
i from 0 to (1- row-count)
do
(setq row-vector (make-vector column-count nil))
(setq separators white-space)
(beginning-of-line)
(setq col-start (point))
(setq left-edge col-start)
(setq col-end
(+ left-edge (ems-interval-start (car separators))))
(setq element (buffer-substring col-start col-end))
(aset row-vector j element)
(incf j)
(while separators
(setq col-start
(+ left-edge (ems-interval-end (car separators))))
(setq separators (cdr separators))
(setq col-end
(if separators
(+ left-edge (ems-interval-start (car separators)))
(progn (end-of-line) (point))))
(setq element (buffer-substring col-start col-end))
(aset row-vector j element)
(incf j))
(setq j 0)
(aset table i row-vector)
(forward-line 1)))
table))
;;}}}
(provide 'emacspeak-tabulate)
;;{{{ emacs local variables
;;; local variables:
;;; folded-file: t
;;; end:
;;}}}
|
