Mercurial > hg > xemacs-beta
comparison lisp/code-files.el @ 3722:a0adf5f08c44
[xemacs-hg @ 2006-12-05 08:20:54 by michaels]
2006-11-30 Mike Sperber <mike@xemacs.org>
* fileio.c (Finsert_file_contents_internal): Don't call the
file-name handler for `insert-file-contents' from here, which is
too late. Instead, do it from Lisp.SSper
2006-11-30 Mike Sperber <mike@xemacs.org>
* code-files.el (insert-file-contents): Call the file-name handler
from Lisp, not from `insert-file-contents-internal', which is too late.
author | michaels |
---|---|
date | Tue, 05 Dec 2006 08:21:03 +0000 |
parents | 5903b079bee1 |
children | 4cc3828e29bb |
comparison
equal
deleted
inserted
replaced
3721:7611e12bc882 | 3722:a0adf5f08c44 |
---|---|
380 coding-system determination procedure. | 380 coding-system determination procedure. |
381 | 381 |
382 See also `insert-file-contents-access-hook', | 382 See also `insert-file-contents-access-hook', |
383 `insert-file-contents-pre-hook', `insert-file-contents-error-hook', | 383 `insert-file-contents-pre-hook', `insert-file-contents-error-hook', |
384 and `insert-file-contents-post-hook'." | 384 and `insert-file-contents-post-hook'." |
385 (let (return-val coding-system used-codesys) | 385 (let* ((expanded (substitute-in-file-name filename)) |
386 ;; OK, first load the file. | 386 (handler (find-file-name-handler expanded 'insert-file-contents))) |
387 (condition-case err | 387 (if handler |
388 (progn | 388 (funcall handler 'insert-file-contents filename visit start end replace) |
389 (run-hook-with-args 'insert-file-contents-access-hook | 389 (let (return-val coding-system used-codesys) |
390 filename visit) | 390 ;; OK, first load the file. |
391 ;; determine the coding system to use, as described above. | 391 (condition-case err |
392 (setq coding-system | 392 (progn |
393 (or | 393 (run-hook-with-args 'insert-file-contents-access-hook |
394 ;; #1. | 394 filename visit) |
395 coding-system-for-read | 395 ;; determine the coding system to use, as described above. |
396 ;; #2. | 396 (setq coding-system |
397 (run-hook-with-args-until-success | 397 (or |
398 'insert-file-contents-pre-hook | 398 ;; #1. |
399 filename visit) | 399 coding-system-for-read |
400 ;; #3. | 400 ;; #2. |
401 (find-file-coding-system-for-read-from-filename filename) | 401 (run-hook-with-args-until-success |
402 ;; #4. | 402 'insert-file-contents-pre-hook |
403 buffer-file-coding-system-for-read | 403 filename visit) |
404 ;; #5. | 404 ;; #3. |
405 'raw-text)) | 405 (find-file-coding-system-for-read-from-filename filename) |
406 (if (consp coding-system) | 406 ;; #4. |
407 (setq return-val coding-system) | 407 buffer-file-coding-system-for-read |
408 (if (null (find-coding-system coding-system)) | 408 ;; #5. |
409 (progn | 409 'raw-text)) |
410 (lwarn 'coding-system 'notice | 410 (if (consp coding-system) |
411 "Invalid coding-system (%s), using 'undecided" | 411 (setq return-val coding-system) |
412 coding-system) | 412 (if (null (find-coding-system coding-system)) |
413 (setq coding-system 'undecided))) | 413 (progn |
414 (setq return-val | 414 (lwarn 'coding-system 'notice |
415 (insert-file-contents-internal filename visit start end | 415 "Invalid coding-system (%s), using 'undecided" |
416 replace coding-system | 416 coding-system) |
417 ;; store here! | 417 (setq coding-system 'undecided))) |
418 'used-codesys)) | 418 (setq return-val |
419 )) | 419 (insert-file-contents-internal filename visit start end |
420 (file-error | 420 replace coding-system |
421 (run-hook-with-args 'insert-file-contents-error-hook | 421 ;; store here! |
422 filename visit err) | 422 'used-codesys)) |
423 (signal (car err) (cdr err)))) | 423 )) |
424 (setq coding-system used-codesys) | 424 (file-error |
425 ;; call any `post-read-conversion' for the coding system that | 425 (run-hook-with-args 'insert-file-contents-error-hook |
426 ;; was used ... | 426 filename visit err) |
427 (let ((func | 427 (signal (car err) (cdr err)))) |
428 (coding-system-property coding-system 'post-read-conversion)) | 428 (setq coding-system used-codesys) |
429 (endmark (make-marker))) | 429 ;; call any `post-read-conversion' for the coding system that |
430 (set-marker endmark (+ (point) (nth 1 return-val))) | 430 ;; was used ... |
431 (if func | 431 (let ((func |
432 (unwind-protect | 432 (coding-system-property coding-system 'post-read-conversion)) |
433 (save-excursion | 433 (endmark (make-marker))) |
434 (let (buffer-read-only) | 434 (set-marker endmark (+ (point) (nth 1 return-val))) |
435 (if (>= (function-max-args func) 2) | 435 (if func |
436 ;; #### fuckme! Someone at FSF changed the calling | 436 (unwind-protect |
437 ;; convention of post-read-conversion. We try to | 437 (save-excursion |
438 ;; support the old way. #### Should we kill this? | 438 (let (buffer-read-only) |
439 (funcall func (point) (marker-position endmark)) | 439 (if (>= (function-max-args func) 2) |
440 (funcall func (- (marker-position endmark) (point)))))) | 440 ;; #### fuckme! Someone at FSF changed the calling |
441 (if visit | 441 ;; convention of post-read-conversion. We try to |
442 (progn | 442 ;; support the old way. #### Should we kill this? |
443 (set-buffer-auto-saved) | 443 (funcall func (point) (marker-position endmark)) |
444 (set-buffer-modified-p nil))))) | 444 (funcall func (- (marker-position endmark) (point)))))) |
445 (setcar (cdr return-val) (- (marker-position endmark) (point)))) | 445 (if visit |
446 ;; now finally set the buffer's `buffer-file-coding-system' ... | 446 (progn |
447 (if (run-hook-with-args-until-success 'insert-file-contents-post-hook | 447 (set-buffer-auto-saved) |
448 filename visit return-val) | 448 (set-buffer-modified-p nil))))) |
449 nil | 449 (setcar (cdr return-val) (- (marker-position endmark) (point)))) |
450 (if (local-variable-p 'buffer-file-coding-system (current-buffer)) | 450 ;; now finally set the buffer's `buffer-file-coding-system' ... |
451 ;; if buffer-file-coding-system is already local, just | 451 (if (run-hook-with-args-until-success 'insert-file-contents-post-hook |
452 ;; set its eol type to what was found, if it wasn't | 452 filename visit return-val) |
453 ;; set already. | 453 nil |
454 (set-buffer-file-coding-system | 454 (if (local-variable-p 'buffer-file-coding-system (current-buffer)) |
455 (subsidiary-coding-system buffer-file-coding-system | 455 ;; if buffer-file-coding-system is already local, just |
456 (coding-system-eol-type coding-system)) t) | 456 ;; set its eol type to what was found, if it wasn't |
457 ;; otherwise actually set buffer-file-coding-system. | 457 ;; set already. |
458 (set-buffer-file-coding-system coding-system t))) | 458 (set-buffer-file-coding-system |
459 ;; ... and `buffer-file-coding-system-when-loaded'. the machinations | 459 (subsidiary-coding-system buffer-file-coding-system |
460 ;; of set-buffer-file-coding-system cause the actual coding system | 460 (coding-system-eol-type coding-system)) t) |
461 ;; object to be stored, so do that here, too. | 461 ;; otherwise actually set buffer-file-coding-system. |
462 (setq buffer-file-coding-system-when-loaded | 462 (set-buffer-file-coding-system coding-system t))) |
463 (get-coding-system coding-system)) | 463 ;; ... and `buffer-file-coding-system-when-loaded'. the machinations |
464 return-val)) | 464 ;; of set-buffer-file-coding-system cause the actual coding system |
465 ;; object to be stored, so do that here, too. | |
466 (setq buffer-file-coding-system-when-loaded | |
467 (get-coding-system coding-system)) | |
468 return-val)))) | |
465 | 469 |
466 (defvar write-region-pre-hook nil | 470 (defvar write-region-pre-hook nil |
467 "A special hook to decide the coding system used for writing out a file. | 471 "A special hook to decide the coding system used for writing out a file. |
468 | 472 |
469 Before writing a file, `write-region' calls the functions on this hook with | 473 Before writing a file, `write-region' calls the functions on this hook with |