Using saved parent location: http://bzr.savannah.gnu.org/r/emacs/trunk/ Now on revision 103018. ------------------------------------------------------------ revno: 103018 committer: Stefan Monnier branch nick: trunk timestamp: Sat 2011-01-29 01:08:24 -0500 message: * lisp/progmodes/compile.el: Avoid an N² behavior in grep. (compilation--previous-directory): New fun. (compilation--previous-directory-cache): New var. (compilation--remove-properties): Flush it. (compilation-directory-properties, compilation-error-properties): Use the new fun to speed up looking for the current directory. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-01-29 03:12:32 +0000 +++ lisp/ChangeLog 2011-01-29 06:08:24 +0000 @@ -1,3 +1,12 @@ +2011-01-29 Stefan Monnier + + * progmodes/compile.el: Avoid an N² behavior in grep. + (compilation--previous-directory): New fun. + (compilation--previous-directory-cache): New var. + (compilation--remove-properties): Flush it. + (compilation-directory-properties, compilation-error-properties): + Use the new fun to speed up looking for the current directory. + 2011-01-29 Chong Yidong * vc/vc-hg.el (vc-hg-history): New var. @@ -18,8 +27,8 @@ * vc/vc-bzr.el (vc-bzr-async-command): Convert into a wrapper for vc-do-async-command. - * vc/vc-bzr.el (vc-bzr-pull, vc-bzr-merge-branch): Callers - changed. + * vc/vc-bzr.el (vc-bzr-pull, vc-bzr-merge-branch): + Callers changed. 2011-01-28 Leo === modified file 'lisp/progmodes/compile.el' --- lisp/progmodes/compile.el 2011-01-28 22:06:20 +0000 +++ lisp/progmodes/compile.el 2011-01-29 06:08:24 +0000 @@ -834,6 +834,39 @@ (:conc-name compilation--message->)) loc type end-loc) +(defvar compilation--previous-directory-cache nil) +(make-variable-buffer-local 'compilation--previous-directory-cache) +(defun compilation--previous-directory (pos) + "Like (previous-single-property-change POS 'compilation-directory), but faster." + ;; This avoids an N² behavior when there's no/few compilation-directory + ;; entries, in which case each call to previous-single-property-change + ;; ends up having to walk very far back to find the last change. + (let* ((cache (and compilation--previous-directory-cache + (<= (car compilation--previous-directory-cache) pos) + (car compilation--previous-directory-cache))) + (prev + (previous-single-property-change + pos 'compilation-directory nil cache))) + (cond + ((null cache) + (setq compilation--previous-directory-cache + (cons (copy-marker pos) (copy-marker prev))) + prev) + ((eq prev cache) + (if cache + (set-marker (car compilation--previous-directory-cache) pos) + (setq compilation--previous-directory-cache + (cons (copy-marker pos) nil))) + (cdr compilation--previous-directory-cache)) + (t + (if cache + (progn + (set-marker (car compilation--previous-directory-cache) pos) + (setcdr compilation--previous-directory-cache (copy-marker prev))) + (setq compilation--previous-directory-cache + (cons (copy-marker pos) (copy-marker prev)))) + prev)))) + ;; Internal function for calculating the text properties of a directory ;; change message. The compilation-directory property is important, because it ;; is the stack of nested enter-messages. Relative filenames on the following @@ -841,7 +874,7 @@ (defun compilation-directory-properties (idx leave) (if leave (setq leave (match-end leave))) ;; find previous stack, and push onto it, or if `leave' pop it - (let ((dir (previous-single-property-change (point) 'compilation-directory))) + (let ((dir (compilation--previous-directory (point)))) (setq dir (if dir (or (get-text-property (1- dir) 'compilation-directory) (get-text-property dir 'compilation-directory)))) `(font-lock-face ,(if leave @@ -900,8 +933,7 @@ (match-string-no-properties file)))) (let ((dir (unless (file-name-absolute-p file) - (let ((pos (previous-single-property-change - (point) 'compilation-directory))) + (let ((pos (compilation--previous-directory (point)))) (when pos (or (get-text-property (1- pos) 'compilation-directory) (get-text-property pos 'compilation-directory))))))) @@ -1064,6 +1096,14 @@ (defun compilation--remove-properties (&optional start end) (with-silent-modifications + (cond + ((or (not compilation--previous-directory-cache) + (<= (car compilation--previous-directory-cache) start))) + ((or (not (cdr compilation--previous-directory-cache)) + (<= (cdr compilation--previous-directory-cache) start)) + (set-marker (car compilation--previous-directory-cache) start)) + (t (setq compilation--previous-directory-cache nil))) + ;; When compile.el used font-lock directly, we could just remove all ;; our text-properties in one go, but now that we manually place ;; font-lock-face, we have to be careful to only remove the font-lock-face ------------------------------------------------------------ revno: 103017 committer: Chong Yidong branch nick: trunk timestamp: Fri 2011-01-28 22:12:32 -0500 message: Rudimentary support for vc-pull and vc-merge in Git and Mercurial. * lisp/vc/vc.el (vc-pull): Make vc-update an alias for this, instead of the other way around. * lisp/vc/vc-git.el (vc-git-branches, vc-git-pull) (vc-git-merge-branch): New functions. (vc-git-history): New var. * lisp/vc/vc-hg.el (vc-hg-history): New var. (vc-hg-pull): Perform default pull if called via Lisp by vc-pull. (vc-hg-merge-branch): New function. diff: === modified file 'etc/NEWS' --- etc/NEWS 2011-01-28 22:12:05 +0000 +++ etc/NEWS 2011-01-29 03:12:32 +0000 @@ -589,20 +589,20 @@ ** VC and related modes *** Support for pulling on distributed version control systems. -The vc-update command now runs a "pull" operation, if it is supported. +The vc-pull command runs a "pull" operation, if it is supported. This updates the current branch from upstream. A prefix argument -means to prompt the user for command specifics, e.g. a pull location. - -**** vc-pull is an alias for vc-update. - -**** Currently supported by Bzr. +means to prompt the user for specifics, e.g. a pull location. + +**** vc-update is now an alias for vc-update. + +**** Currently supported by Bzr, Git, and Mercurial. *** Support for merging on distributed version control systems. The vc-merge command now runs a "merge" operation, if it is supported. -This merges another branch into the current one. A prefix argument -means to prompt the user for command specifics, e.g. a merge location. +This merges another branch into the current one. This command prompts +the user for specifics, e.g. a merge source. -**** Currently supported by Bzr. +**** Currently supported by Bzr, Git, and Mercurial. ** Miscellaneous === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-01-28 23:10:55 +0000 +++ lisp/ChangeLog 2011-01-29 03:12:32 +0000 @@ -1,3 +1,16 @@ +2011-01-29 Chong Yidong + + * vc/vc-hg.el (vc-hg-history): New var. + (vc-hg-pull): Perform default pull if called via Lisp by vc-pull. + (vc-hg-merge-branch): New function. + + * vc/vc.el (vc-pull): Make vc-update an alias for this, instead of + the other way around. + + * vc/vc-git.el (vc-git-branches, vc-git-pull) + (vc-git-merge-branch): New functions. + (vc-git-history): New var. + 2011-01-28 Chong Yidong * vc/vc-dispatcher.el (vc-do-async-command): New function. === modified file 'lisp/vc/vc-dispatcher.el' --- lisp/vc/vc-dispatcher.el 2011-01-28 23:10:55 +0000 +++ lisp/vc/vc-dispatcher.el 2011-01-29 03:12:32 +0000 @@ -373,7 +373,7 @@ (unless (eq (point) (point-min)) (insert " \n")) (setq new-window-start (point)) - (insert "Running \"" command " ") + (insert "Running \"" command) (dolist (arg args) (insert " " arg)) (insert "\"...\n") === modified file 'lisp/vc/vc-git.el' --- lisp/vc/vc-git.el 2011-01-25 04:08:28 +0000 +++ lisp/vc/vc-git.el 2011-01-29 03:12:32 +0000 @@ -122,6 +122,9 @@ (defvar vc-git-commits-coding-system 'utf-8 "Default coding system for git commits.") +;; History of Git commands. +(defvar vc-git-history nil) + ;;; BACKEND PROPERTIES (defun vc-git-revision-granularity () 'repository) @@ -526,6 +529,21 @@ 'help-echo stash-help-echo 'face 'font-lock-variable-name-face)))))) +(defun vc-git-branches () + "Return the existing branches, as a list of strings. +The car of the list is the current branch." + (with-temp-buffer + (call-process "git" nil t nil "branch") + (goto-char (point-min)) + (let (current-branch branches) + (while (not (eobp)) + (when (looking-at "^\\([ *]\\) \\(.+\\)$") + (if (string-equal (match-string 1) "*") + (setq current-branch (match-string 2)) + (push (match-string 2) branches))) + (forward-line 1)) + (cons current-branch (nreverse branches))))) + ;;; STATE-CHANGING FUNCTIONS (defun vc-git-create-repo () @@ -587,6 +605,39 @@ (vc-git-command nil 0 file "reset" "-q" "--") (vc-git-command nil nil file "checkout" "-q" "--"))) +(defun vc-git-pull (prompt) + "Pull changes into the current Git branch. +Normally, this runs \"git pull\".If there is no default +location from which to pull or update, or if PROMPT is non-nil, +prompt for the Git command to run." + (let* ((root (vc-git-root default-directory)) + (buffer (format "*vc-git : %s*" (expand-file-name root))) + (command "pull") + (git-program "git") + args) + ;; If necessary, prompt for the exact command. + (when prompt + (setq args (split-string + (read-shell-command "Run Git (like this): " + "git pull" + 'vc-git-history) + " " t)) + (setq git-program (car args) + command (cadr args) + args (cddr args))) + (apply 'vc-do-async-command buffer root git-program command args))) + +(defun vc-git-merge-branch () + "Merge changes into the current Git branch. +This prompts for a branch to merge from." + (let* ((root (vc-git-root default-directory)) + (buffer (format "*vc-git : %s*" (expand-file-name root))) + (branches (cdr (vc-git-branches))) + (merge-source + (completing-read "Merge from branch: " branches nil t))) + (apply 'vc-do-async-command buffer root "git" "merge" + (list merge-source)))) + ;;; HISTORY FUNCTIONS (defun vc-git-print-log (files buffer &optional shortlog start-revision limit) === modified file 'lisp/vc/vc-hg.el' --- lisp/vc/vc-hg.el 2011-01-25 04:08:28 +0000 +++ lisp/vc/vc-hg.el 2011-01-29 03:12:32 +0000 @@ -141,6 +141,8 @@ ;;; Properties of the backend +(defvar vc-hg-history nil) + (defun vc-hg-revision-granularity () 'repository) (defun vc-hg-checkout-model (files) 'implicit) @@ -607,16 +609,41 @@ (mapcar (lambda (arg) (list "-r" arg)) marked-list))) (error "No log entries selected for push")))) -(defun vc-hg-pull () - (interactive) - (let ((marked-list (log-view-get-marked))) - (if marked-list - (apply #'vc-hg-command - nil 0 nil - "pull" - (apply 'nconc - (mapcar (lambda (arg) (list "-r" arg)) marked-list))) - (error "No log entries selected for pull")))) +(defun vc-hg-pull (prompt) + (interactive "P") + (let (marked-list) + (if (and (called-interactively-p 'interactive) + (setq marked-list (log-view-get-marked))) + (apply #'vc-hg-command + nil 0 nil + "pull" + (apply 'nconc + (mapcar (lambda (arg) (list "-r" arg)) + marked-list))) + (let* ((root (vc-hg-root default-directory)) + (buffer (format "*vc-hg : %s*" (expand-file-name root))) + (command "pull") + (hg-program "hg") + ;; Todo: maybe check if we're up-to-date before updating + ;; the working copy to the latest state. + (args '("-u"))) + ;; If necessary, prompt for the exact command. + (when prompt + (setq args (split-string + (read-shell-command "Run Hg (like this): " "hg -u" + 'vc-hg-history) + " " t)) + (setq hg-program (car args) + command (cadr args) + args (cddr args))) + (apply 'vc-do-async-command buffer root hg-program + command args))))) + +(defun vc-hg-merge-branch () + "Merge incoming changes into the current Mercurial working directory." + (let* ((root (vc-hg-root default-directory)) + (buffer (format "*vc-hg : %s*" (expand-file-name root)))) + (apply 'vc-do-async-command buffer root "hg" '("merge")))) ;;; Internal functions === modified file 'lisp/vc/vc.el' --- lisp/vc/vc.el 2011-01-26 08:36:39 +0000 +++ lisp/vc/vc.el 2011-01-29 03:12:32 +0000 @@ -2297,7 +2297,7 @@ (define-obsolete-function-alias 'vc-revert-buffer 'vc-revert "23.1") ;;;###autoload -(defun vc-update (&optional arg) +(defun vc-pull (&optional arg) "Update the current fileset or branch. On a distributed version control system, this runs a \"pull\" operation to update the current branch, prompting for an argument @@ -2337,7 +2337,7 @@ (error "VC update is unsupported for `%s'" backend))))) ;;;###autoload -(defalias 'vc-pull 'vc-update) +(defalias 'vc-update 'vc-pull) (defun vc-version-backup-file (file &optional rev) "Return name of backup file for revision REV of FILE. ------------------------------------------------------------ revno: 103016 author: Lars Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Sat 2011-01-29 02:29:38 +0000 message: gnus-art.el (article-update-date-lapsed): Try a better way to really keep point at the "same place". diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2011-01-28 23:07:38 +0000 +++ lisp/gnus/ChangeLog 2011-01-29 02:29:38 +0000 @@ -1,3 +1,8 @@ +2011-01-29 Lars Ingebrigtsen + + * gnus-art.el (article-update-date-lapsed): Try a better way to really + keep point at the "same place". + 2011-01-28 Lars Ingebrigtsen * gnus-sum.el (gnus-select-newsgroup): Don't try to alter the active === modified file 'lisp/gnus/gnus-art.el' --- lisp/gnus/gnus-art.el 2011-01-28 01:41:15 +0000 +++ lisp/gnus/gnus-art.el 2011-01-29 02:29:38 +0000 @@ -3692,28 +3692,22 @@ (lambda (w) (set-buffer (window-buffer w)) (when (eq major-mode 'gnus-article-mode) - (let ((mark (point-marker)) - (old-point (point))) + (let ((old-line (count-lines (point-min) (point))) + (old-column (current-column))) (goto-char (point-min)) (when (re-search-forward "^X-Sent:\\|^Date:" nil t) - ;; If the point is on the Date line, then use that - ;; absolute position. Otherwise, use the mark. - ;; This will ensure that point stays at the "same - ;; place". - (when (or (< old-point (match-beginning 0)) - (> old-point (progn - (forward-line 1) - (while (and (not (eobp)) - (looking-at "X-Sent:\\|Date:")) - (forward-line)) - (point)))) - (setq old-point nil)) (when gnus-treat-date-combined-lapsed (article-date-combined-lapsed t)) (when gnus-treat-date-lapsed (article-date-lapsed t))) - (goto-char (or old-point (marker-position mark))) - (move-marker mark nil)))) + (goto-char (point-min)) + (when (> old-column 0) + (setq old-line (1- old-line))) + (forward-line old-line) + (end-of-line) + (when (> (current-column) old-column) + (beginning-of-line) + (forward-char old-column))))) nil 'visible)))))) (defun gnus-start-date-timer (&optional n) ------------------------------------------------------------ revno: 103015 committer: Chong Yidong branch nick: trunk timestamp: Fri 2011-01-28 18:10:55 -0500 message: Convert vc-bzr-async-command into a general vc-do-async-command facility. * vc/vc-dispatcher.el (vc-do-async-command): New function. * vc/vc-bzr.el (vc-bzr-async-command): Convert into a wrapper for vc-do-async-command. * vc/vc-bzr.el (vc-bzr-pull, vc-bzr-merge-branch): Callers changed. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-01-28 22:12:05 +0000 +++ lisp/ChangeLog 2011-01-28 23:10:55 +0000 @@ -1,7 +1,17 @@ +2011-01-28 Chong Yidong + + * vc/vc-dispatcher.el (vc-do-async-command): New function. + + * vc/vc-bzr.el (vc-bzr-async-command): Convert into a wrapper for + vc-do-async-command. + + * vc/vc-bzr.el (vc-bzr-pull, vc-bzr-merge-branch): Callers + changed. + 2011-01-28 Leo * emacs-lisp/advice.el (ad-make-advised-docstring): Don't apply - highlighting to the "this function is advisted" message. + highlighting to the "this function is advised" message. * help-mode.el (help-mode-finish): Apply highlighting here, to avoid clobbering by substitute-command-keys (Bug#6304). === modified file 'lisp/vc/vc-bzr.el' --- lisp/vc/vc-bzr.el 2011-01-27 17:51:06 +0000 +++ lisp/vc/vc-bzr.el 2011-01-28 23:10:55 +0000 @@ -94,6 +94,20 @@ (apply 'vc-do-command (or buffer "*vc*") okstatus vc-bzr-program file-or-list bzr-command args))) +(defun vc-bzr-async-command (bzr-command &rest args) + "Wrapper round `vc-do-async-command' using `vc-bzr-program' as COMMAND. +Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and +`LC_MESSAGES=C' to the environment. +Use the current Bzr root directory as the ROOT argument to +`vc-do-async-command', and specify an output buffer named +\"*vc-bzr : ROOT*\"." + (let* ((process-environment + (list* "BZR_PROGRESS_BAR=none" "LC_MESSAGES=C" + process-environment)) + (root (vc-bzr-root default-directory)) + (buffer (format "*vc-bzr : %s*" (expand-file-name root)))) + (apply 'vc-do-async-command buffer root + vc-bzr-program bzr-command args))) ;;;###autoload (defconst vc-bzr-admin-dirname ".bzr" @@ -261,31 +275,6 @@ (when rootdir (file-relative-name filename* rootdir)))) -(defun vc-bzr-async-command (command args) - "Run Bzr COMMAND asynchronously with ARGS, displaying the result. -Send the output to a buffer named \"*vc-bzr : NAME*\", where NAME -is the root of the current Bzr branch. Display the buffer in -some window, but don't select it." - ;; TODO: set up hyperlinks. - (let* ((dir default-directory) - (root (vc-bzr-root default-directory)) - (buffer (get-buffer-create - (format "*vc-bzr : %s*" - (expand-file-name root))))) - (with-current-buffer buffer - (setq default-directory root) - (goto-char (point-max)) - (unless (eq (point) (point-min)) - (insert " \n")) - (insert "Running \"" vc-bzr-program " " command) - (dolist (arg args) - (insert " " arg)) - (insert "\"...\n") - ;; Run bzr in the original working directory. - (let ((default-directory dir)) - (apply 'vc-bzr-command command t 'async nil args))) - (display-buffer buffer))) - (defun vc-bzr-pull (prompt) "Pull changes into the current Bzr branch. Normally, this runs \"bzr pull\". However, if the branch is a @@ -315,7 +304,7 @@ (setq vc-bzr-program (car args) command (cadr args) args (cddr args))) - (vc-bzr-async-command command args))) + (apply 'vc-bzr-async-command command args))) (defun vc-bzr-merge-branch () "Merge another Bzr branch into the current one. @@ -324,8 +313,8 @@ default if it is available." (let* ((branch-conf (vc-bzr--branch-conf default-directory)) ;; "bzr merge" without an argument defaults to submit_branch, - ;; then parent_location. We extract the specific location - ;; and add it explicitly to the command line. + ;; then parent_location. Extract the specific location and + ;; add it explicitly to the command line. (location (cond ((string-match @@ -347,7 +336,7 @@ (vc-bzr-program (car cmd)) (command (cadr cmd)) (args (cddr cmd))) - (vc-bzr-async-command command args))) + (apply 'vc-bzr-async-command command args))) (defun vc-bzr-status (file) "Return FILE status according to Bzr. === modified file 'lisp/vc/vc-dispatcher.el' --- lisp/vc/vc-dispatcher.el 2011-01-26 08:36:39 +0000 +++ lisp/vc/vc-dispatcher.el 2011-01-28 23:10:55 +0000 @@ -356,6 +356,34 @@ ',command ',file-or-list ',flags)) status)))) +(defun vc-do-async-command (buffer root command &rest args) + "Run COMMAND asynchronously with ARGS, displaying the result. +Send the output to BUFFER, which should be a buffer or the name +of a buffer, which is created. +ROOT should be the directory in which the command should be run. +Display the buffer in some window, but don't select it." + (let* ((dir default-directory) + window new-window-start) + (setq buffer (get-buffer-create buffer)) + (if (get-buffer-process buffer) + (error "Another VC action on %s is running" root)) + (with-current-buffer buffer + (setq default-directory root) + (goto-char (point-max)) + (unless (eq (point) (point-min)) + (insert " \n")) + (setq new-window-start (point)) + (insert "Running \"" command " ") + (dolist (arg args) + (insert " " arg)) + (insert "\"...\n") + ;; Run in the original working directory. + (let ((default-directory dir)) + (apply 'vc-do-command t 'async command nil args))) + (setq window (display-buffer buffer)) + (if window + (set-window-start window new-window-start)))) + ;; These functions are used to ensure that the view the user sees is up to date ;; even if the dispatcher client mode has messed with file contents (as in, ;; for example, VCS keyword expansion). ------------------------------------------------------------ revno: 103014 author: Gnus developers committer: Katsumi Yamaoka branch nick: trunk timestamp: Fri 2011-01-28 23:07:38 +0000 message: Merge changes made in Gnus trunk. gnus-win.el: Remove dead function gnus-window-configuration-element. (gnus-all-windows-visible-p): Remove old compatibility code. (gnus-window-top-edge): Add docstring. gnus-sum.el (gnus-select-newsgroup): Don't try to alter the active data if the group is unactivated. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2011-01-28 11:27:24 +0000 +++ lisp/gnus/ChangeLog 2011-01-28 23:07:38 +0000 @@ -1,5 +1,14 @@ +2011-01-28 Lars Ingebrigtsen + + * gnus-sum.el (gnus-select-newsgroup): Don't try to alter the active + data if the group is unactivated. + 2011-01-28 Julien Danjou + * gnus-win.el: Remove dead function gnus-window-configuration-element. + (gnus-all-windows-visible-p): Remove old compatibility code. + (gnus-window-top-edge): Add docstring. + * gnus-group.el (gnus-group-jump-to-group): Set must match to t. 2011-01-28 Lars Ingebrigtsen === modified file 'lisp/gnus/gnus-sum.el' --- lisp/gnus/gnus-sum.el 2011-01-27 23:56:27 +0000 +++ lisp/gnus/gnus-sum.el 2011-01-28 23:07:38 +0000 @@ -5542,7 +5542,8 @@ (mm-decode-coding-string group charset) (mm-decode-coding-string (gnus-status-message group) charset))) - (when gnus-agent + (when (and gnus-agent + (gnus-active group)) (gnus-agent-possibly-alter-active group (gnus-active group) info) (setq gnus-summary-use-undownloaded-faces === modified file 'lisp/gnus/gnus-win.el' --- lisp/gnus/gnus-win.el 2011-01-25 04:08:28 +0000 +++ lisp/gnus/gnus-win.el 2011-01-28 23:07:38 +0000 @@ -38,9 +38,6 @@ :group 'gnus-windows :type 'boolean) -(defvar gnus-window-configuration nil - "Obsolete variable. See `gnus-buffer-configuration'.") - (defcustom gnus-window-min-width 2 "*Minimum width of Gnus buffers." :group 'gnus-windows @@ -221,12 +218,6 @@ (delete-frame (car gnus-created-frames)))) (pop gnus-created-frames))) -(defun gnus-window-configuration-element (list) - (while (and list - (not (assq (car list) gnus-window-configuration))) - (pop list)) - (cadr (assq (car list) gnus-window-configuration))) - ;;;###autoload (defun gnus-add-configuration (conf) "Add the window configuration CONF to `gnus-buffer-configuration'." @@ -446,11 +437,7 @@ type buffer win buf) (while (and (setq split (pop stack)) all-visible) - ;; Be backwards compatible. - (when (vectorp split) - (setq split (append split nil))) - (when (or (consp (car split)) - (vectorp (car split))) + (when (consp (car split)) (push 1.0 split) (push 'vertical split)) ;; The SPLIT might be something that is to be evaled to @@ -482,6 +469,7 @@ all-visible))) (defun gnus-window-top-edge (&optional window) + "Return the top coordinate of WINDOW." (nth 1 (window-edges window))) (defun gnus-remove-some-windows () ------------------------------------------------------------ revno: 103013 [merge] committer: Stefan Monnier branch nick: trunk timestamp: Fri 2011-01-28 17:12:05 -0500 message: * progmodes/compile.el: Don't use font-lock any more. diff: === modified file 'etc/NEWS' --- etc/NEWS 2011-01-27 21:41:47 +0000 +++ etc/NEWS 2011-01-28 22:12:05 +0000 @@ -321,6 +321,9 @@ * Changes in Specialized Modes and Packages in Emacs 24.1 +** The compile.el mode can be used without font-lock-mode. +`compilation-parse-errors-function' is now obsolete. + ** The Landmark game is now invoked with `landmark', not `lm'. ** Prolog mode has been completely revamped, with lots of additional === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-01-28 21:42:11 +0000 +++ lisp/ChangeLog 2011-01-28 22:12:05 +0000 @@ -13,6 +13,89 @@ 2011-01-28 Stefan Monnier + * progmodes/compile.el: Don't use font-lock any more. + (compilation-error-regexp-alist-alist): Change handling of makepp + so it preserves the warning/error distinction on subsequent files. + Simplify various rules. + (compilation-directory-properties): Use font-lock-face. + Add a compilation-message property. + (compilation-internal-error-properties): Use font-lock-face. + Don't set the compilation-debug property here. + (compilation--put-prop, compilation--remove-properties) + (compilation--parse-region, compilation--ensure-parse) + (compilation--ensure-parse): New functions. + (compilation-parse-errors): New function, largely inspired of + compilation-mode-font-lock-keywords. Set compilation-debug here. + (compilation--parsed): New var. + (compilation--flush-parse): Use compilation--ensure-parse. + (compilation-start): Don't call font-lock. + (compilation-turn-on-font-lock): Remove. + (compilation-setup): Don't set font-lock-extra-managed-props not change + other font-lock settings, other than keywords. + Don't activate font-lock-mode. + Set change-major-mode-hook and before-change-functions. + (compilation--unsetup): Remove properties and hooks. + (compilation-next-single-property-change): New function. + (compilation-next-error): Use it to parse when needed. + (compile-goto-error): Parse buffer as needed. + (compilation--compat-error-properties): Don't need a dummy `face' + property any more. + +2011-01-28 Stefan Monnier + + * progmodes/compile.el: Use accessors for clarity and fix omake hack. + (compilation-process-setup-function): Fix docstring's false promises. + (compilation-error-regexp-alist-alist): Catch omake's continuous + recompilation message and avoid reuse of old markers. + (compilation-parse-errors-function): Declare obsolete. + (compilation-buffer-modtime): Remove. + (compilation--make-cdrloc, compilation--loc->col) + (compilation--loc->line, compilation--loc->file-struct) + (compilation--loc->marker, compilation--loc->visited) + (compilation--make-file-struct, compilation--file-struct->file-spec) + (compilation--file-struct->formats) + (compilation--file-struct->loc-tree): New macros. Use them. + (compilation--message): New defstruct. Use them. + (compilation-next-error-function): Don't mess with timestamps to try + and guess when to reparse. + +2011-01-28 Stefan Monnier + + * textmodes/tex-mode.el: Get rid of compilation-parse-errors-function + (tex-old-error-file-name): New function, + extracted from tex-compilation-parse-errors. + (tex-compilation-parse-errors): Remove. + (tex-error-regexp-alist): New var. + (tex-shell): Use it to avoid compilation-parse-errors-function. + + * progmodes/grep.el (grep-regexp-alist): Tighten regexp. + (grep-mode-font-lock-keywords): Remove regexp that seems like + a left-over from before we used compile.el. + (grep-mode-font-lock-keywords): Call syntax-ppss-flush-cache when + modifying the buffer within with-silent-modifications. + + * progmodes/compile.el: Cleanup text-properties namespace by using + `compilation-message' instead of `message', `compilation-directory' + instead of `directory', and `compilation-debug' instead of `debug'. + (compilation-last-buffer, compilation-parsing-end) + (compilation-error-list, compilation-old-error-list): Move to the + compatibility part of the code. + (compilation-error-properties): If `file' is a function, let it return + a file name. + (compilation-mode-font-lock-keywords): Be more conservative with the + omake "^ *" pattern prefix, to try and minimize the risk of + pathologically slow regexp matching. + (compilation-start): Use inhibit-read-only. + (compilation--unsetup): New function. + (compilation-shell-minor-mode, compilation-minor-mode): Use it. + (compilation-filter): Minor tweaks. + (compilation-next-error-function): Try and avoid abusing variables. + (compilation--flush-file-structure): New fun. + (compilation-fake-loc): Use it to improve behavior when file is reused. + (debug-ignored-errors): Add "Moved past last ...". + (compilation--compat-error-properties) + (compilation--compat-parse-errors): Rename by doubling the "-". + Port features from the previous prolog.el to the new one. * progmodes/prolog.el (prolog-system): Add GNU and ECLiPSe options. (prolog-program-name, prolog-program-switches, prolog-consult-string) @@ -27,7 +110,7 @@ (prolog-inferior-self-insert-command): New command. (prolog-inferior-mode-map): Use it. (prolog-inferior-error-regexp-alist): New var. - (prolog-inferior-mode): Use it, along with compilation-shell-minor-mode. + (prolog-inferior-mode): Use it, with compilation-shell-minor-mode. (prolog-input-filter): Use derived-mode-p. (prolog-inferior-guess-flavor): New function. (prolog-ensure-process): Use it. Use make-comint-in-buffer rather than === modified file 'lisp/progmodes/compile.el' --- lisp/progmodes/compile.el 2011-01-25 04:08:28 +0000 +++ lisp/progmodes/compile.el 2011-01-28 22:06:20 +0000 @@ -28,57 +28,12 @@ ;; This package provides the compile facilities documented in the Emacs user's ;; manual. -;; This mode uses some complex data-structures: - -;; LOC (or location) is a list of (COLUMN LINE FILE-STRUCTURE) - -;; COLUMN and LINE are numbers parsed from an error message. COLUMN and maybe -;; LINE will be nil for a message that doesn't contain them. Then the -;; location refers to a indented beginning of line or beginning of file. -;; Once any location in some file has been jumped to, the list is extended to -;; (COLUMN LINE FILE-STRUCTURE MARKER TIMESTAMP . VISITED) -;; for all LOCs pertaining to that file. -;; MARKER initially points to LINE and COLUMN in a buffer visiting that file. -;; Being a marker it sticks to some text, when the buffer grows or shrinks -;; before that point. VISITED is t if we have jumped there, else nil. -;; TIMESTAMP is necessary because of "incremental compilation": `omake -P' -;; polls filesystem for changes and recompiles when a file is modified -;; using the same *compilation* buffer. this necessitates re-parsing markers. - -;; FILE-STRUCTURE is a list of -;; ((FILENAME DIRECTORY) FORMATS (LINE LOC ...) ...) - -;; FILENAME is a string parsed from an error message. DIRECTORY is a string -;; obtained by following directory change messages. DIRECTORY will be nil for -;; an absolute filename. FORMATS is a list of formats to apply to FILENAME if -;; a file of that name can't be found. -;; The rest of the list is an alist of elements with LINE as key. The keys -;; are either nil or line numbers. If present, nil comes first, followed by -;; the numbers in decreasing order. The LOCs for each line are again an alist -;; ordered the same way. Note that the whole file structure is referenced in -;; every LOC. - -;; MESSAGE is a list of (LOC TYPE END-LOC) - -;; TYPE is 0 for info or 1 for warning if the message matcher identified it as -;; such, 2 otherwise (for a real error). END-LOC is a LOC pointing to the -;; other end, if the parsed message contained a range. If the end of the -;; range didn't specify a COLUMN, it defaults to -1, meaning end of line. -;; These are the value of the `message' text-properties in the compilation -;; buffer. - ;;; Code: (eval-when-compile (require 'cl)) (require 'tool-bar) (require 'comint) -(defvar font-lock-extra-managed-props) -(defvar font-lock-keywords) -(defvar font-lock-maximum-size) -(defvar font-lock-support-mode) - - (defgroup compilation nil "Run compiler as inferior of Emacs, parse error messages." :group 'tools @@ -122,9 +77,7 @@ "*Function to call to customize the compilation process. This function is called immediately before the compilation process is started. It can be used to set any variables or functions that are used -while processing the output of the compilation process. The function -is called with variables `compilation-buffer' and `compilation-window' -bound to the compilation buffer and window, respectively.") +while processing the output of the compilation process.") ;;;###autoload (defvar compilation-buffer-name-function nil @@ -284,11 +237,15 @@ "^makepp\\(?:\\(?:: warning\\(:\\).*?\\|\\(: Scanning\\|: [LR]e?l?oading makefile\\|: Imported\\|log:.*?\\) \\|: .*?\\)\ `\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)['(]\\)" 4 5 nil (1 . 2) 3 - ("`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)['(]" nil nil - (2 compilation-info-face) - (3 compilation-line-face nil t) - (1 (compilation-error-properties 2 3 nil nil nil 0 nil) - append))) + (0 (progn (save-match-data + (compilation-parse-errors + (match-end 0) (line-end-position) + `("`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)['(]" + 2 3 nil + ,(cond ((match-end 1) 1) ((match-end 2) 0) (t 2)) + 1))) + (end-of-line) + nil))) ;; This regexp is pathologically slow on long lines (Bug#3441). ;; (maven @@ -311,7 +268,12 @@ (omake ;; "omake -P" reports "file foo changed" ;; (useful if you do "cvs up" and want to see what has changed) - "omake: file \\(.*\\) changed" 1) + "omake: file \\(.*\\) changed" 1 nil nil nil nil + ;; FIXME-omake: This tries to prevent reusing pre-existing markers + ;; for subsequent messages, since those messages's line numbers + ;; are about another version of the file. + (0 (progn (compilation--flush-file-structure (match-string 1)) + nil))) (oracle "^\\(?:Semantic error\\|Error\\|PCC-[0-9]+:\\).* line \\([0-9]+\\)\ @@ -368,12 +330,10 @@ (gcov-file "^ *-: *\\(0\\):Source:\\(.+\\)$" - 2 1 nil 0 nil - (1 compilation-line-face prepend) (2 compilation-info-face prepend)) + 2 1 nil 0 nil) (gcov-header "^ *-: *\\(0\\):\\(?:Object\\|Graph\\|Data\\|Runs\\|Programs\\):.+$" - nil 1 nil 0 nil - (1 compilation-line-face prepend)) + nil 1 nil 0 nil) ;; Underlines over all lines of gcov output are too uncomfortable to read. ;; However, hyperlinks embedded in the lines are useful. ;; So I put default face on the lines; and then put @@ -382,18 +342,18 @@ (gcov-nomark "^ *-: *\\([1-9]\\|[0-9]\\{2,\\}\\):.*$" nil 1 nil 0 nil - (0 'default t) - (1 compilation-line-face prepend)) + (0 'default) + (1 compilation-line-face)) (gcov-called-line "^ *\\([0-9]+\\): *\\([0-9]+\\):.*$" nil 2 nil 0 nil - (0 'default t) - (1 compilation-info-face prepend) (2 compilation-line-face prepend)) + (0 'default) + (1 compilation-info-face) (2 compilation-line-face)) (gcov-never-called "^ *\\(#####\\): *\\([0-9]+\\):.*$" nil 2 nil 2 nil - (0 'default t) - (1 compilation-error-face prepend) (2 compilation-line-face prepend)) + (0 'default) + (1 compilation-error-face) (2 compilation-line-face)) (perl--Pod::Checker ;; podchecker error messages, per Pod::Checker. @@ -505,8 +465,9 @@ `compilation-message-face' applied. If this is nil, the text matched by the whole REGEXP becomes the hyperlink. -Additional HIGHLIGHTs as described under `font-lock-keywords' can -be added." +Additional HIGHLIGHTs take the shape (SUBMATCH FACE), where SUBMATCH is +the number of a submatch that should be highlighted when it matches, +and FACE is an expression returning the face to use for that submatch.." :type '(repeat (choice (symbol :tag "Predefined symbol") (sexp :tag "Error specification"))) :link `(file-link :tag "example file" @@ -544,10 +505,10 @@ (1 font-lock-function-name-face) (3 compilation-line-face nil t)) (" -\\(?:o[= ]?\\|-\\(?:outfile\\|output\\)[= ]\\)\\(\\S +\\)" . 1) ("^Compilation \\(finished\\).*" - (0 '(face nil message nil help-echo nil mouse-face nil) t) + (0 '(face nil compilation-message nil help-echo nil mouse-face nil) t) (1 compilation-info-face)) ("^Compilation \\(exited abnormally\\|interrupt\\|killed\\|terminated\\|segmentation fault\\)\\(?:.*with code \\([0-9]+\\)\\)?.*" - (0 '(face nil message nil help-echo nil mouse-face nil) t) + (0 '(face nil compilation-message nil help-echo nil mouse-face nil) t) (1 compilation-error-face) (2 compilation-error-face nil t))) "Additional things to highlight in Compilation mode. @@ -738,11 +699,9 @@ ;; Used for compatibility with the old compile.el. -(defvaralias 'compilation-last-buffer 'next-error-last-buffer) -(defvar compilation-parsing-end (make-marker)) (defvar compilation-parse-errors-function nil) -(defvar compilation-error-list nil) -(defvar compilation-old-error-list nil) +(make-obsolete 'compilation-parse-errors-function + 'compilation-error-regexp-alist "24.1") (defcustom compilation-auto-jump-to-first-error nil "If non-nil, automatically jump to the first error during compilation." @@ -754,9 +713,9 @@ "If non-nil, automatically jump to the next error encountered.") (make-variable-buffer-local 'compilation-auto-jump-to-next) -(defvar compilation-buffer-modtime nil - "The buffer modification time, for buffers not associated with files.") -(make-variable-buffer-local 'compilation-buffer-modtime) +;; (defvar compilation-buffer-modtime nil +;; "The buffer modification time, for buffers not associated with files.") +;; (make-variable-buffer-local 'compilation-buffer-modtime) (defvar compilation-skip-to-next-location t "*If non-nil, skip multiple error messages for the same source location.") @@ -802,23 +761,99 @@ (and (cdr type) (match-end (cdr type)) compilation-info-face) compilation-error-face)) +;; LOC (or location) is a list of (COLUMN LINE FILE-STRUCTURE nil nil) + +;; COLUMN and LINE are numbers parsed from an error message. COLUMN and maybe +;; LINE will be nil for a message that doesn't contain them. Then the +;; location refers to a indented beginning of line or beginning of file. +;; Once any location in some file has been jumped to, the list is extended to +;; (COLUMN LINE FILE-STRUCTURE MARKER TIMESTAMP . VISITED) +;; for all LOCs pertaining to that file. +;; MARKER initially points to LINE and COLUMN in a buffer visiting that file. +;; Being a marker it sticks to some text, when the buffer grows or shrinks +;; before that point. VISITED is t if we have jumped there, else nil. +;; FIXME-omake: TIMESTAMP was used to try and handle "incremental compilation": +;; `omake -P' polls filesystem for changes and recompiles when a file is +;; modified using the same *compilation* buffer. this necessitates +;; re-parsing markers. + +;; (defstruct (compilation--loc +;; (:constructor nil) +;; (:copier nil) +;; (:constructor compilation--make-loc +;; (file-struct line col marker)) +;; (:conc-name compilation--loc->)) +;; col line file-struct marker timestamp visited) + +;; FIXME: We don't use a defstruct because of compilation-assq which looks up +;; and creates part of the LOC (only the first cons cell containing the COL). + +(defmacro compilation--make-cdrloc (line file-struct marker) + `(list ,line ,file-struct ,marker nil)) +(defmacro compilation--loc->col (loc) `(car ,loc)) +(defmacro compilation--loc->line (loc) `(cadr ,loc)) +(defmacro compilation--loc->file-struct (loc) `(nth 2 ,loc)) +(defmacro compilation--loc->marker (loc) `(nth 3 ,loc)) +;; (defmacro compilation--loc->timestamp (loc) `(nth 4 ,loc)) +(defmacro compilation--loc->visited (loc) `(nthcdr 5 ,loc)) + +;; FILE-STRUCTURE is a list of +;; ((FILENAME DIRECTORY) FORMATS (LINE LOC ...) ...) + +;; FILENAME is a string parsed from an error message. DIRECTORY is a string +;; obtained by following directory change messages. DIRECTORY will be nil for +;; an absolute filename. FORMATS is a list of formats to apply to FILENAME if +;; a file of that name can't be found. +;; The rest of the list is an alist of elements with LINE as key. The keys +;; are either nil or line numbers. If present, nil comes first, followed by +;; the numbers in decreasing order. The LOCs for each line are again an alist +;; ordered the same way. Note that the whole file structure is referenced in +;; every LOC. + +(defmacro compilation--make-file-struct (file-spec formats &optional loc-tree) + `(cons ,file-spec (cons ,formats ,loc-tree))) +(defmacro compilation--file-struct->file-spec (fs) `(car ,fs)) +(defmacro compilation--file-struct->formats (fs) `(cadr ,fs)) +;; The FORMATS field plays the role of ANCHOR in the loc-tree. +(defmacro compilation--file-struct->loc-tree (fs) `(cdr ,fs)) + +;; MESSAGE is a list of (LOC TYPE END-LOC) + +;; TYPE is 0 for info or 1 for warning if the message matcher identified it as +;; such, 2 otherwise (for a real error). END-LOC is a LOC pointing to the +;; other end, if the parsed message contained a range. If the end of the +;; range didn't specify a COLUMN, it defaults to -1, meaning end of line. +;; These are the value of the `compilation-message' text-properties in the +;; compilation buffer. + +(defstruct (compilation--message + (:constructor nil) + (:copier nil) + ;; (:type list) ;Old representation. + (:constructor compilation--make-message (loc type end-loc)) + (:conc-name compilation--message->)) + loc type end-loc) + ;; Internal function for calculating the text properties of a directory -;; change message. The directory property is important, because it is -;; the stack of nested enter-messages. Relative filenames on the following +;; change message. The compilation-directory property is important, because it +;; is the stack of nested enter-messages. Relative filenames on the following ;; lines are relative to the top of the stack. (defun compilation-directory-properties (idx leave) (if leave (setq leave (match-end leave))) ;; find previous stack, and push onto it, or if `leave' pop it - (let ((dir (previous-single-property-change (point) 'directory))) - (setq dir (if dir (or (get-text-property (1- dir) 'directory) - (get-text-property dir 'directory)))) - `(face ,(if leave - compilation-leave-directory-face - compilation-enter-directory-face) - directory ,(if leave - (or (cdr dir) - '(nil)) ; nil only isn't a property-change - (cons (match-string-no-properties idx) dir)) + (let ((dir (previous-single-property-change (point) 'compilation-directory))) + (setq dir (if dir (or (get-text-property (1- dir) 'compilation-directory) + (get-text-property dir 'compilation-directory)))) + `(font-lock-face ,(if leave + compilation-leave-directory-face + compilation-enter-directory-face) + compilation-directory ,(if leave + (or (cdr dir) + '(nil)) ; nil only isn't a property-change + (cons (match-string-no-properties idx) dir)) + ;; Place a `compilation-message' everywhere we change text-properties + ;; so compilation--remove-properties can know what to remove. + compilation-message ,(compilation--make-message nil 0 nil) mouse-face highlight keymap compilation-button-map help-echo "mouse-2: visit destination directory"))) @@ -857,28 +892,29 @@ ;; Return a property list with all meta information on this error location. (defun compilation-error-properties (file line end-line col end-col type fmt) - (unless (< (next-single-property-change (match-beginning 0) - 'directory nil (point)) - (point)) + (unless (text-property-not-all (match-beginning 0) (point) + 'compilation-message nil) (if file - (if (functionp file) - (setq file (funcall file)) - (let (dir) - (setq file (match-string-no-properties file)) + (when (stringp + (setq file (if (functionp file) (funcall file) + (match-string-no-properties file)))) + (let ((dir (unless (file-name-absolute-p file) - (setq dir (previous-single-property-change (point) 'directory) - dir (if dir (or (get-text-property (1- dir) 'directory) - (get-text-property dir 'directory))))) + (let ((pos (previous-single-property-change + (point) 'compilation-directory))) + (when pos + (or (get-text-property (1- pos) 'compilation-directory) + (get-text-property pos 'compilation-directory))))))) (setq file (cons file (car dir))))) ;; This message didn't mention one, get it from previous (let ((prev-pos ;; Find the previous message. - (previous-single-property-change (point) 'message))) + (previous-single-property-change (point) 'compilation-message))) (if prev-pos ;; Get the file structure that belongs to it. (let* ((prev - (or (get-text-property (1- prev-pos) 'message) - (get-text-property prev-pos 'message))) + (or (get-text-property (1- prev-pos) 'compilation-message) + (get-text-property prev-pos 'compilation-message))) (prev-struct (car (nth 2 (car prev))))) ;; Construct FILE . DIR from that. @@ -917,7 +953,8 @@ (run-with-timer 0 nil 'compilation-auto-jump (current-buffer) (match-beginning 0))) - (compilation-internal-error-properties file line end-line col end-col type fmt))) + (compilation-internal-error-properties + file line end-line col end-col type fmt))) (defun compilation-move-to-column (col screen) "Go to column COL on the current line. @@ -938,22 +975,25 @@ (let* ((file-struct (compilation-get-file-structure file fmts)) ;; Get first already existing marker (if any has one, all have one). ;; Do this first, as the compilation-assq`s may create new nodes. - (marker-line (car (cddr file-struct))) ; a line structure - (marker (nth 3 (cadr marker-line))) ; its marker + (marker-line ; a line structure + (cadr (compilation--file-struct->loc-tree file-struct))) + (marker + (if marker-line (compilation--loc->marker (cadr marker-line)))) (compilation-error-screen-columns compilation-error-screen-columns) end-marker loc end-loc) (if (not (and marker (marker-buffer marker))) (setq marker nil) ; no valid marker for this file (setq loc (or line 1)) ; normalize no linenumber to line 1 (catch 'marker ; find nearest loc, at least one exists - (dolist (x (nthcdr 3 file-struct)) ; loop over remaining lines + (dolist (x (cddr (compilation--file-struct->loc-tree + file-struct))) ; Loop over remaining lines. (if (> (car x) loc) ; still bigger (setq marker-line x) (if (> (- (or (car marker-line) 1) loc) (- loc (car x))) ; current line is nearer (setq marker-line x)) (throw 'marker t)))) - (setq marker (nth 3 (cadr marker-line)) + (setq marker (compilation--loc->marker (cadr marker-line)) marker-line (or (car marker-line) 1)) (with-current-buffer (marker-buffer marker) (save-excursion @@ -966,7 +1006,7 @@ (end-of-line) (compilation-move-to-column end-col compilation-error-screen-columns)) - (setq end-marker (list (point-marker)))) + (setq end-marker (point-marker))) (beginning-of-line (if end-line (- line end-line -1) (- loc marker-line -1))) @@ -974,120 +1014,260 @@ (compilation-move-to-column col compilation-error-screen-columns) (forward-to-indentation 0)) - (setq marker (list (point-marker))))))) + (setq marker (point-marker)))))) - (setq loc (compilation-assq line (cdr file-struct))) + (setq loc (compilation-assq line (compilation--file-struct->loc-tree + file-struct))) + (setq end-loc (if end-line - (setq end-loc (compilation-assq end-line (cdr file-struct)) - end-loc (compilation-assq end-col end-loc)) + (compilation-assq + end-col (compilation-assq + end-line (compilation--file-struct->loc-tree + file-struct))) (if end-col ; use same line element - (setq end-loc (compilation-assq end-col loc)))) + (compilation-assq end-col loc)))) (setq loc (compilation-assq col loc)) ;; If they are new, make the loc(s) reference the file they point to. - (or (cdr loc) (setcdr loc `(,line ,file-struct ,@marker))) + ;; FIXME-omake: there's a problem with timestamps here: the markers + ;; relative to which we computed the current `marker' have a timestamp + ;; almost guaranteed to be different from compilation-buffer-modtime, so if + ;; we use their timestamp, we'll never use `loc' since the timestamp won't + ;; match compilation-buffer-modtime, and if we use + ;; compilation-buffer-modtime then we have different timestamps for + ;; locations that were computed together, which doesn't make sense either. + ;; I think this points to a fundamental problem in our approach to the + ;; "omake -P" problem. --Stef + (or (cdr loc) + (setcdr loc (compilation--make-cdrloc line file-struct marker))) (if end-loc (or (cdr end-loc) - (setcdr end-loc `(,(or end-line line) ,file-struct ,@end-marker)))) + (setcdr end-loc + (compilation--make-cdrloc (or end-line line) file-struct + end-marker)))) ;; Must start with face - `(face ,compilation-message-face - message (,loc ,type ,end-loc) - ,@(if compilation-debug - `(debug (,(assoc (with-no-warnings matcher) font-lock-keywords) - ,@(match-data)))) - help-echo ,(if col - "mouse-2: visit this file, line and column" - (if line - "mouse-2: visit this file and line" - "mouse-2: visit this file")) - keymap compilation-button-map - mouse-face highlight))) + `(font-lock-face ,compilation-message-face + compilation-message ,(compilation--make-message loc type end-loc) + help-echo ,(if col + "mouse-2: visit this file, line and column" + (if line + "mouse-2: visit this file and line" + "mouse-2: visit this file")) + keymap compilation-button-map + mouse-face highlight))) + +(defun compilation--put-prop (matchnum prop val) + (when (and (integerp matchnum) (match-beginning matchnum)) + (put-text-property + (match-beginning matchnum) (match-end matchnum) + prop val))) + +(defun compilation--remove-properties (&optional start end) + (with-silent-modifications + ;; When compile.el used font-lock directly, we could just remove all + ;; our text-properties in one go, but now that we manually place + ;; font-lock-face, we have to be careful to only remove the font-lock-face + ;; we placed. + ;; (remove-list-of-text-properties + ;; (or start (point-min)) (or end (point-max)) + ;; '(compilation-debug compilation-directory compilation-message + ;; font-lock-face help-echo mouse-face)) + (let (next) + (unless start (setq start (point-min))) + (unless end (setq end (point-max))) + (while + (progn + (setq next (or (next-single-property-change + start 'compilation-message nil end) + end)) + (when (get-text-property start 'compilation-message) + (remove-list-of-text-properties + start next + '(compilation-debug compilation-directory compilation-message + font-lock-face help-echo mouse-face))) + (< next end)) + (setq start next))))) + +(defun compilation--parse-region (start end) + (goto-char end) + (unless (bolp) + ;; We generally don't like to parse partial lines. + (assert (eobp)) + (when (let ((proc (get-buffer-process (current-buffer)))) + (and proc (memq (process-status proc) '(run open)))) + (setq end (line-beginning-position)))) + (compilation--remove-properties start end) + (if compilation-parse-errors-function + ;; An old package! Try the compatibility code. + (progn + (goto-char start) + (compilation--compat-parse-errors end)) + + ;; compilation-directory-matcher is the only part that really needs to be + ;; parsed sequentially. So we could split it out, handle directories + ;; like syntax-propertize, and the rest as font-lock-keywords. But since + ;; we want to have it work even when font-lock is off, we'd then need to + ;; use our own compilation-parsed text-property to keep track of the parts + ;; that have already been parsed. + (goto-char start) + (while (re-search-forward (car compilation-directory-matcher) + end t) + (when compilation-debug + (font-lock-append-text-property + (match-beginning 0) (match-end 0) + 'compilation-debug + (vector 'directory compilation-directory-matcher))) + (dolist (elt (cdr compilation-directory-matcher)) + (add-text-properties (match-beginning (car elt)) + (match-end (car elt)) + (compilation-directory-properties + (car elt) (cdr elt))))) + + (compilation-parse-errors start end))) + +(defun compilation-parse-errors (start end &rest rules) + "Parse errors between START and END. +The errors recognized are the ones specified in RULES which default +to `compilation-error-regexp-alist' if RULES is nil." + (message "compilation-parse-errors: %S %S" start end) + (dolist (item (or rules compilation-error-regexp-alist)) + (if (symbolp item) + (setq item (cdr (assq item + compilation-error-regexp-alist-alist)))) + (let ((file (nth 1 item)) + (line (nth 2 item)) + (col (nth 3 item)) + (type (nth 4 item)) + (pat (car item)) + end-line end-col fmt + props) + + ;; omake reports some error indented, so skip the indentation. + ;; another solution is to modify (some?) regexps in + ;; `compilation-error-regexp-alist'. + ;; note that omake usage is not limited to ocaml and C (for stubs). + ;; FIXME-omake: Doing it here seems wrong, at least it should depend on + ;; whether or not omake's own error messages are recognized. + (cond + ((not (memq 'omake compilation-error-regexp-alist)) nil) + ((string-match "\\`\\([^^]\\|^\\( \\*\\|\\[\\)\\)" pat) + nil) ;; Not anchored or anchored but already allows empty spaces. + (t (setq pat (concat "^ *" (substring pat 1))))) + + (if (consp file) (setq fmt (cdr file) file (car file))) + (if (consp line) (setq end-line (cdr line) line (car line))) + (if (consp col) (setq end-col (cdr col) col (car col))) + + (if (functionp line) + ;; The old compile.el had here an undocumented hook that + ;; allowed `line' to be a function that computed the actual + ;; error location. Let's do our best. + (progn + (goto-char start) + (while (re-search-forward pat end t) + (save-match-data + (when compilation-debug + (font-lock-append-text-property + (match-beginning 0) (match-end 0) + 'compilation-debug (vector 'functionp item))) + (add-text-properties + (match-beginning 0) (match-end 0) + (compilation--compat-error-properties + (funcall line (cons (match-string file) + (cons default-directory + (nthcdr 4 item))) + (if col (match-string col)))))) + (compilation--put-prop + file 'font-lock-face compilation-error-face))) + + (unless (or (null (nth 5 item)) (integerp (nth 5 item))) + (error "HYPERLINK should be an integer: %s" (nth 5 item))) + + (goto-char start) + (while (re-search-forward pat end t) + + (when (setq props (compilation-error-properties + file line end-line col end-col (or type 2) fmt)) + + (when (integerp file) + (compilation--put-prop + file 'font-lock-face + (if (consp type) + (compilation-face type) + (symbol-value (aref [compilation-info-face + compilation-warning-face + compilation-error-face] + (or type 2)))))) + + (compilation--put-prop + line 'font-lock-face compilation-line-face) + (compilation--put-prop + end-line 'font-lock-face compilation-line-face) + + (compilation--put-prop + col 'font-lock-face compilation-column-face) + (compilation--put-prop + end-col 'font-lock-face compilation-column-face) + + (dolist (extra-item (nthcdr 6 item)) + (let ((mn (pop extra-item))) + (when (match-beginning mn) + (let ((face (eval (car extra-item)))) + (cond + ((null face)) + ((symbolp face) + (put-text-property + (match-beginning mn) (match-end mn) + 'font-lock-face face)) + (t + (error "Don't know how to handle face %S" + face))))))) + (let ((mn (or (nth 5 item) 0))) + (when compilation-debug + (font-lock-append-text-property + (match-beginning 0) (match-end 0) + 'compilation-debug (vector 'std item props))) + (add-text-properties + (match-beginning mn) (match-end mn) + (cddr props)) + (font-lock-append-text-property + (match-beginning mn) (match-end mn) + 'font-lock-face (cadr props))))))))) + +(defvar compilation--parsed -1) +(make-variable-buffer-local 'compilation--parsed) + +(defun compilation--ensure-parse (limit) + "Make sure the text has been parsed up to LIMIT." + (save-excursion + (goto-char limit) + (setq limit (line-beginning-position 2)) + (unless (markerp compilation--parsed) + ;; We use a marker for compilation--parsed so that users (such as + ;; grep.el) don't need to flush-parse when they modify the buffer + ;; in a way that impacts buffer positions but does not require + ;; re-parsing. + (setq compilation--parsed (point-min-marker))) + (when (< compilation--parsed limit) + (let ((start (max compilation--parsed (point-min)))) + (move-marker compilation--parsed limit) + (goto-char start) + (forward-line 0) ;Not line-beginning-position: ignore (comint) fields. + (with-silent-modifications + (compilation--parse-region (point) compilation--parsed))))) + nil) + +(defun compilation--flush-parse (start end) + "Mark the region between START and END for re-parsing." + (message "compilation--flush-parse: %S %S" start end) + (if (markerp compilation--parsed) + (move-marker compilation--parsed (min start compilation--parsed)))) (defun compilation-mode-font-lock-keywords () "Return expressions to highlight in Compilation mode." - (if compilation-parse-errors-function - ;; An old package! Try the compatibility code. - '((compilation-compat-parse-errors)) - (append - ;; make directory tracking - (if compilation-directory-matcher - `((,(car compilation-directory-matcher) - ,@(mapcar (lambda (elt) - `(,(car elt) - (compilation-directory-properties - ,(car elt) ,(cdr elt)) - t t)) - (cdr compilation-directory-matcher))))) - - ;; Compiler warning/error lines. - (mapcar - (lambda (item) - (if (symbolp item) - (setq item (cdr (assq item - compilation-error-regexp-alist-alist)))) - (let ((file (nth 1 item)) - (line (nth 2 item)) - (col (nth 3 item)) - (type (nth 4 item)) - (pat (car item)) - end-line end-col fmt) - ;; omake reports some error indented, so skip the indentation. - ;; another solution is to modify (some?) regexps in - ;; `compilation-error-regexp-alist'. - ;; note that omake usage is not limited to ocaml and C (for stubs). - (when (and (= ?^ (aref pat 0)) ; anchored: starts with "^" - ;; but does not allow an arbitrary number of leading spaces - (not (and (= ? (aref pat 1)) (= ?* (aref pat 2))))) - (setq pat (concat "^ *" (substring pat 1)))) - (if (consp file) (setq fmt (cdr file) file (car file))) - (if (consp line) (setq end-line (cdr line) line (car line))) - (if (consp col) (setq end-col (cdr col) col (car col))) - - (if (functionp line) - ;; The old compile.el had here an undocumented hook that - ;; allowed `line' to be a function that computed the actual - ;; error location. Let's do our best. - `(,pat - (0 (save-match-data - (compilation-compat-error-properties - (funcall ',line (cons (match-string ,file) - (cons default-directory - ',(nthcdr 4 item))) - ,(if col `(match-string ,col)))))) - (,file compilation-error-face t)) - - (unless (or (null (nth 5 item)) (integerp (nth 5 item))) - (error "HYPERLINK should be an integer: %s" (nth 5 item))) - - `(,pat - - ,@(when (integerp file) - `((,file ,(if (consp type) - `(compilation-face ',type) - (aref [compilation-info-face - compilation-warning-face - compilation-error-face] - (or type 2)))))) - - ,@(when line - `((,line compilation-line-face nil t))) - ,@(when end-line - `((,end-line compilation-line-face nil t))) - - ,@(when (integerp col) - `((,col compilation-column-face nil t))) - ,@(when (integerp end-col) - `((,end-col compilation-column-face nil t))) - - ,@(nthcdr 6 item) - (,(or (nth 5 item) 0) - (compilation-error-properties ',file ,line ,end-line - ,col ,end-col ',(or type 2) - ',fmt) - append))))) ; for compilation-message-face - compilation-error-regexp-alist) - - compilation-mode-font-lock-keywords))) + (append + '((compilation--ensure-parse)) + compilation-mode-font-lock-keywords)) (defun compilation-read-command (command) (read-shell-command "Compile command: " command @@ -1383,7 +1563,7 @@ ;; Insert the output at the end, after the initial text, ;; regardless of where the user sees point. (goto-char (point-max)) - (let* ((buffer-read-only nil) ; call-process needs to modify outbuf + (let* ((inhibit-read-only t) ; call-process needs to modify outbuf (status (call-process shell-file-name nil outbuf nil "-c" command))) (cond ((numberp status) @@ -1397,10 +1577,6 @@ (concat status "\n"))) (t (compilation-handle-exit 'bizarre status status))))) - ;; Without async subprocesses, the buffer is not yet - ;; fontified, so fontify it now. - (let ((font-lock-verbose nil)) ; shut up font-lock messages - (font-lock-fontify-buffer)) (set-buffer-modified-p nil) (message "Executing `%s'...done" command))) ;; Now finally cd to where the shell started make/grep/... @@ -1611,7 +1787,7 @@ mode-name (or name-of-mode "Compilation")) (set (make-local-variable 'page-delimiter) compilation-page-delimiter) - (set (make-local-variable 'compilation-buffer-modtime) nil) + ;; (set (make-local-variable 'compilation-buffer-modtime) nil) (compilation-setup) (setq buffer-read-only t) (run-mode-hooks 'compilation-mode-hook)) @@ -1632,6 +1808,7 @@ (symbol-name v))))) (and (cdr v) (or (boundp (cdr v)) + ;; FIXME: This is hackish, using undocumented info. (if (boundp 'byte-compile-bound-variables) (memq (cdr v) byte-compile-bound-variables))) `(set (make-local-variable ',(car v)) ,(cdr v)))) @@ -1669,9 +1846,6 @@ "Buffer position of the beginning of the compilation messages. If nil, use the beginning of buffer.") -;; A function name can't be a hook, must be something with a value. -(defconst compilation-turn-on-font-lock 'turn-on-font-lock) - (defun compilation-setup (&optional minor) "Prepare the buffer for the compilation parsing commands to work. Optional argument MINOR indicates this is called from @@ -1690,26 +1864,29 @@ (setq next-error-function 'compilation-next-error-function) (set (make-local-variable 'comint-file-name-prefix) (or (file-remote-p default-directory) "")) - (set (make-local-variable 'font-lock-extra-managed-props) - '(directory message help-echo mouse-face debug)) (set (make-local-variable 'compilation-locs) (make-hash-table :test 'equal :weakness 'value)) - ;; lazy-lock would never find the message unless it's scrolled to. - ;; jit-lock might fontify some things too late. - (set (make-local-variable 'font-lock-support-mode) nil) - (set (make-local-variable 'font-lock-maximum-size) nil) + ;; It's generally preferable to use after-change-functions since they + ;; can be subject to combine-after-change-calls, but if we do that, we risk + ;; running our hook after font-lock, resulting in incorrect refontification. + (add-hook 'before-change-functions 'compilation--flush-parse nil t) + ;; Also for minor mode, since it's not permanent-local. + (add-hook 'change-major-mode-hook #'compilation--remove-properties nil t) (if minor - (let ((fld font-lock-defaults)) + (progn (font-lock-add-keywords nil (compilation-mode-font-lock-keywords)) (if font-lock-mode - (if fld - (font-lock-fontify-buffer) - (font-lock-change-mode) - (turn-on-font-lock)) - (turn-on-font-lock))) - (setq font-lock-defaults '(compilation-mode-font-lock-keywords t)) - ;; maybe defer font-lock till after derived mode is set up - (run-mode-hooks 'compilation-turn-on-font-lock))) + (font-lock-fontify-buffer))) + (setq font-lock-defaults '(compilation-mode-font-lock-keywords t)))) + +(defun compilation--unsetup () + ;; Only for minor mode. + (font-lock-remove-keywords nil (compilation-mode-font-lock-keywords)) + (remove-hook 'before-change-functions 'compilation--flush-parse t) + (kill-local-variable 'compilation--parsed) + (compilation--remove-properties) + (if font-lock-mode + (font-lock-fontify-buffer))) ;;;###autoload (define-minor-mode compilation-shell-minor-mode @@ -1723,8 +1900,7 @@ :group 'compilation (if compilation-shell-minor-mode (compilation-setup t) - (font-lock-remove-keywords nil (compilation-mode-font-lock-keywords)) - (font-lock-fontify-buffer))) + (compilation--unsetup))) ;;;###autoload (define-minor-mode compilation-minor-mode @@ -1737,8 +1913,7 @@ :group 'compilation (if compilation-minor-mode (compilation-setup t) - (font-lock-remove-keywords nil (compilation-mode-font-lock-keywords)) - (font-lock-fontify-buffer))) + (compilation--unsetup))) (defun compilation-handle-exit (process-status exit-status msg) "Write MSG in the current buffer and hack its `mode-line-process'." @@ -1766,7 +1941,8 @@ (setq mode-line-process (let ((out-string (format ":%s [%s]" process-status (cdr status))) (msg (format "%s %s" mode-name - (replace-regexp-in-string "\n?$" "" (car status))))) + (replace-regexp-in-string "\n?$" "" + (car status))))) (message "%s" msg) (propertize out-string 'help-echo msg 'face (if (> exit-status 0) @@ -1811,13 +1987,13 @@ (let ((inhibit-read-only t) ;; `save-excursion' doesn't use the right insertion-type for us. (pos (copy-marker (point) t)) + ;; `save-restriction' doesn't use the right insertion type either: + ;; If we are inserting at the end of the accessible part of the + ;; buffer, keep the inserted text visible. (min (point-min-marker)) - (max (point-max-marker))) + (max (copy-marker (point-max) t))) (unwind-protect (progn - ;; If we are inserting at the end of the accessible part - ;; of the buffer, keep the inserted text visible. - (set-marker-insertion-type max t) (widen) (goto-char (process-mark proc)) ;; We used to use `insert-before-markers', so that windows with @@ -1827,10 +2003,12 @@ (unless comint-inhibit-carriage-motion (comint-carriage-motion (process-mark proc) (point))) (set-marker (process-mark proc) (point)) - (set (make-local-variable 'compilation-buffer-modtime) (current-time)) + ;; (set (make-local-variable 'compilation-buffer-modtime) + ;; (current-time)) (run-hooks 'compilation-filter-hook)) (goto-char pos) (narrow-to-region min max) + (set-marker pos nil) (set-marker min nil) (set-marker max nil)))))) @@ -1849,31 +2027,50 @@ `(let (opt) (while (,< n 0) (setq opt pt) - (or (setq pt (,property-change pt 'message)) + (or (setq pt (,property-change pt 'compilation-message)) ;; Handle the case where where the first error message is ;; at the start of the buffer, and n < 0. - (if (or (eq (get-text-property ,limit 'message) - (get-text-property opt 'message)) + (if (or (eq (get-text-property ,limit 'compilation-message) + (get-text-property opt 'compilation-message)) (eq pt opt)) (error ,error compilation-error) (setq pt ,limit))) - ;; prop 'message usually has 2 changes, on and off, so + ;; prop 'compilation-message usually has 2 changes, on and off, so ;; re-search if off - (or (setq msg (get-text-property pt 'message)) - (if (setq pt (,property-change pt 'message nil ,limit)) - (setq msg (get-text-property pt 'message))) + (or (setq msg (get-text-property pt 'compilation-message)) + (if (setq pt (,property-change pt 'compilation-message nil ,limit)) + (setq msg (get-text-property pt 'compilation-message))) (error ,error compilation-error)) - (or (< (cadr msg) compilation-skip-threshold) + (or (< (compilation--message->type msg) compilation-skip-threshold) (if different-file - (eq (prog1 last (setq last (nth 2 (car msg)))) + (eq (prog1 last + (setq last (compilation--loc->file-struct + (compilation--message->loc msg)))) last)) (if compilation-skip-visited - (nthcdr 5 (car msg))) + (compilation--loc->visited (compilation--message->loc msg))) (if compilation-skip-to-next-location - (eq (car msg) loc)) + (eq (compilation--message->loc msg) loc)) ;; count this message only if none of the above are true (setq n (,1+ n)))))) +(defun compilation-next-single-property-change (position prop + &optional object limit) + (let (parsed res) + (while (progn + ;; We parse the buffer here "on-demand" by chunks of 500 chars. + ;; But we could also just parse the whole buffer. + (compilation--ensure-parse + (setq parsed (max compilation--parsed + (min (+ position 500) + (or limit (point-max)))))) + (and (or (not (setq res (next-single-property-change + position prop object limit))) + (eq res limit)) + (< position (or limit (point-max))))) + (setq position parsed)) + res)) + (defun compilation-next-error (n &optional different-file pt) "Move point to the next error in the compilation buffer. This function does NOT find the source line like \\[next-error]. @@ -1887,31 +2084,35 @@ (or (compilation-buffer-p (current-buffer)) (error "Not in a compilation buffer")) (or pt (setq pt (point))) - (let* ((msg (get-text-property pt 'message)) - ;; `loc' is used by the compilation-loop macro. - (loc (car msg)) + (let* ((msg (get-text-property pt 'compilation-message)) + ;; `loc', `msg', and `last' are used by the compilation-loop macro. + (loc (compilation--message->loc msg)) last) (if (zerop n) (unless (or msg ; find message near here (setq msg (get-text-property (max (1- pt) (point-min)) - 'message))) - (setq pt (previous-single-property-change pt 'message nil + 'compilation-message))) + (setq pt (previous-single-property-change pt 'compilation-message nil (line-beginning-position))) - (unless (setq msg (get-text-property (max (1- pt) (point-min)) 'message)) - (setq pt (next-single-property-change pt 'message nil + (unless (setq msg (get-text-property (max (1- pt) (point-min)) + 'compilation-message)) + (setq pt (next-single-property-change pt 'compilation-message nil (line-end-position))) - (or (setq msg (get-text-property pt 'message)) + (or (setq msg (get-text-property pt 'compilation-message)) (setq pt (point))))) - (setq last (nth 2 (car msg))) + (setq last (compilation--loc->file-struct + (compilation--message->loc msg))) (if (>= n 0) - (compilation-loop > next-single-property-change 1- + (compilation-loop > compilation-next-single-property-change 1- (if (get-buffer-process (current-buffer)) "No more %ss yet" "Moved past last %s") (point-max)) + (compilation--ensure-parse pt) ;; Don't move "back" to message at or before point. ;; Pass an explicit (point-min) to make sure pt is non-nil. - (setq pt (previous-single-property-change pt 'message nil (point-min))) + (setq pt (previous-single-property-change + pt 'compilation-message nil (point-min))) (compilation-loop < previous-single-property-change 1+ "Moved back before first %s" (point-min)))) (goto-char pt) @@ -1955,12 +2156,16 @@ (if event (posn-set-point (event-end event))) (or (compilation-buffer-p (current-buffer)) (error "Not in a compilation buffer")) - (if (get-text-property (point) 'directory) - (dired-other-window (car (get-text-property (point) 'directory))) + (compilation--ensure-parse (point)) + (if (get-text-property (point) 'compilation-directory) + (dired-other-window + (car (get-text-property (point) 'compilation-directory))) (push-mark) (setq compilation-current-error (point)) (next-error-internal))) +;; This is mostly unused, but we keep it for the sake of some external +;; packages which seem to make use of it. (defun compilation-find-buffer (&optional avoid-current) "Return a compilation buffer. If AVOID-CURRENT is nil, and the current buffer is a compilation buffer, @@ -1979,53 +2184,65 @@ (setq compilation-current-error nil)) (let* ((columns compilation-error-screen-columns) ; buffer's local value (last 1) timestamp - (loc (compilation-next-error (or n 1) nil + (msg (compilation-next-error (or n 1) nil (or compilation-current-error compilation-messages-start (point-min)))) - (end-loc (nth 2 loc)) + (loc (compilation--message->loc msg)) + (end-loc (compilation--message->end-loc msg)) (marker (point-marker))) (setq compilation-current-error (point-marker) overlay-arrow-position (if (bolp) compilation-current-error - (copy-marker (line-beginning-position))) - loc (car loc)) + (copy-marker (line-beginning-position)))) ;; If loc contains no marker, no error in that file has been visited. ;; If the marker is invalid the buffer has been killed. - ;; If the file is newer than the timestamp, it has been modified - ;; (`omake -P' polls filesystem for changes and recompiles when needed - ;; in the same process and buffer). ;; So, recalculate all markers for that file. - (unless (and (nth 3 loc) (marker-buffer (nth 3 loc)) (nthcdr 4 loc) - ;; There may be no timestamp info if the loc is a `fake-loc', - ;; but we just checked that the file has been visited before! - (equal (nth 4 loc) - (setq timestamp compilation-buffer-modtime))) - (with-current-buffer (compilation-find-file marker (caar (nth 2 loc)) - (cadr (car (nth 2 loc)))) + (unless (and (compilation--loc->marker loc) + (marker-buffer (compilation--loc->marker loc)) + ;; FIXME-omake: For "omake -P", which automatically recompiles + ;; when the file is modified, the line numbers of new output + ;; may not be related to line numbers from earlier output + ;; (earlier markers), so we used to try to detect it here and + ;; force a reparse. But that caused more problems elsewhere, + ;; so instead we now flush the file-structure when we see + ;; omake's message telling it's about to recompile a file. + ;; (or (null (compilation--loc->timestamp loc)) ;A fake-loc + ;; (equal (compilation--loc->timestamp loc) + ;; (setq timestamp compilation-buffer-modtime))) + ) + (with-current-buffer + (compilation-find-file + marker + (caar (compilation--loc->file-struct loc)) + (cadr (car (compilation--loc->file-struct loc)))) (save-restriction (widen) (goto-char (point-min)) ;; Treat file's found lines in forward order, 1 by 1. - (dolist (line (reverse (cddr (nth 2 loc)))) + (dolist (line (reverse (cddr (compilation--loc->file-struct loc)))) (when (car line) ; else this is a filename w/o a line# (beginning-of-line (- (car line) last -1)) (setq last (car line))) ;; Treat line's found columns and store/update a marker for each. (dolist (col (cdr line)) - (if (car col) - (if (eq (car col) -1) ; special case for range end + (if (compilation--loc->col col) + (if (eq (compilation--loc->col col) -1) + ;; Special case for range end. (end-of-line) - (compilation-move-to-column (car col) columns)) + (compilation-move-to-column (compilation--loc->col col) + columns)) (beginning-of-line) (skip-chars-forward " \t")) - (if (nth 3 col) - (set-marker (nth 3 col) (point)) - (setcdr (nthcdr 2 col) `(,(point-marker))))))))) - (compilation-goto-locus marker (nth 3 loc) (nth 3 end-loc)) - (setcdr (nthcdr 3 loc) (list timestamp)) - (setcdr (nthcdr 4 loc) t))) ; Set this one as visited. + (if (compilation--loc->marker col) + (set-marker (compilation--loc->marker col) (point)) + (setf (compilation--loc->marker col) (point-marker))) + ;; (setf (compilation--loc->timestamp col) timestamp) + ))))) + (compilation-goto-locus marker (compilation--loc->marker loc) + (compilation--loc->marker end-loc)) + (setf (compilation--loc->visited loc) t))) (defvar compilation-gcpro nil "Internal variable used to keep some values from being GC'd.") @@ -2036,8 +2253,8 @@ FILE should be ABSOLUTE-FILENAME or (RELATIVE-FILENAME . DIRNAME). This is useful when you compile temporary files, but want automatic translation of the messages to the real buffer from -which the temporary file came. This only works if done before a -message about FILE appears! +which the temporary file came. This may also affect previous messages +about FILE. Optional args LINE and COL default to 1 and beginning of indentation respectively. The marker is expected to reflect @@ -2049,18 +2266,19 @@ call this several times, once each for the last line of one region and the first line of the next region." (or (consp file) (setq file (list file))) - (setq file (compilation-get-file-structure file)) - ;; Between the current call to compilation-fake-loc and the first occurrence - ;; of an error message referring to `file', the data is only kept in the - ;; weak hash-table compilation-locs, so we need to prevent this entry - ;; in compilation-locs from being GC'd away. --Stef - (push file compilation-gcpro) - (let ((loc (compilation-assq (or line 1) (cdr file)))) - (setq loc (compilation-assq col loc)) - (if (cdr loc) - (setcdr (cddr loc) (list marker)) - (setcdr loc (list line file marker))) - loc)) + (compilation--flush-file-structure file) + (let ((fs (compilation-get-file-structure file))) + ;; Between the current call to compilation-fake-loc and the first + ;; occurrence of an error message referring to `file', the data is + ;; only kept in the weak hash-table compilation-locs, so we need + ;; to prevent this entry in compilation-locs from being GC'd + ;; away. --Stef + (push fs compilation-gcpro) + (let ((loc (compilation-assq (or line 1) (cdr fs)))) + (setq loc (compilation-assq col loc)) + (assert (null (cdr loc))) + (setcdr loc (compilation--make-cdrloc line fs marker)) + loc))) (defcustom compilation-context-lines nil "Display this many lines of leading context before the current message. @@ -2278,7 +2496,7 @@ In the former case, FILENAME may be relative or absolute. The file-structure looks like this: - (list (list FILENAME [DIR-FROM-PREV-MSG]) FMT LINE-STRUCT...)" + ((FILENAME [DIR-FROM-PREV-MSG]) FMT LINE-STRUCT...)" (or (gethash file compilation-locs) ;; File was not previously encountered, at least not in the form passed. ;; Let's normalize it and look again. @@ -2323,25 +2541,41 @@ ;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00463.html (or (gethash (cons filename spec-directory) compilation-locs) (puthash (cons filename spec-directory) - (list (list filename spec-directory) fmt) + (compilation--make-file-struct + (list filename spec-directory) fmt) compilation-locs)) compilation-locs)))) -(add-to-list 'debug-ignored-errors "^No more [-a-z ]+s yet$") +(defun compilation--flush-file-structure (file) + (or (consp file) (setq file (list file))) + (let ((fs (compilation-get-file-structure file))) + (assert (eq fs (gethash file compilation-locs))) + (assert (eq fs (gethash (cons (caar fs) (cadr (car fs))) + compilation-locs))) + (maphash (lambda (k v) + (if (eq v fs) (remhash k compilation-locs))) + compilation-locs))) + +(add-to-list 'debug-ignored-errors "\\`No more [-a-z ]+s yet\\'") +(add-to-list 'debug-ignored-errors "\\`Moved past last .*") ;;; Compatibility with the old compile.el. -(defun compile-buffer-substring (n) (if n (match-string n))) +(defvaralias 'compilation-last-buffer 'next-error-last-buffer) +(defvar compilation-parsing-end (make-marker)) +(defvar compilation-error-list nil) +(defvar compilation-old-error-list nil) -(defun compilation-compat-error-properties (err) +(defun compilation--compat-error-properties (err) "Map old-style error ERR to new-style message." ;; Old-style structure is (MARKER (FILE DIR) LINE COL) or ;; (MARKER . MARKER). (let ((dst (cdr err))) (if (markerp dst) - ;; Must start with a face, for font-lock. - `(face nil - message ,(list (list nil nil nil dst) 2) + `(compilation-message ,(compilation--make-message + (cons nil (compilation--make-cdrloc + nil nil dst)) + 2 nil) help-echo "mouse-2: visit the source location" keymap compilation-button-map mouse-face highlight) @@ -2355,19 +2589,19 @@ (compilation-internal-error-properties (cons filename dirname) line nil col nil 2 fmt))))) -(defun compilation-compat-parse-errors (limit) +(defun compilation--compat-parse-errors (limit) (when compilation-parse-errors-function ;; FIXME: We should remove the rest of the compilation keywords ;; but we can't do that from here because font-lock is using - ;; the value right now. --stef + ;; the value right now. --Stef (save-excursion (setq compilation-error-list nil) ;; Reset compilation-parsing-end each time because font-lock ;; might force us the re-parse many times (typically because ;; some code adds some text-property to the output that we ;; already parsed). You might say "why reparse", well: - ;; because font-lock has just removed the `message' property so - ;; have to do it all over again. + ;; because font-lock has just removed the `compilation-message' property + ;; so have to do it all over again. (if compilation-parsing-end (set-marker compilation-parsing-end (point)) (setq compilation-parsing-end (point-marker))) @@ -2379,19 +2613,26 @@ (dolist (err (if (listp compilation-error-list) compilation-error-list)) (let* ((src (car err)) (dst (cdr err)) - (loc (cond ((markerp dst) (list nil nil nil dst)) + (loc (cond ((markerp dst) + (cons nil + (compilation--make-cdrloc nil nil dst))) ((consp dst) - (list (nth 2 dst) (nth 1 dst) - (cons (cdar dst) (caar dst))))))) + (cons (nth 2 dst) + (compilation--make-cdrloc + (nth 1 dst) + (cons (cdar dst) (caar dst)) + nil)))))) (when loc (goto-char src) - ;; (put-text-property src (line-end-position) 'font-lock-face 'font-lock-warning-face) + ;; (put-text-property src (line-end-position) + ;; 'font-lock-face 'font-lock-warning-face) (put-text-property src (line-end-position) - 'message (list loc 2))))))) + 'compilation-message + (compilation--make-message loc 2 nil))))))) (goto-char limit) nil) -;; Beware: this is not only compatibility code. New code stil uses it. --Stef +;; Beware! this is not only compatibility code. New code also uses it. --Stef (defun compilation-forget-errors () ;; In case we hit the same file/line specs, we want to recompute a new ;; marker for them, so flush our cache. === modified file 'lisp/progmodes/grep.el' --- lisp/progmodes/grep.el 2011-01-25 04:08:28 +0000 +++ lisp/progmodes/grep.el 2011-01-28 21:11:19 +0000 @@ -341,7 +341,7 @@ ;;;###autoload (defconst grep-regexp-alist - '(("^\\(.+?\\)\\(:[ \t]*\\)\\([0-9]+\\)\\2" + '(("^\\(.+?\\)\\(:[ \t]*\\)\\([1-9][0-9]*\\)\\2" 1 3) ;; Rule to match column numbers is commented out since no known grep ;; produces them @@ -384,7 +384,6 @@ (defvar grep-mode-font-lock-keywords '(;; Command output lines. - ("^\\([A-Za-z_0-9/\.+-]+\\)[ \t]*:" 1 font-lock-function-name-face) (": \\(.+\\): \\(?:Permission denied\\|No such \\(?:file or directory\\|device or address\\)\\)$" 1 grep-error-face) ;; remove match from grep-regexp-alist before fontifying @@ -399,7 +398,8 @@ (1 grep-error-face) (2 grep-error-face nil t)) ("^.+?-[0-9]+-.*\n" (0 grep-context-face)) - ;; Highlight grep matches and delete markers + ;; Highlight grep matches and delete markers. + ;; FIXME: Modifying the buffer text from font-lock is a bad idea! ("\\(\033\\[01;31m\\)\\(.*?\\)\\(\033\\[[0-9]*m\\)" ;; Refontification does not work after the markers have been ;; deleted. So we use the font-lock-face property here as Font @@ -409,12 +409,14 @@ (progn ;; Delete markers with `replace-match' because it updates ;; the match-data, whereas `delete-region' would render it obsolete. + (syntax-ppss-flush-cache (match-beginning 0)) (replace-match "" t t nil 3) (replace-match "" t t nil 1)))) - ("\\(\033\\[[0-9;]*[mK]\\)" + ("\033\\[[0-9;]*[mK]" ;; Delete all remaining escape sequences ((lambda (bound)) - (replace-match "" t t nil 1)))) + (syntax-ppss-flush-cache (match-beginning 0)) + (replace-match "" t t)))) "Additional things to highlight in grep output. This gets tacked on the end of the generated expressions.") === modified file 'lisp/textmodes/tex-mode.el' --- lisp/textmodes/tex-mode.el 2011-01-25 04:08:28 +0000 +++ lisp/textmodes/tex-mode.el 2011-01-28 21:16:04 +0000 @@ -1812,11 +1812,70 @@ ;; Why use a shell instead of running TeX directly? Because if TeX ;; gets stuck, the user can switch to the shell window and type at it. +(defvar tex-error-parse-syntax-table + (let ((st (make-syntax-table))) + (modify-syntax-entry ?\( "()" st) + (modify-syntax-entry ?\) ")(" st) + (modify-syntax-entry ?\\ "\\" st) + (modify-syntax-entry ?\{ "_" st) + (modify-syntax-entry ?\} "_" st) + (modify-syntax-entry ?\[ "_" st) + (modify-syntax-entry ?\] "_" st) + ;; Single quotations may appear in errors + (modify-syntax-entry ?\" "_" st) + st) + "Syntax-table used while parsing TeX error messages.") + +(defun tex-old-error-file-name () + ;; This is unreliable, partly because we don't try very hard, and + ;; partly because TeX's output format is eminently ambiguous and unfriendly + ;; to automation. + (save-excursion + (save-match-data + (with-syntax-table tex-error-parse-syntax-table + (beginning-of-line) + (backward-up-list 1) + (skip-syntax-forward "(_") + (while (not (let ((try-filename (thing-at-point 'filename))) + (and try-filename + (not (string= "" try-filename)) + (file-readable-p try-filename)))) + (skip-syntax-backward "(_") + (backward-up-list 1) + (skip-syntax-forward "(_")) + (thing-at-point 'filename))))) + +(defconst tex-error-regexp-alist + ;; First alternative handles the newer --file-line-error style: + ;; ./test2.tex:14: Too many }'s. + '(gnu + ;; Second handles the old-style, which spans two lines but doesn't include + ;; any file info: + ;; ! Too many }'s. + ;; l.396 toto} + ("^l\\.\\([1-9][0-9]*\\) \\(?:\\.\\.\\.\\)?\\(.*\\)$" + tex-old-error-file-name 1 nil nil nil + ;; Since there's no filename to highlight, let's highlight the message. + (2 compilation-error-face)) + ;; A few common warning messages. + ("^\\(?:Und\\|Ov\\)erfull \\\\[hv]box .* at lines? \\(\\([1-9][0-9]*\\)\\(?:--\\([1-9][0-9]*\\)\\)?\\)$" + tex-old-error-file-name (2 . 3) nil 1 nil + (1 compilation-warning-face)) + ("^(Font) *\\([^ \n].* on input line \\([1-9][0-9]*\\)\\)\\.$" + tex-old-error-file-name 2 nil 1 1 + (2 compilation-warning-face)) + ;; Included files get output as ( ...). + ;; FIXME: there tend to be a crapload of them at the beginning of the + ;; output which aren't that interesting. Maybe we should filter out + ;; all the file name that start with /usr/share? + ;; ("(\\.?/\\([^() \n]+\\)" 1 nil nil 0) + )) + ;; The utility functions: (define-derived-mode tex-shell shell-mode "TeX-Shell" - (set (make-local-variable 'compilation-parse-errors-function) - 'tex-compilation-parse-errors) + (set (make-local-variable 'compilation-error-regexp-alist) + tex-error-regexp-alist) (compilation-shell-minor-mode t)) ;;;###autoload @@ -2314,113 +2373,6 @@ (tex-display-shell) (setq tex-last-buffer-texed (current-buffer))) -(defvar tex-error-parse-syntax-table - (let ((st (make-syntax-table))) - (modify-syntax-entry ?\( "()" st) - (modify-syntax-entry ?\) ")(" st) - (modify-syntax-entry ?\\ "\\" st) - (modify-syntax-entry ?\{ "_" st) - (modify-syntax-entry ?\} "_" st) - (modify-syntax-entry ?\[ "_" st) - (modify-syntax-entry ?\] "_" st) - ;; Single quotations may appear in errors - (modify-syntax-entry ?\" "_" st) - st) - "Syntax-table used while parsing TeX error messages.") - -(defun tex-compilation-parse-errors (limit-search find-at-least) - "Parse the current buffer as TeX error messages. -See the variable `compilation-parse-errors-function' for the interface it uses. - -This function parses only the last TeX compilation. -It works on TeX compilations only. It is necessary for that purpose, -since TeX does not put file names and line numbers on the same line as -for the error messages." - (require 'thingatpt) - (setq compilation-error-list nil) - (let ((default-directory ; Perhaps dir has changed meanwhile. - (file-name-directory (buffer-file-name tex-last-buffer-texed))) - found-desired (num-errors-found 0) - last-filename last-linenum last-position - begin-of-error end-of-error errfilename) - ;; Don't reparse messages already seen at last parse. - (goto-char compilation-parsing-end) - ;; Parse messages. - (while (and (not (or found-desired (eobp))) - ;; First alternative handles the newer --file-line-error style: - ;; ./test2.tex:14: Too many }'s. - ;; Second handles the old-style: - ;; ! Too many }'s. - (prog1 (re-search-forward - "^\\(?:\\([^:\n]+\\):[[:digit:]]+:\\|!\\) " nil 'move) - (setq begin-of-error (match-beginning 0) - end-of-error (match-end 0) - errfilename (match-string 1))) - (re-search-forward - "^l\\.\\([0-9]+\\) \\(\\.\\.\\.\\)?\\(.*\\)$" nil 'move)) - (let* ((this-error (copy-marker begin-of-error)) - (linenum (string-to-number (match-string 1))) - (error-text (regexp-quote (match-string 3))) - try-filename - (filename - ;; Prefer --file-liner-error filename if we have it. - (or errfilename - (save-excursion - (with-syntax-table tex-error-parse-syntax-table - (backward-up-list 1) - (skip-syntax-forward "(_") - (while (not - (and (setq try-filename (thing-at-point - 'filename)) - (not (string= "" try-filename)) - (file-readable-p try-filename))) - (skip-syntax-backward "(_") - (backward-up-list 1) - (skip-syntax-forward "(_")) - (thing-at-point 'filename))))) - (new-file - (or (null last-filename) - (not (string-equal last-filename filename)))) - (error-location - (with-current-buffer - (if (equal filename (concat tex-zap-file ".tex")) - tex-last-buffer-texed - (find-file-noselect filename)) - (save-excursion - (if new-file - (progn - (goto-char (point-min)) - (forward-line (1- linenum)) - (setq last-position nil)) - (goto-char last-position) - (forward-line (- linenum last-linenum))) - ;; first try a forward search for the error text, - ;; then a backward search limited by the last error. - (let ((starting-point (point))) - (or (re-search-forward error-text nil t) - (re-search-backward error-text last-position t) - (goto-char starting-point))) - (point-marker))))) - (goto-char this-error) - (if (and compilation-error-list - (or (and find-at-least - (>= num-errors-found - find-at-least)) - (and limit-search - (>= end-of-error limit-search))) - new-file) - (setq found-desired t) - (setq num-errors-found (1+ num-errors-found) - last-filename filename - last-linenum linenum - last-position error-location - compilation-error-list ; Add the new error - (cons (cons this-error error-location) - compilation-error-list)) - (goto-char end-of-error))))) - (set-marker compilation-parsing-end (point)) - (setq compilation-error-list (nreverse compilation-error-list))) - ;;; The commands: (defun tex-region (beg end) ------------------------------------------------------------ revno: 103012 author: Leo committer: Chong Yidong branch nick: trunk timestamp: Fri 2011-01-28 16:42:11 -0500 message: Fix help-mode highlighting of advice warning (Bug#6304). * emacs-lisp/advice.el (ad-make-advised-docstring): Don't apply highlighting to the "this function is advisted" message. * help-mode.el (help-mode-finish): Apply highlighting here, to avoid clobbering by substitute-command-keys (Bug#6304). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-01-28 21:20:40 +0000 +++ lisp/ChangeLog 2011-01-28 21:42:11 +0000 @@ -1,3 +1,11 @@ +2011-01-28 Leo + + * emacs-lisp/advice.el (ad-make-advised-docstring): Don't apply + highlighting to the "this function is advisted" message. + + * help-mode.el (help-mode-finish): Apply highlighting here, to + avoid clobbering by substitute-command-keys (Bug#6304). + 2011-01-28 Chong Yidong * woman.el (woman0-roff-buffer): Process roff escape sequences === modified file 'lisp/emacs-lisp/advice.el' --- lisp/emacs-lisp/advice.el 2011-01-25 04:08:28 +0000 +++ lisp/emacs-lisp/advice.el 2011-01-28 21:42:11 +0000 @@ -3007,9 +3007,7 @@ (setq usage (if (null usage) t (setq origdoc (cdr usage)) (car usage))) (if origdoc (setq paragraphs (list origdoc))) (unless (eq style 'plain) - (push (propertize (concat "This " origtype " is advised.") - 'face 'font-lock-warning-face) - paragraphs)) + (push (concat "This " origtype " is advised.") paragraphs)) (ad-dolist (class ad-advice-classes) (ad-dolist (advice (ad-get-enabled-advices function class)) (setq advice-docstring === modified file 'lisp/help-mode.el' --- lisp/help-mode.el 2011-01-26 08:36:39 +0000 +++ lisp/help-mode.el 2011-01-28 21:42:11 +0000 @@ -325,6 +325,15 @@ ;; View mode's read-only status of existing *Help* buffer is lost ;; by with-output-to-temp-buffer. (toggle-read-only 1) + + (save-excursion + (goto-char (point-min)) + (let ((inhibit-read-only t)) + (when (re-search-forward "^This \\w+ is advised.$" nil t) + (put-text-property (match-beginning 0) + (match-end 0) + 'face 'font-lock-warning-face)))) + (help-make-xrefs (current-buffer)))) ;; Grokking cross-reference information in doc strings and ------------------------------------------------------------ revno: 103011 committer: Chong Yidong branch nick: trunk timestamp: Fri 2011-01-28 16:20:40 -0500 message: Fix for woman escape sequence processing (Bug#7843). * lisp/woman.el (woman0-roff-buffer): Process roff escape sequences occurring prior to the first request. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-01-28 19:46:58 +0000 +++ lisp/ChangeLog 2011-01-28 21:20:40 +0000 @@ -1,3 +1,8 @@ +2011-01-28 Chong Yidong + + * woman.el (woman0-roff-buffer): Process roff escape sequences + occurring prior to the first request (Bug#7843). + 2011-01-28 Stefan Monnier Port features from the previous prolog.el to the new one. === modified file 'lisp/woman.el' --- lisp/woman.el 2011-01-25 04:08:28 +0000 +++ lisp/woman.el 2011-01-28 21:20:40 +0000 @@ -2478,10 +2478,22 @@ (woman0-search-regex-start woman0-search-regex-start) (woman0-search-regex (concat woman0-search-regex-start woman0-search-regex-end)) + processed-first-hunk woman0-rename-alist) (set-marker-insertion-type woman0-if-to t) (while (re-search-forward woman0-search-regex nil t) (setq woman-request (match-string 1)) + + ;; Process escape sequences prior to first request (Bug#7843). + (unless processed-first-hunk + (setq processed-first-hunk t) + (let ((process-escapes-to-marker (point-marker))) + (set-marker-insertion-type process-escapes-to-marker t) + (save-match-data + (save-excursion + (goto-char from) + (woman2-process-escapes process-escapes-to-marker))))) + (cond ((string= woman-request "ig") (woman0-ig)) ((string= woman-request "if") (woman0-if "if")) ((string= woman-request "ie") (woman0-if "ie")) ------------------------------------------------------------ revno: 103010 committer: Chong Yidong branch nick: trunk timestamp: Fri 2011-01-28 15:30:38 -0500 message: Fix text pos part of lispy positions for right fringe clicks (Bug#7839). * src/keyboard.c (make_lispy_position): For clicks on right fringe or margin, compute text position using the X coordinate relative to the left of the text area (Bug#7839). diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-01-28 12:31:39 +0000 +++ src/ChangeLog 2011-01-28 20:30:38 +0000 @@ -1,3 +1,9 @@ +2011-01-28 Chong Yidong + + * keyboard.c (make_lispy_position): For clicks on right fringe or + margin, compute text position using the X coordinate relative to + the left of the text area (Bug#7839). + 2011-01-28 Kenichi Handa * ftfont.c (ftfont_spec_pattern): Check each extra property === modified file 'src/keyboard.c' --- src/keyboard.c 2011-01-26 08:36:39 +0000 +++ src/keyboard.c 2011-01-28 20:30:38 +0000 @@ -5153,8 +5153,12 @@ int width2, height2; /* The pixel X coordinate passed to buffer_posn_from_coords is the X coordinate relative to the text area for - text-area clicks, zero otherwise. */ - int x2 = (part == ON_TEXT) ? xret : 0; + text-area and right-margin clicks, zero otherwise. */ + int x2 + = (part == ON_TEXT) ? x2 + : (part == ON_RIGHT_FRINGE || part == ON_RIGHT_MARGIN) + ? (XINT (x) - window_box_left (w, TEXT_AREA)) + : 0; int y2 = wy; string2 = buffer_posn_from_coords (w, &x2, &y2, &p, ------------------------------------------------------------ revno: 103009 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2011-01-28 14:46:58 -0500 message: Port features from the previous prolog.el to the new one. * lisp/progmodes/prolog.el (prolog-system): Add GNU and ECLiPSe options. (prolog-program-name, prolog-program-switches, prolog-consult-string) (prolog-compile-string, prolog-prompt-regexp): Get rid of the -i variable and use a function to compute the value dynamically. (prolog-prompt-regexp): Add regexp for GNU Prolog. (prolog-continued-prompt-regexp): Remove, unused. (prolog-find-value-by-system): Try and use the value of prolog-system in the *prolog* buffer if it helps. (prolog-mode-keybindings-common): Bind C-c C-z unconditionally... (prolog-zip-on): ..and check prolog-system and version here instead. (prolog-inferior-self-insert-command): New command. (prolog-inferior-mode-map): Use it. (prolog-inferior-error-regexp-alist): New var. (prolog-inferior-mode): Use it, along with compilation-shell-minor-mode. (prolog-input-filter): Use derived-mode-p. (prolog-inferior-guess-flavor): New function. (prolog-ensure-process): Use it. Use make-comint-in-buffer rather than make-comint to avoid running comint-mode twice. (prolog-inferior-buffer): New fun. (prolog-old-process-region, prolog-old-process-file): Don't call prolog-bsts here... (prolog-build-prolog-command): ...do it here instead. (prolog-old-process-region, prolog-old-process-file): Use compilation-fake-loc and compilation-forget-errors. (prolog-consult-compile-region): Use bolp. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-01-28 19:13:01 +0000 +++ lisp/ChangeLog 2011-01-28 19:46:58 +0000 @@ -1,3 +1,32 @@ +2011-01-28 Stefan Monnier + + Port features from the previous prolog.el to the new one. + * progmodes/prolog.el (prolog-system): Add GNU and ECLiPSe options. + (prolog-program-name, prolog-program-switches, prolog-consult-string) + (prolog-compile-string, prolog-prompt-regexp): Get rid of the -i + variable and use a function to compute the value dynamically. + (prolog-prompt-regexp): Add regexp for GNU Prolog. + (prolog-continued-prompt-regexp): Remove, unused. + (prolog-find-value-by-system): Try and use the value of prolog-system + in the *prolog* buffer if it helps. + (prolog-mode-keybindings-common): Bind C-c C-z unconditionally... + (prolog-zip-on): ..and check prolog-system and version here instead. + (prolog-inferior-self-insert-command): New command. + (prolog-inferior-mode-map): Use it. + (prolog-inferior-error-regexp-alist): New var. + (prolog-inferior-mode): Use it, along with compilation-shell-minor-mode. + (prolog-input-filter): Use derived-mode-p. + (prolog-inferior-guess-flavor): New function. + (prolog-ensure-process): Use it. Use make-comint-in-buffer rather than + make-comint to avoid running comint-mode twice. + (prolog-inferior-buffer): New fun. + (prolog-old-process-region, prolog-old-process-file): + Don't call prolog-bsts here... + (prolog-build-prolog-command): ...do it here instead. + (prolog-old-process-region, prolog-old-process-file): + Use compilation-fake-loc and compilation-forget-errors. + (prolog-consult-compile-region): Use bolp. + 2011-01-28 Chong Yidong * image-mode.el (image-display-size): Doc fix (Bug#7820). === modified file 'lisp/progmodes/prolog.el' --- lisp/progmodes/prolog.el 2011-01-25 04:08:28 +0000 +++ lisp/progmodes/prolog.el 2011-01-28 19:46:58 +0000 @@ -344,6 +344,10 @@ :group 'prolog :type '(choice (const :tag "SICStus" :value sicstus) (const :tag "SWI Prolog" :value swi) + (const :tag "GNU Prolog" :value gnu) + (const :tag "ECLiPSe Prolog" :value eclipse) + ;; Mercury shouldn't be needed since we have a separate + ;; major mode for it. (const :tag "Default" :value nil))) (make-variable-buffer-local 'prolog-system) @@ -356,6 +360,7 @@ (mercury (0 . 0)) (eclipse (3 . 7)) (gnu (0 . 0))) + ;; FIXME: This should be auto-detected instead of user-provided. "*Alist of Prolog system versions. The version numbers are of the format (Major . Minor)." :group 'prolog) @@ -568,6 +573,8 @@ "*Alist of program names for invoking an inferior Prolog with `run-prolog'." :group 'prolog-inferior :type 'sexp) +(defun prolog-program-name () + (prolog-find-value-by-system prolog-program-name)) (defcustom prolog-program-switches '((sicstus ("-i")) @@ -575,6 +582,8 @@ "*Alist of switches given to inferior Prolog run with `run-prolog'." :group 'prolog-inferior :type 'sexp) +(defun prolog-program-switches () + (prolog-find-value-by-system prolog-program-switches)) (defcustom prolog-consult-string '((eclipse "[%f].") @@ -596,6 +605,8 @@ the region." :group 'prolog-inferior :type 'sexp) +(defun prolog-consult-string () + (prolog-find-value-by-system prolog-consult-string)) (defcustom prolog-compile-string '((eclipse "[%f].") @@ -619,6 +630,8 @@ If `prolog-program-name' is nil, it is an argument to the `compile' function." :group 'prolog-inferior :type 'sexp) +(defun prolog-compile-string () + (prolog-find-value-by-system prolog-compile-string)) (defcustom prolog-eof-string "end_of_file.\n" "*Alist of strings that represent end of file for prolog. @@ -630,17 +643,20 @@ '((eclipse "^[a-zA-Z0-9()]* *\\?- \\|^\\[[a-zA-Z]* [0-9]*\\]:") (sicstus "| [ ?][- ] *") (swi "^\\(\\[[a-zA-Z]*\\] \\)?[1-9]?[0-9]*[ ]?\\?- \\|^| +") - (t "^ *\\?-")) + (gnu "^| \\?-") + (t "^|? *\\?-")) "*Alist of prompts of the prolog system command line." :group 'prolog-inferior :type 'sexp) +(defun prolog-prompt-regexp () + (prolog-find-value-by-system prolog-prompt-regexp)) -(defcustom prolog-continued-prompt-regexp - '((sicstus "^\\(| +\\| +\\)") - (t "^|: +")) - "*Alist of regexps matching the prompt when consulting `user'." - :group 'prolog-inferior - :type 'sexp) +;; (defcustom prolog-continued-prompt-regexp +;; '((sicstus "^\\(| +\\| +\\)") +;; (t "^|: +")) +;; "*Alist of regexps matching the prompt when consulting `user'." +;; :group 'prolog-inferior +;; :type 'sexp) (defcustom prolog-debug-on-string "debug.\n" "*Predicate for enabling debug mode." @@ -786,9 +802,9 @@ (defvar prolog-atom-regexp "" "Set by prolog-set-atom-regexps.") -(defconst prolog-left-paren "[[({]" +(defconst prolog-left-paren "[[({]" ;FIXME: Why not \\s(? "The characters used as left parentheses for the indentation code.") -(defconst prolog-right-paren "[])}]" +(defconst prolog-right-paren "[])}]" ;FIXME: Why not \\s)? "The characters used as right parentheses for the indentation code.") (defconst prolog-quoted-atom-regexp @@ -809,13 +825,8 @@ (defvar prolog-mode-specificators-i nil) (defvar prolog-determinism-specificators-i nil) (defvar prolog-directives-i nil) -(defvar prolog-program-name-i nil) -(defvar prolog-program-switches-i nil) -(defvar prolog-consult-string-i nil) -(defvar prolog-compile-string-i nil) (defvar prolog-eof-string-i nil) -(defvar prolog-prompt-regexp-i nil) -(defvar prolog-continued-prompt-regexp-i nil) +;; (defvar prolog-continued-prompt-regexp-i nil) (defvar prolog-help-function-i nil) (defvar prolog-align-rules @@ -856,24 +867,27 @@ (defun prolog-find-value-by-system (alist) "Get value from ALIST according to `prolog-system'." - (if (listp alist) - (let (result - id) - (while alist - (setq id (car (car alist))) - (if (or (eq id prolog-system) - (eq id t) - (and (listp id) - (eval id))) - (progn - (setq result (car (cdr (car alist)))) - (if (and (listp result) - (eq (car result) 'eval)) - (setq result (eval (car (cdr result))))) - (setq alist nil)) - (setq alist (cdr alist)))) - result) - alist)) + (let ((system (or prolog-system + (buffer-local-value 'prolog-system + (prolog-inferior-buffer 'dont-run))))) + (if (listp alist) + (let (result + id) + (while alist + (setq id (car (car alist))) + (if (or (eq id system) + (eq id t) + (and (listp id) + (eval id))) + (progn + (setq result (car (cdr (car alist)))) + (if (and (listp result) + (eq (car result) 'eval)) + (setq result (eval (car (cdr result))))) + (setq alist nil)) + (setq alist (cdr alist)))) + result) + alist))) (defconst prolog-syntax-propertize-function (when (fboundp 'syntax-propertize-rules) @@ -914,14 +928,13 @@ ;; Initialize Prolog system specific variables (dolist (var '(prolog-keywords prolog-types prolog-mode-specificators prolog-determinism-specificators prolog-directives - prolog-program-name prolog-program-switches - prolog-consult-string prolog-compile-string prolog-eof-string - prolog-prompt-regexp prolog-continued-prompt-regexp + prolog-eof-string + ;; prolog-continued-prompt-regexp prolog-help-function)) (set (intern (concat (symbol-name var) "-i")) (prolog-find-value-by-system (symbol-value var)))) - (when (null prolog-program-name-i) - (set (make-local-variable 'compile-command) prolog-compile-string-i)) + (when (null (prolog-program-name)) + (set (make-local-variable 'compile-command) (prolog-compile-string))) (set (make-local-variable 'font-lock-defaults) '(prolog-font-lock-keywords nil nil ((?_ . "w")))) (set (make-local-variable 'syntax-propertize-function) @@ -934,9 +947,7 @@ (define-key map "\C-c/" 'prolog-help-apropos) (define-key map "\C-c\C-d" 'prolog-debug-on) (define-key map "\C-c\C-t" 'prolog-trace-on) - (if (and (eq prolog-system 'sicstus) - (prolog-atleast-version '(3 . 7))) - (define-key map "\C-c\C-z" 'prolog-zip-on)) + (define-key map "\C-c\C-z" 'prolog-zip-on) (define-key map "\C-c\r" 'run-prolog)) (defun prolog-mode-keybindings-edit (map) @@ -1074,11 +1085,47 @@ (let ((map (make-sparse-keymap))) (prolog-mode-keybindings-common map) (prolog-mode-keybindings-inferior map) + (define-key map [remap self-insert-command] + 'prolog-inferior-self-insert-command) map)) (defvar prolog-inferior-mode-hook nil "List of functions to call after the inferior prolog mode has initialised.") +(defvar prolog-inferior-error-regexp-alist + '(;; GNU Prolog used to not follow the GNU standard format. + ;; ("^\\(.*?\\):\\([0-9]+\\) error: .*(char:\\([0-9]+\\)" 1 2 3) + ;; SWI-Prolog. + ("^\\(?:\\?- *\\)?\\(\\(?:ERROR\\|\\(W\\)arning\\): *\\(.*?\\):\\([1-9][0-9]*\\):\\(?:\\([0-9]*\\):\\)?\\)\\(?:$\\| \\)" + 3 4 5 (2 . nil) 1) + ;; GNU-Prolog now uses the GNU standard format. + gnu)) + +(defun prolog-inferior-self-insert-command () + "Insert the char in the buffer or pass it directly to the process." + (interactive) + (let* ((proc (get-buffer-process (current-buffer))) + (pmark (and proc (marker-position (process-mark proc))))) + ;; FIXME: the same treatment would be needed for SWI-Prolog, but I can't + ;; seem to find any way for Emacs to figure out when to use it because + ;; SWI doesn't include a " ? " or some such recognizable marker. + (if (and (eq prolog-system 'gnu) + pmark + (null current-prefix-arg) + (eobp) + (eq (point) pmark) + (save-excursion + (goto-char (- pmark 3)) + ;; FIXME: check this comes from the process's output, maybe? + (looking-at " \\? "))) + ;; This is GNU prolog waiting to know whether you want more answers + ;; or not (or abort, etc...). The answer is a single char, not + ;; a line, so pass this char directly rather than wait for RET to + ;; send a whole line. + (comint-send-string proc (string last-command-event)) + (call-interactively 'self-insert-command)))) + + (define-derived-mode prolog-inferior-mode comint-mode "Inferior Prolog" "Major mode for interacting with an inferior Prolog process. @@ -1111,13 +1158,16 @@ (setq comint-input-filter 'prolog-input-filter) (setq mode-line-process '(": %s")) (prolog-mode-variables) - (setq comint-prompt-regexp prolog-prompt-regexp-i) + (setq comint-prompt-regexp (prolog-prompt-regexp)) (set (make-local-variable 'shell-dirstack-query) "pwd.") + (set (make-local-variable 'compilation-error-regexp-alist) + prolog-inferior-error-regexp-alist) + (compilation-shell-minor-mode) (prolog-inferior-menu)) (defun prolog-input-filter (str) (cond ((string-match "\\`\\s *\\'" str) nil) ;whitespace - ((not (eq major-mode 'prolog-inferior-mode)) t) + ((not (derived-mode-p 'prolog-inferior-mode)) t) ((= (length str) 1) nil) ;one character ((string-match "\\`[rf] *[0-9]*\\'" str) nil) ;r(edo) or f(ail) (t t))) @@ -1127,6 +1177,8 @@ "Run an inferior Prolog process, input and output via buffer *prolog*. With prefix argument ARG, restart the Prolog process if running before." (interactive "P") + ;; FIXME: It should be possible to interactively specify the command to use + ;; to run prolog. (if (and arg (get-process "prolog")) (progn (process-send-string "prolog" "halt.\n") @@ -1143,18 +1195,55 @@ (prolog-ensure-process) )) +(defun prolog-inferior-guess-flavor (&optional ignored) + (setq prolog-system + (when (or (numberp prolog-system) (markerp prolog-system)) + (save-excursion + (goto-char (1+ prolog-system)) + (cond + ((looking-at "GNU Prolog") 'gnu) + ((looking-at "Welcome to SWI-Prolog\\|%.*\\ pmark (point-min)) (copy-marker (1- pmark))) + (t (1- pmark))))) + (add-hook 'comint-output-filter-functions + 'prolog-inferior-guess-flavor nil t)) (if wait (progn (goto-char (point-max)) @@ -1162,10 +1251,16 @@ (save-excursion (not (re-search-backward - (concat "\\(" prolog-prompt-regexp-i "\\)" "\\=") + (concat "\\(" (prolog-prompt-regexp) "\\)" "\\=") nil t))) (sit-for 0.1))))))) +(defun prolog-inferior-buffer (&optional dont-run) + (or (get-buffer "*prolog*") + (unless dont-run + (prolog-ensure-process) + (get-buffer "*prolog*")))) + (defun prolog-process-insert-string (process string) "Insert STRING into inferior Prolog buffer running PROCESS." ;; Copied from elisp manual, greek to me @@ -1188,7 +1283,7 @@ If COMPILEP is non-nil then use compilation, otherwise consulting." (prolog-ensure-process) ;(let ((tmpfile prolog-temp-filename) - (let ((tmpfile (prolog-bsts (prolog-temporary-file))) + (let ((tmpfile (prolog-temporary-file)) ;(process (get-process "prolog")) (first-line (1+ (count-lines (point-min) @@ -1196,6 +1291,10 @@ (goto-char start) (point)))))) (write-region start end tmpfile) + (setq start (copy-marker start)) + (with-current-buffer (prolog-inferior-buffer) + (compilation-forget-errors) + (compilation-fake-loc start tmpfile)) (process-send-string "prolog" (prolog-build-prolog-command compilep tmpfile (prolog-bsts buffer-file-name) @@ -1218,19 +1317,21 @@ If COMPILEP is non-nil then use compilation, otherwise consulting." (save-some-buffers) (prolog-ensure-process) - (let ((filename (prolog-bsts buffer-file-name))) + (with-current-buffer (prolog-inferior-buffer) + (compilation-forget-errors)) (process-send-string "prolog" (prolog-build-prolog-command - compilep filename filename)) - (prolog-goto-prolog-process-buffer))) + compilep buffer-file-name + (prolog-bsts buffer-file-name))) + (prolog-goto-prolog-process-buffer)) ;;------------------------------------------------------------ ;; Consulting and compiling ;;------------------------------------------------------------ -;;; Interactive interface functions, used by both the standard -;;; and the experimental consultation and compilation functions +;; Interactive interface functions, used by both the standard +;; and the experimental consultation and compilation functions (defun prolog-consult-file () "Consult file of current buffer." (interactive) @@ -1321,9 +1422,12 @@ "Make Prolog command for FILE compilation/consulting. If COMPILEP is non-nil, consider compilation, otherwise consulting." (let* ((compile-string - (if compilep prolog-compile-string-i prolog-consult-string-i)) + ;; FIXME: If the process is not running yet, the auto-detection of + ;; prolog-system won't help here, so we should make sure + ;; we first run Prolog and then build the command. + (if compilep (prolog-compile-string) (prolog-consult-string))) (module (prolog-buffer-module)) - (file-name (concat "'" file "'")) + (file-name (concat "'" (prolog-bsts file) "'")) (module-name (if module (concat "'" module "'"))) (module-file (if module (concat module-name ":" file-name) @@ -1359,7 +1463,7 @@ (setq compile-string (concat strbeg (format "%d" lineoffset) strend))) (concat compile-string "\n"))) -;;; The rest of this page is experimental code! +;; The rest of this page is experimental code! ;; Global variables for process filter function (defvar prolog-process-flag nil @@ -1395,14 +1499,20 @@ (old-filter (process-filter process))) (with-current-buffer buffer (delete-region (point-min) (point-max)) + ;; FIXME: Wasn't this supposed to use prolog-inferior-mode? (compilation-mode) + ;; FIXME: This doesn't seem to cooperate well with new(ish) compile.el. ;; Setting up font-locking for this buffer (set (make-local-variable 'font-lock-defaults) '(prolog-font-lock-keywords nil nil ((?_ . "w")))) (if (eq prolog-system 'sicstus) - (progn + ;; FIXME: This looks really problematic: not only is this using + ;; the old compilation-parse-errors-function, but + ;; prolog-parse-sicstus-compilation-errors only accepts one argument + ;; whereas compile.el calls it with 2 (and did so at least since + ;; Emacs-20). (set (make-local-variable 'compilation-parse-errors-function) - 'prolog-parse-sicstus-compilation-errors))) + 'prolog-parse-sicstus-compilation-errors)) (toggle-read-only 0) (insert command-string "\n")) (save-selected-window @@ -1498,6 +1608,7 @@ ;; If temporary files were used, then we change the error ;; messages to point to the original source file. + ;; FIXME: Use compilation-fake-loc instead. (cond ;; If the prolog process was in trace mode then it requires @@ -1552,7 +1663,7 @@ (insert output))) ;; If the prompt is visible, then the task is finished - (if (string-match prolog-prompt-regexp-i prolog-consult-compile-output) + (if (string-match (prolog-prompt-regexp) prolog-consult-compile-output) (setq prolog-process-flag nil))) (defun prolog-consult-compile-file (compilep) @@ -1579,7 +1690,7 @@ (write-region beg end file nil 'no-message) (write-region "\n" nil file t 'no-message) (prolog-consult-compile compilep file - (if (looking-at "^") (1+ lines) lines)) + (if (bolp) (1+ lines) lines)) (delete-file file))) (defun prolog-consult-compile-predicate (compilep) @@ -1760,8 +1871,10 @@ 0 'prolog-warning-face))) ;; Inferior mode specific patterns (prompt - (list prolog-prompt-regexp-i 0 'font-lock-keyword-face)) + ;; FIXME: Should be handled by comint already. + (list (prolog-prompt-regexp) 0 'font-lock-keyword-face)) (trace-exit + ;; FIXME: Add to compilation-error-regexp-alist instead. (cond ((eq prolog-system 'sicstus) '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Exit\\):" @@ -1770,6 +1883,7 @@ '("[ \t]*\\(Exit\\):[ \t]*([ \t0-9]*)" 1 prolog-exit-face)) (t nil))) (trace-fail + ;; FIXME: Add to compilation-error-regexp-alist instead. (cond ((eq prolog-system 'sicstus) '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Fail\\):" @@ -1778,6 +1892,7 @@ '("[ \t]*\\(Fail\\):[ \t]*([ \t0-9]*)" 1 prolog-warning-face)) (t nil))) (trace-redo + ;; FIXME: Add to compilation-error-regexp-alist instead. (cond ((eq prolog-system 'sicstus) '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Redo\\):" @@ -1786,6 +1901,7 @@ '("[ \t]*\\(Redo\\):[ \t]*([ \t0-9]*)" 1 prolog-redo-face)) (t nil))) (trace-call + ;; FIXME: Add to compilation-error-regexp-alist instead. (cond ((eq prolog-system 'sicstus) '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Call\\):" @@ -1795,6 +1911,7 @@ 1 font-lock-function-name-face)) (t nil))) (trace-exception + ;; FIXME: Add to compilation-error-regexp-alist instead. (cond ((eq prolog-system 'sicstus) '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Exception\\):" @@ -1804,6 +1921,7 @@ 1 prolog-exception-face)) (t nil))) (error-message-identifier + ;; FIXME: Add to compilation-error-regexp-alist instead. (cond ((eq prolog-system 'sicstus) '("{\\([A-Z]* ?ERROR:\\)" 1 prolog-exception-face prepend)) @@ -1811,6 +1929,7 @@ '("^[[]\\(WARNING:\\)" 1 prolog-builtin-face prepend)) (t nil))) (error-whole-messages + ;; FIXME: Add to compilation-error-regexp-alist instead. (cond ((eq prolog-system 'sicstus) '("{\\([A-Z]* ?ERROR:.*\\)}[ \t]*$" @@ -1819,6 +1938,7 @@ '("^[[]WARNING:[^]]*[]]$" 0 font-lock-comment-face append)) (t nil))) (error-warning-messages + ;; FIXME: Add to compilation-error-regexp-alist instead. ;; Mostly errors that SICStus asks the user about how to solve, ;; such as "NAME CLASH:" for example. (cond @@ -1826,6 +1946,7 @@ '("^[A-Z ]*[A-Z]+:" 0 prolog-warning-face)) (t nil))) (warning-messages + ;; FIXME: Add to compilation-error-regexp-alist instead. (cond ((eq prolog-system 'sicstus) '("\\({ ?\\(Warning\\|WARNING\\) ?:.*}\\)[ \t]*$" @@ -2974,6 +3095,9 @@ "Enable zipping (for SICStus 3.7 and later). When called with prefix argument ARG, disable zipping instead." (interactive "P") + (if (not (and (eq prolog-system 'sicstus) + (prolog-atleast-version '(3 . 7)))) + (error "Only works for SICStus 3.7 and later")) (if arg (prolog-zip-off) (prolog-process-insert-string (get-process "prolog") ------------------------------------------------------------ revno: 103008 committer: Chong Yidong branch nick: trunk timestamp: Fri 2011-01-28 14:13:01 -0500 message: * image-mode.el (image-display-size): Doc fix (Bug#7820). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-01-27 19:45:44 +0000 +++ lisp/ChangeLog 2011-01-28 19:13:01 +0000 @@ -1,3 +1,7 @@ +2011-01-28 Chong Yidong + + * image-mode.el (image-display-size): Doc fix (Bug#7820). + 2011-01-27 Sam Steingold * midnight.el (clean-buffer-list-kill-never-buffer-names): Remove === modified file 'lisp/image-mode.el' --- lisp/image-mode.el 2011-01-25 04:08:28 +0000 +++ lisp/image-mode.el 2011-01-28 19:13:01 +0000 @@ -118,13 +118,16 @@ (declare-function image-size "image.c" (spec &optional pixels frame)) (defun image-display-size (spec &optional pixels frame) - "Wrapper around `image-size', to handle slice display properties. -If SPEC is an image display property, call `image-size' with the -given arguments. -If SPEC is a list of properties containing `image' and `slice' -properties, calculate the display size from the slice property. -If SPEC contains `image' but not `slice', call `image-size' with -the specified image." + "Wrapper around `image-size', handling slice display properties. +Like `image-size', the return value is (WIDTH . HEIGHT). +WIDTH and HEIGHT are in canonical character units if PIXELS is +nil, and in pixel units if PIXELS is non-nil. + +If SPEC is an image display property, this function is equivalent +to `image-size'. If SPEC is a list of properties containing +`image' and `slice' properties, return the display size taking +the slice property into account. If the list contains `image' +but not `slice', return the `image-size' of the specified image." (if (eq (car spec) 'image) (image-size spec pixels frame) (let ((image (assoc 'image spec)) ------------------------------------------------------------ revno: 103007 committer: Chong Yidong branch nick: trunk timestamp: Fri 2011-01-28 11:58:04 -0500 message: Update autoloads. diff: === modified file 'lisp/dired.el' --- lisp/dired.el 2011-01-25 04:08:28 +0000 +++ lisp/dired.el 2011-01-28 16:58:04 +0000 @@ -3564,7 +3564,7 @@ ;;;;;; dired-run-shell-command dired-do-shell-command dired-do-async-shell-command ;;;;;; dired-clean-directory dired-do-print dired-do-touch dired-do-chown ;;;;;; dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff -;;;;;; dired-diff) "dired-aux" "dired-aux.el" "b30af1396920c8bf22f3c83746bb73f9") +;;;;;; dired-diff) "dired-aux" "dired-aux.el" "9f5fc434fa6c2607b6e66060862c9caf") ;;; Generated autoloads from dired-aux.el (autoload 'dired-diff "dired-aux" "\ @@ -4023,7 +4023,7 @@ ;;;*** ;;;### (autoloads (dired-do-relsymlink dired-jump) "dired-x" "dired-x.el" -;;;;;; "6d47e23fbd9236014786c50618e99f09") +;;;;;; "fbac6ae123aaa2b2e9df8bb2cde61ceb") ;;; Generated autoloads from dired-x.el (autoload 'dired-jump "dired-x" "\ === modified file 'lisp/emacs-lisp/cl-loaddefs.el' --- lisp/emacs-lisp/cl-loaddefs.el 2011-01-18 19:08:00 +0000 +++ lisp/emacs-lisp/cl-loaddefs.el 2011-01-28 16:58:04 +0000 @@ -10,7 +10,7 @@ ;;;;;; ceiling* floor* isqrt lcm gcd cl-progv-before cl-set-frame-visible-p ;;;;;; cl-map-overlays cl-map-intervals cl-map-keymap-recursively ;;;;;; notevery notany every some mapcon mapcan mapl maplist map -;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "ff6f0444d029166d2ed5da298f39854e") +;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "60f6b85256416c5f2a0a3954a11523b6") ;;; Generated autoloads from cl-extra.el (autoload 'coerce "cl-extra" "\ @@ -282,7 +282,7 @@ ;;;;;; do-all-symbols do-symbols dotimes dolist do* do loop return-from ;;;;;; return block etypecase typecase ecase case load-time-value ;;;;;; eval-when destructuring-bind function* defmacro* defun* gentemp -;;;;;; gensym) "cl-macs" "cl-macs.el" "fd9e3122cb1900c82072cb61a5f3c1bd") +;;;;;; gensym) "cl-macs" "cl-macs.el" "8b2ce9c2ec0e273606bb37c333c4bdde") ;;; Generated autoloads from cl-macs.el (autoload 'gensym "cl-macs" "\ @@ -754,7 +754,7 @@ ;;;;;; find nsubstitute-if-not nsubstitute-if nsubstitute substitute-if-not ;;;;;; substitute-if substitute delete-duplicates remove-duplicates ;;;;;; delete-if-not delete-if delete* remove-if-not remove-if remove* -;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "c17ab899d56f8fa132d0471ce6896a10") +;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "43e0c1183e738e1e1038cdd84fde8366") ;;; Generated autoloads from cl-seq.el (autoload 'reduce "cl-seq" "\ === modified file 'lisp/emulation/tpu-edt.el' --- lisp/emulation/tpu-edt.el 2011-01-25 04:08:28 +0000 +++ lisp/emulation/tpu-edt.el 2011-01-28 16:58:04 +0000 @@ -2437,7 +2437,7 @@ ;;;### (autoloads (tpu-set-cursor-bound tpu-set-cursor-free tpu-set-scroll-margins -;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "2544842880361769b7665e6361c22457") +;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "0d2f0cd1c728d2eb9028a6e01b1a5df1") ;;; Generated autoloads from tpu-extras.el (autoload 'tpu-cursor-free-mode "tpu-extras" "\ === modified file 'lisp/htmlfontify.el' --- lisp/htmlfontify.el 2011-01-27 17:04:07 +0000 +++ lisp/htmlfontify.el 2011-01-28 16:58:04 +0000 @@ -2311,7 +2311,7 @@ ;;;### (autoloads (hfy-fallback-colour-values htmlfontify-load-rgb-file) -;;;;;; "hfy-cmap" "hfy-cmap.el" "f7f81749b08e0aec14aac431f8b5ac8b") +;;;;;; "hfy-cmap" "hfy-cmap.el" "8dce008297f15826cc6ab82203c46fa6") ;;; Generated autoloads from hfy-cmap.el (autoload 'htmlfontify-load-rgb-file "hfy-cmap" "\ === modified file 'lisp/ibuffer.el' --- lisp/ibuffer.el 2011-01-25 04:08:28 +0000 +++ lisp/ibuffer.el 2011-01-28 16:58:04 +0000 @@ -2638,7 +2638,7 @@ ;;;;;; ibuffer-backward-filter-group ibuffer-forward-filter-group ;;;;;; ibuffer-toggle-filter-group ibuffer-mouse-toggle-filter-group ;;;;;; ibuffer-interactive-filter-by-mode ibuffer-mouse-filter-by-mode -;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "ae74e74d79fa66e206bef609e5f72d00") +;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "f163e17664a89a6f0aa2b15bfaaa65a4") ;;; Generated autoloads from ibuf-ext.el (autoload 'ibuffer-auto-mode "ibuf-ext" "\ === modified file 'lisp/mail/rmail.el' --- lisp/mail/rmail.el 2011-01-25 04:08:28 +0000 +++ lisp/mail/rmail.el 2011-01-28 16:58:04 +0000 @@ -4262,7 +4262,7 @@ ;;; Start of automatically extracted autoloads. ;;;### (autoloads (rmail-edit-current-message) "rmailedit" "rmailedit.el" -;;;;;; "1602595714ff15197cf32727d6765c31") +;;;;;; "090ad9432c3bf9a6098bb9c3d7c71baf") ;;; Generated autoloads from rmailedit.el (autoload 'rmail-edit-current-message "rmailedit" "\ @@ -4274,7 +4274,7 @@ ;;;### (autoloads (rmail-next-labeled-message rmail-previous-labeled-message ;;;;;; rmail-read-label rmail-kill-label rmail-add-label) "rmailkwd" -;;;;;; "rmailkwd.el" "061943b8a3dfd5695715b36736827950") +;;;;;; "rmailkwd.el" "08c288c88cfe7be50830122c064e3884") ;;; Generated autoloads from rmailkwd.el (autoload 'rmail-add-label "rmailkwd" "\ @@ -4317,7 +4317,7 @@ ;;;*** -;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "783deb7c855767051af119f1bfd8d84e") +;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "3e235bdf4c2e54da06abcdd72e7f7649") ;;; Generated autoloads from rmailmm.el (autoload 'rmail-mime "rmailmm" "\ @@ -4343,7 +4343,7 @@ ;;;*** ;;;### (autoloads (set-rmail-inbox-list) "rmailmsc" "rmailmsc.el" -;;;;;; "f1d9be06745c78b90224da788f61c2d9") +;;;;;; "ca19b2f8a3e8aa01aa75ca7413f8a5ef") ;;; Generated autoloads from rmailmsc.el (autoload 'set-rmail-inbox-list "rmailmsc" "\ @@ -4359,7 +4359,7 @@ ;;;### (autoloads (rmail-sort-by-labels rmail-sort-by-lines rmail-sort-by-correspondent ;;;;;; rmail-sort-by-recipient rmail-sort-by-author rmail-sort-by-subject -;;;;;; rmail-sort-by-date) "rmailsort" "rmailsort.el" "8b20167ea495d683f83f980833e948e0") +;;;;;; rmail-sort-by-date) "rmailsort" "rmailsort.el" "f297fd33c8f7fa74baf16d2da99acb35") ;;; Generated autoloads from rmailsort.el (autoload 'rmail-sort-by-date "rmailsort" "\ @@ -4418,7 +4418,7 @@ ;;;### (autoloads (rmail-summary-by-senders rmail-summary-by-topic ;;;;;; rmail-summary-by-regexp rmail-summary-by-recipients rmail-summary-by-labels -;;;;;; rmail-summary) "rmailsum" "rmailsum.el" "b1d2ca7470a7d8baffe9e90a15a5b5e0") +;;;;;; rmail-summary) "rmailsum" "rmailsum.el" "76a7ae570a4fa96a9233d0276f52f515") ;;; Generated autoloads from rmailsum.el (autoload 'rmail-summary "rmailsum" "\ @@ -4466,7 +4466,7 @@ ;;;*** ;;;### (autoloads (unforward-rmail-message undigestify-rmail-message) -;;;;;; "undigest" "undigest.el" "1b5181e02606e49ede71604472250cc3") +;;;;;; "undigest" "undigest.el" "41e6a48ea63224385c447a944528feb6") ;;; Generated autoloads from undigest.el (autoload 'undigestify-rmail-message "undigest" "\ === modified file 'lisp/ps-print.el' --- lisp/ps-print.el 2011-01-26 08:36:39 +0000 +++ lisp/ps-print.el 2011-01-28 16:58:04 +0000 @@ -6657,7 +6657,7 @@ ;; But autoload them here to make the separation invisible. ;;;### (autoloads (ps-mule-end-job ps-mule-begin-job ps-mule-initialize -;;;;;; ps-multibyte-buffer) "ps-mule" "ps-mule.el" "84d550158bdd60da7af54df17b7a38f7") +;;;;;; ps-multibyte-buffer) "ps-mule" "ps-mule.el" "0e9db04f70d1221af96488068afa1192") ;;; Generated autoloads from ps-mule.el (defvar ps-multibyte-buffer nil "\ ------------------------------------------------------------ revno: 103006 [merge] committer: Kenichi Handa branch nick: trunk timestamp: Fri 2011-01-28 21:36:47 +0900 message: ftfont.c (ftfont_spec_pattern): Check each extra property value. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-01-28 04:53:17 +0000 +++ src/ChangeLog 2011-01-28 12:31:39 +0000 @@ -1,3 +1,8 @@ +2011-01-28 Kenichi Handa + + * ftfont.c (ftfont_spec_pattern): Check each extra property + value. + 2011-01-28 Stefan Monnier * xdisp.c (safe_eval_handler): Distinguish symbols and strings. === modified file 'src/ftfont.c' --- src/ftfont.c 2011-01-25 04:08:28 +0000 +++ src/ftfont.c 2011-01-28 12:31:34 +0000 @@ -749,7 +749,10 @@ key = XCAR (XCAR (extra)), val = XCDR (XCAR (extra)); if (EQ (key, QCdpi)) - dpi = XINT (val); + { + if (INTEGERP (val)) + dpi = XINT (val); + } else if (EQ (key, QClang)) { if (! langset) @@ -769,12 +772,15 @@ } else if (EQ (key, QCotf)) { - *otspec = ftfont_get_open_type_spec (val); - if (! *otspec) - return NULL; - strcat (otlayout, "otlayout:"); - OTF_TAG_STR ((*otspec)->script_tag, otlayout + 9); - script = (*otspec)->script; + if (CONSP (val)) + { + *otspec = ftfont_get_open_type_spec (val); + if (! *otspec) + return NULL; + strcat (otlayout, "otlayout:"); + OTF_TAG_STR ((*otspec)->script_tag, otlayout + 9); + script = (*otspec)->script; + } } else if (EQ (key, QCscript)) script = val; ------------------------------------------------------------ revno: 103005 author: Julien Danjou committer: Katsumi Yamaoka branch nick: trunk timestamp: Fri 2011-01-28 11:27:24 +0000 message: gnus-group.el (gnus-group-jump-to-group): Set must match to t. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2011-01-28 02:07:48 +0000 +++ lisp/gnus/ChangeLog 2011-01-28 11:27:24 +0000 @@ -1,3 +1,7 @@ +2011-01-28 Julien Danjou + + * gnus-group.el (gnus-group-jump-to-group): Set must match to t. + 2011-01-28 Lars Ingebrigtsen * gnus-int.el (gnus-request-marks): Call *-request-marks instead of the === modified file 'lisp/gnus/gnus-group.el' --- lisp/gnus/gnus-group.el 2011-01-28 00:14:08 +0000 +++ lisp/gnus/gnus-group.el 2011-01-28 11:27:24 +0000 @@ -2467,7 +2467,7 @@ `gnus-group-jump-to-group-prompt'." (interactive (list (gnus-group-completing-read - nil nil (gnus-read-active-file-p) + nil nil t (if current-prefix-arg (cdr (assq current-prefix-arg gnus-group-jump-to-group-prompt)) (or (and (stringp gnus-group-jump-to-group-prompt) ------------------------------------------------------------ revno: 103004 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2011-01-27 23:53:17 -0500 message: * src/xdisp.c (safe_eval_handler): Distinguish symbols and strings. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-01-27 23:45:04 +0000 +++ src/ChangeLog 2011-01-28 04:53:17 +0000 @@ -1,3 +1,7 @@ +2011-01-28 Stefan Monnier + + * xdisp.c (safe_eval_handler): Distinguish symbols and strings. + 2011-01-27 Chong Yidong * font.c (font_parse_fcname): Undefine a temporary macro. === modified file 'src/xdisp.c' --- src/xdisp.c 2011-01-25 04:08:28 +0000 +++ src/xdisp.c 2011-01-28 04:53:17 +0000 @@ -2171,7 +2171,7 @@ static Lisp_Object safe_eval_handler (Lisp_Object arg) { - add_to_log ("Error during redisplay: %s", arg, Qnil); + add_to_log ("Error during redisplay: %S", arg, Qnil); return Qnil; } ------------------------------------------------------------ Use --include-merges or -n0 to see merged revisions.