diff options
Diffstat (limited to 'emacs.d/nxhtml/util/udev.el')
| -rw-r--r-- | emacs.d/nxhtml/util/udev.el | 456 |
1 files changed, 0 insertions, 456 deletions
diff --git a/emacs.d/nxhtml/util/udev.el b/emacs.d/nxhtml/util/udev.el deleted file mode 100644 index ee9d86a..0000000 --- a/emacs.d/nxhtml/util/udev.el +++ /dev/null @@ -1,456 +0,0 @@ -;;; udev.el --- Helper functions for updating from dev sources -;; -;; Author: Lennart Borgman (lennart O borgman A gmail O com) -;; Created: 2008-08-24 -(defconst udev:version "0.5");; Version: -;; Last-Updated: 2009-01-06 Tue -;; URL: -;; Keywords: -;; Compatibility: -;; -;; Features that might be required by this library: -;; - ;; `cus-edit', `cus-face', `cus-load', `cus-start', `wid-edit'. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: -;; -;; When you want to fetch and install sources from a repository you -;; may have to call several async processes and wait for the answer -;; before calling the next function. These functions may help you with -;; this. -;; -;; See `udev-call-first-step' for more information. Or look in the -;; file udev-cedet.el for examples. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Change log: -;; -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or -;; (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth -;; Floor, Boston, MA 02110-1301, USA. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'cus-edit) - -;;; Control/log buffer - -(defvar udev-log-buffer nil - "Log buffer pointer for sentinel function.") -(make-variable-buffer-local 'udev-log-buffer) - -(defvar udev-is-log-buffer nil - "This is t if this is an udev log/control buffer.") -(make-variable-buffer-local 'udev-is-log-buffer) - -(defun udev-check-is-log-buffer (buffer) - "Check that BUFFER is an udev log/control buffer." - (with-current-buffer buffer - (unless udev-is-log-buffer - (error "Internal error, not a log buffer: %s" buffer)))) - -(defvar udev-this-chain nil) -(make-variable-buffer-local 'udev-this-chain) - -(defvar udev-last-error nil - "Error found during last step.") -(make-variable-buffer-local 'udev-last-error) - -(defun udev-set-last-error (log-buffer msg) - (with-current-buffer log-buffer - (setq udev-last-error msg))) - -;;; Chain utils - -(defun udev-chain (log-buffer) - "Return value of `udev-this-chain' in buffer LOG-BUFFER." - (udev-check-is-log-buffer log-buffer) - (with-current-buffer log-buffer - udev-this-chain)) - -(defun udev-this-step (log-buffer) - "Return current function to call from LOG-BUFFER." - (let ((this-chain (udev-chain log-buffer))) - (caar this-chain))) - -(defun udev-goto-next-step (log-buffer) - "Set next function as current in LOG-BUFFER." - (let* ((this-chain (udev-chain log-buffer)) - (this-step (car this-chain))) - (setcar this-chain (cdr this-step)))) - -(defun udev-num-steps (log-buffer) - "Return number of steps." - (length (nth 2 (udev-chain log-buffer)))) - -(defun udev-step-num (log-buffer) - "Return current step number." - (let ((this-chain (udev-chain log-buffer))) - (when this-chain - (1+ (- (udev-num-steps log-buffer) - (length (car this-chain))))))) - -(defun udev-finish-function (log-buffer) - "Return setup function to be called when finished." - (nth 3 (udev-chain log-buffer))) - - -(defvar udev-control-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map button-buffer-map) - map)) - -(define-derived-mode udev-control-mode nil - "Udev-Src" - "Mode for udev control buffer." - (setq show-trailing-whitespace nil) - (setq buffer-read-only t) - (nxhtml-menu-mode 1)) - -;;; Calling steps - -;;;###autoload -(defun udev-call-first-step (log-buffer steps header finish-fun) - "Set up and call first step. -Set up buffer LOG-BUFFER to be used for log messages and -controling of the execution of the functions in list STEPS which -are executed one after another. - -Write HEADER at the end of LOG-BUFFER. - -Call first step. - -If FINISH-FUN non-nil it should be a function. This is called -after last step with LOG-BUFFER as parameter." - ;;(dolist (step steps) (unless (functionp step) (error "Not a known function: %s" step))) - (switch-to-buffer log-buffer) - (udev-control-mode) - (setq udev-is-log-buffer t) - (let ((this-chain - (cons nil - (cons log-buffer - (cons (copy-tree steps) - (cons finish-fun nil)))))) - (setcar this-chain (caddr this-chain)) - (setq udev-this-chain this-chain)) - (assert (eq (car steps) (udev-this-step log-buffer)) t) - (assert (eq finish-fun (udev-finish-function log-buffer)) t) - (widen) - (goto-char (point-max)) - (let ((inhibit-read-only t)) - (unless (= (point) (point-min)) (insert "\n\n")) - (insert header)) - (udev-call-this-step log-buffer nil) - (current-buffer)) - -(defvar udev-step-keymap - (let ((map (make-sparse-keymap))) - (define-key map [(control ?c) ?r] 'udev-rerun-this-step) - (define-key map [(control ?c) ?c] 'udev-continue-from-this-step) - (define-key map [(control ?c) ?s] 'udev-goto-this-step-source) - map)) - -(defun udev-step-at-point () - (get-text-property (point) 'udev-step)) - -(defun udev-rerun-this-step () - "Rerun this step." - (interactive) - (let ((this-step (udev-step-at-point))) - (udev-call-this-step (current-buffer) this-step))) - -(defun udev-continue-from-this-step () - "Continue from this step." - (interactive) - (let ((this-step (udev-step-at-point))) - (goto-char (point-max)) - (let ((inhibit-read-only t)) - (insert (format "\n\nContinuing from %s..." this-step))) - (udev-call-this-step (current-buffer) this-step))) - -(defun udev-goto-this-step-source () - "Find source function for this step." - (interactive) - (let ((this-step (udev-step-at-point))) - (find-function-other-window this-step))) - -(defun udev-call-this-step (log-buffer this-step) - "Call the current function in LOG-BUFFER. -If this function returns a buffer and the buffer has a process -then change the process sentinel to `udev-compilation-sentinel'. -Otherwise continue to call the next function. - -Also put a log message in in LOG-BUFFER with a link to the buffer -returned above if any." - (setq this-step (or this-step (udev-this-step log-buffer))) - (with-current-buffer log-buffer - (setq udev-last-error nil) - (widen) - (goto-char (point-max)) - (let* ((inhibit-read-only t) - here - buf - proc) - (if (not this-step) - (let ((finish-fun (udev-finish-function log-buffer))) - (insert (propertize "\nFinished\n" 'face 'compilation-info)) - (when finish-fun - (funcall finish-fun log-buffer))) - (insert (format "\nStep %s(%s): " - (udev-step-num log-buffer) - (udev-num-steps log-buffer))) - (setq here (point)) - (insert (pp-to-string this-step)) - (setq buf (funcall this-step log-buffer)) - (when (bufferp buf) - (make-text-button here (point) - 'udev-step this-step - 'keymap udev-step-keymap - 'buffer buf - 'help-echo "Push RET to see log buffer, <APPS> for other actions" - 'action (lambda (btn) - (display-buffer - (button-get btn 'buffer)))) - (setq proc (get-buffer-process buf))) - ;; Setup for next step - (if (and proc - (not udev-last-error)) - (progn - (with-current-buffer buf - ;; Make a copy here for the sentinel function. - (setq udev-log-buffer log-buffer) - (setq udev-orig-sentinel (process-sentinel proc)) - (set-process-sentinel proc 'udev-compilation-sentinel))) - ;;(message "proc is nil") - (if udev-last-error - (insert " " - (propertize udev-last-error 'face 'compilation-error)) - (udev-call-next-step log-buffer 0 nil))))))) - -(defun udev-call-next-step (log-buffer prev-exit-status exit-status-buffer) - "Go to next step in LOG-BUFFER and call `udev-call-this-step'. -However if PREV-EXIT-STATUS \(which is the exit status from the -previous step) is not 0 and there is in EXIT-STATUS-BUFFER no -`udev-continue-on-error-function' then stop and insert an error -message in LOG-BUFFER." - (with-current-buffer log-buffer - (let ((inhibit-read-only t)) - (widen) - (goto-char (point-max)) - (insert " ") - (if (or (= 0 prev-exit-status) - (with-current-buffer exit-status-buffer - (when udev-continue-on-error-function - (funcall udev-continue-on-error-function exit-status-buffer)))) - (progn - (insert - (if (= 0 prev-exit-status) - (propertize "Ok" 'face 'compilation-info) - (propertize "Warning, check next step" 'face 'compilation-warning))) - (udev-goto-next-step log-buffer) - (udev-call-this-step log-buffer nil)) - (insert (propertize "Error" 'face 'compilation-error)))))) - - -;;; Sentinel - -(defvar udev-orig-sentinel nil - "Old sentinel function remembered by `udev-call-this-step'.") -(make-variable-buffer-local 'udev-orig-sentinel) - -(defun udev-compilation-sentinel (proc msg) - "Sentinel to use for processes started by `udev-call-this-step'. -Check for error messages and call next step. PROC and MSG have -the same meaning as for `compilation-sentinel'." - ;;(message "udev-compilation-sentinel proc=%s msg=%s" proc msg) - (let ((buf (process-buffer proc)) - (exit-status (process-exit-status proc))) - (with-current-buffer buf - (when udev-orig-sentinel - (funcall udev-orig-sentinel proc msg)) - (when (and (eq 'exit (process-status proc)) - (= 0 exit-status)) - ;; Check for errors - (let ((here (point)) - (err-point 1) - (has-error nil)) - (widen) - (goto-char (point-min)) - (setq has-error - (catch 'found-error - (while err-point - (setq err-point - (next-single-property-change err-point 'face)) - (when err-point - (let ((face (get-text-property err-point 'face))) - (when (or (and (listp face) - (memq 'compilation-error face)) - (eq 'compilation-error face)) - (throw 'found-error t))))))) - (when has-error - (setq exit-status 1) - (goto-char (point-max)) - (let ((inhibit-read-only t)) - (insert (propertize "There were errors" 'font-lock-face 'compilation-error))) - (udev-set-compilation-end-message buf 'exit (cons "has errors" 1))) - (goto-char here) - )) - (unless (member proc compilation-in-progress) - (udev-call-next-step udev-log-buffer exit-status (current-buffer)))))) - -(defun udev-set-compilation-end-message (buffer process-status status) - "Change the message shown after compilation. -This is similar to `compilation-end-message' and BUFFER, -PROCESS-STATUS and STATUS have the same meaning as there." - (with-current-buffer buffer - (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))))) - (message "%s" msg) - (propertize out-string - 'help-echo msg 'face (if (> (cdr status) 0) - 'compilation-error - 'compilation-info)))))) - -(defvar udev-continue-on-error-function nil - "One-time helper to resolve exit status error problem. -This can be used for example after calling `cvs diff' which -returns error exit status if there is a difference - even though -there does not have to be an error.") -(make-variable-buffer-local 'udev-continue-on-error-function) - - -;;; Convenience functions - -(defun udev-buffer-name (fmt log-buffer mode) - "Return a name for compilation buffer. -Use format string FMT and buffer LOG-BUFFER, but ignoring MODE." - (format fmt (when (buffer-live-p log-buffer) - (udev-this-step log-buffer)))) - -(defvar udev-this-dir - (let ((this-file (or load-file-name (buffer-file-name)))) - (file-name-directory this-file))) - -(defun udev-batch-compile (emacs-args defdir name-function) - "Compile elisp code in an inferior Emacs. -Start Emacs with - - emacs -Q -batch EMACS-ARGS - -in the default directory DEFDIR. - -Set the buffer name for the inferior process with NAME-FUNCTION -by giving this to `compilation-start'." - (let ((default-directory (file-name-as-directory defdir)) - (this-emacs (ourcomments-find-emacs))) - (compilation-start - (concat this-emacs " -Q -batch " emacs-args) - 'compilation-mode - name-function))) - -;;; Convenience functions for CVS - -(defun udev-fetch-cvs-diff (defdir name-function) - "Fetch cvs diff in directory DEFDIR. -Put the diff in file 'your-patches.diff' in DEFDIR. -Give inferior buffer name with NAME-FUNCTION." - (let ((default-directory (file-name-as-directory defdir))) - (with-current-buffer - (compilation-start - (concat "cvs diff -b -u > " (shell-quote-argument "your-patches.diff")) - 'compilation-mode - name-function) - (setq udev-continue-on-error-function 'udev-cvs-diff-continue) - (current-buffer)))) - -(defun udev-cvs-diff-continue (cvs-diff-buffer) - "Return non-nil if it is ok to continue. -Check the output from the `cvs diff' command in buffer -CVS-DIFF-BUFFER. - -The cvs command exits with a failure status if there is a -difference, which means that it is hard to know whether there was -an error or just a difference. This function tries to find out." - (with-current-buffer cvs-diff-buffer - (let ((here (point)) - (ret t)) - (goto-char (point-min)) - (when (search-forward "cvs [diff aborted]" nil t) (setq ret nil)) - (goto-char (point-min)) - (when (search-forward "merge conflict" nil t) (setq ret t)) - ;; From cvs co command: - ;; rcsmerge: warning: conflicts during merge - (goto-char (point-min)) - (when (search-forward "conflicts during merge" nil t) (setq ret t)) - ;; cvs checkout: conflicts found in emacs/lisp/startup.el - (goto-char (point-min)) - (when (search-forward "conflicts found in" nil t) (setq ret t)) - (goto-char here) - ret))) - -(defun udev-check-cvs-diff (diff-file log-buffer) - "Check cvs diff output in file DIFF-FILE for merge conflicts. -Return buffer containing DIFF-FILE." - (let ((buf (find-buffer-visiting diff-file))) - ;; Kill buffer to avoid question about revert. - (when buf (kill-buffer buf)) - (setq buf (find-file-noselect diff-file)) - (with-current-buffer buf - (widen) - (let ((here (point))) - (goto-char (point-min)) - ;; Fix-me: Better pattern: - (if (search-forward "<<<<<<<" nil t) - ;; Merge conflict - (with-current-buffer log-buffer - (let ((inhibit-read-only t)) - (setq udev-last-error "Error: merge conflict"))) - (goto-char here)))) - buf)) - -;;(setq compilation-scroll-output t) -;;(add-to-list 'compilation-error-regexp-alist 'cvs) -;;(setq compilation-error-regexp-alist (delq 'cvs compilation-error-regexp-alist)) - -;;; Misc - -(defun udev-send-buffer-process (str) - (interactive "sString to send to process: ") - (let* ((procs (process-list)) - (proc (catch 'found - (dolist (p procs) - (when (eq (process-buffer p) (current-buffer)) - (throw 'found p)))))) - (unless proc (error "Can't find process in buffer")) - ;;(message "str=%s" str) - ;;(message "proc=%s" proc) - (process-send-string proc (concat str "\n")) - )) - - -(provide 'udev) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; udev.el ends here |