Commit 83600dc8 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* lisp/image-mode.el: Use lexical-binding.

(image-mode-winprops): Use t to stand for the window of a buffer that's
not displayed.
* lisp/doc-view.el (doc-view-new-window-function): Handle t in winprops.
(doc-view-enlarge): Make it a real nop if the size is not changed.
(doc-view-display): Handle the case where the buffer is not (yet?)
displayed in any window.
(doc-view-saved-settings): New var.
(doc-view-mode): Use it.
(doc-view-fallback-mode): Set it.
parent a2e770db
2012-09-27 Stefan Monnier <monnier@iro.umontreal.ca> 2012-09-27 Stefan Monnier <monnier@iro.umontreal.ca>
   
* image-mode.el: Use lexical-binding.
(image-mode-winprops): Use t to stand for the window of
a buffer that's not displayed.
* doc-view.el (doc-view-new-window-function): Handle the new
t in winprops.
(doc-view-enlarge): Make it a real nop if the size is not changed.
(doc-view-display): Handle the case where the buffer is not (yet?)
displayed in any window.
(doc-view-saved-settings): New var.
(doc-view-mode): Use it.
(doc-view-fallback-mode): Set it.
* minibuf-eldef.el: Make it possible to replace (default ...) with [...]. * minibuf-eldef.el: Make it possible to replace (default ...) with [...].
Set lexical-binding. Set lexical-binding.
(minibuffer-eldef-shorten-default): New var. (minibuffer-eldef-shorten-default): New var.
......
...@@ -255,20 +255,23 @@ of the page moves to the previous page." ...@@ -255,20 +255,23 @@ of the page moves to the previous page."
;;;; Internal Variables ;;;; Internal Variables
(defun doc-view-new-window-function (winprops) (defun doc-view-new-window-function (winprops)
;; (message "New window %s for buf %s" (car winprops) (current-buffer))
(cl-assert (or (eq t (car winprops))
(eq (window-buffer (car winprops)) (current-buffer))))
(let ((ol (image-mode-window-get 'overlay winprops))) (let ((ol (image-mode-window-get 'overlay winprops)))
(when (and ol (not (overlay-buffer ol)))
;; I've seen `ol' be a dead overlay. I do not yet know how this
;; happened, so maybe the bug is elsewhere, but in the mean time,
;; this seems like a safe approach.
(setq ol nil))
(if ol (if ol
(progn (progn
(cl-assert (eq (overlay-buffer ol) (current-buffer))) (setq ol (copy-overlay ol))
(setq ol (copy-overlay ol))) ;; `ol' might actually be dead.
(cl-assert (not (get-char-property (point-min) 'display))) (move-overlay ol (point-min) (point-max)))
(setq ol (make-overlay (point-min) (point-max) nil t)) (setq ol (make-overlay (point-min) (point-max) nil t))
(overlay-put ol 'doc-view t)) (overlay-put ol 'doc-view t))
(overlay-put ol 'window (car winprops)) (overlay-put ol 'window (car winprops))
(unless (windowp (car winprops))
;; It's a pseudo entry. Let's make sure it's not displayed (the
;; `window' property is only effective if its value is a window).
(cl-assert (eq t (car winprops)))
(delete-overlay ol))
(image-mode-window-put 'overlay ol winprops))) (image-mode-window-put 'overlay ol winprops)))
(defvar doc-view-current-files nil (defvar doc-view-current-files nil
...@@ -560,7 +563,8 @@ at the top edge of the page moves to the previous page." ...@@ -560,7 +563,8 @@ at the top edge of the page moves to the previous page."
"Kill the current converter process(es)." "Kill the current converter process(es)."
(interactive) (interactive)
(while (consp doc-view-current-converter-processes) (while (consp doc-view-current-converter-processes)
(ignore-errors ;; Maybe it's dead already? (ignore-errors ;; Some entries might not be processes, and maybe
;; some are dead already?
(kill-process (pop doc-view-current-converter-processes)))) (kill-process (pop doc-view-current-converter-processes))))
(when doc-view-current-timer (when doc-view-current-timer
(cancel-timer doc-view-current-timer) (cancel-timer doc-view-current-timer)
...@@ -663,19 +667,21 @@ OpenDocument format)." ...@@ -663,19 +667,21 @@ OpenDocument format)."
(defvar doc-view-shrink-factor 1.125) (defvar doc-view-shrink-factor 1.125)
(defun doc-view-enlarge (factor) (defun doc-view-enlarge (factor)
"Enlarge the document." "Enlarge the document by FACTOR."
(interactive (list doc-view-shrink-factor)) (interactive (list doc-view-shrink-factor))
(if (eq (plist-get (cdr (doc-view-current-image)) :type) (if (eq (plist-get (cdr (doc-view-current-image)) :type)
'imagemagick) 'imagemagick)
;; ImageMagick supports on-the-fly-rescaling ;; ImageMagick supports on-the-fly-rescaling.
(progn (let ((new (ceiling (* factor doc-view-image-width))))
(set (make-local-variable 'doc-view-image-width) (unless (equal new doc-view-image-width)
(ceiling (* factor doc-view-image-width))) (set (make-local-variable 'doc-view-image-width) new)
(doc-view-insert-image (plist-get (cdr (doc-view-current-image)) :file) (doc-view-insert-image
:width doc-view-image-width)) (plist-get (cdr (doc-view-current-image)) :file)
(set (make-local-variable 'doc-view-resolution) :width doc-view-image-width)))
(ceiling (* factor doc-view-resolution))) (let ((new (ceiling (* factor doc-view-resolution))))
(doc-view-reconvert-doc))) (unless (equal new doc-view-resolution)
(set (make-local-variable 'doc-view-resolution) new)
(doc-view-reconvert-doc)))))
(defun doc-view-shrink (factor) (defun doc-view-shrink (factor)
"Shrink the document." "Shrink the document."
...@@ -743,12 +749,14 @@ min {(window-width / image-width), (window-height / image-height)} times." ...@@ -743,12 +749,14 @@ min {(window-width / image-width), (window-height / image-height)} times."
(img-height (cdr (image-display-size (img-height (cdr (image-display-size
(image-get-display-property) t)))) (image-get-display-property) t))))
(doc-view-enlarge (min (/ (float win-width) (float img-width)) (doc-view-enlarge (min (/ (float win-width) (float img-width))
(/ (float (- win-height 1)) (float img-height))))) (/ (float (- win-height 1))
(float img-height)))))
;; If slice is set ;; If slice is set
(let* ((slice-width (nth 2 slice)) (let* ((slice-width (nth 2 slice))
(slice-height (nth 3 slice)) (slice-height (nth 3 slice))
(scale-factor (min (/ (float win-width) (float slice-width)) (scale-factor (min (/ (float win-width) (float slice-width))
(/ (float (- win-height 1)) (float slice-height)))) (/ (float (- win-height 1))
(float slice-height))))
(new-slice (mapcar (lambda (x) (ceiling (* scale-factor x))) slice))) (new-slice (mapcar (lambda (x) (ceiling (* scale-factor x))) slice)))
(doc-view-enlarge scale-factor) (doc-view-enlarge scale-factor)
(setf (doc-view-current-slice) new-slice) (setf (doc-view-current-slice) new-slice)
...@@ -762,6 +770,7 @@ Should be invoked when the cached images aren't up-to-date." ...@@ -762,6 +770,7 @@ Should be invoked when the cached images aren't up-to-date."
;; Clear the old cached files ;; Clear the old cached files
(when (file-exists-p (doc-view-current-cache-dir)) (when (file-exists-p (doc-view-current-cache-dir))
(delete-directory (doc-view-current-cache-dir) 'recursive)) (delete-directory (doc-view-current-cache-dir) 'recursive))
(kill-local-variable 'doc-view-last-page-number)
(doc-view-initiate-display)) (doc-view-initiate-display))
(defun doc-view-sentinel (proc event) (defun doc-view-sentinel (proc event)
...@@ -1169,24 +1178,23 @@ Predicate for sorting `doc-view-current-files'." ...@@ -1169,24 +1178,23 @@ Predicate for sorting `doc-view-current-files'."
If FORCE is non-nil, start viewing even if the document does not If FORCE is non-nil, start viewing even if the document does not
have the page we want to view." have the page we want to view."
(with-current-buffer buffer (with-current-buffer buffer
(let ((prev-pages doc-view-current-files) (let ((prev-pages doc-view-current-files))
(windows (get-buffer-window-list buffer nil t)))
(setq doc-view-current-files (setq doc-view-current-files
(sort (directory-files (doc-view-current-cache-dir) t (sort (directory-files (doc-view-current-cache-dir) t
"page-[0-9]+\\.png" t) "page-[0-9]+\\.png" t)
'doc-view-sort)) 'doc-view-sort))
(unless windows (dolist (win (or (get-buffer-window-list buffer nil t)
(switch-to-buffer buffer) (list t)))
(setq windows (get-buffer-window-list buffer nil t)))
(dolist (win windows)
(let* ((page (doc-view-current-page win)) (let* ((page (doc-view-current-page win))
(pagefile (expand-file-name (format "page-%d.png" page) (pagefile (expand-file-name (format "page-%d.png" page)
(doc-view-current-cache-dir)))) (doc-view-current-cache-dir))))
(when (or force (when (or force
(and (not (member pagefile prev-pages)) (and (not (member pagefile prev-pages))
(member pagefile doc-view-current-files))) (member pagefile doc-view-current-files)))
(if (windowp win)
(with-selected-window win (with-selected-window win
(cl-assert (eq (current-buffer) buffer) t) (cl-assert (eq (current-buffer) buffer) t)
(doc-view-goto-page page))
(doc-view-goto-page page)))))))) (doc-view-goto-page page))))))))
(defun doc-view-buffer-message () (defun doc-view-buffer-message ()
...@@ -1231,6 +1239,10 @@ For now these keys are useful: ...@@ -1231,6 +1239,10 @@ For now these keys are useful:
;;;;; Toggle between editing and viewing ;;;;; Toggle between editing and viewing
(defvar-local doc-view-saved-settings nil
"Doc-view settings saved while in some other mode.")
(put 'doc-view-saved-settings 'permanent-local t)
(defun doc-view-toggle-display () (defun doc-view-toggle-display ()
"Toggle between editing a document as text or viewing it." "Toggle between editing a document as text or viewing it."
(interactive) (interactive)
...@@ -1483,13 +1495,16 @@ toggle between displaying the document or editing it as text. ...@@ -1483,13 +1495,16 @@ toggle between displaying the document or editing it as text.
;; returns nil for tar members. ;; returns nil for tar members.
(doc-view-fallback-mode) (doc-view-fallback-mode)
(let* ((prev-major-mode (if (eq major-mode 'doc-view-mode) (let* ((prev-major-mode (if (derived-mode-p 'doc-view-mode)
doc-view-previous-major-mode doc-view-previous-major-mode
(when (not (memq major-mode (unless (eq major-mode 'fundamental-mode)
'(doc-view-mode fundamental-mode)))
major-mode)))) major-mode))))
(kill-all-local-variables) (kill-all-local-variables)
(set (make-local-variable 'doc-view-previous-major-mode) prev-major-mode)) (set (make-local-variable 'doc-view-previous-major-mode)
prev-major-mode))
(dolist (var doc-view-saved-settings)
(set (make-local-variable (car var)) (cdr var)))
;; Figure out the document type. ;; Figure out the document type.
(unless doc-view-doc-type (unless doc-view-doc-type
...@@ -1563,13 +1578,20 @@ toggle between displaying the document or editing it as text. ...@@ -1563,13 +1578,20 @@ toggle between displaying the document or editing it as text.
(defun doc-view-fallback-mode () (defun doc-view-fallback-mode ()
"Fallback to the previous or next best major mode." "Fallback to the previous or next best major mode."
(let ((vars (if (derived-mode-p 'doc-view-mode)
(mapcar (lambda (var) (cons var (symbol-value var)))
'(doc-view-resolution
image-mode-winprops-alist)))))
(if doc-view-previous-major-mode (if doc-view-previous-major-mode
(funcall doc-view-previous-major-mode) (funcall doc-view-previous-major-mode)
(let ((auto-mode-alist (rassq-delete-all (let ((auto-mode-alist
(rassq-delete-all
'doc-view-mode-maybe 'doc-view-mode-maybe
(rassq-delete-all 'doc-view-mode (rassq-delete-all 'doc-view-mode
(copy-alist auto-mode-alist))))) (copy-alist auto-mode-alist)))))
(normal-mode)))) (normal-mode)))
(when vars
(setq-local doc-view-saved-settings vars))))
;;;###autoload ;;;###autoload
(defun doc-view-mode-maybe () (defun doc-view-mode-maybe ()
......
;;; image-mode.el --- support for visiting image files ;;; image-mode.el --- support for visiting image files -*- lexical-binding: t -*-
;; ;;
;; Copyright (C) 2005-2012 Free Software Foundation, Inc. ;; Copyright (C) 2005-2012 Free Software Foundation, Inc.
;; ;;
...@@ -31,6 +31,11 @@ ...@@ -31,6 +31,11 @@
;; resulting buffer file is saved to another name it will correctly save ;; resulting buffer file is saved to another name it will correctly save
;; the image data to the new file. ;; the image data to the new file.
;; Todo:
;; Consolidate with doc-view to make them work on directories of images or on
;; image files containing various "pages".
;;; Code: ;;; Code:
(require 'image) (require 'image)
...@@ -38,8 +43,7 @@ ...@@ -38,8 +43,7 @@
;;; Image mode window-info management. ;;; Image mode window-info management.
(defvar image-mode-winprops-alist t) (defvar-local image-mode-winprops-alist t)
(make-variable-buffer-local 'image-mode-winprops-alist)
(defvar image-mode-new-window-functions nil (defvar image-mode-new-window-functions nil
"Special hook run when image data is requested in a new window. "Special hook run when image data is requested in a new window.
...@@ -47,9 +51,13 @@ It is called with one argument, the initial WINPROPS.") ...@@ -47,9 +51,13 @@ It is called with one argument, the initial WINPROPS.")
(defun image-mode-winprops (&optional window cleanup) (defun image-mode-winprops (&optional window cleanup)
"Return winprops of WINDOW. "Return winprops of WINDOW.
A winprops object has the shape (WINDOW . ALIST)." A winprops object has the shape (WINDOW . ALIST).
WINDOW defaults to `selected-window' if it displays the current buffer, and
otherwise it defaults to t, used for times when the buffer is not displayed."
(cond ((null window) (cond ((null window)
(setq window (selected-window))) (setq window
(if (eq (current-buffer) (window-buffer)) (selected-window) t)))
((eq window t))
((not (windowp window)) ((not (windowp window))
(error "Not a window: %s" window))) (error "Not a window: %s" window)))
(when cleanup (when cleanup
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment