Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-misc.el @ 76:c0c698873ce1 r20-0b33

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b33
author cvs
date Mon, 13 Aug 2007 09:05:10 +0200
parents 131b0175ea99
children 0d2f883870bc
comparison
equal deleted inserted replaced
75:a4e0195b387b 76:c0c698873ce1
68 ((= char ?,) 68 ((= char ?,)
69 (setq s (buffer-substring start (point))) 69 (setq s (buffer-substring start (point)))
70 (if (or (null (string-match "^[\t\f\n\r ]+$" s)) 70 (if (or (null (string-match "^[\t\f\n\r ]+$" s))
71 (not (string= s ""))) 71 (not (string= s "")))
72 (setq list (cons s list))) 72 (setq list (cons s list)))
73 (forward-char 1) 73 (skip-chars-forward ",\t\f\n\r ")
74 (skip-chars-forward "\t\f\n\r ")
75 (setq start (point))) 74 (setq start (point)))
76 ((= char ?\") 75 ((= char ?\")
77 (forward-char 1)
78 (re-search-forward "[^\\]\"" nil 0)) 76 (re-search-forward "[^\\]\"" nil 0))
79 ((= char ?\() 77 ((= char ?\()
80 (let ((parens 1)) 78 (let ((parens 1))
81 (forward-char 1) 79 (forward-char 1)
82 (while (and (not (eobp)) (not (zerop parens))) 80 (while (and (not (eobp)) (not (zerop parens)))
83 (re-search-forward "[^\\][()]" nil 0) 81 (re-search-forward "[()]" nil 0)
84 (cond ((eobp)) 82 (cond ((or (eobp)
83 (= (char-after (- (point) 2)) ?\\)))
85 ((= (preceding-char) ?\() 84 ((= (preceding-char) ?\()
86 (setq parens (1+ parens))) 85 (setq parens (1+ parens)))
87 ((= (preceding-char) ?\)) 86 (t
88 (setq parens (1- parens))))))))) 87 (setq parens (1- parens)))))))))
89 (setq s (buffer-substring start (point))) 88 (setq s (buffer-substring start (point)))
90 (if (and (null (string-match "^[\t\f\n\r ]+$" s)) 89 (if (and (null (string-match "^[\t\f\n\r ]+$" s))
91 (not (string= s ""))) 90 (not (string= s "")))
92 (setq list (cons s list))) 91 (setq list (cons s list)))
138 137
139 (defmacro vm-error-if-folder-read-only () 138 (defmacro vm-error-if-folder-read-only ()
140 '(while vm-folder-read-only 139 '(while vm-folder-read-only
141 (signal 'folder-read-only (list (current-buffer))))) 140 (signal 'folder-read-only (list (current-buffer)))))
142 141
143 ;; XEmacs change 142 (put 'folder-read-only 'error-conditions '(folder-read-only error))
144 (define-error 'folder-read-only "Folder is read-only") 143 (put 'folder-read-only 'error-message "Folder is read-only")
145 144
146 (defmacro vm-error-if-virtual-folder () 145 (defmacro vm-error-if-virtual-folder ()
147 '(and (eq major-mode 'vm-virtual-mode) 146 '(and (eq major-mode 'vm-virtual-mode)
148 (error "%s cannot be applied to virtual folders." this-command))) 147 (error "%s cannot be applied to virtual folders." this-command)))
149 148
290 (let ((values (mapcar 'symbol-value variables))) 289 (let ((values (mapcar 'symbol-value variables)))
291 (save-excursion 290 (save-excursion
292 (set-buffer buffer) 291 (set-buffer buffer)
293 (vm-mapc 'set variables values)))) 292 (vm-mapc 'set variables values))))
294 293
295 ;; XEmacs change 294 (put 'folder-empty 'error-conditions '(folder-empty error))
296 (define-error 'folder-empty "Folder is empty") 295 (put 'folder-empty 'error-message "Folder is empty")
297 (define-error 'unrecognized-folder-type "Unrecognized folder type") 296 (put 'unrecognized-folder-type 'error-conditions
297 '(unrecognized-folder-type error))
298 (put 'unrecognized-folder-type 'error-message "Unrecognized folder type")
298 299
299 (defun vm-error-if-folder-empty () 300 (defun vm-error-if-folder-empty ()
300 (while (null vm-message-list) 301 (while (null vm-message-list)
301 (if vm-folder-type 302 (if vm-folder-type
302 (signal 'unrecognized-folder-type nil) 303 (signal 'unrecognized-folder-type nil)
341 342
342 (defun vm-mouse-support-possible-p () 343 (defun vm-mouse-support-possible-p ()
343 (vm-multiple-frames-possible-p)) 344 (vm-multiple-frames-possible-p))
344 345
345 (defun vm-menu-support-possible-p () 346 (defun vm-menu-support-possible-p ()
346 (or (and (boundp 'window-system) (eq window-system 'x)) 347 (or (and (boundp 'window-system)
348 (or (eq window-system 'x)
349 (eq window-system 'win32)))
347 (and (fboundp 'device-type) (eq (device-type) 'x)))) 350 (and (fboundp 'device-type) (eq (device-type) 'x))))
348 351
349 (defun vm-toolbar-support-possible-p () 352 (defun vm-toolbar-support-possible-p ()
350 (and (vm-xemacs-p) 353 (and (vm-xemacs-p)
351 (vm-multiple-frames-possible-p) 354 (vm-multiple-frames-possible-p)
363 (defun vm-error-free-call (function &rest args) 366 (defun vm-error-free-call (function &rest args)
364 (condition-case nil 367 (condition-case nil
365 (apply function args) 368 (apply function args)
366 (error nil))) 369 (error nil)))
367 370
368 ;; XEmacs change 371 (put 'beginning-of-folder 'error-conditions '(beginning-of-folder error))
369 (define-error 'beginning-of-folder "Beginning of folder") 372 (put 'beginning-of-folder 'error-message "Beginning of folder")
370 (define-error 'end-of-folder "End of folder") 373 (put 'end-of-folder 'error-conditions '(end-of-folder error))
374 (put 'end-of-folder 'error-message "End of folder")
371 375
372 (defun vm-trace (&rest args) 376 (defun vm-trace (&rest args)
373 (save-excursion 377 (save-excursion
374 (set-buffer (get-buffer-create "*vm-trace*")) 378 (set-buffer (get-buffer-create "*vm-trace*"))
375 (apply 'insert args))) 379 (apply 'insert args)))