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