Menu
I have two frames; the second frame is always intended to show *compilation* buffer. I'd like to make (compilation-goto-error) to navigate to a line with error to another frame. I have implemented a function to do this:
(defun my-compile-goto-error-other-frame ()
(interactive)
;;; just for simplification; in the read life there should be
;;; a search of a frame by name
(other-frame 1)
;;; I rely on the behavior when 'compile-goto-error' uses an another
;;; window in a frame to show a source code
(switch-to-buffer "*compilation*")
(compile-goto-error)
(recenter-top-bottom)
(delete-other-windows))
I believe that this implementation is ugly (but in most cases it works).
How to get rid of the sequence of creating new visible buffers and kill unused ones? Sometimes there are flickers. Possibly there are ways to perform the steps invisibly and show only the result?
How would look a correct implementation of (my-compile-display-error-other-frame)?
Similar to the following?
(defun my-compile-display-error-other-frame ()
(my-compile-goto-error-other-frame)
(other-frame 1))
Thanks.
UPDATE:
@lawlist, sorry for not being clear. There are no underlying function in this code. Standard 'compile-goto-error' and my wish to implement my own one which would open the code in another frame. I believe that my implementation is not good one; I suppose that it might look like:
(defun ... ()
;;; Make Emacs think that we are still in the frame where
;;; "*compilation*" buffer active is
(with-context-of-current-frame
;;; But make another frame called "main-window" active
(with-another-frame "main-window"
;;; Since *compile-mode* "thinks" that it still the same frame (because of context)
;;; it creates a new window here but actually the window with source
;;; code buffer is shown in frame "main-window"
(progn (compile-goto-error)
(recenter-top-bottom)))))
In my implementation I do not like that I have to switch to another frame, then select a buffer with compilation log (on slow/remote terminals it would be apparent) then perform 'compile-goto-error' and then delete previously open "compilation" buffer. I believe these steps are excessive.
711
This answer requires that the frame containing the buffer to be compiled must be named one of the following -- e.g., using set-buffer-name: MAIN or SYSTEM or ORG or MISCELLANEOUS. Then once you have set the frame name of the buffer to be compiled, run M-x compile. If you would like to learn more about this process, please visit my other thread: How to intercept a file before it opens and decide which frame
The relevant portion of compilation-start that was modified is the section relating to the variable outbuf.
(defvar regexp-frame-names "^\\(?:MAIN\\|SYSTEM\\|ORG\\|MISCELLANEOUS\\|COMPILATION\\)$"
"Regexp matching frames with specific names.")
(defvar zweibaranov-buffer-regexp nil
"Regexp of file / buffer names displayed in frame `COMPILATION`.")
(setq zweibaranov-buffer-regexp '("\\*compilation\\*"))
(defun zweibaranov-display-buffer-pop-up-frame (buffer alist)
(cond
((regexp-match-p zweibaranov-buffer-regexp (buffer-name buffer))
(if (get-frame "COMPILATION")
(switch-to-frame "COMPILATION")
;; If unnamed frame exists, then take control of it.
(catch 'break (dolist (frame (frame-list))
(if (not (string-match regexp-frame-names (frame-parameter frame 'name)))
(throw 'break (progn
(switch-to-frame (frame-parameter frame 'name))
(set-frame-name "COMPILATION"))))))
;; If dolist found no unnamed frame, then create / name it.
(if (not (get-frame "COMILATION"))
(progn
(make-frame)
(set-frame-name "COMPILATION"))) )
(set-window-buffer (selected-window) (buffer-name buffer))
(set-buffer (buffer-name buffer)) )
(t nil) ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; REGEXP FUNCTION ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun regexp-match-p (regexps string)
"Before the lisp function, define the variable like this:\n
(defvar example-regexp nil
\"Regexps matching `buffer-name buffer` for frame name `SYSTEM`.\")
(setq example-regexp '(\"\\(\\*foo\\*\\|\\*bar\\*\\)\"))
\nWithin the lisp function, use something like this:\n
(regexp-match-p example-regexp (buffer-name buffer))
\nOr, this:\n
(regexp-match-p example-regexp buffer-filename)"
;; (setq case-fold-search nil) ;; take case into consideration
(catch 'matched
(dolist (regexp regexps)
(if (string-match regexp string)
(throw 'matched t)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; FRAME UTILITIES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; http://www.emacswiki.org/emacs/frame-fns.el
(defun get-frame-name (&optional frame)
"Return the string that names FRAME (a frame). Default is selected frame."
(unless frame (setq frame (selected-frame)))
(if (framep frame)
(cdr (assq 'name (frame-parameters frame)))
(error "Function `get-frame-name': Argument not a frame: `%s'" frame)))
;; http://www.emacswiki.org/emacs/frame-fns.el
(defun get-frame (frame)
"Return a frame, if any, named FRAME (a frame or a string).
If none, return nil.
If FRAME is a frame, it is returned."
(cond ((framep frame) frame)
((stringp frame)
(catch 'get-a-frame-found
(dolist (fr (frame-list))
(when (string= frame (get-frame-name fr))
(throw 'get-a-frame-found fr)))
nil))
(t
(error
"Function `get-frame-name': Arg neither a string nor a frame: `%s'"
frame))))
;; https://stackoverflow.com/questions/17823448/if-frame-named-xyz-exists-then-switch-to-that-frame
(defun switch-to-frame (frame-name)
(let ((frames (frame-list)))
(catch 'break
(while frames
(let ((frame (car frames)))
(if (equal (frame-parameter frame 'name) frame-name)
(throw 'break (select-frame-set-input-focus frame))
(setq frames (cdr frames))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'compile)
(defalias 'compilation-start 'lawlist-compilation-start)
(defun lawlist-compilation-start (command &optional mode name-function highlight-regexp)
"Run compilation command COMMAND (low level interface).
If COMMAND starts with a cd command, that becomes the `default-directory'.
The rest of the arguments are optional; for them, nil means use the default.
MODE is the major mode to set in the compilation buffer. Mode
may also be t meaning use `compilation-shell-minor-mode' under `comint-mode'.
If NAME-FUNCTION is non-nil, call it with one argument (the mode name)
to determine the buffer name. Otherwise, the default is to
reuses the current buffer if it has the proper major mode,
else use or create a buffer with name based on the major mode.
If HIGHLIGHT-REGEXP is non-nil, `next-error' will temporarily highlight
the matching section of the visited source line; the default is to use the
global value of `compilation-highlight-regexp'.
Returns the compilation buffer created."
(or mode (setq mode 'compilation-mode))
(let* ((name-of-mode
(if (eq mode t)
"compilation"
(replace-regexp-in-string "-mode\\'" "" (symbol-name mode))))
(thisdir default-directory)
(thisenv compilation-environment)
outwin outbuf)
(with-current-buffer
(setq outbuf
(display-buffer (get-buffer-create
(compilation-buffer-name name-of-mode mode name-function)) '(zweibaranov-display-buffer-pop-up-frame)))
(let ((comp-proc (get-buffer-process (current-buffer))))
(if comp-proc
(if (or (not (eq (process-status comp-proc) 'run))
(eq (process-query-on-exit-flag comp-proc) nil)
(yes-or-no-p
(format "A %s process is running; kill it? "
name-of-mode)))
(condition-case ()
(progn
(interrupt-process comp-proc)
(sit-for 1)
(delete-process comp-proc))
(error nil))
(error "Cannot have two processes in `%s' at once"
(buffer-name)))))
;; first transfer directory from where M-x compile was called
(setq default-directory thisdir)
;; Make compilation buffer read-only. The filter can still write it.
;; Clear out the compilation buffer.
(let ((inhibit-read-only t)
(default-directory thisdir))
;; Then evaluate a cd command if any, but don't perform it yet, else
;; start-command would do it again through the shell: (cd "..") AND
;; sh -c "cd ..; make"
(cd (cond
((not (string-match "\\`\\s *cd\\(?:\\s +\\(\\S +?\\|'[^']*'\\|\"\\(?:[^\"`$\\]\\|\\\\.\\)*\"\\)\\)?\\s *[;&\n]"
command))
default-directory)
((not (match-end 1)) "~")
((eq (aref command (match-beginning 1)) ?\')
(substring command (1+ (match-beginning 1))
(1- (match-end 1))))
((eq (aref command (match-beginning 1)) ?\")
(replace-regexp-in-string
"\\\\\\(.\\)" "\\1"
(substring command (1+ (match-beginning 1))
(1- (match-end 1)))))
;; Try globbing as well (bug#15417).
(t (let* ((substituted-dir
(substitute-env-vars (match-string 1 command)))
;; FIXME: This also tries to expand `*' that were
;; introduced by the envvar expansion!
(expanded-dir
(file-expand-wildcards substituted-dir)))
(if (= (length expanded-dir) 1)
(car expanded-dir)
substituted-dir)))))
(erase-buffer)
;; Select the desired mode.
(if (not (eq mode t))
(progn
(buffer-disable-undo)
(funcall mode))
(setq buffer-read-only nil)
(with-no-warnings (comint-mode))
(compilation-shell-minor-mode))
;; Remember the original dir, so we can use it when we recompile.
;; default-directory' can't be used reliably for that because it may be
;; affected by the special handling of "cd ...;".
;; NB: must be done after (funcall mode) as that resets local variables
(set (make-local-variable 'compilation-directory) thisdir)
(set (make-local-variable 'compilation-environment) thisenv)
(if highlight-regexp
(set (make-local-variable 'compilation-highlight-regexp)
highlight-regexp))
(if (or compilation-auto-jump-to-first-error
(eq compilation-scroll-output 'first-error))
(set (make-local-variable 'compilation-auto-jump-to-next) t))
;; Output a mode setter, for saving and later reloading this buffer.
(insert "-*- mode: " name-of-mode
"; default-directory: "
(prin1-to-string (abbreviate-file-name default-directory))
" -*-\n"
(format "%s started at %s\n\n"
mode-name
(substring (current-time-string) 0 19))
;; The command could be split into several lines, see
;; `rgrep' for example. We want to display it as one
;; line.
(apply 'concat (split-string command (regexp-quote "\\\n") t))
"\n")
(setq thisdir default-directory))
(set-buffer-modified-p nil))
;; Pop up the compilation buffer.
;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01638.html
(setq outwin (display-buffer outbuf))
(with-current-buffer outbuf
(let ((process-environment
(append
compilation-environment
(if (if (boundp 'system-uses-terminfo);`If' for compiler warning.
system-uses-terminfo)
(list "TERM=dumb" "TERMCAP="
(format "COLUMNS=%d" (window-width)))
(list "TERM=emacs"
(format "TERMCAP=emacs:co#%d:tc=unknown:"
(window-width))))
;; Set the EMACS variable, but
;; don't override users' setting of $EMACS.
(unless (getenv "EMACS")
(list "EMACS=t"))
(list "INSIDE_EMACS=t")
(copy-sequence process-environment))))
(set (make-local-variable 'compilation-arguments)
(list command mode name-function highlight-regexp))
(set (make-local-variable 'revert-buffer-function)
'compilation-revert-buffer)
(set-window-start outwin (point-min))
;; Position point as the user will see it.
(let ((desired-visible-point
;; Put it at the end if `compilation-scroll-output' is set.
(if compilation-scroll-output
(point-max)
;; Normally put it at the top.
(point-min))))
(if (eq outwin (selected-window))
(goto-char desired-visible-point)
(set-window-point outwin desired-visible-point)))
;; The setup function is called before compilation-set-window-height
;; so it can set the compilation-window-height buffer locally.
(if compilation-process-setup-function
(funcall compilation-process-setup-function))
(compilation-set-window-height outwin)
;; Start the compilation.
(if (fboundp 'start-process)
(let ((proc
(if (eq mode t)
;; comint uses `start-file-process'.
(get-buffer-process
(with-no-warnings
(comint-exec
outbuf (downcase mode-name)
(if (file-remote-p default-directory)
"/bin/sh"
shell-file-name)
nil `("-c" ,command))))
(start-file-process-shell-command (downcase mode-name)
outbuf command))))
;; Make the buffer's mode line show process state.
(setq mode-line-process
'(:propertize ":%s" face compilation-mode-line-run))
;; Set the process as killable without query by default.
;; This allows us to start a new compilation without
;; getting prompted.
(when compilation-always-kill
(set-process-query-on-exit-flag proc nil))
(set-process-sentinel proc 'compilation-sentinel)
(unless (eq mode t)
;; Keep the comint filter, since it's needed for proper
;; handling of the prompts.
(set-process-filter proc 'compilation-filter))
;; Use (point-max) here so that output comes in
;; after the initial text,
;; regardless of where the user sees point.
(set-marker (process-mark proc) (point-max) outbuf)
(when compilation-disable-input
(condition-case nil
(process-send-eof proc)
;; The process may have exited already.
(error nil)))
(run-hook-with-args 'compilation-start-hook proc)
(setq compilation-in-progress
(cons proc compilation-in-progress)))
;; No asynchronous processes available.
(message "Executing `%s'..." command)
;; Fake mode line display as if `start-process' were run.
(setq mode-line-process
'(:propertize ":run" face compilation-mode-line-run))
(force-mode-line-update)
(sit-for 0) ; Force redisplay
(save-excursion
;; Insert the output at the end, after the initial text,
;; regardless of where the user sees point.
(goto-char (point-max))
(let* ((inhibit-read-only t) ; call-process needs to modify outbuf
(compilation-filter-start (point))
(status (call-process shell-file-name nil outbuf nil "-c"
command)))
(run-hooks 'compilation-filter-hook)
(cond ((numberp status)
(compilation-handle-exit
'exit status
(if (zerop status)
"finished\n"
(format "exited abnormally with code %d\n" status))))
((stringp status)
(compilation-handle-exit 'signal status
(concat status "\n")))
(t
(compilation-handle-exit 'bizarre status status)))))
(set-buffer-modified-p nil)
(message "Executing `%s'...done" command)))
;; Now finally cd to where the shell started make/grep/...
(setq default-directory thisdir)
;; The following form selected outwin ever since revision 1.183,
;; so possibly messing up point in some other window (bug#1073).
;; Moved into the scope of with-current-buffer, though still with
;; complete disregard for the case when compilation-scroll-output
;; equals 'first-error (martin 2008-10-04).
(when compilation-scroll-output
(goto-char (point-max))))
;; Make it so the next C-x ` will use this buffer.
(setq next-error-last-buffer outbuf)))
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With
