Using saved parent location: http://bzr.savannah.gnu.org/r/emacs/trunk/ Now on revision 101156. ------------------------------------------------------------ revno: 101156 committer: Chong Yidong branch nick: trunk timestamp: Sat 2010-08-21 00:46:23 -0400 message: Cleanups and fixes for mouse-save-then-kill and mouse-secondary-save-then-kill. * mouse.el (mouse-save-then-kill): Don't save region to kill ring when extending it. Before killing on the second click, check if the buffer is the correct one. Doc fix. (mouse-secondary-save-then-kill): Allow usage without first calling mouse-start-secondary, by defaulting to point. Don't save an empty secondary selection. Doc fix. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-08-21 04:43:04 +0000 +++ lisp/ChangeLog 2010-08-21 04:46:23 +0000 @@ -1,3 +1,12 @@ +2010-08-21 Chong Yidong + + * mouse.el (mouse-save-then-kill): Don't save region to kill ring + when extending it. Before killing on the second click, check if + the buffer is the correct one. Doc fix. + (mouse-secondary-save-then-kill): Allow usage without first + calling mouse-start-secondary, by defaulting to point. Don't save + an empty secondary selection. Doc fix. + 2010-08-21 Vinicius Jose Latorre * whitespace.el: Fix slow cursor movement. Reported by Christoph === modified file 'lisp/mouse.el' --- lisp/mouse.el 2010-08-16 02:08:01 +0000 +++ lisp/mouse.el 2010-08-21 04:46:23 +0000 @@ -1297,8 +1297,7 @@ ;; whenever it was equal to the front of the kill ring, but some ;; people found that confusing. -;; A list (TEXT START END), describing the text and position of the last -;; invocation of mouse-save-then-kill. +;; The position of the last invocation of `mouse-save-then-kill'. (defvar mouse-save-then-kill-posn nil) (defun mouse-save-then-kill-delete-region (beg end) @@ -1336,111 +1335,76 @@ (undo-boundary)) (defun mouse-save-then-kill (click) - "Set the region according to CLICK; the second time, kill the region. -Assuming this command is bound to a mouse button, CLICK is the -corresponding input event. - -If the region is already active, adjust it. Normally, this -happens by moving either point or mark, whichever is closer, to -the position of CLICK. But if you have selected words or lines, -the region is adjusted by moving point or mark to the word or -line boundary closest to CLICK. - -If the region is inactive, activate it temporarily; set mark at -the original point, and move click to the position of CLICK. - -However, if this command is being called a second time (i.e. the -value of `last-command' is `mouse-save-then-kill'), kill the -region instead. If the text in the region is the same as the -text in the front of the kill ring, just delete it." + "Set the region according to CLICK; the second time, kill it. +CLICK should be a mouse click event. + +If the region is inactive, activate it temporarily. Set mark at +the original point, and move point to the position of CLICK. + +If the region is already active, adjust it. Normally, do this by +moving point or mark, whichever is closer, to CLICK. But if you +have selected whole words or lines, move point or mark to the +word or line boundary closest to CLICK instead. + +If this command is called a second consecutive time with the same +CLICK position, kill the region." (interactive "e") - (let ((before-scroll - (with-current-buffer (window-buffer (posn-window (event-start click))) - point-before-scroll))) - (mouse-minibuffer-check click) - (let ((click-posn (posn-point (event-start click))) - ;; Don't let a subsequent kill command append to this one: - ;; prevent setting this-command to kill-region. - (this-command this-command)) - (if (and (with-current-buffer - (window-buffer (posn-window (event-start click))) - (and (mark t) - (> (mod mouse-selection-click-count 3) 0) - ;; Don't be fooled by a recent click in some other buffer. - (eq mouse-selection-click-count-buffer - (current-buffer))))) - (if (and (eq last-command 'mouse-save-then-kill) - (equal click-posn (nth 2 mouse-save-then-kill-posn))) - ;; If we click this button again without moving it, kill. - (progn - ;; Call `deactivate-mark' to save the primary selection. - (deactivate-mark) - (mouse-save-then-kill-delete-region (mark) (point)) - (setq mouse-selection-click-count 0) - (setq mouse-save-then-kill-posn nil)) - ;; Find both ends of the object selected by this click. - (let* ((range - (mouse-start-end click-posn click-posn - mouse-selection-click-count))) - ;; Move whichever end is closer to the click. - ;; That's what xterm does, and it seems reasonable. - (if (< (abs (- click-posn (mark t))) - (abs (- click-posn (point)))) - (set-mark (car range)) - (goto-char (nth 1 range))) - ;; We have already put the old region in the kill ring. - ;; Replace it with the extended region. - ;; (It would be annoying to make a separate entry.) - (kill-new (buffer-substring (point) (mark t)) t) - (mouse-set-region-1) - ;; Arrange for a repeated mouse-3 to kill this region. - (setq mouse-save-then-kill-posn - (list (car kill-ring) (point) click-posn)))) - - (if (and (eq last-command 'mouse-save-then-kill) - mouse-save-then-kill-posn - (eq (car mouse-save-then-kill-posn) (car kill-ring)) - (equal (cdr mouse-save-then-kill-posn) - (list (point) click-posn))) - ;; If this is the second time we've called - ;; mouse-save-then-kill, delete the text from the buffer. - (progn - ;; Call `deactivate-mark' to save the primary selection. - (deactivate-mark) - (mouse-save-then-kill-delete-region (point) (mark t)) - ;; After we kill, another click counts as "the first time". - (setq mouse-save-then-kill-posn nil)) - ;; This is not a repetition. - ;; We are adjusting an old selection or creating a new one. - (if (or (and (eq last-command 'mouse-save-then-kill) - mouse-save-then-kill-posn) - (and mark-active transient-mark-mode) - (and (memq last-command - '(mouse-drag-region mouse-set-region)) - (or mark-even-if-inactive - (not transient-mark-mode)))) - ;; We have a selection or suitable region, so adjust it. - (let* ((posn (event-start click)) - (new (posn-point posn))) - (select-window (posn-window posn)) - (if (numberp new) - (progn - ;; Move whichever end of the region is closer to the click. - ;; That is what xterm does, and it seems reasonable. - (if (<= (abs (- new (point))) (abs (- new (mark t)))) - (goto-char new) - (set-mark new)) - (setq deactivate-mark nil))) - (kill-new (buffer-substring (point) (mark t)) t)) - ;; Set the mark where point is, then move where clicked. - (mouse-set-mark-fast click) - (if before-scroll - (goto-char before-scroll)) - (exchange-point-and-mark) ;Why??? --Stef - (kill-new (buffer-substring (point) (mark t)))) - (mouse-set-region-1) - (setq mouse-save-then-kill-posn - (list (car kill-ring) (point) click-posn))))))) + (mouse-minibuffer-check click) + (let* ((posn (event-start click)) + (click-pt (posn-point posn)) + (window (posn-window posn)) + (buf (window-buffer window)) + ;; Don't let a subsequent kill command append to this one. + (this-command this-command) + ;; Check if the user has multi-clicked to select words/lines. + (click-count + (if (and (eq mouse-selection-click-count-buffer buf) + (with-current-buffer buf (mark t))) + mouse-selection-click-count + 0))) + (cond + ((not (numberp click-pt)) nil) + ;; If the user clicked without moving point, kill the region. + ;; This also resets `mouse-selection-click-count'. + ((and (eq last-command 'mouse-save-then-kill) + (eq click-pt mouse-save-then-kill-posn) + (eq window (selected-window))) + (kill-region (mark t) (point)) + (setq mouse-selection-click-count 0) + (setq mouse-save-then-kill-posn nil)) + + ;; Otherwise, if there is a suitable region, adjust it by moving + ;; one end (whichever is closer) to CLICK-PT. + ((or (with-current-buffer buf (region-active-p)) + (and (eq window (selected-window)) + (mark t) + (or (and (eq last-command 'mouse-save-then-kill) + mouse-save-then-kill-posn) + (and (memq last-command '(mouse-drag-region + mouse-set-region)) + (or mark-even-if-inactive + (not transient-mark-mode)))))) + (select-window window) + (let* ((range (mouse-start-end click-pt click-pt click-count))) + (if (< (abs (- click-pt (mark t))) + (abs (- click-pt (point)))) + (set-mark (car range)) + (goto-char (nth 1 range))) + (setq deactivate-mark nil) + (mouse-set-region-1) + ;; Arrange for a repeated mouse-3 to kill the region. + (setq mouse-save-then-kill-posn click-pt))) + + ;; Otherwise, set the mark where point is and move to CLICK-PT. + (t + (select-window window) + (mouse-set-mark-fast click) + (let ((before-scroll (with-current-buffer buf point-before-scroll))) + (if before-scroll (goto-char before-scroll))) + (exchange-point-and-mark) + (mouse-set-region-1) + (setq mouse-save-then-kill-posn click-pt))))) + (global-set-key [M-mouse-1] 'mouse-start-secondary) (global-set-key [M-drag-mouse-1] 'mouse-set-secondary) @@ -1520,9 +1484,6 @@ ;; of one word or line. (let ((range (mouse-start-end start-point start-point click-count))) (set-marker mouse-secondary-start nil) - ;; Why the double move? --Stef - ;; (move-overlay mouse-secondary-overlay 1 1 - ;; (window-buffer start-window)) (move-overlay mouse-secondary-overlay (car range) (nth 1 range) (window-buffer start-window))) ;; Single-press: cancel any preexisting secondary selection. @@ -1616,117 +1577,99 @@ (delete-overlay mouse-secondary-overlay)) (defun mouse-secondary-save-then-kill (click) - "Save text to point in kill ring; the second time, kill the text. -You must use this in a buffer where you have recently done \\[mouse-start-secondary]. -If the text between where you did \\[mouse-start-secondary] and where -you use this command matches the text at the front of the kill ring, -this command deletes the text. -Otherwise, it adds the text to the kill ring, like \\[kill-ring-save], -which prepares for a second click with this command to delete the text. - -If you have already made a secondary selection in that buffer, -this command extends or retracts the selection to where you click. -If you do this again in a different position, it extends or retracts -again. If you do this twice in the same position, it kills the selection." + "Set the secondary selection and save it to the kill ring. +The second time, kill it. CLICK should be a mouse click event. + +If you have not called `mouse-start-secondary' in the clicked +buffer, activate the secondary selection and set it between point +and the click position CLICK. + +Otherwise, adjust the bounds of the secondary selection. +Normally, do this by moving its beginning or end, whichever is +closer, to CLICK. But if you have selected whole words or lines, +adjust to the word or line boundary closest to CLICK instead. + +If this command is called a second consecutive time with the same +CLICK position, kill the secondary selection." (interactive "e") (mouse-minibuffer-check click) - (let ((posn (event-start click)) - (click-posn (posn-point (event-start click))) - ;; Don't let a subsequent kill command append to this one: - ;; prevent setting this-command to kill-region. - (this-command this-command)) - (or (eq (window-buffer (posn-window posn)) - (or (overlay-buffer mouse-secondary-overlay) - (if mouse-secondary-start - (marker-buffer mouse-secondary-start)))) - (error "Wrong buffer")) - (with-current-buffer (window-buffer (posn-window posn)) - (if (> (mod mouse-secondary-click-count 3) 0) - (if (not (and (eq last-command 'mouse-secondary-save-then-kill) - (equal click-posn - (car (cdr-safe (cdr-safe mouse-save-then-kill-posn)))))) - ;; Find both ends of the object selected by this click. - (let* ((range - (mouse-start-end click-posn click-posn - mouse-secondary-click-count))) - ;; Move whichever end is closer to the click. - ;; That's what xterm does, and it seems reasonable. - (if (< (abs (- click-posn (overlay-start mouse-secondary-overlay))) - (abs (- click-posn (overlay-end mouse-secondary-overlay)))) - (move-overlay mouse-secondary-overlay (car range) - (overlay-end mouse-secondary-overlay)) - (move-overlay mouse-secondary-overlay - (overlay-start mouse-secondary-overlay) - (nth 1 range))) - ;; We have already put the old region in the kill ring. - ;; Replace it with the extended region. - ;; (It would be annoying to make a separate entry.) - (kill-new (buffer-substring - (overlay-start mouse-secondary-overlay) - (overlay-end mouse-secondary-overlay)) t) - ;; Arrange for a repeated mouse-3 to kill this region. - (setq mouse-save-then-kill-posn - (list (car kill-ring) (point) click-posn))) - ;; If we click this button again without moving it, - ;; that time kill. - (progn - (mouse-save-then-kill-delete-region - (overlay-start mouse-secondary-overlay) - (overlay-end mouse-secondary-overlay)) - (setq mouse-save-then-kill-posn nil) - (setq mouse-secondary-click-count 0) - (delete-overlay mouse-secondary-overlay))) - (if (and (eq last-command 'mouse-secondary-save-then-kill) - mouse-save-then-kill-posn - (eq (car mouse-save-then-kill-posn) (car kill-ring)) - (equal (cdr mouse-save-then-kill-posn) (list (point) click-posn))) - ;; If this is the second time we've called - ;; mouse-secondary-save-then-kill, delete the text from the buffer. - (progn - (mouse-save-then-kill-delete-region - (overlay-start mouse-secondary-overlay) - (overlay-end mouse-secondary-overlay)) - (setq mouse-save-then-kill-posn nil) - (delete-overlay mouse-secondary-overlay)) - (if (overlay-start mouse-secondary-overlay) - ;; We have a selection, so adjust it. - (progn - (if (numberp click-posn) - (progn - ;; Move whichever end of the region is closer to the click. - ;; That is what xterm does, and it seems reasonable. - (if (< (abs (- click-posn (overlay-start mouse-secondary-overlay))) - (abs (- click-posn (overlay-end mouse-secondary-overlay)))) - (move-overlay mouse-secondary-overlay click-posn - (overlay-end mouse-secondary-overlay)) - (move-overlay mouse-secondary-overlay - (overlay-start mouse-secondary-overlay) - click-posn)) - (setq deactivate-mark nil))) - (if (eq last-command 'mouse-secondary-save-then-kill) - ;; If the front of the kill ring comes from - ;; an immediately previous use of this command, - ;; replace it with the extended region. - ;; (It would be annoying to make a separate entry.) - (kill-new (buffer-substring - (overlay-start mouse-secondary-overlay) - (overlay-end mouse-secondary-overlay)) t) - (let (deactivate-mark) - (copy-region-as-kill (overlay-start mouse-secondary-overlay) - (overlay-end mouse-secondary-overlay))))) - (if mouse-secondary-start - ;; All we have is one end of a selection, - ;; so put the other end here. - (let ((start (+ 0 mouse-secondary-start))) - (kill-ring-save start click-posn) - (move-overlay mouse-secondary-overlay start click-posn)))) - (setq mouse-save-then-kill-posn - (list (car kill-ring) (point) click-posn)))) - (if (overlay-buffer mouse-secondary-overlay) - (x-set-selection 'SECONDARY - (buffer-substring - (overlay-start mouse-secondary-overlay) - (overlay-end mouse-secondary-overlay))))))) + (let* ((posn (event-start click)) + (click-pt (posn-point posn)) + (window (posn-window posn)) + (buf (window-buffer window)) + ;; Don't let a subsequent kill command append to this one. + (this-command this-command) + ;; Check if the user has multi-clicked to select words/lines. + (click-count + (if (eq (overlay-buffer mouse-secondary-overlay) buf) + mouse-secondary-click-count + 0)) + (beg (overlay-start mouse-secondary-overlay)) + (end (overlay-end mouse-secondary-overlay))) + + (cond + ((not (numberp click-pt)) nil) + + ;; If the secondary selection is not active in BUF, activate it. + ((not (eq buf (or (overlay-buffer mouse-secondary-overlay) + (if mouse-secondary-start + (marker-buffer mouse-secondary-start))))) + (select-window window) + (setq mouse-secondary-start (make-marker)) + (move-marker mouse-secondary-start (point)) + (move-overlay mouse-secondary-overlay (point) click-pt buf) + (kill-ring-save (point) click-pt)) + + ;; If the user clicked without moving point, delete the secondary + ;; selection. This also resets `mouse-secondary-click-count'. + ((and (eq last-command 'mouse-secondary-save-then-kill) + (eq click-pt mouse-save-then-kill-posn) + (eq window (selected-window))) + (mouse-save-then-kill-delete-region beg end) + (delete-overlay mouse-secondary-overlay) + (setq mouse-secondary-click-count 0) + (setq mouse-save-then-kill-posn nil)) + + ;; Otherwise, if there is a suitable secondary selection overlay, + ;; adjust it by moving one end (whichever is closer) to CLICK-PT. + ((and beg (eq buf (overlay-buffer mouse-secondary-overlay))) + (let* ((range (mouse-start-end click-pt click-pt click-count))) + (if (< (abs (- click-pt beg)) + (abs (- click-pt end))) + (move-overlay mouse-secondary-overlay (car range) end) + (move-overlay mouse-secondary-overlay beg (nth 1 range)))) + (setq deactivate-mark nil) + (if (eq last-command 'mouse-secondary-save-then-kill) + ;; If the front of the kill ring comes from an immediately + ;; previous use of this command, replace the entry. + (kill-new + (buffer-substring (overlay-start mouse-secondary-overlay) + (overlay-end mouse-secondary-overlay)) + t) + (let (deactivate-mark) + (copy-region-as-kill (overlay-start mouse-secondary-overlay) + (overlay-end mouse-secondary-overlay)))) + (setq mouse-save-then-kill-posn click-pt)) + + ;; Otherwise, set the secondary selection overlay. + (t + (select-window window) + (if mouse-secondary-start + ;; All we have is one end of a selection, so put the other + ;; end here. + (let ((start (+ 0 mouse-secondary-start))) + (kill-ring-save start click-pt) + (move-overlay mouse-secondary-overlay start click-pt))) + (setq mouse-save-then-kill-posn click-pt)))) + + ;; Finally, set the window system's secondary selection. + (let (str) + (and (overlay-buffer mouse-secondary-overlay) + (setq str (buffer-substring (overlay-start mouse-secondary-overlay) + (overlay-end mouse-secondary-overlay))) + (> (length str) 0) + (x-set-selection 'SECONDARY str)))) + (defcustom mouse-buffer-menu-maxlen 20 "Number of buffers in one pane (submenu) of the buffer menu. @@ -1907,332 +1850,6 @@ ;; Few buffers--put them all in one pane. (list (cons title alist)))) -;; These need to be rewritten for the new scroll bar implementation. - -;;!! ;; Commands for the scroll bar. -;;!! -;;!! (defun mouse-scroll-down (click) -;;!! (interactive "@e") -;;!! (scroll-down (1+ (cdr (mouse-coords click))))) -;;!! -;;!! (defun mouse-scroll-up (click) -;;!! (interactive "@e") -;;!! (scroll-up (1+ (cdr (mouse-coords click))))) -;;!! -;;!! (defun mouse-scroll-down-full () -;;!! (interactive "@") -;;!! (scroll-down nil)) -;;!! -;;!! (defun mouse-scroll-up-full () -;;!! (interactive "@") -;;!! (scroll-up nil)) -;;!! -;;!! (defun mouse-scroll-move-cursor (click) -;;!! (interactive "@e") -;;!! (move-to-window-line (1+ (cdr (mouse-coords click))))) -;;!! -;;!! (defun mouse-scroll-absolute (event) -;;!! (interactive "@e") -;;!! (let* ((pos (car event)) -;;!! (position (car pos)) -;;!! (length (car (cdr pos)))) -;;!! (if (<= length 0) (setq length 1)) -;;!! (let* ((scale-factor (max 1 (/ length (/ 8000000 (buffer-size))))) -;;!! (newpos (* (/ (* (/ (buffer-size) scale-factor) -;;!! position) -;;!! length) -;;!! scale-factor))) -;;!! (goto-char newpos) -;;!! (recenter '(4))))) -;;!! -;;!! (defun mouse-scroll-left (click) -;;!! (interactive "@e") -;;!! (scroll-left (1+ (car (mouse-coords click))))) -;;!! -;;!! (defun mouse-scroll-right (click) -;;!! (interactive "@e") -;;!! (scroll-right (1+ (car (mouse-coords click))))) -;;!! -;;!! (defun mouse-scroll-left-full () -;;!! (interactive "@") -;;!! (scroll-left nil)) -;;!! -;;!! (defun mouse-scroll-right-full () -;;!! (interactive "@") -;;!! (scroll-right nil)) -;;!! -;;!! (defun mouse-scroll-move-cursor-horizontally (click) -;;!! (interactive "@e") -;;!! (move-to-column (1+ (car (mouse-coords click))))) -;;!! -;;!! (defun mouse-scroll-absolute-horizontally (event) -;;!! (interactive "@e") -;;!! (let* ((pos (car event)) -;;!! (position (car pos)) -;;!! (length (car (cdr pos)))) -;;!! (set-window-hscroll (selected-window) 33))) -;;!! -;;!! (global-set-key [scroll-bar mouse-1] 'mouse-scroll-up) -;;!! (global-set-key [scroll-bar mouse-2] 'mouse-scroll-absolute) -;;!! (global-set-key [scroll-bar mouse-3] 'mouse-scroll-down) -;;!! -;;!! (global-set-key [vertical-slider mouse-1] 'mouse-scroll-move-cursor) -;;!! (global-set-key [vertical-slider mouse-2] 'mouse-scroll-move-cursor) -;;!! (global-set-key [vertical-slider mouse-3] 'mouse-scroll-move-cursor) -;;!! -;;!! (global-set-key [thumbup mouse-1] 'mouse-scroll-up-full) -;;!! (global-set-key [thumbup mouse-2] 'mouse-scroll-up-full) -;;!! (global-set-key [thumbup mouse-3] 'mouse-scroll-up-full) -;;!! -;;!! (global-set-key [thumbdown mouse-1] 'mouse-scroll-down-full) -;;!! (global-set-key [thumbdown mouse-2] 'mouse-scroll-down-full) -;;!! (global-set-key [thumbdown mouse-3] 'mouse-scroll-down-full) -;;!! -;;!! (global-set-key [horizontal-scroll-bar mouse-1] 'mouse-scroll-left) -;;!! (global-set-key [horizontal-scroll-bar mouse-2] -;;!! 'mouse-scroll-absolute-horizontally) -;;!! (global-set-key [horizontal-scroll-bar mouse-3] 'mouse-scroll-right) -;;!! -;;!! (global-set-key [horizontal-slider mouse-1] -;;!! 'mouse-scroll-move-cursor-horizontally) -;;!! (global-set-key [horizontal-slider mouse-2] -;;!! 'mouse-scroll-move-cursor-horizontally) -;;!! (global-set-key [horizontal-slider mouse-3] -;;!! 'mouse-scroll-move-cursor-horizontally) -;;!! -;;!! (global-set-key [thumbleft mouse-1] 'mouse-scroll-left-full) -;;!! (global-set-key [thumbleft mouse-2] 'mouse-scroll-left-full) -;;!! (global-set-key [thumbleft mouse-3] 'mouse-scroll-left-full) -;;!! -;;!! (global-set-key [thumbright mouse-1] 'mouse-scroll-right-full) -;;!! (global-set-key [thumbright mouse-2] 'mouse-scroll-right-full) -;;!! (global-set-key [thumbright mouse-3] 'mouse-scroll-right-full) -;;!! -;;!! (global-set-key [horizontal-scroll-bar S-mouse-2] -;;!! 'mouse-split-window-horizontally) -;;!! (global-set-key [mode-line S-mouse-2] -;;!! 'mouse-split-window-horizontally) -;;!! (global-set-key [vertical-scroll-bar S-mouse-2] -;;!! 'mouse-split-window) - -;;!! ;;;; -;;!! ;;;; Here are experimental things being tested. Mouse events -;;!! ;;;; are of the form: -;;!! ;;;; ((x y) window screen-part key-sequence timestamp) -;;!! ;; -;;!! ;;;; -;;!! ;;;; Dynamically track mouse coordinates -;;!! ;;;; -;;!! ;; -;;!! ;;(defun track-mouse (event) -;;!! ;; "Track the coordinates, absolute and relative, of the mouse." -;;!! ;; (interactive "@e") -;;!! ;; (while mouse-grabbed -;;!! ;; (let* ((pos (read-mouse-position (selected-screen))) -;;!! ;; (abs-x (car pos)) -;;!! ;; (abs-y (cdr pos)) -;;!! ;; (relative-coordinate (coordinates-in-window-p -;;!! ;; (list (car pos) (cdr pos)) -;;!! ;; (selected-window)))) -;;!! ;; (if (consp relative-coordinate) -;;!! ;; (message "mouse: [%d %d], (%d %d)" abs-x abs-y -;;!! ;; (car relative-coordinate) -;;!! ;; (car (cdr relative-coordinate))) -;;!! ;; (message "mouse: [%d %d]" abs-x abs-y))))) -;;!! -;;!! ;; -;;!! ;; Dynamically put a box around the line indicated by point -;;!! ;; -;;!! ;; -;;!! ;;(require 'backquote) -;;!! ;; -;;!! ;;(defun mouse-select-buffer-line (event) -;;!! ;; (interactive "@e") -;;!! ;; (let ((relative-coordinate -;;!! ;; (coordinates-in-window-p (car event) (selected-window))) -;;!! ;; (abs-y (car (cdr (car event))))) -;;!! ;; (if (consp relative-coordinate) -;;!! ;; (progn -;;!! ;; (save-excursion -;;!! ;; (move-to-window-line (car (cdr relative-coordinate))) -;;!! ;; (x-draw-rectangle -;;!! ;; (selected-screen) -;;!! ;; abs-y 0 -;;!! ;; (save-excursion -;;!! ;; (move-to-window-line (car (cdr relative-coordinate))) -;;!! ;; (end-of-line) -;;!! ;; (push-mark nil t) -;;!! ;; (beginning-of-line) -;;!! ;; (- (region-end) (region-beginning))) 1)) -;;!! ;; (sit-for 1) -;;!! ;; (x-erase-rectangle (selected-screen)))))) -;;!! ;; -;;!! ;;(defvar last-line-drawn nil) -;;!! ;;(defvar begin-delim "[^ \t]") -;;!! ;;(defvar end-delim "[^ \t]") -;;!! ;; -;;!! ;;(defun mouse-boxing (event) -;;!! ;; (interactive "@e") -;;!! ;; (save-excursion -;;!! ;; (let ((screen (selected-screen))) -;;!! ;; (while (= (x-mouse-events) 0) -;;!! ;; (let* ((pos (read-mouse-position screen)) -;;!! ;; (abs-x (car pos)) -;;!! ;; (abs-y (cdr pos)) -;;!! ;; (relative-coordinate -;;!! ;; (coordinates-in-window-p `(,abs-x ,abs-y) -;;!! ;; (selected-window))) -;;!! ;; (begin-reg nil) -;;!! ;; (end-reg nil) -;;!! ;; (end-column nil) -;;!! ;; (begin-column nil)) -;;!! ;; (if (and (consp relative-coordinate) -;;!! ;; (or (not last-line-drawn) -;;!! ;; (not (= last-line-drawn abs-y)))) -;;!! ;; (progn -;;!! ;; (move-to-window-line (car (cdr relative-coordinate))) -;;!! ;; (if (= (following-char) 10) -;;!! ;; () -;;!! ;; (progn -;;!! ;; (setq begin-reg (1- (re-search-forward end-delim))) -;;!! ;; (setq begin-column (1- (current-column))) -;;!! ;; (end-of-line) -;;!! ;; (setq end-reg (1+ (re-search-backward begin-delim))) -;;!! ;; (setq end-column (1+ (current-column))) -;;!! ;; (message "%s" (buffer-substring begin-reg end-reg)) -;;!! ;; (x-draw-rectangle screen -;;!! ;; (setq last-line-drawn abs-y) -;;!! ;; begin-column -;;!! ;; (- end-column begin-column) 1)))))))))) -;;!! ;; -;;!! ;;(defun mouse-erase-box () -;;!! ;; (interactive) -;;!! ;; (if last-line-drawn -;;!! ;; (progn -;;!! ;; (x-erase-rectangle (selected-screen)) -;;!! ;; (setq last-line-drawn nil)))) -;;!! -;;!! ;;; (defun test-x-rectangle () -;;!! ;;; (use-local-mouse-map (setq rectangle-test-map (make-sparse-keymap))) -;;!! ;;; (define-key rectangle-test-map mouse-motion-button-left 'mouse-boxing) -;;!! ;;; (define-key rectangle-test-map mouse-button-left-up 'mouse-erase-box)) -;;!! -;;!! ;; -;;!! ;; Here is how to do double clicking in lisp. About to change. -;;!! ;; -;;!! -;;!! (defvar double-start nil) -;;!! (defconst double-click-interval 300 -;;!! "Max ticks between clicks") -;;!! -;;!! (defun double-down (event) -;;!! (interactive "@e") -;;!! (if double-start -;;!! (let ((interval (- (nth 4 event) double-start))) -;;!! (if (< interval double-click-interval) -;;!! (progn -;;!! (backward-up-list 1) -;;!! ;; (message "Interval %d" interval) -;;!! (sleep-for 1))) -;;!! (setq double-start nil)) -;;!! (setq double-start (nth 4 event)))) -;;!! -;;!! (defun double-up (event) -;;!! (interactive "@e") -;;!! (and double-start -;;!! (> (- (nth 4 event ) double-start) double-click-interval) -;;!! (setq double-start nil))) -;;!! -;;!! ;;; (defun x-test-doubleclick () -;;!! ;;; (use-local-mouse-map (setq doubleclick-test-map (make-sparse-keymap))) -;;!! ;;; (define-key doubleclick-test-map mouse-button-left 'double-down) -;;!! ;;; (define-key doubleclick-test-map mouse-button-left-up 'double-up)) -;;!! -;;!! ;; -;;!! ;; This scrolls while button is depressed. Use preferable in scroll bar. -;;!! ;; -;;!! -;;!! (defvar scrolled-lines 0) -;;!! (defconst scroll-speed 1) -;;!! -;;!! (defun incr-scroll-down (event) -;;!! (interactive "@e") -;;!! (setq scrolled-lines 0) -;;!! (incremental-scroll scroll-speed)) -;;!! -;;!! (defun incr-scroll-up (event) -;;!! (interactive "@e") -;;!! (setq scrolled-lines 0) -;;!! (incremental-scroll (- scroll-speed))) -;;!! -;;!! (defun incremental-scroll (n) -;;!! (while (= (x-mouse-events) 0) -;;!! (setq scrolled-lines (1+ (* scroll-speed scrolled-lines))) -;;!! (scroll-down n) -;;!! (sit-for 300 t))) -;;!! -;;!! (defun incr-scroll-stop (event) -;;!! (interactive "@e") -;;!! (message "Scrolled %d lines" scrolled-lines) -;;!! (setq scrolled-lines 0) -;;!! (sleep-for 1)) -;;!! -;;!! ;;; (defun x-testing-scroll () -;;!! ;;; (let ((scrolling-map (function mouse-vertical-scroll-bar-prefix))) -;;!! ;;; (define-key scrolling-map mouse-button-left 'incr-scroll-down) -;;!! ;;; (define-key scrolling-map mouse-button-right 'incr-scroll-up) -;;!! ;;; (define-key scrolling-map mouse-button-left-up 'incr-scroll-stop) -;;!! ;;; (define-key scrolling-map mouse-button-right-up 'incr-scroll-stop))) -;;!! -;;!! ;; -;;!! ;; Some playthings suitable for picture mode? They need work. -;;!! ;; -;;!! -;;!! (defun mouse-kill-rectangle (event) -;;!! "Kill the rectangle between point and the mouse cursor." -;;!! (interactive "@e") -;;!! (let ((point-save (point))) -;;!! (save-excursion -;;!! (mouse-set-point event) -;;!! (push-mark nil t) -;;!! (if (> point-save (point)) -;;!! (kill-rectangle (point) point-save) -;;!! (kill-rectangle point-save (point)))))) -;;!! -;;!! (defun mouse-open-rectangle (event) -;;!! "Kill the rectangle between point and the mouse cursor." -;;!! (interactive "@e") -;;!! (let ((point-save (point))) -;;!! (save-excursion -;;!! (mouse-set-point event) -;;!! (push-mark nil t) -;;!! (if (> point-save (point)) -;;!! (open-rectangle (point) point-save) -;;!! (open-rectangle point-save (point)))))) -;;!! -;;!! ;; Must be a better way to do this. -;;!! -;;!! (defun mouse-multiple-insert (n char) -;;!! (while (> n 0) -;;!! (insert char) -;;!! (setq n (1- n)))) -;;!! -;;!! ;; What this could do is not finalize until button was released. -;;!! -;;!! (defun mouse-move-text (event) -;;!! "Move text from point to cursor position, inserting spaces." -;;!! (interactive "@e") -;;!! (let* ((relative-coordinate -;;!! (coordinates-in-window-p (car event) (selected-window)))) -;;!! (if (consp relative-coordinate) -;;!! (cond ((> (current-column) (car relative-coordinate)) -;;!! (delete-char -;;!! (- (car relative-coordinate) (current-column)))) -;;!! ((< (current-column) (car relative-coordinate)) -;;!! (mouse-multiple-insert -;;!! (- (car relative-coordinate) (current-column)) " ")) -;;!! ((= (current-column) (car relative-coordinate)) (ding)))))) - (define-obsolete-function-alias 'mouse-choose-completion 'choose-completion "23.2") @@ -2475,10 +2092,6 @@ (mouse-menu-bar-map) (mouse-menu-major-mode-map))))) - -;; Replaced with dragging mouse-1 -;; (global-set-key [S-mouse-1] 'mouse-set-mark) - ;; Binding mouse-1 to mouse-select-window when on mode-, header-, or ;; vertical-line prevents Emacs from signaling an error when the mouse ;; button is released after dragging these lines, on non-toolkit ------------------------------------------------------------ revno: 101155 committer: Vinicius Jose Latorre + + * whitespace.el: Fix slow cursor movement. Reported by Christoph + Groth and Liu Xin . New version + 13.0. + (whitespace-empty-at-bob-regexp, whitespace-empty-at-eob-regexp): + Adjust initialization. + (whitespace-bob-marker, whitespace-eob-marker) + (whitespace-buffer-changed): New vars. + (whitespace-cleanup, whitespace-color-on, whitespace-color-off) + (whitespace-empty-at-bob-regexp, whitespace-empty-at-eob-regexp) + (whitespace-post-command-hook, whitespace-display-char-on): Adjust + code. + (whitespace-looking-back, whitespace-buffer-changed): New funs. + (whitespace-space-regexp, whitespace-tab-regexp): Eliminated + funs. + 2010-08-19 Stefan Monnier * files.el (locate-file-completion-table): Only list the .el and .elc @@ -6244,7 +6261,7 @@ * ps-print.el (ps-face-attributes): It was not returning the attribute face for faces specified as string. Reported by harven - . + . (Bug#5254) (ps-print-version): New version 7.3.5. 2009-12-18 Ulf Jasper === modified file 'lisp/whitespace.el' --- lisp/whitespace.el 2010-03-12 17:47:22 +0000 +++ lisp/whitespace.el 2010-08-21 04:43:04 +0000 @@ -6,7 +6,7 @@ ;; Author: Vinicius Jose Latorre ;; Maintainer: Vinicius Jose Latorre ;; Keywords: data, wp -;; Version: 12.1 +;; Version: 13.0 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre ;; This file is part of GNU Emacs. @@ -812,7 +812,7 @@ :group 'whitespace) -(defcustom whitespace-empty-at-bob-regexp "\\`\\(\\([ \t]*\n\\)+\\)" +(defcustom whitespace-empty-at-bob-regexp "^\\(\\([ \t]*\n\\)+\\)" "Specify regexp for empty lines at beginning of buffer. If you're using `mule' package, there may be other characters besides: @@ -827,7 +827,7 @@ :group 'whitespace) -(defcustom whitespace-empty-at-eob-regexp "^\\([ \t\n]+\\)\\'" +(defcustom whitespace-empty-at-eob-regexp "^\\([ \t\n]+\\)" "Specify regexp for empty lines at end of buffer. If you're using `mule' package, there may be other characters besides: @@ -1228,6 +1228,19 @@ "Used to save locally the font-lock refontify state. Used by `whitespace-post-command-hook' function (which see).") +(defvar whitespace-bob-marker nil + "Used to save locally the bob marker value. +Used by `whitespace-post-command-hook' function (which see).") + +(defvar whitespace-eob-marker nil + "Used to save locally the eob marker value. +Used by `whitespace-post-command-hook' function (which see).") + +(defvar whitespace-buffer-changed nil + "Used to indicate locally if buffer changed. +Used by `whitespace-post-command-hook' and `whitespace-buffer-changed' +functions (which see).") + ;;;###autoload (defun whitespace-toggle-options (arg) @@ -1463,10 +1476,10 @@ (let (overwrite-mode) ; enforce no overwrite (goto-char (point-min)) (when (re-search-forward - whitespace-empty-at-bob-regexp nil t) + (concat "\\`" whitespace-empty-at-bob-regexp) nil t) (delete-region (match-beginning 1) (match-end 1))) (when (re-search-forward - whitespace-empty-at-eob-regexp nil t) + (concat whitespace-empty-at-eob-regexp "\\'") nil t) (delete-region (match-beginning 1) (match-end 1))))))) ;; PROBLEM 3: 8 or more SPACEs at bol ;; PROBLEM 4: SPACEs before TAB @@ -2146,8 +2159,15 @@ (set (make-local-variable 'whitespace-point) (point)) (set (make-local-variable 'whitespace-font-lock-refontify) + 0) + (set (make-local-variable 'whitespace-bob-marker) + (point-min-marker)) + (set (make-local-variable 'whitespace-eob-marker) + (point-max-marker)) + (set (make-local-variable 'whitespace-buffer-changed) nil) (add-hook 'post-command-hook #'whitespace-post-command-hook nil t) + (add-hook 'before-change-functions #'whitespace-buffer-changed nil t) ;; turn off font lock (set (make-local-variable 'whitespace-font-lock-mode) font-lock-mode) @@ -2158,7 +2178,7 @@ nil (list ;; Show SPACEs - (list #'whitespace-space-regexp 1 whitespace-space t) + (list whitespace-space-regexp 1 whitespace-space t) ;; Show HARD SPACEs (list whitespace-hspace-regexp 1 whitespace-hspace t)) t)) @@ -2167,7 +2187,7 @@ nil (list ;; Show TABs - (list #'whitespace-tab-regexp 1 whitespace-tab t)) + (list whitespace-tab-regexp 1 whitespace-tab t)) t)) (when (memq 'trailing whitespace-active-style) (font-lock-add-keywords @@ -2296,7 +2316,8 @@ ;; turn off font lock (when (whitespace-style-face-p) (font-lock-mode 0) - (remove-hook 'post-command-hook #'whitespace-post-command-hook) + (remove-hook 'post-command-hook #'whitespace-post-command-hook t) + (remove-hook 'before-change-functions #'whitespace-buffer-changed t) (when whitespace-font-lock (setq whitespace-font-lock nil font-lock-keywords whitespace-font-lock-keywords)) @@ -2317,37 +2338,128 @@ (defun whitespace-empty-at-bob-regexp (limit) "Match spaces at beginning of buffer which do not contain the point at \ beginning of buffer." - (and (/= whitespace-point 1) - (re-search-forward whitespace-empty-at-bob-regexp limit t))) + (let ((b (point)) + r) + (cond + ;; at bob + ((= b 1) + (setq r (and (/= whitespace-point 1) + (looking-at whitespace-empty-at-bob-regexp))) + (if r + (set-marker whitespace-bob-marker (match-end 1)) + (set-marker whitespace-bob-marker b))) + ;; inside bob empty region + ((<= limit whitespace-bob-marker) + (setq r (looking-at whitespace-empty-at-bob-regexp)) + (if r + (when (< (match-end 1) limit) + (set-marker whitespace-bob-marker (match-end 1))) + (set-marker whitespace-bob-marker b))) + ;; intersection with end of bob empty region + ((<= b whitespace-bob-marker) + (setq r (looking-at whitespace-empty-at-bob-regexp)) + (if r + (set-marker whitespace-bob-marker (match-end 1)) + (set-marker whitespace-bob-marker b))) + ;; it is not inside bob empty region + (t + (setq r nil))) + ;; move to end of matching + (and r (goto-char (match-end 1))) + r)) + + +(defsubst whitespace-looking-back (regexp limit) + (save-excursion + (when (/= 0 (skip-chars-backward " \t\n" limit)) + (unless (bolp) + (forward-line 1)) + (looking-at regexp)))) (defun whitespace-empty-at-eob-regexp (limit) "Match spaces at end of buffer which do not contain the point at end of \ buffer." - (and (/= whitespace-point (1+ (buffer-size))) - (re-search-forward whitespace-empty-at-eob-regexp limit t))) - - -(defun whitespace-space-regexp (limit) - "Match spaces." - (setq whitespace-font-lock-refontify t) - (re-search-forward whitespace-space-regexp limit t)) - - -(defun whitespace-tab-regexp (limit) - "Match tabs." - (setq whitespace-font-lock-refontify t) - (re-search-forward whitespace-tab-regexp limit t)) + (let ((b (point)) + (e (1+ (buffer-size))) + r) + (cond + ;; at eob + ((= limit e) + (when (/= whitespace-point e) + (goto-char limit) + (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b))) + (if r + (set-marker whitespace-eob-marker (match-beginning 1)) + (set-marker whitespace-eob-marker limit) + (goto-char b))) ; return back to initial position + ;; inside eob empty region + ((>= b whitespace-eob-marker) + (goto-char limit) + (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b)) + (if r + (when (> (match-beginning 1) b) + (set-marker whitespace-eob-marker (match-beginning 1))) + (set-marker whitespace-eob-marker limit) + (goto-char b))) ; return back to initial position + ;; intersection with beginning of eob empty region + ((>= limit whitespace-eob-marker) + (goto-char limit) + (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b)) + (if r + (set-marker whitespace-eob-marker (match-beginning 1)) + (set-marker whitespace-eob-marker limit) + (goto-char b))) ; return back to initial position + ;; it is not inside eob empty region + (t + (setq r nil))) + r)) + + +(defun whitespace-buffer-changed (beg end) + "Set `whitespace-buffer-changed' variable to t." + (setq whitespace-buffer-changed t)) (defun whitespace-post-command-hook () "Save current point into `whitespace-point' variable. Also refontify when necessary." - (setq whitespace-point (point)) - (let ((refontify (or (eolp) ; end of line - (= whitespace-point 1)))) ; beginning of buffer - (when (or whitespace-font-lock-refontify refontify) - (setq whitespace-font-lock-refontify refontify) + (setq whitespace-point (point)) ; current point position + (let ((refontify + (or + ;; it is at end of line ... + (and (eolp) + ;; ... with trailing SPACE or TAB + (or (= (preceding-char) ?\ ) + (= (preceding-char) ?\t))) + ;; it is at beginning of buffer (bob) + (= whitespace-point 1) + ;; the buffer was modified and ... + (and whitespace-buffer-changed + (or + ;; ... or inside bob whitespace region + (<= whitespace-point whitespace-bob-marker) + ;; ... or at bob whitespace region border + (and (= whitespace-point (1+ whitespace-bob-marker)) + (= (preceding-char) ?\n)))) + ;; it is at end of buffer (eob) + (= whitespace-point (1+ (buffer-size))) + ;; the buffer was modified and ... + (and whitespace-buffer-changed + (or + ;; ... or inside eob whitespace region + (>= whitespace-point whitespace-eob-marker) + ;; ... or at eob whitespace region border + (and (= whitespace-point (1- whitespace-eob-marker)) + (= (following-char) ?\n))))))) + (when (or refontify (> whitespace-font-lock-refontify 0)) + (setq whitespace-buffer-changed nil) + ;; adjust refontify counter + (setq whitespace-font-lock-refontify + (if refontify + 1 + (1- whitespace-font-lock-refontify))) + ;; refontify (jit-lock-refontify)))) @@ -2386,11 +2498,11 @@ (unless whitespace-display-table-was-local (setq whitespace-display-table-was-local t whitespace-display-table + (copy-sequence buffer-display-table)) + ;; asure `buffer-display-table' is unique + ;; when two or more windows are visible. + (setq buffer-display-table (copy-sequence buffer-display-table))) - ;; asure `buffer-display-table' is unique - ;; when two or more windows are visible. - (set (make-local-variable 'buffer-display-table) - (copy-sequence buffer-display-table)) (unless buffer-display-table (setq buffer-display-table (make-display-table))) (dolist (entry whitespace-display-mappings) ------------------------------------------------------------ revno: 101154 committer: Glenn Morris branch nick: trunk timestamp: Fri 2010-08-20 19:21:51 -0700 message: ChangeLog fixes. diff: === modified file 'ChangeLog' --- ChangeLog 2010-08-20 19:55:21 +0000 +++ ChangeLog 2010-08-21 02:21:51 +0000 @@ -1,6 +1,6 @@ -2010-08-18 Joakim Verona +2010-08-18 Joakim Verona - * config.in, Makefile.in, configure.in: Checks for ImageMagick. + * Makefile.in, configure.in: Checks for ImageMagick. 2010-08-10 Dan Nicolaescu === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-08-20 20:00:00 +0000 +++ lisp/ChangeLog 2010-08-21 02:21:51 +0000 @@ -38,15 +38,15 @@ * emacs-lisp/autoload.el (make-autoload): Preload the macros's declarations that are useful before running the macro. -2010-08-18 Joakim Verona - * image.el: - (imagemagick-types-inhibit): New var. - (imagemagick-register-types): New function. - * image-mode.el: - (image-transform-properties): New function. +2010-08-18 Joakim Verona + + * image.el (imagemagick-types-inhibit): New variable. + (imagemagick-register-types): New function. + * image-mode.el (image-transform-properties): New function. (image-transform-set-scale, image-transform-fit-to-height) (image-transform-set-rotation, image-transform-set-resize) - (image-transform-fit-to-width, image-transform-fit-to-height):New functions. + (image-transform-fit-to-width, image-transform-fit-to-height): + New functions. (image-toggle-display-image): Support image transforms. 2010-08-18 Katsumi Yamaoka === modified file 'src/ChangeLog' --- src/ChangeLog 2010-08-20 23:02:11 +0000 +++ src/ChangeLog 2010-08-21 02:21:51 +0000 @@ -81,16 +81,16 @@ NXSecondaryPboard = SecondarySelection. (syms_of_nsselect): Intern QCLIPBOARD (Bug#6677). -2010-08-18 Joakim Verona +2010-08-18 Joakim Verona - * image.c: Add support for ImageMagick. When HAVE_IMAGEMAGICK is - defined: - (imagemagick_image_p): New function to test for ImageMagic img. - (imagemagick_load): New function to load ImageMagick img. - (imagemagick_load_image): New function, helper for imagemagick_load - (imagemagick-types): New function. - (Qimagemagick): New Lisp_object. - (imagemagick-render-type): New var, decides which renderer to use + * image.c: Add support for ImageMagick. When HAVE_IMAGEMAGICK is + defined: + (imagemagick_image_p): New function to test for ImageMagic image. + (imagemagick_load): New function to load ImageMagick image. + (imagemagick_load_image): New function, helper for imagemagick_load. + (imagemagick-types): New function. + (Qimagemagick): New Lisp_object. + (imagemagick-render-type): New variable, decides which renderer to use. 2010-08-17 Stefan Monnier ------------------------------------------------------------ revno: 101153 committer: Dan Nicolaescu branch nick: trunk timestamp: Fri 2010-08-20 16:02:11 -0700 message: Remove unused variables malloc_sbrk_used and malloc_sbrk_unused. * src/alloc.c (malloc_sbrk_used, malloc_sbrk_unused): Remove, write only. (init_alloc_once): Remove writes to malloc_sbrk_unused, and malloc_sbrk_used, nothing uses them. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-08-20 22:52:10 +0000 +++ src/ChangeLog 2010-08-20 23:02:11 +0000 @@ -1,5 +1,10 @@ 2010-08-20 Dan Nicolaescu + * alloc.c (malloc_sbrk_used, malloc_sbrk_unused): Remove, + write only. + (init_alloc_once): Remove writes to malloc_sbrk_unused, and + malloc_sbrk_used, nothing uses them. + * puresize.h: Remove code assuming PNTR_COMPARISON_TYPE is not defined, unconditionally defined in lisp.h. === modified file 'src/alloc.c' --- src/alloc.c 2010-08-07 01:10:12 +0000 +++ src/alloc.c 2010-08-20 23:02:11 +0000 @@ -214,16 +214,6 @@ int garbage_collection_messages; -#ifndef VIRT_ADDR_VARIES -extern -#endif /* VIRT_ADDR_VARIES */ -int malloc_sbrk_used; - -#ifndef VIRT_ADDR_VARIES -extern -#endif /* VIRT_ADDR_VARIES */ -int malloc_sbrk_unused; - /* Number of live and free conses etc. */ static int total_conses, total_markers, total_symbols, total_vector_size; @@ -6178,11 +6168,6 @@ consing_since_gc = 0; gc_cons_threshold = 100000 * sizeof (Lisp_Object); gc_relative_threshold = 0; - -#ifdef VIRT_ADDR_VARIES - malloc_sbrk_unused = 1<<22; /* A large number */ - malloc_sbrk_used = 100000; /* as reasonable as any number */ -#endif /* VIRT_ADDR_VARIES */ } void ------------------------------------------------------------ revno: 101152 committer: Dan Nicolaescu branch nick: trunk timestamp: Fri 2010-08-20 15:52:10 -0700 message: Small src/puresize.h cleanup. * src/puresize.h: Remove code assuming PNTR_COMPARISON_TYPE is not defined, unconditionally defined in lisp.h. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-08-20 22:44:38 +0000 +++ src/ChangeLog 2010-08-20 22:52:10 +0000 @@ -1,5 +1,8 @@ 2010-08-20 Dan Nicolaescu + * puresize.h: Remove code assuming PNTR_COMPARISON_TYPE is not + defined, unconditionally defined in lisp.h. + * term.c: Do not include , systty.h does it. * s/unixware.h (HAVE_TCATTR): === modified file 'src/puresize.h' --- src/puresize.h 2010-07-02 09:26:33 +0000 +++ src/puresize.h 2010-08-20 22:52:10 +0000 @@ -87,7 +87,6 @@ && (PNTR_COMPARISON_TYPE) XPNTR (obj) >= (PNTR_COMPARISON_TYPE) pure) #else /* not VIRT_ADDR_VARIES */ -#ifdef PNTR_COMPARISON_TYPE /* When PNTR_COMPARISON_TYPE is not the default (unsigned int). */ extern char my_edata[]; @@ -95,14 +94,6 @@ #define PURE_P(obj) \ ((PNTR_COMPARISON_TYPE) XPNTR (obj) < (PNTR_COMPARISON_TYPE) my_edata) -#else /* not VIRT_ADDRESS_VARIES, not PNTR_COMPARISON_TYPE */ - -extern char my_edata[]; - -#define PURE_P(obj) \ - (XPNTR (obj) < (unsigned int) my_edata) - -#endif /* PNTR_COMPARISON_TYPE */ #endif /* VIRT_ADDRESS_VARIES */ /* arch-tag: fd9b0a91-a70e-4729-a75a-6bb4ca1ce14f ------------------------------------------------------------ revno: 101151 committer: Dan Nicolaescu branch nick: trunk timestamp: Fri 2010-08-20 15:44:38 -0700 message: * src/term.c: Do not include , systty.h does it. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-08-20 22:36:07 +0000 +++ src/ChangeLog 2010-08-20 22:44:38 +0000 @@ -1,5 +1,7 @@ 2010-08-20 Dan Nicolaescu + * term.c: Do not include , systty.h does it. + * s/unixware.h (HAVE_TCATTR): * s/aix4-2.h (HAVE_TCATTR): Remove definitions, not needed. systty.h defines it when HAVE_TERMIOS is defined. === modified file 'src/term.c' --- src/term.c 2010-08-09 09:35:21 +0000 +++ src/term.c 2010-08-20 22:44:38 +0000 @@ -31,9 +31,6 @@ #include #endif -#if HAVE_TERMIOS_H -#include /* For TIOCNOTTY. */ -#endif #ifdef HAVE_SYS_IOCTL_H #include #endif ------------------------------------------------------------ revno: 101150 committer: Dan Nicolaescu branch nick: trunk timestamp: Fri 2010-08-20 15:36:07 -0700 message: Remove redundant HAVE_TCATTR defines. * src/s/unixware.h (HAVE_TCATTR): * src/s/aix4-2.h (HAVE_TCATTR): Remove definitions, not needed. systty.h defines it when HAVE_TERMIOS is defined. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-08-20 21:01:36 +0000 +++ src/ChangeLog 2010-08-20 22:36:07 +0000 @@ -1,3 +1,9 @@ +2010-08-20 Dan Nicolaescu + + * s/unixware.h (HAVE_TCATTR): + * s/aix4-2.h (HAVE_TCATTR): Remove definitions, not needed. + systty.h defines it when HAVE_TERMIOS is defined. + 2010-08-20 Eli Zaretskii * dispnew.c (buffer_posn_from_coords): Fix last change for text === modified file 'src/s/aix4-2.h' --- src/s/aix4-2.h 2010-07-29 20:01:08 +0000 +++ src/s/aix4-2.h 2010-08-20 22:36:07 +0000 @@ -55,10 +55,6 @@ /* Special items needed to make Emacs run on this system. */ -/* The following definition seems to be needed in AIX version 3.1.6.8. - It may not have been needed in certain earlier versions. */ -#define HAVE_TCATTR - /* AIX doesn't define this. */ #define unix 1 === modified file 'src/s/unixware.h' --- src/s/unixware.h 2010-07-29 18:34:39 +0000 +++ src/s/unixware.h 2010-08-20 22:36:07 +0000 @@ -21,8 +21,6 @@ #include "usg5-4-common.h" -/* fnf@cygnus.com says these exist. */ -#define HAVE_TCATTR /* #define HAVE_GETWD (appears to be buggy on SVR4.2) */ #undef HAVE_GETWD ------------------------------------------------------------ revno: 101149 [merge] committer: Eli Zaretskii branch nick: trunk timestamp: Sat 2010-08-21 00:01:36 +0300 message: Fix last change in buffer_posn_from_coords for text terminals. dispnew.c (buffer_posn_from_coords): Add one-character offset for R2L lines. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-08-20 20:00:00 +0000 +++ src/ChangeLog 2010-08-20 21:01:36 +0000 @@ -1,5 +1,8 @@ 2010-08-20 Eli Zaretskii + * dispnew.c (buffer_posn_from_coords): Fix last change for text + terminals: add one-character offset for R2L lines. + * emacs.c : Add a comment regarding msdos/mainmake.v2's dependency on the syntax of this declaration. === modified file 'src/dispnew.c' --- src/dispnew.c 2010-08-20 14:19:39 +0000 +++ src/dispnew.c 2010-08-20 20:55:09 +0000 @@ -5402,7 +5402,10 @@ iterator doesn't know about that.) The following line adjusts the pixel position to the iterator geometry, which is what move_it_* routines use. */ - to_x = window_box_width (w, TEXT_AREA) - to_x; + to_x = window_box_width (w, TEXT_AREA) - to_x + /* Text terminals need a one-character offset to get it right. */ + - (FRAME_MSDOS_P (WINDOW_XFRAME (w)) + || FRAME_TERMCAP_P (WINDOW_XFRAME (w))); /* Now move horizontally in the row to the glyph under *X. */ move_it_in_display_line (&it, ZV, to_x, MOVE_TO_X); ------------------------------------------------------------ revno: 101148 [merge] committer: Eli Zaretskii branch nick: trunk timestamp: Fri 2010-08-20 23:28:39 +0300 message: Fix the MSDOS build broken by the ImageMagick support. sed1v2.inp (IMAGEMAGICK_LIBS, IMAGEMAGICK_CFLAGS): Edit to empty. diff: === modified file 'msdos/ChangeLog' --- msdos/ChangeLog 2010-08-20 19:45:24 +0000 +++ msdos/ChangeLog 2010-08-20 20:26:12 +0000 @@ -1,3 +1,7 @@ +2010-08-20 Eli Zaretskii + + * sed1v2.inp (IMAGEMAGICK_LIBS, IMAGEMAGICK_CFLAGS): Edit to empty. + 2010-08-15 Eli Zaretskii * mainmake.v2 (version): Update due to change in emacs.c. === modified file 'msdos/sed1v2.inp' --- msdos/sed1v2.inp 2010-08-05 17:11:32 +0000 +++ msdos/sed1v2.inp 2010-08-20 20:26:12 +0000 @@ -88,6 +88,8 @@ /^CFLAGS_SOUND *=/s/@CFLAGS_SOUND@// /^RSVG_LIBS *=/s/@RSVG_LIBS@// /^RSVG_CFLAGS *=/s/@RSVG_CFLAGS@// +/^IMAGEMAGICK_LIBS *=/s/@IMAGEMAGICK_LIBS@// +/^IMAGEMAGICK_CFLAGS *=/s/@IMAGEMAGICK_CFLAGS@// /^WIDGET_OBJ *=/s/@WIDGET_OBJ@// /^CYGWIN_OBJ *=/s/@CYGWIN_OBJ@// /^MSDOS_OBJ *=/s/= */= dosfns.o msdos.o w16select.o/ ------------------------------------------------------------ revno: 101147 committer: Eli Zaretskii branch nick: trunk timestamp: Fri 2010-08-20 23:07:29 +0300 message: Add cross-references regarding POSITION of mouse events. commands.texi (Misc Events): Add cross-references to where POSITION of a mouse event is described in detail. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2010-08-08 21:12:29 +0000 +++ doc/lispref/ChangeLog 2010-08-20 20:07:29 +0000 @@ -1,3 +1,8 @@ +2010-08-20 Eli Zaretskii + + * commands.texi (Misc Events): Add cross-references to where + POSITION of a mouse event is described in detail. + 2010-08-08 Christoph * control.texi (Handling Errors) : Fix arg name. === modified file 'doc/lispref/commands.texi' --- doc/lispref/commands.texi 2010-06-24 19:05:47 +0000 +++ doc/lispref/commands.texi 2010-08-20 20:07:29 +0000 @@ -1616,7 +1616,8 @@ usual meaning is a kind of scroll or zoom. The element @var{position} is a list describing the position of the -event, in the same format as used in a mouse-click event. +event, in the same format as used in a mouse-click event (@pxref{Click +Events}). @vindex mouse-wheel-up-event @vindex mouse-wheel-down-event @@ -1633,9 +1634,10 @@ dropped onto an Emacs frame. The element @var{position} is a list describing the position of the -event, in the same format as used in a mouse-click event, and -@var{files} is the list of file names that were dragged and dropped. -The usual way to handle this event is by visiting these files. +event, in the same format as used in a mouse-click event (@pxref{Click +Events}), and @var{files} is the list of file names that were dragged +and dropped. The usual way to handle this event is by visiting these +files. This kind of event is generated, at present, only on some kinds of systems. ------------------------------------------------------------ revno: 101146 [merge] committer: joakim@verona.se branch nick: trunk timestamp: Fri 2010-08-20 22:01:27 +0200 message: imagemagick merge diff: === modified file 'ChangeLog' --- ChangeLog 2010-08-18 10:35:23 +0000 +++ ChangeLog 2010-08-20 19:55:21 +0000 @@ -1,3 +1,7 @@ +2010-08-18 Joakim Verona + + * config.in, Makefile.in, configure.in: Checks for ImageMagick. + 2010-08-10 Dan Nicolaescu * configure.in (AC_PREREQ): Require autoconf 2.65. @@ -139,21 +143,6 @@ * Makefile.in (install-arch-indep): Delete any old info .gz files first. -2010-06-12 Joakim Verona - - * image.c: Add support for ImageMagick. When HAVE_IMAGEMAGICK is - defined: - (imagemagick_image_p): New function to test for ImageMagic img. - (imagemagick_load): New function to load ImageMagick img. - (imagemagick_load_image): New function, helper for imagemagick_load - (imagemagick-types): New function. - (Qimagemagick): New Lisp_object. - (imagemagick-render-type): New var, decides which renderer to use - * image.el: - (imagemagick-types-inhibit): New var. - (imagemagick-register-types): New function. - * config.in, Makefile.in, configure.in - 2010-06-11 Glenn Morris * configure.in (--without-compress-info): New option. === modified file 'configure' --- configure 2010-08-17 21:19:11 +0000 +++ configure 2010-08-20 19:55:21 +0000 @@ -8726,7 +8726,7 @@ fi -$as_echo "#define HAVE_MAGICKEXPORTIMAGEPIXELS 1" >>confdefs.h +$as_echo "#define HAVE_MAGICKEXPORTIMAGEPIXELS 0" >>confdefs.h === modified file 'configure.in' --- configure.in 2010-08-17 21:19:11 +0000 +++ configure.in 2010-08-20 19:55:21 +0000 @@ -1852,7 +1852,7 @@ LIBS="$IMAGEMAGICK_LIBS $LIBS" fi - AC_DEFINE(HAVE_MAGICKEXPORTIMAGEPIXELS, 1, [Define to 1 if MagickExportImagePixels is defined.]) + AC_DEFINE(HAVE_MAGICKEXPORTIMAGEPIXELS, 0, [Define to 1 if MagickExportImagePixels is defined.]) AC_CHECK_FUNCS_ONCE(MagickExportImagePixels) fi === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-08-19 21:21:21 +0000 +++ lisp/ChangeLog 2010-08-20 20:00:00 +0000 @@ -38,6 +38,17 @@ * emacs-lisp/autoload.el (make-autoload): Preload the macros's declarations that are useful before running the macro. +2010-08-18 Joakim Verona + * image.el: + (imagemagick-types-inhibit): New var. + (imagemagick-register-types): New function. + * image-mode.el: + (image-transform-properties): New function. + (image-transform-set-scale, image-transform-fit-to-height) + (image-transform-set-rotation, image-transform-set-resize) + (image-transform-fit-to-width, image-transform-fit-to-height):New functions. + (image-toggle-display-image): Support image transforms. + 2010-08-18 Katsumi Yamaoka * image.el (create-animated-image): Don't add heuristic mask to image === modified file 'src/ChangeLog' --- src/ChangeLog 2010-08-20 19:49:20 +0000 +++ src/ChangeLog 2010-08-20 20:00:00 +0000 @@ -62,6 +62,17 @@ NXSecondaryPboard = SecondarySelection. (syms_of_nsselect): Intern QCLIPBOARD (Bug#6677). +2010-08-18 Joakim Verona + + * image.c: Add support for ImageMagick. When HAVE_IMAGEMAGICK is + defined: + (imagemagick_image_p): New function to test for ImageMagic img. + (imagemagick_load): New function to load ImageMagick img. + (imagemagick_load_image): New function, helper for imagemagick_load + (imagemagick-types): New function. + (Qimagemagick): New Lisp_object. + (imagemagick-render-type): New var, decides which renderer to use + 2010-08-17 Stefan Monnier * gtkutil.c (update_frame_tool_bar): Don't assume TOOL_BAR_ITEM_LABEL ------------------------------------------------------------ revno: 101145 [merge] committer: Eli Zaretskii branch nick: trunk timestamp: Fri 2010-08-20 22:49:20 +0300 message: Fix version string in top-level MSDOS Makefile. msdos/mainmake.v2 (version): Update due to change in emacs.c. src/emacs.c : Add a comment regarding msdos/mainmake.v2's dependency on the syntax of this declaration. diff: === modified file 'msdos/ChangeLog' --- msdos/ChangeLog 2010-08-05 17:11:32 +0000 +++ msdos/ChangeLog 2010-08-20 19:45:24 +0000 @@ -1,3 +1,7 @@ +2010-08-15 Eli Zaretskii + + * mainmake.v2 (version): Update due to change in emacs.c. + 2010-08-05 Eli Zaretskii * sed1v2.inp (UNEXEC_OBJ): Edit to unexcoff.o, due to renaming of === modified file 'msdos/mainmake.v2' --- msdos/mainmake.v2 2010-06-26 14:36:27 +0000 +++ msdos/mainmake.v2 2010-08-20 19:45:24 +0000 @@ -65,7 +65,7 @@ top_srcdir := $(subst \,/,$(shell cd)) # Find out which version of Emacs this is. -version := ${shell sed -n -e '/^const char emacs_version/s/^[^"]*\("[^"]*"\).*/\1/p' src/emacs.c} +version := ${shell sed -n -e '/^static const char emacs_version/s/^[^"]*\("[^"]*"\).*/\1/p' src/emacs.c} # Q: Do we need to bootstrap? # A: Only if we find admin/admin.el, i.e. we are building out of === modified file 'src/ChangeLog' --- src/ChangeLog 2010-08-20 14:19:39 +0000 +++ src/ChangeLog 2010-08-20 19:49:20 +0000 @@ -1,5 +1,10 @@ 2010-08-20 Eli Zaretskii + * emacs.c : Add a comment regarding + msdos/mainmake.v2's dependency on the syntax of this declaration. + +2010-08-20 Eli Zaretskii + * dispnew.c (buffer_posn_from_coords): Fix calculation of buffer position for R2L lines by mirroring the pixel position wrt the text are box. Improve commentary. === modified file 'src/emacs.c' --- src/emacs.c 2010-08-11 12:34:46 +0000 +++ src/emacs.c 2010-08-20 19:45:24 +0000 @@ -91,6 +91,8 @@ #endif #endif +/* If you change the following line, remember to update + msdos/mainmake.v2 which gleans the Emacs version from it! */ static const char emacs_copyright[] = "Copyright (C) 2010 Free Software Foundation, Inc."; static const char emacs_version[] = "24.0.50"; ------------------------------------------------------------ revno: 101144 committer: Eli Zaretskii branch nick: trunk timestamp: Fri 2010-08-20 17:31:38 +0300 message: xdisp.c: Add commentary about iterator geometry in R2L paragraphs. diff: === modified file 'src/xdisp.c' --- src/xdisp.c 2010-08-14 12:55:04 +0000 +++ src/xdisp.c 2010-08-20 14:31:38 +0000 @@ -217,7 +217,26 @@ glyph with suitably computed width. Both the blanks and the stretch glyph are given the face of the background of the line. This way, the terminal-specific back-end can still draw the glyphs - left to right, even for R2L lines. */ + left to right, even for R2L lines. + + Note one important detail mentioned above: that the bidi reordering + engine, driven by the iterator, produces characters in R2L rows + starting at the character that will be the rightmost on display. + As far as the iterator is concerned, the geometry of such rows is + still left to right, i.e. the iterator "thinks" the first character + is at the leftmost pixel position. The iterator does not know that + PRODUCE_GLYPHS reverses the order of the glyphs that the iterator + delivers. This is important when functions from the the move_it_* + family are used to get to certain screen position or to match + screen coordinates with buffer coordinates: these functions use the + iterator geometry, which is left to right even in R2L paragraphs. + This works well with most callers of move_it_*, because they need + to get to a specific column, and columns are still numbered in the + reading order, i.e. the rightmost character in a R2L paragraph is + still column zero. But some callers do not get well with this; a + notable example is mouse clicks that need to find the character + that corresponds to certain pixel coordinates. See + buffer_posn_from_coords in dispnew.c for how this is handled. */ #include #include ------------------------------------------------------------ revno: 101143 committer: Eli Zaretskii branch nick: trunk timestamp: Fri 2010-08-20 17:19:39 +0300 message: Fix mouse clicks, drag, and highlight in R2L lines. dispnew.c (buffer_posn_from_coords): Fix calculation of buffer position for R2L lines by mirroring the pixel position wrt the text are box. Improve commentary. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-08-20 12:02:43 +0000 +++ src/ChangeLog 2010-08-20 14:19:39 +0000 @@ -1,3 +1,9 @@ +2010-08-20 Eli Zaretskii + + * dispnew.c (buffer_posn_from_coords): Fix calculation of buffer + position for R2L lines by mirroring the pixel position wrt the + text are box. Improve commentary. + 2010-08-20 Andreas Schwab * image.c (imagemagick_clear_image): Remove debugging output. === modified file 'src/dispnew.c' --- src/dispnew.c 2010-08-06 14:54:06 +0000 +++ src/dispnew.c 2010-08-20 14:19:39 +0000 @@ -5351,9 +5351,15 @@ ***********************************************************************/ /* Determine what's under window-relative pixel position (*X, *Y). - Return the object (string or buffer) that's there. + Return the OBJECT (string or buffer) that's there. Return in *POS the position in that object. - Adjust *X and *Y to character positions. */ + Adjust *X and *Y to character positions. + Return in *DX and *DY the pixel coordinates of the click, + relative to the top left corner of OBJECT, or relative to + the top left corner of the character glyph at (*X, *Y) + if OBJECT is nil. + Return WIDTH and HEIGHT of the object at (*X, *Y), or zero + if the coordinates point to an empty area of the display. */ Lisp_Object buffer_posn_from_coords (struct window *w, int *x, int *y, struct display_pos *pos, Lisp_Object *object, int *dx, int *dy, int *width, int *height) @@ -5366,7 +5372,7 @@ #ifdef HAVE_WINDOW_SYSTEM struct image *img = 0; #endif - int x0, x1; + int x0, x1, to_x; /* We used to set current_buffer directly here, but that does the wrong thing with `face-remapping-alist' (bug#2044). */ @@ -5377,8 +5383,29 @@ start_display (&it, w, startp); x0 = *x - WINDOW_LEFT_MARGIN_WIDTH (w); - move_it_to (&it, -1, x0 + it.first_visible_x, *y, -1, - MOVE_TO_X | MOVE_TO_Y); + + /* First, move to the beginning of the row corresponding to *Y. We + need to be in that row to get the correct value of base paragraph + direction for the paragraph at *X. */ + move_it_to (&it, -1, 0, *y, -1, MOVE_TO_X | MOVE_TO_Y); + + /* TO_X is the pixel position that the iterator will compute for the + glyph at *X. This is because iterator positions are not offset + due to hscroll. */ + to_x = x0 + it.first_visible_x; + if (it.bidi_it.paragraph_dir == R2L) + /* For lines in an R2L paragraph, we need to mirror TO_X wrt the + text area. This is because the iterator, even in R2L + paragraphs, delivers glyphs as if they started at the left + margin of the window. (When we actually produce glyphs for + display, we reverse their order in PRODUCE_GLYPHS, but the + iterator doesn't know about that.) The following line adjusts + the pixel position to the iterator geometry, which is what + move_it_* routines use. */ + to_x = window_box_width (w, TEXT_AREA) - to_x; + + /* Now move horizontally in the row to the glyph under *X. */ + move_it_in_display_line (&it, ZV, to_x, MOVE_TO_X); Fset_buffer (old_current_buffer); ------------------------------------------------------------ revno: 101142 committer: Andreas Schwab branch nick: emacs timestamp: Fri 2010-08-20 14:02:43 +0200 message: * image.c (imagemagick_clear_image): Remove debugging output. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-08-19 15:53:08 +0000 +++ src/ChangeLog 2010-08-20 12:02:43 +0000 @@ -1,3 +1,7 @@ +2010-08-20 Andreas Schwab + + * image.c (imagemagick_clear_image): Remove debugging output. + 2010-08-19 Stefan Monnier * cmds.c (Vself_insert_face, Vself_insert_face_command): Remove. === modified file 'src/image.c' --- src/image.c 2010-08-19 07:29:27 +0000 +++ src/image.c 2010-08-20 12:02:43 +0000 @@ -7400,7 +7400,6 @@ imagemagick_clear_image (struct frame *f, struct image *img) { - printf("clearing imagemagick image\n"); x_clear_image (f, img); } @@ -7485,7 +7484,6 @@ image. Interface :index is same as for GIF. First we "ping" the image to see how many sub-images it contains. Pinging is faster than loading the image to find out things about it. */ - printf("im ping file %s\n", filename); image = image_spec_value (img->spec, QCindex, NULL); ino = INTEGERP (image) ? XFASTINT (image) : 0; ping_wand=NewMagickWand(); @@ -7519,7 +7517,6 @@ if (filename != NULL) { - printf("im read file %s\n", filename); image_info=CloneImageInfo((ImageInfo *) NULL); (void) strcpy(image_info->filename, filename); image_info -> number_scenes = 1; @@ -7529,7 +7526,6 @@ im_image = ReadImage (image_info, exception); CatchException(exception); - printf("im wand from image\n"); image_wand = NewMagickWandFromImage(im_image); } else @@ -7565,7 +7561,6 @@ } if(desired_width != -1 && desired_height != -1) { - printf("MagickScaleImage %d %d\n", desired_width, desired_height); status = MagickScaleImage(image_wand, desired_width, desired_height); if (status == MagickFalse) { image_error ("Imagemagick scale failed", Qnil, Qnil); @@ -7592,7 +7587,6 @@ h=XFASTINT(XCAR(XCDR(crop))); x=XFASTINT(XCAR(XCDR(XCDR(crop)))); y=XFASTINT(XCAR(XCDR(XCDR(XCDR(crop))))); - printf("MagickCropImage(image_wand, %d,%d, %d,%d)\n", w, h, x, y); MagickCropImage(image_wand, w,h, x,y); } @@ -7609,7 +7603,6 @@ PixelSetColor (background, "#ffffff");/*TODO remove hardcode*/ rotation = extract_float (value); - printf ("MagickRotateImage %f\n", rotation); status = MagickRotateImage (image_wand, background, rotation); DestroyPixelWand (background); @@ -7691,7 +7684,6 @@ int imagedepth = 24;/*MagickGetImageDepth(image_wand);*/ char* exportdepth = imagedepth <= 8 ? "I" : "BGRP";/*"RGBP";*/ /* Try to create a x pixmap to hold the imagemagick pixmap. */ - printf("imagedepth:%d exportdepth:%s\n", imagedepth, exportdepth); if (!x_create_x_image_and_pixmap (f, width, height, imagedepth, &ximg, &img->pixmap)){ image_error("Imagemagick X bitmap allocation failure", Qnil, Qnil); @@ -7758,7 +7750,6 @@ imagemagick_error: /* TODO more cleanup. */ image_error ("Error parsing IMAGEMAGICK image `%s'", img->spec, Qnil); - printf("Imagemagick error, see *Messages*\n"); return 0; } ------------------------------------------------------------ revno: 101141 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2010-08-19 23:21:21 +0200 message: * lisp/files.el (locate-file-completion-table): Only list the .el and .elc extensions if there's no other choice. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-08-19 15:43:45 +0000 +++ lisp/ChangeLog 2010-08-19 21:21:21 +0000 @@ -1,5 +1,8 @@ 2010-08-19 Stefan Monnier + * files.el (locate-file-completion-table): Only list the .el and .elc + extensions if there's no other choice (bug#5955). + * facemenu.el (facemenu-self-insert-data): New var. (facemenu-post-self-insert-function, facemenu-set-self-insert-face): New functions. === modified file 'lisp/files.el' --- lisp/files.el 2010-07-31 15:46:58 +0000 +++ lisp/files.el 2010-08-19 21:21:21 +0000 @@ -757,21 +757,44 @@ (let ((x (file-name-directory suffix))) (if x (1- (length x)) (length suffix)))))) (t - (let ((names nil) + (let ((names '()) + ;; If we have files like "foo.el" and "foo.elc", we could load one of + ;; them with "foo.el", "foo.elc", or "foo", where just "foo" is the + ;; preferred way. So if we list all 3, that gives a lot of redundant + ;; entries for the poor soul looking just for "foo". OTOH, sometimes + ;; the user does want to pay attention to the extension. We try to + ;; diffuse this tension by stripping the suffix, except when the + ;; result is a single element (i.e. usually we only list "foo" unless + ;; it's the only remaining element in the list, in which case we do + ;; list "foo", "foo.elc" and "foo.el"). + (fullnames '()) (suffix (concat (regexp-opt suffixes t) "\\'")) (string-dir (file-name-directory string)) (string-file (file-name-nondirectory string))) (dolist (dir dirs) - (unless dir - (setq dir default-directory)) - (if string-dir (setq dir (expand-file-name string-dir dir))) - (when (file-directory-p dir) - (dolist (file (file-name-all-completions - string-file dir)) - (push file names) - (when (string-match suffix file) - (setq file (substring file 0 (match-beginning 0))) - (push file names))))) + (unless dir + (setq dir default-directory)) + (if string-dir (setq dir (expand-file-name string-dir dir))) + (when (file-directory-p dir) + (dolist (file (file-name-all-completions + string-file dir)) + (if (not (string-match suffix file)) + (push file names) + (push file fullnames) + (push (substring file 0 (match-beginning 0)) names))))) + ;; Switching from names to names+fullnames creates a non-monotonicity + ;; which can cause problems with things like partial-completion. + ;; To minimize the problem, filter out completion-regexp-list, so that + ;; M-x load-library RET t/x.e TAB finds some files. + (if completion-regexp-list + (setq names (all-completions "" names))) + ;; Remove duplicates of the first element, so that we can easily check + ;; if `names' really only contains a single element. + (when (cdr names) (setcdr names (delete (car names) (cdr names)))) + (unless (cdr names) + ;; There's no more than one matching non-suffixed element, so expand + ;; the list by adding the suffixed elements as well. + (setq names (nconc names fullnames))) (completion-table-with-context string-dir names string-file pred action))))) ------------------------------------------------------------ Use --include-merges or -n0 to see merged revisions.