Changeset - 0b5c99a5885b
Parent rev.
Child rev.
[Not reviewed]
Merge
0 3 0
Sergey Pashinin - 11 years ago 2014-09-30 08:39:00
sergey@pashinin.com
Merge branch 'dev'
3 files changed with 69 insertions and 12 deletions:
.travis.yml
1
1
src/workgroups2.el
21
11
tests/workgroups2-tests.el
47
0 comments (0 inline, 0 general)
.travis.yml
➞
Show inline comments
 
@@ -34,7 +34,7 @@ script:
 
  - $EMACS --version
 
  - if [ "$GUI" = "1" ]; then make testgui EMACS=${EMACS}; fi;
 
  - if [ "$GUI" = "0" ]; then make test EMACS=${EMACS}; fi;
 
  - ls -la /tmp
 

			




	
	
	
		
 
notifications:

			




	
	
	
		
 
  email: false

			




	
	
		
 
\ No newline at end of file

			




	
	
	
		
 
  email: false

			




        

    


    
    

    

        

                

                    src/workgroups2.el
                

                

                  
                      
                        

                      ➞

                      
                        
                  

                  
                      
                  
                      
                  
                      
                  
                      
                  
                  
                

                

                    Show inline comments
                    
                

        

        

            



	
	
		
 
@@ -1137,13 +1137,16 @@ Saves some variables to restore a BUFFER later."

			




	
	
	
		
 
(font-lock-add-keywords 'emacs-lisp-mode wg-font-lock-keywords)

			




	
	
	
		
 

			




	
	
	
		
 
(defvar wg-current-session nil "Current session object.")

			




	
	
	
		
 
(defun wg-current-session (&optional noerror)

			




	
	
	
		
 
  "Return `wg-current-session' or error unless NOERROR."

			




	
	
	
		
 
  (or wg-current-session

			




	
	
	
		
 
      (unless noerror (error "No session is defined"))))

			




	
	
	
		
 
      (if workgroups-mode

			




	
	
	
		
 
          (unless noerror (error "No session is defined"))

			




	
	
	
		
 
        (unless noerror

			




	
	
	
		
 
          (error "Activate workgroups with (workgroups-mode 1)")))))

			




	
	
	
		
 

			




	
	
	
		
 
;; locate-dominating-file

			




	
	
	
		
 
(defun wg-get-first-existing-dir (&optional dir)

			




	
	
	
		
 
  "Test if DIR exists and return it.

			




	
	
	
		
 
If not - try to go to the parent dir and do the same."

			




	
	
	
		
 
  (let* ((d (or dir default-directory)))

			




	
	
		
 
@@ -2422,27 +2425,27 @@ If you want, restore them manually and try again."

			




	
	
	
		
 
  "Save the current wconfig to the current workgroup's saved wconfigs."

			




	
	
	
		
 
  (interactive)

			




	
	
	
		
 
  (let* ((workgroup (wg-current-workgroup))

			




	
	
	
		
 
         (name (wg-read-saved-wconfig-name workgroup))

			




	
	
	
		
 
         (wconfig (wg-current-wconfig)))

			




	
	
	
		
 
    (setf (wg-wconfig-name wconfig) name)

			




	
	
	
		
 
    (wg-workgroup-save-wconfig workgroup wconfig)

			




	
	
	
		
 
    (wg-workgroup-save-wconfig wconfig workgroup)

			




	
	
	
		
 
    (wg-fontified-message

			




	
	
	
		
 
      (:cmd "Saved: ")

			




	
	
	
		
 
      (:cur name))))

			




	
	
	
		
 

			




	
	
	
		
 
(defun wg-restore-saved-wconfig ()

			




	
	
	
		
 
  "Restore one of the current workgroup's saved wconfigs in `selected-frame'."

			




	
	
	
		
 
  (interactive)

			




	
	
	
		
 
  (let ((workgroup (wg-current-workgroup)))

			




	
	
	
		
 
    (wg-restore-wconfig-undoably

			




	
	
	
		
 
     (wg-workgroup-get-saved-wconfig

			




	
	
	
		
 
      workgroup

			




	
	
	
		
 
      (ido-completing-read "Saved wconfig: "

			




	
	
	
		
 
                           (mapcar 'wg-wconfig-name (wg-workgroup-saved-wconfigs workgroup))

			




	
	
	
		
 
                           nil t)))))

			




	
	
	
		
 
                           nil t)

			




	
	
	
		
 
      workgroup))))

			




	
	
	
		
 

			




	
	
	
		
 
(defun wg-kill-saved-wconfig ()

			




	
	
	
		
 
  "Kill one of the current workgroup's saved wconfigs.

			




	
	
	
		
 
Also add it to the wconfig kill-ring."

			




	
	
	
		
 
  (interactive)

			




	
	
	
		
 
  (let* ((workgroup (wg-current-workgroup))

			




	
	
		
 
@@ -3436,23 +3439,25 @@ WCONFIG-OR-NAME is resolved with `wg-workgroup-get-saved-wconfig'."

			




	
	
	
		
 
  (let (wg-flag-modified)

			




	
	
	
		
 
    (wg-restore-wconfig-undoably (wg-workgroup-working-wconfig workgroup) t)))

			




	
	
	
		
 

			




	
	
	
		
 
(defun wg-workgroup-list-or-error (&optional noerror)

			




	
	
	
		
 
  "Return the value of `wg-current-session's :workgroup-list slot.

			




	
	
	
		
 
Or scream unless NOERROR."

			




	
	
	
		
 
  (or (wg-workgroup-list)

			




	
	
	
		
 
      (unless noerror (error "No workgroups are defined"))))

			




	
	
	
		
 
  (aif (wg-current-session noerror)

			




	
	
	
		
 
      (or (wg-session-workgroup-list it)

			




	
	
	
		
 
          (unless noerror (error "No workgroups are defined.")))

			




	
	
	
		
 
    (unless noerror (error "Current session is nil. No workgroups are defined"))))

			




	
	
	
		
 

			




	
	
	
		
 
(defun wg-find-workgroup-by (slotkey value &optional noerror)

			




	
	
	
		
 
  "Return the workgroup on which ACCESSOR returns VALUE or error."

			




	
	
	
		
 
  (let ((accessor (cl-ecase slotkey

			




	
	
	
		
 
                    (:name 'wg-workgroup-name)

			




	
	
	
		
 
                    (:uid  'wg-workgroup-uid))))

			




	
	
	
		
 
    (or (cl-find value (wg-workgroup-list-or-error noerror) :test 'equal :key accessor)

			




	
	
	
		
 
        (unless noerror

			




	
	
	
		
 
          (error "No are no workgroups with a %S of %S"

			




	
	
	
		
 
          (error "There are no workgroups with a %S of %S"

			




	
	
	
		
 
                 accessor value)))))

			




	
	
	
		
 

			




	
	
	
		
 
(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)))

			




	
	
	
		
 

			




	
	
		
 
@@ -3589,13 +3594,13 @@ symetry with `wg-undo-once-all-workgroups'."

			




	
	
	
		
 
    (wg-workgroup-working-wconfig

			




	
	
	
		
 
     (wg-get-workgroup workgroup))

			




	
	
	
		
 
    'both)))

			




	
	
	
		
 

			




	
	
	
		
 
(defun wg-rename-workgroup (newname &optional workgroup)

			




	
	
	
		
 
  "Set NEWNAME to WORKGROUP's name."

			




	
	
	
		
 
  (interactive (list nil (wg-read-new-workgroup-name "New name: ")))

			




	
	
	
		
 
  (interactive (list (wg-read-new-workgroup-name "New name: ") nil))

			




	
	
	
		
 
  (-when-let (workgroup (wg-get-workgroup workgroup))

			




	
	
	
		
 
    (let* ((oldname (wg-workgroup-name workgroup)))

			




	
	
	
		
 
      (setf (wg-workgroup-name workgroup) newname)

			




	
	
	
		
 
      (wg-flag-workgroup-modified workgroup)

			




	
	
	
		
 
      (wg-fontified-message

			




	
	
	
		
 
        (:cmd "Renamed: ")

			




	
	
		
 
@@ -4030,14 +4035,15 @@ To save up to date undo info before the change."

			




	
	
	
		
 

			




	
	
	
		
 
(defun wg-workgroup-list-display (&optional workgroup-list)

			




	
	
	
		
 
  "Return the WORKGROUP-LIST display string.

			




	
	
	
		
 
The string contains the names of all workgroups in `wg-workgroup-list',

			




	
	
	
		
 
decorated with faces, dividers and strings identifying the

			




	
	
	
		
 
current and previous workgroups."

			




	
	
	
		
 
  (wg-display-internal 'wg-workgroup-display

			




	
	
	
		
 
                       (or workgroup-list (wg-workgroup-list))))

			




	
	
	
		
 
  (if (wg-current-session t)

			




	
	
	
		
 
      (wg-display-internal 'wg-workgroup-display

			




	
	
	
		
 
                           (or workgroup-list (wg-workgroup-list)))))

			




	
	
	
		
 

			




	
	
	
		
 
(defun wg-create-first-wg ()

			




	
	
	
		
 
  "Create a first workgroup if needed."

			




	
	
	
		
 
  (when (and workgroups-mode

			




	
	
	
		
 
             wg-session-load-on-start

			




	
	
	
		
 
             (= (length (wg-workgroup-list)) 0))

			




	
	
		
 
@@ -4196,16 +4202,20 @@ nil otherwise."

			




	
	
	
		
 
  (dolist (workgroup (wg-workgroup-list))

			




	
	
	
		
 
    (awhen (wg-workgroup-selected-frame-wconfig workgroup)

			




	
	
	
		
 
      (setf (wg-workgroup-base-wconfig workgroup) it

			




	
	
	
		
 
            (wg-workgroup-selected-frame-wconfig workgroup) nil)))

			




	
	
	
		
 

			




	
	
	
		
 
  ;; Garbage collection

			




	
	
	
		
 

			




	
	
	
		
 
  ;; Commenting this will cause a constantly growing session file:

			




	
	
	
		
 
  ;; (tried to comment this block to solve https://github.com/pashinin/workgroups2/issues/48)

			




	
	
	
		
 
  (let ((all-buf-uids (wg-all-buf-uids)))

			




	
	
	
		
 
    (wg-asetf (wg-buf-list)

			




	
	
	
		
 
              (cl-remove-if-not (lambda (uid) (member uid all-buf-uids)) it

			




	
	
	
		
 
                                :key 'wg-buf-uid)))

			




	
	
	
		
 

			




	
	
	
		
 
  (mapc 'wg-workgroup-gc-buf-uids (wg-workgroup-list))  ; Remove buf uids that have no referent in `wg-buf-list'

			




	
	
	
		
 
  (mapc 'wg-update-buffer-in-buf-list (wg-buffer-list-emacs)))

			




	
	
	
		
 

			




	
	
	
		
 
(defun wg-save-session-as (filename &optional confirm)

			




	
	
	
		
 
  "Write the current session into file FILENAME.

			




	
	
	
		
 
This makes the session visit that file, and marks it as not modified.

			




	
	
		
 
@@ -4546,13 +4556,13 @@ ARG is anything else, turn on `workgroups-mode'."

			




	
	
	
		
 
              ((integerp arg) (if (> arg 0) t nil))

			




	
	
	
		
 
              (t)))

			




	
	
	
		
 
  (cond

			




	
	
	
		
 
   (workgroups-mode

			




	
	
	
		
 
    (if (boundp 'desktop-restore-frames)

			




	
	
	
		
 
        (setq desktop-restore-frames nil))

			




	
	
	
		
 
    (wg-reset-internal)

			




	
	
	
		
 
    (wg-reset-internal)                              ; creates a new `wg-current-session'

			




	
	
	
		
 
    (wg-add-workgroups-mode-minor-mode-entries)

			




	
	
	
		
 
    (wg-enable-all-advice)

			




	
	
	
		
 
    (wg-add-or-remove-workgroups-hooks nil)

			




	
	
	
		
 
    (wg-change-modeline)

			




	
	
	
		
 

			




	
	
	
		
 
    ;; some sr-speedbar hooks can harm

			




        

    


    
    

    

        

                

                    tests/workgroups2-tests.el
                

                

                  
                      
                        

                      ➞

                      
                        
                  

                  
                      
                  
                      
                  
                      
                  
                      
                  
                  
                

                

                    Show inline comments
                    
                

        

        

            



	
	
		
 
@@ -151,27 +151,74 @@

			




	
	
	
		
 
      (switch-to-buffer (process-buffer (python-shell-get-or-create-process)))))

			




	
	
	
		
 

			




	
	
	
		
 
  ;; TODO: handle errors

			




	
	
	
		
 
  )

			




	
	
	
		
 

			




	
	
	
		
 
(ert-deftest 310-frames ()

			




	
	
	
		
 
  ;; Create some frames

			




	
	
	
		
 
  (should wg-control-frames)

			




	
	
	
		
 
  (make-frame)

			




	
	
	
		
 
  (make-frame)

			




	
	
	
		
 
  (should (wg-modified-p))

			




	
	
	
		
 
  (should (= (length (frame-list)) 3))

			




	
	
	
		
 
  (should workgroups-mode)

			




	
	
	
		
 

			




	
	
	
		
 
  ;; Save

			




	
	
	
		
 
  (let (message-log-max)

			




	
	
	
		
 
    (wg-save-session))

			




	
	
	
		
 

			




	
	
	
		
 
  ;; Reset to 1 frame

			




	
	
	
		
 
  (should-not (wg-session-modified (wg-current-session)))

			




	
	
	
		
 
  (should (= (length (wg-session-parameter 'frame-list)) 2))

			




	
	
	
		
 
  (delete-other-frames)

			




	
	
	
		
 
  (should (= (length (frame-list)) 1))

			




	
	
	
		
 

			




	
	
	
		
 
  ;; Restore frames

			




	
	
	
		
 
  (wg-reload-session)

			




	
	
	
		
 
  ;;(should (= (length (wg-session-parameter 'frame-list)) 2))

			




	
	
	
		
 
  (should (= (length (frame-list)) 3))

			




	
	
	
		
 
  (delete-other-frames)

			




	
	
	
		
 
  (let (message-log-max)

			




	
	
	
		
 
    (wg-save-session)))

			




	
	
	
		
 

			




	
	
	
		
 

			




	
	
	
		
 

			




	
	
	
		
 
;; Bugs

			




	
	
	
		
 

			




	
	
	
		
 
;; https://github.com/pashinin/workgroups2/issues/48

			




	
	
	
		
 
;;(ert-deftest 500-bug-48 ()

			




	
	
	
		
 
;;  ;; Create a bunch of files for 2 workgroups

			




	
	
	
		
 
;;  (make-directory "/tmp/wg1" t)

			




	
	
	
		
 
;;  (make-directory "/tmp/wg2" t)

			




	
	
	
		
 
;;  (dotimes (i 20)

			




	
	
	
		
 
;;    (let ((file (format "/tmp/wg1/file_%.2d.\n" (1+ i))))

			




	
	
	
		
 
;;      (unless (file-exists-p file)

			




	
	
	
		
 
;;        (write-file file))

			




	
	
	
		
 
;;      (find-file file)))

			




	
	
	
		
 
;;  (wg-create-workgroup "wg2" t)

			




	
	
	
		
 
;;  (dotimes (i 20)

			




	
	
	
		
 
;;    (let ((file (format "/tmp/wg2/file_%.2d.\n" (+ i 41))))

			




	
	
	
		
 
;;      (unless (file-exists-p file)

			




	
	
	
		
 
;;        (write-file file))

			




	
	
	
		
 
;;      (find-file file)))

			




	
	
	
		
 
;;

			




	
	
	
		
 
;;  ;; Reopen, resave

			




	
	
	
		
 
;;  (workgroups-mode 0)

			




	
	
	
		
 
;;  (workgroups-mode 1)

			




	
	
	
		
 
;;  (wg-save-session)     ;; this removes BUF objects, I think garbage collection

			




	
	
	
		
 
;;

			




	
	
	
		
 
;;  ;;(should (= (length (wg-session-buf-list (wg-current-session))) 3))

			




	
	
	
		
 
;;  (let* ((bufs (wg-session-buf-list (wg-current-session)))

			




	
	
	
		
 
;;         (bufs-len (length bufs))

			




	
	
	
		
 
;;         (wg1 (wg-get-workgroup "First workgroup"))

			




	
	
	
		
 
;;         (wg2 (wg-get-workgroup "wg2"))

			




	
	
	
		
 
;;         (bufs1 (wg-workgroup-associated-bufs wg1))

			




	
	
	
		
 
;;         (bufs2 (wg-workgroup-associated-bufs wg2))

			




	
	
	
		
 
;;         (len1 (length bufs1))

			




	
	
	
		
 
;;         (len2 (length bufs2)))

			




	
	
	
		
 
;;    ;;(wg-workgroup-associated-bufs)

			




	
	
	
		
 
;;    (should (>= bufs-len 40))

			




	
	
	
		
 
;;    (should (>= len1 20))

			




	
	
	
		
 
;;    (should (>= len2 20))))

			




	
	
	
		
 

			




	
	
	
		
 
(provide 'workgroups2-tests)

			




	
	
	
		
 
;;; workgroups2-tests.el ends here

			




        

    



    


    



    



      

      





    
    0 comments (0 inline, 0 general)
    





    


  

  







  


    




    








    
        
    
    
        This site is powered by
            Kallithea 0.7.0,
        which is
        © 2010–2025 by various authors & licensed under GPLv3.