Changeset - efeb7d0d8dc3
[Not reviewed]
0 1 0
Naoto Yokoyama - 12 years ago 2014-02-28 13:54:40
builtinnya@gmail.com
Fixed mode-line to be attached face correctly
1 file changed with 9 insertions and 9 deletions:
0 comments (0 inline, 0 general)
src/workgroups-functions.el
Show inline comments
 
@@ -1306,216 +1306,216 @@ Ask to overwrite if a workgroup with the same name exists."
 
    :base-wconfig (if blank (wg-make-blank-wconfig)
 
                    (wg-current-wconfig)))))
 

	
 
(defun wg-get-workgroup-create (workgroup)
 
  "Return the workgroup specified by WORKGROUP, creating a new one if needed.
 
If `wg-get-workgroup' on WORKGROUP returns a workgroup, return it.
 
Otherwise, if WORKGROUP is a string, create a new workgroup with
 
that name and return it. Otherwise error."
 
  (or (wg-get-workgroup workgroup t)
 
      (if (stringp workgroup)
 
          (when (or (not wg-confirm-on-get-workgroup-create)
 
                    (y-or-n-p (format "%S doesn't exist.  Create it? "
 
                                      workgroup)))
 
            (wg-make-and-add-workgroup workgroup))
 
        ;; Call this again for its error message
 
        (wg-get-workgroup workgroup))))
 

	
 
(defun wg-cyclic-offset-workgroup (workgroup n)
 
  "Offset WORKGROUP's position in `wg-workgroup-list' by N."
 
  (let ((workgroup-list (wg-workgroup-list-or-error)))
 
    (unless (member workgroup workgroup-list)
 
      (error "Workgroup isn't present in `wg-workgroup-list'."))
 
    (setf (wg-workgroup-list) (wg-cyclic-offset-elt workgroup workgroup-list n)
 
          (wg-session-modified (wg-current-session)) t)))
 

	
 
(defun wg-swap-workgroups-in-workgroup-list (workgroup1 workgroup2)
 
  "Swap the positions of WORKGROUP1 and WORKGROUP2 in `wg-workgroup-list'."
 
  (let ((workgroup-list (wg-workgroup-list-or-error)))
 
    (when (eq workgroup1 workgroup2)
 
      (error "Can't swap a workgroup with itself"))
 
    (unless (and (memq workgroup1 workgroup-list)
 
                 (memq workgroup2 workgroup-list))
 
      (error "Both workgroups aren't present in `wg-workgroup-list'."))
 
    (setf (wg-workgroup-list) (wg-util-swap workgroup1 workgroup2 workgroup-list)
 
          (wg-session-modified (wg-current-session)) t)))
 

	
 
(defun wg-cyclic-nth-from-workgroup (workgroup &optional n)
 
  "Return the workgroup N places from WORKGROUP in `wg-workgroup-list'."
 
  (wg-cyclic-nth-from-elt workgroup (wg-workgroup-list-or-error) (or n 1)))
 

	
 

	
 

	
 
;;; buffer association
 

	
 
(defun wg-associate-buffers (workgroup window-or-emacs-window-tree)
 
  "Associate the buffers visible in window elements of
 
WINDOW-OR-EMACS-WINDOW-TREE with the given WORKGROUP.
 
WINDOW-OR-EMACS-WINDOW-TREE must be either a window or a tree of
 
the form produced by `(car (window-tree))'."
 
  (wg-aif (windowp window-or-emacs-window-tree)
 
      (with-current-buffer (window-buffer window-or-emacs-window-tree)
 
        (setq wg-buffer-workgroup workgroup))
 
    (dolist (w (cddr window-or-emacs-window-tree))
 
      (when w (wg-associate-buffers workgroup w)))))
 

	
 
(defun wg-associate-frame-buffers ()
 
  "Associate the buffers visible in the current frame with the
 
current workgroup (unless it is currently being deactivated)."
 
  (wg-awhen (wg-current-workgroup :noerror)
 
    (unless (member it wg-deactivation-list)
 
      (wg-associate-buffers it (car (window-tree))))))
 

	
 
(defun wg-associate-all-frame-buffers ()
 
  "Associate all visible buffers with the current
 
workgroup (unless it is currently being deactivated)."
 
  (mapcar 'wg-associate-frame-buffers (frame-list)))
 

	
 
(defun wg-buffer-predicate (buffer)
 
  "Return t iff the given BUFFER should be considered a candidate
 
for display by `other-buffer' in the current workgroup."
 
  (or (not wg-associate-buffers)
 
      (wg-awhen (wg-current-workgroup :noerror)
 
        (with-current-buffer buffer
 
          (eq wg-buffer-workgroup it)))))
 

	
 
(defun wg-after-make-frame (frame)
 
  (set-frame-parameter frame 'buffer-predicate
 
                       'wg-buffer-predicate))
 

	
 
;;; mode-line
 

	
 
(defun wg-mode-line-buffer-association-indicator (workgroup)
 
  "Return a string indicating `current-buffer's association-type in WORKGROUP."
 
  (cl-case (wg-workgroup-bufobj-association-type workgroup (current-buffer))
 
    (strong wg-mode-line-decor-strongly-associated)
 
    (weak wg-mode-line-decor-weakly-associated)
 
    (otherwise wg-mode-line-decor-unassociated)))
 

	
 
(defun wg-mode-line-string ()
 
  "Return the string to be displayed in the mode-line."
 
  (let ((wg (wg-current-workgroup t))
 
        (wg-use-faces wg-mode-line-use-faces))
 
    (cond (wg (wg-fontify " "
 
                ;;(consp (cons :div wg-mode-line-decor-left-brace))
 
                ;;(keywordp (car (cons :div wg-mode-line-decor-left-brace)))
 
                ;;(:div wg-mode-line-decor-left-brace)
 
                wg-mode-line-decor-left-brace
 
                (wg-workgroup-name wg)
 
                (:brace wg-mode-line-decor-left-brace)
 
                (:mode (wg-workgroup-name wg))
 
                (if (not wg-mode-line-only-name)
 
                    (progn
 
                      wg-mode-line-decor-divider
 
                      (:div wg-mode-line-decor-divider)
 
                      (wg-mode-line-buffer-association-indicator wg)
 
                      wg-mode-line-decor-divider
 
                      (:div wg-mode-line-decor-divider)
 
                      (if (window-dedicated-p)
 
                                 wg-mode-line-decor-window-dedicated
 
                               wg-mode-line-decor-window-undedicated)
 
                      wg-mode-line-decor-divider
 
                      (:div wg-mode-line-decor-divider)
 
                      (if (wg-session-modified (wg-current-session))
 
                                 wg-mode-line-decor-session-modified
 
                               wg-mode-line-decor-session-unmodified)
 
                      (if (wg-workgroup-modified wg)
 
                          wg-mode-line-decor-workgroup-modified
 
                        wg-mode-line-decor-workgroup-unmodified)))
 
                wg-mode-line-decor-right-brace))
 
                (:brace wg-mode-line-decor-right-brace)))
 
          (t (if wg-display-nowg
 
                 (progn
 
                   (wg-fontify " "
 
                     wg-mode-line-decor-left-brace
 
                     wg-nowg-string
 
                     wg-mode-line-decor-right-brace))
 
                     (:brace wg-mode-line-decor-left-brace)
 
                     (:mode wg-nowg-string)
 
                     (:brace wg-mode-line-decor-right-brace)))
 
               "")))))
 

	
 
(defun wg-add-mode-line-display ()
 
  "Add Workgroups' mode-line format to `mode-line-format'."
 
  (unless (or (assq 'wg-mode-line-display-on mode-line-format)
 
              wg-mode-line-disable)
 
    (let ((format '(wg-mode-line-display-on (:eval (wg-mode-line-string))))
 
          (pos (or (cl-position 'mode-line-position mode-line-format) 10)))
 
      (set-default 'mode-line-format
 
                   (wg-insert-after format mode-line-format pos))
 
      (force-mode-line-update))))
 

	
 
(defun wg-remove-mode-line-display ()
 
  "Remove Workgroups' mode-line format from `mode-line-format'."
 
  (wg-awhen (assq 'wg-mode-line-display-on mode-line-format)
 
    (set-default 'mode-line-format (remove it mode-line-format))
 
    (force-mode-line-update)))
 

	
 

	
 

	
 
;;; messaging
 

	
 
(defun wg-message (format-string &rest args)
 
  "Call `message' with FORMAT-STRING and ARGS.
 
Also save the msg to `wg-last-message'."
 
  (setq wg-last-message (apply #'message format-string args)))
 

	
 
(defmacro wg-fontified-message (&rest format)
 
  "`wg-fontify' FORMAT and call `wg-message' on it."
 
  (declare (indent defun))
 
  `(wg-message (wg-fontify ,@format)))
 

	
 

	
 

	
 
;;; fancy displays
 

	
 
;; FIXME: add `wg-display-max-lines' to chop long display strings at max-line
 
;; and element-name boundaries
 

	
 
(defun wg-element-display (elt elt-string &optional current-elt-p previous-elt-p)
 
  "Return display string for ELT."
 
  (cond ((and current-elt-p (funcall current-elt-p elt))
 
         (wg-fontify (:cur (concat wg-list-display-decor-current-left
 
                                   elt-string
 
                                   wg-list-display-decor-current-right))))
 
        ((and previous-elt-p (funcall previous-elt-p elt))
 
         (wg-fontify (:prev (concat wg-list-display-decor-previous-left
 
                                    elt-string
 
                                    wg-list-display-decor-previous-right))))
 
        (t (wg-fontify (:other elt-string)))))
 

	
 
(defun wg-workgroup-display (workgroup index)
 
  "Return display string for WORKGROUP at INDEX."
 
  (if (not workgroup) wg-nowg-string
 
    (wg-element-display
 
     workgroup
 
     (format "%d: %s" index (wg-workgroup-name workgroup))
 
     'wg-current-workgroup-p
 
     'wg-previous-workgroup-p)))
 

	
 
(defun wg-buffer-display (buffer index)
 
  "Return display string for BUFFER. INDEX is ignored."
 
  (if (not buffer) "No buffers"
 
    (wg-element-display
 
     (wg-get-buffer buffer)
 
     (format "%s" (wg-buffer-name buffer))
 
     'wg-current-buffer-p)))
 

	
 

	
 
;; (defun wg-display-internal (elt-fn list)
 
;;   "Return display string built by calling ELT-FN on each element of LIST."
 
;;   (let ((div (wg-add-face :div wg-list-display-decor-divider))
 
;;         (i -1))
 
;;     (wg-fontify
 
;;       (:brace wg-list-display-decor-left-brace)
 
;;       (if (not list) (funcall elt-fn nil nil)
 
;;         (wg-doconcat (elt list div) (funcall elt-fn elt (cl-incf i))))
 
;;       (:brace wg-list-display-decor-right-brace))))
 

	
 
(defcustom wg-display-max-lines 1
 
  "FIXME: docstring this"
 
  :type 'integer
 
  :group 'workgroups)
 

	
 

	
 

	
 
(defun wg-display-internal (elt-fn list)
 
  "Return display string built by calling ELT-FN on each element of LIST."
 
  (let ((div (wg-add-face :div wg-list-display-decor-divider))
 
        (wwidth (window-width (minibuffer-window)))
 
        (i -1)
 
        (str))
 
    (setq str
 
          (wg-fontify
 
            (:brace wg-list-display-decor-left-brace)
 
            (if (not list) (funcall elt-fn nil nil)
0 comments (0 inline, 0 general)