~ubuntu-branches/ubuntu/feisty/wnn7egg/feisty

« back to all changes in this revision

Viewing changes to elisp/xemacs21/wnn7egg-rpcx21.el

  • Committer: Bazaar Package Importer
  • Author(s): ISHIKAWA Mutsumi
  • Date: 2004-09-22 17:39:30 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20040922173930-pna2yuvlq63wxgc9
Tags: 1.02-5
update dolist macro confliction fix, thanks TSUCHIYA Masatoshi.
realy closes: #270839

Show diffs side-by-side

added added

removed removed

Lines of Context:
56
56
 
57
57
;;; Commentary:
58
58
 
 
59
;;; 2002/5/16  XEmacs$B$K$*$$$F%f!<%6<-=q$N%/%i%$%"%s%HE>Aw$,$G$-$J$$LdBj$NBP1~(B
59
60
;;; 2001/9/30  Modified Error Messages
60
61
 
61
62
;;; Code:
62
63
 
63
 
 
64
 
(require 'wnn7egg-comx21)
 
64
(defun wnn-perform-replace (from-string replacements)
 
65
  "perform-replace $B$h$jITI,MW$J%*%W%7%g%s!"=hM}!"%(%3!<NN0h$X$NI=<($r:o=|$7$?$b$N(B"
 
66
  (let* ((event (make-event))
 
67
         (nocasify (not (and case-fold-search case-replace
 
68
                             (string-equal from-string
 
69
                                           (downcase from-string)))))
 
70
         (literal t)
 
71
         (search-function (if (boundp 'replace-search-function)
 
72
                              replace-search-function
 
73
                            'search-forward))
 
74
         (search-string from-string)
 
75
         (real-match-data nil)          ; the match data for the current match
 
76
         (next-replacement nil)
 
77
         (replacement-index 0)
 
78
         (keep-going t)
 
79
         (stack nil)
 
80
         (next-rotate-count 0)
 
81
         (replace-count 0)
 
82
         (repeat-count 1)
 
83
         (lastrepl nil)                 ;Position after last match considered.
 
84
         ;; If non-nil, it is marker saying where in the buffer to
 
85
         ;; stop.
 
86
         (limit nil)
 
87
         (match-again t)
 
88
         ;; XEmacs addition
 
89
         (qr-case-fold-search
 
90
          (if (and case-fold-search search-caps-disable-folding)
 
91
              (if (boundp 'no-upper-case-p)
 
92
                  (no-upper-case-p search-string nil)
 
93
                (isearch-no-upper-case-p search-string))
 
94
            case-fold-search))
 
95
         )
 
96
    ;; If the region is active, operate on region.
 
97
    (when (region-active-p)
 
98
      ;; Original Per Abrahamsen's code simply narrowed the region,
 
99
      ;; thus providing a visual indication of the search boundary.
 
100
      ;; Stallman, on the other hand, handles it like this.
 
101
      (setq limit (copy-marker (region-end)))
 
102
      (goto-char (region-beginning))
 
103
      (zmacs-deactivate-region))
 
104
    (if (stringp replacements)
 
105
        (setq next-replacement replacements)
 
106
      (or repeat-count (setq repeat-count 1)))
 
107
    (push-mark)
 
108
    (undo-boundary)
 
109
    (unwind-protect
 
110
        ;; Loop finding occurrences that perhaps should be replaced.
 
111
        (while (and keep-going
 
112
                    (not (eobp))
 
113
                    (or (null limit) (< (point) limit))
 
114
                    (let ((case-fold-search qr-case-fold-search))
 
115
                      (if (> emacs-minor-version 1)
 
116
                          (funcall search-function search-string limit)
 
117
                        (funcall search-function search-string limit t)))
 
118
                    ;; If the search string matches immediately after
 
119
                    ;; the previous match, but it did not match there
 
120
                    ;; before the replacement was done, ignore the match.
 
121
                    (if (or (eq lastrepl (point)))
 
122
                        (if (or (eobp)
 
123
                                (and limit (>= (point) limit)))
 
124
                            nil
 
125
                          ;; Don't replace the null string
 
126
                          ;; right after end of previous replacement.
 
127
                          (forward-char 1)
 
128
                          (let ((case-fold-search qr-case-fold-search))
 
129
                            (if (> emacs-minor-version 1)
 
130
                                (funcall search-function search-string limit)
 
131
                              (funcall search-function search-string limit t))))
 
132
                      t))
 
133
 
 
134
          ;; Save the data associated with the real match.
 
135
          (setq real-match-data (match-data))
 
136
 
 
137
          ;; If time for a change, advance to next replacement string.
 
138
          (if (and (listp replacements)
 
139
                   (= next-rotate-count replace-count))
 
140
              (progn
 
141
                (setq next-rotate-count
 
142
                      (+ next-rotate-count repeat-count))
 
143
                (setq next-replacement (nth replacement-index replacements))
 
144
                (setq replacement-index (% (1+ replacement-index) (length replacements)))))
 
145
          (store-match-data real-match-data)
 
146
          (replace-match next-replacement nocasify literal)
 
147
          (setq replace-count (1+ replace-count))
 
148
          (setq lastrepl (point)))
 
149
      ;; Useless in XEmacs.  We handle (de)highlighting through
 
150
      ;; perform-replace-next-event.
 
151
      ;(replace-dehighlight)
 
152
      )
 
153
    (or unread-command-events)
 
154
    (and keep-going stack)))
 
155
 
 
156
(if (> emacs-minor-version 1)
 
157
    (require 'wnn7egg-comx214)
 
158
  (require 'wnn7egg-comx21))
65
159
 
66
160
(defmacro wnn-file-string ()
67
161
  (string-as-unibyte (decode-coding-string "$B#W#n#n$N%U%!%$%k(B" 'euc-jp)))
439
533
    (or (and (< errno (length msg)) (aref msg errno))
440
534
        (format "#%d" errno))))
441
535
 
 
536
;---
 
537
(defun insert-file-contents-wnn (filename &optional visit start end replace)
 
538
  (let (return-val coding-system used-codesys)
 
539
    ;; OK, first load the file.
 
540
    (condition-case err
 
541
        (progn
 
542
          (run-hook-with-args 'insert-file-contents-access-hook
 
543
                              filename visit)
 
544
          ;; determine the coding system to use, as described above.
 
545
          (setq coding-system 'binary)
 
546
          (if (consp coding-system)
 
547
              (setq return-val coding-system)
 
548
            (if (null (find-coding-system coding-system))
 
549
                (progn
 
550
                  (message
 
551
                   "Invalid coding-system (%s), using 'undecided"
 
552
                   coding-system)
 
553
                  (setq coding-system 'undecided)))
 
554
            (setq return-val
 
555
                  (insert-file-contents-internal filename visit start end
 
556
                                                 replace coding-system
 
557
                                                 ;; store here!
 
558
                                                 'used-codesys))
 
559
            ))
 
560
      (file-error
 
561
       (run-hook-with-args 'insert-file-contents-error-hook
 
562
                           filename visit err)
 
563
       (signal (car err) (cdr err))))
 
564
    (setq coding-system used-codesys)
 
565
    ;; call any `post-read-conversion' for the coding system that
 
566
    ;; was used ...
 
567
    (let ((func
 
568
           (coding-system-property coding-system 'post-read-conversion))
 
569
          (endmark (make-marker)))
 
570
      (set-marker endmark (+ (point) (nth 1 return-val)))
 
571
      (if func
 
572
          (unwind-protect
 
573
              (save-excursion
 
574
                (let (buffer-read-only)
 
575
                  (funcall func (point) (marker-position endmark))))
 
576
            (if visit
 
577
                (progn
 
578
                  (set-buffer-auto-saved)
 
579
                  (set-buffer-modified-p nil)))))
 
580
      (setcar (cdr return-val) (- (marker-position endmark) (point))))
 
581
    ;; now finally set the buffer's `buffer-file-coding-system'.
 
582
    (if (run-hook-with-args-until-success 'insert-file-contents-post-hook
 
583
                                          filename visit return-val)
 
584
        nil
 
585
      (if (local-variable-p 'buffer-file-coding-system (current-buffer))
 
586
          ;; if buffer-file-coding-system is already local, just
 
587
          ;; set its eol type to what was found, if it wasn't
 
588
          ;; set already.
 
589
          (set-buffer-file-coding-system
 
590
           (subsidiary-coding-system buffer-file-coding-system
 
591
                                     (coding-system-eol-type coding-system)))
 
592
        ;; otherwise actually set buffer-file-coding-system.
 
593
        (set-buffer-file-coding-system coding-system)))
 
594
    return-val))
 
595
;---
 
596
 
442
597
(defmacro wnn7rpc-call-with-proc (proc vlist send-expr &rest receive-exprs)
443
598
  `(comm-call-with-proc ,proc
444
599
       ((zhuyin nil)
1231
1386
                 env-id dic hinshi-table)
1232
1387
    (wnn7rpc-get-result)))
1233
1388
 
 
1389
(defmacro with-current-buffer-bin (buffer &rest body)
 
1390
  "Temporarily make BUFFER the current buffer and execute the forms in BODY.
 
1391
The value returned is the value of the last form in BODY.
 
1392
See also `with-temp-buffer'."
 
1393
  `(save-current-buffer
 
1394
    (set-buffer ,buffer)
 
1395
    (let ((coding-system-for-read 'binary)
 
1396
          (coding-system-for-write 'binary))
 
1397
      (set-buffer-multibyte nil)
 
1398
      ,@body)))
 
1399
 
 
1400
(defmacro with-temp-buffer-bin (&rest forms)
 
1401
  "Create a temporary buffer, and evaluate FORMS there like `progn'.
 
1402
See also `with-temp-file' and `with-output-to-string'."
 
1403
  (let ((temp-buffer (make-symbol "temp-buffer")))
 
1404
    `(let ((,temp-buffer
 
1405
            (get-buffer-create (generate-new-buffer-name " *temp*"))))
 
1406
       (unwind-protect
 
1407
           (let ((coding-system-for-read 'binary)
 
1408
                 (coding-system-for-write 'binary))
 
1409
             (set-buffer-multibyte nil)
 
1410
             (with-current-buffer-bin ,temp-buffer
 
1411
               ,@forms))
 
1412
         (and (buffer-name ,temp-buffer)
 
1413
              (kill-buffer ,temp-buffer))))))
 
1414
 
1234
1415
(defmacro wnn7rpc-with-temp-buffer (&rest body)
1235
 
  `(with-temp-buffer
1236
 
     (let ((coding-system-for-read 'no-conversion)
1237
 
           (coding-system-for-write 'no-conversion))
 
1416
;  `(with-temp-buffer
 
1417
;     (let ((coding-system-for-read 'binary)
 
1418
;          (coding-system-for-write 'binary))
 
1419
;       (set-buffer-multibyte nil)
 
1420
;       ,@body)))
 
1421
  `(with-temp-buffer-bin
 
1422
     (let ((coding-system-for-read 'binary)
 
1423
           (coding-system-for-write 'binary))
1238
1424
       (set-buffer-multibyte nil)
1239
1425
       ,@body)))
1240
1426
 
 
1427
(defmacro with-temp-file-bin (file &rest forms)
 
1428
  (let ((temp-file (make-symbol "temp-file"))
 
1429
        (temp-buffer (make-symbol "temp-buffer")))
 
1430
    `(let ((,temp-file ,file)
 
1431
           (,temp-buffer
 
1432
            (get-buffer-create (generate-new-buffer-name " *temp file*"))))
 
1433
       (unwind-protect
 
1434
           (prog1
 
1435
               (with-current-buffer ,temp-buffer
 
1436
                 ,@forms)
 
1437
             (with-current-buffer ,temp-buffer
 
1438
               (widen)
 
1439
               (let ((coding-system-for-read 'binary)
 
1440
                     (coding-system-for-write 'binary))
 
1441
                 (write-region (point-min) (point-max) ,temp-file nil 0))))
 
1442
         (and (buffer-name ,temp-buffer)
 
1443
              (kill-buffer ,temp-buffer))))))
 
1444
 
1241
1445
(defmacro wnn7rpc-with-write-file (filename error-handler &rest body)
 
1446
;  `(condition-case error
 
1447
;       (with-temp-file ,filename
 
1448
;        (let ((coding-system-for-read 'binary)
 
1449
;              (coding-system-for-write 'binary))
 
1450
;          (set-buffer-multibyte nil)
 
1451
;          ,@body))
 
1452
;     (file-error ,error-handler)))
1242
1453
  `(condition-case error
1243
 
       (with-temp-file ,filename
1244
 
         (let ((coding-system-for-read 'no-conversion)
1245
 
               (coding-system-for-write 'no-conversion))
 
1454
       (with-temp-file-bin ,filename
 
1455
         (let ((coding-system-for-read 'binary)
 
1456
               (coding-system-for-write 'binary))
1246
1457
           (set-buffer-multibyte nil)
1247
1458
           ,@body))
1248
1459
     (file-error ,error-handler)))
1286
1497
  (wnn7rpc-with-temp-buffer
1287
1498
    (if (null (file-readable-p filename))
1288
1499
        (list nil (make-string (wnn-const WNN_UNIQ_LEN) 0) "" "")
1289
 
      (insert-file-contents filename nil 0 (wnn-const WNN_FILE_HEADER_LEN))
 
1500
      (insert-file-contents-internal filename nil 0 (wnn-const WNN_FILE_HEADER_LEN))
1290
1501
      (wnn7rpc-scan-file-header))))
1291
1502
 
1292
1503
(defun wnn7rpc-check-local-file (path &optional preserve)
1333
1544
(defun wnn7rpc-change-file-uniq (header path &optional new)
1334
1545
  (wnn7rpc-with-write-file path
1335
1546
      nil
1336
 
    (insert-file-contents path)
 
1547
    (insert-file-contents-internal path)
1337
1548
    (if (wnn7rpc-scan-file-header)
1338
1549
        (let ((uniq (wnn7rpc-make-uniq (file-attributes path))))
1339
1550
          (goto-char (1+ (wnn-const WNN_FILE_STRING_LEN)))
1427
1638
                    (comm-format (u) (wnn-const WNN_ACK))
1428
1639
                    (comm-unpack (B) contents))
1429
1640
                  (insert contents)
 
1641
                  (save-excursion
 
1642
                    (goto-char (point-min))
 
1643
                    (wnn-perform-replace "\377\0" "\377"))
1430
1644
                  (if (= result 2)
1431
 
                      (insert-file-contents local-filename nil (1- (point))))
 
1645
                      (insert-file-contents-internal local-filename nil (1- (point))))
1432
1646
                  (save-excursion
1433
1647
                    (set-buffer (process-buffer proc))
1434
1648
                    (wnn7rpc-get-result)))))))))
1457
1671
                  (comm-format (s B)
1458
1672
                               (concat wnn-system-name "!" filename)
1459
1673
                               (wnn7rpc-with-temp-buffer
1460
 
                                 (insert-file-contents filename)
 
1674
                                 (insert-file-contents-internal filename)
1461
1675
                                 (buffer-string)))
1462
1676
                  (wnn7rpc-get-result
1463
1677
                    (wnn7env-set-client-file env filename)
1543
1757
   ((null (file-readable-p filename)) (- (wnn-const WNN_FILE_READ_ERROR)))
1544
1758
   (t 
1545
1759
    (wnn7rpc-with-temp-buffer
1546
 
      (insert-file-contents filename nil 0 (1- (wnn-const WNN_PASSWD_LEN)))
 
1760
      (insert-file-contents-internal filename nil 0 (1- (wnn-const WNN_PASSWD_LEN)))
1547
1761
      (goto-char 1)
1548
1762
      (if (and (search-forward-regexp "[\0\n]" nil 0)
1549
1763
               (= (preceding-char) 0))